da_interp_lin_3d_new.inc

1 subroutine da_interp_lin_3d_new(fm3d, xp, &
2                          i, j, k, dx, dy, dz, dxm, dym, dzm, &
3                          fo3d, nl,num)
4 
5    !-----------------------------------------------------------------------
6    ! Purpose: TBD
7    !-----------------------------------------------------------------------
8 
9    implicit none
10 
11    type (xpose_type),      intent(in)  :: xp    ! Dimensions and xpose buffers.
12    integer,                intent(in)  :: nl     ! number of input levels      
13    integer,                intent(in)  :: num    ! number of ns   
14    integer,                intent(in)  :: i(num), j(num), k(nl,num)
15    real,                   intent(in)  :: dx(num), dxm(num)
16    real,                   intent(in)  :: dy(num), dym(num)
17    real,                   intent(in)  :: dz(nl,num), dzm(nl,num)
18    real, dimension(xp%ims:xp%ime,xp%jms:xp%jme,xp%kms:xp%kme), &
19                            intent(in)  :: fm3d    ! Input variable              
20    real,                   intent(inout) :: fo3d(nl,num)  ! Output variable 
21 
22    integer                             :: n, kk
23    real                                :: fmz(xp%kms:xp%kme)
24 
25    if (trace_use) call da_trace_entry("da_interp_lin_3d_new")
26 
27    fo3d(:,:) = 0.0
28 
29    do n=1,num
30       fmz(:)=0.0
31 
32       fmz(xp%kts:xp%kte) = dym(n)*(dxm(n)*fm3d(i(n), j(n), xp%kts:xp%kte) &
33                             +dx(n) *fm3d(i(n)+1,j(n), xp%kts:xp%kte)) &
34                       + dy(n) *(dxm(n)*fm3d(i(n), j(n)+1, xp%kts:xp%kte) &
35                             +dx(n) * fm3d(i(n)+1, j(n)+1, xp%kts:xp%kte))
36       do kk = 1, nl
37          if (k(kk,n) > 0) then
38             fo3d(kk,n) = dzm(kk,n)*fmz(k(kk,n)) + dz(kk,n)*fmz(k(kk,n)+1)
39          end if
40       end do
41    end do
42 
43    if (trace_use) call da_trace_exit("da_interp_lin_3d_new")
44 
45 end subroutine da_interp_lin_3d_new
46 
47