var/da/da_tamdar/da_jo_and_grady_tamdar_sfc.inc

   1 subroutine da_jo_and_grady_tamdar_sfc( iv, re, jo, jo_grad_y)
   2
   3    !-----------------------------------------------------------------------
   4    ! Purpose: TBD
   5    !-----------------------------------------------------------------------
   6
   7    implicit none
   8
   9    type(iv_type), intent(in)    :: iv          ! Innovation vector.
  10    type(y_type),  intent(in)    :: re          ! Residual vector.
  11    type(y_type),  intent(inout) :: jo_grad_y   ! Grad_y(Jo)
  12    type(jo_type), intent(inout) :: jo          ! Obs cost function.
  13
  14    integer                      :: n
  15    ! the following "global" objects are used only when testing
  16    type(iv_type) :: iv_glob         ! Global Innovation vector(O-B).
  17    type(y_type)  :: re_glob         ! Global Residual vector(O-A).
  18    type(y_type)  :: jo_grad_y_glob  ! Global Grad_y(Jo)
  19
  20    if (trace_use_dull) call da_trace_entry("da_jo_and_grady_tamdar_sfc")
  21
  22    jo % tamdar_sfc_u = 0.0
  23    jo % tamdar_sfc_v = 0.0
  24    jo % tamdar_sfc_t = 0.0
  25    jo % tamdar_sfc_p = 0.0
  26    jo % tamdar_sfc_q = 0.0
  27
  28    if (test_dm_exact) then
  29       if (iv%info(tamdar_sfc)%ntotal == 0) then
  30          if (trace_use_dull) call da_trace_exit("da_jo_and_grady_tamdar_sfc")
  31          return
  32       end if
  33    else
  34       if (iv%info(tamdar_sfc)%nlocal < 1) then
  35          if (trace_use_dull) call da_trace_exit("da_jo_and_grady_tamdar_sfc")
  36          return
  37       end if
  38    end if
  39
  40    do n=1, iv%info(tamdar_sfc)%nlocal
  41       jo_grad_y%tamdar_sfc(n)%u = -re%tamdar_sfc(n)%u / (iv%tamdar_sfc(n)%u%error * iv%tamdar_sfc(n)%u%error)
  42       jo_grad_y%tamdar_sfc(n)%v = -re%tamdar_sfc(n)%v / (iv%tamdar_sfc(n)%v%error * iv%tamdar_sfc(n)%v%error)
  43       jo_grad_y%tamdar_sfc(n)%t = -re%tamdar_sfc(n)%t / (iv%tamdar_sfc(n)%t%error * iv%tamdar_sfc(n)%t%error)
  44       jo_grad_y%tamdar_sfc(n)%p = -re%tamdar_sfc(n)%p / (iv%tamdar_sfc(n)%p%error * iv%tamdar_sfc(n)%p%error)
  45       jo_grad_y%tamdar_sfc(n)%q = -re%tamdar_sfc(n)%q / (iv%tamdar_sfc(n)%q%error * iv%tamdar_sfc(n)%q%error)
  46    end do
  47
  48       call da_jo_tamdar_sfc_uvtq( iv, re, jo_grad_y, jo)
  49
  50    jo % tamdar_sfc_u = 0.5 * jo % tamdar_sfc_u
  51    jo % tamdar_sfc_v = 0.5 * jo % tamdar_sfc_v
  52    jo % tamdar_sfc_t = 0.5 * jo % tamdar_sfc_t
  53    jo % tamdar_sfc_p = 0.5 * jo % tamdar_sfc_p
  54    jo % tamdar_sfc_q = 0.5 * jo % tamdar_sfc_q
  55    if (trace_use_dull) call da_trace_exit("da_jo_and_grady_tamdar_sfc")
  56
  57 end subroutine da_jo_and_grady_tamdar_sfc
  58
  59