wrfv2_fire/var/da/da_metar/da_check_max_iv_metar.inc

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