var/da/da_physics/da_tv_profile_adj.inc

   1 subroutine da_tv_profile_adj(grid,jo_grad_x,info, n,pre_ma,tv_ma,ADJ_pre_ma, ADJ_tv_ma)
   2
   3    !-----------------------------------------------------------------------
   4    ! Purpose: adjoint routine for da_tv_profile
   5    !-----------------------------------------------------------------------
   6
   7    implicit none
   8
   9    type (x_type),         intent(inout) :: jo_grad_x ! grad_x(jo)
  10    type (infa_type),      intent(in)    :: info
  11    integer,               intent(in)    :: n
  12    type (domain),         intent(in)    :: grid
  13    real,                  intent(in)    :: pre_ma(kts-1:kte+1)
  14    real,                  intent(in)    :: tv_ma(kts-1:kte+1)
  15    real,                  intent(inout) :: ADJ_pre_ma(kts-1:kte+1)
  16    real,                  intent(inout) :: ADJ_tv_ma(kts-1:kte+1)
  17
  18    integer :: ii,jj
  19    real    :: ADJ_tv_m(2,2,kts:kte)
  20    integer :: i, j      ! OBS location
  21    real    :: dx, dxm   ! interpolation weights.
  22    real    :: dy, dym   ! interpolation weights.
  23
  24    if (trace_use_dull) call da_trace_entry("da_tv_profile_adj")
  25
  26    i   = info%i(1,n)
  27    j   = info%j(1,n)
  28    dx  = info%dx(1,n)
  29    dy  = info%dy(1,n)
  30    dxm = info%dxm(1,n)
  31    dym = info%dym(1,n)
  32
  33    ADJ_tv_m(1,1,kts:kte) = dym*dxm * ADJ_tv_ma (kts:kte)
  34    ADJ_tv_m(2,1,kts:kte) = dym*dx *  ADJ_tv_ma (kts:kte)
  35    ADJ_tv_m(1,2,kts:kte) = dy*dxm*   ADJ_tv_ma (kts:kte)
  36    ADJ_tv_m(2,2,kts:kte) = dy*dx*    ADJ_tv_ma (kts:kte)
  37
  38    jo_grad_x%p(i,j,kts:kte)     = jo_grad_x%p(i,j,kts:kte) + dym*dxm  * ADJ_pre_ma(kts:kte)
  39    jo_grad_x%p(i+1,j,kts:kte)   = jo_grad_x%p(i+1,j,kts:kte) + dym*dx * ADJ_pre_ma(kts:kte)
  40    jo_grad_x%p(i,j+1,kts:kte)   = jo_grad_x%p(i,j+1,kts:kte) + dy*dxm * ADJ_pre_ma(kts:kte)
  41    jo_grad_x%p(i+1,j+1,kts:kte) = jo_grad_x%p(i+1,j+1,kts:kte) + dy*dx* ADJ_pre_ma(kts:kte)
  42
  43    ADJ_tv_ma (kts:kte) = 0.0
  44    ADJ_pre_ma(kts:kte) = 0.0
  45
  46    do ii=i,i+1
  47       do jj=j,j+1
  48          jo_grad_x%t(ii,jj,kts:kte) = jo_grad_x%t(ii,jj,kts:kte) + &
  49             ADJ_tv_m(ii-i+1,jj-j+1,kts:kte)*(1.0+0.61*grid%xb%q(ii,jj,kts:kte))
  50          jo_grad_x%q(ii,jj,kts:kte) = jo_grad_x%q(ii,jj,kts:kte) + &
  51             0.61*grid%xb%t(ii,jj,kts:kte)*ADJ_tv_m(ii-i+1,jj-j+1,kts:kte)
  52       end do
  53    end do
  54
  55    if (trace_use_dull) call da_trace_exit("da_tv_profile_adj")
  56
  57 end subroutine da_tv_profile_adj
  58
  59