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