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    call da_get_unit(fac_unit)
29    open(unit=fac_unit, status='old', file = 'wrfvar_run/errfac.dat', iostat=ierr)
30 
31    if (ierr == 0) then
32       do 
33          read(unit=fac_unit,fmt='(1x,a5,a21,a91)')ob_name1, string1, string2
34 
35          if (ob_name == ob_name1 .and. &
36               string1 == ' obs, Error Factor = ') then
37             read(unit=string2(17:31),fmt=*)d1
38             read(unit=string2(32:46),fmt=*)d2
39             read(unit=string2(47:61),fmt=*)d3
40             read(unit=string2(62:76),fmt=*)d4
41             read(unit=string2(77:91),fmt=*)d5
42             if (d1 > 0.0) f1 = d1
43             if (d2 > 0.0) f2 = d2
44             if (d3 > 0.0) f3 = d3
45             if (d4 > 0.0) f4 = d4
46             if (d5 > 0.0) f5 = d5
47 
48             exit
49          else if (ob_name1 == 'Total') then
50             write(unit=message(1),fmt='(a,a)') &
51                ' No Tuning Error factors for ', ob_name
52             write(unit=message(2),fmt='(a)') &
53                ' So setting to 1.0 i.e. default errors.'  
54             call da_warning(__FILE__,__LINE__,message(1:2))
55             exit
56          end if
57       end do     
58    else   
59       call da_warning(__FILE__,__LINE__, &
60          (/"Problem reading errfac.dat - Not tuning ob errors"/))
61    end if
62 
63    close(fac_unit)
64    call da_free_unit(fac_unit)
65 
66 end subroutine da_read_errfac
67 
68