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

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