UPP (develop)
Loading...
Searching...
No Matches
SMOOTH.f
Go to the documentation of this file.
1
31!**********************************************************************
32!**********************************************************************
42 SUBROUTINE smooth (FIELD,HOLD,IX,IY,SMTH)
43
44!**********************************************************************
45!**********************************************************************
46
47 implicit none
48
49 integer :: i1, i2, j, it, i, ix, iy
50 real :: smth1, smth, smth2, smth3, smth4, smth5
51 real :: sum1, sum2
52 REAL FIELD(IX,IY), HOLD (IX,2)
53 smth1 = 0.25 * smth * smth
54 smth2 = 0.5 * smth * (1.-smth)
55 smth3 = (1.-smth) * (1.-smth)
56 smth4 = (1.-smth)
57 smth5 = 0.5 * smth
58 i1 = 2
59 i2 = 1
60 DO j=2,iy-1
61 it = i1
62 i1 = i2
63 i2 = it
64!$omp parallel do private(i,sum1,sum2)
65 DO i = 2,ix-1
66 sum1 = field(i-1,j+1) + field(i-1,j-1) &
67 + field(i+1,j+1) + field(i+1,j-1)
68 sum2 = field(i ,j+1) + field(i+1,j ) &
69 + field(i ,j-1) + field(i-1,j )
70 hold(i,i1) = smth1*sum1 + smth2*sum2 + smth3*field(i,j)
71 ENDDO
72 IF (j > 2) then
73!$omp parallel do private(i)
74 DO i=2,ix-1
75 field(i,j-1) = hold(i,i2)
76 ENDDO
77 endif
78 ENDDO
79
80!$omp parallel do private(i)
81 DO i = 2,ix-1
82 field(i,iy-1) = hold(i,i1)
83 ENDDO
84
85 DO i = 2,ix-1
86 field(i,1) = smth4 * field(i,1) &
87 + smth5 * (field(i-1,1) + field(i+1,1))
88 field(i,iy) = smth4 * field(i,iy) &
89 + smth5 * (field(i-1,iy) + field(i+1,iy))
90 ENDDO
91
92 DO j = 2,iy-1
93 field(1,j) = smth4 * field(1,j) &
94 + smth5 * (field(1,j-1) + field(1,j+1))
95 field(ix,j) = smth4 * field(ix,j) &
96 + smth5 * (field(ix,j-1) + field(ix,j+1))
97 ENDDO
98
99 RETURN
100 END
101
131!**********************************************************************
132!**********************************************************************
133
134 SUBROUTINE smoothc (FIELD,HOLD,IX,IY,SMTH)
135
136!**********************************************************************
137!**********************************************************************
138
139 implicit none
140
141 integer :: i1, i2, j, it, i, ix, iy, im1, ip1
142 real :: smth1, smth, smth2, smth3, smth4, smth5
143 real :: sum1, sum2
144 REAL FIELD(IX,IY), HOLD (IX,2)
145 integer :: iw(ix), ie(ix)
146!
147 smth1 = 0.25 * smth * smth
148 smth2 = 0.5 * smth * (1.-smth)
149 smth3 = (1.-smth) * (1.-smth)
150 smth4 = (1.-smth)
151 smth5 = 0.5 * smth
152!
153 do i=2,ix-1
154 ie(i) = i + 1
155 iw(i) = i - 1
156 enddo
157 ie(ix) = 1
158 iw(1) = ix
159!
160 i1 = 2
161 i2 = 1
162 DO j=2,iy-1
163 it = i1
164 i1 = i2
165 i2 = it
166!$omp parallel do private(i,sum1,sum2,ip1,im1)
167 DO i = 1,ix
168 ip1 = ie(i)
169 im1 = iw(i)
170 sum1 = field(im1,j+1) + field(im1,j-1) &
171 + field(ip1,j+1) + field(ip1,j-1)
172 sum2 = field(i ,j+1) + field(ip1,j ) &
173 + field(i ,j-1) + field(im1,j )
174 hold(i,i1) = smth1*sum1 + smth2*sum2 + smth3*field(i,j)
175 ENDDO
176 IF (j > 2) then
177!$omp parallel do private(i)
178 DO i=1,ix
179 field(i,j-1) = hold(i,i2)
180 ENDDO
181 endif
182 ENDDO
183
184!$omp parallel do private(i)
185 DO i = 1,ix
186 field(i,iy-1) = hold(i,i1)
187 ENDDO
188
189 DO i = 1,ix
190 ip1 = ie(i)
191 im1 = iw(i)
192 field(i,1) = smth4 * field(i,1) &
193 + smth5 * (field(im1,1) + field(ip1,1))
194 field(i,iy) = smth4 * field(i,iy) &
195 + smth5 * (field(im1,iy) + field(ip1,iy))
196 ENDDO
197
198
199 RETURN
200 END
smooth
subroutine smooth(field, hold, ix, iy, smth)
smooth() smooths a meteorological field using Shapiro smoother.
Definition SMOOTH.f:43
smoothc
subroutine smoothc(field, hold, ix, iy, smth)
smoothc() smooths a meteorological field using Shapiro smoother.
Definition SMOOTH.f:135