da_smooth_anl.inc

1 subroutine da_smooth_anl(slab,imx,jmx,kx,npass,icrsdot)
2 
3    !-----------------------------------------------------------------------
4    ! Purpose: spatially smooth (usually slab) to remove high
5    ! frequency waves
6    !-----------------------------------------------------------------------
7 
8    implicit none
9    
10    real, intent(inout)                :: SLAB(:,:,:)
11    integer, intent(in)                :: imx, jmx, kx
12    integer, intent(in)                :: npass
13    integer, intent(in)                :: icrsdot
14    
15    real, allocatable                  :: SLABNEW(:,:)
16    real                               :: XNU(1:2)
17    integer                            :: ie, je, k 
18    integer                            :: loop, n, i, j
19    
20    allocate (SLABNEW(IMX,JMX))
21 
22    IE=IMX-1-ICRSdoT
23    JE=JMX-1-ICRSdoT
24    XNU(1)=0.50
25    XNU(2)=-0.52
26    do K=1,KX
27       do LOOP=1,NPASS*2
28          N=2-MOD(LOOP,2)
29  
30          ! FIRST SMOOTH in THE IMX DIRECTION
31  
32          do I=2,IE
33             do J=2,JE
34                SLABNEW(I,J)=SLAB(I,J,K)+XNU(N) * &
35                ((SLAB(I,J+1,K)+SLAB(I,J-1,K))*0.5-SLAB(I,J,K))
36             end do
37          end do
38          do I=2,IE
39             do J=2,JE
40                SLAB(I,J,K)=SLABNEW(I,J)
41             end do
42          end do
43  
44          ! NOW SMOOTH in THE JMX DIRECTION
45  
46          do J=2,JE
47             do I=2,IE
48                SLABNEW(I,J)=SLAB(I,J,K)+XNU(N) * &
49                ((SLAB(I+1,J,K)+SLAB(I-1,J,K))*0.5-SLAB(I,J,K))
50             end do
51          end do
52 
53          do I=2,IE
54             do J=2,JE
55                SLAB(I,J,K)=SLABNEW(I,J)
56             end do
57          end do
58       end do
59    end do
60 
61    deallocate (SLABNEW)
62 
63 end subroutine da_smooth_anl
64 
65