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 :: iv_type               
17    logical   :: if_write
18    
19    real         :: fld(10), fld1_rad , fld2_rad                         
20    integer      :: n, k, n1,n2, levels, ios
21 
22    if (trace_use) call da_trace_entry("da_read_rand_unit")
23 
24    open(unit=unit_in,   file=trim(filename), status='old',iostat=ios)
25    if (ios /= 0) then
26       call da_error(__FILE__,__LINE__, &
27          (/"Cannot open file"//trim(filename)/))
28    end if
29 1  continue
30   
31 
32    read(unit_in,'(a20,i8)', end = 999, err = 1000)iv_type,num_obs                    
33    
34    if_write = .false.
35    if (index(iv_type,OBS_type_in(1:nc)) > 0) if_write = .true.
36 
37    ! If radiance data treat differently
38    if ( index(iv_type,'noaa') > 0  .or. index(iv_type,'eos') > 0 .or.  &
39         index(iv_type,'dmsp') > 0 ) then
40       do n = 1, num_obs
41          if (if_write) num = num + 1
42          read(unit_in,'(2i8,f10.3,e15.7)')n1, n2, fld1_rad,fld2_rad
43          if (if_write)write(rand_unit,'(2i8,f10.3,e15.7)')num,n2, fld1_rad,fld2_rad
44       end do
45    else
46       do n = 1, num_obs        
47          if (if_write) num = num + 1
48          if (index(iv_type,'bogus')     > 0)  then
49             read(unit_in,'(i8)', err=1000)levels
50             if (if_write) write(rand_unit,'(i8)')levels
51             read(unit_in,'(2i8,10e15.7)', err= 1000) n1, n2, fld
52             if (if_write) write(rand_unit,'(2i8,10e15.7)') num, levels, fld  
53          end if
54          read(unit_in,'(i8)', err=1000)levels
55          if (if_write) write(rand_unit,'(i8)')levels
56          do k = 1, levels
57             read(unit_in,'(2i8,10e15.7)', err= 1000) n1, n2, fld  
58             if (if_write) write(rand_unit,'(2i8,10e15.7)') num, k, fld
59          end do
60       end do
61    end if
62 
63    if (if_write)  goto 999
64    goto 1
65 
66 999 continue
67    close (unit_in)
68    if (trace_use) call da_trace_exit("da_read_rand_unit")
69    return
70 
71 1000  continue 
72    write(unit=message(1), fmt='(/a,i3/a/)') &
73               'read error on unit: ',unit_in, &
74               'in da_read_rand_unit'
75    call da_warning(__FILE__,__LINE__,message(1:1))
76 
77    if (trace_use) call da_trace_exit("da_read_rand_unit")
78 
79 end subroutine da_read_rand_unit
80 
81