** Warning **

Issuing rollback() due to DESTROY without explicit disconnect() of DBD::mysql::db handle dbname=MITgcm at /usr/local/share/lxr/lib/LXR/Common.pm line 1224.

Last-Modified: Tue, 20 May 2024 05:11:26 GMT Content-Type: text/html; charset=utf-8 MITgcm/MITgcm/model/src/convective_adjustment_ini.F
Back to home page

MITgcm
 
 

    

File indexing completed on 2023-05-28 05:09:48 UTC

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