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

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

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

Revision 1.2 - (hide annotations) (download)
Tue May 29 14:01:40 2001 UTC (22 years, 11 months ago) by adcroft
Branch: MAIN
CVS Tags: checkpoint44e_post, release1_p13_pre, checkpoint43a-release1mods, release1_p13, checkpoint40pre3, checkpoint40pre1, checkpoint40pre7, checkpoint40pre6, checkpoint40pre9, checkpoint40pre8, chkpt44d_post, release1_p8, release1_p9, release1_p1, release1_p2, release1_p3, release1_p4, release1_p5, release1_p6, release1_p7, checkpoint44e_pre, release1_b1, checkpoint43, release1_chkpt44d_post, icebear5, icebear4, icebear3, icebear2, checkpoint40pre2, release1-branch_tutorials, chkpt44a_post, checkpoint40pre4, chkpt44c_pre, ecco_c44_e19, ecco_c44_e18, ecco_c44_e17, ecco_c44_e16, release1_p12, release1_p10, release1_p11, release1_p16, release1_p17, release1_p14, release1_p15, release1-branch-end, release1_final_v1, checkpoint44b_post, ecco_ice2, ecco_ice1, release1_p12_pre, ecco_c44_e22, ecco_c44_e25, checkpoint40pre5, chkpt44a_pre, ecco_c44_e23, ecco_c44_e20, ecco_c44_e21, ecco_c44_e26, ecco_c44_e27, ecco_c44_e24, ecco-branch-mod1, ecco-branch-mod2, ecco-branch-mod3, ecco-branch-mod4, ecco-branch-mod5, release1_beta1, checkpoint44b_pre, checkpoint42, checkpoint40, checkpoint41, checkpoint44, chkpt44c_post, release1-branch_branchpoint
Branch point for: c24_e25_ice, release1_final, release1-branch, release1, ecco-branch, release1_50yr, icebear, release1_coupled
Changes since 1.1: +270 -0 lines 
Merge from branch pre38:
 o essential mods for cubed sphere
 o debugged atmosphere, dynamcis + physics (aim)
 o new packages (mom_vecinv, mom_fluxform, ...)
1 adcroft 1.2 C $Header: /u/gcmpack/models/MITgcmUV/pkg/shap_filt/Attic/shap_filt_uv_s4.F,v 1.1.2.1 2001/05/07 19:02:52 adcroft Exp $
2     C $Name: pre38-close $
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
  ViewVC Help
Powered by ViewVC 1.1.22