Back to home page

MITgcm
 
 

    

File indexing completed on 2025-06-05 05:08:25 UTC

view on githubraw file Latest commit 6a6c83f9 on 2025-06-04 22:00:11 UTC
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 C     !ROUTINE: GMREDI_RTRANSPORT
                0007 C     !INTERFACE:
e9de1d7682 Jean*0008       SUBROUTINE GMREDI_RTRANSPORT(
                0009      I     trIdentity, bi, bj, k,
                0010      I     iMin, iMax, jMin, jMax,
0e9223926c Jean*0011      I     maskUp, Tracer,
0c49347dc7 Alis*0012      U     df,
e9de1d7682 Jean*0013      I     myThid )
14e0496834 Jean*0014 
                0015 C     !DESCRIPTION: \bv
e9de1d7682 Jean*0016 C     *==========================================================*
0c49347dc7 Alis*0017 C     | o SUBROUTINE GMREDI_RTRANSPORT                           |
                0018 C     |   Add vertical transport terms from GM/Redi              |
                0019 C     |   parameterization.                                      |
e9de1d7682 Jean*0020 C     *==========================================================*
14e0496834 Jean*0021 C     \ev
0c49347dc7 Alis*0022 
14e0496834 Jean*0023 C     !USES:
                0024       IMPLICIT NONE
0c49347dc7 Alis*0025 C     == GLobal variables ==
                0026 #include "SIZE.h"
                0027 #include "EEPARAMS.h"
                0028 #include "PARAMS.h"
                0029 #include "GRID.h"
                0030 #include "GMREDI.h"
4e66ab0b67 Oliv*0031 #include "GAD.h"
                0032 #ifdef ALLOW_LONGSTEP
                0033 #include "LONGSTEP.h"
                0034 #endif
0c49347dc7 Alis*0035 
9cb619cfcd Patr*0036 #ifdef ALLOW_AUTODIFF_TAMC
27cc6013c1 Patr*0037 # include "tamc.h"
                0038 # ifdef ALLOW_PTRACERS
                0039 #  include "PTRACERS_SIZE.h"
                0040 # endif
9cb619cfcd Patr*0041 #endif /* ALLOW_AUTODIFF_TAMC */
                0042 
14e0496834 Jean*0043 C     !INPUT/OUTPUT PARAMETERS:
                0044 C     trIdentity   :: tracer Id number
                0045 C     bi, bj       :: current tile indices
                0046 C     k            :: current level index
                0047 C     iMin,iMax    :: Range of 1rst index where results will be set
                0048 C     jMin,jMax    :: Range of 2nd  index where results will be set
0e9223926c Jean*0049 C     maskUp       :: 2-D array for mask at W points
14e0496834 Jean*0050 C     Tracer       :: 3D Tracer field
                0051 C     df           :: Diffusive flux component work array.
                0052 C     myThid       :: my Thread Id number
e9de1d7682 Jean*0053       INTEGER trIdentity
                0054       INTEGER bi, bj, k
                0055       INTEGER iMin, iMax, jMin, jMax
0e9223926c Jean*0056       _RS maskUp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
e9de1d7682 Jean*0057       _RL Tracer(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
2092dbb101 Patr*0058       _RL df    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0c49347dc7 Alis*0059       INTEGER myThid
14e0496834 Jean*0060 CEOP
0c49347dc7 Alis*0061 
                0062 #ifdef ALLOW_GMREDI
14e0496834 Jean*0063 C     !LOCAL VARIABLES:
                0064 C     i, j    ::  Loop counters
e9de1d7682 Jean*0065       INTEGER i, j
7c50f07931 Mart*0066 #ifdef ALLOW_AUTODIFF_TAMC
edb6656069 Mart*0067 C     kkey :: tape key (depends on levels, tiles, and tracers)
                0068       INTEGER kkey
                0069       CHARACTER*(MAX_LEN_MBUF) msgBuf
7c50f07931 Mart*0070 #endif
9cb619cfcd Patr*0071       _RL dTdx  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0072       _RL dTdy  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0073 #ifdef GM_BOLUS_ADVEC
                0074       _RL rTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0075 #endif
                0076 
                0077 #ifdef ALLOW_AUTODIFF_TAMC
edb6656069 Mart*0078       kkey = bi + (bj-1)*nSx + (ikey_dynamics-1)*nSx*nSy
                0079       kkey = trIdentity + (kkey-1)*maxpass
                0080       kkey = k + (kkey-1)*Nr
7c50f07931 Mart*0081       IF (trIdentity.GT.maxpass) THEN
edb6656069 Mart*0082        WRITE(msgBuf,'(A,2I5)')
                0083      &      'GMREDI_RTRANSPORT: trIdentity > maxpass ',
                0084      &      trIdentity, maxpass
                0085        CALL PRINT_ERROR( msgBuf, myThid )
                0086        STOP 'ABNORMAL END: S/R GMREDI_RTRANSPORT'
7c50f07931 Mart*0087       ENDIF
9cb619cfcd Patr*0088 #endif /* ALLOW_AUTODIFF_TAMC */
0c49347dc7 Alis*0089 
                0090 C     Surface flux is zero
e9de1d7682 Jean*0091       IF ( useGMRedi .AND. k.GT.1 ) THEN
0c49347dc7 Alis*0092 
e9de1d7682 Jean*0093 C-    Horizontal gradients interpolated to W points
0c49347dc7 Alis*0094       DO j=jMin,jMax
                0095        DO i=iMin,iMax
9cb619cfcd Patr*0096         dTdx(i,j) = op5*(
a67797e4f0 Jean*0097      &    op5*recip_deepFacC(k)
                0098      &       *( _maskW(i+1,j,k,bi,bj)*_recip_dxC(i+1,j,bi,bj)
                0099      &             *( Tracer(i+1,j,k) - Tracer( i ,j,k) )
                0100      &        + _maskW( i ,j,k,bi,bj) *_recip_dxC(i,j,bi,bj)
                0101      &             *( Tracer( i ,j,k) - Tracer(i-1,j,k) )
                0102      &        )
                0103      &   +op5*recip_deepFacC(k-1)
                0104      &       *( _maskW(i+1,j,k-1,bi,bj)*_recip_dxC(i+1,j,bi,bj)
                0105      &             *( Tracer(i+1,j,k-1) - Tracer( i ,j,k-1) )
                0106      &         +_maskW( i ,j,k-1,bi,bj)*_recip_dxC( i ,j,bi,bj)
                0107      &             *( Tracer( i ,j,k-1) - Tracer(i-1,j,k-1) )
                0108      &        )          )
0c49347dc7 Alis*0109 
9cb619cfcd Patr*0110         dTdy(i,j) = op5*(
a67797e4f0 Jean*0111      &    op5*recip_deepFacC(k)
                0112      &       *( _maskS(i,j+1,k,bi,bj)*_recip_dyC(i,j+1,bi,bj)
                0113      &             *( Tracer(i,j+1,k) - Tracer(i,j,k) )
                0114      &        + _maskS(i, j ,k,bi,bj)*_recip_dyC(i, j ,bi,bj)
                0115      &             *( Tracer(i,j,k) - Tracer(i,j-1,k) )
                0116      &        )
                0117      &   +op5*recip_deepFacC(k-1)
                0118      &       *( _maskS(i,j+1,k-1,bi,bj)*_recip_dyC(i,j+1,bi,bj)
                0119      &             *( Tracer(i,j+1,k-1) - Tracer(i,j,k-1) )
                0120      &        + _maskS(i, j ,k-1,bi,bj)*_recip_dyC(i, j ,bi,bj)
                0121      &             *( Tracer(i,j,k-1) - Tracer(i,j-1,k-1) )
                0122      &        )          )
9cb619cfcd Patr*0123        ENDDO
                0124       ENDDO
e9de1d7682 Jean*0125 
9cb619cfcd Patr*0126 #ifdef GM_AUTODIFF_EXCESSIVE_STORE
e9de1d7682 Jean*0127 CADJ STORE dTdx(:,:) =
9cb619cfcd Patr*0128 CADJ &     comlev1_gmredi_k_gad, key=kkey, byte=isbyte
e9de1d7682 Jean*0129 CADJ STORE dTdy(:,:) =
9cb619cfcd Patr*0130 CADJ &     comlev1_gmredi_k_gad, key=kkey, byte=isbyte
                0131 #endif
0c49347dc7 Alis*0132 
e9de1d7682 Jean*0133 C-    Off-diagonal components of vertical flux
                0134 #ifdef ALLOW_LONGSTEP
                0135       IF ( trIdentity .GE. GAD_TR1 ) THEN
                0136         DO j=jMin,jMax
                0137          DO i=iMin,iMax
                0138           df(i,j) = df(i,j)
a67797e4f0 Jean*0139      &      - _rA(i,j,bi,bj)*deepFac2F(k)*maskInC(i,j,bi,bj)
e9de1d7682 Jean*0140      &       *( LS_Kwx(i,j,k,bi,bj)*dTdx(i,j)
0e9223926c Jean*0141      &        + LS_Kwy(i,j,k,bi,bj)*dTdy(i,j) )*maskUp(i,j)
e9de1d7682 Jean*0142          ENDDO
                0143         ENDDO
                0144       ELSE
                0145 #endif /* ALLOW_LONGSTEP */
                0146         DO j=jMin,jMax
                0147          DO i=iMin,iMax
                0148           df(i,j) = df(i,j)
a67797e4f0 Jean*0149      &      - _rA(i,j,bi,bj)*deepFac2F(k)*maskInC(i,j,bi,bj)
e9de1d7682 Jean*0150      &       *( Kwx(i,j,k,bi,bj)*dTdx(i,j)
0e9223926c Jean*0151      &        + Kwy(i,j,k,bi,bj)*dTdy(i,j) )*maskUp(i,j)
e9de1d7682 Jean*0152          ENDDO
                0153         ENDDO
4e66ab0b67 Oliv*0154 #ifdef ALLOW_LONGSTEP
e9de1d7682 Jean*0155       ENDIF
                0156 #endif /* ALLOW_LONGSTEP */
0c49347dc7 Alis*0157 
f42e64b3e7 Jean*0158 #ifdef GM_BOLUS_ADVEC
43af9695da Gael*0159       IF (GM_AdvForm .AND. GM_AdvSeparate
                0160      & .AND. .NOT.GM_InMomAsStress) THEN
5b172de0d2 Jean*0161 C      Since bolus transport is computed as curl of stream-function, needs to
                0162 C      flip sign when using Left-Handed Coordinate system such as P-coordinate
                0163 c      flipSign4LHCoord = -gravitySign
6a6c83f9ac Hajo*0164 #ifdef ALLOW_LONGSTEP
                0165        IF ( trIdentity .GE. GAD_TR1 ) THEN
                0166         DO j=jMin,jMax
                0167          DO i=iMin,iMax
                0168           rTrans(i,j) = -gravitySign*(
                0169      &       dyG(i+1,j,bi,bj)*LS_PsiX(i+1,j,k,bi,bj)
                0170      &      -dyG( i ,j,bi,bj)*LS_PsiX( i ,j,k,bi,bj)
                0171      &      +dxG(i,j+1,bi,bj)*LS_PsiY(i,j+1,k,bi,bj)
                0172      &      -dxG(i, j ,bi,bj)*LS_PsiY(i, j ,k,bi,bj)
                0173      &                               )*deepFacF(k)
                0174          ENDDO
9cb619cfcd Patr*0175         ENDDO
6a6c83f9ac Hajo*0176        ELSE
                0177 #endif /* ALLOW_LONGSTEP */
                0178         DO j=jMin,jMax
                0179          DO i=iMin,iMax
                0180           rTrans(i,j) = -gravitySign*(
                0181      &       dyG(i+1,j,bi,bj)*GM_PsiX(i+1,j,k,bi,bj)
                0182      &      -dyG( i ,j,bi,bj)*GM_PsiX( i ,j,k,bi,bj)
                0183      &      +dxG(i,j+1,bi,bj)*GM_PsiY(i,j+1,k,bi,bj)
                0184      &      -dxG(i, j ,bi,bj)*GM_PsiY(i, j ,k,bi,bj)
                0185      &                               )*deepFacF(k)
                0186          ENDDO
                0187         ENDDO
                0188 #ifdef ALLOW_LONGSTEP
                0189        ENDIF
                0190 #endif /* ALLOW_LONGSTEP */
9cb619cfcd Patr*0191 #ifdef GM_AUTODIFF_EXCESSIVE_STORE
e9de1d7682 Jean*0192 CADJ STORE rtrans(:,:) =
9cb619cfcd Patr*0193 CADJ &     comlev1_gmredi_k_gad, key=kkey, byte=isbyte
                0194 #endif
                0195        DO j=jMin,jMax
                0196         DO i=iMin,iMax
f42e64b3e7 Jean*0197          df(i,j) = df(i,j)
a67797e4f0 Jean*0198      &    + rTrans(i,j)*op5
                0199      &                 *( Tracer(i,j,k) + Tracer(i,j,k-1) )
                0200      &                 *maskInC(i,j,bi,bj)*maskUp(i,j)
f42e64b3e7 Jean*0201         ENDDO
                0202        ENDDO
                0203       ENDIF
e9de1d7682 Jean*0204 #endif /* GM_BOLUS_ADVEC */
f42e64b3e7 Jean*0205 
0c49347dc7 Alis*0206 c     IF (.NOT.implicitDiffusion) THEN
e9de1d7682 Jean*0207 C This vertical diffusion term is currently implemented
a67797e4f0 Jean*0208 C by adding the Kwz diffusivity to KappaRT/S
e9de1d7682 Jean*0209 C See calc_diffusivity.F and calc_gt.F (calc_gs.F)
0c49347dc7 Alis*0210 c     ENDIF
                0211 
                0212       ENDIF
                0213 #endif /* ALLOW_GMREDI */
                0214 
                0215       RETURN
                0216       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!