var/da/da_lightning/da_calculate_grady_lightning.inc

   1 subroutine da_calculate_grady_lightning(iv, re, jo_grad_y)
   2
   3    !----------------------------------------------------------------------
   4    ! Purpose: Applies obs inverse on re-vector
   5    ! Authors: Z Chen (zchen@fjnu.edu.cn), Jenny Sun (NCAR), X Qie (IAP)
   6    !------------------------------------------------------------------------------
   7    implicit none
   8
   9    type (iv_type), intent(in)     :: iv          ! Innovation vector.
  10    type (y_type),  intent(inout)  :: re          ! Residual vector.
  11    type (y_type),  intent(inout)  :: jo_grad_y   ! Grad_y(Jo)
  12
  13    integer  :: n, k
  14
  15    if (trace_use_dull) call da_trace_entry("da_calculate_grady_lightning")
  16
  17    do n = 1, iv%info(lightning)%nlocal
  18       do k = 2, iv%info(lightning)%levels(n)
  19
  20          if(use_lightning_w) then
  21            if(iv%lightning(n)%w(k)%qc < obs_qc_pointer) then
  22              re%lightning(n)%w(k) = 0.0
  23            end if
  24            jo_grad_y%lightning(n)%w(k) = -re%lightning(n)%w(k) / (iv%lightning(n)%w(k)%error * iv%lightning(n)%w(k)%error)
  25          end if
  26
  27          if(use_lightning_div) then
  28            if(iv%lightning(n)%div(k)%qc < obs_qc_pointer) then
  29              re%lightning(n)%div(k) = 0.0
  30            end if
  31            jo_grad_y%lightning(n)%div(k) = -re%lightning(n)%div(k) / (iv%lightning(n)%div(k)%error * iv%lightning(n)%div(k)%error)
  32          end if
  33
  34          if(use_lightning_qv) then
  35            if(iv%lightning(n)%qv(k)%qc < obs_qc_pointer) then
  36              re%lightning(n)%qv(k) = 0.0
  37            end if
  38            jo_grad_y%lightning(n)%qv(k) = -re%lightning(n)%qv(k) / (iv%lightning(n)%qv(k)%error * iv%lightning(n)%qv(k)%error)
  39          end if
  40
  41       end do
  42    end do
  43
  44    if (trace_use_dull) call da_trace_exit("da_calculate_grady_lightning")
  45
  46 end subroutine da_calculate_grady_lightning