phylmd/Orography/mva9.f90

module MVA9_m

  implicit none

contains

  SUBROUTINE MVA9(X)

    ! From dyn3d/grid_noro.F, version 1.1.1.1 2004/05/19 12:53:06

    ! Make a moving average over 9 gridpoints of the x fields.

    REAL, intent(inout):: X(:, :) ! (IMAR, JMAR)

    ! Local:
    integer imar, jmar
    real XF(size(x, 1), size(x, 2))
    real WEIGHTpb(-1:1, -1:1)
    real my_sum
    integer i, is, js, j

    !---------------------------------------------------------------

    imar = size(x, 1)
    jmar = size(x, 2)

    MY_SUM=0.
    DO IS=-1, 1
       DO JS=-1, 1
          WEIGHTpb(IS, JS) = 1. / REAL((1 + IS**2) * (1 + JS**2))
          MY_SUM=MY_SUM+WEIGHTpb(IS, JS)
       ENDDO
    ENDDO

    DO IS=-1, 1
       DO JS=-1, 1
          WEIGHTpb(IS, JS)=WEIGHTpb(IS, JS)/MY_SUM
       ENDDO
    ENDDO

    DO J=2, JMAR-1
       DO I=2, IMAR-1
          XF(I, J)=0.
          DO IS=-1, 1
             DO JS=-1, 1
                XF(I, J)=XF(I, J)+X(I+IS, J+JS)*WEIGHTpb(IS, JS)
             ENDDO
          ENDDO
       ENDDO
    ENDDO

    DO J=2, JMAR-1
       XF(1, J)=0.
       IS=IMAR-1
       DO JS=-1, 1 
          XF(1, J)=XF(1, J)+X(IS, J+JS)*WEIGHTpb(-1, JS)
       ENDDO
       DO IS=0, 1 
          DO JS=-1, 1 
             XF(1, J)=XF(1, J)+X(1+IS, J+JS)*WEIGHTpb(IS, JS)
          ENDDO
       ENDDO
       XF(IMAR, J)=XF(1, J)
    ENDDO

    DO I=1, IMAR
       XF(I, 1)=XF(I, 2)
       XF(I, JMAR)=XF(I, JMAR-1)
    ENDDO

    DO I=1, IMAR
       DO J=1, JMAR
          X(I, J)=XF(I, J)
       ENDDO
    ENDDO

  END SUBROUTINE MVA9

end module MVA9_m
1	guez	47	module MVA9_m
2
3			implicit none
4
5			contains
6
7			SUBROUTINE MVA9(X)
8
9			! From dyn3d/grid_noro.F, version 1.1.1.1 2004/05/19 12:53:06
10
11			! Make a moving average over 9 gridpoints of the x fields.
12
13			REAL, intent(inout):: X(:, :) ! (IMAR, JMAR)
14
15			! Local:
16			integer imar, jmar
17			real XF(size(x, 1), size(x, 2))
18			real WEIGHTpb(-1:1, -1:1)
19			real my_sum
20			integer i, is, js, j
21
22			!---------------------------------------------------------------
23
24			imar = size(x, 1)
25			jmar = size(x, 2)
26
27			MY_SUM=0.
28			DO IS=-1, 1
29			DO JS=-1, 1
30			WEIGHTpb(IS, JS) = 1. / REAL((1 + IS*2) (1 + JS**2))
31			MY_SUM=MY_SUM+WEIGHTpb(IS, JS)
32			ENDDO
33			ENDDO
34
35			DO IS=-1, 1
36			DO JS=-1, 1
37			WEIGHTpb(IS, JS)=WEIGHTpb(IS, JS)/MY_SUM
38			ENDDO
39			ENDDO
40
41			DO J=2, JMAR-1
42			DO I=2, IMAR-1
43			XF(I, J)=0.
44			DO IS=-1, 1
45			DO JS=-1, 1
46			XF(I, J)=XF(I, J)+X(I+IS, J+JS)*WEIGHTpb(IS, JS)
47			ENDDO
48			ENDDO
49			ENDDO
50			ENDDO
51
52			DO J=2, JMAR-1
53			XF(1, J)=0.
54			IS=IMAR-1
55			DO JS=-1, 1
56			XF(1, J)=XF(1, J)+X(IS, J+JS)*WEIGHTpb(-1, JS)
57			ENDDO
58			DO IS=0, 1
59			DO JS=-1, 1
60			XF(1, J)=XF(1, J)+X(1+IS, J+JS)*WEIGHTpb(IS, JS)
61			ENDDO
62			ENDDO
63			XF(IMAR, J)=XF(1, J)
64			ENDDO
65
66			DO I=1, IMAR
67			XF(I, 1)=XF(I, 2)
68			XF(I, JMAR)=XF(I, JMAR-1)
69			ENDDO
70
71			DO I=1, IMAR
72			DO J=1, JMAR
73			X(I, J)=XF(I, J)
74			ENDDO
75			ENDDO
76
77			END SUBROUTINE MVA9
78
79			end module MVA9_m