/[MITgcm]/MITgcm/pkg/mom_fluxform/mom_fluxform.F
ViewVC logotype

Contents of /MITgcm/pkg/mom_fluxform/mom_fluxform.F

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


Revision 1.38 - (show annotations) (download)
Thu Nov 23 00:45:18 2006 UTC (17 years, 6 months ago) by jmc
Branch: MAIN
Changes since 1.37: +4 -6 lines
nitialise vort3 (Pb reported by Martin).

1 C $Header: /u/gcmpack/MITgcm/pkg/mom_fluxform/mom_fluxform.F,v 1.37 2006/07/13 03:02:48 jmc Exp $
2 C $Name: $
3
4 CBOI
5 C !TITLE: pkg/mom\_advdiff
6 C !AUTHORS: adcroft@mit.edu
7 C !INTRODUCTION: Flux-form Momentum Equations Package
8 C
9 C Package "mom\_fluxform" provides methods for calculating explicit terms
10 C in the momentum equation cast in flux-form:
11 C \begin{eqnarray*}
12 C G^u & = & -\frac{1}{\rho} \partial_x \phi_h
13 C -\nabla \cdot {\bf v} u
14 C -fv
15 C +\frac{1}{\rho} \nabla \cdot {\bf \tau}^x
16 C + \mbox{metrics}
17 C \\
18 C G^v & = & -\frac{1}{\rho} \partial_y \phi_h
19 C -\nabla \cdot {\bf v} v
20 C +fu
21 C +\frac{1}{\rho} \nabla \cdot {\bf \tau}^y
22 C + \mbox{metrics}
23 C \end{eqnarray*}
24 C where ${\bf v}=(u,v,w)$ and $\tau$, the stress tensor, includes surface
25 C stresses as well as internal viscous stresses.
26 CEOI
27
28 #include "MOM_FLUXFORM_OPTIONS.h"
29
30 CBOP
31 C !ROUTINE: MOM_FLUXFORM
32
33 C !INTERFACE: ==========================================================
34 SUBROUTINE MOM_FLUXFORM(
35 I bi,bj,iMin,iMax,jMin,jMax,k,kUp,kDown,
36 I KappaRU, KappaRV,
37 U fVerU, fVerV,
38 O guDiss, gvDiss,
39 I myTime, myIter, myThid)
40
41 C !DESCRIPTION:
42 C Calculates all the horizontal accelerations except for the implicit surface
43 C pressure gradient and implciit vertical viscosity.
44
45 C !USES: ===============================================================
46 C == Global variables ==
47 IMPLICIT NONE
48 #include "SIZE.h"
49 #include "DYNVARS.h"
50 #include "FFIELDS.h"
51 #include "EEPARAMS.h"
52 #include "PARAMS.h"
53 #include "GRID.h"
54 #include "SURFACE.h"
55 #ifdef ALLOW_AUTODIFF_TAMC
56 # include "tamc.h"
57 # include "tamc_keys.h"
58 # include "MOM_FLUXFORM.h"
59 #endif
60
61 C !INPUT PARAMETERS: ===================================================
62 C bi,bj :: tile indices
63 C iMin,iMax,jMin,jMAx :: loop ranges
64 C k :: vertical level
65 C kUp :: =1 or 2 for consecutive k
66 C kDown :: =2 or 1 for consecutive k
67 C KappaRU :: vertical viscosity
68 C KappaRV :: vertical viscosity
69 C fVerU :: vertical flux of U, 2 1/2 dim for pipe-lining
70 C fVerV :: vertical flux of V, 2 1/2 dim for pipe-lining
71 C guDiss :: dissipation tendency (all explicit terms), u component
72 C gvDiss :: dissipation tendency (all explicit terms), v component
73 C myTime :: current time
74 C myIter :: current time-step number
75 C myThid :: thread number
76 INTEGER bi,bj,iMin,iMax,jMin,jMax
77 INTEGER k,kUp,kDown
78 _RL KappaRU(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
79 _RL KappaRV(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
80 _RL fVerU(1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
81 _RL fVerV(1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
82 _RL guDiss(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
83 _RL gvDiss(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
84 _RL myTime
85 INTEGER myIter
86 INTEGER myThid
87
88 C !OUTPUT PARAMETERS: ==================================================
89 C None - updates gU() and gV() in common blocks
90
91 C !LOCAL VARIABLES: ====================================================
92 C i,j :: loop indices
93 C vF :: viscous flux
94 C v4F :: bi-harmonic viscous flux
95 C cF :: Coriolis acceleration
96 C mT :: Metric terms
97 C fZon :: zonal fluxes
98 C fMer :: meridional fluxes
99 C fVrUp,fVrDw :: vertical viscous fluxes at interface k-1 & k
100 INTEGER i,j
101 #ifdef ALLOW_AUTODIFF_TAMC
102 INTEGER imomkey
103 #endif
104 _RL vF(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
105 _RL v4F(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
106 _RL cF(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
107 _RL mT(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
108 _RL fZon(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
109 _RL fMer(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
110 _RL fVrUp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
111 _RL fVrDw(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
112 C afFacMom :: Tracer parameters for turning terms on and off.
113 C vfFacMom
114 C pfFacMom afFacMom - Advective terms
115 C cfFacMom vfFacMom - Eddy viscosity terms
116 C mtFacMom pfFacMom - Pressure terms
117 C cfFacMom - Coriolis terms
118 C foFacMom - Forcing
119 C mtFacMom - Metric term
120 C uDudxFac, AhDudxFac, etc ... individual term parameters for switching terms off
121 _RS hFacZ(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
122 _RS r_hFacZ(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
123 _RS xA(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
124 _RS yA(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
125 _RL uTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
126 _RL vTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
127 _RL uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
128 _RL vFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
129 _RL rTransU(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
130 _RL rTransV(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
131 _RL KE(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
132 _RL viscAh_D(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
133 _RL viscAh_Z(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
134 _RL viscA4_D(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
135 _RL viscA4_Z(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
136 _RL vort3(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
137 _RL hDiv(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
138 _RL strain(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
139 _RL tension(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
140 _RL uDudxFac
141 _RL AhDudxFac
142 _RL vDudyFac
143 _RL AhDudyFac
144 _RL rVelDudrFac
145 _RL ArDudrFac
146 _RL fuFac
147 _RL mtFacU
148 _RL mtNHFacU
149 _RL uDvdxFac
150 _RL AhDvdxFac
151 _RL vDvdyFac
152 _RL AhDvdyFac
153 _RL rVelDvdrFac
154 _RL ArDvdrFac
155 _RL fvFac
156 _RL mtFacV
157 _RL mtNHFacV
158 _RL sideMaskFac
159 LOGICAL bottomDragTerms,harmonic,biharmonic,useVariableViscosity
160 CEOP
161
162 #ifdef ALLOW_AUTODIFF_TAMC
163 act0 = k - 1
164 max0 = Nr
165 act1 = bi - myBxLo(myThid)
166 max1 = myBxHi(myThid) - myBxLo(myThid) + 1
167 act2 = bj - myByLo(myThid)
168 max2 = myByHi(myThid) - myByLo(myThid) + 1
169 act3 = myThid - 1
170 max3 = nTx*nTy
171 act4 = ikey_dynamics - 1
172 imomkey = (act0 + 1)
173 & + act1*max0
174 & + act2*max0*max1
175 & + act3*max0*max1*max2
176 & + act4*max0*max1*max2*max3
177 #endif /* ALLOW_AUTODIFF_TAMC */
178
179 C Initialise intermediate terms
180 DO j=1-OLy,sNy+OLy
181 DO i=1-OLx,sNx+OLx
182 vF(i,j) = 0.
183 v4F(i,j) = 0.
184 cF(i,j) = 0.
185 mT(i,j) = 0.
186 fZon(i,j) = 0.
187 fMer(i,j) = 0.
188 fVrUp(i,j)= 0.
189 fVrDw(i,j)= 0.
190 rTransU(i,j)= 0.
191 rTransV(i,j)= 0.
192 c KE(i,j) = 0.
193 c hDiv(i,j) = 0.
194 vort3(i,j) = 0.
195 strain(i,j) = 0.
196 tension(i,j)= 0.
197 guDiss(i,j) = 0.
198 gvDiss(i,j) = 0.
199 ENDDO
200 ENDDO
201
202 C-- Term by term tracer parmeters
203 C o U momentum equation
204 uDudxFac = afFacMom*1.
205 AhDudxFac = vfFacMom*1.
206 vDudyFac = afFacMom*1.
207 AhDudyFac = vfFacMom*1.
208 rVelDudrFac = afFacMom*1.
209 ArDudrFac = vfFacMom*1.
210 mtFacU = mtFacMom*1.
211 mtNHFacU = 1.
212 fuFac = cfFacMom*1.
213 C o V momentum equation
214 uDvdxFac = afFacMom*1.
215 AhDvdxFac = vfFacMom*1.
216 vDvdyFac = afFacMom*1.
217 AhDvdyFac = vfFacMom*1.
218 rVelDvdrFac = afFacMom*1.
219 ArDvdrFac = vfFacMom*1.
220 mtFacV = mtFacMom*1.
221 mtNHFacV = 1.
222 fvFac = cfFacMom*1.
223
224 IF (implicitViscosity) THEN
225 ArDudrFac = 0.
226 ArDvdrFac = 0.
227 ENDIF
228
229 C note: using standard stencil (no mask) results in under-estimating
230 C vorticity at a no-slip boundary by a factor of 2 = sideDragFactor
231 IF ( no_slip_sides ) THEN
232 sideMaskFac = sideDragFactor
233 ELSE
234 sideMaskFac = 0. _d 0
235 ENDIF
236
237 IF ( no_slip_bottom
238 & .OR. bottomDragQuadratic.NE.0.
239 & .OR. bottomDragLinear.NE.0.) THEN
240 bottomDragTerms=.TRUE.
241 ELSE
242 bottomDragTerms=.FALSE.
243 ENDIF
244
245 C-- Calculate open water fraction at vorticity points
246 CALL MOM_CALC_HFACZ(bi,bj,k,hFacZ,r_hFacZ,myThid)
247
248 C---- Calculate common quantities used in both U and V equations
249 C Calculate tracer cell face open areas
250 DO j=1-OLy,sNy+OLy
251 DO i=1-OLx,sNx+OLx
252 xA(i,j) = _dyG(i,j,bi,bj)
253 & *drF(k)*_hFacW(i,j,k,bi,bj)
254 yA(i,j) = _dxG(i,j,bi,bj)
255 & *drF(k)*_hFacS(i,j,k,bi,bj)
256 ENDDO
257 ENDDO
258
259 C Make local copies of horizontal flow field
260 DO j=1-OLy,sNy+OLy
261 DO i=1-OLx,sNx+OLx
262 uFld(i,j) = uVel(i,j,k,bi,bj)
263 vFld(i,j) = vVel(i,j,k,bi,bj)
264 ENDDO
265 ENDDO
266
267 C Calculate velocity field "volume transports" through tracer cell faces.
268 DO j=1-OLy,sNy+OLy
269 DO i=1-OLx,sNx+OLx
270 uTrans(i,j) = uFld(i,j)*xA(i,j)
271 vTrans(i,j) = vFld(i,j)*yA(i,j)
272 ENDDO
273 ENDDO
274
275 CALL MOM_CALC_KE(bi,bj,k,2,uFld,vFld,KE,myThid)
276 IF ( momViscosity) THEN
277 CALL MOM_CALC_HDIV(bi,bj,k,2,uFld,vFld,hDiv,myThid)
278 CALL MOM_CALC_RELVORT3(bi,bj,k,uFld,vFld,hFacZ,vort3,myThid)
279 CALL MOM_CALC_TENSION(bi,bj,k,uFld,vFld,tension,myThid)
280 CALL MOM_CALC_STRAIN(bi,bj,k,uFld,vFld,hFacZ,strain,myThid)
281 DO j=1-Oly,sNy+Oly
282 DO i=1-Olx,sNx+Olx
283 IF ( hFacZ(i,j).EQ.0. ) THEN
284 vort3(i,j) = sideMaskFac*vort3(i,j)
285 strain(i,j) = sideMaskFac*strain(i,j)
286 ENDIF
287 ENDDO
288 ENDDO
289 #ifdef ALLOW_DIAGNOSTICS
290 IF ( useDiagnostics ) THEN
291 CALL DIAGNOSTICS_FILL(hDiv, 'momHDiv ',k,1,2,bi,bj,myThid)
292 CALL DIAGNOSTICS_FILL(vort3, 'momVort3',k,1,2,bi,bj,myThid)
293 CALL DIAGNOSTICS_FILL(tension,'Tension ',k,1,2,bi,bj,myThid)
294 CALL DIAGNOSTICS_FILL(strain, 'Strain ',k,1,2,bi,bj,myThid)
295 ENDIF
296 #endif
297 ENDIF
298
299 C--- First call (k=1): compute vertical adv. flux fVerU(kUp) & fVerV(kUp)
300 IF (momAdvection.AND.k.EQ.1) THEN
301
302 C- Calculate vertical transports above U & V points (West & South face):
303
304 #ifdef ALLOW_AUTODIFF_TAMC
305 # ifdef NONLIN_FRSURF
306 # ifndef DISABLE_RSTAR_CODE
307 CADJ STORE dwtransc(:,:,bi,bj) =
308 CADJ & comlev1_bibj_k, key = imomkey, byte = isbyte
309 CADJ STORE dwtransu(:,:,bi,bj) =
310 CADJ & comlev1_bibj_k, key = imomkey, byte = isbyte
311 CADJ STORE dwtransv(:,:,bi,bj) =
312 CADJ & comlev1_bibj_k, key = imomkey, byte = isbyte
313 # endif
314 # endif /* NONLIN_FRSURF */
315 #endif /* ALLOW_AUTODIFF_TAMC */
316 CALL MOM_CALC_RTRANS( k, bi, bj,
317 O rTransU, rTransV,
318 I myTime, myIter, myThid)
319
320 C- Free surface correction term (flux at k=1)
321 CALL MOM_U_ADV_WU( bi,bj,k,uVel,wVel,rTransU,
322 O fVerU(1-OLx,1-OLy,kUp), myThid )
323
324 CALL MOM_V_ADV_WV( bi,bj,k,vVel,wVel,rTransV,
325 O fVerV(1-OLx,1-OLy,kUp), myThid )
326
327 C--- endif momAdvection & k=1
328 ENDIF
329
330
331 C--- Calculate vertical transports (at k+1) below U & V points :
332 IF (momAdvection) THEN
333 CALL MOM_CALC_RTRANS( k+1, bi, bj,
334 O rTransU, rTransV,
335 I myTime, myIter, myThid)
336 ENDIF
337
338 IF (momViscosity) THEN
339 CALL MOM_CALC_VISC(
340 I bi,bj,k,
341 O viscAh_Z,viscAh_D,viscA4_Z,viscA4_D,
342 O harmonic,biharmonic,useVariableViscosity,
343 I hDiv,vort3,tension,strain,KE,hFacZ,
344 I myThid)
345 ENDIF
346
347 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
348
349 C---- Zonal momentum equation starts here
350
351 IF (momAdvection) THEN
352 C--- Calculate mean fluxes (advection) between cells for zonal flow.
353
354 C-- Zonal flux (fZon is at east face of "u" cell)
355 C Mean flow component of zonal flux -> fZon
356 CALL MOM_U_ADV_UU(bi,bj,k,uTrans,uFld,fZon,myThid)
357
358 C-- Meridional flux (fMer is at south face of "u" cell)
359 C Mean flow component of meridional flux -> fMer
360 CALL MOM_U_ADV_VU(bi,bj,k,vTrans,uFld,fMer,myThid)
361
362 C-- Vertical flux (fVer is at upper face of "u" cell)
363 C Mean flow component of vertical flux (at k+1) -> fVer
364 CALL MOM_U_ADV_WU(
365 I bi,bj,k+1,uVel,wVel,rTransU,
366 O fVerU(1-OLx,1-OLy,kDown), myThid )
367
368 C-- Tendency is minus divergence of the fluxes + coriolis + pressure term
369 DO j=jMin,jMax
370 DO i=iMin,iMax
371 gU(i,j,k,bi,bj) =
372 #ifdef OLD_UV_GEOM
373 & -_recip_hFacW(i,j,k,bi,bj)*recip_drF(k)/
374 & ( 0.5 _d 0*(rA(i,j,bi,bj)+rA(i-1,j,bi,bj)) )
375 #else
376 & -_recip_hFacW(i,j,k,bi,bj)*recip_drF(k)
377 & *recip_rAw(i,j,bi,bj)
378 #endif
379 & *( ( fZon(i,j ) - fZon(i-1,j) )*uDudxFac
380 & +( fMer(i,j+1) - fMer(i, j) )*vDudyFac
381 & +(fVerU(i,j,kDown) - fVerU(i,j,kUp))*rkSign*rVelDudrFac
382 & )
383 ENDDO
384 ENDDO
385
386 #ifdef ALLOW_DIAGNOSTICS
387 IF ( useDiagnostics ) THEN
388 CALL DIAGNOSTICS_FILL(fZon,'ADVx_Um ',k,1,2,bi,bj,myThid)
389 CALL DIAGNOSTICS_FILL(fMer,'ADVy_Um ',k,1,2,bi,bj,myThid)
390 CALL DIAGNOSTICS_FILL(fVerU(1-Olx,1-Oly,kUp),
391 & 'ADVrE_Um',k,1,2,bi,bj,myThid)
392 ENDIF
393 #endif
394
395 #ifdef NONLIN_FRSURF
396 C-- account for 3.D divergence of the flow in rStar coordinate:
397 # ifndef DISABLE_RSTAR_CODE
398 IF ( select_rStar.GT.0 ) THEN
399 DO j=jMin,jMax
400 DO i=iMin,iMax
401 gU(i,j,k,bi,bj) = gU(i,j,k,bi,bj)
402 & - (rStarExpW(i,j,bi,bj) - 1. _d 0)/deltaTfreesurf
403 & *uVel(i,j,k,bi,bj)
404 ENDDO
405 ENDDO
406 ENDIF
407 IF ( select_rStar.LT.0 ) THEN
408 DO j=jMin,jMax
409 DO i=iMin,iMax
410 gU(i,j,k,bi,bj) = gU(i,j,k,bi,bj)
411 & - rStarDhWDt(i,j,bi,bj)*uVel(i,j,k,bi,bj)
412 ENDDO
413 ENDDO
414 ENDIF
415 # endif /* DISABLE_RSTAR_CODE */
416 #endif /* NONLIN_FRSURF */
417
418 ELSE
419 C- if momAdvection / else
420 DO j=1-OLy,sNy+OLy
421 DO i=1-OLx,sNx+OLx
422 gU(i,j,k,bi,bj) = 0. _d 0
423 ENDDO
424 ENDDO
425
426 C- endif momAdvection.
427 ENDIF
428
429 IF (momViscosity) THEN
430 C--- Calculate eddy fluxes (dissipation) between cells for zonal flow.
431
432 C Bi-harmonic term del^2 U -> v4F
433 IF (biharmonic)
434 & CALL MOM_U_DEL2U(bi,bj,k,uFld,hFacZ,v4f,myThid)
435
436 C Laplacian and bi-harmonic terms, Zonal Fluxes -> fZon
437 CALL MOM_U_XVISCFLUX(bi,bj,k,uFld,v4F,fZon,
438 I viscAh_D,viscA4_D,myThid)
439
440 C Laplacian and bi-harmonic termis, Merid Fluxes -> fMer
441 CALL MOM_U_YVISCFLUX(bi,bj,k,uFld,v4F,hFacZ,fMer,
442 I viscAh_Z,viscA4_Z,myThid)
443
444 C Eddy component of vertical flux (interior component only) -> fVrUp & fVrDw
445 IF (.NOT.implicitViscosity) THEN
446 CALL MOM_U_RVISCFLUX(bi,bj, k, uVel,KappaRU,fVrUp,myThid)
447 CALL MOM_U_RVISCFLUX(bi,bj,k+1,uVel,KappaRU,fVrDw,myThid)
448 ENDIF
449
450 C-- Tendency is minus divergence of the fluxes
451 DO j=jMin,jMax
452 DO i=iMin,iMax
453 guDiss(i,j) =
454 #ifdef OLD_UV_GEOM
455 & -_recip_hFacW(i,j,k,bi,bj)*recip_drF(k)/
456 & ( 0.5 _d 0*(rA(i,j,bi,bj)+rA(i-1,j,bi,bj)) )
457 #else
458 & -_recip_hFacW(i,j,k,bi,bj)*recip_drF(k)
459 & *recip_rAw(i,j,bi,bj)
460 #endif
461 & *( ( fZon(i,j ) - fZon(i-1,j) )*AhDudxFac
462 & +( fMer(i,j+1) - fMer(i, j) )*AhDudyFac
463 & +( fVrDw(i,j) - fVrUp(i,j) )*rkSign*ArDudrFac
464 & )
465 ENDDO
466 ENDDO
467
468 #ifdef ALLOW_DIAGNOSTICS
469 IF ( useDiagnostics ) THEN
470 CALL DIAGNOSTICS_FILL(fZon, 'VISCx_Um',k,1,2,bi,bj,myThid)
471 CALL DIAGNOSTICS_FILL(fMer, 'VISCy_Um',k,1,2,bi,bj,myThid)
472 IF (.NOT.implicitViscosity)
473 & CALL DIAGNOSTICS_FILL(fVrUp,'VISrE_Um',k,1,2,bi,bj,myThid)
474 ENDIF
475 #endif
476
477 C-- No-slip and drag BCs appear as body forces in cell abutting topography
478 IF (no_slip_sides) THEN
479 C- No-slip BCs impose a drag at walls...
480 CALL MOM_U_SIDEDRAG(
481 I bi,bj,k,
482 I uFld, v4f, hFacZ,
483 I viscAh_Z,viscA4_Z,
484 I harmonic,biharmonic,useVariableViscosity,
485 O vF,
486 I myThid)
487 DO j=jMin,jMax
488 DO i=iMin,iMax
489 gUdiss(i,j) = gUdiss(i,j) + vF(i,j)
490 ENDDO
491 ENDDO
492 ENDIF
493 C- No-slip BCs impose a drag at bottom
494 IF (bottomDragTerms) THEN
495 CALL MOM_U_BOTTOMDRAG(bi,bj,k,uFld,KE,KappaRU,vF,myThid)
496 DO j=jMin,jMax
497 DO i=iMin,iMax
498 gUdiss(i,j) = gUdiss(i,j) + vF(i,j)
499 ENDDO
500 ENDDO
501 ENDIF
502
503 #ifdef ALLOW_SHELFICE
504 IF (useShelfIce) THEN
505 CALL SHELFICE_U_DRAG(bi,bj,k,uFld,KE,KappaRU,vF,myThid)
506 DO j=jMin,jMax
507 DO i=iMin,iMax
508 gUdiss(i,j) = gUdiss(i,j) + vF(i,j)
509 ENDDO
510 ENDDO
511 ENDIF
512 #endif /* ALLOW_SHELFICE */
513
514 C- endif momViscosity
515 ENDIF
516
517 C-- Forcing term (moved to timestep.F)
518 c IF (momForcing)
519 c & CALL EXTERNAL_FORCING_U(
520 c I iMin,iMax,jMin,jMax,bi,bj,k,
521 c I myTime,myThid)
522
523 C-- Metric terms for curvilinear grid systems
524 IF (useNHMTerms) THEN
525 C o Non-Hydrostatic (spherical) metric terms
526 CALL MOM_U_METRIC_NH(bi,bj,k,uFld,wVel,mT,myThid)
527 DO j=jMin,jMax
528 DO i=iMin,iMax
529 gU(i,j,k,bi,bj) = gU(i,j,k,bi,bj)+mtNHFacU*mT(i,j)
530 ENDDO
531 ENDDO
532 ENDIF
533 IF ( usingSphericalPolarGrid .AND. metricTerms ) THEN
534 C o Spherical polar grid metric terms
535 CALL MOM_U_METRIC_SPHERE(bi,bj,k,uFld,vFld,mT,myThid)
536 DO j=jMin,jMax
537 DO i=iMin,iMax
538 gU(i,j,k,bi,bj) = gU(i,j,k,bi,bj)+mtFacU*mT(i,j)
539 ENDDO
540 ENDDO
541 ENDIF
542 IF ( usingCylindricalGrid .AND. metricTerms ) THEN
543 C o Cylindrical grid metric terms
544 CALL MOM_U_METRIC_CYLINDER(bi,bj,k,uFld,vFld,mT,myThid)
545 DO j=jMin,jMax
546 DO i=iMin,iMax
547 gU(i,j,k,bi,bj) = gU(i,j,k,bi,bj)+mtFacU*mT(i,j)
548 ENDDO
549 ENDDO
550 ENDIF
551
552 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
553
554 C---- Meridional momentum equation starts here
555
556 IF (momAdvection) THEN
557 C--- Calculate mean fluxes (advection) between cells for meridional flow.
558 C Mean flow component of zonal flux -> fZon
559 CALL MOM_V_ADV_UV(bi,bj,k,uTrans,vFld,fZon,myThid)
560
561 C-- Meridional flux (fMer is at north face of "v" cell)
562 C Mean flow component of meridional flux -> fMer
563 CALL MOM_V_ADV_VV(bi,bj,k,vTrans,vFld,fMer,myThid)
564
565 C-- Vertical flux (fVer is at upper face of "v" cell)
566 C Mean flow component of vertical flux (at k+1) -> fVerV
567 CALL MOM_V_ADV_WV(
568 I bi,bj,k+1,vVel,wVel,rTransV,
569 O fVerV(1-OLx,1-OLy,kDown), myThid )
570
571 C-- Tendency is minus divergence of the fluxes + coriolis + pressure term
572 DO j=jMin,jMax
573 DO i=iMin,iMax
574 gV(i,j,k,bi,bj) =
575 #ifdef OLD_UV_GEOM
576 & -_recip_hFacS(i,j,k,bi,bj)*recip_drF(k)/
577 & ( 0.5 _d 0*(_rA(i,j,bi,bj)+_rA(i,j-1,bi,bj)) )
578 #else
579 & -_recip_hFacS(i,j,k,bi,bj)*recip_drF(k)
580 & *recip_rAs(i,j,bi,bj)
581 #endif
582 & *( ( fZon(i+1,j) - fZon(i,j ) )*uDvdxFac
583 & +( fMer(i, j) - fMer(i,j-1) )*vDvdyFac
584 & +(fVerV(i,j,kDown) - fVerV(i,j,kUp))*rkSign*rVelDvdrFac
585 & )
586 ENDDO
587 ENDDO
588
589 #ifdef ALLOW_DIAGNOSTICS
590 IF ( useDiagnostics ) THEN
591 CALL DIAGNOSTICS_FILL(fZon,'ADVx_Vm ',k,1,2,bi,bj,myThid)
592 CALL DIAGNOSTICS_FILL(fMer,'ADVy_Vm ',k,1,2,bi,bj,myThid)
593 CALL DIAGNOSTICS_FILL(fVerV(1-Olx,1-Oly,kUp),
594 & 'ADVrE_Vm',k,1,2,bi,bj,myThid)
595 ENDIF
596 #endif
597
598 #ifdef NONLIN_FRSURF
599 C-- account for 3.D divergence of the flow in rStar coordinate:
600 # ifndef DISABLE_RSTAR_CODE
601 IF ( select_rStar.GT.0 ) THEN
602 DO j=jMin,jMax
603 DO i=iMin,iMax
604 gV(i,j,k,bi,bj) = gV(i,j,k,bi,bj)
605 & - (rStarExpS(i,j,bi,bj) - 1. _d 0)/deltaTfreesurf
606 & *vVel(i,j,k,bi,bj)
607 ENDDO
608 ENDDO
609 ENDIF
610 IF ( select_rStar.LT.0 ) THEN
611 DO j=jMin,jMax
612 DO i=iMin,iMax
613 gV(i,j,k,bi,bj) = gV(i,j,k,bi,bj)
614 & - rStarDhSDt(i,j,bi,bj)*vVel(i,j,k,bi,bj)
615 ENDDO
616 ENDDO
617 ENDIF
618 # endif /* DISABLE_RSTAR_CODE */
619 #endif /* NONLIN_FRSURF */
620
621 ELSE
622 C- if momAdvection / else
623 DO j=1-OLy,sNy+OLy
624 DO i=1-OLx,sNx+OLx
625 gV(i,j,k,bi,bj) = 0. _d 0
626 ENDDO
627 ENDDO
628
629 C- endif momAdvection.
630 ENDIF
631
632 IF (momViscosity) THEN
633 C--- Calculate eddy fluxes (dissipation) between cells for meridional flow.
634 C Bi-harmonic term del^2 V -> v4F
635 IF (biharmonic)
636 & CALL MOM_V_DEL2V(bi,bj,k,vFld,hFacZ,v4f,myThid)
637
638 C Laplacian and bi-harmonic terms, Zonal Fluxes -> fZon
639 CALL MOM_V_XVISCFLUX(bi,bj,k,vFld,v4f,hFacZ,fZon,
640 I viscAh_Z,viscA4_Z,myThid)
641
642 C Laplacian and bi-harmonic termis, Merid Fluxes -> fMer
643 CALL MOM_V_YVISCFLUX(bi,bj,k,vFld,v4f,fMer,
644 I viscAh_D,viscA4_D,myThid)
645
646 C Eddy component of vertical flux (interior component only) -> fVrUp & fVrDw
647 IF (.NOT.implicitViscosity) THEN
648 CALL MOM_V_RVISCFLUX(bi,bj, k, vVel,KappaRV,fVrUp,myThid)
649 CALL MOM_V_RVISCFLUX(bi,bj,k+1,vVel,KappaRV,fVrDw,myThid)
650 ENDIF
651
652 C-- Tendency is minus divergence of the fluxes + coriolis + pressure term
653 DO j=jMin,jMax
654 DO i=iMin,iMax
655 gvDiss(i,j) =
656 #ifdef OLD_UV_GEOM
657 & -_recip_hFacS(i,j,k,bi,bj)*recip_drF(k)/
658 & ( 0.5 _d 0*(_rA(i,j,bi,bj)+_rA(i,j-1,bi,bj)) )
659 #else
660 & -_recip_hFacS(i,j,k,bi,bj)*recip_drF(k)
661 & *recip_rAs(i,j,bi,bj)
662 #endif
663 & *( ( fZon(i+1,j) - fZon(i,j ) )*AhDvdxFac
664 & +( fMer(i, j) - fMer(i,j-1) )*AhDvdyFac
665 & +( fVrDw(i,j) - fVrUp(i,j) )*rkSign*ArDvdrFac
666 & )
667 ENDDO
668 ENDDO
669
670 #ifdef ALLOW_DIAGNOSTICS
671 IF ( useDiagnostics ) THEN
672 CALL DIAGNOSTICS_FILL(fZon, 'VISCx_Vm',k,1,2,bi,bj,myThid)
673 CALL DIAGNOSTICS_FILL(fMer, 'VISCy_Vm',k,1,2,bi,bj,myThid)
674 IF (.NOT.implicitViscosity)
675 & CALL DIAGNOSTICS_FILL(fVrUp,'VISrE_Vm',k,1,2,bi,bj,myThid)
676 ENDIF
677 #endif
678
679 C-- No-slip and drag BCs appear as body forces in cell abutting topography
680 IF (no_slip_sides) THEN
681 C- No-slip BCs impose a drag at walls...
682 CALL MOM_V_SIDEDRAG(
683 I bi,bj,k,
684 I vFld, v4f, hFacZ,
685 I viscAh_Z,viscA4_Z,
686 I harmonic,biharmonic,useVariableViscosity,
687 O vF,
688 I myThid)
689 DO j=jMin,jMax
690 DO i=iMin,iMax
691 gvDiss(i,j) = gvDiss(i,j) + vF(i,j)
692 ENDDO
693 ENDDO
694 ENDIF
695 C- No-slip BCs impose a drag at bottom
696 IF (bottomDragTerms) THEN
697 CALL MOM_V_BOTTOMDRAG(bi,bj,k,vFld,KE,KappaRV,vF,myThid)
698 DO j=jMin,jMax
699 DO i=iMin,iMax
700 gvDiss(i,j) = gvDiss(i,j) + vF(i,j)
701 ENDDO
702 ENDDO
703 ENDIF
704
705 #ifdef ALLOW_SHELFICE
706 IF (useShelfIce) THEN
707 CALL SHELFICE_V_DRAG(bi,bj,k,vFld,KE,KappaRU,vF,myThid)
708 DO j=jMin,jMax
709 DO i=iMin,iMax
710 gvDiss(i,j) = gvDiss(i,j) + vF(i,j)
711 ENDDO
712 ENDDO
713 ENDIF
714 #endif /* ALLOW_SHELFICE */
715
716 C- endif momViscosity
717 ENDIF
718
719 C-- Forcing term (moved to timestep.F)
720 c IF (momForcing)
721 c & CALL EXTERNAL_FORCING_V(
722 c I iMin,iMax,jMin,jMax,bi,bj,k,
723 c I myTime,myThid)
724
725 C-- Metric terms for curvilinear grid systems
726 IF (useNHMTerms) THEN
727 C o Non-Hydrostatic (spherical) metric terms
728 CALL MOM_V_METRIC_NH(bi,bj,k,vFld,wVel,mT,myThid)
729 DO j=jMin,jMax
730 DO i=iMin,iMax
731 gV(i,j,k,bi,bj) = gV(i,j,k,bi,bj)+mtNHFacV*mT(i,j)
732 ENDDO
733 ENDDO
734 ENDIF
735 IF ( usingSphericalPolarGrid .AND. metricTerms ) THEN
736 C o Spherical polar grid metric terms
737 CALL MOM_V_METRIC_SPHERE(bi,bj,k,uFld,mT,myThid)
738 DO j=jMin,jMax
739 DO i=iMin,iMax
740 gV(i,j,k,bi,bj) = gV(i,j,k,bi,bj)+mtFacV*mT(i,j)
741 ENDDO
742 ENDDO
743 ENDIF
744 IF ( usingCylindricalGrid .AND. metricTerms ) THEN
745 C o Cylindrical grid metric terms
746 CALL MOM_V_METRIC_CYLINDER(bi,bj,k,uFld,vFld,mT,myThid)
747 DO j=jMin,jMax
748 DO i=iMin,iMax
749 gV(i,j,k,bi,bj) = gV(i,j,k,bi,bj)+mtFacV*mT(i,j)
750 ENDDO
751 ENDDO
752 ENDIF
753
754 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
755
756 C-- Coriolis term
757 C Note. As coded here, coriolis will not work with "thin walls"
758 c IF (useCDscheme) THEN
759 c CALL MOM_CDSCHEME(bi,bj,k,dPhiHydX,dPhiHydY,myThid)
760 c ELSE
761 IF (.NOT.useCDscheme) THEN
762 CALL MOM_U_CORIOLIS(bi,bj,k,vFld,cf,myThid)
763 DO j=jMin,jMax
764 DO i=iMin,iMax
765 gU(i,j,k,bi,bj) = gU(i,j,k,bi,bj)+fuFac*cf(i,j)
766 ENDDO
767 ENDDO
768 #ifdef ALLOW_DIAGNOSTICS
769 IF ( useDiagnostics )
770 & CALL DIAGNOSTICS_FILL(cf,'Um_Cori ',k,1,2,bi,bj,myThid)
771 #endif
772 CALL MOM_V_CORIOLIS(bi,bj,k,uFld,cf,myThid)
773 DO j=jMin,jMax
774 DO i=iMin,iMax
775 gV(i,j,k,bi,bj) = gV(i,j,k,bi,bj)+fvFac*cf(i,j)
776 ENDDO
777 ENDDO
778 #ifdef ALLOW_DIAGNOSTICS
779 IF ( useDiagnostics )
780 & CALL DIAGNOSTICS_FILL(cf,'Vm_Cori ',k,1,2,bi,bj,myThid)
781 #endif
782 ENDIF
783
784 C-- 3.D Coriolis term (horizontal momentum, Eastward component: -f'*w)
785 IF ( use3dCoriolis ) THEN
786 CALL MOM_U_CORIOLIS_NH(bi,bj,k,wVel,cf,myThid)
787 DO j=jMin,jMax
788 DO i=iMin,iMax
789 gU(i,j,k,bi,bj) = gU(i,j,k,bi,bj)+fuFac*cf(i,j)
790 ENDDO
791 ENDDO
792 IF ( usingCurvilinearGrid ) THEN
793 C- presently, non zero angleSinC array only supported with Curvilinear-Grid
794 CALL MOM_V_CORIOLIS_NH(bi,bj,k,wVel,cf,myThid)
795 DO j=jMin,jMax
796 DO i=iMin,iMax
797 gV(i,j,k,bi,bj) = gV(i,j,k,bi,bj)+fvFac*cf(i,j)
798 ENDDO
799 ENDDO
800 ENDIF
801 ENDIF
802
803 C-- Set du/dt & dv/dt on boundaries to zero
804 DO j=jMin,jMax
805 DO i=iMin,iMax
806 gU(i,j,k,bi,bj) = gU(i,j,k,bi,bj)*_maskW(i,j,k,bi,bj)
807 guDiss(i,j) = guDiss(i,j) *_maskW(i,j,k,bi,bj)
808 gV(i,j,k,bi,bj) = gV(i,j,k,bi,bj)*_maskS(i,j,k,bi,bj)
809 gvDiss(i,j) = gvDiss(i,j) *_maskS(i,j,k,bi,bj)
810 ENDDO
811 ENDDO
812
813 #ifdef ALLOW_DIAGNOSTICS
814 IF ( useDiagnostics ) THEN
815 CALL DIAGNOSTICS_FILL(KE, 'momKE ',k,1,2,bi,bj,myThid)
816 CALL DIAGNOSTICS_FILL(gU(1-Olx,1-Oly,k,bi,bj),
817 & 'Um_Advec',k,1,2,bi,bj,myThid)
818 CALL DIAGNOSTICS_FILL(gV(1-Olx,1-Oly,k,bi,bj),
819 & 'Vm_Advec',k,1,2,bi,bj,myThid)
820 IF (momViscosity) THEN
821 CALL DIAGNOSTICS_FILL(guDiss,'Um_Diss ',k,1,2,bi,bj,myThid)
822 CALL DIAGNOSTICS_FILL(gvDiss,'Vm_Diss ',k,1,2,bi,bj,myThid)
823 ENDIF
824 ENDIF
825 #endif /* ALLOW_DIAGNOSTICS */
826
827 RETURN
828 END

  ViewVC Help
Powered by ViewVC 1.1.22