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

Contents 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 - (show annotations) (download)
Tue May 29 14:01:40 2001 UTC (23 years 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 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