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

Annotation 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 - (hide 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 adcroft 1.2 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