UPP  11.0.0
 All Data Structures Files Functions Variables Pages
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
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:42
smoothc
subroutine smoothc(FIELD, HOLD, IX, IY, SMTH)
smoothc() smooths a meteorological field using Shapiro smoother.
Definition: SMOOTH.f:134