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) ) then             
38       do n = 1, num_obs        
39          if (if_write) num = num + 1
40          read(unit_in,'(2i8,e15.7)')n1, n2, fld_rad                              
41          if (if_write)write(unit_out,'(2i8,e15.7)')num,n2, fld_rad                              
42       end do
43    else    
44       do n = 1, num_obs        
45          if (if_write) num = num + 1
46          if (index(ob_type,'bogus') > 0) then
47             read(unit_in,'(i8)', err=1000)levels
48             if (if_write) write(unit_out,'(i8)')levels
49             read(unit_in,'(2i8,7e15.7)', err= 1000) n1, n2, fld
50             if (if_write) write(unit_out,'(2i8,7e15.7)') num, levels, fld  
51          end if
52          read(unit_in,'(i8)', err=1000)levels
53          if (if_write) write(unit_out,'(i8)')levels
54          do k = 1, levels
55             read(unit_in,'(2i8,7e15.7)', err= 1000) n1, n2, fld  
56             if (if_write) write(unit_out,'(2i8,7e15.7)') num, k, fld
57          end do
58       end do
59    end if
60    if (if_write) exit reports
61    cycle reports
62 1000  continue 
63    write(unit=message(1), fmt='(a,i3,a,a)') &
64       'read error on unit: ',unit_in, ' for ob_type', trim(ob_type)
65 !   call da_warning(__FILE__,__LINE__,message(1:1))
66    end do reports
67  999  continue 
68    close (unit_in)
69    call da_free_unit(unit_in)
70 
71 end subroutine da_read_y_unit
72 
73