da_read_rand_unit.inc

1 subroutine da_read_rand_unit(filename, unit_in,num,obs_type_in, nc)
2 
3    !----------------------------------------------------------------------------   
4    ! Purpose: Program to read diagnostics written on rand_unit by WRF-Var
5    !----------------------------------------------------------------------------   
6 
7    implicit none
8 
9    integer      ,intent (in)    :: unit_in
10    integer      ,intent (inout) :: num
11    character*(*),intent (in)    :: obs_type_in 
12    character*(*),intent (inout) :: filename                    
13    integer      ,intent (in)    :: nc      
14 
15    integer      :: num_obs 
16    character*20 :: ob_type               
17    logical   :: if_write
18    
19    real         :: fld(10), fld1_rad , fld2_rad                         
20    integer      :: n, k, n1,n2, levels, ios
21 
22    open(unit=unit_in,   file=trim(filename), status='old',iostat=ios)
23    if (ios /= 0) Then
24       call da_error(__FILE__,__LINE__, &
25          (/"Cannot open file"//trim(filename)/))
26    end if
27 1  continue
28   
29 
30    read(unit_in,'(a20,i8)', end = 999, err = 1000)ob_type,num_obs                    
31    
32    if_write = .false.
33    if (index(ob_type,OBS_type_in(1:nc)) > 0) if_write = .true.
34 
35    ! If radiance data treat differently
36    if ( index(ob_type,'noaa') > 0  .or. index(ob_type,'eos') > 0 .or.  &
37         index(ob_type,'dmsp') > 0 ) then
38       do n = 1, num_obs
39          if (if_write) num = num + 1
40          read(unit_in,'(2i8,f10.3,e15.7)')n1, n2, fld1_rad,fld2_rad
41          if (if_write)write(rand_unit,'(2i8,f10.3,e15.7)')num,n2, fld1_rad,fld2_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(rand_unit,'(i8)')levels
49             read(unit_in,'(2i8,10e15.7)', err= 1000) n1, n2, fld
50             if (if_write) write(rand_unit,'(2i8,10e15.7)') num, levels, fld  
51          end if
52          read(unit_in,'(i8)', err=1000)levels
53          if (if_write) write(rand_unit,'(i8)')levels
54          do k = 1, levels
55             read(unit_in,'(2i8,10e15.7)', err= 1000) n1, n2, fld  
56             if (if_write) write(rand_unit,'(2i8,10e15.7)') num, k, fld
57          end do
58       end do
59    end if
60 
61    if (if_write)  goto 999
62    goto 1
63 
64 999 continue
65      close (unit_in)
66      return
67 1000  continue 
68    write(unit=message(1), fmt='(/a,i3/a/)') &
69               'read error on unit: ',unit_in, &
70               'in da_read_rand_unit'
71    call da_warning(__FILE__,__LINE__,message(1:1))
72 
73 end subroutine da_read_rand_unit
74 
75