da_jo_and_grady.inc
References to this file elsewhere.
1 subroutine da_jo_and_grady(iv, re, jot, jo, jo_grad_y)
2
3 !-----------------------------------------------------------------------
4 ! Purpose: TBD
5 !-----------------------------------------------------------------------
6
7 implicit none
8
9 type (iv_type), intent(in) :: iv ! Innovation vector (O-B).
10 type (y_type), intent(in) :: re ! Residual vector (O-A).
11 real, intent(out) :: jot ! Obs cost function.
12 type (jo_type), intent(out) :: jo ! Obs cost function.
13 type (y_type), intent(out) :: jo_grad_y ! Grad_y(Jo)
14
15
16 real :: jo_sound, jo_sonde_sfc,jo_synop, jo_geoamv, jo_polaramv, &
17 jo_airep, jo_pilot, jo_satem, &
18 jo_metar, jo_ships, jo_gpspw, &
19 jo_ssmi_tb, jo_ssmi_rv, jo_ssmt1, jo_ssmt2, &
20 jo_pseudo, jo_qscat, jo_buoy, &
21 jo_profiler, jo_radar, jo_gpsref, jo_bogus, &
22 jo_radiance, jo_airsr
23 integer :: i,k
24
25 if (trace_use) call da_trace_entry("da_jo_and_grady")
26
27 !-------------------------------------------------------------------------
28 ! [1.0] Compute components of Grad_y(Jo):
29 !-------------------------------------------------------------------------
30
31 if (iv%info(sound)%nlocal > 0) then
32 call da_jo_and_grady_sound(iv, re, jo, jo_grad_y)
33 jo_sound = jo%sound_u + jo%sound_v + jo%sound_t + jo%sound_q
34
35 if (print_detail_grad) then
36 write(unit=stdout, fmt='(a, e24.12)') &
37 ' jo_sound ', jo_sound, &
38 ' jo%sound_u ', jo%sound_u, &
39 ' jo%sound_v ', jo%sound_v, &
40 ' jo%sound_t ', jo%sound_t, &
41 ' jo%sound_q ', jo%sound_q
42 end if
43
44 call da_jo_and_grady_sonde_sfc(iv, re, jo, jo_grad_y)
45 jo_sonde_sfc = jo%sonde_sfc_u + jo%sonde_sfc_v + jo%sonde_sfc_t + &
46 jo%sonde_sfc_q + jo%sonde_sfc_p
47
48 if (print_detail_grad) then
49 write(unit=stdout, fmt='(a, e24.12)') &
50 ' jo_sonde_sfc ', jo_sonde_sfc, &
51 ' jo%sonde_sfc_u ', jo%sonde_sfc_u, &
52 ' jo%sonde_sfc_v ', jo%sonde_sfc_v, &
53 ' jo%sonde_sfc_t ', jo%sonde_sfc_t, &
54 ' jo%sonde_sfc_p ', jo%sonde_sfc_p, &
55 ' jo%sonde_sfc_q ', jo%sonde_sfc_q
56 end if
57 else
58 jo_sound = 0.0
59 jo_sonde_sfc = 0.0
60 end if
61
62 if (iv%info(synop)%nlocal > 0) then
63 call da_jo_and_grady_synop(iv, re, jo, jo_grad_y)
64 jo_synop = jo%synop_u + jo%synop_v + jo%synop_t + jo%synop_p + jo%synop_q
65
66 if (print_detail_grad) then
67 write(unit=stdout, fmt='(a, e24.12)') &
68 ' jo_synop ', jo_synop, &
69 ' jo%synop_u ', jo%synop_u, &
70 ' jo%synop_v ', jo%synop_v, &
71 ' jo%synop_t ', jo%synop_t, &
72 ' jo%synop_p ', jo%synop_p, &
73 ' jo%synop_q ', jo%synop_q
74 end if
75 else
76 jo_synop = 0.0
77 end if
78
79 if (iv%info(geoamv)%nlocal > 0) then
80 call da_jo_and_grady_geoamv(iv, re, jo, jo_grad_y)
81 jo_geoamv = jo%geoamv_u + jo%geoamv_v
82 if (print_detail_grad) then
83 write(unit=stdout, fmt='(a, e24.12)') &
84 ' jo_geoamv ', jo_geoamv, &
85 ' jo%geoamv_u ', jo%geoamv_u, &
86 ' jo%geoamv_v ', jo%geoamv_v
87 end if
88 else
89 jo_geoamv = 0.0
90 end if
91
92 if (iv%info(polaramv)%nlocal > 0) then
93 call da_jo_and_grady_polaramv(iv, re, jo, jo_grad_y)
94 jo_polaramv = jo%polaramv_u + jo%polaramv_v
95 if (print_detail_grad) then
96 write(unit=stdout, fmt='(a, e24.12)') &
97 ' jo_polaramv ', jo_polaramv, &
98 ' jo%polaramv_u ', jo%polaramv_u, &
99 ' jo%polaramv_v ', jo%polaramv_v
100 end if
101 else
102 jo_polaramv = 0.0
103 end if
104
105 if (iv%info(airep)%nlocal > 0) then
106 call da_jo_and_grady_airep(iv, re, jo, jo_grad_y)
107 jo_airep = jo%airep_u + jo%airep_v + jo%airep_t
108 else
109 jo_airep = 0.0
110 end if
111
112 if (iv%info(pilot)%nlocal > 0) then
113 call da_jo_and_grady_pilot(iv, re, jo, jo_grad_y)
114 jo_pilot = jo%pilot_u + jo%pilot_v
115 else
116 jo_pilot = 0.0
117 end if
118
119 if (iv%info(satem)%nlocal > 0) then
120 call da_jo_and_grady_satem(iv, re, jo, jo_grad_y)
121 jo_satem = jo%satem_thickness
122 else
123 jo_satem = 0.0
124 end if
125
126 if (iv%info(metar)%nlocal > 0) then
127 call da_jo_and_grady_metar(iv, re, jo, jo_grad_y)
128 jo_metar = jo%metar_u + jo%metar_v + jo%metar_t + jo%metar_p + jo%metar_q
129 else
130 jo_metar = 0.0
131 end if
132
133 if (iv%info(ships)%nlocal > 0) then
134 call da_jo_and_grady_ships(iv, re, jo, jo_grad_y)
135 jo_ships = jo%ships_u + jo%ships_v + jo%ships_t + jo%ships_p + jo%ships_q
136 else
137 jo_ships = 0.0
138 end if
139
140 if (iv%info(gpspw)%nlocal > 0) then
141 call da_jo_and_grady_gpspw(iv, re, jo, jo_grad_y)
142 jo_gpspw = jo%gpspw_tpw
143 else
144 jo_gpspw = 0.0
145 end if
146
147 if (iv%info(gpsref)%nlocal > 0) then
148 call da_jo_and_grady_gpsref(iv, re, jo, jo_grad_y)
149 jo_gpsref = jo%gpsref_ref
150 else
151 jo_gpsref = 0.0
152 end if
153
154 if (iv%info(ssmi_tb)%nlocal > 0) then
155 call da_jo_and_grady_ssmi_tb (iv, re, jo, jo_grad_y)
156 jo_ssmi_tb = jo % ssmi_tb19v + jo % ssmi_tb19h + jo % ssmi_tb22v + &
157 jo % ssmi_tb37v + jo % ssmi_tb37h + jo % ssmi_tb85v + &
158 jo % ssmi_tb85h
159 else
160 jo_ssmi_tb = 0.0
161 end if
162
163 if (iv%info(ssmi_rv)%nlocal > 0) then
164 call da_jo_and_grady_ssmi_rv(iv, re, jo, jo_grad_y)
165 jo_ssmi_rv = jo % ssmir_speed + jo % ssmir_tpw
166 else
167 jo_ssmi_rv = 0.0
168 end if
169
170 if (iv%info(ssmt2)%nlocal > 0) then
171 call da_jo_and_grady_ssmt1(iv, re, jo, jo_grad_y)
172 jo_ssmt1 = jo%ssmt1_t
173 else
174 jo_ssmt1 = 0.0
175 end if
176
177 if (iv%info(ssmt2)%nlocal > 0) then
178 call da_jo_and_grady_ssmt2(iv, re, jo, jo_grad_y)
179 jo_ssmt2 = jo%ssmt2_rh
180 else
181 jo_ssmt2 = 0.0
182 end if
183
184 if (iv%info(radar)%nlocal > 0) then
185 call da_jo_and_grady_radar(iv, re, jo, jo_grad_y)
186 jo_radar = jo%radar_rv + jo%radar_rf
187 else
188 jo_radar = 0.0
189 end if
190
191 if (iv%info(pseudo)%nlocal > 0) then
192 call da_jo_and_grady_pseudo(iv, re, jo, jo_grad_y)
193 jo_pseudo = jo%pseudo_u + jo%pseudo_v + jo%pseudo_t + jo%pseudo_p + jo%pseudo_q
194 else
195 jo_pseudo = 0.0
196 end if
197
198 if (iv%info(qscat)%nlocal > 0) then
199 call da_jo_and_grady_qscat(iv, re, jo, jo_grad_y)
200 jo_qscat = jo%qscat_u + jo%qscat_v
201 else
202 jo_qscat = 0.0
203 end if
204
205 if (iv%info(profiler)%nlocal > 0) then
206 call da_jo_and_grady_profiler (iv, re, jo, jo_grad_y)
207 jo_profiler = jo%profiler_u + jo%profiler_v
208 else
209 jo_profiler = 0.0
210 end if
211
212 if (iv%info(bogus)%nlocal > 0) then
213 call da_jo_and_grady_bogus (iv, re, jo, jo_grad_y)
214 jo_bogus = jo%bogus_u + jo%bogus_v + jo%bogus_slp + jo%bogus_t + jo%bogus_q
215 else
216 jo_bogus = 0.0
217 end if
218
219 if (iv%info(buoy)%nlocal > 0) then
220 call da_jo_and_grady_buoy (iv, re, jo, jo_grad_y)
221 jo_buoy = jo%buoy_u + jo%buoy_v + jo%buoy_t + jo%buoy_p + jo%buoy_q
222 else
223 jo_buoy = 0.0
224 end if
225
226 if (iv%num_inst > 0) then
227 call da_jo_and_grady_rad (iv, re, jo, jo_grad_y)
228
229 jo_radiance = 0.0
230 if (use_rad) then
231 do i=1,iv%num_inst
232 do k=1,iv%instid(i)%nchan
233 jo_radiance = jo_radiance + jo%rad(i)%jo_ichan(k)
234 end do
235 end do
236 end if
237 if (print_detail_grad) then
238 write(unit=stdout, fmt='(a, e24.12)') &
239 ' jo_radiance ', jo_radiance
240 do i = 1, iv%num_inst
241 write(unit=stdout, fmt='(a, e24.12)') &
242 trim(' jo_'//iv%instid(i)%rttovid_string), sum(jo%rad(i)%jo_ichan(:))
243 end do
244 end if
245 else
246 jo_radiance = 0.0
247 end if
248
249 if (iv%info(airsr)%nlocal > 0) then
250 call da_jo_and_grady_airsr(iv, re, jo, jo_grad_y)
251 jo_airsr = jo%airsr_t + jo%airsr_q
252
253 if (print_detail_grad) then
254 write(unit=stdout, fmt='(a, e24.12)') &
255 ' jo_airsr ', jo_airsr, &
256 ' jo%airsr_t ', jo%airsr_t, &
257 ' jo%airsr_q ', jo%airsr_q
258 end if
259 else
260 jo_airsr = 0.0
261 end if
262
263 !-------------------------------------------------------------------------
264 ! [2.0] Jo = 1/2 * (yo-y)**2/ob_err_variance:
265 !-------------------------------------------------------------------------
266
267 jo%total = jo_sound + jo_sonde_sfc+jo_geoamv + jo_polaramv + jo_synop + jo_satem + &
268 jo_pilot + jo_airep + jo_metar + jo_ships + &
269 jo_gpspw + jo_ssmi_tb + jo_ssmi_rv + jo_ssmt1 + jo_ssmt2 + &
270 jo_pseudo + jo_qscat + jo_profiler + jo_buoy + &
271 jo_radar + jo_gpsref + jo_bogus + jo_radiance + jo_airsr
272
273 jot = jo%total
274
275 if (print_detail_grad) then
276 write(unit=stdout, fmt='(a, e24.12)') &
277 ' jo%total ', jot
278
279 write(unit=stdout, fmt='(a, e24.12)') &
280 ' jo_sound ', jo_sound, &
281 ' jo_sonde_sfc ', jo_sonde_sfc, &
282 ' jo_geoamv ', jo_geoamv, &
283 ' jo_polaramv ', jo_polaramv, &
284 ' jo_synop ', jo_synop, &
285 ' jo_satem ', jo_satem, &
286 ' jo_pilot ', jo_pilot, &
287 ' jo_airep ', jo_airep, &
288 ' jo_metar ', jo_metar, &
289 ' jo_ships ', jo_ships, &
290 ' jo_gpspw ', jo_gpspw, &
291 ' jo_ssmi_tb ', jo_ssmi_tb, &
292 ' jo_ssmi_rv ', jo_ssmi_rv, &
293 ' jo_ssmt1 ', jo_ssmt1, &
294 ' jo_ssmt2 ', jo_ssmt2, &
295 ' jo_pseudo ', jo_pseudo, &
296 ' jo_qscat ', jo_qscat, &
297 ' jo_profiler ', jo_profiler, &
298 ' jo_buoy ', jo_buoy, &
299 ' jo_radar ', jo_radar, &
300 ' jo_gpsref ', jo_gpsref, &
301 ' jo_bogus ', jo_bogus, &
302 ' jo_radiance ', jo_radiance, &
303 ' jo_airsr ', jo_airsr
304
305 end if
306
307 if (trace_use) call da_trace_exit("da_jo_and_grady")
308
309 end subroutine da_jo_and_grady
310
311