da_read_omb_tmp.inc
References to this file elsewhere.
1 subroutine da_read_omb_tmp(filename,unit_in,num,obs_type_in, nc)
2
3 !-------------------------------------------------------------------------
4 ! read diagnostics written to temporary file by WRFVAR
5 !-------------------------------------------------------------------------
6
7 implicit none
8
9 integer ,intent (in) :: unit_in
10 integer ,intent (inout) :: num
11 character*(*),intent (in) :: obs_type_in, filename
12 integer ,intent (in) :: nc
13
14 integer :: num_obs, ios
15 character*20 :: iv_type
16 logical :: if_write
17
18 character*5 :: stn_id
19 integer :: n, k, kk, l, levels, dummy_i
20 real :: lat, lon, press, height, dummy
21 real :: tpw_obs, tpw_inv, tpw_err, tpw_inc
22 real :: u_obs, u_inv, u_error, u_inc, &
23 v_obs, v_inv, v_error, v_inc, &
24 t_obs, t_inv, t_error, t_inc, &
25 p_obs, p_inv, p_error, p_inc, &
26 q_obs, q_inv, q_error, q_inc, &
27 ref_obs, ref_inv, ref_error, ref_inc, &
28 spd_obs, spd_inv, spd_err, spd_inc
29 integer :: u_qc, v_qc, t_qc, p_qc, q_qc, tpw_qc, spd_qc, ref_qc
30
31 if (trace_use_dull) call da_trace_entry("da_read_omb_tmp")
32
33 open(unit=unit_in,file=trim(filename),form='formatted',status='old',iostat=ios)
34 if (ios /= 0) then
35 call da_error(__FILE__,__LINE__, (/"Cannot open file"//trim(filename)/))
36 end if
37
38 reports: do
39
40 read(unit_in,'(a20,i8)', end = 999, err = 1000) iv_type,num_obs
41 if_write = .false.
42 if (index(iv_type,OBS_type_in(1:nc)) > 0) if_write = .true.
43
44 select case (trim(adjustl(iv_type)))
45
46 case ('synop' , 'metar' , 'ships' , 'buoy' , 'sonde_sfc' )
47 if (num_obs > 0) then
48 do n = 1, num_obs
49 read(unit_in,'(i8)')levels
50 if (if_write) then
51 write(omb_unit,'(i8)')levels
52 num = num + 1
53 end if
54 do k = 1, levels
55 read(unit_in,'(2i8,a5,2f9.2,f17.7,5(2f17.7,i8,2f17.7))', err= 1000)&
56 kk,l, stn_id, & ! Station
57 lat, lon, press, & ! Lat/lon, pressure
58 u_obs, u_inv, u_qc, u_error, u_inc, &
59 v_obs, v_inv, v_qc, v_error, v_inc, &
60 t_obs, t_inv, t_qc, t_error, t_inc, &
61 p_obs, p_inv, p_qc, p_error, p_inc, &
62 q_obs, q_inv, q_qc, q_error, q_inc
63 if (if_write) &
64 write(omb_unit,'(2i8,a5,2f9.2,f17.7,5(2f17.7,i8,2f17.7))', err= 1000)&
65 num, k, stn_id, & ! Station
66 lat, lon, press, & ! Lat/lon, pressure
67 u_obs, u_inv, u_qc, u_error, u_inc, &
68 v_obs, v_inv, v_qc, v_error, v_inc, &
69 t_obs, t_inv, t_qc, t_error, t_inc, &
70 p_obs, p_inv, p_qc, p_error, p_inc, &
71 q_obs, q_inv, q_qc, q_error, q_inc
72 end do
73 end do
74 end if
75 if (if_write) exit reports
76 cycle reports
77
78 case ('geoamv' , 'polaramv' )
79 if (num_obs > 0) then
80 do n = 1, num_obs
81 read(unit_in,'(i8)')levels
82 if (if_write) then
83 write(omb_unit,'(i8)')levels
84 num = num + 1
85 end if
86 do k = 1, levels
87 read(unit_in,'(2i8,a5,2f9.2,f17.7,5(2f17.7,i8,2f17.7))', err= 1000)&
88 kk, l, stn_id, & ! Station
89 lat, lon, press, & ! Lat/lon, pressure
90 u_obs, u_inv, u_qc, u_error, u_inc, &
91 v_obs, v_inv, v_qc, v_error, v_inc
92 if (if_write) &
93 write(omb_unit,'(2i8,a5,2f9.2,f17.7,5(2f17.7,i8,2f17.7))', err= 1000)&
94 num, k, stn_id, & ! Station
95 lat, lon, press, & ! Lat/lon, pressure
96 u_obs, u_inv, u_qc, u_error, u_inc, &
97 v_obs, v_inv, v_qc, v_error, v_inc
98
99 end do
100 end do
101 end if
102 if (if_write) exit reports
103 cycle reports
104
105 case ('gpspw' )
106 if (num_obs > 0) then
107 do n = 1, num_obs
108 read(unit_in,'(i8)')levels
109 if (if_write) then
110 write(omb_unit,'(i8)')levels
111 num = num + 1
112 end if
113 do k = 1, levels
114 read(unit_in,'(2i8,a5,2f9.2,f17.7,5(2f17.7,i8,2f17.7))', err= 1000)&
115 kk,l, stn_id, & ! Station
116 lat, lon, dummy, & ! Lat/lon, dummy
117 tpw_obs, tpw_inv, tpw_qc, tpw_err, tpw_inc
118 if (if_write) &
119 write(omb_unit,'(2i8,a5,2f9.2,f17.7,5(2f17.7,i8,2f17.7))', err= 1000)&
120 num, k, stn_id, & ! Station
121 lat, lon, dummy, & ! Lat/lon, dummy
122 tpw_obs, tpw_inv, tpw_qc, tpw_err, tpw_inc
123 end do
124 end do
125 end if
126 if (if_write) exit reports
127 cycle reports
128
129 case ('sound' )
130 if (num_obs > 0) then
131 do n = 1, num_obs
132 read(unit_in,'(i8)')levels
133 if (if_write) then
134 write(omb_unit,'(i8)')levels
135 num = num + 1
136 end if
137 do k = 1, levels
138 read(unit_in,'(2i8,a5,2f9.2,f17.7,5(2f17.7,i8,2f17.7))', err= 1000)&
139 kk,l, stn_id, & ! Station
140 lat, lon, press, & ! Lat/lon, dummy
141 u_obs, u_inv, u_qc, u_error, u_inc, &
142 v_obs, v_inv, v_qc, v_error, v_inc, &
143 t_obs, t_inv, t_qc, t_error, t_inc, &
144 q_obs, q_inv, q_qc, q_error, q_inc
145 if (if_write) &
146 write(omb_unit,'(2i8,a5,2f9.2,f17.7,5(2f17.7,i8,2f17.7))', err= 1000)&
147 num, k, stn_id, & ! Station
148 lat, lon, press, & ! Lat/lon, dummy
149 u_obs, u_inv, u_qc, u_error, u_inc, &
150 v_obs, v_inv, v_qc, v_error, v_inc, &
151 t_obs, t_inv, t_qc, t_error, t_inc, &
152 q_obs, q_inv, q_qc, q_error, q_inc
153 end do
154 end do
155 end if
156 if (if_write) exit reports
157 cycle reports
158
159 case ('airep' )
160 if (num_obs > 0) then
161 do n = 1, num_obs
162 read(unit_in,'(i8)') levels
163 if (if_write) then
164 write(omb_unit,'(i8)')levels
165 num = num + 1
166 end if
167 do k = 1, levels
168 read(unit_in,'(2i8,a5,2f9.2,f17.7,5(2f17.7,i8,2f17.7))', err= 1000)&
169 kk,l, stn_id, & ! Station
170 lat, lon, press, & ! Lat/lon, dummy
171 u_obs, u_inv, u_qc, u_error, u_inc, &
172 v_obs, v_inv, v_qc, v_error, v_inc, &
173 t_obs, t_inv, t_qc, t_error, t_inc
174 if (if_write) &
175 write(omb_unit,'(2i8,a5,2f9.2,f17.7,5(2f17.7,i8,2f17.7))', err= 1000)&
176 num, k, stn_id, & ! Station
177 lat, lon, press, & ! Lat/lon, dummy
178 u_obs, u_inv, u_qc, u_error, u_inc, &
179 v_obs, v_inv, v_qc, v_error, v_inc, &
180 t_obs, t_inv, t_qc, t_error, t_inc
181 end do
182 end do
183 end if
184 if (if_write) exit reports
185 cycle reports
186
187 case ('pilot' , 'profiler' )
188 if (num_obs > 0) then
189 do n = 1, num_obs
190 read(unit_in,'(i8)')levels
191 if (if_write) then
192 write(omb_unit,'(i8)')levels
193 num = num + 1
194 end if
195 do k = 1, levels
196 read(unit_in,'(2i8,a5,2f9.2,f17.7,5(2f17.7,i8,2f17.7))', err= 1000)&
197 kk,l, stn_id, & ! Station
198 lat, lon, press, & ! Lat/lon, dummy
199 u_obs, u_inv, u_qc, u_error, u_inc, &
200 v_obs, v_inv, v_qc, v_error, v_inc
201 if (if_write) &
202 write(omb_unit,'(2i8,a5,2f9.2,f17.7,5(2f17.7,i8,2f17.7))', err= 1000)&
203 num, k, stn_id, & ! Station
204 lat, lon, press, & ! Lat/lon, dummy
205 u_obs, u_inv, u_qc, u_error, u_inc, &
206 v_obs, v_inv, v_qc, v_error, v_inc
207 end do
208 end do
209 end if
210 if (if_write) exit reports
211 cycle reports
212
213 case ('ssmir' )
214 if (num_obs > 0) then
215 do n = 1, num_obs
216 read(unit_in,'(i8)')levels
217 if (if_write) then
218 write(omb_unit,'(i8)')levels
219 num = num + 1
220 end if
221 do k = 1, levels
222 read(unit_in,'(2i8,a5,2f9.2,f17.7,5(2f17.7,i8,2f17.7))', err= 1000)&
223 kk,l, stn_id, & ! Station
224 lat, lon, dummy, & ! Lat/lon, dummy
225 spd_obs, spd_inv, spd_qc, spd_err, spd_inc, &
226 tpw_obs, tpw_inv, tpw_qc, tpw_err, tpw_inc
227 if (if_write) &
228 write(omb_unit,'(2i8,a5,2f9.2,f17.7,5(2f17.7,i8,2f17.7))', err= 1000)&
229 num, k, stn_id, & ! Station
230 lat, lon, dummy, & ! Lat/lon, dummy
231 spd_obs, spd_inv, spd_qc, spd_err, spd_inc, &
232 tpw_obs, tpw_inv, tpw_qc, tpw_err, tpw_inc
233 end do
234 end do
235 end if
236 if (if_write) exit reports
237 cycle reports
238
239 case ('ssmit' )
240 if (num_obs > 0) then
241 do n = 1, num_obs
242 read(unit_in,'(i8)')levels
243 if (if_write) then
244 write(omb_unit,'(i8)')levels
245 num = num + 1
246 end if
247 do k = 1, levels
248 read(unit_in,'(2i8,a5,2f9.2,f17.7,7(2f17.7,i8,2f17.7))', err= 1000)&
249 kk,l, stn_id, & ! Station
250 lat, lon, dummy, & ! Lat/lon, dummy
251 dummy, dummy, dummy_i, dummy, dummy, &
252 dummy, dummy, dummy_i, dummy, dummy, &
253 dummy, dummy, dummy_i, dummy, dummy, &
254 dummy, dummy, dummy_i, dummy, dummy, &
255 dummy, dummy, dummy_i, dummy, dummy, &
256 dummy, dummy, dummy_i, dummy, dummy, &
257 dummy, dummy, dummy_i, dummy, dummy
258 if (if_write) &
259 write(omb_unit,'(2i8,a5,2f9.2,f17.7,7(2f17.7,i8,2f17.7))', err= 1000)&
260 num,k,stn_id, & ! Station
261 lat, lon, dummy, & ! Lat/lon, dummy
262 dummy, dummy, dummy_i, dummy, dummy, &
263 dummy, dummy, dummy_i, dummy, dummy, &
264 dummy, dummy, dummy_i, dummy, dummy, &
265 dummy, dummy, dummy_i, dummy, dummy, &
266 dummy, dummy, dummy_i, dummy, dummy, &
267 dummy, dummy, dummy_i, dummy, dummy, &
268 dummy, dummy, dummy_i, dummy, dummy
269 end do
270 end do
271 end if
272 if (if_write) exit reports
273 cycle reports
274
275 case ('satem' )
276 if (num_obs > 0) then
277 do n = 1, num_obs
278 read(unit_in,'(i8)') levels
279 if (if_write) then
280 write(omb_unit,'(i8)')levels
281 num = num + 1
282 end if
283 do k = 1, levels
284 read(unit_in,'(2i8,a5,2f9.2,f17.7,5(2f17.7,i8,2f17.7))', err= 1000)&
285 kk,l, stn_id, & ! Station
286 lat, lon, dummy, & ! Lat/lon, dummy
287 dummy,dummy, dummy_i, dummy, dummy
288 if (if_write) &
289 write(omb_unit,'(2i8,a5,2f9.2,f17.7,5(2f17.7,i8,2f17.7))', err= 1000)&
290 num,k,stn_id, & ! Station
291 lat, lon, dummy, & ! Lat/lon, dummy
292 dummy,dummy, dummy_i, dummy, dummy
293 end do
294 end do
295 end if
296 if (if_write) exit reports
297 cycle reports
298
299 case ('ssmt1' , 'ssmt2' )
300 if (num_obs > 0) then
301 do n = 1, num_obs
302 read(unit_in,'(i8)') levels
303 if (if_write) then
304 write(omb_unit,'(i8)')levels
305 num = num + 1
306 end if
307 do k = 1, levels
308 read(unit_in,'(2i8,a5,2f9.2,f17.7,5(2f17.7,i8,2f17.7))', err= 1000)&
309 kk,l, stn_id, & ! Station
310 lat, lon, dummy, & ! Lat/lon, dummy
311 dummy,dummy, dummy_i, dummy, dummy
312 if (if_write) &
313 write(omb_unit,'(2i8,a5,2f9.2,f17.7,5(2f17.7,i8,2f17.7))', err= 1000)&
314 num,k,stn_id, & ! Station
315 lat, lon, dummy, & ! Lat/lon, dummy
316 dummy,dummy, dummy_i, dummy, dummy
317 end do
318 end do
319 end if
320 if (if_write) exit reports
321 cycle reports
322
323 case ('qscat' )
324 if (num_obs > 0) then
325 do n = 1, num_obs
326 read(unit_in,'(i8)') levels
327 if (if_write) then
328 write(omb_unit,'(i8)')levels
329 num = num + 1
330 end if
331 do k = 1, levels
332 read(unit_in,'(2i8,a5,2f9.2,f17.7,5(2f17.7,i8,2f17.7))', err= 1000)&
333 kk,l, stn_id, & ! Station
334 lat, lon, press, & ! Lat/lon, dummy
335 u_obs, u_inv, u_qc, u_error, u_inc, &
336 v_obs, v_inv, v_qc, v_error, v_inc
337 if (if_write) &
338 write(omb_unit,'(2i8,a5,2f9.2,f17.7,5(2f17.7,i8,2f17.7))', err= 1000)&
339 num,k,stn_id, & ! Station
340 lat, lon, press, & ! Lat/lon, dummy
341 u_obs, u_inv, u_qc, u_error, u_inc, &
342 v_obs, v_inv, v_qc, v_error, v_inc
343 end do
344 end do
345 end if
346 if (if_write) exit reports
347 cycle reports
348
349 case ('bogus' )
350 ! TC Bogus data is written in two records
351 ! 1st record holds info about surface level
352 ! 2nd is for upper air
353
354 if (num_obs > 0) then
355 do n = 1, num_obs
356 read(unit_in,'(i8)') levels
357 if (if_write) then
358 write(omb_unit,'(i8)')levels
359 num = num + 1
360 end if
361 do k = 1, levels
362 read(unit_in,'(2i8,a5,2f9.2,f17.7,5(2f17.7,i8,2f17.7))', err= 1000)&
363 kk,l, stn_id, & ! Station
364 lat, lon, press, & ! Lat/lon, dummy
365 u_obs, u_inv, u_qc, u_error, u_inc, &
366 v_obs, v_inv, v_qc, v_error, v_inc
367 if (if_write) &
368 write(omb_unit,'(2i8,a5,2f9.2,f17.7,5(2f17.7,i8,2f17.7))', err= 1000)&
369 num,l,stn_id, & ! Station
370 lat, lon, press, & ! Lat/lon, dummy
371 u_obs, u_inv, u_qc, u_error, u_inc, &
372 v_obs, v_inv, v_qc, v_error, v_inc
373 end do
374 read(unit_in,'(i8)') levels
375 if (if_write) then
376 write(omb_unit,'(i8)')levels
377 end if
378 do k = 1, levels
379 read(unit_in,'(2i8,a5,2f9.2,f17.7,5(2f17.7,i8,2f17.7))', err= 1000)&
380 kk,l, stn_id, & ! Station
381 lat, lon, press, & ! Lat/lon, dummy
382 u_obs, u_inv, u_qc, u_error, u_inc, &
383 v_obs, v_inv, v_qc, v_error, v_inc
384 if (if_write) &
385 write(omb_unit,'(2i8,a5,2f9.2,f17.7,5(2f17.7,i8,2f17.7))', err= 1000)&
386 num,l,stn_id, & ! Station
387 lat, lon, press, & ! Lat/lon, dummy
388 u_obs, u_inv, u_qc, u_error, u_inc, &
389 v_obs, v_inv, v_qc, v_error, v_inc
390 end do
391 end do
392 end if
393 if (if_write) exit reports
394 cycle reports
395
396 case ('airsr' )
397 if (num_obs > 0) then
398 do n = 1, num_obs
399 read(unit_in,'(i8)') levels
400 if (if_write) write(omb_unit,'(i8)')levels
401 num = num + 1
402 do k = 1, levels
403 read(unit_in,'(2i8,a5,2f9.2,f17.7,5(2f17.7,i8,2f17.7))', err= 1000)&
404 kk,l, stn_id, & ! Station
405 lat, lon, press, & ! Lat/lon, dummy
406 t_obs, t_inv, t_qc, t_error, t_inc, &
407 q_obs, q_inv, q_qc, q_error, q_inc
408 if (if_write) &
409 write(omb_unit,'(2i8,a5,2f9.2,f17.7,5(2f17.7,i8,2f17.7))', err= 1000)&
410 num,k,stn_id, & ! Station
411 lat, lon, press, & ! Lat/lon, dummy
412 t_obs, t_inv, t_qc, t_error, t_inc, &
413 q_obs, q_inv, q_qc, q_error, q_inc
414 end do
415 end do
416 end if
417 if (if_write) exit reports
418 cycle reports
419
420 case ('gpsref' )
421 if (num_obs > 0) then
422 do n = 1, num_obs
423 read(unit_in,'(i8)') levels
424 if (if_write) write(omb_unit,'(i8)')levels
425 num = num + 1
426 do k = 1, levels
427 read(unit_in,'(2i8,a5,2f9.2,f17.7,5(2f17.7,i8,2f17.7))', err= 1000)&
428 kk,l, stn_id, & ! Station
429 lat, lon, height, & ! Lat/lon, height
430 ref_obs, ref_inv, ref_qc, ref_error, ref_inc
431 if (if_write) &
432 write(omb_unit,'(2i8,a5,2f9.2,f17.7,5(2f17.7,i8,2f17.7))', err= 1000)&
433 num,k,stn_id, & ! Station
434 lat, lon, height, & ! Lat/lon, height
435 ref_obs, ref_inv, ref_qc, ref_error, ref_inc
436 end do
437 end do
438 end if
439 if (if_write) exit reports
440 cycle reports
441
442 case default;
443
444 write(unit=message(1), fmt='(a,a20,a,i3)') &
445 'Got unknown obs_type string:', trim(iv_type),' on unit ',unit_in
446 call da_error(__FILE__,__LINE__,message(1:1))
447 end select
448 end do reports
449
450 999 continue
451 close (unit_in)
452
453 if (trace_use_dull) call da_trace_exit("da_read_omb_tmp")
454 return
455
456 1000 continue
457 write(unit=message(1), fmt='(a,i3)') &
458 'read error on unit: ',unit_in
459 call da_warning(__FILE__,__LINE__,message(1:1))
460
461 end subroutine da_read_omb_tmp
462