da_read_y_unit.inc

1 subroutine da_read_y_unit(filename,unit_out,num,obs_type_in, nc)
2 
3    !-------------------------------------------------------------------------  
4    ! Purpose: read diagnostics written on yp_unit or y_unit by WRF-Var
5    !-------------------------------------------------------------------------   
6 
7    implicit none
8 
9    integer      ,intent (in)    :: unit_out
10    integer      ,intent (inout) :: num
11    character*(*),intent (in)    :: obs_type_in, filename                 
12    integer      ,intent (in)    :: nc      
13 
14    integer      :: num_obs , unit_in, ios
15    character*20 :: iv_type               
16    logical      :: if_write
17    
18    real         :: fld(7), fld_rad                          
19    integer      :: n, k, n1,n2, levels
20 
21    if (trace_use_dull) call da_trace_entry("da_read_y_unit")
22 
23    iv_type="Unknown"
24 
25    call da_get_unit(unit_in)
26    open(unit=unit_in,file=trim(filename),form='formatted',iostat=ios,status='old')
27    if (ios /= 0) then
28       call da_error(__FILE__,__LINE__, &
29          (/"Cannot open random observation error file"//trim(filename)/))
30    end if
31 
32    reports: do
33    read(unit_in,'(a20,i8)', end = 999, err = 1000) iv_type,num_obs                    
34    
35    if_write = .false.
36    if (index(iv_type,OBS_type_in(1:nc)) > 0) if_write = .true.
37 
38    ! If radiance data treat differently
39    if ( (index(iv_type,'noaa') > 0) .or. (index(iv_type,'eos') > 0) .or.   &
40         (index(iv_type,'dmsp') > 0) ) then             
41       do n = 1, num_obs        
42          if (if_write) num = num + 1
43          read(unit_in,'(2i8,e15.7)')n1, n2, fld_rad                              
44          if (if_write)write(unit_out,'(2i8,e15.7)')num,n2, fld_rad                              
45       end do
46    else    
47       do n = 1, num_obs        
48          if (if_write) num = num + 1
49          if (index(iv_type,'bogus') > 0) then
50             read(unit_in,'(i8)', err=1000)levels
51             if (if_write) write(unit_out,'(i8)')levels
52             read(unit_in,'(2i8,7e15.7)', err= 1000) n1, n2, fld
53             if (if_write) write(unit_out,'(2i8,7e15.7)') num, levels, fld  
54          end if
55          read(unit_in,'(i8)', err=1000)levels
56          if (if_write) write(unit_out,'(i8)')levels
57          do k = 1, levels
58             read(unit_in,'(2i8,7e15.7)', err= 1000) n1, n2, fld  
59             if (if_write) write(unit_out,'(2i8,7e15.7)') num, k, fld
60          end do
61       end do
62    end if
63    if (if_write) exit reports
64    cycle reports
65 1000  continue 
66    write(unit=message(1), fmt='(a,i3,a,a)') &
67       'read error on unit: ',unit_in, ' for iv_type', trim(iv_type)
68    ! call da_warning(__FILE__,__LINE__,message(1:1))
69    end do reports
70  999  continue 
71    close (unit_in)
72    call da_free_unit(unit_in)
73 
74    if (trace_use_dull) call da_trace_exit("da_read_y_unit")
75 
76 end subroutine da_read_y_unit
77 
78