/[MITgcm]/MITgcm/model/src/dynamics.F
ViewVC logotype

Contents of /MITgcm/model/src/dynamics.F

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


Revision 1.33 - (show annotations) (download)
Sun Sep 6 17:35:20 1998 UTC (25 years, 8 months ago) by cnh
Branch: MAIN
Changes since 1.32: +7 -1 lines
Consistent isomorphism changes

1 C $Header: /u/gcmpack/models/MITgcmUV/model/src/dynamics.F,v 1.32 1998/08/23 15:34:40 cnh Exp $
2
3 #include "CPP_OPTIONS.h"
4
5 SUBROUTINE DYNAMICS(myTime, myIter, myThid)
6 C /==========================================================\
7 C | SUBROUTINE DYNAMICS |
8 C | o Controlling routine for the explicit part of the model |
9 C | dynamics. |
10 C |==========================================================|
11 C | This routine evaluates the "dynamics" terms for each |
12 C | block of ocean in turn. Because the blocks of ocean have |
13 C | overlap regions they are independent of one another. |
14 C | If terms involving lateral integrals are needed in this |
15 C | routine care will be needed. Similarly finite-difference |
16 C | operations with stencils wider than the overlap region |
17 C | require special consideration. |
18 C | Notes |
19 C | ===== |
20 C | C*P* comments indicating place holders for which code is |
21 C | presently being developed. |
22 C \==========================================================/
23
24 C == Global variables ===
25 #include "SIZE.h"
26 #include "EEPARAMS.h"
27 #include "CG2D.h"
28 #include "PARAMS.h"
29 #include "DYNVARS.h"
30
31 C == Routine arguments ==
32 C myTime - Current time in simulation
33 C myIter - Current iteration number in simulation
34 C myThid - Thread number for this instance of the routine.
35 INTEGER myThid
36 _RL myTime
37 INTEGER myIter
38
39 C == Local variables
40 C xA, yA - Per block temporaries holding face areas
41 C uTrans, vTrans, rTrans - Per block temporaries holding flow transport
42 C rVel o uTrans: Zonal transport
43 C o vTrans: Meridional transport
44 C o rTrans: Vertical transport
45 C o rVel: Vertical velocity at upper and lower
46 C cell faces.
47 C maskC,maskUp o maskC: land/water mask for tracer cells
48 C o maskUp: land/water mask for W points
49 C aTerm, xTerm, cTerm - Work arrays for holding separate terms in
50 C mTerm, pTerm, tendency equations.
51 C fZon, fMer, fVer[STUV] o aTerm: Advection term
52 C o xTerm: Mixing term
53 C o cTerm: Coriolis term
54 C o mTerm: Metric term
55 C o pTerm: Pressure term
56 C o fZon: Zonal flux term
57 C o fMer: Meridional flux term
58 C o fVer: Vertical flux term - note fVer
59 C is "pipelined" in the vertical
60 C so we need an fVer for each
61 C variable.
62 C rhoK, rhoKM1 - Density at current level, level above and level below.
63 C rhoKP1
64 C buoyK, buoyKM1 - Buoyancy at current level and level above.
65 C phiHyd - Hydrostatic part of the potential phiHydi.
66 C In z coords phiHydiHyd is the hydrostatic pressure anomaly
67 C In p coords phiHydiHyd is the geopotential surface height
68 C anomaly.
69 C etaSurfX, - Holds surface elevation gradient in X and Y.
70 C etaSurfY
71 C K13, K23, K33 - Non-zero elements of small-angle approximation
72 C diffusion tensor.
73 C KapGM - Spatially varying Visbeck et. al mixing coeff.
74 C KappaRT, - Total diffusion in vertical for T and S.
75 C KappaRS ( background + spatially varying, isopycnal term).
76 C iMin, iMax - Ranges and sub-block indices on which calculations
77 C jMin, jMax are applied.
78 C bi, bj
79 C k, kUp, - Index for layer above and below. kUp and kDown
80 C kDown, kM1 are switched with layer to be the appropriate index
81 C into fVerTerm
82 _RS xA (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
83 _RS yA (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
84 _RL uTrans (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
85 _RL vTrans (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
86 _RL rTrans (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
87 _RL rVel (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
88 _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
89 _RS maskUp (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
90 _RL aTerm (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
91 _RL xTerm (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
92 _RL cTerm (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
93 _RL mTerm (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
94 _RL pTerm (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
95 _RL fZon (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
96 _RL fMer (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
97 _RL fVerT (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
98 _RL fVerS (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
99 _RL fVerU (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
100 _RL fVerV (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
101 _RL phiHyd (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
102 _RL rhokm1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
103 _RL rhokp1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
104 _RL rhok (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
105 _RL buoyKM1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
106 _RL buoyK (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
107 _RL rhotmp (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
108 _RL etaSurfX(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
109 _RL etaSurfY(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
110 _RL K13 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
111 _RL K23 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
112 _RL K33 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
113 _RL KapGM (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
114 _RL KappaRT (1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
115 _RL KappaRS (1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
116
117 INTEGER iMin, iMax
118 INTEGER jMin, jMax
119 INTEGER bi, bj
120 INTEGER i, j
121 INTEGER k, kM1, kUp, kDown
122 LOGICAL BOTTOM_LAYER
123
124 C--- The algorithm...
125 C
126 C "Correction Step"
127 C =================
128 C Here we update the horizontal velocities with the surface
129 C pressure such that the resulting flow is either consistent
130 C with the free-surface evolution or the rigid-lid:
131 C U[n] = U* + dt x d/dx P
132 C V[n] = V* + dt x d/dy P
133 C
134 C "Calculation of Gs"
135 C ===================
136 C This is where all the accelerations and tendencies (ie.
137 C phiHydysics, parameterizations etc...) are calculated
138 C rVel = sum_r ( div. u[n] )
139 C rho = rho ( theta[n], salt[n] )
140 C b = b(rho, theta)
141 C K31 = K31 ( rho )
142 C Gu[n] = Gu( u[n], v[n], rVel, b, ... )
143 C Gv[n] = Gv( u[n], v[n], rVel, b, ... )
144 C Gt[n] = Gt( theta[n], u[n], v[n], rVel, K31, ... )
145 C Gs[n] = Gs( salt[n], u[n], v[n], rVel, K31, ... )
146 C
147 C "Time-stepping" or "Prediction"
148 C ================================
149 C The models variables are stepped forward with the appropriate
150 C time-stepping scheme (currently we use Adams-Bashforth II)
151 C - For momentum, the result is always *only* a "prediction"
152 C in that the flow may be divergent and will be "corrected"
153 C later with a surface pressure gradient.
154 C - Normally for tracers the result is the new field at time
155 C level [n+1} *BUT* in the case of implicit diffusion the result
156 C is also *only* a prediction.
157 C - We denote "predictors" with an asterisk (*).
158 C U* = U[n] + dt x ( 3/2 Gu[n] - 1/2 Gu[n-1] )
159 C V* = V[n] + dt x ( 3/2 Gv[n] - 1/2 Gv[n-1] )
160 C theta[n+1] = theta[n] + dt x ( 3/2 Gt[n] - 1/2 atG[n-1] )
161 C salt[n+1] = salt[n] + dt x ( 3/2 Gt[n] - 1/2 atG[n-1] )
162 C With implicit diffusion:
163 C theta* = theta[n] + dt x ( 3/2 Gt[n] - 1/2 atG[n-1] )
164 C salt* = salt[n] + dt x ( 3/2 Gt[n] - 1/2 atG[n-1] )
165 C (1 + dt * K * d_zz) theta[n] = theta*
166 C (1 + dt * K * d_zz) salt[n] = salt*
167 C---
168
169 C-- Set up work arrays with valid (i.e. not NaN) values
170 C These inital values do not alter the numerical results. They
171 C just ensure that all memory references are to valid floating
172 C point numbers. This prevents spurious hardware signals due to
173 C uninitialised but inert locations.
174 DO j=1-OLy,sNy+OLy
175 DO i=1-OLx,sNx+OLx
176 xA(i,j) = 0. _d 0
177 yA(i,j) = 0. _d 0
178 uTrans(i,j) = 0. _d 0
179 vTrans(i,j) = 0. _d 0
180 aTerm(i,j) = 0. _d 0
181 xTerm(i,j) = 0. _d 0
182 cTerm(i,j) = 0. _d 0
183 mTerm(i,j) = 0. _d 0
184 pTerm(i,j) = 0. _d 0
185 fZon(i,j) = 0. _d 0
186 fMer(i,j) = 0. _d 0
187 DO K=1,Nr
188 phiHyd (i,j,k) = 0. _d 0
189 K13(i,j,k) = 0. _d 0
190 K23(i,j,k) = 0. _d 0
191 K33(i,j,k) = 0. _d 0
192 KappaRT(i,j,k) = 0. _d 0
193 KappaRS(i,j,k) = 0. _d 0
194 ENDDO
195 rhoKM1 (i,j) = 0. _d 0
196 rhok (i,j) = 0. _d 0
197 rhoKP1 (i,j) = 0. _d 0
198 rhoTMP (i,j) = 0. _d 0
199 buoyKM1(i,j) = 0. _d 0
200 buoyK (i,j) = 0. _d 0
201 maskC (i,j) = 0. _d 0
202 ENDDO
203 ENDDO
204
205 DO bj=myByLo(myThid),myByHi(myThid)
206 DO bi=myBxLo(myThid),myBxHi(myThid)
207
208 C-- Set up work arrays that need valid initial values
209 DO j=1-OLy,sNy+OLy
210 DO i=1-OLx,sNx+OLx
211 rTrans(i,j) = 0. _d 0
212 rVel (i,j,1) = 0. _d 0
213 rVel (i,j,2) = 0. _d 0
214 fVerT (i,j,1) = 0. _d 0
215 fVerT (i,j,2) = 0. _d 0
216 fVerS (i,j,1) = 0. _d 0
217 fVerS (i,j,2) = 0. _d 0
218 fVerU (i,j,1) = 0. _d 0
219 fVerU (i,j,2) = 0. _d 0
220 fVerV (i,j,1) = 0. _d 0
221 fVerV (i,j,2) = 0. _d 0
222 phiHyd(i,j,1) = 0. _d 0
223 K13 (i,j,1) = 0. _d 0
224 K23 (i,j,1) = 0. _d 0
225 K33 (i,j,1) = 0. _d 0
226 KapGM (i,j) = GMkbackground
227 ENDDO
228 ENDDO
229
230 iMin = 1-OLx+1
231 iMax = sNx+OLx
232 jMin = 1-OLy+1
233 jMax = sNy+OLy
234
235 K = 1
236 BOTTOM_LAYER = K .EQ. Nr
237
238 C-- Calculate gradient of surface pressure
239 CALL CALC_GRAD_ETA_SURF(
240 I bi,bj,iMin,iMax,jMin,jMax,
241 O etaSurfX,etaSurfY,
242 I myThid)
243 C-- Update fields in top level according to tendency terms
244 CALL CORRECTION_STEP(
245 I bi,bj,iMin,iMax,jMin,jMax,K,
246 I etaSurfX,etaSurfY,myTime,myThid)
247 IF ( .NOT. BOTTOM_LAYER ) THEN
248 C-- Update fields in layer below according to tendency terms
249 CALL CORRECTION_STEP(
250 I bi,bj,iMin,iMax,jMin,jMax,K+1,
251 I etaSurfX,etaSurfY,myTime,myThid)
252 ENDIF
253 C-- Density of 1st level (below W(1)) reference to level 1
254 CALL FIND_RHO(
255 I bi, bj, iMin, iMax, jMin, jMax, K, K, eosType,
256 O rhoKm1,
257 I myThid )
258
259 IF ( .NOT. BOTTOM_LAYER ) THEN
260 C-- Check static stability with layer below
261 C-- and mix as needed.
262 CALL FIND_RHO(
263 I bi, bj, iMin, iMax, jMin, jMax, K+1, K, eosType,
264 O rhoKp1,
265 I myThid )
266 CALL CONVECT(
267 I bi,bj,iMin,iMax,jMin,jMax,K+1,rhoKm1,rhoKp1,
268 I myTime,myIter,myThid)
269 C-- Recompute density after mixing
270 CALL FIND_RHO(
271 I bi, bj, iMin, iMax, jMin, jMax, K, K, eosType,
272 O rhoKm1,
273 I myThid )
274 ENDIF
275 C-- Calculate buoyancy
276 CALL CALC_BUOYANCY(
277 I bi,bj,iMin,iMax,jMin,jMax,K,rhoKm1,
278 O buoyKm1,
279 I myThid )
280 C-- Integrate hydrostatic balance for phiHyd with BC of phiHyd(z=0)=0
281 CALL CALC_PHI_HYD(
282 I bi,bj,iMin,iMax,jMin,jMax,K,buoyKm1,buoyKm1,
283 U phiHyd,
284 I myThid )
285
286 DO K=2,Nr
287 BOTTOM_LAYER = K .EQ. Nr
288 IF ( .NOT. BOTTOM_LAYER ) THEN
289 C-- Update fields in layer below according to tendency terms
290 CALL CORRECTION_STEP(
291 I bi,bj,iMin,iMax,jMin,jMax,K+1,
292 I etaSurfX,etaSurfY,myTime,myThid)
293 ENDIF
294 C-- Density of K level (below W(K)) reference to K level
295 CALL FIND_RHO(
296 I bi, bj, iMin, iMax, jMin, jMax, K, K, eosType,
297 O rhoK,
298 I myThid )
299 IF ( .NOT. BOTTOM_LAYER ) THEN
300 C-- Check static stability with layer below and mix as needed.
301 C-- Density of K+1 level (below W(K+1)) reference to K level.
302 CALL FIND_RHO(
303 I bi, bj, iMin, iMax, jMin, jMax, K+1, K, eosType,
304 O rhoKp1,
305 I myThid )
306 CALL CONVECT(
307 I bi,bj,iMin,iMax,jMin,jMax,K+1,rhoK,rhoKp1,
308 I myTime,myIter,myThid)
309 C-- Recompute density after mixing
310 CALL FIND_RHO(
311 I bi, bj, iMin, iMax, jMin, jMax, K, K, eosType,
312 O rhoK,
313 I myThid )
314 ENDIF
315 C-- Calculate buoyancy
316 CALL CALC_BUOYANCY(
317 I bi,bj,iMin,iMax,jMin,jMax,K,rhoK,
318 O buoyK,
319 I myThid )
320 C-- Integrate hydrostatic balance for phiHyd with BC of phiHyd(z=0)=0
321 CALL CALC_PHI_HYD(
322 I bi,bj,iMin,iMax,jMin,jMax,K,buoyKm1,buoyK,
323 U phiHyd,
324 I myThid )
325 C-- Calculate iso-neutral slopes for the GM/Redi parameterisation
326 CALL FIND_RHO(
327 I bi, bj, iMin, iMax, jMin, jMax, K-1, K, eosType,
328 O rhoTmp,
329 I myThid )
330 CALL CALC_ISOSLOPES(
331 I bi, bj, iMin, iMax, jMin, jMax, K,
332 I rhoKm1, rhoK, rhotmp,
333 O K13, K23, K33, KapGM,
334 I myThid )
335 DO J=jMin,jMax
336 DO I=iMin,iMax
337 rhoKm1 (I,J) = rhoK(I,J)
338 buoyKm1(I,J) = buoyK(I,J)
339 ENDDO
340 ENDDO
341 ENDDO ! K
342
343 DO K = Nr, 1, -1
344
345 kM1 =max(1,k-1) ! Points to level above k (=k-1)
346 kUp =1+MOD(k+1,2) ! Cycles through 1,2 to point to layer above
347 kDown=1+MOD(k,2) ! Cycles through 2,1 to point to current layer
348 iMin = 1-OLx+2
349 iMax = sNx+OLx-1
350 jMin = 1-OLy+2
351 jMax = sNy+OLy-1
352
353 C-- Get temporary terms used by tendency routines
354 CALL CALC_COMMON_FACTORS (
355 I bi,bj,iMin,iMax,jMin,jMax,k,kM1,kUp,kDown,
356 O xA,yA,uTrans,vTrans,rTrans,rVel,maskC,maskUp,
357 I myThid)
358 CcnhDebugStarts
359 IF ( K .EQ. 1 ) THEN
360 CALL PLOT_FIELD_XYRL( rVel(1,1,1), 'K=1 Current rVel.1 ' , myIter, myThid )
361 CALL PLOT_FIELD_XYRL( rVel(1,1,2), 'K=1 Current rVel.2 ' , myIter, myThid )
362 ENDIF
363 CcnhDebugEnds
364 C-- Calculate the total vertical diffusivity
365 CALL CALC_DIFFUSIVITY(
366 I bi,bj,iMin,iMax,jMin,jMax,K,
367 I maskC,maskUp,KapGM,K33,
368 O KappaRT,KappaRS,
369 I myThid)
370 C-- Calculate accelerations in the momentum equations
371 IF ( momStepping ) THEN
372 CALL CALC_MOM_RHS(
373 I bi,bj,iMin,iMax,jMin,jMax,k,kM1,kUp,kDown,
374 I xA,yA,uTrans,vTrans,rTrans,rVel,maskC,
375 I phiHyd,
376 U aTerm,xTerm,cTerm,mTerm,pTerm,
377 U fZon, fMer, fVerU, fVerV,
378 I myThid)
379 ENDIF
380 C-- Calculate active tracer tendencies
381 IF ( tempStepping ) THEN
382 CALL CALC_GT(
383 I bi,bj,iMin,iMax,jMin,jMax, k,kM1,kUp,kDown,
384 I xA,yA,uTrans,vTrans,rTrans,maskUp,maskC,
385 I K13,K23,KappaRT,KapGM,
386 U aTerm,xTerm,fZon,fMer,fVerT,
387 I myThid)
388 ENDIF
389 IF ( saltStepping ) THEN
390 CALL CALC_GS(
391 I bi,bj,iMin,iMax,jMin,jMax, k,kM1,kUp,kDown,
392 I xA,yA,uTrans,vTrans,rTrans,maskUp,maskC,
393 I K13,K23,KappaRS,KapGM,
394 U aTerm,xTerm,fZon,fMer,fVerS,
395 I myThid)
396 ENDIF
397 C-- Prediction step (step forward all model variables)
398 CALL TIMESTEP(
399 I bi,bj,iMin,iMax,jMin,jMax,K,
400 I myThid)
401 C-- Diagnose barotropic divergence of predicted fields
402 CALL CALC_DIV_GHAT(
403 I bi,bj,iMin,iMax,jMin,jMax,K,
404 I xA,yA,
405 I myThid)
406
407 C-- Cumulative diagnostic calculations (ie. time-averaging)
408 #ifdef ALLOW_DIAGNOSTICS
409 IF (taveFreq.GT.0.) THEN
410 CALL DO_TIME_AVERAGES(
411 I myTime, myIter, bi, bj, K, kUp, kDown,
412 I K13, K23, rVel, KapGM,
413 I myThid )
414 ENDIF
415 #endif
416
417 ENDDO ! K
418
419 C-- Implicit diffusion
420 IF (implicitDiffusion) THEN
421 CALL IMPLDIFF( bi, bj, iMin, iMax, jMin, jMax,
422 I KappaRT,KappaRS,
423 I myThid )
424 ENDIF
425
426 ENDDO
427 ENDDO
428
429 C write(0,*) 'dynamics: pS ',minval(cg2d_x(1:sNx,1:sNy,:,:)),
430 C & maxval(cg2d_x(1:sNx,1:sNy,:,:))
431 C write(0,*) 'dynamics: U ',minval(uVel(1:sNx,1:sNy,1,:,:),mask=uVel(1:sNx,1:sNy,1,:,:).NE.0.),
432 C & maxval(uVel(1:sNx,1:sNy,1,:,:),mask=uVel(1:sNx,1:sNy,1,:,:).NE.0.)
433 C write(0,*) 'dynamics: V ',minval(vVel(1:sNx,1:sNy,1,:,:),mask=vVel(1:sNx,1:sNy,1,:,:).NE.0.),
434 C & maxval(vVel(1:sNx,1:sNy,1,:,:),mask=vVel(1:sNx,1:sNy,1,:,:).NE.0.)
435 C write(0,*) 'dynamics: rVel(1) ',
436 C & minval(rVel(1:sNx,1:sNy,1),mask=rVel(1:sNx,1:sNy,1).NE.0.),
437 C & maxval(rVel(1:sNx,1:sNy,1),mask=rVel(1:sNx,1:sNy,1).NE.0.)
438 C write(0,*) 'dynamics: rVel(2) ',
439 C & minval(rVel(1:sNx,1:sNy,2),mask=rVel(1:sNx,1:sNy,2).NE.0.),
440 C & maxval(rVel(1:sNx,1:sNy,2),mask=rVel(1:sNx,1:sNy,2).NE.0.)
441 cblk write(0,*) 'dynamics: K13',minval(K13(1:sNx,1:sNy,:)),
442 cblk & maxval(K13(1:sNx,1:sNy,:))
443 cblk write(0,*) 'dynamics: K23',minval(K23(1:sNx,1:sNy,:)),
444 cblk & maxval(K23(1:sNx,1:sNy,:))
445 cblk write(0,*) 'dynamics: K33',minval(K33(1:sNx,1:sNy,:)),
446 cblk & maxval(K33(1:sNx,1:sNy,:))
447 C write(0,*) 'dynamics: gT ',minval(gT(1:sNx,1:sNy,:,:,:)),
448 C & maxval(gT(1:sNx,1:sNy,:,:,:))
449 C write(0,*) 'dynamics: T ',minval(Theta(1:sNx,1:sNy,:,:,:)),
450 C & maxval(Theta(1:sNx,1:sNy,:,:,:))
451 C write(0,*) 'dynamics: gS ',minval(gS(1:sNx,1:sNy,:,:,:)),
452 C & maxval(gS(1:sNx,1:sNy,:,:,:))
453 C write(0,*) 'dynamics: S ',minval(salt(1:sNx,1:sNy,:,:,:)),
454 C & maxval(salt(1:sNx,1:sNy,:,:,:))
455 C write(0,*) 'dynamics: phiHyd ',minval(phiHyd/(Gravity*Rhonil),mask=phiHyd.NE.0.),
456 C & maxval(phiHyd/(Gravity*Rhonil))
457
458 RETURN
459 END

  ViewVC Help
Powered by ViewVC 1.1.22