da_filter.inc

1 subroutine da_filter(var, xp)
2 
3    !-----------------------------------------------------------------------
4    ! Purpose: TBD
5    !-----------------------------------------------------------------------
6 
7    implicit none
8    
9    type (xpose_type), intent(inout) :: xp      ! Transpose variables.
10 
11    real, dimension(xp%ims:xp%ime,xp%jms:xp%jme,xp%kms:xp%kme), &
12                       intent(inout) :: var
13 
14    integer :: i, j, k
15 
16    real, dimension (3) :: w
17 
18    data  w/0.25,0.5,0.25/
19 
20    ! Copy var for transpose.
21 
22    xp%v1z(xp%its:xp%ite,xp%jts:xp%jte,xp%kts:xp%kte) = &
23       var(xp%its:xp%ite,xp%jts:xp%jte,xp%kts:xp%kte)
24 
25    ! Apply (i',j',k -> i,j',k') transpose (v1z -> v1x).
26 
27    call da_transpose_z2x (xp)
28 
29    ! Perform x-direction filter:
30 
31    do k = xp%ktsx, xp%ktex
32       do j=xp%jtsx, xp%jtex
33          ! Forward 
34          do i=xp%ids+1, xp%ide-1
35             xp%v1x(i,j,k) = w(1)*xp%v1x(i-1,j,k) + w(2)*xp%v1x(i,j,k) + &
36                w(3)*xp%v1x(i+1,j,k)
37          end do
38 
39          ! Backward
40          do i=xp%ide-1,xp%ids+1,-1
41             xp%v1x(i,j,k) = w(1)*xp%v1x(i-1,j,k) + w(2)*xp%v1x(i,j,k) + &
42                w(3)*xp%v1x(i+1,j,k)
43          end do
44       end do
45    end do
46 
47 
48    ! Apply (i,j',k' -> i',j,k') transpose (v1x -> v1y).
49 
50    call da_transpose_x2y (xp)
51 
52    ! Perform y-direction filter:
53 
54    do k=xp%ktsy, xp%ktey
55       do i=xp%itsy, xp%itey
56          ! Forward
57          do j=xp%jds+1, xp%jde-1
58             xp%v1y(i,j,k) = w(1)*xp%v1y(i,j-1,k) + w(2)*xp%v1y(i,j,k) + &
59                w(3)*xp%v1y(i,j+1,k)
60          end do
61 
62          ! Backward
63          do j=xp%jde-1,xp%jds+1,-1
64             xp%v1y(i,j,k) = w(1)*xp%v1y(i,j-1,k) + w(2)*xp%v1y(i,j,k) + &
65                w(3)*xp%v1y(i,j+1,k)
66          end do
67       end do
68    end do
69 
70    ! Apply (i',j,k' -> i',j',k) transpose (v1y -> v1z).
71 
72    call da_transpose_y2z (xp)
73 
74    var(xp%its:xp%ite,xp%jts:xp%jte,xp%kts:xp%kte) = &
75       xp%v1z(xp%its:xp%ite,xp%jts:xp%jte,xp%kts:xp%kte)
76 
77 end subroutine da_filter
78 
79