var/da/da_obs_io/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 :: iv_type
  16    logical      :: if_write
  17
  18    real         :: fld(7), fld_rad
  19    integer      :: n, k, n1,n2, levels
  20
  21    if (trace_use_dull) call da_trace_entry("da_read_y_unit")
  22
  23    iv_type="Unknown"
  24
  25    call da_get_unit(unit_in)
  26    open(unit=unit_in,file=trim(filename),form='formatted',iostat=ios,status='old')
  27    if (ios /= 0) then
  28       call da_error(__FILE__,__LINE__, &
  29          (/"Cannot open random observation error file"//filename/))
  30    end if
  31
  32    reports: do
  33    read(unit_in,'(a20,i8)', end = 999, err = 1000) iv_type,num_obs
  34
  35    if_write = .false.
  36    if (index(iv_type,OBS_type_in(1:nc)) > 0) if_write = .true.
  37
  38    ! If radiance data treat differently
  39    if ( (index(iv_type,'noaa') > 0) .or. (index(iv_type,'eos') > 0) .or.   &
  40         (index(iv_type,'dmsp') > 0) .or. (index(iv_type,'metop') > 0) .or. &
  41         (index(iv_type,'tiros') > 0) .or. (index(iv_type,'msg') > 0) .or. &
  42         (index(iv_type,'jpss') > 0)  .or. (index(iv_type,'gcom-w') >0) .or. &
  43         (index(iv_type,'goes') > 0) .or. (index(iv_type,'himawari') >0) .or. &
  44         (index(iv_type,'fy3') >0)) then
  45
  46       do n = 1, num_obs
  47          if (if_write) num = num + 1
  48          read(unit_in,'(2i8,e15.7)')n1, n2, fld_rad
  49          if (if_write)write(unit_out,'(2i8,e15.7)')num,n2, fld_rad
  50       end do
  51    else
  52       do n = 1, num_obs
  53          if (if_write) num = num + 1
  54          if (index(iv_type,'bogus') > 0) then
  55             read(unit_in,'(i8)', err=1000)levels
  56             if (if_write) write(unit_out,'(i8)')levels
  57             read(unit_in,'(2i8,7e15.7)', err= 1000) n1, n2, fld
  58             if (if_write) write(unit_out,'(2i8,7e15.7)') num, levels, fld
  59          end if
  60          read(unit_in,'(i8)', err=1000)levels
  61          if (if_write) write(unit_out,'(i8)')levels
  62          do k = 1, levels
  63             read(unit_in,'(2i8,7e15.7)', err= 1000) n1, n2, fld
  64             if (if_write) write(unit_out,'(2i8,7e15.7)') num, k, fld
  65          end do
  66       end do
  67    end if
  68    if (if_write) exit reports
  69    cycle reports
  70 1000  continue
  71    write(unit=message(1), fmt='(a,i3,a,a)') &
  72       'read error on unit: ',unit_in, ' for iv_type', trim(iv_type)
  73    ! call da_warning(__FILE__,__LINE__,message(1:1))
  74    end do reports
  75  999  continue
  76    close (unit_in)
  77    call da_free_unit(unit_in)
  78
  79    if (trace_use_dull) call da_trace_exit("da_read_y_unit")
  80
  81 end subroutine da_read_y_unit
  82
  83