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

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

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

Revision 1.3 - (hide annotations) (download)
Fri Jun 15 15:14:56 2001 UTC (22 years, 11 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint43a-release1mods, checkpoint40pre3, checkpoint40pre1, checkpoint40pre7, checkpoint40pre6, checkpoint40pre9, checkpoint40pre8, release1_b1, checkpoint43, icebear5, icebear4, icebear3, icebear2, checkpoint40pre2, release1-branch_tutorials, checkpoint40pre4, ecco_c44_e19, ecco_c44_e18, ecco_c44_e17, ecco_c44_e16, release1-branch-end, ecco_ice2, ecco_ice1, ecco_c44_e22, ecco_c44_e25, checkpoint40pre5, 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, checkpoint42, checkpoint40, checkpoint41, checkpoint44, release1-branch_branchpoint
Branch point for: c24_e25_ice, release1-branch, release1, ecco-branch, icebear, release1_coupled
Changes since 1.2: +102 -66 lines 
extend S2 Shapiro Filter : new parameters nShapTrPhys and nShapUVPhys allow
to switch from numerical-space filter (default)
            to physical-space filter  (as S2g)
            or a combination of both.
1 jmc 1.3 C $Header: /u/gcmpack/models/MITgcmUV/pkg/shap_filt/shap_filt_uv_s2.F,v 1.2 2001/05/29 14:01:40 adcroft Exp $
2     C $Name: $
3 adcroft 1.2
4     #include "SHAP_FILT_OPTIONS.h"
5    
6     SUBROUTINE SHAP_FILT_UV_S2(
7     U uFld, vFld,
8     I myTime, myThid )
9     C /==========================================================\
10     C | S/R SHAP_FILT_UV_S2 |
11     C | Applies Shapiro filter to U,V 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 jmc 1.3 C------
32     C Combine computational Filter of Div & Vorticity
33     C and Physical Filter of U,V field
34     C nShapUVPhys = 0 ==> use only computational Filter
35     C nShapUVPhys = 1 ==> compute Div & Vort. with Grid factors,
36     C Filter Div & Vort. Numerically (power nShapUV-1)
37     C and return filtered U.V in physical space
38     C nShapUVPhys = nShapUV ==> Filter in Physical space only (power nShapUV)
39     C------
40 adcroft 1.2
41     C == Local variables ==
42     INTEGER bi,bj,K,I,J,N
43     _RS hFacZ(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
44     _RS r_hFacZ(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
45     _RL hDiv(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
46     _RL vort3(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
47    
48 jmc 1.3 IF (nShapUV.GT.0 .AND. Shap_uvtau.GT.0.) THEN
49 adcroft 1.2
50     DO bj=myByLo(myThid),myByHi(myThid)
51     DO bi=myBxLo(myThid),myBxHi(myThid)
52     DO K=1,Nr
53 jmc 1.3 DO J=1-Oly,sNy+Oly
54     DO I=1-Olx,sNx+Olx
55 adcroft 1.2 tmpFldU(i,j,k,bi,bj)=uFld(i,j,k,bi,bj)
56     & *_maskW(i,j,k,bi,bj)
57     tmpFldV(i,j,k,bi,bj)=vFld(i,j,k,bi,bj)
58     & *_maskS(i,j,k,bi,bj)
59     ENDDO
60     ENDDO
61     ENDDO
62     ENDDO
63     ENDDO
64    
65 jmc 1.3 c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
66 adcroft 1.2
67     C [d_xx+d_yy]^n tmpFld
68    
69     DO N=1,nShapUV
70    
71     CALL EXCH_UV_XYZ_RL(tmpFldU,tmpFldV,.TRUE.,myThid)
72    
73     DO bj=myByLo(myThid),myByHi(myThid)
74     DO bi=myBxLo(myThid),myBxHi(myThid)
75     DO K=1,Nr
76    
77     C [d_xx+d_yy] tmpFld
78 jmc 1.3 IF (N.LE.nShapUVPhys) THEN
79 adcroft 1.2 CALL MOM_CALC_HFACZ(bi,bj,k,hFacZ,r_hFacZ,myThid)
80 jmc 1.3 CALL MOM_VI_CALC_HDIV(bi,bj,k,
81     I tmpFldU(1-OLx,1-OLy,k,bi,bj),
82     I tmpFldV(1-OLx,1-OLy,k,bi,bj),
83     & hDiv,myThid)
84     CALL MOM_VI_CALC_RELVORT3(bi,bj,k,
85     I tmpFldU(1-OLx,1-OLy,k,bi,bj),
86     I tmpFldV(1-OLx,1-OLy,k,bi,bj),
87     & hFacZ,vort3,myThid)
88     ELSE
89     C- replace Physical calc Div & Vort by computational one :
90 adcroft 1.2 DO J=0,sNy+1
91     DO I=0,sNx+1
92     hDiv(i,j)=tmpFldU(i+1,j,k,bi,bj)-tmpFldU(i,j,k,bi,bj)
93     & +tmpFldV(i,j+1,k,bi,bj)-tmpFldV(i,j,k,bi,bj)
94     ENDDO
95     ENDDO
96     DO J=1,sNy+1
97     DO I=1,sNx+1
98     vort3(i,j)=(tmpFldV(i,j,k,bi,bj)-tmpFldV(i-1,j,k,bi,bj)
99     & -tmpFldU(i,j,k,bi,bj)+tmpFldU(i,j-1,k,bi,bj)
100     & )
101     ENDDO
102     ENDDO
103     C Special stuff for Cubed Sphere
104 jmc 1.3 IF (useCubedSphereExchange) THEN
105     I=1
106     J=1
107     vort3(I,J)=
108     & tmpFldV(I,J,k,bi,bj)
109     c & -tmpFldV(I-1,J,k,bi,bj)
110     & -tmpFldU(I,J,k,bi,bj)
111     & +tmpFldU(I,J-1,k,bi,bj)
112     I=sNx+1
113     J=1
114     vort3(I,J)=
115     c & tmpFldV(I,J,k,bi,bj)
116     & -tmpFldV(I-1,J,k,bi,bj)
117     & -tmpFldU(I,J,k,bi,bj)
118     & +tmpFldU(I,J-1,k,bi,bj)
119     I=1
120     J=sNy+1
121     vort3(I,J)=
122     & tmpFldV(I,J,k,bi,bj)
123     c & -tmpFldV(I-1,J,k,bi,bj)
124     & -tmpFldU(I,J,k,bi,bj)
125     & +tmpFldU(I,J-1,k,bi,bj)
126     I=sNx+1
127     J=sNy+1
128     vort3(I,J)=
129     c & tmpFldV(I,J,k,bi,bj)
130     & -tmpFldV(I-1,J,k,bi,bj)
131     & -tmpFldU(I,J,k,bi,bj)
132     & +tmpFldU(I,J-1,k,bi,bj)
133     ENDIF
134     ENDIF
135    
136     c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
137    
138     IF (N.GT.nShapUV-nShapUVPhys) THEN
139     CALL MOM_CALC_HFACZ(bi,bj,k,hFacZ,r_hFacZ,myThid)
140     CALL MOM_VI_DEL2UV(
141     I bi,bj,k,hDiv,vort3,hFacZ,
142     O tmpFldU(1-OLx,1-OLy,k,bi,bj),
143     O tmpFldV(1-OLx,1-OLy,k,bi,bj),
144     I myThid)
145     IF (Shap_uvLength.EQ.0.) THEN
146     DO J=1,sNy+1
147     DO I=1,sNx+1
148     tmpFldU(i,j,k,bi,bj) = -0.125*tmpFldU(i,j,k,bi,bj)
149     & *rAw(i,j,bi,bj)*_maskW(i,j,k,bi,bj)
150     tmpFldV(i,j,k,bi,bj) = -0.125*tmpFldV(i,j,k,bi,bj)
151     & *rAs(i,j,bi,bj)*_maskS(i,j,k,bi,bj)
152     ENDDO
153     ENDDO
154     ELSE
155     DO J=1,sNy+1
156     DO I=1,sNx+1
157     tmpFldU(i,j,k,bi,bj) = -0.125*tmpFldU(i,j,k,bi,bj)
158     & *Shap_uvLength*Shap_uvLength*_maskW(i,j,k,bi,bj)
159     tmpFldV(i,j,k,bi,bj) = -0.125*tmpFldV(i,j,k,bi,bj)
160     & *Shap_uvLength*Shap_uvLength*_maskS(i,j,k,bi,bj)
161     ENDDO
162     ENDDO
163     ENDIF
164     ELSE
165 adcroft 1.2 DO J=1,sNy
166     DO I=1,sNx+1
167 jmc 1.3 tmpFldU(i,j,k,bi,bj) = -0.125*
168     & ( hDiv(i,j)-hDiv(i-1,j)
169 adcroft 1.2 & -vort3(i,j+1)+vort3(i,j)
170 jmc 1.3 & )*maskW(i,j,k,bi,bj)
171 adcroft 1.2 ENDDO
172     ENDDO
173     DO J=1,sNy+1
174     DO I=1,sNx
175 jmc 1.3 tmpFldV(i,j,k,bi,bj) = -0.125*
176     & ( vort3(i+1,j)-vort3(i,j)
177 adcroft 1.2 & +hDiv(i,j)-hDiv(i,j-1)
178 jmc 1.3 & )*maskS(i,j,k,bi,bj)
179 adcroft 1.2 ENDDO
180     ENDDO
181    
182 jmc 1.3 ENDIF
183 adcroft 1.2
184     ENDDO
185     ENDDO
186     ENDDO
187 jmc 1.3 C end loop N=1,nShapUV
188     ENDDO
189 adcroft 1.2
190 jmc 1.3 c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
191 adcroft 1.2
192     C F <- [1 - (d_xx+d_yy)^n *deltat/tau].F
193     DO bj=myByLo(myThid),myByHi(myThid)
194     DO bi=myBxLo(myThid),myBxHi(myThid)
195     DO K=1,Nr
196     DO J=1,sNy+1
197 jmc 1.3 DO I=1,sNx
198 adcroft 1.2 uFld(i,j,k,bi,bj)=uFld(i,j,k,bi,bj)
199     & -tmpFldU(i,j,k,bi,bj)*deltaTmom/Shap_uvtau
200 jmc 1.3 ENDDO
201     ENDDO
202     DO J=1,sNy+1
203     DO I=1,sNx
204 adcroft 1.2 vFld(i,j,k,bi,bj)=vFld(i,j,k,bi,bj)
205     & -tmpFldV(i,j,k,bi,bj)*deltaTmom/Shap_uvtau
206     ENDDO
207     ENDDO
208     ENDDO
209     ENDDO
210     ENDDO
211    
212     CALL EXCH_UV_XYZ_RL(uFld,vFld,.TRUE.,myThid)
213    
214     ENDIF
215     #endif /* ALLOW_SHAP_FILT */
216    
217     RETURN
218     END
  ViewVC Help
Powered by ViewVC 1.1.22