da_add_noise_to_ob.inc
References to this file elsewhere.
1 subroutine da_add_noise_to_ob( iv, ob )
2 !----------------------------------------------------------------------------
3 ! History:
4 !
5 ! Additions:
6 ! 07/08/2003 - Profiler and Buoy Obs Syed RH Rizvi
7 ! 03/08/2006 Add radiance part Zhiquan Liu
8 ! 06/23/2006 - MPI update Syed RH Rizvi
9 ! 07/03/2006 - update for AIRS retrievals Syed RH Rizvi
10 !
11 ! Purpose: Allocates observation structure and fills it fro iv.
12 !----------------------------------------------------------------------------
13
14 implicit none
15
16
17 type (iv_type), intent(inout) :: iv ! Obs and header structure.
18 type (y_type), intent(inout) :: ob ! (Smaller) observation structure.
19
20 real :: z1, z2, z3, z4, z5, z6, z7, dum ! Random numbers.
21 integer :: n, k, i ! Loop counters.
22 integer :: ounit ! Output unit
23 integer :: num_obs, ios
24 character(len=20) :: ob_name, filename
25
26 if (trace_use_dull) call da_trace_entry("da_add_noise_to_ob")
27
28 !----------------------------------------------------------------------------
29 ! Fix output unit
30 !----------------------------------------------------------------------------
31 call da_get_unit(ounit)
32
33 dum = -999999.9
34 !----------------------------------------------------------------------
35 ! [1.0] Initiate random number sequence:
36 !----------------------------------------------------------------------
37
38 call da_random_seed
39
40 !----------------------------------------------------------------------
41 ! [2.0] Create noise and output:
42 !----------------------------------------------------------------------
43 #ifdef DM_PARALLEL
44 write(unit=filename, fmt='(a,i3.3)') 'rand_obs_error.', myproc
45 #else
46 write(unit=filename, fmt='(a)') 'rand_obs_error.000'
47 #endif
48
49 open(unit=ounit,file=trim(filename),form='formatted',iostat=ios)
50 if (ios /= 0 ) then
51 call da_error(__FILE__,__LINE__, &
52 (/"Cannot open random observation error file"//filename/))
53 Endif
54
55 ! [2.1] Transfer surface obs:
56
57 if ( iv%info(synop)%nlocal > 0 ) then
58 num_obs = 0
59 do n = 1, iv%info(synop)%nlocal
60 if(iv%info(synop)%proc_domain(1,n)) num_obs = num_obs + 1
61 end do
62 write(ounit,'(a20,i8)')'synop', num_obs
63 num_obs = 0
64
65 do n = 1, iv%info(synop)%nlocal
66 if(iv%info(synop)%proc_domain(1,n)) then
67 num_obs = num_obs + 1
68 write(ounit,'(i8)') 1
69 ! Add random perturbation:
70 call da_add_noise( iv % synop(n) % u, ob % synop(n) % u, z1 )
71 call da_add_noise( iv % synop(n) % v, ob % synop(n) % v, z2 )
72 call da_add_noise( iv % synop(n) % t, ob % synop(n) % t, z3 )
73 call da_add_noise( iv % synop(n) % p, ob % synop(n) % p, z4 )
74 call da_add_noise( iv % synop(n) % q, ob % synop(n) % q, z5 )
75
76 ! Write out data:
77 write(ounit,'(2i8,10e15.7)')num_obs, 1, iv % synop(n) % u % error, z1, &
78 iv % synop(n) % v % error, z2, &
79 iv % synop(n) % t % error, z3, &
80 iv % synop(n) % p % error, z4, &
81 iv % synop(n) % q % error, z5
82 end if
83 end do
84 end if
85
86 ! [2.2] Transfer metar obs:
87
88 if ( iv%info(metar)%nlocal > 0 ) then
89 num_obs = 0
90 do n = 1, iv%info(metar)%nlocal
91 if(iv%info(metar)%proc_domain(1,n)) num_obs = num_obs + 1
92 end do
93 write(ounit,'(a20,i8)')'metar', num_obs
94 num_obs = 0
95 do n = 1, iv%info(metar)%nlocal
96 if(iv%info(metar)%proc_domain(1,n)) then
97 num_obs = num_obs + 1
98 write(ounit,'(i8)') 1
99 ! Add random perturbation:
100 call da_add_noise( iv % metar(n) % u, ob % metar(n) % u, z1 )
101 call da_add_noise( iv % metar(n) % v, ob % metar(n) % v, z2 )
102 call da_add_noise( iv % metar(n) % t, ob % metar(n) % t, z3 )
103 call da_add_noise( iv % metar(n) % p, ob % metar(n) % p, z4 )
104 call da_add_noise( iv % metar(n) % q, ob % metar(n) % q, z5 )
105
106 ! Write out data:
107 write(ounit,'(2i8,10e15.7)')num_obs, 1, &
108 iv % metar(n) % u % error, z1, &
109 iv % metar(n) % v % error, z2, &
110 iv % metar(n) % t % error, z3, &
111 iv % metar(n) % p % error, z4, &
112 iv % metar(n) % q % error, z5
113 end if
114 end do
115 end if
116
117 ! [2.3] Transfer ships obs:
118
119 if ( iv%info(ships)%nlocal > 0 ) then
120 num_obs = 0
121 do n = 1, iv%info(ships)%nlocal
122 if(iv%info(ships)%proc_domain(1,n)) num_obs = num_obs + 1
123 end do
124 write(ounit,'(a20,i8)')'ships', num_obs
125 num_obs = 0
126 do n = 1, iv%info(ships)%nlocal
127 if(iv%info(ships)%proc_domain(1,n)) then
128 num_obs = num_obs + 1
129 write(ounit,'(i8)') 1
130 ! Add random perturbation:
131 call da_add_noise( iv % ships(n) % u, ob % ships(n) % u, z1 )
132 call da_add_noise( iv % ships(n) % v, ob % ships(n) % v, z2 )
133 call da_add_noise( iv % ships(n) % t, ob % ships(n) % t, z3 )
134 call da_add_noise( iv % ships(n) % p, ob % ships(n) % p, z4 )
135 call da_add_noise( iv % ships(n) % q, ob % ships(n) % q, z5 )
136 ! Write out data:
137 write(ounit,'(2i8,10e15.7)')num_obs, 1, &
138 iv % ships(n) % u % error, z1, &
139 iv % ships(n) % v % error, z2, &
140 iv % ships(n) % t % error, z3, &
141 iv % ships(n) % p % error, z4, &
142 iv % ships(n) % q % error, z5
143 end if
144 end do
145 end if
146
147
148 ! [2.4.1] Transfer Geostationary AMVs obs:
149
150 if ( iv%info(geoamv)%nlocal > 0 ) then
151 num_obs = 0
152 do n = 1, iv%info(geoamv)%nlocal
153 if(iv%info(geoamv)%proc_domain(1,n)) num_obs = num_obs + 1
154 end do
155 write(ounit,'(a20,i8)')'geoamv', num_obs
156 num_obs = 0
157 do n = 1, iv%info(geoamv)%nlocal
158 if(iv%info(geoamv)%proc_domain(1,n)) then
159 num_obs = num_obs + 1
160 write(ounit,'(i8)')iv%info(geoamv)%levels(n)
161 do k = 1, iv%info(geoamv)%levels(n)
162 ! Add random perturbation:
163 call da_add_noise( iv % geoamv(n) % u(k), ob % geoamv(n) % u(k), z1)
164 call da_add_noise( iv % geoamv(n) % v(k), ob % geoamv(n) % v(k), z2)
165
166 ! Write out data:
167 write(ounit,'(2i8,10e15.7)')num_obs, k, &
168 iv % geoamv(n) % u(k) % error, z1, &
169 iv % geoamv(n) % v(k) % error, z2, &
170 dum, dum, dum, dum, dum, dum
171 end do
172 end if
173 end do
174 end if
175
176 ! [2.4.2] Transfer Polar AMVs obs:
177
178 if ( iv%info(polaramv)%nlocal > 0 ) then
179 num_obs = 0
180 do n = 1, iv%info(polaramv)%nlocal
181 if (iv%info(polaramv)%proc_domain(1,n)) num_obs = num_obs + 1
182 end do
183 write(ounit,'(a20,i8)')'polaramv', num_obs
184 num_obs = 0
185 do n = 1, iv%info(polaramv)%nlocal
186 if (iv%info(polaramv)%proc_domain(1,n)) then
187 num_obs = num_obs + 1
188 write(ounit,'(i8)')iv%info(polaramv)%levels(n)
189 do k = 1, iv%info(polaramv)%levels(n)
190 ! Add random perturbation:
191 call da_add_noise( iv % polaramv(n) % u(k), ob % polaramv(n) % u(k), z1)
192 call da_add_noise( iv % polaramv(n) % v(k), ob % polaramv(n) % v(k), z2)
193
194 ! Write out data:
195 write(ounit,'(2i8,10e15.7)')num_obs, k, &
196 iv % polaramv(n) % u(k) % error, z1, &
197 iv % polaramv(n) % v(k) % error, z2, &
198 dum, dum, dum, dum, dum, dum
199 end do
200 end if
201 end do
202 end if
203
204 ! [2.5] Transfer gpspw obs:
205
206 if ( iv%info(gpspw)%nlocal > 0 ) then
207 num_obs = 0
208 do n = 1, iv%info(gpspw)%nlocal
209 if(iv%info(gpspw)%proc_domain(1,n)) num_obs = num_obs + 1
210 end do
211 write(ounit,'(a20,i8)')'gpspw', num_obs
212 num_obs = 0
213 do n = 1, iv%info(gpspw)%nlocal
214 if(iv%info(gpspw)%proc_domain(1,n)) then
215 num_obs = num_obs + 1
216 write(ounit,'(i8)') 1
217 ! Add random perturbation:
218 call da_add_noise( iv % gpspw(n) % tpw, ob % gpspw(n) % tpw, z1 )
219
220 ! Write out data:
221 write(ounit,'(2i8,10e15.7)')num_obs, 1, iv % gpspw(n) % tpw % error, z1, &
222 dum, dum, dum, dum, dum, dum, dum, dum
223 end if
224 end do
225 end if
226
227 ! [2.6] Transfer sonde obs:
228
229 if ( iv%info(sound)%nlocal > 0 ) then
230 num_obs = 0
231 do n = 1, iv%info(sound)%nlocal
232 if(iv%info(sound)%proc_domain(1,n)) num_obs = num_obs + 1
233 end do
234 write(ounit,'(a20,i8)')'sound', num_obs
235 num_obs = 0
236 do n = 1, iv%info(sound)%nlocal
237 if(iv%info(sound)%proc_domain(1,n)) then
238 num_obs = num_obs + 1
239 write(ounit,'(i8)')iv%info(sound)%levels(n)
240 do k = 1, iv%info(sound)%levels(n)
241 ! Add random perturbation:
242 call da_add_noise( iv % sound(n) % u(k), ob % sound(n) % u(k), z1)
243 call da_add_noise( iv % sound(n) % v(k), ob % sound(n) % v(k), z2)
244 call da_add_noise( iv % sound(n) % t(k), ob % sound(n) % t(k), z3)
245 call da_add_noise( iv % sound(n) % q(k), ob % sound(n) % q(k), z4)
246
247 ! Write out data:
248 write(ounit,'(2i8,10e15.7)')num_obs, k, &
249 iv % sound(n) % u(k) % error, z1, &
250 iv % sound(n) % v(k) % error, z2, &
251 iv % sound(n) % t(k) % error, z3, &
252 iv % sound(n) % q(k) % error, z4, &
253 dum, dum
254 end do
255 end if
256 end do
257 ! Now do surface level
258 num_obs = 0
259 do n = 1, iv%info(sound)%nlocal
260 if(iv%info(sound)%proc_domain(1,n)) num_obs = num_obs + 1
261 end do
262 write(ounit,'(a20,i8)')'sonde_sfc', num_obs
263 num_obs = 0
264 do n = 1, iv%info(sound)%nlocal
265 if(iv%info(sound)%proc_domain(1,n)) then
266 num_obs = num_obs + 1
267 write(ounit,'(i8)') 1
268 ! Add random perturbation:
269 call da_add_noise( iv % sonde_sfc(n) % u, ob % sonde_sfc(n) % u, z1 )
270 call da_add_noise( iv % sonde_sfc(n) % v, ob % sonde_sfc(n) % v, z2 )
271 call da_add_noise( iv % sonde_sfc(n) % t, ob % sonde_sfc(n) % t, z3 )
272 call da_add_noise( iv % sonde_sfc(n) % p, ob % sonde_sfc(n) % p, z4 )
273 call da_add_noise( iv % sonde_sfc(n) % q, ob % sonde_sfc(n) % q, z5 )
274
275 ! Write out data:
276 write(ounit,'(2i8,10e15.7)')num_obs, 1, iv % sonde_sfc(n) % u % error, z1, &
277 iv % sonde_sfc(n) % v % error, z2, &
278 iv % sonde_sfc(n) % t % error, z3, &
279 iv % sonde_sfc(n) % p % error, z4, &
280 iv % sonde_sfc(n) % q % error, z5
281 end if
282 end do
283 end if
284
285 ! [2.7] Transfer airep obs:
286
287 if ( iv%info(airep)%nlocal > 0 ) then
288 num_obs = 0
289 do n = 1, iv%info(airep)%nlocal
290 if (iv%info(airep)%proc_domain(1,n)) num_obs = num_obs + 1
291 end do
292 write(ounit,'(a20,i8)')'airep', num_obs
293 num_obs = 0
294 do n = 1, iv%info(airep)%nlocal
295 if (iv%info(airep)%proc_domain(1,n)) then
296 num_obs = num_obs + 1
297 write(ounit,'(i8)')iv%info(airep)%levels(n)
298 do k = 1, iv%info(airep)%levels(n)
299 ! Add random perturbation:
300 call da_add_noise( iv % airep(n) % u(k), ob % airep(n) % u(k), z1)
301 call da_add_noise( iv % airep(n) % v(k), ob % airep(n) % v(k), z2)
302 call da_add_noise( iv % airep(n) % t(k), ob % airep(n) % t(k), z3)
303
304 ! Write out data:
305 write(ounit,'(2i8,10e15.7)')num_obs, k, &
306 iv % airep(n) % u(k) % error, z1, &
307 iv % airep(n) % v(k) % error, z2, &
308 iv % airep(n) % t(k) % error, z3, &
309 dum, dum, dum, dum
310 end do
311 end if
312 end do
313 end if
314
315 ! [2.8] Transfer pilot obs:
316
317 if ( iv%info(pilot)%nlocal > 0 ) then
318 num_obs = 0
319 do n = 1, iv%info(pilot)%nlocal
320 if(iv%info(pilot)%proc_domain(1,n)) num_obs = num_obs + 1
321 end do
322 write(ounit,'(a20,i8)')'pilot', num_obs
323 num_obs = 0
324 do n = 1, iv%info(pilot)%nlocal
325 if(iv%info(pilot)%proc_domain(1,n)) then
326 num_obs = num_obs + 1
327 write(ounit,'(i8)') iv%info(pilot)%levels(n)
328 do k = 1, iv%info(pilot)%levels(n)
329 ! Add random perturbation:
330 call da_add_noise( iv % pilot(n) % u(k), ob % pilot(n) % u(k), z1)
331 call da_add_noise( iv % pilot(n) % v(k), ob % pilot(n) % v(k), z2)
332
333 ! Write out data:
334 write(ounit,'(2i8,10e15.7)')num_obs, k, &
335 iv % pilot(n) % u(k) % error, z1, &
336 iv % pilot(n) % v(k) % error, z2, &
337 dum, dum, dum, dum, dum, dum
338 end do
339 end if
340 end do
341 end if
342
343 ! [2.9] Transfer SSM/I obs:SSMI:
344
345 if ( iv%info(ssmi_rv)%nlocal > 0 ) then
346 num_obs = 0
347 do n = 1, iv%info(ssmi_rv)%nlocal
348 if(iv%info(ssmi_rv)%proc_domain(1,n)) num_obs = num_obs + 1
349 end do
350 write(ounit,'(a20,i8)')'ssmir', num_obs
351 num_obs = 0
352 do n = 1, iv%info(ssmi_rv)%nlocal
353 if(iv%info(ssmi_rv)%proc_domain(1,n)) then
354 num_obs = num_obs + 1
355 write(ounit,'(i8)') 1
356
357 ! Add random perturbation:
358 call da_add_noise( iv % ssmi_rv(n) % speed, &
359 ob % ssmi_rv(n) % speed, z1 )
360 call da_add_noise( iv % ssmi_rv(n) % tpw, &
361 ob % ssmi_rv(n) % tpw, z2 )
362 ! Write out data:
363 write(ounit,'(2i8,10e15.7)')num_obs, 1, &
364 iv % ssmi_rv(n) % speed % error, z1, &
365 iv % ssmi_rv(n) % tpw % error, z2, &
366 dum, dum, dum, dum, dum, dum
367 end if
368 end do
369 end if
370
371 if ( iv%info(ssmi_tb)%nlocal > 0 ) then
372 num_obs = 0
373 do n = 1, iv%info(ssmi_tb)%nlocal
374 if(iv%info(ssmi_tb)%proc_domain(1,n)) num_obs = num_obs + 1
375 end do
376 write(ounit,'(a20,i8)')'ssmiT', num_obs
377 num_obs = 0
378 do n = 1, iv%info(ssmi_tb)%nlocal
379 if(iv%info(ssmi_tb)%proc_domain(1,n)) then
380 num_obs = num_obs + 1
381 ! Add random perturbation:
382 call da_add_noise( iv % ssmi_tb(n) % tb19h, &
383 ob % ssmi_tb(n) % tb19h, z1)
384 call da_add_noise( iv % ssmi_tb(n) % tb19v, &
385 ob % ssmi_tb(n) % tb19v, z2)
386 call da_add_noise( iv % ssmi_tb(n) % tb22v, &
387 ob % ssmi_tb(n) % tb22v, z3)
388 call da_add_noise( iv % ssmi_tb(n) % tb37h, &
389 ob % ssmi_tb(n) % tb37h, z4)
390 call da_add_noise( iv % ssmi_tb(n) % tb37v, &
391 ob % ssmi_tb(n) % tb37v, z5)
392 call da_add_noise( iv % ssmi_tb(n) % tb85h, &
393 ob % ssmi_tb(n) % tb85h, z6)
394 call da_add_noise( iv % ssmi_tb(n) % tb85v, &
395 ob % ssmi_tb(n) % tb85v, z7)
396
397 ! Write out data:
398 write(ounit,'(i8)') 1
399 write(ounit,'(2i8,14e15.7)')num_obs, 1, &
400 iv % ssmi_tb(n) % tb19h % error, z1, &
401 iv % ssmi_tb(n) % tb19v % error, z2, &
402 iv % ssmi_tb(n) % tb22v % error, z3, &
403 iv % ssmi_tb(n) % tb37h % error, z4, &
404 iv % ssmi_tb(n) % tb37v % error, z5, &
405 iv % ssmi_tb(n) % tb85h % error, z6, &
406 iv % ssmi_tb(n) % tb85v % error, z7
407 end if
408 end do
409 end if
410
411 ! [2.10] Transfer satem obs:
412
413 if ( iv%info(satem)%nlocal > 0 ) then
414 num_obs = 0
415 do n = 1, iv%info(satem)%nlocal
416 if(iv%info(satem)%proc_domain(1,n)) num_obs = num_obs + 1
417 end do
418 write(ounit,'(a20,i8)')'satem', num_obs
419 num_obs = 0
420 do n = 1, iv%info(satem)%nlocal
421 if(iv%info(satem)%proc_domain(1,n)) then
422 num_obs = num_obs + 1
423 write(ounit,'(i8)')iv%info(satem)%levels(n)
424 do k = 1, iv%info(satem)%levels(n)
425 ! Add random perturbation:
426 call da_add_noise( iv % satem(n) % thickness(k), &
427 ob % satem(n) % thickness(k), z1 )
428 ! Write out data:
429 write(ounit,'(2i8,10e15.7)')num_obs, k, &
430 iv % satem(n) % thickness(k) % error, z1, &
431 dum, dum, dum, dum, dum, dum, dum, dum
432 end do
433 end if
434 end do
435 end if
436
437 ! [2.11] Transfer ssmt1 obs:
438
439 if ( iv%info(ssmt1)%nlocal > 0 ) then
440 num_obs = 0
441 do n = 1, iv%info(ssmt1)%nlocal
442 if(iv%info(ssmt1)%proc_domain(1,n)) num_obs = num_obs + 1
443 end do
444 write(ounit,'(a20,i8)')'ssmt1', num_obs
445 num_obs = 0
446
447 do n = 1, iv%info(ssmt1)%nlocal
448 if(iv%info(ssmt1)%proc_domain(1,n)) then
449 num_obs = num_obs + 1
450 write(ounit,'(i8)')iv%info(ssmt1)%levels(n)
451
452 do k = 1, iv%info(ssmt1)%levels(n)
453
454 ! Add random perturbation:
455 call da_add_noise( iv % ssmt1(n) % t(k), &
456 ob % ssmt1(n) % t(k), z1 )
457 ! Write out data:
458 write(ounit,'(2i8,10e15.7)')num_obs, k, iv % ssmt1(n) % t(k) % error, z1, &
459 dum, dum, dum, dum, dum, dum, dum, dum
460 end do
461 end if
462 end do
463 end if
464
465 ! [2.12] Transfer ssmt2 obs:
466
467 if ( iv%info(ssmt2)%nlocal > 0 ) then
468 num_obs = 0
469 do n = 1, iv%info(ssmt2)%nlocal
470 if(iv%info(ssmt2)%proc_domain(1,n)) num_obs = num_obs + 1
471 end do
472 write(ounit,'(a20,i8)')'ssmt2', num_obs
473 num_obs = 0
474
475 do n = 1, iv%info(ssmt2)%nlocal
476 if(iv%info(ssmt2)%proc_domain(1,n)) then
477 num_obs = num_obs + 1
478 write(ounit,'(i8)')iv%info(ssmt2)%levels(n)
479
480 do k = 1, iv%info(ssmt2)%levels(n)
481
482 ! Add random perturbation:
483 call da_add_noise( iv % ssmt2(n) % rh(k), &
484 ob % ssmt2(n) % rh(k), z1 )
485 ! Write out data:
486 write(ounit,'(2i8,10e15.7)')num_obs, k, iv % ssmt2(n) % rh(k) % error, z1, &
487 dum, dum, dum, dum, dum, dum, dum, dum
488 end do
489 end if
490 end do
491 end if
492
493 ! [2.13] Transfer scatterometer obs:
494
495 if ( iv%info(qscat)%nlocal > 0 ) then
496 num_obs = 0
497 do n = 1, iv%info(qscat)%nlocal
498 if(iv%info(qscat)%proc_domain(1,n)) num_obs = num_obs + 1
499 end do
500 write(ounit,'(a20,i8)')'qscat', num_obs
501 num_obs = 0
502 do n = 1, iv%info(qscat)%nlocal
503 if(iv%info(qscat)%proc_domain(1,n)) then
504 num_obs = num_obs + 1
505 write(ounit,'(i8)') 1
506 ! Add random perturbation:
507 call da_add_noise( iv % qscat(n) % u, ob % qscat(n) % u, z1 )
508 call da_add_noise( iv % qscat(n) % v, ob % qscat(n) % v, z2 )
509
510 ! Write out data:
511 write(ounit,'(2i8,10e15.7)')num_obs, 1, &
512 iv % qscat(n) % u % error, z1, &
513 iv % qscat(n) % v % error, z2, &
514 dum, dum, dum, dum, dum, dum
515 end if
516 end do
517 end if
518
519 ! [2.14] Transfer buoy obs:
520
521 if ( iv%info(buoy)%nlocal > 0 ) then
522 num_obs = 0
523 do n = 1, iv%info(buoy)%nlocal
524 if(iv%info(buoy)%proc_domain(1,n)) num_obs = num_obs + 1
525 end do
526 write(ounit,'(a20,i8)')'buoy', num_obs
527 num_obs = 0
528 do n = 1, iv%info(buoy)%nlocal
529 if(iv%info(buoy)%proc_domain(1,n)) then
530 num_obs = num_obs + 1
531 write(ounit,'(i8)') 1
532 ! Add random perturbation:
533 call da_add_noise( iv % buoy(n) % u, ob % buoy(n) % u, z1 )
534 call da_add_noise( iv % buoy(n) % v, ob % buoy(n) % v, z2 )
535 call da_add_noise( iv % buoy(n) % t, ob % buoy(n) % t, z3 )
536 call da_add_noise( iv % buoy(n) % p, ob % buoy(n) % p, z4 )
537 call da_add_noise( iv % buoy(n) % q, ob % buoy(n) % q, z5 )
538
539 ! Write out data:
540 write(ounit,'(2i8,10e15.7)')num_obs, 1, &
541 iv % buoy(n) % u % error, z1, &
542 iv % buoy(n) % v % error, z2, &
543 iv % buoy(n) % t % error, z3, &
544 iv % buoy(n) % p % error, z4, &
545 iv % buoy(n) % q % error, z5
546 end if
547 end do
548 end if
549
550 ! [2.15] Transfer profiler obs:
551
552 if ( iv%info(profiler)%nlocal > 0 ) then
553 num_obs = 0
554 do n = 1, iv%info(profiler)%nlocal
555 if(iv%info(profiler)%proc_domain(1,n)) num_obs = num_obs + 1
556 end do
557 write(ounit,'(a20,i8)')'profiler', num_obs
558 num_obs = 0
559 do n = 1, iv%info(profiler)%nlocal
560 if(iv%info(profiler)%proc_domain(1,n)) then
561 num_obs = num_obs + 1
562 write(ounit,'(i8)')iv%info(profiler)%levels(n)
563 do k = 1, iv%info(profiler)%levels(n)
564 ! Add random perturbation:
565 call da_add_noise( iv % profiler(n) % u(k), ob % profiler(n) % u(k), z1)
566 call da_add_noise( iv % profiler(n) % v(k), ob % profiler(n) % v(k), z2)
567 ! Write out data:
568 write(ounit,'(2i8,10e15.7)')num_obs, k, &
569 iv % profiler(n) % u(k) % error, z1, &
570 iv % profiler(n) % v(k) % error, z2, &
571 dum, dum, dum, dum, dum, dum
572 end do
573 end if
574 end do
575 end if
576
577 ! [2.16] Transfer TC bogus obs:
578
579 if ( iv%info(bogus)%nlocal > 0 ) then
580 num_obs = 0
581 do n = 1, iv%info(bogus)%nlocal
582 if(iv%info(bogus)%proc_domain(1,n)) num_obs = num_obs + 1
583 end do
584 write(ounit,'(a20,i8)')'bogus', num_obs
585 num_obs = 0
586
587 do n = 1, iv%info(bogus)%nlocal
588 if(iv%info(bogus)%proc_domain(1,n)) then
589 num_obs = num_obs + 1
590 write(ounit,'(i8)') 1
591 call da_add_noise( iv % bogus(n) % slp, ob % bogus(n) % slp, z1 )
592 write(ounit,'(2i8,10e15.7)')num_obs, 1, &
593 iv % bogus(n) % slp % error, z1, &
594 dum, dum, dum, dum, dum, dum, dum, dum
595
596 write(ounit,'(i8)')iv%info(bogus)%levels(n)
597 do k = 1, iv%info(bogus)%levels(n)
598 ! Add random perturbation:
599 call da_add_noise( iv % bogus(n) % u(k), ob % bogus(n) % u(k), z1)
600 call da_add_noise( iv % bogus(n) % v(k), ob % bogus(n) % v(k), z2)
601 call da_add_noise( iv % bogus(n) % t(k), ob % bogus(n) % t(k), z3)
602 call da_add_noise( iv % bogus(n) % q(k), ob % bogus(n) % q(k), z4)
603
604 ! Write out data:
605 write(ounit,'(2i8,10e15.7)')num_obs, k, &
606 iv % bogus(n) % u(k) % error, z1, &
607 iv % bogus(n) % v(k) % error, z2, &
608 iv % bogus(n) % t(k) % error, z3, &
609 iv % bogus(n) % q(k) % error, z4, &
610 dum, dum
611 end do
612 end if
613 end do
614 end if
615 !
616 ! Transfer AIRS retrievals:
617 !
618 if ( iv%info(airsr)%nlocal > 0 ) then
619 num_obs = 0
620 do n = 1, iv%info(airsr)%nlocal
621 if(iv%info(airsr)%proc_domain(1,n)) num_obs = num_obs + 1
622 end do
623 write(ounit,'(a20,i8)')'airsr', num_obs
624 num_obs = 0
625 do n = 1, iv%info(airsr)%nlocal
626 if(iv%info(airsr)%proc_domain(1,n)) then
627 num_obs = num_obs + 1
628 write(ounit,'(i8)')iv%info(airsr)%levels(n)
629 do k = 1, iv%info(airsr)%levels(n)
630 ! Add random perturbation:
631 call da_add_noise( iv % airsr(n) % t(k), ob % airsr(n) % t(k), z1)
632 call da_add_noise( iv % airsr(n) % q(k), ob % airsr(n) % q(k), z2)
633
634 ! Write out data:
635 write(ounit,'(2i8,10e15.7)')num_obs, k, &
636 iv % airsr(n) % t(k) % error, z1, &
637 iv % airsr(n) % q(k) % error, z2, &
638 dum, dum, dum, dum, dum, dum
639 end do
640 end if
641 end do
642 end if
643
644 ! Transfer gpsref obs:
645
646 if ( iv%info(gpsref)%nlocal > 0 ) then
647 num_obs = 0
648 do n = 1, iv%info(gpsref)%nlocal
649 if(iv%info(gpsref)%proc_domain(1,n)) num_obs = num_obs + 1
650 end do
651 write(ounit,'(a20,i8)')'gpsref', num_obs
652 num_obs = 0
653 do n = 1, iv%info(gpsref)%nlocal
654 if(iv%info(gpsref)%proc_domain(1,n)) then
655 num_obs = num_obs + 1
656 write(ounit,'(i8)')iv%info(gpsref)%levels(n)
657 do k = 1, iv%info(gpsref)%levels(n)
658 ! Add random perturbation:
659 call da_add_noise( iv % gpsref(n) % ref(k), ob % gpsref(n) % ref(k), z1)
660 ! Write out data:
661 write(ounit,'(2i8,10e15.7)')num_obs, k, &
662 iv % gpsref(n) % ref(k) % error, z1, &
663 dum, dum, dum, dum, dum, dum, dum, dum
664 end do
665 end if
666 end do
667 end if
668
669
670 !
671 ! Transfer Radiance obs:
672 !
673
674 if ( iv%num_inst > 0 ) then
675 do i = 1, iv%num_inst ! loop for sensor
676 if ( iv%instid(i)%num_rad < 1 ) cycle
677 do k = 1,iv%instid(i)%nchan ! loop for channel
678 ! Counting number of obs for channle k
679 num_obs = 0
680 do n = 1,iv%instid(i)%num_rad ! loop for pixel
681 if(iv%instid(i)%info%proc_domain(1,n) .and. &
682 (iv%instid(i)%tb_qc(k,n) >= obs_qc_pointer)) then
683 num_obs = num_obs + 1
684 end if
685 end do ! end loop for pixel
686 if (num_obs < 1) cycle
687
688 write(ob_name,'(a,a,i4.4)') trim(iv%instid(i)%rttovid_string),'-',k
689 write(ounit,'(a20,i8)') ob_name,num_obs
690
691 num_obs = 0
692 do n= 1, iv%instid(i)%num_rad ! loop for pixel
693 if(iv%instid(i)%info%proc_domain(1,n) .and. &
694 (iv%instid(i)%tb_qc(k,n) >= obs_qc_pointer)) then
695 num_obs = num_obs + 1
696 call da_add_noise_new( iv%instid(i)%tb_qc(k,n), &
697 iv%instid(i)%tb_error(k,n), &
698 iv%instid(i)%tb_inv(k,n), &
699 ob%instid(i)%tb(k,n), z1)
700
701 write(ounit,'(2i8,f10.3,e15.7)') num_obs, 1, &
702 iv%instid(i)%tb_error(k,n), z1
703 end if
704 end do ! end loop for pixel
705 end do ! end loop for channel
706 end do ! end loop for sensor
707 end if
708
709 close (ounit)
710 call da_free_unit(ounit)
711
712 if (trace_use_dull) call da_trace_exit("da_add_noise_to_ob")
713
714 end subroutine da_add_noise_to_ob
715
716