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 :: ob_type               
16    logical      :: if_write
17    
18    real         :: fld(7), fld_rad                          
19    integer      :: n, k, n1,n2, levels
20 
21    ob_type="Unknown"
22 
23    call da_get_unit(unit_in)
24    open(unit=unit_in,file=trim(filename),form='formatted',iostat=ios,status='old')
25    if (ios /= 0) Then
26       call da_error(__FILE__,__LINE__, &
27          (/"Cannot open random observation error file"//trim(filename)/))
28    end if
29 
30    reports: do
31    read(unit_in,'(a20,i8)', end = 999, err = 1000) ob_type,num_obs                    
32    
33    if_write = .false.
34    if (index(ob_type,OBS_type_in(1:nc)) > 0) if_write = .true.
35 
36    ! If radiance data treat differently
37    if ( (index(ob_type,'noaa') > 0) .or. (index(ob_type,'eos') > 0) .or.   &
38         (index(ob_type,'dmsp') > 0) ) then             
39       do n = 1, num_obs        
40          if (if_write) num = num + 1
41          read(unit_in,'(2i8,e15.7)')n1, n2, fld_rad                              
42          if (if_write)write(unit_out,'(2i8,e15.7)')num,n2, fld_rad                              
43       end do
44    else    
45       do n = 1, num_obs        
46          if (if_write) num = num + 1
47          if (index(ob_type,'bogus') > 0) then
48             read(unit_in,'(i8)', err=1000)levels
49             if (if_write) write(unit_out,'(i8)')levels
50             read(unit_in,'(2i8,7e15.7)', err= 1000) n1, n2, fld
51             if (if_write) write(unit_out,'(2i8,7e15.7)') num, levels, fld  
52          end if
53          read(unit_in,'(i8)', err=1000)levels
54          if (if_write) write(unit_out,'(i8)')levels
55          do k = 1, levels
56             read(unit_in,'(2i8,7e15.7)', err= 1000) n1, n2, fld  
57             if (if_write) write(unit_out,'(2i8,7e15.7)') num, k, fld
58          end do
59       end do
60    end if
61    if (if_write) exit reports
62    cycle reports
63 1000  continue 
64    write(unit=message(1), fmt='(a,i3,a,a)') &
65       'read error on unit: ',unit_in, ' for ob_type', trim(ob_type)
66 !   call da_warning(__FILE__,__LINE__,message(1:1))
67    end do reports
68  999  continue 
69    close (unit_in)
70    call da_free_unit(unit_in)
71 
72 end subroutine da_read_y_unit
73 
74