da_get_innov_vector_bogus.inc
References to this file elsewhere.
1 subroutine da_get_innov_vector_bogus( it, xb, xp, ob, iv)
2
3 !------------------------------------------------------------------------------
4 ! Purpose: calculate the innovations for the bogus data.
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(in) :: 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
19 real :: dx, dxm ! Interpolation weights.
20 real :: dy, dym ! Interpolation weights.
21 real, dimension(xp%kms:xp%kme) :: v_h ! Model value h at ob hor. location.
22 real, dimension(xp%kms:xp%kme) :: v_p ! Model value p at ob hor. location.
23
24 real, dimension(1:max_ob_levels) :: model_u ! Model value u at ob location.
25 real, dimension(1:max_ob_levels) :: model_v ! Model value v at ob location.
26 real, dimension(1:max_ob_levels) :: model_t ! Model value t at ob location.
27 real, dimension(1:max_ob_levels) :: model_q ! Model value q at ob location.
28 real :: model_slp ! Model value slp at ob location.
29
30 integer :: itu,ituf,itvv,itvvf,itt,ittf,itqv,itqvf,itslp,itslpf
31
32 if (iv % num_bogus < 1) return
33
34 if (trace_use) call da_trace_entry("da_get_innov_vector_bogus")
35
36 itu = 0; itvv = 0; itt = 0; itqv = 0; itslp = 0;
37 ituf = 0; itvvf = 0; ittf = 0; itqvf = 0; itslpf = 0;
38
39 do n=iv%ob_numb(iv%current_ob_time-1)%bogus+1,iv%ob_numb(iv%current_ob_time)%bogus
40 num_levs = iv % bogus(n) % info % levels
41
42 if (num_levs < 1) cycle
43
44 model_u(:) = 0.0
45 model_v(:) = 0.0
46 model_t(:) = 0.0
47 model_q(:) = 0.0
48 model_slp = 0.0
49
50 i = iv%bogus(n)%loc%i
51 j = iv%bogus(n)%loc%j
52 dx = iv%bogus(n)%loc%dx
53 dy = iv%bogus(n)%loc%dy
54 dxm = iv%bogus(n)%loc%dxm
55 dym = iv%bogus(n)%loc%dym
56
57 do k=xp%kts,xp%kte
58 v_h(k) = dym*(dxm*xb%h(i,j ,k) + dx*xb%h(i+1,j ,k)) &
59 + dy *(dxm*xb%h(i,j+1,k) + dx*xb%h(i+1,j+1,k))
60 v_p(k) = dym*(dxm*xb%p(i,j ,k) + dx*xb%p(i+1,j ,k)) &
61 + dy *(dxm*xb%p(i,j+1,k) + dx*xb%p(i+1,j+1,k))
62 end do
63
64 do k=1, iv % bogus(n) % info % levels
65 iv%bogus(n)%zk(k)=missing_r
66 if (iv % bogus(n) % p(k) > 1.0) then
67 call da_to_zk(iv % bogus(n) % p(k), v_p, xp, v_interp_p, iv%bogus(n)%zk(k))
68 else if (iv % bogus(n) % h(k) > 0.0) then
69 call da_to_zk(iv % bogus(n) % h(k), v_h, xp, v_interp_h, iv%bogus(n)%zk(k))
70 end if
71
72 if (iv%bogus(n)%zk(k) < 0.0 .and. .not.anal_type_verify) then
73 iv % bogus(n) % u(k) % qc = missing
74 iv % bogus(n) % v(k) % qc = missing
75 iv % bogus(n) % t(k) % qc = missing
76 iv % bogus(n) % q(k) % qc = missing
77 end if
78 end do
79
80 ! [1.4] Interpolate horizontally:
81 call da_interp_lin_3d( xb % u, xp, i, j, dx, dy, dxm, dym, &
82 model_u, max_ob_levels, iv%bogus(n)%zk, num_levs)
83 call da_interp_lin_3d( xb % v, xp, i, j, dx, dy, dxm, dym, &
84 model_v, max_ob_levels, iv%bogus(n)%zk, num_levs)
85 call da_interp_lin_3d( xb % t, xp, i, j, dx, dy, dxm, dym, &
86 model_t, max_ob_levels, iv%bogus(n)%zk, num_levs)
87 call da_interp_lin_3d( xb % q, xp, i, j, dx, dy, dxm, dym, &
88 model_q, max_ob_levels, iv%bogus(n)%zk, num_levs)
89
90 model_slp = dym*(dxm*xb%slp(i,j) + dx*xb%slp(i+1,j)) &
91 + dy *(dxm*xb%slp(i,j+1) + dx*xb%slp(i+1,j+1))
92
93 !------------------------------------------------------------------------
94 ! [2.0] Initialise components of innovation vector:
95 !------------------------------------------------------------------------
96
97 iv % bogus(n) % slp % inv = 0.0
98
99 if (ABS(ob % bogus(n) % slp - missing_r) > 1. .AND. &
100 iv % bogus(n) % slp % qc >= obs_qc_pointer) then
101 iv % bogus(n) % slp % inv = ob % bogus(n) % slp - model_slp
102 end if
103
104 do k = 1, iv % bogus(n) % info % levels
105 iv % bogus(n) % u(k) % inv = 0.0
106 iv % bogus(n) % v(k) % inv = 0.0
107 iv % bogus(n) % t(k) % inv = 0.0
108 iv % bogus(n) % q(k) % inv = 0.0
109
110 !------------------------------------------------------------------------
111 ! [4.0] Fast interpolation:
112 !------------------------------------------------------------------------
113
114 if (ob % bogus(n) % u(k) > missing_r .AND. &
115 iv % bogus(n) % u(k) % qc >= obs_qc_pointer) then
116 iv % bogus(n) % u(k) % inv = ob % bogus(n) % u(k) - model_u(k)
117 end if
118
119 if (ob % bogus(n) % v(k) > missing_r .AND. &
120 iv % bogus(n) % v(k) % qc >= obs_qc_pointer) then
121 iv % bogus(n) % v(k) % inv = ob % bogus(n) % v(k) - model_v(k)
122 end if
123
124 if (ob % bogus(n) % t(k) > missing_r .AND. &
125 iv % bogus(n) % t(k) % qc >= obs_qc_pointer) then
126
127 ! only for global Bogus(YRG 07/15/2005):
128 if (iv % bogus(n) % info % platform(8:12) /= 'TCBOG') then
129 iv % bogus(n) % t(k) % inv = ob % bogus(n) % t(k) - model_t(k)
130 else
131 iv % bogus(n) % t(k) % inv = missing_r
132 iv % bogus(n) % t(k) % qc = missing_data
133 end if
134 end if
135
136 if (ob % bogus(n) % q(k) > missing_r .AND. &
137 iv % bogus(n) % q(k) % qc >= obs_qc_pointer) then
138
139 ! only for global Bogus(YRG 07/15/2005):
140 if (iv % bogus(n) % info % platform(8:12) /= 'TCBOG') then
141 iv % bogus(n) % q(k) % inv = ob % bogus(n) % q(k) - model_q(k)
142 else
143 iv % bogus(n) % q(k) % inv = missing_r
144 iv % bogus(n) % q(k) % qc = missing_data
145 end if
146 end if
147 end do
148
149 !------------------------------------------------------------------------
150 ! [5.0] Perform optional maximum error check:
151 !------------------------------------------------------------------------
152
153 if (check_max_iv) then
154 call da_check_max_iv_bogus(it, iv % bogus(n), &
155 itu,ituf,itvv,itvvf,itt,ittf,itqv,itqvf,itslp,itslpf)
156 end if
157 end do
158
159 if (rootproc .and. check_max_iv_print) then
160 write(unit = check_max_iv_unit, fmt ='(A,i5,A)')'For outer iteration ',it, &
161 ', Total Rejections for Bogus follows:'
162
163 write(unit = check_max_iv_unit, fmt = '(/,10(2(A,I6),/))') &
164 'Number of failed u-wind observations: ',ituf, ' on ',itu, &
165 'Number of failed v-wind observations: ',itvvf, ' on ',itvv, &
166 'Number of failed temperature observations: ',ittf, ' on ',itt, &
167 'Number of failed mixing ratio observations: ',itqvf, ' on ',itqv, &
168 'Number of failed slp observations: ',itslpf,' on ',itslp, &
169 'Finally Total Bogus rejections ',ituf+itvvf+ittf+itqvf+itslpf,' on ', &
170 itu +itvv +itt +itqv +itslp
171 end if
172
173 if (trace_use) call da_trace_exit("da_get_innov_vector_bogus")
174
175 end subroutine da_get_innov_vector_bogus
176
177