var/da/da_obs_io/da_read_errfac.inc

   1 subroutine da_read_errfac(ob_name, f1, f2, f3, f4, f5)
   2
   3    !-----------------------------------------------------------------------
   4    ! Purpose: TBD
   5    !-----------------------------------------------------------------------
   6
   7    implicit none
   8
   9    character (len=5), intent(in)  :: ob_name
  10    real,              intent(out) :: f1
  11    real,              intent(out) :: f2
  12    real,              intent(out) :: f3
  13    real,              intent(out) :: f4
  14    real,              intent(out) :: f5
  15
  16    character (len=5)  :: ob_name1
  17    character (len=21) :: string1
  18    character (len=91) :: string2
  19    integer            :: fac_unit
  20    real               :: d1, d2, d3, d4, d5
  21
  22    f1 = 1.0
  23    f2 = 1.0
  24    f3 = 1.0
  25    f4 = 1.0
  26    f5 = 1.0
  27
  28    if (trace_use_dull) call da_trace_entry("da_read_errfac")
  29
  30    call da_get_unit(fac_unit)
  31    open(unit=fac_unit, status='old', file = 'errfac.dat', iostat=ierr)
  32
  33    if (ierr == 0) then
  34       do
  35          read(unit=fac_unit,fmt='(1x,a5,a21,a91)')ob_name1, string1, string2
  36
  37          if (ob_name == ob_name1 .and. string1 == ' obs, Error Factor = ') then
  38             read(unit=string2(17:31),fmt=*)d1
  39             read(unit=string2(32:46),fmt=*)d2
  40             read(unit=string2(47:61),fmt=*)d3
  41             read(unit=string2(62:76),fmt=*)d4
  42             read(unit=string2(77:91),fmt=*)d5
  43             if (d1 > 0.0) f1 = d1
  44             if (d2 > 0.0) f2 = d2
  45             if (d3 > 0.0) f3 = d3
  46             if (d4 > 0.0) f4 = d4
  47             if (d5 > 0.0) f5 = d5
  48
  49             exit
  50          else if (ob_name1 == 'Total') then
  51             write(unit=message(1),fmt='(a,a)') ' No Tuning Error factors for ', ob_name
  52             write(unit=message(2),fmt='(a)') ' So setting to 1.0 i.e. default errors.'
  53             call da_warning(__FILE__,__LINE__,message(1:2))
  54             exit
  55          end if
  56       end do
  57    else
  58       call da_warning(__FILE__,__LINE__, (/"Problem reading errfac.dat - Not tuning ob errors"/))
  59    end if
  60
  61    close(fac_unit)
  62    call da_free_unit(fac_unit)
  63
  64    if (trace_use_dull) call da_trace_exit("da_read_errfac")
  65
  66 end subroutine da_read_errfac
  67
  68