var/da/da_sound/da_check_max_iv_sonde_sfc.inc

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