da_read_iv_for_multi_inc.inc
References to this file elsewhere.
1 subroutine da_read_iv_for_multi_inc(file_index, iv)
2
3 !-----------------------------------------------------------------------
4 ! Purpose: Read for Multi-incremental
5 !-----------------------------------------------------------------------
6
7 !-------------------------------------------------------------------------
8 ! read iv=O-B structure written by WRFVAR
9 !-------------------------------------------------------------------------
10
11 implicit none
12
13 type (iv_type), intent(inout) :: iv ! O-B structure.
14 integer, intent(in) :: file_index
15 integer :: unit_in
16 character(len=filename_len) :: filename
17
18 integer :: num_obs, ios
19 character*20 :: ob_type_string
20
21 integer :: n, gn
22 logical :: found_flag
23
24 if (trace_use) call da_trace_entry("da_read_iv_for_multi_inc")
25
26 !-------------------------------------------------------------------------
27 ! Fix input unit
28 !-------------------------------------------------------------------------
29
30 call da_get_unit(unit_in)
31
32 write(unit=filename, fmt='(a,i3.3)') 'gts_omb.', file_index
33
34 ! [1] Transfer surface obs:
35
36 if (iv%info(synop)%plocal(iv%time)-iv%info(synop)%plocal(iv%time-1) > 0) then
37
38 open(unit=unit_in,file=trim(filename)//'.synop',form='formatted',status='old',iostat=ios)
39 if (ios /= 0) Then
40 call da_error(__FILE__,__LINE__, &
41 (/"Cannot open file"//trim(filename)/))
42 end if
43
44 read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs
45 if ( trim(adjustl(ob_type_string)) .ne. 'synop' ) &
46 call da_error(__FILE__,__LINE__, &
47 (/"Cannot find synop marker. "/))
48 gn = 0
49 do n = iv%info(synop)%plocal(iv%time-1) + 1, &
50 iv%info(synop)%plocal(iv%time)
51 call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag)
52 if (found_flag .eqv. .false.) &
53 call da_error(__FILE__,__LINE__, &
54 (/"Cannot find synop obs. "/))
55 gn = gn + 1
56 end do
57 if (gn /= iv%info(synop)%plocal(iv%time)-iv%info(synop)%plocal(iv%time-1)) &
58 call da_error(__FILE__,__LINE__, &
59 (/"Unequal obs. found "/))
60 close (unit_in)
61 end if
62
63 ! [2] Transfer metar obs:
64
65 if (iv%info(metar)%plocal(iv%time)-iv%info(metar)%plocal(iv%time-1) > 0) then
66
67 open(unit=unit_in,file=trim(filename)//'.metar',form='formatted',status='old',iostat=ios)
68 if (ios /= 0) Then
69 call da_error(__FILE__,__LINE__, &
70 (/"Cannot open file"//trim(filename)/))
71 end if
72
73 read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs
74 if ( trim(adjustl(ob_type_string)) .ne. 'metar' ) &
75 call da_error(__FILE__,__LINE__, &
76 (/"Cannot find metar marker. "/))
77 gn = 0
78 do n = iv%info(metar)%plocal(iv%time-1) + 1, &
79 iv%info(metar)%plocal(iv%time)
80 call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag)
81 if (found_flag .eqv. .false.) &
82 call da_error(__FILE__,__LINE__, &
83 (/"Cannot find metar obs. "/))
84 gn = gn + 1
85 end do
86 if (gn /= iv%info(metar)%plocal(iv%time)-iv%info(metar)%plocal(iv%time-1)) &
87 call da_error(__FILE__,__LINE__, &
88 (/"Unequal obs. found "/))
89 close (unit_in)
90 end if
91
92 ! [3] Transfer ships obs:
93
94 if (iv%info(ships)%plocal(iv%time)-iv%info(ships)%plocal(iv%time-1) > 0) then
95
96 open(unit=unit_in,file=trim(filename)//'.ships',form='formatted',status='old',iostat=ios)
97 if (ios /= 0) Then
98 call da_error(__FILE__,__LINE__, &
99 (/"Cannot open file"//trim(filename)/))
100 end if
101
102 read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs
103 if ( trim(adjustl(ob_type_string)) .ne. 'ships' ) &
104 call da_error(__FILE__,__LINE__, &
105 (/"Cannot find ships marker. "/))
106 gn = 0
107 do n = iv%info(ships)%plocal(iv%time-1) + 1, &
108 iv%info(ships)%plocal(iv%time)
109 call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag)
110 if (found_flag .eqv. .false.) &
111 call da_error(__FILE__,__LINE__, &
112 (/"Cannot find ships obs. "/))
113 gn = gn + 1
114 end do
115 if (gn /= iv%info(ships)%plocal(iv%time)-iv%info(ships)%plocal(iv%time-1)) &
116 call da_error(__FILE__,__LINE__, &
117 (/"Unequal obs. found "/))
118 close (unit_in)
119 end if
120
121 ! [4] Transfer sonde_sfc obs:
122
123 if (iv%info(sound)%plocal(iv%time)-iv%info(sound)%plocal(iv%time-1) > 0) then
124
125 open(unit=unit_in,file=trim(filename)//'.sonde_sfc',form='formatted',status='old',iostat=ios)
126 if (ios /= 0) Then
127 call da_error(__FILE__,__LINE__, &
128 (/"Cannot open file"//trim(filename)/))
129 end if
130
131 read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs
132 if ( trim(adjustl(ob_type_string)) .ne. 'sonde_sfc' ) &
133 call da_error(__FILE__,__LINE__, &
134 (/"Cannot find sonde_sfc marker. "/))
135 gn = 0
136 do n = iv%info(sound)%plocal(iv%time-1) + 1, &
137 iv%info(sound)%plocal(iv%time)
138 call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag)
139 if (found_flag .eqv. .false.) &
140 call da_error(__FILE__,__LINE__, &
141 (/"Cannot find sonde_sfc obs. "/))
142 gn = gn + 1
143 end do
144 if (gn /= iv%info(sound)%plocal(iv%time)-iv%info(sound)%plocal(iv%time-1)) &
145 call da_error(__FILE__,__LINE__, &
146 (/"Unequal obs. found "/))
147 close (unit_in)
148 end if
149
150 ! [5] Transfer sound obs:
151
152 if (iv%info(sound)%plocal(iv%time)-iv%info(sound)%plocal(iv%time-1) > 0) then
153
154 open(unit=unit_in,file=trim(filename)//'.sound',form='formatted',status='old',iostat=ios)
155 if (ios /= 0) Then
156 call da_error(__FILE__,__LINE__, &
157 (/"Cannot open file"//trim(filename)/))
158 end if
159
160 read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs
161 if ( trim(adjustl(ob_type_string)) .ne. 'sound' ) &
162 call da_error(__FILE__,__LINE__, &
163 (/"Cannot find sound marker. "/))
164 gn = 0
165 do n = iv%info(sound)%plocal(iv%time-1) + 1, &
166 iv%info(sound)%plocal(iv%time)
167 call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag)
168 if (found_flag .eqv. .false.) &
169 call da_error(__FILE__,__LINE__, &
170 (/"Cannot find sound obs. "/))
171 gn = gn + 1
172 end do
173 if (gn /= iv%info(sound)%plocal(iv%time)-iv%info(sound)%plocal(iv%time-1)) &
174 call da_error(__FILE__,__LINE__, &
175 (/"Unequal obs. found "/))
176 close (unit_in)
177 end if
178
179 ! [6] Transfer buoy obs:
180
181 if (iv%info(buoy)%plocal(iv%time)-iv%info(buoy)%plocal(iv%time-1) > 0) then
182
183 open(unit=unit_in,file=trim(filename)//'.buoy',form='formatted',status='old',iostat=ios)
184 if (ios /= 0) Then
185 call da_error(__FILE__,__LINE__, &
186 (/"Cannot open file"//trim(filename)/))
187 end if
188
189 read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs
190 if ( trim(adjustl(ob_type_string)) .ne. 'buoy' ) &
191 call da_error(__FILE__,__LINE__, &
192 (/"Cannot find buoy marker. "/))
193 gn = 0
194 do n = iv%info(buoy)%plocal(iv%time-1) + 1, &
195 iv%info(buoy)%plocal(iv%time)
196 call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag)
197 if (found_flag .eqv. .false.) &
198 call da_error(__FILE__,__LINE__, &
199 (/"Cannot find buoy obs. "/))
200 gn = gn + 1
201 end do
202 if (gn /= iv%info(buoy)%plocal(iv%time)-iv%info(buoy)%plocal(iv%time-1)) &
203 call da_error(__FILE__,__LINE__, &
204 (/"Unequal obs. found "/))
205 close (unit_in)
206 end if
207
208 ! [7] Transfer Geo AMV obs:
209
210 if (iv%info(geoamv)%plocal(iv%time)-iv%info(geoamv)%plocal(iv%time-1) > 0) then
211
212 open(unit=unit_in,file=trim(filename)//'.geoamv',form='formatted',status='old',iostat=ios)
213 if (ios /= 0) Then
214 call da_error(__FILE__,__LINE__, &
215 (/"Cannot open file"//trim(filename)/))
216 end if
217
218 read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs
219 if ( trim(adjustl(ob_type_string)) .ne. 'geoamv' ) &
220 call da_error(__FILE__,__LINE__, &
221 (/"Cannot find geoamv marker. "/))
222 gn = 0
223 do n = iv%info(geoamv)%plocal(iv%time-1) + 1, &
224 iv%info(geoamv)%plocal(iv%time)
225 call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag)
226 if (found_flag .eqv. .false.) &
227 call da_error(__FILE__,__LINE__, &
228 (/"Cannot find geoamv obs. "/))
229 gn = gn + 1
230 end do
231 if (gn /= iv%info(geoamv)%plocal(iv%time)-iv%info(geoamv)%plocal(iv%time-1)) &
232 call da_error(__FILE__,__LINE__, &
233 (/"Unequal obs. found "/))
234 close (unit_in)
235 end if
236
237 ! [8] Transfer gpspw obs:
238
239 if (iv%info(gpspw)%plocal(iv%time)-iv%info(gpspw)%plocal(iv%time-1) > 0) then
240
241 open(unit=unit_in,file=trim(filename)//'.gpspw',form='formatted',status='old',iostat=ios)
242 if (ios /= 0) Then
243 call da_error(__FILE__,__LINE__, &
244 (/"Cannot open file"//trim(filename)/))
245 end if
246
247 read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs
248 if ( trim(adjustl(ob_type_string)) .ne. 'gpspw' ) &
249 call da_error(__FILE__,__LINE__, &
250 (/"Cannot find gpspw marker. "/))
251 gn = 0
252 do n = iv%info(gpspw)%plocal(iv%time-1) + 1, &
253 iv%info(gpspw)%plocal(iv%time)
254 call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag)
255 if (found_flag .eqv. .false.) &
256 call da_error(__FILE__,__LINE__, &
257 (/"Cannot find gpspw obs. "/))
258 gn = gn + 1
259 end do
260 if (gn /= iv%info(gpspw)%plocal(iv%time)-iv%info(gpspw)%plocal(iv%time-1)) &
261 call da_error(__FILE__,__LINE__, &
262 (/"Unequal obs. found "/))
263 close (unit_in)
264 end if
265
266 ! [9] Transfer SSM/I obs:
267
268 if (iv%info(ssmi_rv)%plocal(iv%time)-iv%info(ssmi_rv)%plocal(iv%time-1) > 0) then
269
270 open(unit=unit_in,file=trim(filename)//'.ssmir',form='formatted',status='old',iostat=ios)
271 if (ios /= 0) Then
272 call da_error(__FILE__,__LINE__, &
273 (/"Cannot open file"//trim(filename)/))
274 end if
275
276 read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs
277 if ( trim(adjustl(ob_type_string)) .ne. 'ssmir' ) &
278 call da_error(__FILE__,__LINE__, &
279 (/"Cannot find ssmir marker. "/))
280 gn = 0
281 do n = iv%info(ssmi_rv)%plocal(iv%time-1) + 1, &
282 iv%info(ssmi_rv)%plocal(iv%time)
283 call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag)
284 if (found_flag .eqv. .false.) &
285 call da_error(__FILE__,__LINE__, &
286 (/"Cannot find ssmir obs. "/))
287 gn = gn + 1
288 end do
289 if (gn /= iv%info(ssmi_rv)%plocal(iv%time)-iv%info(ssmi_rv)%plocal(iv%time-1)) &
290 call da_error(__FILE__,__LINE__, &
291 (/"Unequal obs. found "/))
292 close (unit_in)
293 end if
294
295 ! [10] Transfer airep obs:
296
297 if (iv%info(airep)%plocal(iv%time)-iv%info(airep)%plocal(iv%time-1) > 0) then
298
299 open(unit=unit_in,file=trim(filename)//'.airep',form='formatted',status='old',iostat=ios)
300 if (ios /= 0) Then
301 call da_error(__FILE__,__LINE__, &
302 (/"Cannot open file"//trim(filename)/))
303 end if
304
305 read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs
306 if ( trim(adjustl(ob_type_string)) .ne. 'airep' ) &
307 call da_error(__FILE__,__LINE__, &
308 (/"Cannot find airep marker. "/))
309 gn = 0
310 do n = iv%info(airep)%plocal(iv%time-1) + 1, &
311 iv%info(airep)%plocal(iv%time)
312 call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag)
313 if (found_flag .eqv. .false.) &
314 call da_error(__FILE__,__LINE__, &
315 (/"Cannot find airep obs. "/))
316 gn = gn + 1
317 end do
318 if (gn /= iv%info(airep)%plocal(iv%time)-iv%info(airep)%plocal(iv%time-1)) &
319 call da_error(__FILE__,__LINE__, &
320 (/"Unequal obs. found "/))
321 close (unit_in)
322 end if
323
324 ! [11] Transfer polaramv obs:
325
326 if (iv%info(polaramv)%plocal(iv%time)-iv%info(polaramv)%plocal(iv%time-1) > 0) then
327
328 open(unit=unit_in,file=trim(filename)//'.polaramv',form='formatted',status='old',iostat=ios)
329 if (ios /= 0) Then
330 call da_error(__FILE__,__LINE__, &
331 (/"Cannot open file"//trim(filename)/))
332 end if
333
334 read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs
335 if ( trim(adjustl(ob_type_string)) .ne. 'polaramv' ) &
336 call da_error(__FILE__,__LINE__, &
337 (/"Cannot find polaramv marker. "/))
338 gn = 0
339 do n = iv%info(polaramv)%plocal(iv%time-1) + 1, &
340 iv%info(polaramv)%plocal(iv%time)
341 call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag)
342 if (found_flag .eqv. .false.) &
343 call da_error(__FILE__,__LINE__, &
344 (/"Cannot find polaramv obs. "/))
345 gn = gn + 1
346 end do
347 if (gn /= iv%info(polaramv)%plocal(iv%time)-iv%info(polaramv)%plocal(iv%time-1)) &
348 call da_error(__FILE__,__LINE__, &
349 (/"Unequal obs. found "/))
350 close (unit_in)
351 end if
352
353 ! [12] Transfer pilot obs:
354
355 if (iv%info(pilot)%plocal(iv%time)-iv%info(pilot)%plocal(iv%time-1) > 0) then
356
357 open(unit=unit_in,file=trim(filename)//'.pilot',form='formatted',status='old',iostat=ios)
358 if (ios /= 0) Then
359 call da_error(__FILE__,__LINE__, &
360 (/"Cannot open file"//trim(filename)/))
361 end if
362
363 read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs
364 if ( trim(adjustl(ob_type_string)) .ne. 'pilot' ) &
365 call da_error(__FILE__,__LINE__, &
366 (/"Cannot find pilot marker. "/))
367 gn = 0
368 do n = iv%info(pilot)%plocal(iv%time-1) + 1, &
369 iv%info(pilot)%plocal(iv%time)
370 call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag)
371 if (found_flag .eqv. .false.) &
372 call da_error(__FILE__,__LINE__, &
373 (/"Cannot find pilot obs. "/))
374 gn = gn + 1
375 end do
376 if (gn /= iv%info(pilot)%plocal(iv%time)-iv%info(pilot)%plocal(iv%time-1)) &
377 call da_error(__FILE__,__LINE__, &
378 (/"Unequal obs. found "/))
379 close (unit_in)
380 end if
381
382 ! [13] Transfer ssmi_tb obs:
383
384 if (iv%info(ssmi_tb)%plocal(iv%time)-iv%info(ssmi_tb)%plocal(iv%time-1) > 0) then
385
386 open(unit=unit_in,file=trim(filename)//'.ssmi_tb',form='formatted',status='old',iostat=ios)
387 if (ios /= 0) Then
388 call da_error(__FILE__,__LINE__, &
389 (/"Cannot open file"//trim(filename)/))
390 end if
391
392 read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs
393 if ( trim(adjustl(ob_type_string)) .ne. 'ssmi_tb' ) &
394 call da_error(__FILE__,__LINE__, &
395 (/"Cannot find ssmi_tb marker. "/))
396 gn = 0
397 do n = iv%info(ssmi_tb)%plocal(iv%time-1) + 1, &
398 iv%info(ssmi_tb)%plocal(iv%time)
399 call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag)
400 if (found_flag .eqv. .false.) &
401 call da_error(__FILE__,__LINE__, &
402 (/"Cannot find ssmi_tb obs. "/))
403 gn = gn + 1
404 end do
405 if (gn /= iv%info(ssmi_tb)%plocal(iv%time)-iv%info(ssmi_tb)%plocal(iv%time-1)) &
406 call da_error(__FILE__,__LINE__, &
407 (/"Unequal obs. found "/))
408 close (unit_in)
409 end if
410
411 ! [14] Transfer satem obs:
412
413 if (iv%info(satem)%plocal(iv%time)-iv%info(satem)%plocal(iv%time-1) > 0) then
414
415 open(unit=unit_in,file=trim(filename)//'.satem',form='formatted',status='old',iostat=ios)
416 if (ios /= 0) Then
417 call da_error(__FILE__,__LINE__, &
418 (/"Cannot open file"//trim(filename)/))
419 end if
420
421 read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs
422 if ( trim(adjustl(ob_type_string)) .ne. 'satem' ) &
423 call da_error(__FILE__,__LINE__, &
424 (/"Cannot find satem marker. "/))
425 gn = 0
426 do n = iv%info(satem)%plocal(iv%time-1) + 1, &
427 iv%info(satem)%plocal(iv%time)
428 call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag)
429 if (found_flag .eqv. .false.) &
430 call da_error(__FILE__,__LINE__, &
431 (/"Cannot find satem obs. "/))
432 gn = gn + 1
433 end do
434 if (gn /= iv%info(satem)%plocal(iv%time)-iv%info(satem)%plocal(iv%time-1)) &
435 call da_error(__FILE__,__LINE__, &
436 (/"Unequal obs. found "/))
437 close (unit_in)
438 end if
439
440 ! [15] Transfer ssmt1 obs:
441
442 if (iv%info(ssmt1)%plocal(iv%time)-iv%info(ssmt1)%plocal(iv%time-1) > 0) then
443
444 open(unit=unit_in,file=trim(filename)//'.ssmt1',form='formatted',status='old',iostat=ios)
445 if (ios /= 0) Then
446 call da_error(__FILE__,__LINE__, &
447 (/"Cannot open file"//trim(filename)/))
448 end if
449
450 read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs
451 if ( trim(adjustl(ob_type_string)) .ne. 'ssmt1' ) &
452 call da_error(__FILE__,__LINE__, &
453 (/"Cannot find ssmt1 marker. "/))
454 gn = 0
455 do n = iv%info(ssmt1)%plocal(iv%time-1) + 1, &
456 iv%info(ssmt1)%plocal(iv%time)
457 call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag)
458 if (found_flag .eqv. .false.) &
459 call da_error(__FILE__,__LINE__, &
460 (/"Cannot find ssmt1 obs. "/))
461 gn = gn + 1
462 end do
463 if (gn /= iv%info(ssmt1)%plocal(iv%time)-iv%info(ssmt1)%plocal(iv%time-1)) &
464 call da_error(__FILE__,__LINE__, &
465 (/"Unequal obs. found "/))
466 close (unit_in)
467 end if
468
469 ! [16] Transfer ssmt2 obs:
470
471 if (iv%info(ssmt2)%plocal(iv%time)-iv%info(ssmt2)%plocal(iv%time-1) > 0) then
472
473 open(unit=unit_in,file=trim(filename)//'.ssmt2',form='formatted',status='old',iostat=ios)
474 if (ios /= 0) Then
475 call da_error(__FILE__,__LINE__, &
476 (/"Cannot open file"//trim(filename)/))
477 end if
478
479 read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs
480 if ( trim(adjustl(ob_type_string)) .ne. 'ssmt2' ) &
481 call da_error(__FILE__,__LINE__, &
482 (/"Cannot find ssmt2 marker. "/))
483 gn = 0
484 do n = iv%info(ssmt2)%plocal(iv%time-1) + 1, &
485 iv%info(ssmt2)%plocal(iv%time)
486 call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag)
487 if (found_flag .eqv. .false.) &
488 call da_error(__FILE__,__LINE__, &
489 (/"Cannot find ssmt2 obs. "/))
490 gn = gn + 1
491 end do
492 if (gn /= iv%info(ssmt2)%plocal(iv%time)-iv%info(ssmt2)%plocal(iv%time-1)) &
493 call da_error(__FILE__,__LINE__, &
494 (/"Unequal obs. found "/))
495 close (unit_in)
496 end if
497
498 ! [17] Transfer scatterometer obs:
499
500 if (iv%info(qscat)%plocal(iv%time)-iv%info(qscat)%plocal(iv%time-1) > 0) then
501
502 open(unit=unit_in,file=trim(filename)//'.qscat',form='formatted',status='old',iostat=ios)
503 if (ios /= 0) Then
504 call da_error(__FILE__,__LINE__, &
505 (/"Cannot open file"//trim(filename)/))
506 end if
507
508 read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs
509 if ( trim(adjustl(ob_type_string)) .ne. 'qscat' ) &
510 call da_error(__FILE__,__LINE__, &
511 (/"Cannot find qscat marker. "/))
512 gn = 0
513 do n = iv%info(qscat)%plocal(iv%time-1) + 1, &
514 iv%info(qscat)%plocal(iv%time)
515 call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag)
516 if (found_flag .eqv. .false.) &
517 call da_error(__FILE__,__LINE__, &
518 (/"Cannot find qscat obs. "/))
519 gn = gn + 1
520 end do
521 if (gn /= iv%info(qscat)%plocal(iv%time)-iv%info(qscat)%plocal(iv%time-1)) &
522 call da_error(__FILE__,__LINE__, &
523 (/"Unequal obs. found "/))
524 close (unit_in)
525 end if
526
527 ! [18] Transfer profiler obs:
528
529 if (iv%info(profiler)%plocal(iv%time)-iv%info(profiler)%plocal(iv%time-1) > 0) then
530
531 open(unit=unit_in,file=trim(filename)//'.profiler',form='formatted',status='old',iostat=ios)
532 if (ios /= 0) Then
533 call da_error(__FILE__,__LINE__, &
534 (/"Cannot open file"//trim(filename)/))
535 end if
536
537 read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs
538 if ( trim(adjustl(ob_type_string)) .ne. 'profiler' ) &
539 call da_error(__FILE__,__LINE__, &
540 (/"Cannot find profiler marker. "/))
541 gn = 0
542 do n = iv%info(profiler)%plocal(iv%time-1) + 1, &
543 iv%info(profiler)%plocal(iv%time)
544 call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag)
545 if (found_flag .eqv. .false.) &
546 call da_error(__FILE__,__LINE__, &
547 (/"Cannot find profiler obs. "/))
548 gn = gn + 1
549 end do
550 if (gn /= iv%info(profiler)%plocal(iv%time)-iv%info(profiler)%plocal(iv%time-1)) &
551 call da_error(__FILE__,__LINE__, &
552 (/"Unequal obs. found "/))
553 close (unit_in)
554 end if
555
556 ! [19] Transfer TC bogus obs:
557
558 if (iv%info(bogus)%plocal(iv%time)-iv%info(bogus)%plocal(iv%time-1) > 0) then
559
560 open(unit=unit_in,file=trim(filename)//'.bogus',form='formatted',status='old',iostat=ios)
561 if (ios /= 0) Then
562 call da_error(__FILE__,__LINE__, &
563 (/"Cannot open file"//trim(filename)/))
564 end if
565
566 read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs
567 if ( trim(adjustl(ob_type_string)) .ne. 'bogus' ) &
568 call da_error(__FILE__,__LINE__, &
569 (/"Cannot find bogus marker. "/))
570 gn = 0
571 do n = iv%info(bogus)%plocal(iv%time-1) + 1, &
572 iv%info(bogus)%plocal(iv%time)
573 call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag)
574 if (found_flag .eqv. .false.) &
575 call da_error(__FILE__,__LINE__, &
576 (/"Cannot find bogus obs. "/))
577 gn = gn + 1
578 end do
579 if (gn /= iv%info(bogus)%plocal(iv%time)-iv%info(bogus)%plocal(iv%time-1)) &
580 call da_error(__FILE__,__LINE__, &
581 (/"Unequal obs. found "/))
582 close (unit_in)
583 end if
584
585 ! [20] Transfer AIRS retrievals:
586
587 if (iv%info(airsr)%plocal(iv%time)-iv%info(airsr)%plocal(iv%time-1) > 0) then
588
589 open(unit=unit_in,file=trim(filename)//'.airsr',form='formatted',status='old',iostat=ios)
590 if (ios /= 0) Then
591 call da_error(__FILE__,__LINE__, &
592 (/"Cannot open file"//trim(filename)/))
593 end if
594
595 read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs
596 if ( trim(adjustl(ob_type_string)) .ne. 'airsr' ) &
597 call da_error(__FILE__,__LINE__, &
598 (/"Cannot find airsr marker. "/))
599 gn = 0
600 do n = iv%info(airsr)%plocal(iv%time-1) + 1, &
601 iv%info(airsr)%plocal(iv%time)
602 call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag)
603 if (found_flag .eqv. .false.) &
604 call da_error(__FILE__,__LINE__, &
605 (/"Cannot find airsr obs. "/))
606 gn = gn + 1
607 end do
608 if (gn /= iv%info(airsr)%plocal(iv%time)-iv%info(airsr)%plocal(iv%time-1)) &
609 call da_error(__FILE__,__LINE__, &
610 (/"Unequal obs. found "/))
611 close (unit_in)
612 end if
613
614 ! [21] Transfer gpsref obs:
615
616 if (iv%info(gpsref)%plocal(iv%time)-iv%info(gpsref)%plocal(iv%time-1) > 0) then
617
618 open(unit=unit_in,file=trim(filename)//'.gpsref',form='formatted',status='old',iostat=ios)
619 if (ios /= 0) Then
620 call da_error(__FILE__,__LINE__, &
621 (/"Cannot open file"//trim(filename)/))
622 end if
623
624 read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type_string,num_obs
625 if ( trim(adjustl(ob_type_string)) .ne. 'gpsref' ) &
626 call da_error(__FILE__,__LINE__, &
627 (/"Cannot find gpsref marker. "/))
628 gn = 0
629 do n = iv%info(gpsref)%plocal(iv%time-1) + 1, &
630 iv%info(gpsref)%plocal(iv%time)
631 call da_search_obs (ob_type_string, unit_in, num_obs, n, iv, found_flag)
632 if (found_flag .eqv. .false.) &
633 call da_error(__FILE__,__LINE__, &
634 (/"Cannot find gpsref obs. "/))
635 gn = gn + 1
636 end do
637 if (gn /= iv%info(gpsref)%plocal(iv%time)-iv%info(gpsref)%plocal(iv%time-1)) &
638 call da_error(__FILE__,__LINE__, &
639 (/"Unequal obs. found "/))
640 close (unit_in)
641 end if
642
643 999 continue
644 close (unit_in)
645 call da_free_unit(unit_in)
646
647 if (trace_use) call da_trace_exit("da_read_iv_for_multi_inc")
648 return
649
650 1000 continue
651 write(unit=message(1), fmt='(a,i3)') &
652 'read error on unit: ',unit_in
653 call da_warning(__FILE__,__LINE__,message(1:1))
654
655 end subroutine da_read_iv_for_multi_inc