/[MITgcm]/MITgcm/pkg/shap_filt/shap_filt_uv_s4.F
ViewVC logotype

Diff of /MITgcm/pkg/shap_filt/shap_filt_uv_s4.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.1 by adcroft, Mon May 7 19:02:52 2001 UTC revision 1.2 by adcroft, Tue May 29 14:01:40 2001 UTC
# Line 0  Line 1 
1    C $Header$
2    C $Name$
3    
4    #include "SHAP_FILT_OPTIONS.h"
5    
6          SUBROUTINE SHAP_FILT_UV_S4(
7         U           uFld, vFld,
8         I           myTime, myThid )
9    C     /==========================================================\
10    C     | S/R SHAP_FILT_UV                                         |
11    C     | Applies Shapiro filter to tracer field over one XY slice |
12    C     | of one tile at a time.                                   |
13    C     \==========================================================/
14          IMPLICIT NONE
15    
16    C     == Global variables ===
17    #include "SIZE.h"
18    #include "EEPARAMS.h"
19    #include "PARAMS.h"
20    #include "GRID.h"
21    #ifdef ALLOW_SHAP_FILT
22    #include "SHAP_FILT.h"
23    #include "SHAP_FILT_UV.h"
24    #endif
25    
26    C     == Routine arguments
27          _RL uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
28          _RL vFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
29          _RL     myTime
30          INTEGER myThid
31    
32    #ifdef ALLOW_SHAP_FILT
33    
34    C     == Local variables ==
35          INTEGER bi,bj,K,I,J,N
36          _RL tmpGrdU(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
37          _RL tmpGrdV(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
38          _RL maskZj,maskZp
39    
40          IF (nShapUV.gt.0) THEN
41    
42            DO bj=myByLo(myThid),myByHi(myThid)
43             DO bi=myBxLo(myThid),myBxHi(myThid)
44              DO K=1,Nr
45               DO J=1,sNy
46                DO I=1,sNx+1
47                 tmpFldU(i,j,k,bi,bj)=uFld(i,j,k,bi,bj)
48         &                *_maskW(i,j,k,bi,bj)
49                ENDDO
50               ENDDO
51               DO J=1,sNy+1
52                DO I=1,sNx
53                 tmpFldV(i,j,k,bi,bj)=vFld(i,j,k,bi,bj)
54         &                *_maskS(i,j,k,bi,bj)
55                ENDDO
56               ENDDO
57              ENDDO
58             ENDDO
59            ENDDO
60    
61    
62    C      d_xx^n tmpFld
63    
64           DO N=1,nShapUV
65    
66            CALL EXCH_UV_XYZ_RL(tmpFldU,tmpFldV,.TRUE.,myThid)
67    
68    
69            DO bj=myByLo(myThid),myByHi(myThid)
70             DO bi=myBxLo(myThid),myBxHi(myThid)
71              DO K=1,Nr
72    
73    C          Uxx
74               DO J=1,sNy
75                DO I=1,sNx+1
76                 tmpGrdU(i,j) = -0.25*(
77         &          tmpFldU(i-1,j,k,bi,bj) + tmpFldU(i+1,j,k,bi,bj)
78         &             - 2.*tmpFldU(i,j,k,bi,bj)
79         &            )*_maskW(i,j,k,bi,bj)
80                ENDDO
81               ENDDO
82    
83               DO J=1,sNy
84                DO I=1,sNx+1
85                 tmpFldU(i,j,k,bi,bj) = tmpGrdU(i,j)
86                ENDDO
87               ENDDO
88    
89    C          Vyy
90               DO J=1,sNy+1
91                DO I=1,sNx
92                 tmpGrdV(i,j) = -0.25*(
93         &          tmpFldV(i,j-1,k,bi,bj) + tmpFldV(i,j+1,k,bi,bj)
94         &             - 2.*tmpFldV(i,j,k,bi,bj)
95         &            )*_maskS(i,j,k,bi,bj)
96                ENDDO
97               ENDDO
98    
99               DO J=1,sNy+1
100                DO I=1,sNx
101                 tmpFldV(i,j,k,bi,bj) = tmpGrdV(i,j)
102                ENDDO
103               ENDDO
104    
105              ENDDO
106             ENDDO
107            ENDDO
108    
109           ENDDO
110    
111    C      F <-  [1-d_xx^n]F
112           DO bj=myByLo(myThid),myByHi(myThid)
113            DO bi=myBxLo(myThid),myBxHi(myThid)
114             DO K=1,Nr
115              DO J=1,sNy
116               DO I=1,sNx+1
117                tmpFldU(i,j,k,bi,bj)=uFld(i,j,k,bi,bj)-tmpFldU(i,j,k,bi,bj)
118                uFld(i,j,k,bi,bj)=tmpFldU(i,j,k,bi,bj)
119               ENDDO
120              ENDDO
121              DO J=1,sNy+1
122               DO I=1,sNx
123                tmpFldV(i,j,k,bi,bj)=vFld(i,j,k,bi,bj)-tmpFldV(i,j,k,bi,bj)
124                vFld(i,j,k,bi,bj)=tmpFldV(i,j,k,bi,bj)
125               ENDDO
126              ENDDO
127             ENDDO
128            ENDDO
129           ENDDO
130    
131    
132    C      d_yy^n tmpFld
133    
134           DO N=1,nShapUV
135    
136            CALL EXCH_UV_XYZ_RL(tmpFldU,tmpFldV,.TRUE.,myThid)
137    
138            DO bj=myByLo(myThid),myByHi(myThid)
139             DO bi=myBxLo(myThid),myBxHi(myThid)
140              DO K=1,Nr
141    
142    C          Uyy
143               DO J=1,sNy
144                DO I=1,sNx+1
145                 maskZj=_maskS(i-1, j ,k,bi,bj)
146         &             *_maskS( i , j ,k,bi,bj)
147                 maskZp=_maskS(i-1,j+1,k,bi,bj)
148         &             *_maskS( i ,j+1,k,bi,bj)
149                 tmpGrdU(i,j) = -0.25*(
150         &        (tmpFldU(i,j+1,k,bi,bj)-tmpFldU(i, j ,k,bi,bj))*maskZp
151         &       -(tmpFldU(i, j ,k,bi,bj)-tmpFldU(i,j-1,k,bi,bj))*maskZj
152    #ifdef NO_SLIP_SHAP
153         &       -2.*(2.-maskZj-maskZp)*tmpFldU(i,j,k,bi,bj)
154    #endif
155         &             )*_maskW(i,j,k,bi,bj)
156                ENDDO
157               ENDDO
158    
159               IF (useCubedSphereExchange) THEN
160                J=1
161                DO I=1,sNx+1,sNx
162                 maskZj=maskS(i-1, j ,k,bi,bj)*maskS( i , j ,k,bi,bj)
163                 maskZp=maskS(i-1,j+1,k,bi,bj)*maskS( i ,j+1,k,bi,bj)
164                 tmpGrdU(i,j) = -0.25*(
165         &        (tmpFldU(i,j+1,k,bi,bj)-tmpFldU(i, j ,k,bi,bj))*maskZp
166         &       -(tmpFldU(i, j ,k,bi,bj)-0*tmpFldU(i,j-1,k,bi,bj))*maskZj
167    #ifdef NO_SLIP_SHAP
168         &       -2.*(2.-maskZj-maskZp)*tmpFldU(i,j,k,bi,bj)
169    #endif
170         &             )*_maskW(i,j,k,bi,bj)
171                ENDDO
172                J=sNy
173                DO I=1,sNx+1,sNx
174                 maskZj=maskS(i-1, j ,k,bi,bj)*maskS( i , j ,k,bi,bj)
175                 maskZp=maskS(i-1,j+1,k,bi,bj)*maskS( i ,j+1,k,bi,bj)
176                 tmpGrdU(i,j) = -0.25*(
177         &        (0*tmpFldU(i,j+1,k,bi,bj)-tmpFldU(i, j ,k,bi,bj))*maskZp
178         &       -(tmpFldU(i, j ,k,bi,bj)-tmpFldU(i,j-1,k,bi,bj))*maskZj
179    #ifdef NO_SLIP_SHAP
180         &       -2.*(2.-maskZj-maskZp)*tmpFldU(i,j,k,bi,bj)
181    #endif
182         &             )*_maskW(i,j,k,bi,bj)
183                ENDDO
184               ENDIF
185    
186               DO J=1,sNy
187                DO I=1,sNx+1
188                 tmpFldU(i,j,k,bi,bj) = tmpGrdU(i,j)
189                ENDDO
190               ENDDO
191    
192    C          Vxx
193               DO J=1,sNy+1
194                DO I=1,sNx
195                 maskZj=_maskW( i ,j-1,k,bi,bj)
196         &             *_maskW( i , j ,k,bi,bj)
197                 maskZp=_maskW(i+1,j-1,k,bi,bj)
198         &             *_maskW(i+1, j ,k,bi,bj)
199                 tmpGrdV(i,j) = -0.25*(
200         &        (tmpFldV(i+1,j,k,bi,bj)-tmpFldV( i ,j,k,bi,bj))*maskZp
201         &       -(tmpFldV( i ,j,k,bi,bj)-tmpFldV(i-1,j,k,bi,bj))*maskZj
202    #ifdef NO_SLIP_SHAP
203         &       -2.*(2.-maskZj-maskZp)*tmpFldV(i,j,k,bi,bj)
204    #endif
205         &             )*_maskS(i,j,k,bi,bj)
206                ENDDO
207               ENDDO
208    
209               IF (useCubedSphereExchange) THEN
210                DO J=1,sNy+1,sNy
211                I=1
212                 maskZj=maskW( i ,j-1,k,bi,bj)*maskW( i , j ,k,bi,bj)
213                 maskZp=maskW(i+1,j-1,k,bi,bj)*maskW(i+1, j ,k,bi,bj)
214                 tmpGrdV(i,j) = -0.25*(
215         &        (tmpFldV(i+1,j,k,bi,bj)-tmpFldV( i ,j,k,bi,bj))*maskZp
216         &       -(tmpFldV( i ,j,k,bi,bj)-0*tmpFldV(i-1,j,k,bi,bj))*maskZj
217    #ifdef NO_SLIP_SHAP
218         &       -2.*(2.-maskZj-maskZp)*tmpFldV(i,j,k,bi,bj)
219    #endif
220         &             )*_maskS(i,j,k,bi,bj)
221                ENDDO
222                DO J=1,sNy+1,sNy
223                I=sNx
224                 maskZj=maskW( i ,j-1,k,bi,bj)*maskW( i , j ,k,bi,bj)
225                 maskZp=maskW(i+1,j-1,k,bi,bj)*maskW(i+1, j ,k,bi,bj)
226                 tmpGrdV(i,j) = -0.25*(
227         &        (0*tmpFldV(i+1,j,k,bi,bj)-tmpFldV( i ,j,k,bi,bj))*maskZp
228         &       -(tmpFldV( i ,j,k,bi,bj)-tmpFldV(i-1,j,k,bi,bj))*maskZj
229    #ifdef NO_SLIP_SHAP
230         &       -2.*(2.-maskZj-maskZp)*tmpFldV(i,j,k,bi,bj)
231    #endif
232         &             )*_maskS(i,j,k,bi,bj)
233                ENDDO
234               ENDIF
235    
236               DO J=1,sNy+1
237                DO I=1,sNx
238                 tmpFldV(i,j,k,bi,bj) = tmpGrdV(i,j)
239                ENDDO
240               ENDDO
241    
242              ENDDO
243             ENDDO
244            ENDDO
245    
246           ENDDO
247    
248    C      F <-  [1-d_yy^n]F
249           DO bj=myByLo(myThid),myByHi(myThid)
250            DO bi=myBxLo(myThid),myBxHi(myThid)
251             DO K=1,Nr
252              DO J=1,sNy
253               DO I=1,sNx+1
254                uFld(i,j,k,bi,bj)=uFld(i,j,k,bi,bj)-tmpFldU(i,j,k,bi,bj)
255               ENDDO
256              ENDDO
257              DO J=1,sNy+1
258               DO I=1,sNx
259                vFld(i,j,k,bi,bj)=vFld(i,j,k,bi,bj)-tmpFldV(i,j,k,bi,bj)
260               ENDDO
261              ENDDO
262             ENDDO
263            ENDDO
264           ENDDO
265    
266          ENDIF
267    #endif /* ALLOW_SHAP_FILT */
268    
269          RETURN
270          END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22