/[MITgcm]/MITgcm/verification/aim.5l_cs/code/shap_filt_uv_s2.F
ViewVC logotype

Contents of /MITgcm/verification/aim.5l_cs/code/shap_filt_uv_s2.F

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

Revision 1.1.4.1 - (show annotations) (download)
Tue Feb 26 16:05:07 2002 UTC (22 years, 1 month ago) by adcroft
Branch: release1
CVS Tags: release1_p12, release1_p13, release1_p10, release1_p16, release1_p17, release1_p14, release1_p15, release1_p13_pre, release1_p12_pre, release1_p11, release1_p8, release1_p9, release1_p2, release1_p3, release1_p4, release1_p6, release1_p7, release1_p1, release1_p5, release1_chkpt44d_post
Branch point for: release1_50yr
Changes since 1.1: +2 -2 lines 
Merging changes on MAIN between checkpoint43 and checkpoint43a-release1mods
Command: cvs -q update -jcheckpoint43 -jcheckpoint43a-release1mods -d -P

These changes are most of the changes between c43 and c44 except those
that occured after "12:45 11 Jan 2002". As far as I can tell it is
checkpoint43 with the following mods:

  o fix bug in mom_vi_del2uv
  o select when filters are applied ; add options to zonal_filter (data.zonfilt)  o gmredi: fix Pb in the adiabatic form ; add options (.e.g. Bolus advection)
  o update AIM experiments (NCEP input files)
  o improve and extend diagnostics (Monitor, TimeAve with NonLin-FrSurf)
  o added some stuff for AD
  o Jamar wet-points

This update does not contain the following mods that are in checkpoint44

  o bug fix in pkg/generic_advdiff/
    - thread related bug, bi,bj arguments in vertical advection routines
  o some changes to pkg/autodiff, pkg/cost, pkg/exf, pkg/ecco,
    verification/carbon and model/src/ related to adjoint
  o some new Matlab scripts for diagnosing model density
    - utils/matlab/dens_poly3.m and ini_poly3.m

The list of exclusions is accurate based on a "cvs diff". The list of
inclusions is based on the record in doc/tag-index which may not be complete.
1 C $Header: /u/gcmpack/MITgcm/verification/aim.5l_cs/code/shap_filt_uv_s2.F,v 1.1 2002/01/09 00:28:55 jmc Exp $
2 C $Name: checkpoint43a-release1mods $
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 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
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 _RS maskZ
48
49 IF (nShapUV.GT.0 .AND. Shap_uvtau.GT.0.) THEN
50
51 DO bj=myByLo(myThid),myByHi(myThid)
52 DO bi=myBxLo(myThid),myBxHi(myThid)
53 DO K=1,Nr
54 DO J=1-Oly,sNy+Oly
55 DO I=1-Olx,sNx+Olx
56 tmpFldU(i,j,k,bi,bj)=uFld(i,j,k,bi,bj)
57 & *_maskW(i,j,k,bi,bj)
58 tmpFldV(i,j,k,bi,bj)=vFld(i,j,k,bi,bj)
59 & *_maskS(i,j,k,bi,bj)
60 ENDDO
61 ENDDO
62 ENDDO
63 ENDDO
64 ENDDO
65
66 c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
67
68 C [d_xx+d_yy]^n tmpFld
69
70 DO N=1,nShapUV
71
72 CALL EXCH_UV_XYZ_RL(tmpFldU,tmpFldV,.TRUE.,myThid)
73
74 DO bj=myByLo(myThid),myByHi(myThid)
75 DO bi=myBxLo(myThid),myBxHi(myThid)
76 DO K=1,Nr
77
78 C [d_xx+d_yy] tmpFld
79 IF (N.LE.nShapUVPhys) THEN
80 CALL MOM_CALC_HFACZ(bi,bj,k,hFacZ,r_hFacZ,myThid)
81 CALL MOM_VI_CALC_HDIV(bi,bj,k,
82 I tmpFldU(1-OLx,1-OLy,k,bi,bj),
83 I tmpFldV(1-OLx,1-OLy,k,bi,bj),
84 & hDiv,myThid)
85 c CALL MOM_VI_CALC_RELVORT3(bi,bj,k,
86 CALL SHAP_FILT_RELVORT3(bi,bj,k,
87 I tmpFldU(1-OLx,1-OLy,k,bi,bj),
88 I tmpFldV(1-OLx,1-OLy,k,bi,bj),
89 & hFacZ,vort3,myThid)
90 ELSE
91 C- replace Physical calc Div & Vort by computational one :
92 DO J=0,sNy+1
93 DO I=0,sNx+1
94 hDiv(i,j)=tmpFldU(i+1,j,k,bi,bj)-tmpFldU(i,j,k,bi,bj)
95 & +tmpFldV(i,j+1,k,bi,bj)-tmpFldV(i,j,k,bi,bj)
96 ENDDO
97 ENDDO
98 DO J=1,sNy+1
99 DO I=1,sNx+1
100 vort3(i,j)=(tmpFldV(i,j,k,bi,bj)-tmpFldV(i-1,j,k,bi,bj)
101 & -tmpFldU(i,j,k,bi,bj)+tmpFldU(i,j-1,k,bi,bj)
102 & )
103 maskZ = (maskW(i,j,k,bi,bj)+maskW(i,j-1,k,bi,bj))
104 & *(maskS(i,j,k,bi,bj)+maskS(i-1,j,k,bi,bj))
105 IF (maskZ.LT.1.) vort3(i,j)=0.
106 ENDDO
107 ENDDO
108
109 C Special stuff for Cubed Sphere
110 IF (useCubedSphereExchange) THEN
111 c---
112 I=1
113 J=1
114 maskZ = maskW(i,j,k,bi,bj)+maskW(i,j-1,k,bi,bj)
115 & +maskS(i,j,k,bi,bj)
116 IF (maskZ.GE.2.) THEN
117 vort3(I,J)=
118 & tmpFldV(I,J,k,bi,bj)
119 c & -tmpFldV(I-1,J,k,bi,bj)
120 & -tmpFldU(I,J,k,bi,bj)
121 & +tmpFldU(I,J-1,k,bi,bj)
122 vort3(I,J)=vort3(I,J)*4.d0/3.d0
123 ELSE
124 vort3(I,J)=0.
125 ENDIF
126 c---
127 I=sNx+1
128 J=1
129 maskZ = maskW(i,j,k,bi,bj)+maskW(i,j-1,k,bi,bj)
130 & +maskS(i-1,j,k,bi,bj)
131 IF (maskZ.GE.2.) THEN
132 vort3(I,J)=
133 c & tmpFldV(I,J,k,bi,bj)
134 & -tmpFldV(I-1,J,k,bi,bj)
135 & -tmpFldU(I,J,k,bi,bj)
136 & +tmpFldU(I,J-1,k,bi,bj)
137 vort3(I,J)=vort3(I,J)*4.d0/3.d0
138 ELSE
139 vort3(I,J)=0.
140 ENDIF
141 c---
142 I=1
143 J=sNy+1
144 maskZ = maskW(i,j,k,bi,bj)+maskW(i,j-1,k,bi,bj)
145 & +maskS(i,j,k,bi,bj)
146 IF (maskZ.GE.2.) THEN
147 vort3(I,J)=
148 & tmpFldV(I,J,k,bi,bj)
149 c & -tmpFldV(I-1,J,k,bi,bj)
150 & -tmpFldU(I,J,k,bi,bj)
151 & +tmpFldU(I,J-1,k,bi,bj)
152 vort3(I,J)=vort3(I,J)*4.d0/3.d0
153 ELSE
154 vort3(I,J)=0.
155 ENDIF
156 c---
157 I=sNx+1
158 J=sNy+1
159 maskZ = maskW(i,j,k,bi,bj)+maskW(i,j-1,k,bi,bj)
160 & +maskS(i-1,j,k,bi,bj)
161 IF (maskZ.GE.2.) THEN
162 vort3(I,J)=
163 c & tmpFldV(I,J,k,bi,bj)
164 & -tmpFldV(I-1,J,k,bi,bj)
165 & -tmpFldU(I,J,k,bi,bj)
166 & +tmpFldU(I,J-1,k,bi,bj)
167 vort3(I,J)=vort3(I,J)*4.d0/3.d0
168 ELSE
169 vort3(I,J)=0.
170 ENDIF
171 c---
172 ENDIF
173 ENDIF
174
175 c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
176
177 IF (N.GT.nShapUV-nShapUVPhys) THEN
178 CALL MOM_CALC_HFACZ(bi,bj,k,hFacZ,r_hFacZ,myThid)
179 CALL MOM_VI_DEL2UV(
180 I bi,bj,k,hDiv,vort3,hFacZ,
181 O tmpFldU(1-OLx,1-OLy,k,bi,bj),
182 O tmpFldV(1-OLx,1-OLy,k,bi,bj),
183 I myThid)
184 IF (Shap_uvLength.EQ.0.) THEN
185 DO J=1,sNy+1
186 DO I=1,sNx+1
187 tmpFldU(i,j,k,bi,bj) = -0.125*tmpFldU(i,j,k,bi,bj)
188 & *rAw(i,j,bi,bj)*_maskW(i,j,k,bi,bj)
189 tmpFldV(i,j,k,bi,bj) = -0.125*tmpFldV(i,j,k,bi,bj)
190 & *rAs(i,j,bi,bj)*_maskS(i,j,k,bi,bj)
191 ENDDO
192 ENDDO
193 ELSE
194 DO J=1,sNy+1
195 DO I=1,sNx+1
196 tmpFldU(i,j,k,bi,bj) = -0.125*tmpFldU(i,j,k,bi,bj)
197 & *Shap_uvLength*Shap_uvLength*_maskW(i,j,k,bi,bj)
198 tmpFldV(i,j,k,bi,bj) = -0.125*tmpFldV(i,j,k,bi,bj)
199 & *Shap_uvLength*Shap_uvLength*_maskS(i,j,k,bi,bj)
200 ENDDO
201 ENDDO
202 ENDIF
203 ELSE
204 DO J=1,sNy
205 DO I=1,sNx+1
206 tmpFldU(i,j,k,bi,bj) = -0.125*
207 & ( hDiv(i,j)-hDiv(i-1,j)
208 & -vort3(i,j+1)+vort3(i,j)
209 & )*maskW(i,j,k,bi,bj)
210 ENDDO
211 ENDDO
212 DO J=1,sNy+1
213 DO I=1,sNx
214 tmpFldV(i,j,k,bi,bj) = -0.125*
215 & ( vort3(i+1,j)-vort3(i,j)
216 & +hDiv(i,j)-hDiv(i,j-1)
217 & )*maskS(i,j,k,bi,bj)
218 ENDDO
219 ENDDO
220
221 ENDIF
222
223 ENDDO
224 ENDDO
225 ENDDO
226 C end loop N=1,nShapUV
227 ENDDO
228
229 c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
230
231 C F <- [1 - (d_xx+d_yy)^n *deltat/tau].F
232 DO bj=myByLo(myThid),myByHi(myThid)
233 DO bi=myBxLo(myThid),myBxHi(myThid)
234 DO K=1,Nr
235 DO J=1,sNy+1
236 DO I=1,sNx
237 uFld(i,j,k,bi,bj)=uFld(i,j,k,bi,bj)
238 & -tmpFldU(i,j,k,bi,bj)*deltaTmom/Shap_uvtau
239 ENDDO
240 ENDDO
241 DO J=1,sNy+1
242 DO I=1,sNx
243 vFld(i,j,k,bi,bj)=vFld(i,j,k,bi,bj)
244 & -tmpFldV(i,j,k,bi,bj)*deltaTmom/Shap_uvtau
245 ENDDO
246 ENDDO
247 ENDDO
248 ENDDO
249 ENDDO
250
251 CALL EXCH_UV_XYZ_RL(uFld,vFld,.TRUE.,myThid)
252
253 ENDIF
254 #endif /* ALLOW_SHAP_FILT */
255
256 RETURN
257 END
  ViewVC Help
Powered by ViewVC 1.1.22