var/da/da_synop/da_check_max_iv_synop.inc

   1 subroutine da_check_max_iv_synop(iv,ob, it, num_qcstat_conv)
   2
   3    !-------------------------------------------------------------------------
   4    ! Purpose: TBD
   5    ! Update:
   6    !    Removed Outerloop check as it is done in da_get_innov
   7    !    Author: Syed RH Rizvi,  MMM/NESL/NCAR,  Date: 07/12/2009
   8    !-------------------------------------------------------------------------
   9
  10    implicit none
  11
  12    type(iv_type), intent(inout) :: iv
  13    integer,       intent(in)    :: it      ! Outer iteration
  14    integer,       intent(inout) :: num_qcstat_conv(:,:,:,:)
  15    type(y_type),  intent(in)    :: ob      ! Observation structure.
  16
  17
  18    logical :: failed,failed1,failed2
  19    integer :: n
  20
  21    if (trace_use_dull) call da_trace_entry("da_check_max_iv_synop")
  22
  23    !---------------------------------------------------------------------------
  24    ! [1.0] Perform maximum innovation vector check:
  25    !---------------------------------------------------------------------------
  26
  27    do n=iv%info(synop)%n1,iv%info(synop)%n2
  28          if(.not. qc_rej_both)then
  29             if(wind_sd_synop)then
  30                failed=.false.
  31                if( iv%synop(n)%u%qc >= obs_qc_pointer ) then
  32                    call da_max_error_qc (it,iv%info(synop), n, iv%synop(n)%u, max_error_spd,failed)
  33                    if( iv%info(synop)%proc_domain(1,n) ) then
  34                        num_qcstat_conv(1,synop,1,1) = num_qcstat_conv(1,synop,1,1) + 1
  35                        if(failed) then
  36                           num_qcstat_conv(2,synop,1,1) = num_qcstat_conv(2,synop,1,1) + 1
  37                           if ( write_rej_obs_conv ) then
  38                           write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')&
  39                           'synop',ob_vars(1),iv%info(synop)%lat(1,n),iv%info(synop)%lon(1,n),0.01*ob%synop(n)%p
  40                           end if
  41                        end if
  42                    end if
  43                end if
  44
  45                failed=.false.
  46                if( iv%synop(n)%v%qc >= obs_qc_pointer ) then
  47                    call da_max_error_qc (it,iv%info(synop), n, iv%synop(n)%v, max_error_dir,failed)
  48                    if( iv%info(synop)%proc_domain(1,n) ) then
  49                        num_qcstat_conv(1,synop,2,1) = num_qcstat_conv(1,synop,2,1) + 1
  50                        if(failed)then
  51                           num_qcstat_conv(2,synop,2,1) = num_qcstat_conv(2,synop,2,1) + 1
  52                           if ( write_rej_obs_conv ) then
  53                           write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')&
  54                           'synop',ob_vars(2),iv%info(synop)%lat(1,n),iv%info(synop)%lon(1,n),0.01*ob%synop(n)%p
  55                           end if
  56                        end if
  57                    end if
  58                end if
  59             else
  60                failed=.false.
  61                if( iv%synop(n)%u%qc >= obs_qc_pointer ) then
  62                    call da_max_error_qc (it,iv%info(synop), n, iv%synop(n)%u, max_error_uv,failed)
  63                    if( iv%info(synop)%proc_domain(1,n) ) then
  64                        num_qcstat_conv(1,synop,1,1) = num_qcstat_conv(1,synop,1,1) + 1
  65                        if(failed) then
  66                           num_qcstat_conv(2,synop,1,1) = num_qcstat_conv(2,synop,1,1) + 1
  67                           if ( write_rej_obs_conv ) then
  68                           write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')&
  69                           'synop',ob_vars(1),iv%info(synop)%lat(1,n),iv%info(synop)%lon(1,n),0.01*ob%synop(n)%p
  70                           end if
  71                        end if
  72                    end if
  73                end if
  74
  75                failed=.false.
  76                if( iv%synop(n)%v%qc >= obs_qc_pointer ) then
  77                    call da_max_error_qc (it,iv%info(synop), n, iv%synop(n)%v, max_error_uv,failed)
  78                    if( iv%info(synop)%proc_domain(1,n) ) then
  79                        num_qcstat_conv(1,synop,2,1) = num_qcstat_conv(1,synop,2,1) + 1
  80                        if(failed)then
  81                           num_qcstat_conv(2,synop,2,1) = num_qcstat_conv(2,synop,2,1) + 1
  82                           if ( write_rej_obs_conv ) then
  83                           write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')&
  84                           'synop',ob_vars(2),iv%info(synop)%lat(1,n),iv%info(synop)%lon(1,n),0.01*ob%synop(n)%p
  85                           end if
  86                        end if
  87                    end if
  88                end if
  89             end if
  90
  91             if(wind_sd_synop)then
  92                if(iv%synop(n)%u%qc == fails_error_max .or.  abs(iv%synop(n)%u%inv) >= max_omb_spd) then
  93                   iv%synop(n)%u%qc = fails_error_max
  94                   iv%synop(n)%u%inv = 0.0
  95                endif
  96                if(iv%synop(n)%v%qc == fails_error_max .or.  abs(iv%synop(n)%v%inv) >= max_omb_dir) then
  97                   iv%synop(n)%v%qc = fails_error_max
  98                   iv%synop(n)%v%inv = 0.0
  99                endif
 100             endif
 101          else
 102             failed1=.false.
 103             failed2=.false.
 104
 105             if( iv%synop(n)%v%qc >= obs_qc_pointer .or. iv%synop(n)%u%qc >= obs_qc_pointer )  then
 106                 if(wind_sd_synop)then
 107                    call da_max_error_qc (it,iv%info(synop), n, iv%synop(n)%u, max_error_spd,failed1)
 108                    call da_max_error_qc (it,iv%info(synop), n, iv%synop(n)%v, max_error_dir,failed2)
 109                 else
 110                    call da_max_error_qc (it,iv%info(synop), n, iv%synop(n)%u, max_error_uv,failed1)
 111                    call da_max_error_qc (it,iv%info(synop), n, iv%synop(n)%v, max_error_uv,failed2)
 112                 endif
 113             endif
 114
 115             if( iv%info(synop)%proc_domain(1,n) ) then
 116                 num_qcstat_conv(1,synop,1,1) = num_qcstat_conv(1,synop,1,1) + 1
 117                 num_qcstat_conv(1,synop,2,1) = num_qcstat_conv(1,synop,2,1) + 1
 118
 119                 if(failed1 .or. failed2) then
 120                    num_qcstat_conv(2,synop,1,1) = num_qcstat_conv(2,synop,1,1) + 1
 121                    if ( write_rej_obs_conv ) then
 122                    write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')&
 123                          'synop',ob_vars(1),iv%info(synop)%lat(1,n),iv%info(synop)%lon(1,n),0.01*ob%synop(n)%p
 124                    end if
 125                    num_qcstat_conv(2,synop,2,1) = num_qcstat_conv(2,synop,2,1) + 1
 126                    if ( write_rej_obs_conv ) then
 127                    write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')&
 128                          'synop',ob_vars(2),iv%info(synop)%lat(1,n),iv%info(synop)%lon(1,n),0.01*ob%synop(n)%p
 129                    end if
 130                 endif
 131              endif
 132
 133              if(wind_sd_synop)then
 134                 if(iv%synop(n)%u%qc == fails_error_max .or. iv%synop(n)%v%qc == fails_error_max .or. &
 135                    abs(iv%synop(n)%v%inv) >= max_omb_dir .or. abs(iv%synop(n)%u%inv) >= max_omb_spd )then
 136                    iv%synop(n)%u%qc = fails_error_max
 137                    iv%synop(n)%v%qc = fails_error_max
 138                    iv%synop(n)%u%inv = 0.0
 139                    iv%synop(n)%v%inv = 0.0
 140                 endif
 141              else
 142                 if(iv%synop(n)%u%qc == fails_error_max .or. iv%synop(n)%v%qc == fails_error_max ) then
 143                    iv%synop(n)%u%qc = fails_error_max
 144                    iv%synop(n)%v%qc = fails_error_max
 145                    iv%synop(n)%u%inv = 0.0
 146                    iv%synop(n)%v%inv = 0.0
 147                 endif
 148              endif
 149           endif
 150
 151
 152       failed=.false.
 153       if( iv%synop(n)%t%qc >= obs_qc_pointer )  then
 154       call da_max_error_qc (it, iv%info(synop), n, iv%synop(n)%t, max_error_t , failed)
 155       if( iv%info(synop)%proc_domain(1,n) ) then
 156       num_qcstat_conv(1,synop,3,1)= num_qcstat_conv(1,synop,3,1) + 1
 157       if(failed) then
 158       num_qcstat_conv(2,synop,3,1)= num_qcstat_conv(2,synop,3,1) + 1
 159       if ( write_rej_obs_conv ) then
 160       write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')&
 161            'synop',ob_vars(3),iv%info(synop)%lat(1,n),iv%info(synop)%lon(1,n),0.01*ob%synop(n)%p
 162       end if
 163       end if
 164       end if
 165       end if
 166
 167       failed=.false.
 168       if( iv%synop(n)%p%qc >= obs_qc_pointer )  then
 169       call da_max_error_qc (it, iv%info(synop), n, iv%synop(n)%p, max_error_p , failed)
 170       if( iv%info(synop)%proc_domain(1,n) ) then
 171       num_qcstat_conv(1,synop,5,1)= num_qcstat_conv(1,synop,5,1) + 1
 172       if(failed) then
 173       num_qcstat_conv(2,synop,5,1)= num_qcstat_conv(2,synop,5,1) + 1
 174       if ( write_rej_obs_conv ) then
 175       write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')&
 176            'synop',ob_vars(5),iv%info(synop)%lat(1,n),iv%info(synop)%lon(1,n),0.01*ob%synop(n)%p
 177       end if
 178       end if
 179       end if
 180       end if
 181
 182       failed=.false.
 183       if( iv%synop(n)%q%qc >= obs_qc_pointer ) then
 184        if( iv%synop(n)%t%qc == fails_error_max .or. iv%synop(n)%p%qc == fails_error_max) then
 185        failed=.true.
 186        iv%synop(n)%q%qc  = fails_error_max
 187        iv%synop(n)%q%inv = 0.0
 188        else
 189        call da_max_error_qc (it, iv%info(synop), n, iv%synop(n)%q, max_error_q , failed)
 190        endif
 191       if( iv%info(synop)%proc_domain(1,n) ) then
 192       num_qcstat_conv(1,synop,4,1)= num_qcstat_conv(1,synop,4,1) + 1
 193       if(failed) then
 194       num_qcstat_conv(2,synop,4,1)= num_qcstat_conv(2,synop,4,1) + 1
 195       if ( write_rej_obs_conv ) then
 196       write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')&
 197            'synop',ob_vars(4),iv%info(synop)%lat(1,n),iv%info(synop)%lon(1,n),0.01*ob%synop(n)%p
 198       end if
 199       end if
 200       end if
 201       end if
 202    end do
 203
 204    if (trace_use_dull) call da_trace_exit("da_check_max_iv_synop")
 205
 206 end subroutine da_check_max_iv_synop
 207
 208