model/src/convective_adjustment.F

6d54cf9ca1 Ed H*0001 #include "PACKAGES_CONFIG.h"
fb481a83c2 Alis*0002 #include "CPP_OPTIONS.h"
517dbdc414 Jean*0003 #ifdef ALLOW_AUTODIFF
                0004 # include "AUTODIFF_OPTIONS.h"
                0005 #endif
fb481a83c2 Alis*0006
9366854e02 Chri*0007 CBOP
                0008 C     !ROUTINE: CONVECTIVE_ADJUSTMENT
                0009 C     !INTERFACE:
fb481a83c2 Alis*0010       SUBROUTINE CONVECTIVE_ADJUSTMENT(
218973b4ce Jean*0011      I                      bi, bj, myTime, myIter, myThid )
9366854e02 Chri*0012 C     !DESCRIPTION: \bv
                0013 C     *==========================================================*
218973b4ce Jean*0014 C     | SUBROUTINE CONVECTIVE_ADJUSTMENT
                0015 C     | o Driver for vertical mixing or similar parameterization
9366854e02 Chri*0016 C     *==========================================================*
                0017 C     \ev
                0018
                0019 C     !USES:
fb481a83c2 Alis*0020       IMPLICIT NONE
                0021 C     == Global data ==
                0022 #include "SIZE.h"
                0023 #include "EEPARAMS.h"
                0024 #include "PARAMS.h"
                0025 #include "DYNVARS.h"
                0026 #include "GRID.h"
7c50f07931 Mart*0027 #ifdef ALLOW_AUTODIFF_TAMC
2dcaa8b9a5 Patr*0028 #include "tamc.h"
7c50f07931 Mart*0029 #endif /* ALLOW_AUTODIFF_TAMC */
fb481a83c2 Alis*0030
9366854e02 Chri*0031 C     !INPUT/OUTPUT PARAMETERS:
fb481a83c2 Alis*0032 C     == Routine arguments ==
218973b4ce Jean*0033 C     bi,bj  :: tile indices
                0034 C     myTime :: Current time in simulation
                0035 C     myIter :: Current iteration in simulation
                0036 C     myThid :: My Thread Id number
                0037       INTEGER bi,bj
                0038       _RL     myTime
fb481a83c2 Alis*0039       INTEGER myIter
                0040       INTEGER myThid
                0041
                0042 #ifdef INCLUDE_CONVECT_CALL
                0043
517dbdc414 Jean*0044 C     !FUNCTIONS:
                0045       EXTERNAL DIFFERENT_MULTIPLE
                0046       LOGICAL  DIFFERENT_MULTIPLE
                0047
9366854e02 Chri*0048 C     !LOCAL VARIABLES:
fb481a83c2 Alis*0049 C     == Local variables ==
218973b4ce Jean*0050 C     iMin,iMax,jMin,jMax :: computation domain
dd54a44307 Mart*0051 C     i,j,k        :: Loop counters
9366854e02 Chri*0052 C     rhoKm1, rhoK :: Density at adjacent levels (common ref. level)
                0053 C     ConvectCount :: Convection mixing freq. counter.
218973b4ce Jean*0054       INTEGER iMin,iMax,jMin,jMax
dd54a44307 Mart*0055       INTEGER i, j, k, kTop, kBottom, kDir, deltaK
7c50f07931 Mart*0056 #ifdef ALLOW_AUTODIFF_TAMC
edb6656069 Mart*0057       INTEGER tkey, kkey
7c50f07931 Mart*0058 #endif
fb481a83c2 Alis*0059       _RL rhoKm1(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0060       _RL rhoK  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0061       _RL ConvectCount(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
dfe2344b20 Alis*0062       _RL weightA(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0063       _RL weightB(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
9366854e02 Chri*0064 CEOP
fb481a83c2 Alis*0065
                0066 C--   Check to see if should convect now
0fa2023ba5 Jean*0067       IF ( DIFFERENT_MULTIPLE(cAdjFreq,myTime,deltaTClock)
51d88069bf Jean*0068      &   ) THEN
fb481a83c2 Alis*0069
218973b4ce Jean*0070 C--   Define computation domain
517dbdc414 Jean*0071         iMin=1-OLx
                0072         iMax=sNx+OLx
                0073         jMin=1-OLy
                0074         jMax=sNy+OLy
218973b4ce Jean*0075
7103bd8015 Patr*0076 C--   Initialise counters
                0077         kTop    = 0
                0078         kBottom = 0
                0079         kDir    = 0
                0080         deltaK  = 0
                0081
b91a70728d Jean*0082 C-      Initialisation of Convection Counter
dd54a44307 Mart*0083         DO k=1,Nr
b91a70728d Jean*0084          DO j=1-OLy,sNy+OLy
                0085           DO i=1-OLx,sNx+OLx
dd54a44307 Mart*0086            ConvectCount(i,j,k) = 0.
b91a70728d Jean*0087           ENDDO
                0088          ENDDO
                0089         ENDDO
                0090
2dcaa8b9a5 Patr*0091 #ifdef ALLOW_AUTODIFF_TAMC
edb6656069 Mart*0092         tkey = bi + (bj-1)*nSx + (ikey_dynamics-1)*nSx*nSy
2dcaa8b9a5 Patr*0093 #endif /* ALLOW_AUTODIFF_TAMC */
                0094
7c50f07931 Mart*0095         IF ( rkSign*gravitySign .GT. 0. ) THEN
9669509dca Jean*0096 C-          <=> usingZCoords:
7c50f07931 Mart*0097          kTop    =  2
                0098          kBottom = Nr
                0099          kDir    =  1
                0100          deltaK  = -1
                0101         ELSE
9669509dca Jean*0102 C-          <=> usingPCoords:
7c50f07931 Mart*0103          kTop    = Nr
                0104          kBottom =  2
                0105          kDir    = -1
                0106          deltaK  =  0
                0107         ENDIF
59e59b79d8 Mart*0108
fb481a83c2 Alis*0109 C--       Loop over all *interior* layers
7c50f07931 Mart*0110         DO k=kTop,kBottom,kDir
59e59b79d8 Mart*0111
fb481a83c2 Alis*0112 #ifdef ALLOW_AUTODIFF_TAMC
edb6656069 Mart*0113          kkey = k + (tkey-1)*Nr
dd54a44307 Mart*0114 C     It is important that the two k-levels of these fields are stored
                0115 C     in one statement because otherwise taf will only store one, which
                0116 C     is wrong (i.e. was wrong in previous versions).
                0117 CADJ STORE theta(:,:,k-1,bi,bj), theta(:,:,k,bi,bj) =
                0118 CADJ &     comlev1_bibj_k, key = kkey, kind = isbyte
                0119 CADJ STORE salt(:,:,k-1,bi,bj), salt(:,:,k,bi,bj) =
                0120 CADJ &     comlev1_bibj_k, key = kkey, kind = isbyte
fb481a83c2 Alis*0121 #endif /* ALLOW_AUTODIFF_TAMC */
dd54a44307 Mart*0122 C-          Density of k-1 layer (above W(k)) reference to k-1 T-level
7c50f07931 Mart*0123          CALL FIND_RHO_2D(
                0124      I        iMin, iMax, jMin, jMax, k+deltaK,
                0125      I        theta(1-OLx,1-OLy,k-1,bi,bj),
                0126      I        salt (1-OLx,1-OLy,k-1,bi,bj),
                0127      O        rhoKm1,
                0128      I        k-1, bi, bj, myThid )
fb481a83c2 Alis*0129
dd54a44307 Mart*0130 C-          Density of k layer (below W(k)) reference to k-1 T-level.
7c50f07931 Mart*0131          CALL FIND_RHO_2D(
                0132      I        iMin, iMax, jMin, jMax, k+deltaK,
                0133      I        theta(1-OLx,1-OLy,k,bi,bj),
                0134      I        salt (1-OLx,1-OLy,k,bi,bj),
                0135      O        rhoK,
                0136      I        k, bi, bj, myThid )
fb481a83c2 Alis*0137 #ifdef ALLOW_AUTODIFF_TAMC
dd54a44307 Mart*0138 CADJ STORE rhoKm1 = comlev1_bibj_k, key = kkey, kind = isbyte
                0139 CADJ STORE rhoK   = comlev1_bibj_k, key = kkey, kind = isbyte
fb481a83c2 Alis*0140 #endif /* ALLOW_AUTODIFF_TAMC */
dfe2344b20 Alis*0141
dd54a44307 Mart*0142 C-          Pre-calculate mixing weights for interface k
7c50f07931 Mart*0143          CALL CONVECTIVE_WEIGHTS(
                0144      I        bi,bj,k,rhoKm1,rhoK,
                0145      O        weightA,weightB,ConvectCount,
                0146      I        myThid)
dfe2344b20 Alis*0147
dd54a44307 Mart*0148 C-          Convectively mix heat across interface k
7c50f07931 Mart*0149          CALL CONVECTIVELY_MIXTRACER(
                0150      I                               bi,bj,k,weightA,weightB,
                0151      U                               theta,
                0152      I                               myThid)
dfe2344b20 Alis*0153
dd54a44307 Mart*0154 C-          Convectively mix salt across interface k
7c50f07931 Mart*0155          CALL CONVECTIVELY_MIXTRACER(
                0156      I                               bi,bj,k,weightA,weightB,
                0157      U                               salt,
                0158      I                               myThid)
dfe2344b20 Alis*0159
5c43c390b6 Alis*0160 #ifdef ALLOW_PTRACERS
dd54a44307 Mart*0161 C-          Convectively mix passive tracers across interface k
7c50f07931 Mart*0162          IF ( usePTRACERS ) THEN
                0163           CALL PTRACERS_CONVECT(
                0164      I                          bi,bj,k,weightA,weightB,myThid)
                0165          ENDIF
5c43c390b6 Alis*0166 #endif /* ALLOW_PTRACERS */
                0167
dd54a44307 Mart*0168 C--       End DO k=1,Nr
7c50f07931 Mart*0169         ENDDO
218973b4ce Jean*0170
                0171 #ifdef ALLOW_DIAGNOSTICS
7c50f07931 Mart*0172         IF ( myIter.NE.nIter0 .AND. useDiagnostics ) THEN
                0173          CALL DIAGNOSTICS_FILL( ConvectCount, 'CONVADJ ',
                0174      I                          0, Nr, 2, bi, bj, myThid )
                0175         ENDIF
ad55014c08 Jean*0176 #endif /*  ALLOW_DIAGNOSTICS */
                0177
0fa2023ba5 Jean*0178 C--   End IF (DIFFERENT_MULTIPLE)
fb481a83c2 Alis*0179       ENDIF
                0180
                0181 #endif /* INCLUDE_CONVECT_CALL */
                0182
                0183       RETURN
                0184       END