var/da/da_physics/da_pt_to_rho_adj.inc

   1 subroutine da_pt_to_rho_adj(grid)
   2
   3    !---------------------------------------------------------------------------
   4    !  Purpose: Adjoint of da_pt_to_rho.
   5    !
   6    !  Assumptions: 1) Model level stored top down
   7    !---------------------------------------------------------------------------
   8
   9    implicit none
  10
  11    type (domain), intent(inout)  :: grid
  12
  13    integer                       :: i,j,k        ! Loop counter.
  14
  15    integer                       :: is, ie, js, je
  16
  17    real                          :: temp
  18
  19    if (trace_use) call da_trace_entry("da_pt_to_rho_adj")
  20
  21    is = its
  22    js = jts
  23
  24    ie = ite
  25    je = jte
  26
  27    if (test_transforms) then
  28       is = its-1
  29       js = jts-1
  30
  31       ie = ite+1
  32       je = jte+1
  33
  34       if (is < ids) is = ids
  35       if (js < jds) js = jds
  36
  37       if (ie > ide) ie = ide
  38       if (je > jde) je = jde
  39    end if
  40
  41    !---------------------------------------------------------------------------
  42    ! Calculate rho increments:
  43    !---------------------------------------------------------------------------
  44
  45    do j=js, je
  46       do k=kts, kte
  47          do i=is, ie
  48             temp = grid%xa%rho(i,j,k) * grid%xb%rho(i,j,k)
  49
  50             grid%xa%p(i,j,k) = grid%xa%p(i,j,k) + temp/grid%xb%p(i,j,k)
  51
  52             grid%xa%t(i,j,k) = grid%xa%t(i,j,k) - temp/grid%xb%t(i,j,k)
  53
  54             grid%xa%rho(i,j,k) = 0.0
  55          end do
  56       end do
  57    end do
  58
  59    if (trace_use) call da_trace_exit("da_pt_to_rho_adj")
  60
  61 end subroutine da_pt_to_rho_adj
  62
  63