pkg/gmredi/gmredi_xtransport.F

0c49347dc7 Alis*0001 #include "GMREDI_OPTIONS.h"
14e0496834 Jean*0002 #ifdef ALLOW_AUTODIFF
                0003 # include "AUTODIFF_OPTIONS.h"
                0004 #endif
0c49347dc7 Alis*0005
14e0496834 Jean*0006 CBOP
                0007 C     !ROUTINE: GMREDI_XTRANSPORT
                0008 C     !INTERFACE:
2ae58a73ff Jean*0009       SUBROUTINE GMREDI_XTRANSPORT(
e9de1d7682 Jean*0010      I     trIdentity, bi, bj, k,
                0011      I     iMin, iMax, jMin, jMax,
8233d0ceb9 Jean*0012      I     xA, maskFk, Tracer,
0c49347dc7 Alis*0013      U     df,
e9de1d7682 Jean*0014      I     myThid )
14e0496834 Jean*0015
                0016 C     !DESCRIPTION: \bv
2ae58a73ff Jean*0017 C     *==========================================================*
                0018 C     | o SUBROUTINE GMREDI_XTRANSPORT
                0019 C     |   Add horizontal x transport terms from GM/Redi
                0020 C     |   parameterization.
                0021 C     *==========================================================*
14e0496834 Jean*0022 C     \ev
0c49347dc7 Alis*0023
14e0496834 Jean*0024 C     !USES:
                0025       IMPLICIT NONE
0c49347dc7 Alis*0026 C     == GLobal variables ==
                0027 #include "SIZE.h"
                0028 #include "EEPARAMS.h"
                0029 #include "PARAMS.h"
                0030 #include "GRID.h"
                0031 #include "GMREDI.h"
                0032
b6b11b9b2f Patr*0033 #ifdef ALLOW_AUTODIFF_TAMC
27cc6013c1 Patr*0034 # include "tamc.h"
                0035 # ifdef ALLOW_PTRACERS
                0036 #  include "PTRACERS_SIZE.h"
                0037 # endif
b6b11b9b2f Patr*0038 #endif /* ALLOW_AUTODIFF_TAMC */
                0039
14e0496834 Jean*0040 C     !INPUT/OUTPUT PARAMETERS:
8233d0ceb9 Jean*0041 C     trIdentity :: tracer Id number
                0042 C     bi, bj     :: current tile indices
                0043 C     k          :: current level index
                0044 C     iMin,iMax  :: Range of 1rst index where results will be set
                0045 C     jMin,jMax  :: Range of 2nd  index where results will be set
                0046 C     xA         :: Area of X face
                0047 C     maskFk     :: 2-D mask for vertical interface k (between level k-1 & k)
                0048 C     Tracer     :: 3D Tracer field
                0049 C     df         :: Diffusive flux component work array.
                0050 C     myThid     :: my Thread Id number
e9de1d7682 Jean*0051       INTEGER trIdentity
                0052       INTEGER bi, bj, k
                0053       INTEGER iMin, iMax, jMin, jMax
8233d0ceb9 Jean*0054       _RS xA    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0055       _RS maskFk(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
e9de1d7682 Jean*0056       _RL Tracer(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
0c49347dc7 Alis*0057       _RL df    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0058       INTEGER myThid
14e0496834 Jean*0059 CEOP
0c49347dc7 Alis*0060
                0061 #ifdef ALLOW_GMREDI
14e0496834 Jean*0062 C     !LOCAL VARIABLES:
8233d0ceb9 Jean*0063 C     i, j       :: Loop counters
e9de1d7682 Jean*0064       INTEGER i, j
2ae58a73ff Jean*0065 #if ( defined (GM_EXTRA_DIAGONAL) || defined (GM_BOLUS_ADVEC) )
                0066       INTEGER kp1
8233d0ceb9 Jean*0067       _RL maskp1
2ae58a73ff Jean*0068 #endif
9cb619cfcd Patr*0069 #ifdef GM_EXTRA_DIAGONAL
2ae58a73ff Jean*0070       INTEGER km1
9cb619cfcd Patr*0071       _RL dTdz  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0072 #endif
                0073 #ifdef GM_BOLUS_ADVEC
                0074       _RL uTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
5a08ec604d Davi*0075 #ifdef ALLOW_DIAGNOSTICS
                0076       LOGICAL  DIAGNOSTICS_IS_ON
                0077       EXTERNAL DIAGNOSTICS_IS_ON
                0078       _RL tmp1k(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0079 #endif
2ae58a73ff Jean*0080 #endif /* GM_BOLUS_ADVEC */
7c50f07931 Mart*0081 #ifdef ALLOW_AUTODIFF_TAMC
edb6656069 Mart*0082 C     kkey :: tape key (depends on levels and tiles)
                0083       INTEGER kkey
                0084       CHARACTER*(MAX_LEN_MBUF) msgBuf
7c50f07931 Mart*0085 #endif
0c49347dc7 Alis*0086
b6b11b9b2f Patr*0087 #ifdef ALLOW_AUTODIFF_TAMC
edb6656069 Mart*0088       kkey = bi + (bj-1)*nSx + (ikey_dynamics-1)*nSx*nSy
                0089       kkey = trIdentity + (kkey-1)*maxpass
                0090       kkey = k + (kkey-1)*Nr
7c50f07931 Mart*0091       IF (trIdentity.GT.maxpass) THEN
edb6656069 Mart*0092        WRITE(msgBuf,'(A,2I5)')
                0093      &      'GMREDI_XTRANSPORT: trIdentity > maxpass ',
                0094      &      trIdentity, maxpass
                0095        CALL PRINT_ERROR( msgBuf, myThid )
                0096        STOP 'ABNORMAL END: S/R GMREDI_XTRANSPORT'
7c50f07931 Mart*0097       ENDIF
b6b11b9b2f Patr*0098 #endif /* ALLOW_AUTODIFF_TAMC */
                0099
2a09713997 Patr*0100       IF (useGMRedi) THEN
2ae58a73ff Jean*0101
b6b11b9b2f Patr*0102 #ifdef ALLOW_AUTODIFF_TAMC
2ae58a73ff Jean*0103 CADJ STORE Kux(:,:,k,bi,bj) =
10d4db6918 Patr*0104 CADJ &     comlev1_gmredi_k_gad, key=kkey, byte=isbyte
                0105 # ifdef GM_EXTRA_DIAGONAL
                0106 CADJ STORE Kuz(:,:,k,bi,bj) =
                0107 CADJ &     comlev1_gmredi_k_gad, key=kkey, byte=isbyte
                0108 # endif
14e0496834 Jean*0109 #endif /* ALLOW_AUTODIFF_TAMC */
0c49347dc7 Alis*0110
                0111 C--   Area integrated zonal flux
                0112       DO j=jMin,jMax
                0113        DO i=iMin,iMax
                0114         df(i,j) = df(i,j)
f42e64b3e7 Jean*0115      &   -xA(i,j)
                0116      &    *Kux(i,j,k,bi,bj)
a67797e4f0 Jean*0117      &    *_recip_dxC(i,j,bi,bj)*recip_deepFacC(k)
                0118      &    *( Tracer(i,j,k) - Tracer(i-1,j,k) )
0c49347dc7 Alis*0119        ENDDO
                0120       ENDDO
                0121
f42e64b3e7 Jean*0122 #ifdef GM_EXTRA_DIAGONAL
796b5e35f7 Jean*0123       IF ( GM_ExtraDiag ) THEN
f42e64b3e7 Jean*0124        km1 = MAX(k-1,1)
                0125        kp1 = MIN(k+1,Nr)
e9de1d7682 Jean*0126 C-    Vertical gradients interpolated to U points
8233d0ceb9 Jean*0127 C     Note: no real needs for masking out with maskp1 when k=Nr since the Tracer
                0128 C           difference is already zero (k=kp1 in this case); but cleaner for
                0129 C           AD-code to ensure exactly zero contribution to Tracer AD var.
                0130        maskp1 = 1. _d 0
                0131        IF (k.GE.Nr) maskp1 = 0. _d 0
f42e64b3e7 Jean*0132        DO j=jMin,jMax
                0133         DO i=iMin,iMax
8233d0ceb9 Jean*0134          dTdz(i,j) = op5*(
796b5e35f7 Jean*0135      &    +op5*recip_drC(k)*
8233d0ceb9 Jean*0136      &        ( maskFk(i-1,j)*
                0137      &            ( Tracer(i-1,j,km1)-Tracer(i-1,j,k) )
                0138      &         +maskFk( i ,j)*
                0139      &            ( Tracer( i ,j,km1)-Tracer( i ,j,k) )
796b5e35f7 Jean*0140      &        )
                0141      &    +op5*recip_drC(kp1)*
8233d0ceb9 Jean*0142      &        ( maskC(i-1,j,k,bi,bj)*maskC(i-1,j,kp1,bi,bj)*maskp1*
                0143      &            ( Tracer(i-1,j,k)-Tracer(i-1,j,kp1) )
                0144      &         +maskC( i ,j,k,bi,bj)*maskC( i ,j,kp1,bi,bj)*maskp1*
                0145      &            ( Tracer( i ,j,k)-Tracer( i ,j,kp1) )
                0146      &        )          )
f42e64b3e7 Jean*0147         ENDDO
                0148        ENDDO
9cb619cfcd Patr*0149 #ifdef GM_AUTODIFF_EXCESSIVE_STORE
796b5e35f7 Jean*0150 CADJ STORE dTdz(:,:) =
9cb619cfcd Patr*0151 CADJ &     comlev1_gmredi_k_gad, key=kkey, byte=isbyte
                0152 #endif
e9de1d7682 Jean*0153 C-    Off-diagonal components of horizontal flux
9cb619cfcd Patr*0154        DO j=jMin,jMax
                0155         DO i=iMin,iMax
796b5e35f7 Jean*0156          df(i,j) = df(i,j) - xA(i,j)*Kuz(i,j,k,bi,bj)*dTdz(i,j)
9cb619cfcd Patr*0157         ENDDO
                0158        ENDDO
f42e64b3e7 Jean*0159       ENDIF
                0160 #endif /* GM_EXTRA_DIAGONAL */
                0161
                0162 #ifdef GM_BOLUS_ADVEC
796b5e35f7 Jean*0163       IF ( GM_AdvForm .AND. GM_AdvSeparate
                0164      &                .AND. .NOT.GM_InMomAsStress ) THEN
5b172de0d2 Jean*0165 C      Since bolus transport is computed as curl of stream-function, needs to
                0166 C      flip sign when using Left-Handed Coordinate system such as P-coordinate
                0167 c      flipSign4LHCoord = -gravitySign
f42e64b3e7 Jean*0168        kp1 = MIN(k+1,Nr)
8233d0ceb9 Jean*0169        maskp1 = 1. _d 0
                0170        IF (k.GE.Nr) maskp1 = 0. _d 0
f42e64b3e7 Jean*0171        DO j=jMin,jMax
                0172         DO i=iMin,iMax
5b172de0d2 Jean*0173          uTrans(i,j) = -gravitySign*dyG(i,j,bi,bj)
a67797e4f0 Jean*0174      &      *( GM_PsiX(i,j,kp1,bi,bj)*deepFacF(kp1)*maskp1
                0175      &       - GM_PsiX(i,j, k ,bi,bj)*deepFacF(k)
                0176      &       )*maskW(i,j,k,bi,bj)
9cb619cfcd Patr*0177         ENDDO
                0178        ENDDO
                0179 #ifdef GM_AUTODIFF_EXCESSIVE_STORE
796b5e35f7 Jean*0180 CADJ STORE uTrans(:,:) =
9cb619cfcd Patr*0181 CADJ &     comlev1_gmredi_k_gad, key=kkey, byte=isbyte
                0182 #endif
                0183        DO j=jMin,jMax
                0184         DO i=iMin,iMax
f42e64b3e7 Jean*0185          df(i,j) = df(i,j)
a67797e4f0 Jean*0186      &    + uTrans(i,j)*op5*( Tracer(i,j,k) + Tracer(i-1,j,k) )
f42e64b3e7 Jean*0187         ENDDO
                0188        ENDDO
                0189       ENDIF
5a08ec604d Davi*0190
                0191 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
2ae58a73ff Jean*0192
                0193 #ifdef ALLOW_DIAGNOSTICS
a67797e4f0 Jean*0194       IF ( useDiagnostics .AND. trIdentity.EQ.1 .AND.
                0195      &     DIAGNOSTICS_IS_ON( 'GM_ubT  ', myThid ) ) THEN
5a08ec604d Davi*0196        kp1 = MIN(k+1,Nr)
8233d0ceb9 Jean*0197        maskp1 = 1. _d 0
                0198        IF (k.GE.Nr) maskp1 = 0. _d 0
5a08ec604d Davi*0199        DO j=jMin,jMax
                0200         DO i=iMin,iMax
5b172de0d2 Jean*0201          tmp1k(i,j) = -gravitySign*dyG(i,j,bi,bj)
a67797e4f0 Jean*0202      &      *( GM_PsiX(i,j,kp1,bi,bj)*deepFacF(kp1)*maskp1
                0203      &       - GM_PsiX(i,j, k ,bi,bj)*deepFacF(k)
                0204      &       )*maskW(i,j,k,bi,bj)
                0205      &        *op5*( Tracer(i,j,k) + Tracer(i-1,j,k) )
5a08ec604d Davi*0206         ENDDO
                0207        ENDDO
                0208        CALL DIAGNOSTICS_FILL(tmp1k,'GM_ubT  ', k,1,2,bi,bj,myThid)
                0209       ENDIF
                0210 #endif /* ALLOW_DIAGNOSTICS */
                0211
f42e64b3e7 Jean*0212 #endif /* GM_BOLUS_ADVEC */
                0213
0c49347dc7 Alis*0214       ENDIF
                0215 #endif /* ALLOW_GMREDI */
                0216
                0217       RETURN
                0218       END