var/da/da_mtgirs/da_check_max_iv_mtgirs.inc

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