/[MITgcm]/MITgcm/pkg/mom_vecinv/mom_vi_hdissip.F
ViewVC logotype

Contents of /MITgcm/pkg/mom_vecinv/mom_vi_hdissip.F

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


Revision 1.25 - (show annotations) (download)
Mon Apr 11 14:47:24 2005 UTC (19 years, 2 months ago) by dimitri
Branch: MAIN
CVS Tags: checkpoint57m_post, checkpoint57g_pre, checkpoint57g_post, checkpoint57r_post, checkpoint57i_post, checkpoint57n_post, checkpoint57l_post, checkpoint57h_pre, checkpoint57h_post, checkpoint57p_post, checkpoint57q_post, checkpoint57h_done, checkpoint57j_post, checkpoint57o_post, checkpoint57k_post
Changes since 1.24: +7 -18 lines
Added flag useAnisotropicViscAGridMax to turn on and off (off by default)
Alistair's latest length scale computation for horizontal viscosity.
It is used only for maximum viscosity calculations.  Alistair recommends
a value of viscA*GridMax=.25

1 C $Header: /u/gcmpack/MITgcm/pkg/mom_vecinv/mom_vi_hdissip.F,v 1.24 2005/04/03 15:58:51 heimbach Exp $
2 C $Name: $
3
4 #include "MOM_VECINV_OPTIONS.h"
5
6 SUBROUTINE MOM_VI_HDISSIP(
7 I bi,bj,k,
8 I hDiv,vort3,hFacZ,dStar,zStar,
9 O uDissip,vDissip,
10 I myThid)
11
12 cph(
13 cph The following line was commented in the argument list
14 cph TAMC cannot digest commented lines within continuing lines
15 c I viscAh_Z,viscAh_D,viscA4_Z,viscA4_D,
16 cph)
17
18 IMPLICIT NONE
19 C
20 C Calculate horizontal dissipation terms
21 C [del^2 - del^4] (u,v)
22 C
23
24 C == Global variables ==
25 #include "SIZE.h"
26 #include "GRID.h"
27 #include "EEPARAMS.h"
28 #include "PARAMS.h"
29
30 C == Routine arguments ==
31 INTEGER bi,bj,k
32 _RL hDiv(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
33 _RL vort3(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
34 _RS hFacZ(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
35 _RL dStar(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
36 _RL zStar(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
37 _RL uDissip(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
38 _RL vDissip(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
39 INTEGER myThid
40
41 C == Local variables ==
42 _RL viscAh_Z(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
43 _RL viscAh_D(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
44 _RL viscA4_Z(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
45 _RL viscA4_D(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
46 INTEGER I,J
47 _RL Zip,Zij,Zpj,Dim,Dij,Dmj,uD2,vD2,uD4,vD4
48 _RL Alin,AlinMin,AlinMax,Alth2,Alth4,grdVrt,grdDiv
49 _RL vg2,vg2Min,vg2Max,vg4,vg4Min,vg4Max
50 _RL recip_dt,L2,L3,L4,L5,L2rdt,L4rdt
51 LOGICAL useVariableViscosity
52
53 useVariableViscosity=
54 & (viscAhGrid.NE.0.)
55 & .OR.(viscA4Grid.NE.0.)
56 & .OR.(viscC2leith.NE.0.)
57 & .OR.(viscC2leithD.NE.0.)
58 & .OR.(viscC4leith.NE.0.)
59 & .OR.(viscC4leithD.NE.0.)
60
61 IF (deltaTmom.NE.0.) THEN
62 recip_dt=1./deltaTmom
63 ELSE
64 recip_dt=0.
65 ENDIF
66
67 vg2=viscAhGrid*recip_dt
68 vg2Min=viscAhGridMin*recip_dt
69 vg2Max=viscAhGridMax*recip_dt
70 vg4=viscA4Grid*recip_dt
71 vg4Min=viscA4GridMin*recip_dt
72 vg4Max=viscA4GridMax*recip_dt
73
74 C - Viscosity
75 IF (useVariableViscosity) THEN
76 DO j=2-Oly,sNy+Oly-1
77 DO i=2-Olx,sNx+Olx-1
78 C These are (powers of) length scales used in the Leith viscosity calculation
79 L2=rA(i,j,bi,bj)
80 L3=(L2**1.5)
81 L4=(L2**2)
82 L5=0.125*(L2**2.5)
83 IF (useAnisotropicViscAGridMax) THEN
84 L2rdt=recip_dt/( 2.*(recip_DXF(I,J,bi,bj)**2
85 & +recip_DYF(I,J,bi,bj)**2) )
86 L4rdt=recip_dt/( 6.*(recip_DXF(I,J,bi,bj)**4
87 & +recip_DYF(I,J,bi,bj)**4)
88 & +8.*((recip_DXF(I,J,bi,bj)
89 & *recip_DYF(I,J,bi,bj))**2) )
90 ENDIF
91
92 IF (useFullLeith) THEN
93 C This is the vector magnitude of the vorticity gradient squared
94 grdVrt=0.25*(
95 & ((vort3(i+1,j)-vort3(i,j))*recip_DXG(i,j,bi,bj))**2
96 & +((vort3(i,j+1)-vort3(i,j))*recip_DYG(i,j,bi,bj))**2
97 & +((vort3(i+1,j+1)-vort3(i,j+1))*recip_DXG(i,j+1,bi,bj))**2
98 & +((vort3(i+1,j+1)-vort3(i+1,j))*recip_DYG(i+1,j,bi,bj))**2)
99
100 C This is the vector magnitude of grad (div.v) squared
101 C Using it in Leith serves to damp instabilities in w.
102 grdDiv=0.25*(
103 & ((hDiv(i+1,j)-hDiv(i,j))*recip_DXG(i,j,bi,bj))**2
104 & +((hDiv(i,j+1)-hDiv(i,j))*recip_DYG(i,j,bi,bj))**2
105 & +((hDiv(i-1,j)-hDiv(i,j))*recip_DXG(i-1,j,bi,bj))**2
106 & +((hDiv(i,j-1)-hDiv(i,j))*recip_DYG(i,j-1,bi,bj))**2)
107
108 IF ( (viscC2leith**2*grdVrt+viscC2leithD**2*grdDiv)
109 & .NE. 0. ) THEN
110 Alth2=sqrt(viscC2leith**2*grdVrt+viscC2leithD**2*grdDiv)*L3
111 ELSE
112 Alth2=0. _d 0
113 ENDIF
114 IF ( (viscC4leith**2*grdVrt+viscC4leithD**2*grdDiv)
115 & .NE. 0. ) THEN
116 Alth4=sqrt(viscC4leith**2*grdVrt+viscC4leithD**2*grdDiv)*L5
117 ELSE
118 Alth4=0. _d 0
119 ENDIF
120 ELSE
121 C but this approximation will work on cube
122 c (and differs by as much as 4X)
123 grdVrt=abs((vort3(i+1,j)-vort3(i,j))*recip_DXG(i,j,bi,bj))
124 grdVrt=max(grdVrt,
125 & abs((vort3(i,j+1)-vort3(i,j))*recip_DYG(i,j,bi,bj)))
126 grdVrt=max(grdVrt,
127 & abs((vort3(i+1,j+1)-vort3(i,j+1))*recip_DXG(i,j+1,bi,bj)))
128 grdVrt=max(grdVrt,
129 & abs((vort3(i+1,j+1)-vort3(i+1,j))*recip_DYG(i+1,j,bi,bj)))
130
131 grdDiv=abs((hDiv(i+1,j)-hDiv(i,j))*recip_DXG(i,j,bi,bj))
132 grdDiv=max(grdDiv,
133 & abs((hDiv(i,j+1)-hDiv(i,j))*recip_DYG(i,j,bi,bj)))
134 grdDiv=max(grdDiv,
135 & abs((hDiv(i-1,j)-hDiv(i,j))*recip_DXG(i-1,j,bi,bj)))
136 grdDiv=max(grdDiv,
137 & abs((hDiv(i,j-1)-hDiv(i,j))*recip_DYG(i,j-1,bi,bj)))
138
139 c This approximation is good to the same order as above...
140 Alth2=(viscC2leith*grdVrt+(viscC2leithD*grdDiv))*L3
141 Alth4=(viscC4leith*grdVrt+(viscC4leithD*grdDiv))*L5
142 ENDIF
143
144 C Harmonic Modified Leith on Div.u points
145 Alin=viscAhD+vg2*L2+Alth2
146 viscAh_D(i,j)=min(viscAhMax,Alin)
147 IF (useAnisotropicViscAGridMax) THEN
148 AlinMax=viscAhGridMax*L2rdt
149 viscAh_D(i,j)=min(AlinMax,viscAh_D(i,j))
150 ELSE
151 IF (vg2Max.GT.0.) THEN
152 AlinMax=vg2Max*L2
153 viscAh_D(i,j)=min(AlinMax,viscAh_D(i,j))
154 ENDIF
155 ENDIF
156 AlinMin=vg2Min*L2
157 viscAh_D(i,j)=max(AlinMin,viscAh_D(i,j))
158
159 C BiHarmonic Modified Leith on Div.u points
160 Alin=viscA4D+vg4*L4+Alth4
161 viscA4_D(i,j)=min(viscA4Max,Alin)
162 IF (useAnisotropicViscAGridMax) THEN
163 AlinMax=viscA4GridMax*L4rdt
164 viscA4_D(i,j)=min(AlinMax,viscA4_D(i,j))
165 ELSE
166 IF (vg4Max.GT.0.) THEN
167 AlinMax=vg4Max*L4
168 viscA4_D(i,j)=min(AlinMax,viscA4_D(i,j))
169 ENDIF
170 ENDIF
171 AlinMin=vg4Min*L4
172 viscA4_D(i,j)=max(AlinMin,viscA4_D(i,j))
173
174 C These are (powers of) length scales used in the Leith viscosity calculation
175 L2=rAz(i,j,bi,bj)
176 L3=(L2**1.5)
177 L4=(L2**2)
178 L5=0.125*(L2**2.5)
179 IF (useAnisotropicViscAGridMax) THEN
180 L2rdt=recip_dt/( 2.*(recip_DXV(I,J,bi,bj)**2
181 & +recip_DYU(I,J,bi,bj)**2) )
182 L4rdt=recip_dt/( 6.*(recip_DXV(I,J,bi,bj)**4
183 & +recip_DYU(I,J,bi,bj)**4)
184 & +8.*((recip_DXV(I,J,bi,bj)
185 & *recip_DYU(I,J,bi,bj))**2) )
186 ENDIF
187
188 C This is the vector magnitude of the vorticity gradient squared
189 IF (useFullLeith) THEN
190 grdVrt=0.25*(
191 & ((vort3(i+1,j)-vort3(i,j))*recip_DXG(i,j,bi,bj))**2
192 & +((vort3(i,j+1)-vort3(i,j))*recip_DYG(i,j,bi,bj))**2
193 & +((vort3(i-1,j)-vort3(i,j))*recip_DXG(i-1,j,bi,bj))**2
194 & +((vort3(i,j-1)-vort3(i,j))*recip_DYG(i,j-1,bi,bj))**2)
195
196 C This is the vector magnitude of grad(div.v) squared
197 grdDiv=0.25*(
198 & ((hDiv(i+1,j)-hDiv(i,j))*recip_DXG(i,j,bi,bj))**2
199 & +((hDiv(i,j+1)-hDiv(i,j))*recip_DYG(i,j,bi,bj))**2
200 & +((hDiv(i+1,j+1)-hDiv(i,j+1))*recip_DXG(i,j+1,bi,bj))**2
201 & +((hDiv(i+1,j+1)-hDiv(i+1,j))*recip_DYG(i+1,j,bi,bj))**2)
202
203 IF ( (viscC2leith**2*grdVrt+viscC2leithD**2*grdDiv)
204 & .NE. 0. ) THEN
205 Alth2=sqrt(viscC2leith**2*grdVrt+viscC2leithD**2*grdDiv)*L3
206 ELSE
207 Alth2=0. _d 0
208 ENDIF
209 IF ( (viscC4leith**2*grdVrt+viscC4leithD**2*grdDiv)
210 & .NE. 0. ) THEN
211 Alth4=sqrt(viscC4leith**2*grdVrt+viscC4leithD**2*grdDiv)*L5
212 ELSE
213 Alth4=0. _d 0
214 ENDIF
215 ELSE
216 C but this approximation will work on cube (and differs by as much as 4X)
217 grdVrt=abs((vort3(i+1,j)-vort3(i,j))*recip_DXG(i,j,bi,bj))
218 grdVrt=max(grdVrt,
219 & abs((vort3(i,j+1)-vort3(i,j))*recip_DYG(i,j,bi,bj)))
220 grdVrt=max(grdVrt,
221 & abs((vort3(i-1,j)-vort3(i,j))*recip_DXG(i-1,j,bi,bj)))
222 grdVrt=max(grdVrt,
223 & abs((vort3(i,j-1)-vort3(i,j))*recip_DYG(i,j-1,bi,bj)))
224
225 grdDiv=abs((hDiv(i+1,j)-hDiv(i,j))*recip_DXG(i,j,bi,bj))
226 grdDiv=max(grdDiv,
227 & abs((hDiv(i,j+1)-hDiv(i,j))*recip_DYG(i,j,bi,bj)))
228 grdDiv=max(grdDiv,
229 & abs((hDiv(i+1,j+1)-hDiv(i,j+1))*recip_DXG(i-1,j,bi,bj)))
230 grdDiv=max(grdDiv,
231 & abs((hDiv(i+1,j+1)-hDiv(i+1,j))*recip_DYG(i,j-1,bi,bj)))
232
233 C This if statement is just to prevent bitwise changes when leithd=0
234 Alth2=(viscC2leith*grdVrt+(viscC2leithD*grdDiv))*L3
235 Alth4=(viscC4leith*grdVrt+(viscC4leithD*grdDiv))*L5
236 ENDIF
237
238 C Harmonic Modified Leith on Zeta points
239 Alin=viscAhZ+vg2*L2+Alth2
240 viscAh_Z(i,j)=min(viscAhMax,Alin)
241 IF (useAnisotropicViscAGridMax) THEN
242 AlinMax=viscAhGridMax*L2rdt
243 viscAh_Z(i,j)=min(AlinMax,viscAh_Z(i,j))
244 ELSE
245 IF (vg2Max.GT.0.) THEN
246 AlinMax=vg2Max*L2
247 viscAh_Z(i,j)=min(AlinMax,viscAh_Z(i,j))
248 ENDIF
249 ENDIF
250 AlinMin=vg2Min*L2
251 viscAh_Z(i,j)=max(AlinMin,viscAh_Z(i,j))
252
253 C BiHarmonic Modified Leith on Zeta Points
254 Alin=viscA4Z+vg4*L4+Alth4
255 viscA4_Z(i,j)=min(viscA4Max,Alin)
256 IF (useAnisotropicViscAGridMax) THEN
257 AlinMax=viscA4GridMax*L4rdt
258 viscA4_Z(i,j)=min(AlinMax,viscA4_Z(i,j))
259 ELSE
260 IF (vg4Max.GT.0.) THEN
261 AlinMax=vg4Max*L4
262 viscA4_Z(i,j)=min(AlinMax,viscA4_Z(i,j))
263 ENDIF
264 ENDIF
265 AlinMin=vg4Min*L4
266 viscA4_Z(i,j)=max(AlinMin,viscA4_Z(i,j))
267 ENDDO
268 ENDDO
269 ELSE
270 DO j=1-Oly,sNy+Oly
271 DO i=1-Olx,sNx+Olx
272 viscAh_D(i,j)=viscAhD
273 viscAh_Z(i,j)=viscAhZ
274 viscA4_D(i,j)=viscA4D
275 viscA4_Z(i,j)=viscA4Z
276 ENDDO
277 ENDDO
278 ENDIF
279
280 C - Laplacian terms
281 IF ( viscC2leith.NE.0. .OR. viscAhGrid.NE.0.
282 & .OR. viscAhD.NE.0. .OR. viscAhZ.NE.0. ) THEN
283 DO j=2-Oly,sNy+Oly-1
284 DO i=2-Olx,sNx+Olx-1
285
286 Dim=hDiv( i ,j-1)
287 Dij=hDiv( i , j )
288 Dmj=hDiv(i-1, j )
289 Zip=hFacZ( i ,j+1)*vort3( i ,j+1)
290 Zij=hFacZ( i , j )*vort3( i , j )
291 Zpj=hFacZ(i+1, j )*vort3(i+1, j )
292
293 C This bit scales the harmonic dissipation operator to be proportional
294 C to the grid-cell area over the time-step. viscAh is then non-dimensional
295 C and should be less than 1/8, for example viscAh=0.01
296 IF (useVariableViscosity) THEN
297 Dij=Dij*viscAh_D(i,j)
298 Dim=Dim*viscAh_D(i,j-1)
299 Dmj=Dmj*viscAh_D(i-1,j)
300 Zij=Zij*viscAh_Z(i,j)
301 Zip=Zip*viscAh_Z(i,j+1)
302 Zpj=Zpj*viscAh_Z(i+1,j)
303 uD2 = (
304 & cosFacU(j,bi,bj)*( Dij-Dmj )*recip_DXC(i,j,bi,bj)
305 & -recip_hFacW(i,j,k,bi,bj)*( Zip-Zij )*recip_DYG(i,j,bi,bj) )
306 vD2 = (
307 & recip_hFacS(i,j,k,bi,bj)*( Zpj-Zij )*recip_DXG(i,j,bi,bj)
308 & *cosFacV(j,bi,bj)
309 & +( Dij-Dim )*recip_DYC(i,j,bi,bj) )
310 ELSE
311 uD2 = viscAhD*
312 & cosFacU(j,bi,bj)*( Dij-Dmj )*recip_DXC(i,j,bi,bj)
313 & - viscAhZ*recip_hFacW(i,j,k,bi,bj)*
314 & ( Zip-Zij )*recip_DYG(i,j,bi,bj)
315 vD2 = viscAhZ*recip_hFacS(i,j,k,bi,bj)*
316 & cosFacV(j,bi,bj)*( Zpj-Zij )*recip_DXG(i,j,bi,bj)
317 & + viscAhD* ( Dij-Dim )*recip_DYC(i,j,bi,bj)
318 ENDIF
319
320 uDissip(i,j) = uD2
321 vDissip(i,j) = vD2
322
323 ENDDO
324 ENDDO
325 ELSE
326 DO j=2-Oly,sNy+Oly-1
327 DO i=2-Olx,sNx+Olx-1
328 uDissip(i,j) = 0.
329 vDissip(i,j) = 0.
330 ENDDO
331 ENDDO
332 ENDIF
333
334 C - Bi-harmonic terms
335 IF ( viscC4leith.NE.0. .OR. viscA4Grid.NE.0.
336 & .OR. viscA4D.NE.0. .OR. viscA4Z.NE.0. ) THEN
337 DO j=2-Oly,sNy+Oly-1
338 DO i=2-Olx,sNx+Olx-1
339
340 #ifdef MOM_VI_ORIGINAL_VISCA4
341 Dim=dyF( i ,j-1,bi,bj)*dStar( i ,j-1)
342 Dij=dyF( i , j ,bi,bj)*dStar( i , j )
343 Dmj=dyF(i-1, j ,bi,bj)*dStar(i-1, j )
344
345 Zip=dxV( i ,j+1,bi,bj)*hFacZ( i ,j+1)*zStar( i ,j+1)
346 Zij=dxV( i , j ,bi,bj)*hFacZ( i , j )*zStar( i , j )
347 Zpj=dxV(i+1, j ,bi,bj)*hFacZ(i+1, j )*zStar(i+1, j )
348 #else
349 Dim=dStar( i ,j-1)
350 Dij=dStar( i , j )
351 Dmj=dStar(i-1, j )
352
353 Zip=hFacZ( i ,j+1)*zStar( i ,j+1)
354 Zij=hFacZ( i , j )*zStar( i , j )
355 Zpj=hFacZ(i+1, j )*zStar(i+1, j )
356 #endif
357
358 C This bit scales the harmonic dissipation operator to be proportional
359 C to the grid-cell area over the time-step. viscAh is then non-dimensional
360 C and should be less than 1/8, for example viscAh=0.01
361 IF (useVariableViscosity) THEN
362 Dij=Dij*viscA4_D(i,j)
363 Dim=Dim*viscA4_D(i,j-1)
364 Dmj=Dmj*viscA4_D(i-1,j)
365 Zij=Zij*viscA4_Z(i,j)
366 Zip=Zip*viscA4_Z(i,j+1)
367 Zpj=Zpj*viscA4_Z(i+1,j)
368
369 #ifdef MOM_VI_ORIGINAL_VISCA4
370 uD4 = recip_rAw(i,j,bi,bj)*(
371 & ( (Dij-Dmj)*cosFacU(j,bi,bj) )
372 & -recip_hFacW(i,j,k,bi,bj)*( Zip-Zij ) )
373 vD4 = recip_rAs(i,j,bi,bj)*(
374 & recip_hFacS(i,j,k,bi,bj)*( (Zpj-Zij)*cosFacV(j,bi,bj) )
375 & + ( Dij-Dim ) )
376 ELSE
377 uD4 = recip_rAw(i,j,bi,bj)*(
378 & viscA4*( (Dij-Dmj)*cosFacU(j,bi,bj) )
379 & -recip_hFacW(i,j,k,bi,bj)*viscA4*( Zip-Zij ) )
380 vD4 = recip_rAs(i,j,bi,bj)*(
381 & recip_hFacS(i,j,k,bi,bj)*viscA4*( (Zpj-Zij)*cosFacV(j,bi,bj) )
382 & + viscA4*( Dij-Dim ) )
383 #else /* MOM_VI_ORIGINAL_VISCA4 */
384 uD4 = (
385 & cosFacU(j,bi,bj)*( Dij-Dmj )*recip_DXC(i,j,bi,bj)
386 & -recip_hFacW(i,j,k,bi,bj)*( Zip-Zij )*recip_DYG(i,j,bi,bj) )
387 vD4 = (
388 & recip_hFacS(i,j,k,bi,bj)*( Zpj-Zij )*recip_DXG(i,j,bi,bj)
389 & *cosFacV(j,bi,bj)
390 & +( Dij-Dim )*recip_DYC(i,j,bi,bj) )
391 ELSE
392 uD4 = viscA4D*
393 & cosFacU(j,bi,bj)*( Dij-Dmj )*recip_DXC(i,j,bi,bj)
394 & - viscA4Z*recip_hFacW(i,j,k,bi,bj)*
395 & ( Zip-Zij )*recip_DYG(i,j,bi,bj)
396 vD4 = viscA4Z*recip_hFacS(i,j,k,bi,bj)*
397 & cosFacV(j,bi,bj)*( Zpj-Zij )*recip_DXG(i,j,bi,bj)
398 & + viscA4D* ( Dij-Dim )*recip_DYC(i,j,bi,bj)
399 #endif /* MOM_VI_ORIGINAL_VISCA4 */
400 ENDIF
401
402 uDissip(i,j) = uDissip(i,j) - uD4
403 vDissip(i,j) = vDissip(i,j) - vD4
404
405 ENDDO
406 ENDDO
407 ENDIF
408
409 #ifdef ALLOW_DIAGNOSTICS
410 IF (useDiagnostics) THEN
411 CALL DIAGNOSTICS_FILL(viscAh_D,'VISCAH ',k,1,2,bi,bj,myThid)
412 CALL DIAGNOSTICS_FILL(viscA4_D,'VISCA4 ',k,1,2,bi,bj,myThid)
413 ENDIF
414 #endif
415
416 RETURN
417 END

  ViewVC Help
Powered by ViewVC 1.1.22