/[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.24 - (show annotations) (download)
Sun Apr 3 15:58:51 2005 UTC (19 years, 1 month ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint57f_post, checkpoint57f_pre
Changes since 1.23: +25 -5 lines
Minor modifications to make Leith scheme adjointable
(initial tests at 1/4 deg. indicate it works).

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

  ViewVC Help
Powered by ViewVC 1.1.22