da_use_obs_errfac.inc
References to this file elsewhere.
1 subroutine da_use_obs_errfac(iv)
2
3 !-------------------------------------------------------------------------
4 ! Purpose: Allocates observation structure and fills it from iv.
5 !-------------------------------------------------------------------------
6
7 implicit none
8
9 type (iv_type), intent(inout) :: iv ! Obs and header structure.
10
11 integer :: n, k ! Loop counters.
12 real :: d1, d2, d3, d4 ! Dummy values.
13
14 if (trace_use) call da_trace_entry("da_use_obs_errfac")
15
16 !----------------------------------------------------------------------
17 ! [2.0] Scale observation errors:
18 !-------------------------------------------------------------------
19
20 ! [2.1] Transfer surface obs:
21
22 if (iv%info(synop)%nlocal > 0) then
23 call da_read_errfac('synop', iv % synop_ef_u, &
24 iv % synop_ef_v, iv % synop_ef_t, &
25 iv % synop_ef_p, iv % synop_ef_q)
26
27 do n = 1, iv%info(synop)%nlocal
28 iv % synop(n) % u % error = iv % synop(n) % u % error * iv % synop_ef_u
29 iv % synop(n) % v % error = iv % synop(n) % v % error * iv % synop_ef_v
30 iv % synop(n) % t % error = iv % synop(n) % t % error * iv % synop_ef_t
31 iv % synop(n) % p % error = iv % synop(n) % p % error * iv % synop_ef_p
32 iv % synop(n) % q % error = iv % synop(n) % q % error * iv % synop_ef_q
33 end do
34 end if
35
36 ! [2.2] Transfer metar obs:
37
38 if (iv%info(metar)%nlocal > 0) then
39
40 call da_read_errfac('metar', iv % metar_ef_u, &
41 iv % metar_ef_v, iv % metar_ef_t, &
42 iv % metar_ef_p, iv % metar_ef_q)
43
44 do n = 1, iv%info(metar)%nlocal
45 iv % metar(n) % u % error = iv % metar(n) % u % error * iv % metar_ef_u
46 iv % metar(n) % v % error = iv % metar(n) % v % error * iv % metar_ef_v
47 iv % metar(n) % t % error = iv % metar(n) % t % error * iv % metar_ef_t
48 iv % metar(n) % p % error = iv % metar(n) % p % error * iv % metar_ef_p
49 iv % metar(n) % q % error = iv % metar(n) % q % error * iv % metar_ef_q
50 end do
51 end if
52
53 ! [2.2] Transfer ships obs:
54
55 if (iv%info(ships)%nlocal > 0) then
56
57 call da_read_errfac('ships', iv % ships_ef_u, &
58 iv % ships_ef_v, iv % ships_ef_t, &
59 iv % ships_ef_p, iv % ships_ef_q)
60
61 do n = 1, iv%info(ships)%nlocal
62 iv % ships(n) % u % error = iv % ships(n) % u % error * iv % ships_ef_u
63 iv % ships(n) % v % error = iv % ships(n) % v % error * iv % ships_ef_v
64 iv % ships(n) % t % error = iv % ships(n) % t % error * iv % ships_ef_t
65 iv % ships(n) % p % error = iv % ships(n) % p % error * iv % ships_ef_p
66 iv % ships(n) % q % error = iv % ships(n) % q % error * iv % ships_ef_q
67 end do
68 end if
69
70 ! [2.4.1] Transfer Geo. AMVs Obs:
71
72 if (iv%info(geoamv)%nlocal > 0) then
73
74 call da_read_errfac('geoamv', iv % geoamv_ef_u, iv % geoamv_ef_v, d1, d2, d3)
75
76 do n = 1, iv%info(geoamv)%nlocal
77 do k = 1, iv%info(geoamv)%levels(n)
78 iv % geoamv(n) % u(k) % error = iv % geoamv(n) % u(k) % error * iv % geoamv_ef_u
79 iv % geoamv(n) % v(k) % error = iv % geoamv(n) % v(k) % error * iv % geoamv_ef_v
80 end do
81 end do
82 end if
83
84 ! [2.4.2] Transfer Polar AMVs Obs:
85
86 if (iv%info(polaramv)%nlocal > 0) then
87
88 call da_read_errfac('polaramv', iv % polaramv_ef_u, iv % polaramv_ef_v, d1, d2, d3)
89
90 do n = 1, iv%info(polaramv)%nlocal
91 do k = 1, iv%info(polaramv)%levels(n)
92 iv % polaramv(n) % u(k) % error = iv % polaramv(n) % u(k) % error * iv % polaramv_ef_u
93 iv % polaramv(n) % v(k) % error = iv % polaramv(n) % v(k) % error * iv % polaramv_ef_v
94 end do
95 end do
96 end if
97
98
99 ! [2.5] Transfer gpspw obs:
100
101 if (iv%info(gpspw)%nlocal > 0) then
102
103 call da_read_errfac('gpspw', iv % gpspw_ef_tpw, d1, d2, d3, d4)
104
105 do n = 1, iv%info(gpspw)%nlocal
106 iv % gpspw(n) % tpw % error = iv % gpspw(n) % tpw % error * &
107 iv % gpspw_ef_tpw
108
109 end do
110 end if
111
112 ! [2.6] Transfer sonde obs:
113
114 if (iv%info(sound)%nlocal > 0) then
115
116 call da_read_errfac('sound', iv % sound_ef_u, iv % sound_ef_v, &
117 iv % sound_ef_t, iv % sound_ef_q, d1)
118
119 do n = 1, iv%info(sound)%nlocal
120 do k = 1, iv%info(sound)%levels(n)
121 iv % sound(n) % u(k) % error = iv % sound(n) % u(k) % error * &
122 iv % sound_ef_u
123 iv % sound(n) % v(k) % error = iv % sound(n) % v(k) % error * &
124 iv % sound_ef_v
125 iv % sound(n) % t(k) % error = iv % sound(n) % t(k) % error * &
126 iv % sound_ef_t
127 iv % sound(n) % q(k) % error = iv % sound(n) % q(k) % error * &
128 iv % sound_ef_q
129 end do
130
131 iv % sonde_sfc(n) % u % error = iv % sonde_sfc(n) % u % error * iv % synop_ef_u
132 iv % sonde_sfc(n) % v % error = iv % sonde_sfc(n) % v % error * iv % synop_ef_v
133 iv % sonde_sfc(n) % t % error = iv % sonde_sfc(n) % t % error * iv % synop_ef_t
134 iv % sonde_sfc(n) % p % error = iv % sonde_sfc(n) % p % error * iv % synop_ef_p
135 iv % sonde_sfc(n) % q % error = iv % sonde_sfc(n) % q % error * iv % synop_ef_q
136 end do
137 end if
138
139 ! [2.7] Transfer airep obs:
140
141 if (iv%info(airep)%nlocal > 0) then
142
143 call da_read_errfac('airep', iv % airep_ef_u, iv % airep_ef_v, &
144 iv % airep_ef_t, d1, d2)
145
146 do n = 1, iv%info(airep)%nlocal
147 do k = 1, iv%info(airep)%levels(n)
148 iv % airep(n) % u(k) % error = iv % airep(n) % u(k) % error * &
149 iv % airep_ef_u
150 iv % airep(n) % v(k) % error = iv % airep(n) % v(k) % error * &
151 iv % airep_ef_v
152 iv % airep(n) % t(k) % error = iv % airep(n) % t(k) % error * &
153 iv % airep_ef_t
154 end do
155 end do
156 end if
157
158 ! [2.8] Transfer pilot obs:
159
160 if (iv%info(pilot)%nlocal > 0) then
161
162 call da_read_errfac('pilot', iv % pilot_ef_u, iv % pilot_ef_v, d1, d2, d3)
163
164 do n = 1, iv%info(pilot)%nlocal
165 do k = 1, iv%info(pilot)%levels(n)
166 iv % pilot(n) % u(k) % error = iv % pilot(n) % u(k) % error * &
167 iv % pilot_ef_u
168 iv % pilot(n) % v(k) % error = iv % pilot(n) % v(k) % error * &
169 iv % pilot_ef_v
170
171 end do
172 end do
173 end if
174
175 ! [2.9] Transfer SSM/I obs:SSMI:
176
177 if (iv%info(ssmi_rv)%nlocal > 0) then
178
179 call da_read_errfac('ssmir', iv % ssmir_ef_speed, iv % ssmir_ef_tpw, d1, d2, d3)
180
181 do n = 1, iv%info(ssmi_rv)%nlocal
182 iv%ssmi_rv(n)%tpw%error = iv%ssmi_rv(n)%tpw%error * &
183 iv % ssmir_ef_tpw
184 iv%ssmi_rv(n)%speed%error = iv%ssmi_rv(n)%speed%error * &
185 iv % ssmir_ef_speed
186 end do
187 end if
188
189 if (iv%info(ssmi_tb)%nlocal > 0) then
190
191 ! iv % ssmit_ef_tb19h = 1.0 ! Tuning not yet coded.
192 ! iv % ssmit_ef_tb19v = 1.0 ! Tuning not yet coded.
193 ! iv % ssmit_ef_tb22v = 1.0 ! Tuning not yet coded.
194 ! iv % ssmit_ef_tb37h = 1.0 ! Tuning not yet coded.
195 ! iv % ssmit_ef_tb37v = 1.0 ! Tuning not yet coded.
196 ! iv % ssmit_ef_tb85h = 1.0 ! Tuning not yet coded.
197 ! iv % ssmit_ef_tb85v = 1.0 ! Tuning not yet coded.
198
199 ! do n = 1, iv%info(ssmi_tb)%nlocal
200 ! iv%ssmi_tb(n)%tb19h%error = iv%ssmi_tb(n)%tb19h%error
201 ! iv%ssmi_tb(n)%tb19v%error = iv%ssmi_tb(n)%tb19v%error
202 ! iv%ssmi_tb(n)%tb22v%error = iv%ssmi_tb(n)%tb22v%error
203 ! iv%ssmi_tb(n)%tb37h%error = iv%ssmi_tb(n)%tb37h%error * &
204 ! fac_ssmit_tb37h
205 ! iv%ssmi_tb(n)%tb37v%error = iv%ssmi_tb(n)%tb37v%error * &
206 ! fac_ssmit_tb37v
207 ! iv%ssmi_tb(n)%tb85h%error = iv%ssmi_tb(n)%tb85h%error * &
208 ! fac_ssmit_tb85h
209 ! iv%ssmi_tb(n)%tb85v%error = iv%ssmi_tb(n)%tb85v%error * &
210 ! fac_ssmit_tb85v
211 ! end do
212 end if
213
214 ! [2.10] Transfer satem obs:
215
216 if (iv%info(satem)%nlocal > 0) then
217 call da_read_errfac('satem', iv % satem_ef_thickness, d1, d2, d3, d4)
218
219 do n = 1, iv%info(satem)%nlocal
220 do k = 1, iv%info(satem)%levels(n)
221 iv % satem(n) % thickness(k) % error = iv % satem(n) % thickness(k) % error*&
222 iv % satem_ef_thickness
223 end do
224 end do
225 end if
226
227 ! [2.11] Transfer ssmt1 obs:
228
229 if (iv%info(ssmt1)%nlocal > 0) then
230 call da_read_errfac('ssmt1', iv % ssmt1_ef_t, d1, d2, d3, d4)
231
232 do n = 1, iv%info(ssmt1)%nlocal
233 do k = 1, iv%info(ssmt1)%levels(n)
234 iv % ssmt1(n) % t(k) % error = iv % ssmt1(n) % t(k) % error * &
235 iv % ssmt1_ef_t
236 end do
237 end do
238 end if
239
240 ! [2.12] Transfer ssmt2 obs:
241
242 if (iv%info(ssmt2)%nlocal > 0) then
243 call da_read_errfac('ssmt2', iv % ssmt2_ef_rh, d1, d2, d3, d4)
244
245 do n = 1, iv%info(ssmt2)%nlocal
246 do k = 1, iv%info(ssmt2)%levels(n)
247 iv % ssmt2(n) % rh(k) % error = iv % ssmt2(n) % rh(k) % error * &
248 iv % ssmt2_ef_rh
249 end do
250 end do
251 end if
252
253 ! [2.13] Transfer scatterometer obs:
254
255 if (iv%info(qscat)%nlocal > 0) then
256 call da_read_errfac('qscat', iv % qscat_ef_u, &
257 iv % qscat_ef_v, d1, d2, d3)
258
259 do n = 1, iv%info(qscat)%nlocal
260 iv % qscat(n) % u % error = iv % qscat(n) % u % error * iv % qscat_ef_u
261 iv % qscat(n) % v % error = iv % qscat(n) % v % error * iv % qscat_ef_v
262 end do
263 end if
264
265 ! [2.14] Transfer profiler obs:
266
267 if (iv%info(profiler)%nlocal > 0) then
268 call da_read_errfac('profi', iv % profiler_ef_u, iv % profiler_ef_v, d1, d2, d3)
269
270 do n = 1, iv%info(profiler)%nlocal
271 do k = 1, iv%info(profiler)%levels(n)
272 iv % profiler(n) % u(k) % error = iv % profiler(n) % u(k) % error * &
273 iv % profiler_ef_u
274 iv % profiler(n) % v(k) % error = iv % profiler(n) % v(k) % error * &
275 iv % profiler_ef_v
276
277 end do
278 end do
279 end if
280
281 ! [2.15] Transfer buoy obs:
282
283 if (iv%info(buoy)%nlocal > 0) then
284 call da_read_errfac('buoy ', iv % buoy_ef_u, &
285 iv % buoy_ef_v, iv % buoy_ef_t, &
286 iv % buoy_ef_p, iv % buoy_ef_q)
287
288 do n = 1, iv%info(buoy)%nlocal
289 iv % buoy(n) % u % error = iv % buoy(n) % u % error * iv % buoy_ef_u
290 iv % buoy(n) % v % error = iv % buoy(n) % v % error * iv % buoy_ef_v
291 iv % buoy(n) % t % error = iv % buoy(n) % t % error * iv % buoy_ef_t
292 iv % buoy(n) % p % error = iv % buoy(n) % p % error * iv % buoy_ef_p
293 iv % buoy(n) % q % error = iv % buoy(n) % q % error * iv % buoy_ef_q
294 end do
295 end if
296
297 ! [2.16] Transfer TC bogus obs:
298
299 if (iv%info(bogus)%nlocal > 0) then
300 call da_read_errfac('bogus', iv % bogus_ef_u, iv % bogus_ef_v, &
301 iv % bogus_ef_t, iv % bogus_ef_q, iv % bogus_ef_slp)
302
303 do n = 1, iv%info(bogus)%nlocal
304 do k = 1, iv%info(bogus)%levels(n)
305 iv % bogus(n) % u(k) % error = iv % bogus(n) % u(k) % error * &
306 iv % bogus_ef_u
307 iv % bogus(n) % v(k) % error = iv % bogus(n) % v(k) % error * &
308 iv % bogus_ef_v
309 iv % bogus(n) % t(k) % error = iv % bogus(n) % t(k) % error * &
310 iv % bogus_ef_t
311 iv % bogus(n) % q(k) % error = iv % bogus(n) % q(k) % error * &
312 iv % bogus_ef_q
313
314 end do
315
316 iv % bogus(n) % slp % error = iv % bogus(n) % slp % error * iv % bogus_ef_slp
317 end do
318 end if
319
320 ! Transfer AIRS retrievals:
321
322 if (iv%info(airsr)%nlocal > 0) then
323 call da_read_errfac('airsr', iv % airsr_ef_t, iv % airsr_ef_q, d1, d3, d3)
324
325 do n = 1, iv%info(airsr)%nlocal
326 do k = 1, iv%info(airsr)%levels(n)
327 iv % airsr(n) % t(k) % error = iv % airsr(n) % t(k) % error * &
328 iv % airsr_ef_t
329 iv % airsr(n) % q(k) % error = iv % airsr(n) % q(k) % error * &
330 iv % airsr_ef_q
331 end do
332 end do
333 end if
334
335 if (trace_use) call da_trace_exit("da_use_obs_errfac")
336
337 end subroutine da_use_obs_errfac
338
339