/[MITgcm]/MITgcm/verification/global_ocean_pressure/code/dynamics.F
ViewVC logotype

Contents of /MITgcm/verification/global_ocean_pressure/code/dynamics.F

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


Revision 1.2 - (show annotations) (download)
Sat Feb 8 02:26:34 2003 UTC (21 years, 2 months ago) by jmc
Branch: MAIN
CVS Tags: HEAD
Changes since 1.1: +1 -1 lines
FILE REMOVED
o find difficult to maintain the local version of dynamics.F up to date.
  therefore, has been remove from the code directory.
  One can recover the same version (but up to date) simply
  by activating the commented lines [between lines Cml( and Cml) ],
  at the end of the standard version of dynamics.F
o finite volume form of calc_phi_hyd.F is now a standard option.
  only needs to set integr_GeoPot=1 in file "data" to select this form.

1 C $Header: /u/gcmpack/MITgcm/verification/global_ocean_pressure/code/dynamics.F,v 1.1 2002/12/16 21:41:52 mlosch Exp $
2 C $Name: $
3
4 #include "CPP_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: DYNAMICS
8 C !INTERFACE:
9 SUBROUTINE DYNAMICS(myTime, myIter, myThid)
10 C !DESCRIPTION: \bv
11 C *==========================================================*
12 C | SUBROUTINE DYNAMICS
13 C | o Controlling routine for the explicit part of the model
14 C | dynamics.
15 C *==========================================================*
16 C | This routine evaluates the "dynamics" terms for each
17 C | block of ocean in turn. Because the blocks of ocean have
18 C | overlap regions they are independent of one another.
19 C | If terms involving lateral integrals are needed in this
20 C | routine care will be needed. Similarly finite-difference
21 C | operations with stencils wider than the overlap region
22 C | require special consideration.
23 C | The algorithm...
24 C |
25 C | "Correction Step"
26 C | =================
27 C | Here we update the horizontal velocities with the surface
28 C | pressure such that the resulting flow is either consistent
29 C | with the free-surface evolution or the rigid-lid:
30 C | U[n] = U* + dt x d/dx P
31 C | V[n] = V* + dt x d/dy P
32 C |
33 C | "Calculation of Gs"
34 C | ===================
35 C | This is where all the accelerations and tendencies (ie.
36 C | physics, parameterizations etc...) are calculated
37 C | rho = rho ( theta[n], salt[n] )
38 C | b = b(rho, theta)
39 C | K31 = K31 ( rho )
40 C | Gu[n] = Gu( u[n], v[n], wVel, b, ... )
41 C | Gv[n] = Gv( u[n], v[n], wVel, b, ... )
42 C | Gt[n] = Gt( theta[n], u[n], v[n], wVel, K31, ... )
43 C | Gs[n] = Gs( salt[n], u[n], v[n], wVel, K31, ... )
44 C |
45 C | "Time-stepping" or "Prediction"
46 C | ================================
47 C | The models variables are stepped forward with the appropriate
48 C | time-stepping scheme (currently we use Adams-Bashforth II)
49 C | - For momentum, the result is always *only* a "prediction"
50 C | in that the flow may be divergent and will be "corrected"
51 C | later with a surface pressure gradient.
52 C | - Normally for tracers the result is the new field at time
53 C | level [n+1} *BUT* in the case of implicit diffusion the result
54 C | is also *only* a prediction.
55 C | - We denote "predictors" with an asterisk (*).
56 C | U* = U[n] + dt x ( 3/2 Gu[n] - 1/2 Gu[n-1] )
57 C | V* = V[n] + dt x ( 3/2 Gv[n] - 1/2 Gv[n-1] )
58 C | theta[n+1] = theta[n] + dt x ( 3/2 Gt[n] - 1/2 atG[n-1] )
59 C | salt[n+1] = salt[n] + dt x ( 3/2 Gt[n] - 1/2 atG[n-1] )
60 C | With implicit diffusion:
61 C | theta* = theta[n] + dt x ( 3/2 Gt[n] - 1/2 atG[n-1] )
62 C | salt* = salt[n] + dt x ( 3/2 Gt[n] - 1/2 atG[n-1] )
63 C | (1 + dt * K * d_zz) theta[n] = theta*
64 C | (1 + dt * K * d_zz) salt[n] = salt*
65 C |
66 C *==========================================================*
67 C \ev
68 C !USES:
69 IMPLICIT NONE
70 C == Global variables ===
71 #include "SIZE.h"
72 #include "EEPARAMS.h"
73 #include "PARAMS.h"
74 #include "DYNVARS.h"
75 #include "GRID.h"
76 #ifdef ALLOW_PASSIVE_TRACER
77 #include "TR1.h"
78 #endif
79 #ifdef ALLOW_AUTODIFF_TAMC
80 # include "tamc.h"
81 # include "tamc_keys.h"
82 # include "FFIELDS.h"
83 # ifdef ALLOW_KPP
84 # include "KPP.h"
85 # endif
86 #endif /* ALLOW_AUTODIFF_TAMC */
87 #ifdef ALLOW_TIMEAVE
88 #include "TIMEAVE_STATV.h"
89 #endif
90
91 C !CALLING SEQUENCE:
92 C DYNAMICS()
93 C |
94 C |-- CALC_GRAD_PHI_SURF
95 C |
96 C |-- CALC_VISCOSITY
97 C |
98 C |-- CALC_PHI_HYD
99 C |
100 C |-- STORE_PRESSURE
101 C |
102 C |-- MOM_FLUXFORM
103 C |
104 C |-- MOM_VECINV
105 C |
106 C |-- TIMESTEP
107 C |
108 C |-- OBCS_APPLY_UV
109 C |
110 C |-- IMPLDIFF
111 C |
112 C |-- OBCS_APPLY_UV
113 C |
114 C |-- CALL TIMEAVE_CUMUL_1T
115 C |-- CALL DEBUG_STATS_RL
116
117 C !INPUT/OUTPUT PARAMETERS:
118 C == Routine arguments ==
119 C myTime - Current time in simulation
120 C myIter - Current iteration number in simulation
121 C myThid - Thread number for this instance of the routine.
122 _RL myTime
123 INTEGER myIter
124 INTEGER myThid
125
126 C !LOCAL VARIABLES:
127 C == Local variables
128 C fVer[STUV] o fVer: Vertical flux term - note fVer
129 C is "pipelined" in the vertical
130 C so we need an fVer for each
131 C variable.
132 C rhoK, rhoKM1 - Density at current level, and level above
133 C phiHyd - Hydrostatic part of the potential phiHydi.
134 C In z coords phiHydiHyd is the hydrostatic
135 C Potential (=pressure/rho0) anomaly
136 C In p coords phiHydiHyd is the geopotential
137 C surface height anomaly.
138 C phiSurfX, - gradient of Surface potentiel (Pressure/rho, ocean)
139 C phiSurfY or geopotentiel (atmos) in X and Y direction
140 C iMin, iMax - Ranges and sub-block indices on which calculations
141 C jMin, jMax are applied.
142 C bi, bj
143 C k, kup, - Index for layer above and below. kup and kDown
144 C kDown, km1 are switched with layer to be the appropriate
145 C index into fVerTerm.
146 _RL fVerU (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
147 _RL fVerV (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
148 _RL phiHyd (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
149 _RL rhokm1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
150 _RL rhok (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
151 _RL phiSurfX(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
152 _RL phiSurfY(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
153 _RL KappaRU (1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
154 _RL KappaRV (1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
155
156 INTEGER iMin, iMax
157 INTEGER jMin, jMax
158 INTEGER bi, bj
159 INTEGER i, j
160 INTEGER k, km1, kp1, kup, kDown
161
162 Cjmc : add for phiHyd output <- but not working if multi tile per CPU
163 c CHARACTER*(MAX_LEN_MBUF) suff
164 c LOGICAL DIFFERENT_MULTIPLE
165 c EXTERNAL DIFFERENT_MULTIPLE
166 Cjmc(end)
167
168 C--- The algorithm...
169 C
170 C "Correction Step"
171 C =================
172 C Here we update the horizontal velocities with the surface
173 C pressure such that the resulting flow is either consistent
174 C with the free-surface evolution or the rigid-lid:
175 C U[n] = U* + dt x d/dx P
176 C V[n] = V* + dt x d/dy P
177 C
178 C "Calculation of Gs"
179 C ===================
180 C This is where all the accelerations and tendencies (ie.
181 C physics, parameterizations etc...) are calculated
182 C rho = rho ( theta[n], salt[n] )
183 C b = b(rho, theta)
184 C K31 = K31 ( rho )
185 C Gu[n] = Gu( u[n], v[n], wVel, b, ... )
186 C Gv[n] = Gv( u[n], v[n], wVel, b, ... )
187 C Gt[n] = Gt( theta[n], u[n], v[n], wVel, K31, ... )
188 C Gs[n] = Gs( salt[n], u[n], v[n], wVel, K31, ... )
189 C
190 C "Time-stepping" or "Prediction"
191 C ================================
192 C The models variables are stepped forward with the appropriate
193 C time-stepping scheme (currently we use Adams-Bashforth II)
194 C - For momentum, the result is always *only* a "prediction"
195 C in that the flow may be divergent and will be "corrected"
196 C later with a surface pressure gradient.
197 C - Normally for tracers the result is the new field at time
198 C level [n+1} *BUT* in the case of implicit diffusion the result
199 C is also *only* a prediction.
200 C - We denote "predictors" with an asterisk (*).
201 C U* = U[n] + dt x ( 3/2 Gu[n] - 1/2 Gu[n-1] )
202 C V* = V[n] + dt x ( 3/2 Gv[n] - 1/2 Gv[n-1] )
203 C theta[n+1] = theta[n] + dt x ( 3/2 Gt[n] - 1/2 atG[n-1] )
204 C salt[n+1] = salt[n] + dt x ( 3/2 Gt[n] - 1/2 atG[n-1] )
205 C With implicit diffusion:
206 C theta* = theta[n] + dt x ( 3/2 Gt[n] - 1/2 atG[n-1] )
207 C salt* = salt[n] + dt x ( 3/2 Gt[n] - 1/2 atG[n-1] )
208 C (1 + dt * K * d_zz) theta[n] = theta*
209 C (1 + dt * K * d_zz) salt[n] = salt*
210 C---
211 CEOP
212
213 C-- Set up work arrays with valid (i.e. not NaN) values
214 C These inital values do not alter the numerical results. They
215 C just ensure that all memory references are to valid floating
216 C point numbers. This prevents spurious hardware signals due to
217 C uninitialised but inert locations.
218 DO j=1-OLy,sNy+OLy
219 DO i=1-OLx,sNx+OLx
220 rhoKM1 (i,j) = 0. _d 0
221 rhok (i,j) = 0. _d 0
222 phiSurfX(i,j) = 0. _d 0
223 phiSurfY(i,j) = 0. _d 0
224 ENDDO
225 ENDDO
226
227 C-- Call to routine for calculation of
228 C Eliassen-Palm-flux-forced U-tendency,
229 C if desired:
230 #ifdef INCLUDE_EP_FORCING_CODE
231 CALL CALC_EP_FORCING(myThid)
232 #endif
233
234 #ifdef ALLOW_AUTODIFF_TAMC
235 C-- HPF directive to help TAMC
236 CHPF$ INDEPENDENT
237 #endif /* ALLOW_AUTODIFF_TAMC */
238
239 DO bj=myByLo(myThid),myByHi(myThid)
240
241 #ifdef ALLOW_AUTODIFF_TAMC
242 C-- HPF directive to help TAMC
243 CHPF$ INDEPENDENT, NEW (fVerU,fVerV
244 CHPF$& ,phiHyd
245 CHPF$& ,KappaRU,KappaRV
246 CHPF$& )
247 #endif /* ALLOW_AUTODIFF_TAMC */
248
249 DO bi=myBxLo(myThid),myBxHi(myThid)
250
251 #ifdef ALLOW_AUTODIFF_TAMC
252 act1 = bi - myBxLo(myThid)
253 max1 = myBxHi(myThid) - myBxLo(myThid) + 1
254 act2 = bj - myByLo(myThid)
255 max2 = myByHi(myThid) - myByLo(myThid) + 1
256 act3 = myThid - 1
257 max3 = nTx*nTy
258 act4 = ikey_dynamics - 1
259 ikey = (act1 + 1) + act2*max1
260 & + act3*max1*max2
261 & + act4*max1*max2*max3
262 #endif /* ALLOW_AUTODIFF_TAMC */
263
264 C-- Set up work arrays that need valid initial values
265 DO j=1-OLy,sNy+OLy
266 DO i=1-OLx,sNx+OLx
267 DO k=1,Nr
268 phiHyd(i,j,k) = 0. _d 0
269 KappaRU(i,j,k) = 0. _d 0
270 KappaRV(i,j,k) = 0. _d 0
271 ENDDO
272 fVerU (i,j,1) = 0. _d 0
273 fVerU (i,j,2) = 0. _d 0
274 fVerV (i,j,1) = 0. _d 0
275 fVerV (i,j,2) = 0. _d 0
276 ENDDO
277 ENDDO
278
279 C-- Start computation of dynamics
280 iMin = 1-OLx+2
281 iMax = sNx+OLx-1
282 jMin = 1-OLy+2
283 jMax = sNy+OLy-1
284
285 #ifdef ALLOW_AUTODIFF_TAMC
286 CADJ STORE wvel (:,:,:,bi,bj) = comlev1_bibj, key = ikey, byte = isbyte
287 #endif /* ALLOW_AUTODIFF_TAMC */
288
289 C-- Explicit part of the Surface Potentiel Gradient (add in TIMESTEP)
290 C (note: this loop will be replaced by CALL CALC_GRAD_ETA)
291 IF (implicSurfPress.NE.1.) THEN
292 CALL CALC_GRAD_PHI_SURF(
293 I bi,bj,iMin,iMax,jMin,jMax,
294 I etaN,
295 O phiSurfX,phiSurfY,
296 I myThid )
297 ENDIF
298
299 #ifdef ALLOW_AUTODIFF_TAMC
300 CADJ STORE uvel (:,:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte
301 CADJ STORE vvel (:,:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte
302 #ifdef ALLOW_KPP
303 CADJ STORE KPPviscAz (:,:,:,bi,bj)
304 CADJ & = comlev1_bibj, key=ikey, byte=isbyte
305 #endif /* ALLOW_KPP */
306 #endif /* ALLOW_AUTODIFF_TAMC */
307
308 #ifdef INCLUDE_CALC_DIFFUSIVITY_CALL
309 C-- Calculate the total vertical diffusivity
310 DO k=1,Nr
311 CALL CALC_VISCOSITY(
312 I bi,bj,iMin,iMax,jMin,jMax,k,
313 O KappaRU,KappaRV,
314 I myThid)
315 ENDDO
316 #endif
317
318 C-- Start of dynamics loop
319 DO k=1,Nr
320
321 C-- km1 Points to level above k (=k-1)
322 C-- kup Cycles through 1,2 to point to layer above
323 C-- kDown Cycles through 2,1 to point to current layer
324
325 km1 = MAX(1,k-1)
326 kp1 = MIN(k+1,Nr)
327 kup = 1+MOD(k+1,2)
328 kDown= 1+MOD(k,2)
329
330 #ifdef ALLOW_AUTODIFF_TAMC
331 kkey = (ikey-1)*Nr + k
332 #endif /* ALLOW_AUTODIFF_TAMC */
333
334 C-- Integrate hydrostatic balance for phiHyd with BC of
335 C phiHyd(z=0)=0
336 C distinguishe between Stagger and Non Stagger time stepping
337 IF (staggerTimeStep) THEN
338 CALL CALC_PHI_HYD(
339 I bi,bj,iMin,iMax,jMin,jMax,k,
340 I gT, gS,
341 U phiHyd,
342 I myThid )
343 ELSE
344 CALL CALC_PHI_HYD(
345 I bi,bj,iMin,iMax,jMin,jMax,k,
346 I theta, salt,
347 U phiHyd,
348 I myThid )
349 ENDIF
350
351 C calculate pressure from phiHyd and store it on common block
352 C variable pressure
353 CALL STORE_PRESSURE( bi, bj, k, phiHyd, myThid )
354
355
356 C-- Calculate accelerations in the momentum equations (gU, gV, ...)
357 C and step forward storing the result in gUnm1, gVnm1, etc...
358 IF ( momStepping ) THEN
359 #ifndef DISABLE_MOM_FLUXFORM
360 IF (.NOT. vectorInvariantMomentum) CALL MOM_FLUXFORM(
361 I bi,bj,iMin,iMax,jMin,jMax,k,kup,kDown,
362 I phiHyd,KappaRU,KappaRV,
363 U fVerU, fVerV,
364 I myTime, myIter, myThid)
365 #endif
366 #ifndef DISABLE_MOM_VECINV
367 IF (vectorInvariantMomentum) CALL MOM_VECINV(
368 I bi,bj,iMin,iMax,jMin,jMax,k,kup,kDown,
369 I phiHyd,KappaRU,KappaRV,
370 U fVerU, fVerV,
371 I myTime, myIter, myThid)
372 #endif
373 CALL TIMESTEP(
374 I bi,bj,iMin,iMax,jMin,jMax,k,
375 I phiHyd, phiSurfX, phiSurfY,
376 I myIter, myThid)
377
378 #ifdef ALLOW_OBCS
379 C-- Apply open boundary conditions
380 IF (useOBCS) THEN
381 CALL OBCS_APPLY_UV( bi, bj, k, gUnm1, gVnm1, myThid )
382 END IF
383 #endif /* ALLOW_OBCS */
384
385 #ifdef ALLOW_AUTODIFF_TAMC
386 #ifdef INCLUDE_CD_CODE
387 ELSE
388 DO j=1-OLy,sNy+OLy
389 DO i=1-OLx,sNx+OLx
390 guCD(i,j,k,bi,bj) = 0.0
391 gvCD(i,j,k,bi,bj) = 0.0
392 END DO
393 END DO
394 #endif /* INCLUDE_CD_CODE */
395 #endif /* ALLOW_AUTODIFF_TAMC */
396 ENDIF
397
398
399 C-- end of dynamics k loop (1:Nr)
400 ENDDO
401
402 C-- Implicit viscosity
403 IF (implicitViscosity.AND.momStepping) THEN
404 #ifdef ALLOW_AUTODIFF_TAMC
405 CADJ STORE gUNm1(:,:,:,bi,bj) = comlev1_bibj , key=ikey, byte=isbyte
406 #endif /* ALLOW_AUTODIFF_TAMC */
407 CALL IMPLDIFF(
408 I bi, bj, iMin, iMax, jMin, jMax,
409 I deltaTmom, KappaRU,recip_HFacW,
410 U gUNm1,
411 I myThid )
412 #ifdef ALLOW_AUTODIFF_TAMC
413 CADJ STORE gVNm1(:,:,:,bi,bj) = comlev1_bibj , key=ikey, byte=isbyte
414 #endif /* ALLOW_AUTODIFF_TAMC */
415 CALL IMPLDIFF(
416 I bi, bj, iMin, iMax, jMin, jMax,
417 I deltaTmom, KappaRV,recip_HFacS,
418 U gVNm1,
419 I myThid )
420
421 #ifdef ALLOW_OBCS
422 C-- Apply open boundary conditions
423 IF (useOBCS) THEN
424 DO K=1,Nr
425 CALL OBCS_APPLY_UV( bi, bj, k, gUnm1, gVnm1, myThid )
426 ENDDO
427 END IF
428 #endif /* ALLOW_OBCS */
429
430 #ifdef INCLUDE_CD_CODE
431 #ifdef ALLOW_AUTODIFF_TAMC
432 CADJ STORE vVelD(:,:,:,bi,bj) = comlev1_bibj , key=ikey, byte=isbyte
433 #endif /* ALLOW_AUTODIFF_TAMC */
434 CALL IMPLDIFF(
435 I bi, bj, iMin, iMax, jMin, jMax,
436 I deltaTmom, KappaRU,recip_HFacW,
437 U vVelD,
438 I myThid )
439 #ifdef ALLOW_AUTODIFF_TAMC
440 CADJ STORE uVelD(:,:,:,bi,bj) = comlev1_bibj , key=ikey, byte=isbyte
441 #endif /* ALLOW_AUTODIFF_TAMC */
442 CALL IMPLDIFF(
443 I bi, bj, iMin, iMax, jMin, jMax,
444 I deltaTmom, KappaRV,recip_HFacS,
445 U uVelD,
446 I myThid )
447 #endif /* INCLUDE_CD_CODE */
448 C-- End If implicitViscosity.AND.momStepping
449 ENDIF
450
451 Cjmc : add for phiHyd output <- but not working if multi tile per CPU
452 c IF ( DIFFERENT_MULTIPLE(dumpFreq,myTime+deltaTClock,myTime)
453 c & .AND. buoyancyRelation .ne. 'OCEANIC' ) THEN
454 c WRITE(suff,'(I10.10)') myIter+1
455 c CALL WRITE_FLD_XYZ_RL('PH.',suff,phiHyd,myIter+1,myThid)
456 c ENDIF
457 Cjmc(end)
458
459 #ifdef ALLOW_TIMEAVE
460 IF (taveFreq.GT.0.) THEN
461 CALL TIMEAVE_CUMUL_1T(phiHydtave, phiHyd, Nr,
462 I deltaTclock, bi, bj, myThid)
463 ENDIF
464 #endif /* ALLOW_TIMEAVE */
465
466 ENDDO
467 ENDDO
468
469 Cml(
470 C In order to compare the variance of phiHydLow of a p/z-coordinate
471 C run with etaH of a z/p-coordinate run the drift of phiHydLow
472 C has to be removed by something like the following subroutine:
473 CALL REMOVE_MEAN_RL( 1, phiHydLow, maskH, maskH, rA, drF,
474 & 'phiHydLow', myThid )
475 Cml)
476
477 #ifndef DISABLE_DEBUGMODE
478 If (debugMode) THEN
479 CALL DEBUG_STATS_RL(1,EtaN,'EtaN (DYNAMICS)',myThid)
480 CALL DEBUG_STATS_RL(Nr,uVel,'Uvel (DYNAMICS)',myThid)
481 CALL DEBUG_STATS_RL(Nr,vVel,'Vvel (DYNAMICS)',myThid)
482 CALL DEBUG_STATS_RL(Nr,wVel,'Wvel (DYNAMICS)',myThid)
483 CALL DEBUG_STATS_RL(Nr,theta,'Theta (DYNAMICS)',myThid)
484 CALL DEBUG_STATS_RL(Nr,salt,'Salt (DYNAMICS)',myThid)
485 CALL DEBUG_STATS_RL(Nr,Gu,'Gu (DYNAMICS)',myThid)
486 CALL DEBUG_STATS_RL(Nr,Gv,'Gv (DYNAMICS)',myThid)
487 CALL DEBUG_STATS_RL(Nr,Gt,'Gt (DYNAMICS)',myThid)
488 CALL DEBUG_STATS_RL(Nr,Gs,'Gs (DYNAMICS)',myThid)
489 CALL DEBUG_STATS_RL(Nr,GuNm1,'GuNm1 (DYNAMICS)',myThid)
490 CALL DEBUG_STATS_RL(Nr,GvNm1,'GvNm1 (DYNAMICS)',myThid)
491 CALL DEBUG_STATS_RL(Nr,GtNm1,'GtNm1 (DYNAMICS)',myThid)
492 CALL DEBUG_STATS_RL(Nr,GsNm1,'GsNm1 (DYNAMICS)',myThid)
493 ENDIF
494 #endif
495
496 RETURN
497 END

  ViewVC Help
Powered by ViewVC 1.1.22