var/da/da_buoy/da_check_max_iv_buoy.inc

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