da_get_innov_vector_ssmt2.inc
References to this file elsewhere.
1 subroutine da_get_innov_vector_ssmt2( it, xb, xp, ob, iv)
2
3 !-----------------------------------------------------------------------
4 ! Purpose: TBD
5 !-----------------------------------------------------------------------
6
7 implicit none
8
9 integer, intent(in) :: it ! External iteration.
10 type(xb_type), intent(in) :: xb ! first guess state.
11 type(xpose_type), intent(in) :: xp ! Domain decomposition vars.
12 type(y_type), intent(inout) :: ob ! Observation structure.
13 type(ob_type), intent(inout) :: iv ! O-B structure.
14
15 integer :: n ! Loop counter.
16 integer :: i, j, k ! Index dimension.
17 integer :: num_levs ! Number of obs levels.
18 real :: dx, dxm ! Interpolation weights.
19 real :: dy, dym ! Interpolation weights.
20 real, dimension(1:max_ob_levels):: model_rh ! Model value rh at ob location.
21
22 real :: zk ! Interpolation vertical coordinator.
23
24 real, dimension(xp%kms:xp%kme) :: v_h ! Model value h at ob hor. location.
25 real, dimension(xp%kms:xp%kme) :: v_p ! Model value p at ob hor. location.
26
27 integer :: irh, irhf
28
29 if (iv % num_ssmt2 > 0) then
30 irh = 0 ; irhf = 0
31 do n=1, iv % num_ssmt2
32 num_levs = iv % ssmt2(n) % info % levels
33
34 if (num_levs < 1) cycle
35
36 model_rh(:) = 0.0
37
38 ! [1.1] Get horizontal interpolation weights:
39
40 i = iv%ssmt2(n)%loc%i
41 j = iv%ssmt2(n)%loc%j
42 dx = iv%ssmt2(n)%loc%dx
43 dy = iv%ssmt2(n)%loc%dy
44 dxm = iv%ssmt2(n)%loc%dxm
45 dym = iv%ssmt2(n)%loc%dym
46
47 do k=xp%kts,xp%kte
48 v_h(k) = dym*(dxm*xb%h(i,j ,k) + dx*xb%h(i+1,j ,k)) &
49 + dy *(dxm*xb%h(i,j+1,k) + dx*xb%h(i+1,j+1,k))
50 v_p(k) = dym*(dxm*xb%p(i,j ,k) + dx*xb%p(i+1,j ,k)) &
51 + dy *(dxm*xb%p(i,j+1,k) + dx*xb%p(i+1,j+1,k))
52 end do
53
54 num_levs=0
55 do k=1, iv % ssmt2(n) % info % levels
56
57 zk=missing_r
58
59 if (iv % ssmt2(n) % h(k) > 0.0) then
60 call da_to_zk(iv % ssmt2(n) % h(k), v_h, xp, v_interp_h, zk)
61 else if (iv % ssmt2(n) % p(k) > 1.0) then
62 call da_to_zk(iv % ssmt2(n) % p(k), v_p, xp, v_interp_p, zk)
63 end if
64
65 if (zk > 0.0) then
66 num_levs=num_levs+1
67 iv%ssmt2(n)%zk(num_levs)=zk
68
69 ob % ssmt2(n) % rh(num_levs) = ob % ssmt2(n) % rh(k)
70
71 iv % ssmt2(n) % rh(num_levs) % qc = iv % ssmt2(n) % rh(k) % qc
72
73 iv % ssmt2(n) % rh(num_levs) % error = iv % ssmt2(n) % rh(k) % error
74 end if
75 end do
76
77 iv % ssmt2(n) % info % levels = num_levs
78
79 ! [1.2] Interpolate horizontally to ob:
80
81 call da_interp_lin_3d( xb % rh, xp, i, j, dx, dy, dxm, dym, &
82 model_rh, max_ob_levels, iv%ssmt2(n)%zk, num_levs)
83
84 !--------------------------------------------------------------------
85 ! [2.0] Initialise components of innovation vector:
86 !--------------------------------------------------------------------
87
88 do k = 1, iv % ssmt2(n) % info % levels
89
90 iv % ssmt2(n) % rh(k) % inv = 0.0
91
92 !-----------------------------------------------------------------
93 ! [3.0] Interpolation:
94 !-----------------------------------------------------------------
95
96 if (ob % ssmt2(n) % rh(k) > missing_r .AND. &
97 iv % ssmt2(n) % rh(k) % qc >= obs_qc_pointer) then
98
99 iv % ssmt2(n) % rh(k) % inv = ob % ssmt2(n) % rh(k) - &
100 model_rh(k)
101 end if
102
103 ! write(122,'(2i4,i8,5f15.5)')n, k, iv%ssmt2(n)%height_qc(k), &
104 ! iv%ssmt2(n)%info%lat, iv%ssmt2(n)%info%lon, &
105 ! iv%ssmt2(n)%h(k), &
106 ! ob % ssmt2(n) % rh(k), model_rh(k)
107
108 end do
109
110 !------------------------------------------------------------------------
111 ! [5.0] Perform optional maximum error check:
112 !------------------------------------------------------------------------
113
114 if (check_max_iv) call da_check_max_iv_ssmt2(it, iv % ssmt2(n), irh,irhf)
115 end do
116
117 if (rootproc .and. check_max_iv_print) then
118 write(unit = check_max_iv_unit, fmt ='(A,i5,A)') &
119 'For outer iteration ',it,' Total Rejections for SSMI(T2) follows:'
120 write(unit = check_max_iv_unit, fmt = '(/,2(2(A,I6),/))') &
121 'Number of failed RH(T2) observations: ',irhf, ' on ',irh
122 end if
123 end if
124
125 end subroutine da_get_innov_vector_ssmt2
126
127