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