wrfv2_fire/var/da/da_airep/da_check_max_iv_airep.inc

   1 subroutine da_check_max_iv_airep(iv, it, num_qcstat_conv)
   2
   3    !-----------------------------------------------------------------------
   4    ! Purpose: TBD
   5    !    Removed Outerloop check as it is done in da_get_innov
   6    !    Author: Syed RH Rizvi,  MMM/NESL/NCAR,  Date: 07/12/2009
   7    !-----------------------------------------------------------------------
   8
   9    implicit none
  10
  11    type(iv_type), intent(inout) :: iv
  12    integer,       intent(in)    :: it      ! Outer iteration
  13    integer,       intent(inout) :: num_qcstat_conv(:,:,:,:)
  14
  15    integer :: k,n, ipr
  16    logical :: failed
  17
  18    if (trace_use_dull) call da_trace_entry("da_check_max_iv_airep")
  19
  20    !---------------------------------------------------------------------------
  21    ! [1.0] Perform maximum innovation vector check:
  22    !---------------------------------------------------------------------------
  23
  24    do n = iv%info(airep)%n1,iv%info(airep)%n2
  25       do k = 1, iv%info(airep)%levels(n)
  26          call da_get_print_lvl(iv%airep(n)%p(k),ipr)
  27
  28         failed=.false.
  29         if( iv%airep(n)%u(k)%qc >= obs_qc_pointer ) &
  30          call da_max_error_qc (it,iv%info(airep), n, iv%airep(n)%u(k), max_error_uv,failed)
  31         if( iv%info(airep)%proc_domain(k,n) ) then
  32           num_qcstat_conv(1,airep,1,ipr) = num_qcstat_conv(1,airep,1,ipr) + 1
  33          if(failed) then
  34           num_qcstat_conv(2,airep,1,ipr) = num_qcstat_conv(2,airep,1,ipr) + 1
  35            write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')&
  36            'airep',ob_vars(1),iv%info(airep)%lat(k,n),iv%info(airep)%lon(k,n),0.01*iv%airep(n)%p(k)
  37          end if
  38         end if
  39
  40         failed=.false.
  41         if( iv%airep(n)%v(k)%qc >= obs_qc_pointer ) &
  42          call da_max_error_qc (it,iv%info(airep), n, iv%airep(n)%v(k), max_error_uv,failed)
  43         if( iv%info(airep)%proc_domain(k,n) ) then
  44            num_qcstat_conv(1,airep,2,ipr) = num_qcstat_conv(1,airep,2,ipr) + 1
  45          if(failed)then
  46            num_qcstat_conv(2,airep,2,ipr) = num_qcstat_conv(2,airep,2,ipr) + 1
  47            write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')&
  48            'airep',ob_vars(2),iv%info(airep)%lat(k,n),iv%info(airep)%lon(k,n),0.01*iv%airep(n)%p(k)
  49          end if
  50         end if
  51
  52         failed=.false.
  53         if( iv%airep(n)%t(k)%qc >= obs_qc_pointer ) &
  54          call da_max_error_qc (it,iv%info(airep), n, iv%airep(n)%t(k), max_error_t,failed)
  55         if( iv%info(airep)%proc_domain(k,n) ) then
  56          num_qcstat_conv(1,airep,3,ipr) = num_qcstat_conv(1,airep,3,ipr) + 1
  57          if(failed) then
  58           num_qcstat_conv(2,airep,3,ipr) = num_qcstat_conv(2,airep,3,ipr) + 1
  59            write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')&
  60            'airep',ob_vars(3),iv%info(airep)%lat(k,n),iv%info(airep)%lon(k,n),0.01*iv%airep(n)%p(k)
  61          end if
  62         end if
  63
  64       end do
  65    end do
  66
  67    if (trace_use_dull) call da_trace_exit("da_check_max_iv_airep")
  68
  69 end subroutine da_check_max_iv_airep