140 |
INTEGER nipass,ipass |
INTEGER nipass,ipass |
141 |
INTEGER myTile, nCFace |
INTEGER myTile, nCFace |
142 |
LOGICAL N_edge, S_edge, E_edge, W_edge |
LOGICAL N_edge, S_edge, E_edge, W_edge |
143 |
|
#ifdef ALLOW_DIAGNOSTICS |
144 |
|
INTEGER kk |
145 |
|
CHARACTER*8 diagName |
146 |
|
CHARACTER*4 GAD_DIAG_SUFX, diagSufx |
147 |
|
EXTERNAL GAD_DIAG_SUFX |
148 |
|
#endif |
149 |
CEOP |
CEOP |
150 |
|
|
151 |
#ifdef ALLOW_AUTODIFF_TAMC |
#ifdef ALLOW_AUTODIFF_TAMC |
169 |
endif |
endif |
170 |
#endif /* ALLOW_AUTODIFF_TAMC */ |
#endif /* ALLOW_AUTODIFF_TAMC */ |
171 |
|
|
172 |
|
#ifdef ALLOW_DIAGNOSTICS |
173 |
|
C-- Set diagnostic suffix for the current tracer |
174 |
|
IF ( useDiagnostics ) THEN |
175 |
|
diagSufx = GAD_DIAG_SUFX( tracerIdentity, myThid ) |
176 |
|
ENDIF |
177 |
|
#endif |
178 |
|
|
179 |
C-- Set up work arrays with valid (i.e. not NaN) values |
C-- Set up work arrays with valid (i.e. not NaN) values |
180 |
C These inital values do not alter the numerical results. They |
C These inital values do not alter the numerical results. They |
181 |
C just ensure that all memory references are to valid floating |
C just ensure that all memory references are to valid floating |
345 |
#endif /* ALLOW_AUTODIFF_TAMC */ |
#endif /* ALLOW_AUTODIFF_TAMC */ |
346 |
|
|
347 |
IF (advectionScheme.EQ.ENUM_FLUX_LIMIT) THEN |
IF (advectionScheme.EQ.ENUM_FLUX_LIMIT) THEN |
348 |
CALL GAD_FLUXLIMIT_ADV_X( bi,bj,k, deltaTtracer, |
CALL GAD_FLUXLIMIT_ADV_X( bi,bj,k, dTtracerLev(k), |
349 |
I uTrans, uVel, maskLocW, localTij, |
I uTrans, uVel, maskLocW, localTij, |
350 |
O af, myThid ) |
O af, myThid ) |
351 |
ELSEIF (advectionScheme.EQ.ENUM_DST3 ) THEN |
ELSEIF (advectionScheme.EQ.ENUM_DST3 ) THEN |
352 |
CALL GAD_DST3_ADV_X( bi,bj,k, deltaTtracer, |
CALL GAD_DST3_ADV_X( bi,bj,k, dTtracerLev(k), |
353 |
I uTrans, uVel, maskLocW, localTij, |
I uTrans, uVel, maskLocW, localTij, |
354 |
O af, myThid ) |
O af, myThid ) |
355 |
ELSEIF (advectionScheme.EQ.ENUM_DST3_FLUX_LIMIT ) THEN |
ELSEIF (advectionScheme.EQ.ENUM_DST3_FLUX_LIMIT ) THEN |
356 |
CALL GAD_DST3FL_ADV_X( bi,bj,k, deltaTtracer, |
CALL GAD_DST3FL_ADV_X( bi,bj,k, dTtracerLev(k), |
357 |
I uTrans, uVel, maskLocW, localTij, |
I uTrans, uVel, maskLocW, localTij, |
358 |
O af, myThid ) |
O af, myThid ) |
359 |
ELSE |
ELSE |
384 |
IF ( S_edge ) THEN |
IF ( S_edge ) THEN |
385 |
DO j=1-Oly,0 |
DO j=1-Oly,0 |
386 |
DO i=iMinUpd,iMaxUpd |
DO i=iMinUpd,iMaxUpd |
387 |
localTij(i,j)=localTij(i,j)-deltaTtracer* |
localTij(i,j)=localTij(i,j)-dTtracerLev(k)* |
388 |
& _recip_hFacC(i,j,k,bi,bj)*recip_drF(k) |
& _recip_hFacC(i,j,k,bi,bj)*recip_drF(k) |
389 |
& *recip_rA(i,j,bi,bj) |
& *recip_rA(i,j,bi,bj) |
390 |
& *( af(i+1,j)-af(i,j) |
& *( af(i+1,j)-af(i,j) |
396 |
IF ( N_edge ) THEN |
IF ( N_edge ) THEN |
397 |
DO j=sNy+1,sNy+Oly |
DO j=sNy+1,sNy+Oly |
398 |
DO i=iMinUpd,iMaxUpd |
DO i=iMinUpd,iMaxUpd |
399 |
localTij(i,j)=localTij(i,j)-deltaTtracer* |
localTij(i,j)=localTij(i,j)-dTtracerLev(k)* |
400 |
& _recip_hFacC(i,j,k,bi,bj)*recip_drF(k) |
& _recip_hFacC(i,j,k,bi,bj)*recip_drF(k) |
401 |
& *recip_rA(i,j,bi,bj) |
& *recip_rA(i,j,bi,bj) |
402 |
& *( af(i+1,j)-af(i,j) |
& *( af(i+1,j)-af(i,j) |
414 |
IF ( interiorOnly .AND. N_edge ) jMaxUpd = sNy |
IF ( interiorOnly .AND. N_edge ) jMaxUpd = sNy |
415 |
DO j=jMinUpd,jMaxUpd |
DO j=jMinUpd,jMaxUpd |
416 |
DO i=1-Olx+1,sNx+Olx-1 |
DO i=1-Olx+1,sNx+Olx-1 |
417 |
localTij(i,j)=localTij(i,j)-deltaTtracer* |
localTij(i,j)=localTij(i,j)-dTtracerLev(k)* |
418 |
& _recip_hFacC(i,j,k,bi,bj)*recip_drF(k) |
& _recip_hFacC(i,j,k,bi,bj)*recip_drF(k) |
419 |
& *recip_rA(i,j,bi,bj) |
& *recip_rA(i,j,bi,bj) |
420 |
& *( af(i+1,j)-af(i,j) |
& *( af(i+1,j)-af(i,j) |
482 |
#endif /* ALLOW_AUTODIFF_TAMC */ |
#endif /* ALLOW_AUTODIFF_TAMC */ |
483 |
|
|
484 |
IF (advectionScheme.EQ.ENUM_FLUX_LIMIT) THEN |
IF (advectionScheme.EQ.ENUM_FLUX_LIMIT) THEN |
485 |
CALL GAD_FLUXLIMIT_ADV_Y( bi,bj,k, deltaTtracer, |
CALL GAD_FLUXLIMIT_ADV_Y( bi,bj,k, dTtracerLev(k), |
486 |
I vTrans, vVel, maskLocS, localTij, |
I vTrans, vVel, maskLocS, localTij, |
487 |
O af, myThid ) |
O af, myThid ) |
488 |
ELSEIF (advectionScheme.EQ.ENUM_DST3 ) THEN |
ELSEIF (advectionScheme.EQ.ENUM_DST3 ) THEN |
489 |
CALL GAD_DST3_ADV_Y( bi,bj,k, deltaTtracer, |
CALL GAD_DST3_ADV_Y( bi,bj,k, dTtracerLev(k), |
490 |
I vTrans, vVel, maskLocS, localTij, |
I vTrans, vVel, maskLocS, localTij, |
491 |
O af, myThid ) |
O af, myThid ) |
492 |
ELSEIF (advectionScheme.EQ.ENUM_DST3_FLUX_LIMIT ) THEN |
ELSEIF (advectionScheme.EQ.ENUM_DST3_FLUX_LIMIT ) THEN |
493 |
CALL GAD_DST3FL_ADV_Y( bi,bj,k, deltaTtracer, |
CALL GAD_DST3FL_ADV_Y( bi,bj,k, dTtracerLev(k), |
494 |
I vTrans, vVel, maskLocS, localTij, |
I vTrans, vVel, maskLocS, localTij, |
495 |
O af, myThid ) |
O af, myThid ) |
496 |
ELSE |
ELSE |
521 |
IF ( W_edge ) THEN |
IF ( W_edge ) THEN |
522 |
DO j=jMinUpd,jMaxUpd |
DO j=jMinUpd,jMaxUpd |
523 |
DO i=1-Olx,0 |
DO i=1-Olx,0 |
524 |
localTij(i,j)=localTij(i,j)-deltaTtracer* |
localTij(i,j)=localTij(i,j)-dTtracerLev(k)* |
525 |
& _recip_hFacC(i,j,k,bi,bj)*recip_drF(k) |
& _recip_hFacC(i,j,k,bi,bj)*recip_drF(k) |
526 |
& *recip_rA(i,j,bi,bj) |
& *recip_rA(i,j,bi,bj) |
527 |
& *( af(i,j+1)-af(i,j) |
& *( af(i,j+1)-af(i,j) |
533 |
IF ( E_edge ) THEN |
IF ( E_edge ) THEN |
534 |
DO j=jMinUpd,jMaxUpd |
DO j=jMinUpd,jMaxUpd |
535 |
DO i=sNx+1,sNx+Olx |
DO i=sNx+1,sNx+Olx |
536 |
localTij(i,j)=localTij(i,j)-deltaTtracer* |
localTij(i,j)=localTij(i,j)-dTtracerLev(k)* |
537 |
& _recip_hFacC(i,j,k,bi,bj)*recip_drF(k) |
& _recip_hFacC(i,j,k,bi,bj)*recip_drF(k) |
538 |
& *recip_rA(i,j,bi,bj) |
& *recip_rA(i,j,bi,bj) |
539 |
& *( af(i,j+1)-af(i,j) |
& *( af(i,j+1)-af(i,j) |
551 |
IF ( interiorOnly .AND. E_edge ) iMaxUpd = sNx |
IF ( interiorOnly .AND. E_edge ) iMaxUpd = sNx |
552 |
DO j=1-Oly+1,sNy+Oly-1 |
DO j=1-Oly+1,sNy+Oly-1 |
553 |
DO i=iMinUpd,iMaxUpd |
DO i=iMinUpd,iMaxUpd |
554 |
localTij(i,j)=localTij(i,j)-deltaTtracer* |
localTij(i,j)=localTij(i,j)-dTtracerLev(k)* |
555 |
& _recip_hFacC(i,j,k,bi,bj)*recip_drF(k) |
& _recip_hFacC(i,j,k,bi,bj)*recip_drF(k) |
556 |
& *recip_rA(i,j,bi,bj) |
& *recip_rA(i,j,bi,bj) |
557 |
& *( af(i,j+1)-af(i,j) |
& *( af(i,j+1)-af(i,j) |
591 |
DO j=1-Oly,sNy+Oly |
DO j=1-Oly,sNy+Oly |
592 |
DO i=1-Olx,sNx+Olx |
DO i=1-Olx,sNx+Olx |
593 |
gTracer(i,j,k,bi,bj)= |
gTracer(i,j,k,bi,bj)= |
594 |
& (localTij(i,j)-tracer(i,j,k,bi,bj))/deltaTtracer |
& (localTij(i,j)-tracer(i,j,k,bi,bj))/dTtracerLev(k) |
595 |
ENDDO |
ENDDO |
596 |
ENDDO |
ENDDO |
597 |
ELSE |
ELSE |
603 |
ENDDO |
ENDDO |
604 |
ENDIF |
ENDIF |
605 |
|
|
606 |
|
#ifdef ALLOW_DIAGNOSTICS |
607 |
|
IF ( useDiagnostics ) THEN |
608 |
|
kk = -k |
609 |
|
diagName = 'ADVx'//diagSufx |
610 |
|
CALL DIAGNOSTICS_FILL(afx,diagName, kk,1, 2,bi,bj, myThid) |
611 |
|
diagName = 'ADVy'//diagSufx |
612 |
|
CALL DIAGNOSTICS_FILL(afy,diagName, kk,1, 2,bi,bj, myThid) |
613 |
|
ENDIF |
614 |
|
#endif |
615 |
|
|
616 |
#ifdef ALLOW_DEBUG |
#ifdef ALLOW_DEBUG |
617 |
IF ( debugLevel .GE. debLevB |
IF ( debugLevel .GE. debLevB |
618 |
& .AND. tracerIdentity.EQ.GAD_TEMPERATURE |
& .AND. tracerIdentity.EQ.GAD_TEMPERATURE |
691 |
C- Compute vertical advective flux in the interior: |
C- Compute vertical advective flux in the interior: |
692 |
IF (vertAdvecScheme.EQ.ENUM_FLUX_LIMIT) THEN |
IF (vertAdvecScheme.EQ.ENUM_FLUX_LIMIT) THEN |
693 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
694 |
CALL GAD_FLUXLIMIT_ADV_R( bi,bj,k, deltaTtracer, |
CALL GAD_FLUXLIMIT_ADV_R( bi,bj,k, dTtracerLev(k), |
695 |
I rTrans, wVel, localTijk, |
I rTrans, wVel, localTijk, |
696 |
O fVerT(1-Olx,1-Oly,kUp), myThid ) |
O fVerT(1-Olx,1-Oly,kUp), myThid ) |
697 |
ELSEIF (vertAdvecScheme.EQ.ENUM_DST3 ) THEN |
ELSEIF (vertAdvecScheme.EQ.ENUM_DST3 ) THEN |
698 |
CALL GAD_DST3_ADV_R( bi,bj,k, deltaTtracer, |
CALL GAD_DST3_ADV_R( bi,bj,k, dTtracerLev(k), |
699 |
I rTrans, wVel, localTijk, |
I rTrans, wVel, localTijk, |
700 |
O fVerT(1-Olx,1-Oly,kUp), myThid ) |
O fVerT(1-Olx,1-Oly,kUp), myThid ) |
701 |
ELSEIF (vertAdvecScheme.EQ.ENUM_DST3_FLUX_LIMIT ) THEN |
ELSEIF (vertAdvecScheme.EQ.ENUM_DST3_FLUX_LIMIT ) THEN |
702 |
CALL GAD_DST3FL_ADV_R( bi,bj,k, deltaTtracer, |
CALL GAD_DST3FL_ADV_R( bi,bj,k, dTtracerLev(k), |
703 |
I rTrans, wVel, localTijk, |
I rTrans, wVel, localTijk, |
704 |
O fVerT(1-Olx,1-Oly,kUp), myThid ) |
O fVerT(1-Olx,1-Oly,kUp), myThid ) |
705 |
ELSE |
ELSE |
719 |
C-- Divergence of vertical fluxes |
C-- Divergence of vertical fluxes |
720 |
DO j=1-Oly,sNy+Oly |
DO j=1-Oly,sNy+Oly |
721 |
DO i=1-Olx,sNx+Olx |
DO i=1-Olx,sNx+Olx |
722 |
localTij(i,j)=localTijk(i,j,k)-deltaTtracer* |
localTij(i,j)=localTijk(i,j,k)-dTtracerLev(k)* |
723 |
& _recip_hFacC(i,j,k,bi,bj)*recip_drF(k) |
& _recip_hFacC(i,j,k,bi,bj)*recip_drF(k) |
724 |
& *recip_rA(i,j,bi,bj) |
& *recip_rA(i,j,bi,bj) |
725 |
& *( fVerT(i,j,kUp)-fVerT(i,j,kDown) |
& *( fVerT(i,j,kUp)-fVerT(i,j,kDown) |
726 |
& -tracer(i,j,k,bi,bj)*(rTrans(i,j)-rTransKp1(i,j)) |
& -tracer(i,j,k,bi,bj)*(rTrans(i,j)-rTransKp1(i,j)) |
727 |
& )*rkFac |
& )*rkFac |
728 |
gTracer(i,j,k,bi,bj)= |
gTracer(i,j,k,bi,bj)= |
729 |
& (localTij(i,j)-tracer(i,j,k,bi,bj))/deltaTtracer |
& (localTij(i,j)-tracer(i,j,k,bi,bj))/dTtracerLev(k) |
730 |
ENDDO |
ENDDO |
731 |
ENDDO |
ENDDO |
732 |
|
|
733 |
|
#ifdef ALLOW_DIAGNOSTICS |
734 |
|
IF ( useDiagnostics ) THEN |
735 |
|
kk = -k |
736 |
|
diagName = 'ADVr'//diagSufx |
737 |
|
CALL DIAGNOSTICS_FILL( fVerT(1-Olx,1-Oly,kUp), |
738 |
|
& diagName, kk,1, 2,bi,bj, myThid) |
739 |
|
ENDIF |
740 |
|
#endif |
741 |
|
|
742 |
C-- End of K loop for vertical flux |
C-- End of K loop for vertical flux |
743 |
ENDDO |
ENDDO |
744 |
C-- end of if not.implicitAdvection block |
C-- end of if not.implicitAdvection block |