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