da_max_error_qc.inc

1 subroutine da_max_error_qc (it, info, field, max_error, ix, ixf, iunit, var, &
2                          failed, print)
3 
4    !-----------------------------------------------------------------------
5    ! Purpose: TBD
6    !-----------------------------------------------------------------------
7 
8    implicit none
9 
10    integer          ,   intent (in)   :: it
11    type (info_type) ,   intent(in)    :: info
12    type (field_type),   intent(inout) :: field
13    real             ,   intent(in)    :: max_error
14    integer          ,   intent(inout) :: ix, ixf
15    integer          ,   intent(in)    :: iunit
16    character (len=*),   intent(in)    :: var
17    logical          ,   intent(out)   :: failed
18    logical          ,   intent(in)    :: print
19 
20    real                               :: err, err_max
21    integer                            :: qc_flag
22 
23    failed = .false.
24 
25    qc_flag = field % qc
26    err_max = field % error * max_error
27    err     = field % inv
28    err     = ABS (err)
29 
30    ix     = ix + 1
31    if (it > 1 .and. qc_flag == fails_error_max) field%qc = 0
32    if (err > err_max) then
33       if (field % qc > fails_error_max) field % qc = fails_error_max 
34 
35       ixf = ixf + 1
36       failed = .true.
37 
38       if (print .and. failed) then
39          if (err_max .LE. 0.) then
40             write (unit=iunit , fmt = '(A,3(F10.1,1X),A,A,A,A5,A,A,3f10.2)')   &
41                    "Err_max < 0 ==> ",err,err_max,max_error, " for ", var, &
42                    " OBS ID: ", info % id, info % platform,     &
43                    " LA/LON/ELV:", info % lat, info % lon, info % elv
44             ! call da_error(__FILE__,__LINE__,(/"Erk"/))
45          end if
46 
47          write (unit=iunit , fmt = '(A,A5,A,A,I5,A,I3,A,F4.1,A,A,A,2e13.6)') &
48                 "Err_max failed:ID=", info % id, info % platform,&
49                 "Ix=", ix, " Ixf=", ixf, " Err_max ratio =",err/err_max, &
50                 " for ", var, " inv, error:",field % inv, field % error
51       end if
52       field % inv = 0.0
53    end if
54 
55 end subroutine da_max_error_qc
56 
57