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"
6a6c83f9ac Hajo*0032 #include "GAD.h"
                0033 #ifdef ALLOW_LONGSTEP
                0034 #include "LONGSTEP.h"
                0035 #endif
0c49347dc7 Alis*0036
b6b11b9b2f Patr*0037 #ifdef ALLOW_AUTODIFF_TAMC
27cc6013c1 Patr*0038 # include "tamc.h"
                0039 # ifdef ALLOW_PTRACERS
                0040 #  include "PTRACERS_SIZE.h"
                0041 # endif
b6b11b9b2f Patr*0042 #endif /* ALLOW_AUTODIFF_TAMC */
                0043
14e0496834 Jean*0044 C     !INPUT/OUTPUT PARAMETERS:
8233d0ceb9 Jean*0045 C     trIdentity :: tracer Id number
                0046 C     bi, bj     :: current tile indices
                0047 C     k          :: current level index
                0048 C     iMin,iMax  :: Range of 1rst index where results will be set
                0049 C     jMin,jMax  :: Range of 2nd  index where results will be set
                0050 C     xA         :: Area of X face
                0051 C     maskFk     :: 2-D mask for vertical interface k (between level k-1 & k)
                0052 C     Tracer     :: 3D Tracer field
                0053 C     df         :: Diffusive flux component work array.
                0054 C     myThid     :: my Thread Id number
e9de1d7682 Jean*0055       INTEGER trIdentity
                0056       INTEGER bi, bj, k
                0057       INTEGER iMin, iMax, jMin, jMax
8233d0ceb9 Jean*0058       _RS xA    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0059       _RS maskFk(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
e9de1d7682 Jean*0060       _RL Tracer(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
0c49347dc7 Alis*0061       _RL df    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0062       INTEGER myThid
14e0496834 Jean*0063 CEOP
0c49347dc7 Alis*0064
                0065 #ifdef ALLOW_GMREDI
14e0496834 Jean*0066 C     !LOCAL VARIABLES:
8233d0ceb9 Jean*0067 C     i, j       :: Loop counters
e9de1d7682 Jean*0068       INTEGER i, j
2ae58a73ff Jean*0069 #if ( defined (GM_EXTRA_DIAGONAL) || defined (GM_BOLUS_ADVEC) )
                0070       INTEGER kp1
8233d0ceb9 Jean*0071       _RL maskp1
2ae58a73ff Jean*0072 #endif
9cb619cfcd Patr*0073 #ifdef GM_EXTRA_DIAGONAL
2ae58a73ff Jean*0074       INTEGER km1
9cb619cfcd Patr*0075       _RL dTdz  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0076 #endif
                0077 #ifdef GM_BOLUS_ADVEC
                0078       _RL uTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
5a08ec604d Davi*0079 #ifdef ALLOW_DIAGNOSTICS
                0080       LOGICAL  DIAGNOSTICS_IS_ON
                0081       EXTERNAL DIAGNOSTICS_IS_ON
                0082       _RL tmp1k(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0083 #endif
2ae58a73ff Jean*0084 #endif /* GM_BOLUS_ADVEC */
7c50f07931 Mart*0085 #ifdef ALLOW_AUTODIFF_TAMC
edb6656069 Mart*0086 C     kkey :: tape key (depends on levels and tiles)
                0087       INTEGER kkey
                0088       CHARACTER*(MAX_LEN_MBUF) msgBuf
7c50f07931 Mart*0089 #endif
0c49347dc7 Alis*0090
b6b11b9b2f Patr*0091 #ifdef ALLOW_AUTODIFF_TAMC
edb6656069 Mart*0092       kkey = bi + (bj-1)*nSx + (ikey_dynamics-1)*nSx*nSy
                0093       kkey = trIdentity + (kkey-1)*maxpass
                0094       kkey = k + (kkey-1)*Nr
7c50f07931 Mart*0095       IF (trIdentity.GT.maxpass) THEN
edb6656069 Mart*0096        WRITE(msgBuf,'(A,2I5)')
                0097      &      'GMREDI_XTRANSPORT: trIdentity > maxpass ',
                0098      &      trIdentity, maxpass
                0099        CALL PRINT_ERROR( msgBuf, myThid )
                0100        STOP 'ABNORMAL END: S/R GMREDI_XTRANSPORT'
7c50f07931 Mart*0101       ENDIF
b6b11b9b2f Patr*0102 #endif /* ALLOW_AUTODIFF_TAMC */
                0103
2a09713997 Patr*0104       IF (useGMRedi) THEN
2ae58a73ff Jean*0105
b6b11b9b2f Patr*0106 #ifdef ALLOW_AUTODIFF_TAMC
2ae58a73ff Jean*0107 CADJ STORE Kux(:,:,k,bi,bj) =
10d4db6918 Patr*0108 CADJ &     comlev1_gmredi_k_gad, key=kkey, byte=isbyte
                0109 # ifdef GM_EXTRA_DIAGONAL
                0110 CADJ STORE Kuz(:,:,k,bi,bj) =
                0111 CADJ &     comlev1_gmredi_k_gad, key=kkey, byte=isbyte
                0112 # endif
14e0496834 Jean*0113 #endif /* ALLOW_AUTODIFF_TAMC */
0c49347dc7 Alis*0114
                0115 C--   Area integrated zonal flux
6a6c83f9ac Hajo*0116 #ifdef ALLOW_LONGSTEP
                0117       IF ( trIdentity .GE. GAD_TR1 ) THEN
                0118        DO j=jMin,jMax
                0119         DO i=iMin,iMax
                0120          df(i,j) = df(i,j)
                0121      &    -xA(i,j)
                0122      &     *LS_Kux(i,j,k,bi,bj)
                0123      &     *_recip_dxC(i,j,bi,bj)*recip_deepFacC(k)
                0124      &     *( Tracer(i,j,k) - Tracer(i-1,j,k) )
                0125         ENDDO
0c49347dc7 Alis*0126        ENDDO
6a6c83f9ac Hajo*0127       ELSE
                0128 #endif /* ALLOW_LONGSTEP */
                0129        DO j=jMin,jMax
                0130         DO i=iMin,iMax
                0131          df(i,j) = df(i,j)
                0132      &    -xA(i,j)
                0133      &     *Kux(i,j,k,bi,bj)
                0134      &     *_recip_dxC(i,j,bi,bj)*recip_deepFacC(k)
                0135      &     *( Tracer(i,j,k) - Tracer(i-1,j,k) )
                0136         ENDDO
                0137        ENDDO
                0138 #ifdef ALLOW_LONGSTEP
                0139       ENDIF
                0140 #endif /* ALLOW_LONGSTEP */
0c49347dc7 Alis*0141
f42e64b3e7 Jean*0142 #ifdef GM_EXTRA_DIAGONAL
796b5e35f7 Jean*0143       IF ( GM_ExtraDiag ) THEN
f42e64b3e7 Jean*0144        km1 = MAX(k-1,1)
                0145        kp1 = MIN(k+1,Nr)
e9de1d7682 Jean*0146 C-    Vertical gradients interpolated to U points
8233d0ceb9 Jean*0147 C     Note: no real needs for masking out with maskp1 when k=Nr since the Tracer
                0148 C           difference is already zero (k=kp1 in this case); but cleaner for
                0149 C           AD-code to ensure exactly zero contribution to Tracer AD var.
                0150        maskp1 = 1. _d 0
                0151        IF (k.GE.Nr) maskp1 = 0. _d 0
f42e64b3e7 Jean*0152        DO j=jMin,jMax
                0153         DO i=iMin,iMax
8233d0ceb9 Jean*0154          dTdz(i,j) = op5*(
796b5e35f7 Jean*0155      &    +op5*recip_drC(k)*
8233d0ceb9 Jean*0156      &        ( maskFk(i-1,j)*
                0157      &            ( Tracer(i-1,j,km1)-Tracer(i-1,j,k) )
                0158      &         +maskFk( i ,j)*
                0159      &            ( Tracer( i ,j,km1)-Tracer( i ,j,k) )
796b5e35f7 Jean*0160      &        )
                0161      &    +op5*recip_drC(kp1)*
8233d0ceb9 Jean*0162      &        ( maskC(i-1,j,k,bi,bj)*maskC(i-1,j,kp1,bi,bj)*maskp1*
                0163      &            ( Tracer(i-1,j,k)-Tracer(i-1,j,kp1) )
                0164      &         +maskC( i ,j,k,bi,bj)*maskC( i ,j,kp1,bi,bj)*maskp1*
                0165      &            ( Tracer( i ,j,k)-Tracer( i ,j,kp1) )
                0166      &        )          )
f42e64b3e7 Jean*0167         ENDDO
                0168        ENDDO
9cb619cfcd Patr*0169 #ifdef GM_AUTODIFF_EXCESSIVE_STORE
796b5e35f7 Jean*0170 CADJ STORE dTdz(:,:) =
9cb619cfcd Patr*0171 CADJ &     comlev1_gmredi_k_gad, key=kkey, byte=isbyte
                0172 #endif
e9de1d7682 Jean*0173 C-    Off-diagonal components of horizontal flux
6a6c83f9ac Hajo*0174 #ifdef ALLOW_LONGSTEP
                0175        IF ( trIdentity .GE. GAD_TR1 ) THEN
                0176         DO j=jMin,jMax
                0177          DO i=iMin,iMax
                0178           df(i,j) = df(i,j) - xA(i,j)*LS_Kuz(i,j,k,bi,bj)*dTdz(i,j)
                0179          ENDDO
9cb619cfcd Patr*0180         ENDDO
6a6c83f9ac Hajo*0181        ELSE
                0182 #endif /* ALLOW_LONGSTEP */
                0183         DO j=jMin,jMax
                0184          DO i=iMin,iMax
                0185           df(i,j) = df(i,j) - xA(i,j)*Kuz(i,j,k,bi,bj)*dTdz(i,j)
                0186          ENDDO
                0187         ENDDO
                0188 #ifdef ALLOW_LONGSTEP
                0189        ENDIF
                0190 #endif /* ALLOW_LONGSTEP */
f42e64b3e7 Jean*0191       ENDIF
                0192 #endif /* GM_EXTRA_DIAGONAL */
                0193
                0194 #ifdef GM_BOLUS_ADVEC
796b5e35f7 Jean*0195       IF ( GM_AdvForm .AND. GM_AdvSeparate
                0196      &                .AND. .NOT.GM_InMomAsStress ) THEN
5b172de0d2 Jean*0197 C      Since bolus transport is computed as curl of stream-function, needs to
                0198 C      flip sign when using Left-Handed Coordinate system such as P-coordinate
                0199 c      flipSign4LHCoord = -gravitySign
f42e64b3e7 Jean*0200        kp1 = MIN(k+1,Nr)
8233d0ceb9 Jean*0201        maskp1 = 1. _d 0
                0202        IF (k.GE.Nr) maskp1 = 0. _d 0
6a6c83f9ac Hajo*0203 #ifdef ALLOW_LONGSTEP
                0204        IF ( trIdentity .GE. GAD_TR1 ) THEN
                0205         DO j=jMin,jMax
                0206          DO i=iMin,iMax
                0207           uTrans(i,j) = -gravitySign*dyG(i,j,bi,bj)
                0208      &       *( LS_PsiX(i,j,kp1,bi,bj)*deepFacF(kp1)*maskp1
                0209      &        - LS_PsiX(i,j, k ,bi,bj)*deepFacF(k)
                0210      &        )*maskW(i,j,k,bi,bj)
                0211          ENDDO
9cb619cfcd Patr*0212         ENDDO
6a6c83f9ac Hajo*0213        ELSE
                0214 #endif /* ALLOW_LONGSTEP */
                0215         DO j=jMin,jMax
                0216          DO i=iMin,iMax
                0217           uTrans(i,j) = -gravitySign*dyG(i,j,bi,bj)
                0218      &       *( GM_PsiX(i,j,kp1,bi,bj)*deepFacF(kp1)*maskp1
                0219      &        - GM_PsiX(i,j, k ,bi,bj)*deepFacF(k)
                0220      &        )*maskW(i,j,k,bi,bj)
                0221          ENDDO
                0222         ENDDO
                0223 #ifdef ALLOW_LONGSTEP
                0224        ENDIF
                0225 #endif /* ALLOW_LONGSTEP */
9cb619cfcd Patr*0226 #ifdef GM_AUTODIFF_EXCESSIVE_STORE
796b5e35f7 Jean*0227 CADJ STORE uTrans(:,:) =
9cb619cfcd Patr*0228 CADJ &     comlev1_gmredi_k_gad, key=kkey, byte=isbyte
                0229 #endif
                0230        DO j=jMin,jMax
                0231         DO i=iMin,iMax
f42e64b3e7 Jean*0232          df(i,j) = df(i,j)
a67797e4f0 Jean*0233      &    + uTrans(i,j)*op5*( Tracer(i,j,k) + Tracer(i-1,j,k) )
f42e64b3e7 Jean*0234         ENDDO
                0235        ENDDO
                0236       ENDIF
5a08ec604d Davi*0237
                0238 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
2ae58a73ff Jean*0239
                0240 #ifdef ALLOW_DIAGNOSTICS
a67797e4f0 Jean*0241       IF ( useDiagnostics .AND. trIdentity.EQ.1 .AND.
                0242      &     DIAGNOSTICS_IS_ON( 'GM_ubT  ', myThid ) ) THEN
5a08ec604d Davi*0243        kp1 = MIN(k+1,Nr)
8233d0ceb9 Jean*0244        maskp1 = 1. _d 0
                0245        IF (k.GE.Nr) maskp1 = 0. _d 0
5a08ec604d Davi*0246        DO j=jMin,jMax
                0247         DO i=iMin,iMax
5b172de0d2 Jean*0248          tmp1k(i,j) = -gravitySign*dyG(i,j,bi,bj)
a67797e4f0 Jean*0249      &      *( GM_PsiX(i,j,kp1,bi,bj)*deepFacF(kp1)*maskp1
                0250      &       - GM_PsiX(i,j, k ,bi,bj)*deepFacF(k)
                0251      &       )*maskW(i,j,k,bi,bj)
                0252      &        *op5*( Tracer(i,j,k) + Tracer(i-1,j,k) )
5a08ec604d Davi*0253         ENDDO
                0254        ENDDO
                0255        CALL DIAGNOSTICS_FILL(tmp1k,'GM_ubT  ', k,1,2,bi,bj,myThid)
                0256       ENDIF
                0257 #endif /* ALLOW_DIAGNOSTICS */
                0258
f42e64b3e7 Jean*0259 #endif /* GM_BOLUS_ADVEC */
                0260
0c49347dc7 Alis*0261       ENDIF
                0262 #endif /* ALLOW_GMREDI */
                0263
                0264       RETURN
                0265       END