wrfv2_fire/var/da/da_profiler/da_check_max_iv_profiler.inc

   1 subroutine da_check_max_iv_profiler(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
  18
  19    if (trace_use_dull) call da_trace_entry("da_check_max_iv_profiler")
  20
  21    !---------------------------------------------------------------------------
  22    ! [1.0] Perform maximum innovation vector check:
  23    !---------------------------------------------------------------------------
  24
  25    do n = iv%info(profiler)%n1,iv%info(profiler)%n2
  26       do k = 1, iv%info(profiler)%levels(n)
  27
  28        call da_get_print_lvl(iv%profiler(n)%p(k),ipr)
  29
  30         failed=.false.
  31         if( iv%profiler(n)%u(k)%qc >= obs_qc_pointer )  &
  32          call da_max_error_qc(it, iv%info(profiler), n, iv%profiler(n)%u(k), max_error_uv, failed)
  33         if( iv%info(profiler)%proc_domain(k,n) ) then
  34             num_qcstat_conv(1,profiler,1,ipr) = num_qcstat_conv(1,profiler,1,ipr) + 1
  35          if(failed)then
  36           num_qcstat_conv(2,profiler,1,ipr) = num_qcstat_conv(2,profiler,1,ipr) + 1
  37         write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')&
  38         'profiler',ob_vars(1),iv%info(profiler)%lat(k,n),iv%info(profiler)%lon(k,n),0.01*iv%profiler(n)%p(k)
  39          end if
  40          end if
  41
  42         failed=.false.
  43         if( iv%profiler(n)%v(k)%qc >= obs_qc_pointer )  &
  44          call da_max_error_qc(it, iv%info(profiler), n, iv%profiler(n)%v(k), max_error_uv, failed)
  45         if( iv%info(profiler)%proc_domain(k,n) ) then
  46             num_qcstat_conv(1,profiler,2,ipr) = num_qcstat_conv(1,profiler,2,ipr) + 1
  47          if(failed)then
  48           num_qcstat_conv(2,profiler,2,ipr) = num_qcstat_conv(2,profiler,2,ipr) + 1
  49         write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')&
  50         'profiler',ob_vars(2),iv%info(profiler)%lat(k,n),iv%info(profiler)%lon(k,n),0.01*iv%profiler(n)%p(k)
  51          end if
  52          end if
  53
  54       end do
  55    end do
  56
  57    if (trace_use_dull) call da_trace_exit("da_check_max_iv_profiler")
  58
  59 end subroutine da_check_max_iv_profiler