da_interp_lin_3d_adj_new.inc

1 subroutine da_interp_lin_3d_adj_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,num
13    integer,                intent(in)    :: i(num), j(num), k(nl,num)
14    real,                   intent(in)    :: dx(num), dxm(num)
15    real,                   intent(in)    :: dy(num), dym(num)
16    real,                   intent(in)    :: dz(nl,num), dzm(nl,num)
17    real,                   intent(in)    :: fo3d(nl,num) 
18    real, dimension(xp%ims:xp%ime,xp%jms:xp%jme,xp%kms:xp%kme), &
19                            intent(inout) :: fm3d    ! Input/Output variable
20 
21    integer                :: point,kk
22    real                   :: fmz(xp%kms:xp%kme)
23 
24    if (trace_use) call da_trace_entry("da_interp_lin_3d_adj_new")
25 
26    do point=1,num
27       fmz = 0.0
28       do kk = 1, nl
29          if (k(kk,point) > 0) then
30             fmz(k(kk,point))   = dzm(kk,point)*fo3d(kk,point) + fmz(k(kk,point))
31             fmz(k(kk,point)+1) = dz(kk,point) *fo3d(kk,point) + fmz(k(kk,point)+1)
32          end if
33       end do
34 
35       fm3d(i(point)  ,j(point)  ,xp%kts:xp%kte) = dym(point)*dxm(point)*fmz(xp%kts:xp%kte) &
36                                   + fm3d(i(point)  ,j(point)  ,xp%kts:xp%kte)
37       fm3d(i(point)+1,j(point)  ,xp%kts:xp%kte) = dym(point)*dx(point) *fmz(xp%kts:xp%kte) &
38                                   + fm3d(i(point)+1,j(point)  ,xp%kts:xp%kte)
39       fm3d(i(point)  ,j(point)+1,xp%kts:xp%kte) = dy(point) *dxm(point)*fmz(xp%kts:xp%kte) &
40                                   + fm3d(i(point)  ,j(point)+1,xp%kts:xp%kte)
41       fm3d(i(point)+1,j(point)+1,xp%kts:xp%kte) = dy(point) *dx(point) *fmz(xp%kts:xp%kte) &
42                                   + fm3d(i(point)+1,j(point)+1,xp%kts:xp%kte)
43    end do
44 
45    if (trace_use) call da_trace_exit("da_interp_lin_3d_adj_new")
46 
47 end subroutine da_interp_lin_3d_adj_new
48 
49