/[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.2 - (hide annotations) (download)
Tue May 29 14:01:40 2001 UTC (23 years, 1 month ago) by adcroft
Branch: MAIN
Changes since 1.1: +182 -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_s2.F,v 1.1.2.5 2001/05/09 13:30:22 adcroft Exp $
2     C $Name: pre38-close $
3    
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    
32     C == Local variables ==
33     INTEGER bi,bj,K,I,J,N
34     _RS hFacZ(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
35     _RS r_hFacZ(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
36     _RL hDiv(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
37     _RL vort3(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
38     _RL tmpGrdU(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
39     _RL tmpGrdV(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
40    
41     IF (nShapUV.gt.0 .AND. Shap_uvtau.GT.0.) THEN
42    
43     DO bj=myByLo(myThid),myByHi(myThid)
44     DO bi=myBxLo(myThid),myBxHi(myThid)
45     DO K=1,Nr
46     DO J=1,sNy
47     DO I=1,sNx+1
48     tmpFldU(i,j,k,bi,bj)=uFld(i,j,k,bi,bj)
49     & *_maskW(i,j,k,bi,bj)
50     ENDDO
51     ENDDO
52     DO J=1,sNy+1
53     DO I=1,sNx
54     tmpFldV(i,j,k,bi,bj)=vFld(i,j,k,bi,bj)
55     & *_maskS(i,j,k,bi,bj)
56     ENDDO
57     ENDDO
58     ENDDO
59     ENDDO
60     ENDDO
61    
62    
63     C [d_xx+d_yy]^n tmpFld
64    
65     DO N=1,nShapUV
66    
67     CALL EXCH_UV_XYZ_RL(tmpFldU,tmpFldV,.TRUE.,myThid)
68    
69     DO bj=myByLo(myThid),myByHi(myThid)
70     DO bi=myBxLo(myThid),myBxHi(myThid)
71     DO K=1,Nr
72    
73     C [d_xx+d_yy] tmpFld
74     CALL MOM_CALC_HFACZ(bi,bj,k,hFacZ,r_hFacZ,myThid)
75     c CALL MOM_VI_CALC_HDIV(bi,bj,k,
76     c I tmpFldU(1-OLx,1-OLy,k,bi,bj),
77     c I tmpFldV(1-OLx,1-OLy,k,bi,bj),
78     c & hDiv,myThid)
79     DO J=0,sNy+1
80     DO I=0,sNx+1
81     hDiv(i,j)=tmpFldU(i+1,j,k,bi,bj)-tmpFldU(i,j,k,bi,bj)
82     & +tmpFldV(i,j+1,k,bi,bj)-tmpFldV(i,j,k,bi,bj)
83     ENDDO
84     ENDDO
85     c CALL MOM_VI_CALC_RELVORT3(bi,bj,k,
86     c I tmpFldU(1-OLx,1-OLy,k,bi,bj),
87     c I tmpFldV(1-OLx,1-OLy,k,bi,bj),
88     c & hFacZ,vort3,myThid)
89     DO J=1,sNy+1
90     DO I=1,sNx+1
91     vort3(i,j)=(tmpFldV(i,j,k,bi,bj)-tmpFldV(i-1,j,k,bi,bj)
92     & -tmpFldU(i,j,k,bi,bj)+tmpFldU(i,j-1,k,bi,bj)
93     & )
94     ENDDO
95     ENDDO
96     C Special stuff for Cubed Sphere
97     IF (useCubedSphereExchange) THEN
98     I=1
99     J=1
100     vort3(I,J)=
101     & tmpFldV(I,J,k,bi,bj)
102     c & -tmpFldV(I-1,J,k,bi,bj)
103     & -tmpFldU(I,J,k,bi,bj)
104     & +tmpFldU(I,J-1,k,bi,bj)
105     I=sNx+1
106     J=1
107     vort3(I,J)=
108     c & tmpFldV(I,J,k,bi,bj)
109     & -tmpFldV(I-1,J,k,bi,bj)
110     & -tmpFldU(I,J,k,bi,bj)
111     & +tmpFldU(I,J-1,k,bi,bj)
112     I=1
113     J=sNy+1
114     vort3(I,J)=
115     & tmpFldV(I,J,k,bi,bj)
116     c & -tmpFldV(I-1,J,k,bi,bj)
117     & -tmpFldU(I,J,k,bi,bj)
118     & +tmpFldU(I,J-1,k,bi,bj)
119     I=sNx+1
120     J=sNy+1
121     vort3(I,J)=
122     c & tmpFldV(I,J,k,bi,bj)
123     & -tmpFldV(I-1,J,k,bi,bj)
124     & -tmpFldU(I,J,k,bi,bj)
125     & +tmpFldU(I,J-1,k,bi,bj)
126     ENDIF
127    
128     c CALL MOM_VI_DEL2UV(
129     c I bi,bj,k,hDiv,vort3,hFacZ,
130     c O tmpGrdU,tmpGrdV,
131     c & myThid)
132     DO J=1,sNy
133     DO I=1,sNx+1
134     tmpGrdU(i,j)=(hDiv(i,j)-hDiv(i-1,j)
135     & -vort3(i,j+1)+vort3(i,j)
136     & )*maskW(i,j,k,bi,bj)
137     ENDDO
138     ENDDO
139     DO J=1,sNy+1
140     DO I=1,sNx
141     tmpGrdV(i,j)=(vort3(i+1,j)-vort3(i,j)
142     & +hDiv(i,j)-hDiv(i,j-1)
143     & )*maskS(i,j,k,bi,bj)
144     ENDDO
145     ENDDO
146    
147     DO J=1,sNy+1
148     DO I=1,sNx+1
149     tmpFldU(i,j,k,bi,bj) = -0.125*tmpGrdU(i,j)
150     tmpFldV(i,j,k,bi,bj) = -0.125*tmpGrdV(i,j)
151     ENDDO
152     ENDDO
153    
154     ENDDO
155     ENDDO
156     ENDDO
157    
158     ENDDO
159    
160     C F <- [1 - (d_xx+d_yy)^n *deltat/tau].F
161     DO bj=myByLo(myThid),myByHi(myThid)
162     DO bi=myBxLo(myThid),myBxHi(myThid)
163     DO K=1,Nr
164     DO J=1,sNy+1
165     DO I=1,sNx+1
166     uFld(i,j,k,bi,bj)=uFld(i,j,k,bi,bj)
167     & -tmpFldU(i,j,k,bi,bj)*deltaTmom/Shap_uvtau
168     vFld(i,j,k,bi,bj)=vFld(i,j,k,bi,bj)
169     & -tmpFldV(i,j,k,bi,bj)*deltaTmom/Shap_uvtau
170     ENDDO
171     ENDDO
172     ENDDO
173     ENDDO
174     ENDDO
175    
176     CALL EXCH_UV_XYZ_RL(uFld,vFld,.TRUE.,myThid)
177    
178     ENDIF
179     #endif /* ALLOW_SHAP_FILT */
180    
181     RETURN
182     END
  ViewVC Help
Powered by ViewVC 1.1.22