model/src/calc_3d_diffusivity.F

8bb967e208 Jean*0001 #include "PACKAGES_CONFIG.h"
                0002 #include "CPP_OPTIONS.h"
fe1862e69b Mart*0003 #ifdef ALLOW_AUTODIFF
                0004 # include "AUTODIFF_OPTIONS.h"
                0005 #endif
8bb967e208 Jean*0006
                0007 CBOP
                0008 C     !ROUTINE: CALC_3D_DIFFUSIVITY
55e9ea8a90 Jean*0009 C     !INTERFACE:
                0010       SUBROUTINE CALC_3D_DIFFUSIVITY(
2d435b47ac Jean*0011      I        bi, bj, iMin,iMax,jMin,jMax,
8bb967e208 Jean*0012      I        trIdentity, trUseGMRedi, trUseKPP,
                0013      O        KappaRTr,
2d435b47ac Jean*0014      I        myThid )
8bb967e208 Jean*0015
                0016 C     !DESCRIPTION: \bv
                0017 C     *==========================================================*
                0018 C     | SUBROUTINE CALC_3D_DIFFUSIVITY
                0019 C     | o Calculate net (3D) vertical diffusivity for 1 tracer
                0020 C     *==========================================================*
                0021 C     | Combines spatially varying diffusion coefficients from
                0022 C     | KPP and/or GM and/or convective stability test.
                0023 C     *==========================================================*
                0024 C     \ev
                0025
                0026 C     !USES:
                0027       IMPLICIT NONE
                0028 C     == GLobal variables ==
                0029 #include "SIZE.h"
                0030 #include "EEPARAMS.h"
                0031 #include "PARAMS.h"
                0032 #include "DYNVARS.h"
                0033 #include "GRID.h"
3ff07dd7e9 Jean*0034 #ifdef ALLOW_GENERIC_ADVDIFF
8bb967e208 Jean*0035 #include "GAD.h"
3ff07dd7e9 Jean*0036 #endif
8bb967e208 Jean*0037 #ifdef ALLOW_PTRACERS
                0038 #include "PTRACERS_SIZE.h"
85f77391e5 Jean*0039 #include "PTRACERS_PARAMS.h"
8bb967e208 Jean*0040 #endif
4e66ab0b67 Oliv*0041 #ifdef ALLOW_LONGSTEP
                0042 #include "LONGSTEP.h"
                0043 #endif
8bb967e208 Jean*0044
                0045 C     !INPUT/OUTPUT PARAMETERS:
                0046 C     == Routine arguments ==
                0047 C     bi, bj     :: tile indices
                0048 C     iMin,iMax  :: Range of points for which calculation is performed.
                0049 C     jMin,jMax  :: Range of points for which calculation is performed.
                0050 C     trIdentity :: tracer identifier
                0051 C     trUseGMRedi:: this tracer use GM-Redi
                0052 C     trUseKPP   :: this tracer use KPP
                0053 C     myThid     :: Instance number for this innvocation of CALC_3D_DIFFUSIVITY
                0054 C     KappaRTr   :: Net diffusivity for this tracer (trIdentity)
                0055       INTEGER bi,bj,iMin,iMax,jMin,jMax
                0056       INTEGER trIdentity
                0057       LOGICAL trUseGMRedi, trUseKPP
d8d1486ca1 Jean*0058       _RL KappaRTr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
8bb967e208 Jean*0059       INTEGER myThid
                0060
3ff07dd7e9 Jean*0061 #ifdef ALLOW_GENERIC_ADVDIFF
8bb967e208 Jean*0062 C     !LOCAL VARIABLES:
                0063 C     == Local variables ==
                0064 C     i, j, k    :: Loop counters
                0065 C     iTr        :: passive tracer index
                0066 C     msgBuf     :: message buffer
                0067       INTEGER i,j,k
55e9ea8a90 Jean*0068       _RL KbryanLewis79
                0069 #ifdef ALLOW_BL79_LAT_VARY
                0070       _RL KbryanLewisEQ
                0071 #endif
8bb967e208 Jean*0072       CHARACTER*(MAX_LEN_MBUF) msgBuf
7418e6b1e6 Jean*0073 #ifdef ALLOW_PTRACERS
                0074       INTEGER iTr
                0075 #endif
2d435b47ac Jean*0076 #ifndef EXCLUDE_PCELL_MIX_CODE
                0077       INTEGER km, mixSurf, mixBott
                0078       _RL pC_kFac
                0079       _RL tmpFac(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0080 #endif
8bb967e208 Jean*0081 CEOP
                0082
059d9fc14f Dimi*0083       IF ( .NOT. trUseKPP ) THEN
8bb967e208 Jean*0084        DO k = 1,Nr
d38a57d581 Jean*0085         KbryanLewis79=diffKrBL79surf+(diffKrBL79deep-diffKrBL79surf)
059d9fc14f Dimi*0086      &       *(atan(-(rF(k)-diffKrBL79Ho)/diffKrBL79scl)/PI+0.5 _d 0)
e40c34e398 Dimi*0087 #ifdef ALLOW_BL79_LAT_VARY
                0088         KbryanLewisEQ=diffKrBLEQsurf+(diffKrBLEQdeep-diffKrBLEQsurf)
059d9fc14f Dimi*0089      &       *(atan(-(rF(k)-diffKrBLEQHo)/diffKrBLEQscl)/PI+0.5 _d 0)
e40c34e398 Dimi*0090 #endif
4e66ab0b67 Oliv*0091 #ifdef ALLOW_LONGSTEP
2d5bb917cc Jean*0092         IF ( trIdentity .GE. GAD_TR1) THEN
                0093          DO j = 1-OLy,sNy+OLy
                0094           DO i = 1-OLx,sNx+OLx
4e66ab0b67 Oliv*0095            KappaRTr(i,j,k) =
                0096      &         LS_IVDConvCount(i,j,k,bi,bj)*ivdc_kappa
                0097      &         + KbryanLewis79
                0098 #ifdef ALLOW_BL79_LAT_VARY
                0099      &         + (KbryanLewisEQ-KbryanLewis79)*BL79LatArray(i,j,bi,bj)
                0100 #endif
2d5bb917cc Jean*0101           ENDDO
                0102          ENDDO
                0103         ELSE
4e66ab0b67 Oliv*0104 #else
2d5bb917cc Jean*0105         IF ( .TRUE. ) THEN
4e66ab0b67 Oliv*0106 #endif /* ALLOW_LONGSTEP */
2d5bb917cc Jean*0107          DO j = 1-OLy,sNy+OLy
                0108           DO i = 1-OLx,sNx+OLx
4e66ab0b67 Oliv*0109            KappaRTr(i,j,k) =
8bb967e208 Jean*0110      &         IVDConvCount(i,j,k,bi,bj)*ivdc_kappa
059d9fc14f Dimi*0111      &         + KbryanLewis79
e40c34e398 Dimi*0112 #ifdef ALLOW_BL79_LAT_VARY
059d9fc14f Dimi*0113      &         + (KbryanLewisEQ-KbryanLewis79)*BL79LatArray(i,j,bi,bj)
e40c34e398 Dimi*0114 #endif
2d5bb917cc Jean*0115           ENDDO
8bb967e208 Jean*0116          ENDDO
2d5bb917cc Jean*0117         ENDIF
8bb967e208 Jean*0118        ENDDO
059d9fc14f Dimi*0119        IF ( trIdentity.EQ.GAD_TEMPERATURE ) THEN
                0120         DO k = 1,Nr
d8d1486ca1 Jean*0121          DO j = 1-OLy,sNy+OLy
                0122           DO i = 1-OLx,sNx+OLx
55e9ea8a90 Jean*0123            KappaRTr(i,j,k) = KappaRTr(i,j,k)
f67fb678bc Jean*0124 #ifdef ALLOW_3D_DIFFKR
059d9fc14f Dimi*0125      &          + diffKr(i,j,k,bi,bj)
8bb967e208 Jean*0126 #else
059d9fc14f Dimi*0127      &          + diffKrNrT(k)
8bb967e208 Jean*0128 #endif
059d9fc14f Dimi*0129           ENDDO
                0130          ENDDO
                0131         ENDDO
                0132        ELSEIF ( trIdentity.EQ.GAD_SALINITY) THEN
                0133         DO k = 1,Nr
d8d1486ca1 Jean*0134          DO j = 1-OLy, sNy+OLy
                0135           DO i = 1-OLx, sNx+OLx
059d9fc14f Dimi*0136            KappaRTr(i,j,k) = KappaRTr(i,j,k)
f67fb678bc Jean*0137 #ifdef ALLOW_3D_DIFFKR
059d9fc14f Dimi*0138      &          + diffKr(i,j,k,bi,bj)
                0139 #else
                0140      &          + diffKrNrS(k)
e40c34e398 Dimi*0141 #endif
059d9fc14f Dimi*0142           ENDDO
8bb967e208 Jean*0143          ENDDO
                0144         ENDDO
                0145 #ifdef ALLOW_PTRACERS
4e66ab0b67 Oliv*0146        ELSEIF ( trIdentity.GE.GAD_TR1) THEN
8bb967e208 Jean*0147
059d9fc14f Dimi*0148         iTr = trIdentity - GAD_TR1 + 1
                0149         DO k = 1,Nr
d8d1486ca1 Jean*0150          DO j = 1-OLy, sNy+OLy
                0151           DO i = 1-OLx, sNx+OLx
059d9fc14f Dimi*0152            KappaRTr(i,j,k) = KappaRTr(i,j,k)
f67fb678bc Jean*0153 #ifdef ALLOW_3D_DIFFKR
059d9fc14f Dimi*0154      &          + diffKr(i,j,k,bi,bj)
8bb967e208 Jean*0155 #else
059d9fc14f Dimi*0156      &          + PTRACERS_diffKrNr(k,iTr)
e40c34e398 Dimi*0157 #endif
059d9fc14f Dimi*0158           ENDDO
8bb967e208 Jean*0159          ENDDO
                0160         ENDDO
                0161 #endif /* ALLOW_PTRACERS */
059d9fc14f Dimi*0162        ELSE
8bb967e208 Jean*0163         WRITE(msgBuf,'(A,I4)')
059d9fc14f Dimi*0164      &       ' CALC_3D_DIFFUSIVITY: Invalid tracer Id: ',trIdentity
8bb967e208 Jean*0165         CALL PRINT_ERROR(msgBuf, myThid)
                0166         STOP 'ABNORMAL END: S/R CALC_3D_DIFFUSIVITY'
059d9fc14f Dimi*0167        ENDIF
8bb967e208 Jean*0168       ENDIF
                0169
                0170 C--   Add physical pacakge contributions:
                0171
                0172 #ifdef ALLOW_KPP
                0173       IF (trUseKPP) THEN
a3b5d49db3 Dimi*0174 C--   Set vertical diffusivity contribution from KPP
8bb967e208 Jean*0175        IF (trIdentity.EQ.GAD_TEMPERATURE) THEN
                0176          CALL KPP_CALC_DIFF_T(
a4e4b5f62b Jean*0177      I        bi,bj,iMin,iMax,jMin,jMax,0,Nr,
a3b5d49db3 Dimi*0178      O        KappaRTr,
8bb967e208 Jean*0179      I        myThid)
4e66ab0b67 Oliv*0180        ELSEIF (trIdentity.EQ.GAD_SALINITY) THEN
8bb967e208 Jean*0181          CALL KPP_CALC_DIFF_S(
a4e4b5f62b Jean*0182      I        bi,bj,iMin,iMax,jMin,jMax,0,Nr,
a3b5d49db3 Dimi*0183      O        KappaRTr,
4e66ab0b67 Oliv*0184      I        myThid)
f67fb678bc Jean*0185 #ifdef ALLOW_PTRACERS
4e66ab0b67 Oliv*0186        ELSEIF ( trIdentity.GE.GAD_TR1) THEN
f67fb678bc Jean*0187          iTr = trIdentity - GAD_TR1 + 1
4e66ab0b67 Oliv*0188          CALL KPP_CALC_DIFF_Ptr(
                0189      I        bi,bj,iMin,iMax,jMin,jMax,0,Nr,
                0190      O        KappaRTr,
f67fb678bc Jean*0191      I        iTr, myThid )
                0192 #endif /* ALLOW_PTRACERS */
                0193        ELSE
                0194         WRITE(msgBuf,'(A,I4)')
                0195      &       ' CALC_3D_DIFFUSIVITY: Invalid tracer Id: ',trIdentity
                0196         CALL PRINT_ERROR( msgBuf, myThid )
                0197         STOP 'ABNORMAL END: S/R CALC_3D_DIFFUSIVITY'
059d9fc14f Dimi*0198        ENDIF
                0199       ENDIF
                0200 #endif /* ALLOW_KPP */
                0201
                0202 #ifdef ALLOW_GMREDI
55e9ea8a90 Jean*0203       IF (trUseGMRedi) THEN
059d9fc14f Dimi*0204          CALL GMREDI_CALC_DIFF(
                0205      I        bi,bj,iMin,iMax,jMin,jMax,0,Nr,
                0206      U        KappaRTr,
97eca3c3f0 Davi*0207      I        trIdentity,myThid)
8bb967e208 Jean*0208       ENDIF
                0209 #endif
                0210
                0211 #ifdef ALLOW_PP81
                0212       IF (usePP81) THEN
                0213          CALL PP81_CALC_DIFF(
a4e4b5f62b Jean*0214      I        bi,bj,iMin,iMax,jMin,jMax,0,Nr,
8bb967e208 Jean*0215      U        KappaRTr,
                0216      I        myThid)
                0217       ENDIF
                0218 #endif
                0219
d8d1486ca1 Jean*0220 #ifdef ALLOW_KL10
                0221       IF (useKL10) THEN
                0222          CALL KL10_CALC_DIFF(
                0223      I        bi,bj,iMin,iMax,jMin,jMax,0,Nr,
                0224      U        KappaRTr,
                0225      I        myThid)
                0226       ENDIF
                0227 #endif
                0228
8bb967e208 Jean*0229 #ifdef ALLOW_MY82
                0230       IF (useMY82) THEN
                0231          CALL MY82_CALC_DIFF(
a4e4b5f62b Jean*0232      I        bi,bj,iMin,iMax,jMin,jMax,0,Nr,
8bb967e208 Jean*0233      U        KappaRTr,
                0234      I        myThid)
                0235       ENDIF
                0236 #endif
55e9ea8a90 Jean*0237
8bb967e208 Jean*0238 #ifdef ALLOW_GGL90
                0239       IF (useGGL90) THEN
                0240          CALL GGL90_CALC_DIFF(
a4e4b5f62b Jean*0241      I        bi,bj,iMin,iMax,jMin,jMax,0,Nr,
8bb967e208 Jean*0242      O        KappaRTr,
                0243      I        myThid)
                0244       ENDIF
                0245 #endif
55e9ea8a90 Jean*0246
2d5bb917cc Jean*0247 #ifdef ALLOW_SMAG_3D_DIFFUSIVITY
                0248        IF ( smag3D_diffCoeff.GT.zeroRL ) THEN
                0249         DO k = 2,Nr
                0250          DO j = 1-OLy,sNy+OLy
                0251           DO i = 1-OLx,sNx+OLx
                0252            KappaRTr(i,j,k) = KappaRTr(i,j,k)
                0253      &          + halfRL*( smag3D_diffK(i,j,k-1,bi,bj)
                0254      &                   + smag3D_diffK(i,j, k, bi,bj) )
                0255           ENDDO
                0256          ENDDO
                0257         ENDDO
                0258        ENDIF
                0259 #endif /* ALLOW_SMAG_3D_DIFFUSIVITY */
                0260
2d435b47ac Jean*0261 #ifndef EXCLUDE_PCELL_MIX_CODE
fe1862e69b Mart*0262 # ifdef ALLOW_AUTODIFF_TAMC
                0263 CADJ INIT loctape_3d_diff = COMMON, Nr
7448700841 Mart*0264 CADJ STORE kappartr = loctape_3d_diff
fe1862e69b Mart*0265 # endif
2d435b47ac Jean*0266       IF ( interDiffKr_pCell ) THEN
                0267 C--   This is a hack: alter vertical diffusivity (instead of changing many S/R)
                0268 C     in order to account for missing hFac in diffusion term
                0269        DO k = 2,Nr
                0270          km = k - 1
                0271 C-    account for true distance (including hFac) in vertical gradient
                0272          DO j = 2-OLy, sNy+OLy
                0273           DO i = 2-OLx, sNx+OLx
                0274            IF ( k.GT.kSurfC(i,j,bi,bj) .AND.
                0275      &          k.LE.kLowC(i,j,bi,bj) ) THEN
                0276              KappaRTr(i,j,k) = KappaRTr(i,j,k)
                0277      &                *twoRL/(hFacC(i,j,km,bi,bj)+hFacC(i,j,k,bi,bj))
                0278            ENDIF
                0279           ENDDO
                0280          ENDDO
                0281        ENDDO
                0282       ENDIF
                0283
                0284       IF ( pCellMix_select.GT.0 ) THEN
                0285 C--   This is a hack: alter vertical diffusivity (instead of changing many S/R)
                0286 C     in order to to increase mixing for too thin surface/bottom partial cell
                0287        mixSurf = pCellMix_select/10
                0288        mixBott = MOD(pCellMix_select,10)
                0289        DO k = 2,Nr
                0290          km = k - 1
                0291          pC_kFac = 1.
                0292          IF ( pCellMix_delR.LT.drF(k) )
                0293      &     pC_kFac = pCellMix_delR*recip_drF(k)
                0294
fe1862e69b Mart*0295 # ifdef ALLOW_AUTODIFF
                0296          DO j = 1-OLy, sNy+OLy
                0297           DO i = 1-OLx, sNx+OLx
                0298            tmpFac(i,j) = 0. _d 0
                0299           ENDDO
                0300          ENDDO
                0301 # endif
                0302
2d435b47ac Jean*0303 C-    Increase KappaRTr above bottom level:
                0304          IF ( mixBott.GE.1 ) THEN
                0305           DO j = 2-OLy, sNy+OLy
                0306            DO i = 2-OLx, sNx+OLx
                0307              tmpFac(i,j) = 0. _d 0
                0308              IF ( k.EQ.kLowC(i,j,bi,bj) .AND.
                0309      &            k.GT.kSurfC(i,j,bi,bj) ) THEN
                0310                tmpFac(i,j) = pC_kFac*_recip_hFacC(i,j,k,bi,bj)
                0311              ENDIF
                0312            ENDDO
                0313           ENDDO
7448700841 Mart*0314 # ifdef ALLOW_AUTODIFF_TAMC
                0315 CADJ STORE tmpFac          = loctape_3d_diff, key = k
                0316 # endif
f2a88c9ff8 jm-c 0317           IF ( mixBott.EQ.2 ) THEN
                0318            DO j = 2-OLy, sNy+OLy
                0319             DO i = 2-OLx, sNx+OLx
2d435b47ac Jean*0320              tmpFac(i,j) = tmpFac(i,j)*tmpFac(i,j)
f2a88c9ff8 jm-c 0321             ENDDO
2d435b47ac Jean*0322            ENDDO
f2a88c9ff8 jm-c 0323           ELSEIF ( mixBott.EQ.3 ) THEN
                0324            DO j = 2-OLy, sNy+OLy
                0325             DO i = 2-OLx, sNx+OLx
2d435b47ac Jean*0326              tmpFac(i,j) = tmpFac(i,j)*tmpFac(i,j)*tmpFac(i,j)
f2a88c9ff8 jm-c 0327             ENDDO
2d435b47ac Jean*0328            ENDDO
f2a88c9ff8 jm-c 0329           ELSEIF ( mixBott.EQ.4 ) THEN
                0330            DO j = 2-OLy, sNy+OLy
                0331             DO i = 2-OLx, sNx+OLx
2d435b47ac Jean*0332              tmpFac(i,j) = tmpFac(i,j)*tmpFac(i,j)
                0333      &                   * tmpFac(i,j)*tmpFac(i,j)
f2a88c9ff8 jm-c 0334             ENDDO
2d435b47ac Jean*0335            ENDDO
f2a88c9ff8 jm-c 0336           ENDIF
2d435b47ac Jean*0337 C-    increase mixing above bottom (by ~(1/hFac)^mixBott) if too thin p-cell
                0338           DO j = 2-OLy, sNy+OLy
                0339            DO i = 2-OLx, sNx+OLx
                0340              tmpFac(i,j) = MIN( tmpFac(i,j), pCellMix_maxFac )
fe1862e69b Mart*0341 # ifdef ALLOW_AUTODIFF_TAMC
                0342            ENDDO
                0343           ENDDO
                0344 CADJ STORE tmpFac          = loctape_3d_diff, key = k
                0345 CADJ STORE kappartr(:,:,k) = loctape_3d_diff, key = k
                0346           DO j = 2-OLy, sNy+OLy
                0347            DO i = 2-OLx, sNx+OLx
                0348 # endif
2d435b47ac Jean*0349              KappaRTr(i,j,k) = MAX( KappaRTr(i,j,k),
                0350      &                              pCellMix_diffKr(k)*tmpFac(i,j) )
                0351            ENDDO
                0352           ENDDO
                0353          ENDIF
                0354
                0355          pC_kFac = 1.
                0356          IF ( pCellMix_delR.LT.drF(km) )
                0357      &     pC_kFac = pCellMix_delR*recip_drF(km)
                0358
                0359 C-    Increase KappaRTr below surface level:
                0360          IF ( mixSurf.GE.1 ) THEN
                0361           DO j = 2-OLy, sNy+OLy
                0362            DO i = 2-OLx, sNx+OLx
                0363              tmpFac(i,j) = 0. _d 0
                0364              IF ( km.EQ.kSurfC(i,j,bi,bj) .AND.
                0365      &            km.LT.kLowC(i,j,bi,bj) ) THEN
d1b9d34933 Jean*0366                tmpFac(i,j) = pC_kFac*_recip_hFacC(i,j,km,bi,bj)
2d435b47ac Jean*0367              ENDIF
                0368            ENDDO
                0369           ENDDO
7448700841 Mart*0370 # ifdef ALLOW_AUTODIFF_TAMC
                0371 CADJ STORE tmpFac          = loctape_3d_diff, key = k
                0372 # endif
f2a88c9ff8 jm-c 0373           IF ( mixSurf.EQ.2 ) THEN
                0374            DO j = 2-OLy, sNy+OLy
                0375             DO i = 2-OLx, sNx+OLx
2d435b47ac Jean*0376              tmpFac(i,j) = tmpFac(i,j)*tmpFac(i,j)
f2a88c9ff8 jm-c 0377             ENDDO
2d435b47ac Jean*0378            ENDDO
f2a88c9ff8 jm-c 0379           ELSEIF ( mixSurf.EQ.3 ) THEN
                0380            DO j = 2-OLy, sNy+OLy
                0381             DO i = 2-OLx, sNx+OLx
2d435b47ac Jean*0382              tmpFac(i,j) = tmpFac(i,j)*tmpFac(i,j)*tmpFac(i,j)
f2a88c9ff8 jm-c 0383             ENDDO
2d435b47ac Jean*0384            ENDDO
f2a88c9ff8 jm-c 0385           ELSEIF ( mixSurf.EQ.4 ) THEN
                0386            DO j = 2-OLy, sNy+OLy
                0387             DO i = 2-OLx, sNx+OLx
2d435b47ac Jean*0388              tmpFac(i,j) = tmpFac(i,j)*tmpFac(i,j)
                0389      &                   * tmpFac(i,j)*tmpFac(i,j)
f2a88c9ff8 jm-c 0390             ENDDO
2d435b47ac Jean*0391            ENDDO
f2a88c9ff8 jm-c 0392           ENDIF
2d435b47ac Jean*0393 C-    increase mixing below surface (by ~(1/hFac)^mixSurf) if too thin p-cell
                0394           DO j = 2-OLy, sNy+OLy
                0395            DO i = 2-OLx, sNx+OLx
                0396              tmpFac(i,j) = MIN( tmpFac(i,j), pCellMix_maxFac )
fe1862e69b Mart*0397 # ifdef ALLOW_AUTODIFF_TAMC
                0398            ENDDO
                0399           ENDDO
                0400 CADJ STORE tmpFac          = loctape_3d_diff, key = k
                0401 CADJ STORE kappartr(:,:,k) = loctape_3d_diff, key = k
                0402           DO j = 2-OLy, sNy+OLy
                0403            DO i = 2-OLx, sNx+OLx
                0404 # endif
2d435b47ac Jean*0405              KappaRTr(i,j,k) = MAX( KappaRTr(i,j,k),
                0406      &                              pCellMix_diffKr(k)*tmpFac(i,j) )
                0407            ENDDO
                0408           ENDDO
                0409          ENDIF
                0410
                0411 C--   end of k loop
                0412        ENDDO
                0413       ENDIF
                0414 #endif /* ndef EXCLUDE_PCELL_MIX_CODE */
                0415
55e9ea8a90 Jean*0416 C-    Apply mask to vertical diffusivity
ff02675122 Jean*0417 C jmc: do not have the impression that masking is needed
                0418 C      but could be removed later if it is the case.
d8d1486ca1 Jean*0419 c     DO j = 1-OLy, sNy+OLy
                0420 c      DO i = 1-OLx, sNx+OLx
8bb967e208 Jean*0421 c       KappaRTr(i,j,k) = maskUp(i,j)*KappaRTr(i,j,k)
                0422 c      ENDDO
                0423 c     ENDDO
                0424
3ff07dd7e9 Jean*0425 #endif /* ALLOW_GENERIC_ADVDIFF */
                0426
8bb967e208 Jean*0427       RETURN
                0428       END