var/da/da_ships/da_check_max_iv_ships.inc

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