wrfv2_fire/var/da/da_sound/da_check_max_iv_sound.inc

   1 subroutine da_check_max_iv_sound(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_sound")
  20
  21    !---------------------------------------------------------------------------
  22    ! [1.0] Perform maximum innovation vector check:
  23    !---------------------------------------------------------------------------
  24
  25    do n = iv%info(sound)%n1,iv%info(sound)%n2
  26       do k = 1, iv%info(sound)%levels(n)
  27          call da_get_print_lvl(iv%sound(n)%p(k),ipr)
  28          failed=.false.
  29          if( iv%sound(n)%u(k)%qc >= obs_qc_pointer )  &
  30          call da_max_error_qc (it,iv%info(sound), n, iv%sound(n)%u(k), max_error_uv,failed)
  31          if( iv%info(sound)%proc_domain(k,n) ) then
  32                     num_qcstat_conv(1,sound,1,ipr) = num_qcstat_conv(1,sound,1,ipr) + 1
  33          if(failed) then
  34           num_qcstat_conv(2,sound,1,ipr) = num_qcstat_conv(2,sound,1,ipr) + 1
  35            write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')&
  36            'sound',ob_vars(1),iv%info(sound)%lat(k,n),iv%info(sound)%lon(k,n),0.01*iv%sound(n)%p(k)
  37          end if
  38          end if
  39
  40          failed=.false.
  41          if( iv%sound(n)%v(k)%qc >= obs_qc_pointer )  &
  42          call da_max_error_qc (it,iv%info(sound), n, iv%sound(n)%v(k), max_error_uv,failed)
  43          if( iv%info(sound)%proc_domain(k,n) ) then
  44                     num_qcstat_conv(1,sound,2,ipr) = num_qcstat_conv(1,sound,2,ipr) + 1
  45          if(failed) then
  46           num_qcstat_conv(2,sound,2,ipr) = num_qcstat_conv(2,sound,2,ipr) + 1
  47            write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')&
  48            'sound',ob_vars(2),iv%info(sound)%lat(k,n),iv%info(sound)%lon(k,n),0.01*iv%sound(n)%p(k)
  49          end if
  50          end if
  51
  52          failed=.false.
  53          if( iv%sound(n)%t(k)%qc >= obs_qc_pointer )  &
  54          call da_max_error_qc (it,iv%info(sound), n, iv%sound(n)%t(k), max_error_t ,failed)
  55          if( iv%info(sound)%proc_domain(k,n) ) then
  56                     num_qcstat_conv(1,sound,3,ipr) = num_qcstat_conv(1,sound,3,ipr) + 1
  57          if(failed) then
  58           num_qcstat_conv(2,sound,3,ipr) = num_qcstat_conv(2,sound,3,ipr) + 1
  59            write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')&
  60            'sound',ob_vars(3),iv%info(sound)%lat(k,n),iv%info(sound)%lon(k,n),0.01*iv%sound(n)%p(k)
  61          end if
  62          end if
  63
  64          failed=.false.
  65          if( iv%sound(n)%q(k)%qc >= obs_qc_pointer ) then
  66           if( iv%sound(n)%t(k)%qc == fails_error_max ) then
  67           failed=.true.
  68           iv%sound(n)%q(k)%qc  = fails_error_max
  69           iv%sound(n)%q(k)%inv = 0.0
  70           else
  71           call da_max_error_qc (it,iv%info(sound), n, iv%sound(n)%q(k), max_error_q ,failed)
  72           endif
  73          if( iv%info(sound)%proc_domain(k,n) ) then
  74                     num_qcstat_conv(1,sound,4,ipr) = num_qcstat_conv(1,sound,4,ipr) + 1
  75          if(failed) then
  76          num_qcstat_conv(2,sound,4,ipr) = num_qcstat_conv(2,sound,4,ipr) + 1
  77            write(qcstat_conv_unit,'(2x,a10,2x,a4,3f12.2)')&
  78            'sound',ob_vars(4),iv%info(sound)%lat(k,n),iv%info(sound)%lon(k,n),0.01*iv%sound(n)%p(k)
  79          end if
  80          end if
  81          end if
  82
  83       end do
  84    end do
  85
  86    if (trace_use_dull) call da_trace_exit("da_check_max_iv_sound")
  87
  88 end subroutine da_check_max_iv_sound