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