var/da/da_metar/da_check_max_iv_metar.inc

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