var/da/da_obs_io/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"//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) .or. (index(iv_type,'metop') > 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