da_tv_profile.inc

1 subroutine da_tv_profile(xp, xb, i, j, dx, dxm, dy, dym, 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 (xb_type), intent(in)     :: xb       ! first guess state.
12    type (xpose_type), intent(in)  :: xp       ! Dimensions and xpose buffers.
13    integer, intent(in)            :: i, j     ! OBS location
14    real, intent(in)               :: dx, dxm  ! interpolation weights.
15    real, intent(in)               :: dy, dym  ! interpolation weights.
16    real, dimension(xp%kts-1:xp%kte+1), intent(out)   :: pre_ma,tv_ma
17                           
18    integer                        :: ii,jj,ks,ke    ! index dimension.
19    real, dimension(2,2,xp%kts:xp%kte)   :: tv_m     ! Virtual temperatures
20 
21    ks = xp%kts; ke = xp%kte
22 
23    ! Virtual temperature
24 
25    do ii=i,i+1
26       do jj=j,j+1
27          tv_m(ii-i+1,jj-j+1,ks:ke) = xb%t(ii,jj,ks:ke) * &
28             (1. + 0.61*xb%q(ii,jj,ks:ke))
29       end do
30    end do
31 
32    ! Horizontal interpolation to the obs. pt.
33 
34    pre_ma(ks:ke) = dym* ( dxm * xb%p(i,j,ks:ke) + dx * xb%p(i+1,j,ks:ke) ) + &
35                    dy * ( dxm * xb%p(i,j+1,ks:ke) + dx * xb%p(i+1,j+1,ks:ke) )
36 
37    tv_ma (ks:ke) = dym* ( dxm * tv_m (1,1,ks:ke) + dx * tv_m (2,1,ks:ke) ) + &
38                    dy * ( dxm * tv_m (1,2,ks:ke) + dx * tv_m (2,2,ks:ke) )
39 
40 end subroutine da_tv_profile
41 
42