var/da/da_physics/da_tv_profile.inc

   1 subroutine da_tv_profile(grid, info, n, pre_ma, tv_ma)
   2
   3    !--------------------------------------------------------------------------
   4    ! Purpose: Calculates virtual temperature (tv_ma) on each level
   5    ! (pre_ma, pressure at the level) at the observed location (i,j).
   6    ! dx, dxm, dy, dym are horizontal interpolation weighting.
   7    !--------------------------------------------------------------------------
   8
   9    implicit none
  10
  11    type (domain),         intent(in)  :: grid
  12    type (infa_type),      intent(in)  :: info
  13    integer,               intent(in)  :: n
  14    real,                  intent(out) :: pre_ma(kts-1:kte+1)
  15    real,                  intent(out) :: tv_ma(kts-1:kte+1)
  16
  17    integer :: ii,jj    ! index dimension.
  18    real    :: tv_m(2,2,kts:kte)     ! Virtual temperatures
  19
  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")
  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    ! Virtual temperature
  34
  35    do ii=i,i+1
  36       do jj=j,j+1
  37          tv_m(ii-i+1,jj-j+1,kts:kte) = grid%xb%t(ii,jj,kts:kte) * &
  38             (1.0 + 0.61*grid%xb%q(ii,jj,kts:kte))
  39       end do
  40    end do
  41
  42    ! Horizontal interpolation to the obs. pt.
  43
  44    pre_ma(kts:kte) = dym* ( dxm * grid%xb%p(i,j,kts:kte) + dx * grid%xb%p(i+1,j,kts:kte) ) + &
  45       dy * ( dxm * grid%xb%p(i,j+1,kts:kte) + dx * grid%xb%p(i+1,j+1,kts:kte) )
  46
  47    tv_ma (kts:kte) = dym* ( dxm * tv_m (1,1,kts:kte) + dx * tv_m (2,1,kts:kte) ) + &
  48       dy * ( dxm * tv_m (1,2,kts:kte) + dx * tv_m (2,2,kts:kte) )
  49
  50    if (trace_use_dull) call da_trace_exit("da_tv_profile")
  51
  52 end subroutine da_tv_profile
  53
  54