58 |
C lower cell faces. |
C lower cell faces. |
59 |
C maskC,maskUp o maskC: land/water mask for tracer cells |
C maskC,maskUp o maskC: land/water mask for tracer cells |
60 |
C o maskUp: land/water mask for W points |
C o maskUp: land/water mask for W points |
61 |
C aTerm, xTerm, cTerm - Work arrays for holding separate terms in |
C fVer[STUV] o fVer: Vertical flux term - note fVer |
|
C mTerm, pTerm, tendency equations. |
|
|
C fZon, fMer, fVer[STUV] o aTerm: Advection term |
|
|
C o xTerm: Mixing term |
|
|
C o cTerm: Coriolis term |
|
|
C o mTerm: Metric term |
|
|
C o pTerm: Pressure term |
|
|
C o fZon: Zonal flux term |
|
|
C o fMer: Meridional flux term |
|
|
C o fVer: Vertical flux term - note fVer |
|
62 |
C is "pipelined" in the vertical |
C is "pipelined" in the vertical |
63 |
C so we need an fVer for each |
C so we need an fVer for each |
64 |
C variable. |
C variable. |
90 |
_RL rVel (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2) |
_RL rVel (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2) |
91 |
_RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
_RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
92 |
_RS maskUp (1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
_RS maskUp (1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
|
_RL aTerm (1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
|
|
_RL xTerm (1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
|
|
_RL cTerm (1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
|
|
_RL mTerm (1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
|
|
_RL pTerm (1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
|
|
_RL fZon (1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
|
|
_RL fMer (1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
|
93 |
_RL fVerT (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2) |
_RL fVerT (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2) |
94 |
_RL fVerS (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2) |
_RL fVerS (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2) |
95 |
_RL fVerU (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2) |
_RL fVerU (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2) |
191 |
yA(i,j) = 0. _d 0 |
yA(i,j) = 0. _d 0 |
192 |
uTrans(i,j) = 0. _d 0 |
uTrans(i,j) = 0. _d 0 |
193 |
vTrans(i,j) = 0. _d 0 |
vTrans(i,j) = 0. _d 0 |
|
aTerm(i,j) = 0. _d 0 |
|
|
xTerm(i,j) = 0. _d 0 |
|
|
cTerm(i,j) = 0. _d 0 |
|
|
mTerm(i,j) = 0. _d 0 |
|
|
pTerm(i,j) = 0. _d 0 |
|
|
fZon(i,j) = 0. _d 0 |
|
|
fMer(i,j) = 0. _d 0 |
|
194 |
DO k=1,Nr |
DO k=1,Nr |
195 |
phiHyd (i,j,k) = 0. _d 0 |
phiHyd (i,j,k) = 0. _d 0 |
196 |
KappaRU(i,j,k) = 0. _d 0 |
KappaRU(i,j,k) = 0. _d 0 |
289 |
kkey = (ikey-1)*(Nr-2+1) + (k-2) + 1 |
kkey = (ikey-1)*(Nr-2+1) + (k-2) + 1 |
290 |
#endif /* ALLOW_AUTODIFF_TAMC */ |
#endif /* ALLOW_AUTODIFF_TAMC */ |
291 |
|
|
|
#ifdef ALLOW_OBCS |
|
|
C-- Calculate future values on open boundaries |
|
|
IF (openBoundaries) THEN |
|
|
Caja CALL CYCLE_OBCS( k, bi, bj, myThid ) |
|
|
c new args! CALL SET_OBCS( k, bi, bj, myTime, myThid ) |
|
|
c +deltaT? |
|
|
ENDIF |
|
|
#endif |
|
|
|
|
292 |
C-- Integrate continuity vertically for vertical velocity |
C-- Integrate continuity vertically for vertical velocity |
293 |
CALL INTEGRATE_FOR_W( |
CALL INTEGRATE_FOR_W( |
294 |
I bi, bj, k, uVel, vVel, |
I bi, bj, k, uVel, vVel, |
295 |
O wVel, |
O wVel, |
296 |
I myThid ) |
I myThid ) |
297 |
#ifdef ALLOW_OBCS |
|
298 |
|
#ifdef ALLOW_OBCS |
299 |
|
C-- Calculate future values on open boundaries |
300 |
IF (openBoundaries) THEN |
IF (openBoundaries) THEN |
301 |
c new subr CALL OBCS_APPLY_W( bi, bj, k, wVel, myThid ) |
#ifdef ALLOW_NONHYDROSTATIC |
302 |
|
IF (nonHydrostatic) THEN |
303 |
|
CALL OBCS_APPLY_W( bi, bj, k, wVel, myThid ) |
304 |
|
ENDIF |
305 |
|
#endif /* ALLOW_NONHYDROSTATIC */ |
306 |
|
CALL OBCS_CALC( bi, bj, k, myTime+deltaT, myThid ) |
307 |
ENDIF |
ENDIF |
308 |
#endif |
#endif /* ALLOW_OBCS */ |
309 |
|
|
310 |
C-- Calculate gradients of potential density for isoneutral |
C-- Calculate gradients of potential density for isoneutral |
311 |
C slope terms (e.g. GM/Redi tensor or IVDC diffusivity) |
C slope terms (e.g. GM/Redi tensor or IVDC diffusivity) |
338 |
C-- end of diagnostic k loop (Nr:1) |
C-- end of diagnostic k loop (Nr:1) |
339 |
ENDDO |
ENDDO |
340 |
|
|
341 |
|
C-- Determines forcing terms based on external fields |
342 |
|
C relaxation terms, etc. |
343 |
|
CALL EXTERNAL_FORCING_SURF( |
344 |
|
I bi, bj, iMin, iMax, jMin, jMax, |
345 |
|
I myThid ) |
346 |
|
|
347 |
#ifdef ALLOW_GMREDI |
#ifdef ALLOW_GMREDI |
348 |
C-- Calculate iso-neutral slopes for the GM/Redi parameterisation |
C-- Calculate iso-neutral slopes for the GM/Redi parameterisation |
349 |
IF (useGMRedi) THEN |
IF (useGMRedi) THEN |
364 |
ENDIF |
ENDIF |
365 |
#endif /* ALLOW_KPP */ |
#endif /* ALLOW_KPP */ |
366 |
|
|
|
C-- Determines forcing terms based on external fields |
|
|
C relaxation terms, etc. |
|
|
CALL EXTERNAL_FORCING_SURF( |
|
|
I bi, bj, iMin, iMax, jMin, jMax, |
|
|
I myThid ) |
|
|
|
|
367 |
#ifdef ALLOW_AUTODIFF_TAMC |
#ifdef ALLOW_AUTODIFF_TAMC |
368 |
CADJ STORE KappaRT(:,:,:) = comlev1_bibj, key = ikey, byte = isbyte |
CADJ STORE KappaRT(:,:,:) = comlev1_bibj, key = ikey, byte = isbyte |
369 |
CADJ STORE KappaRS(:,:,:) = comlev1_bibj, key = ikey, byte = isbyte |
CADJ STORE KappaRS(:,:,:) = comlev1_bibj, key = ikey, byte = isbyte |
374 |
#endif /* ALLOW_AUTODIFF_TAMC */ |
#endif /* ALLOW_AUTODIFF_TAMC */ |
375 |
|
|
376 |
|
|
377 |
|
|
378 |
C-- Start of thermodynamics loop |
C-- Start of thermodynamics loop |
379 |
DO k=Nr,1,-1 |
DO k=Nr,1,-1 |
380 |
|
|
422 |
I bi,bj,iMin,iMax,jMin,jMax, k,km1,kup,kDown, |
I bi,bj,iMin,iMax,jMin,jMax, k,km1,kup,kDown, |
423 |
I xA,yA,uTrans,vTrans,rTrans,maskUp,maskC, |
I xA,yA,uTrans,vTrans,rTrans,maskUp,maskC, |
424 |
I KappaRT, |
I KappaRT, |
425 |
U aTerm,xTerm,fZon,fMer,fVerT, |
U fVerT, |
426 |
I myTime, myThid) |
I myTime, myThid) |
427 |
CALL TIMESTEP_TRACER( |
CALL TIMESTEP_TRACER( |
428 |
I bi,bj,iMin,iMax,jMin,jMax,k, |
I bi,bj,iMin,iMax,jMin,jMax,k, |
435 |
I bi,bj,iMin,iMax,jMin,jMax, k,km1,kup,kDown, |
I bi,bj,iMin,iMax,jMin,jMax, k,km1,kup,kDown, |
436 |
I xA,yA,uTrans,vTrans,rTrans,maskUp,maskC, |
I xA,yA,uTrans,vTrans,rTrans,maskUp,maskC, |
437 |
I KappaRS, |
I KappaRS, |
438 |
U aTerm,xTerm,fZon,fMer,fVerS, |
U fVerS, |
439 |
I myTime, myThid) |
I myTime, myThid) |
440 |
CALL TIMESTEP_TRACER( |
CALL TIMESTEP_TRACER( |
441 |
I bi,bj,iMin,iMax,jMin,jMax,k, |
I bi,bj,iMin,iMax,jMin,jMax,k, |
443 |
U gSnm1, |
U gSnm1, |
444 |
I myIter, myThid) |
I myIter, myThid) |
445 |
ENDIF |
ENDIF |
446 |
#ifdef ALLOW_OBCS |
|
447 |
|
#ifdef ALLOW_OBCS |
448 |
C-- Apply open boundary conditions |
C-- Apply open boundary conditions |
449 |
IF (openBoundaries) THEN |
IF (openBoundaries) THEN |
450 |
#ifdef ALLOW_AUTODIFF_TAMC |
CALL OBCS_APPLY_TS( bi, bj, k, gTnm1, gSnm1, myThid ) |
|
CADJ STORE gwnm1(:,:,k,bi,bj) = comlev1_bibj_k |
|
|
CADJ & , key = kkey, byte = isbyte |
|
|
#endif /* ALLOW_AUTODIFF_TAMC */ |
|
|
c new subr CALL OBCS_APPLY_TS( bi, bj, k, myThid ) |
|
451 |
END IF |
END IF |
452 |
#endif |
#endif /* ALLOW_OBCS */ |
453 |
|
|
454 |
C-- Freeze water |
C-- Freeze water |
455 |
IF (allowFreezing) THEN |
IF (allowFreezing) THEN |
456 |
#ifdef ALLOW_AUTODIFF_TAMC |
#ifdef ALLOW_AUTODIFF_TAMC |
495 |
I myThid ) |
I myThid ) |
496 |
ENDIF |
ENDIF |
497 |
|
|
498 |
|
#ifdef ALLOW_OBCS |
499 |
|
C-- Apply open boundary conditions |
500 |
|
IF (openBoundaries) THEN |
501 |
|
DO K=1,Nr |
502 |
|
CALL OBCS_APPLY_TS( bi, bj, k, gTnm1, gSnm1, myThid ) |
503 |
|
ENDDO |
504 |
|
END IF |
505 |
|
#endif /* ALLOW_OBCS */ |
506 |
|
|
507 |
C-- End If implicitDiffusion |
C-- End If implicitDiffusion |
508 |
ENDIF |
ENDIF |
509 |
|
|
510 |
|
|
511 |
|
|
512 |
C-- Start of dynamics loop |
C-- Start of dynamics loop |
513 |
DO k=1,Nr |
DO k=1,Nr |
514 |
|
|
550 |
U phiHyd, |
U phiHyd, |
551 |
I myThid ) |
I myThid ) |
552 |
|
|
|
C-- Get temporary terms used by tendency routines |
|
|
CALL CALC_COMMON_FACTORS ( |
|
|
I bi,bj,iMin,iMax,jMin,jMax,k,km1,kup,kDown, |
|
|
O xA,yA,uTrans,vTrans,rTrans,rVel,maskC,maskUp, |
|
|
I myThid) |
|
|
|
|
553 |
C-- Calculate accelerations in the momentum equations (gU, gV, ...) |
C-- Calculate accelerations in the momentum equations (gU, gV, ...) |
554 |
C and step forward storing the result in gUnm1, gVnm1, etc... |
C and step forward storing the result in gUnm1, gVnm1, etc... |
555 |
IF ( momStepping ) THEN |
IF ( momStepping ) THEN |
556 |
CALL CALC_MOM_RHS( |
CALL CALC_MOM_RHS( |
557 |
I bi,bj,iMin,iMax,jMin,jMax,k,km1,kup,kDown, |
I bi,bj,iMin,iMax,jMin,jMax,k,kup,kDown, |
|
I xA,yA,uTrans,vTrans,rTrans,rVel,maskC, |
|
558 |
I phiHyd,KappaRU,KappaRV, |
I phiHyd,KappaRU,KappaRV, |
559 |
U fVerU, fVerV, |
U fVerU, fVerV, |
560 |
I myTime, myThid) |
I myTime, myThid) |
561 |
CALL TIMESTEP( |
CALL TIMESTEP( |
562 |
I bi,bj,iMin,iMax,jMin,jMax,k, |
I bi,bj,iMin,iMax,jMin,jMax,k, |
563 |
I myIter, myThid) |
I myIter, myThid) |
564 |
|
|
565 |
|
#ifdef ALLOW_OBCS |
566 |
|
C-- Apply open boundary conditions |
567 |
|
IF (openBoundaries) THEN |
568 |
|
CALL OBCS_APPLY_UV( bi, bj, k, gUnm1, gVnm1, myThid ) |
569 |
|
END IF |
570 |
|
#endif /* ALLOW_OBCS */ |
571 |
|
|
572 |
#ifdef ALLOW_AUTODIFF_TAMC |
#ifdef ALLOW_AUTODIFF_TAMC |
573 |
#ifdef INCLUDE_CD_CODE |
#ifdef INCLUDE_CD_CODE |
574 |
ELSE |
ELSE |
607 |
U gVNm1, |
U gVNm1, |
608 |
I myThid ) |
I myThid ) |
609 |
|
|
610 |
|
#ifdef ALLOW_OBCS |
611 |
|
C-- Apply open boundary conditions |
612 |
|
IF (openBoundaries) THEN |
613 |
|
DO K=1,Nr |
614 |
|
CALL OBCS_APPLY_UV( bi, bj, k, gUnm1, gVnm1, myThid ) |
615 |
|
ENDDO |
616 |
|
END IF |
617 |
|
#endif /* ALLOW_OBCS */ |
618 |
|
|
619 |
#ifdef INCLUDE_CD_CODE |
#ifdef INCLUDE_CD_CODE |
620 |
#ifdef ALLOW_AUTODIFF_TAMC |
#ifdef ALLOW_AUTODIFF_TAMC |
621 |
idkey = iikey + 5 |
idkey = iikey + 5 |