/[MITgcm]/MITgcm/model/src/thermodynamics.F
ViewVC logotype

Diff of /MITgcm/model/src/thermodynamics.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.34 by heimbach, Fri Jan 10 19:06:05 2003 UTC revision 1.43 by heimbach, Tue Jul 8 15:00:26 2003 UTC
# Line 9  C $Name$ Line 9  C $Name$
9  # ifdef ALLOW_KPP  # ifdef ALLOW_KPP
10  #  include "KPP_OPTIONS.h"  #  include "KPP_OPTIONS.h"
11  # endif  # endif
12  cswdice --- add ----  # ifdef ALLOW_PTRACERS
13  #ifdef ALLOW_THERM_SEAICE  #  include "PTRACERS_OPTIONS.h"
14  #include "ICE.h"  # endif
 #endif  
 cswdice ------  
15  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
16    
17  CBOP  CBOP
# Line 84  C     == Global variables === Line 82  C     == Global variables ===
82  #ifdef ALLOW_PASSIVE_TRACER  #ifdef ALLOW_PASSIVE_TRACER
83  #include "TR1.h"  #include "TR1.h"
84  #endif  #endif
85    #ifdef ALLOW_TIMEAVE
86    #include "TIMEAVE_STATV.h"
87    #endif
88    
89  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
90  # include "tamc.h"  # include "tamc.h"
91  # include "tamc_keys.h"  # include "tamc_keys.h"
# Line 95  C     == Global variables === Line 97  C     == Global variables ===
97  # ifdef ALLOW_GMREDI  # ifdef ALLOW_GMREDI
98  #  include "GMREDI.h"  #  include "GMREDI.h"
99  # endif  # endif
100    # ifdef ALLOW_PTRACERS
101    #  include "PTRACERS.h"
102    # endif
103    cswdice --- add ----
104    # ifdef ALLOW_THERM_SEAICE
105    #  include "ICE.h"
106    # endif
107    cswdice ------
108  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
 #ifdef ALLOW_TIMEAVE  
 #include "TIMEAVE_STATV.h"  
 #endif  
109    
110  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
111  C     == Routine arguments ==  C     == Routine arguments ==
# Line 123  C                                      i Line 130  C                                      i
130  C                                      so we need an fVer for each  C                                      so we need an fVer for each
131  C                                      variable.  C                                      variable.
132  C     rhoK, rhoKM1   - Density at current level, and level above  C     rhoK, rhoKM1   - Density at current level, and level above
 C     phiHyd         - Hydrostatic part of the potential phiHydi.  
 C                      In z coords phiHydiHyd is the hydrostatic  
 C                      Potential (=pressure/rho0) anomaly  
 C                      In p coords phiHydiHyd is the geopotential  
 C                      surface height anomaly.  
133  C     phiSurfX, - gradient of Surface potentiel (Pressure/rho, ocean)  C     phiSurfX, - gradient of Surface potentiel (Pressure/rho, ocean)
134  C     phiSurfY             or geopotentiel (atmos) in X and Y direction  C     phiSurfY             or geopotentiel (atmos) in X and Y direction
135  C     KappaRT,       - Total diffusion in vertical for T and S.  C     KappaRT,       - Total diffusion in vertical for T and S.
136  C     KappaRS          (background + spatially varying, isopycnal term).  C     KappaRS          (background + spatially varying, isopycnal term).
137    C     useVariableK   = T when vertical diffusion is not constant
138  C     iMin, iMax     - Ranges and sub-block indices on which calculations  C     iMin, iMax     - Ranges and sub-block indices on which calculations
139  C     jMin, jMax       are applied.  C     jMin, jMax       are applied.
140  C     bi, bj  C     bi, bj
# Line 147  C                      index into fVerTe Line 150  C                      index into fVerTe
150        _RL fVerT   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)        _RL fVerT   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
151        _RL fVerS   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)        _RL fVerS   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
152        _RL fVerTr1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)        _RL fVerTr1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
       _RL phiHyd  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)  
153        _RL rhokm1  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL rhokm1  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
154        _RL rhok    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL rhok    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
155        _RL phiSurfX(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL phiSurfX(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
# Line 159  C                      index into fVerTe Line 161  C                      index into fVerTe
161        _RL sigmaR  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL sigmaR  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
162  C     This is currently used by IVDC and Diagnostics  C     This is currently used by IVDC and Diagnostics
163        _RL ConvectCount (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL ConvectCount (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
164          LOGICAL useVariableK
165        INTEGER iMin, iMax        INTEGER iMin, iMax
166        INTEGER jMin, jMax        INTEGER jMin, jMax
167        INTEGER bi, bj        INTEGER bi, bj
168        INTEGER i, j        INTEGER i, j
169        INTEGER k, km1, kup, kDown        INTEGER k, km1, kup, kDown
170          INTEGER iTracer
171    
172  CEOP  CEOP
173    
174    #ifndef DISABLE_DEBUGMODE
175             IF ( debugLevel .GE. debLevB )
176         &    CALL DEBUG_ENTER('FORWARD_STEP',myThid)
177    #endif
178    
179  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
180  C--   dummy statement to end declaration part  C--   dummy statement to end declaration part
# Line 173  C--   dummy statement to end declaration Line 182  C--   dummy statement to end declaration
182        itdkey = 1        itdkey = 1
183  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
184    
 C--   Set up work arrays with valid (i.e. not NaN) values  
 C     These inital values do not alter the numerical results. They  
 C     just ensure that all memory references are to valid floating  
 C     point numbers. This prevents spurious hardware signals due to  
 C     uninitialised but inert locations.  
       DO j=1-OLy,sNy+OLy  
        DO i=1-OLx,sNx+OLx  
         xA(i,j)      = 0. _d 0  
         yA(i,j)      = 0. _d 0  
         uTrans(i,j)  = 0. _d 0  
         vTrans(i,j)  = 0. _d 0  
         rhok   (i,j) = 0. _d 0  
         phiSurfX(i,j) = 0. _d 0  
         phiSurfY(i,j) = 0. _d 0  
        ENDDO  
       ENDDO  
   
   
185  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
186  C--   HPF directive to help TAMC  C--   HPF directive to help TAMC
187  CHPF$ INDEPENDENT  CHPF$ INDEPENDENT
# Line 201  CHPF$ INDEPENDENT Line 192  CHPF$ INDEPENDENT
192  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
193  C--    HPF directive to help TAMC  C--    HPF directive to help TAMC
194  CHPF$  INDEPENDENT, NEW (rTrans,fVerT,fVerS  CHPF$  INDEPENDENT, NEW (rTrans,fVerT,fVerS
195  CHPF$&                  ,phiHyd,utrans,vtrans,xA,yA  CHPF$&                  ,utrans,vtrans,xA,yA
196  CHPF$&                  ,KappaRT,KappaRS  CHPF$&                  ,KappaRT,KappaRS
197  CHPF$&                  )  CHPF$&                  )
198  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
# Line 221  CHPF$&                  ) Line 212  CHPF$&                  )
212       &                      + act4*max1*max2*max3       &                      + act4*max1*max2*max3
213  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
214    
215  C--     Set up work arrays that need valid initial values  C--   Set up work arrays with valid (i.e. not NaN) values
216    C     These inital values do not alter the numerical results. They
217    C     just ensure that all memory references are to valid floating
218    C     point numbers. This prevents spurious hardware signals due to
219    C     uninitialised but inert locations.
220    
221          DO j=1-OLy,sNy+OLy          DO j=1-OLy,sNy+OLy
222           DO i=1-OLx,sNx+OLx           DO i=1-OLx,sNx+OLx
223              xA(i,j)        = 0. _d 0
224              yA(i,j)        = 0. _d 0
225              uTrans(i,j)    = 0. _d 0
226              vTrans(i,j)    = 0. _d 0
227              rhok   (i,j)   = 0. _d 0
228              rhoKM1 (i,j)   = 0. _d 0
229              phiSurfX(i,j)  = 0. _d 0
230              phiSurfY(i,j)  = 0. _d 0
231            rTrans (i,j)   = 0. _d 0            rTrans (i,j)   = 0. _d 0
232            fVerT  (i,j,1) = 0. _d 0            fVerT  (i,j,1) = 0. _d 0
233            fVerT  (i,j,2) = 0. _d 0            fVerT  (i,j,2) = 0. _d 0
# Line 231  C--     Set up work arrays that need val Line 235  C--     Set up work arrays that need val
235            fVerS  (i,j,2) = 0. _d 0            fVerS  (i,j,2) = 0. _d 0
236            fVerTr1(i,j,1) = 0. _d 0            fVerTr1(i,j,1) = 0. _d 0
237            fVerTr1(i,j,2) = 0. _d 0            fVerTr1(i,j,2) = 0. _d 0
           rhoKM1 (i,j)   = 0. _d 0  
238           ENDDO           ENDDO
239          ENDDO          ENDDO
240    
# Line 239  C--     Set up work arrays that need val Line 242  C--     Set up work arrays that need val
242           DO j=1-OLy,sNy+OLy           DO j=1-OLy,sNy+OLy
243            DO i=1-OLx,sNx+OLx            DO i=1-OLx,sNx+OLx
244  C This is currently also used by IVDC and Diagnostics  C This is currently also used by IVDC and Diagnostics
            phiHyd(i,j,k) = 0. _d 0  
245             sigmaX(i,j,k) = 0. _d 0             sigmaX(i,j,k) = 0. _d 0
246             sigmaY(i,j,k) = 0. _d 0             sigmaY(i,j,k) = 0. _d 0
247             sigmaR(i,j,k) = 0. _d 0             sigmaR(i,j,k) = 0. _d 0
# Line 254  cph although some of these are re-initia Line 256  cph although some of these are re-initia
256  # ifdef ALLOW_PASSIVE_TRACER  # ifdef ALLOW_PASSIVE_TRACER
257             gTr1(i,j,k,bi,bj) = 0. _d 0             gTr1(i,j,k,bi,bj) = 0. _d 0
258  # endif  # endif
259    # ifdef ALLOW_PTRACERS
260               DO iTracer=1,PTRACERS_numInUse
261                gPTr(i,j,k,bi,bj,itracer) = 0. _d 0
262               ENDDO
263    # endif
264  # ifdef ALLOW_GMREDI  # ifdef ALLOW_GMREDI
265             Kwx(i,j,k,bi,bj)  = 0. _d 0             Kwx(i,j,k,bi,bj)  = 0. _d 0
266             Kwy(i,j,k,bi,bj)  = 0. _d 0             Kwy(i,j,k,bi,bj)  = 0. _d 0
# Line 270  cph although some of these are re-initia Line 277  cph although some of these are re-initia
277             GM_PsiX(i,j,k,bi,bj)  = 0. _d 0             GM_PsiX(i,j,k,bi,bj)  = 0. _d 0
278             GM_PsiY(i,j,k,bi,bj)  = 0. _d 0             GM_PsiY(i,j,k,bi,bj)  = 0. _d 0
279  #  endif  #  endif
280    #  ifdef GM_VISBECK_VARIABLE_K
281               VisbeckK(i,j,bi,bj)   = 0. _d 0
282    #  endif
283  # endif /* ALLOW_GMREDI */  # endif /* ALLOW_GMREDI */
284  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
285            ENDDO            ENDDO
# Line 281  cph although some of these are re-initia Line 291  cph although some of these are re-initia
291          jMin = 1-OLy          jMin = 1-OLy
292          jMax = sNy+OLy          jMax = sNy+OLy
293    
   
294  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
295  CADJ STORE theta(:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte  CADJ STORE theta(:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
296  CADJ STORE salt (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte  CADJ STORE salt (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
297    CADJ STORE totphihyd
298    CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte
299  #ifdef ALLOW_KPP  #ifdef ALLOW_KPP
300  CADJ STORE uvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte  CADJ STORE uvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
301  CADJ STORE vvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte  CADJ STORE vvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
302  #endif  #endif
303  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
304    
305    #ifndef DISABLE_DEBUGMODE
306            IF ( debugLevel .GE. debLevB )
307         &    CALL DEBUG_MSG('ENTERING UPWARD K LOOP',myThid)
308    #endif
309    
310  C--     Start of diagnostic loop  C--     Start of diagnostic loop
311          DO k=Nr,1,-1          DO k=Nr,1,-1
312    
# Line 325  C--       Calculate gradients of potenti Line 341  C--       Calculate gradients of potenti
341  C         slope terms (e.g. GM/Redi tensor or IVDC diffusivity)  C         slope terms (e.g. GM/Redi tensor or IVDC diffusivity)
342  c         IF ( k.GT.1 .AND. (useGMRedi.OR.ivdc_kappa.NE.0.) ) THEN  c         IF ( k.GT.1 .AND. (useGMRedi.OR.ivdc_kappa.NE.0.) ) THEN
343            IF ( useGMRedi .OR. (k.GT.1 .AND. ivdc_kappa.NE.0.) ) THEN            IF ( useGMRedi .OR. (k.GT.1 .AND. ivdc_kappa.NE.0.) ) THEN
344    #ifndef DISABLE_DEBUGMODE
345                IF ( debugLevel .GE. debLevB )
346         &       CALL DEBUG_CALL('FIND_RHO',myThid)
347    #endif
348  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
349  CADJ STORE theta(:,:,k,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE theta(:,:,k,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte
350  CADJ STORE salt (:,:,k,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE salt (:,:,k,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte
 CADJ STORE pressure(:,:,k,bi,bj) =  
 CADJ &     comlev1_bibj_k, key=kkey, byte=isbyte  
351  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
352              CALL FIND_RHO(              CALL FIND_RHO(
353       I        bi, bj, iMin, iMax, jMin, jMax, k, k,       I        bi, bj, iMin, iMax, jMin, jMax, k, k,
# Line 341  CADJ &     comlev1_bibj_k, key=kkey, byt Line 359  CADJ &     comlev1_bibj_k, key=kkey, byt
359  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
360  CADJ STORE theta(:,:,k-1,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE theta(:,:,k-1,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte
361  CADJ STORE salt (:,:,k-1,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE salt (:,:,k-1,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte
 CADJ STORE pressure(:,:,k-1,bi,bj) =  
 CADJ &     comlev1_bibj_k, key=kkey, byte=isbyte  
362  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
363               CALL FIND_RHO(               CALL FIND_RHO(
364       I        bi, bj, iMin, iMax, jMin, jMax, k-1, k,       I        bi, bj, iMin, iMax, jMin, jMax, k-1, k,
# Line 350  CADJ &     comlev1_bibj_k, key=kkey, byt Line 366  CADJ &     comlev1_bibj_k, key=kkey, byt
366       O        rhoKm1,       O        rhoKm1,
367       I        myThid )       I        myThid )
368              ENDIF              ENDIF
369    #ifndef DISABLE_DEBUGMODE
370                IF ( debugLevel .GE. debLevB )
371         &       CALL DEBUG_CALL('GRAD_SIGMA',myThid)
372    #endif
373              CALL GRAD_SIGMA(              CALL GRAD_SIGMA(
374       I             bi, bj, iMin, iMax, jMin, jMax, k,       I             bi, bj, iMin, iMax, jMin, jMax, k,
375       I             rhoK, rhoKm1, rhoK,       I             rhoK, rhoKm1, rhoK,
# Line 364  CADJ STORE rhokm1 (:,:) = comlev1_bibj_k Line 384  CADJ STORE rhokm1 (:,:) = comlev1_bibj_k
384  C--       Implicit Vertical Diffusion for Convection  C--       Implicit Vertical Diffusion for Convection
385  c ==> should use sigmaR !!!  c ==> should use sigmaR !!!
386            IF (k.GT.1 .AND. ivdc_kappa.NE.0.) THEN            IF (k.GT.1 .AND. ivdc_kappa.NE.0.) THEN
387    #ifndef DISABLE_DEBUGMODE
388                IF ( debugLevel .GE. debLevB )
389         &       CALL DEBUG_CALL('CALC_IVDC',myThid)
390    #endif
391              CALL CALC_IVDC(              CALL CALC_IVDC(
392       I        bi, bj, iMin, iMax, jMin, jMax, k,       I        bi, bj, iMin, iMax, jMin, jMax, k,
393       I        rhoKm1, rhoK,       I        rhoKm1, rhoK,
# Line 379  C--     end of diagnostic k loop (Nr:1) Line 403  C--     end of diagnostic k loop (Nr:1)
403  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
404  cph avoids recomputation of integrate_for_w  cph avoids recomputation of integrate_for_w
405  CADJ STORE wvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte  CADJ STORE wvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
 CADJ STORE pressure (:,:,:,bi,bj) =  
 CADJ &     comlev1_bibj, key=itdkey, byte=isbyte  
406  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
407    
408  #ifdef  ALLOW_OBCS  #ifdef  ALLOW_OBCS
409  C--     Calculate future values on open boundaries  C--     Calculate future values on open boundaries
410          IF (useOBCS) THEN          IF (useOBCS) THEN
411    #ifndef DISABLE_DEBUGMODE
412              IF ( debugLevel .GE. debLevB )
413         &     CALL DEBUG_CALL('OBCS_CALC',myThid)
414    #endif
415            CALL OBCS_CALC( bi, bj, myTime+deltaT, myIter+1,            CALL OBCS_CALC( bi, bj, myTime+deltaT, myIter+1,
416       I            uVel, vVel, wVel, theta, salt,       I            uVel, vVel, wVel, theta, salt,
417       I            myThid )       I            myThid )
# Line 396  C--     Calculate future values on open Line 422  C--     Calculate future values on open
422  c********************************************  c********************************************
423  cswdice --- add ---  cswdice --- add ---
424  #ifdef ALLOW_THERM_SEAICE  #ifdef ALLOW_THERM_SEAICE
425    #ifndef DISABLE_DEBUGMODE
426            IF ( debugLevel .GE. debLevB )
427         &    CALL DEBUG_CALL('ICE_FORCING',myThid)
428    #endif
429  C--     Determines forcing terms based on external fields  C--     Determines forcing terms based on external fields
430  c--     including effects from ice  c--     including effects from ice
431          CALL ICE_FORCING(          CALL ICE_FORCING(
# Line 407  cswdice --- end add --- Line 437  cswdice --- end add ---
437    
438  C--     Determines forcing terms based on external fields  C--     Determines forcing terms based on external fields
439  C       relaxation terms, etc.  C       relaxation terms, etc.
440    #ifndef DISABLE_DEBUGMODE
441            IF ( debugLevel .GE. debLevB )
442         &    CALL DEBUG_CALL('EXTERNAL_FORCING_SURF',myThid)
443    #endif
444          CALL EXTERNAL_FORCING_SURF(          CALL EXTERNAL_FORCING_SURF(
445       I             bi, bj, iMin, iMax, jMin, jMax,       I             bi, bj, iMin, iMax, jMin, jMax,
446       I             myThid )       I             myThid )
# Line 444  CADJ STORE sigmaX(:,:,:)        = comlev Line 478  CADJ STORE sigmaX(:,:,:)        = comlev
478  CADJ STORE sigmaY(:,:,:)        = comlev1_bibj, key=itdkey, byte=isbyte  CADJ STORE sigmaY(:,:,:)        = comlev1_bibj, key=itdkey, byte=isbyte
479  CADJ STORE sigmaR(:,:,:)        = comlev1_bibj, key=itdkey, byte=isbyte  CADJ STORE sigmaR(:,:,:)        = comlev1_bibj, key=itdkey, byte=isbyte
480  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
481    
482  C--     Calculate iso-neutral slopes for the GM/Redi parameterisation  C--     Calculate iso-neutral slopes for the GM/Redi parameterisation
483          IF (useGMRedi) THEN          IF (useGMRedi) THEN
484    #ifndef DISABLE_DEBUGMODE
485              IF ( debugLevel .GE. debLevB )
486         &     CALL DEBUG_CALL('GMREDI_CALC_TENSOR',myThid)
487    #endif
488            CALL GMREDI_CALC_TENSOR(            CALL GMREDI_CALC_TENSOR(
489       I             bi, bj, iMin, iMax, jMin, jMax,       I             bi, bj, iMin, iMax, jMin, jMax,
490       I             sigmaX, sigmaY, sigmaR,       I             sigmaX, sigmaY, sigmaR,
# Line 470  CADJ STORE Kwz(:,:,:,bi,bj)   = comlev1_ Line 509  CADJ STORE Kwz(:,:,:,bi,bj)   = comlev1_
509  #ifdef  ALLOW_KPP  #ifdef  ALLOW_KPP
510  C--     Compute KPP mixing coefficients  C--     Compute KPP mixing coefficients
511          IF (useKPP) THEN          IF (useKPP) THEN
512    #ifndef DISABLE_DEBUGMODE
513              IF ( debugLevel .GE. debLevB )
514         &     CALL DEBUG_CALL('KPP_CALC',myThid)
515    #endif
516            CALL KPP_CALC(            CALL KPP_CALC(
517       I                  bi, bj, myTime, myThid )       I                  bi, bj, myTime, myThid )
518  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
# Line 499  CADJ STORE vvel (:,:,:,bi,bj) = comlev1_ Line 542  CADJ STORE vvel (:,:,:,bi,bj) = comlev1_
542  #ifdef ALLOW_PASSIVE_TRACER  #ifdef ALLOW_PASSIVE_TRACER
543  CADJ STORE tr1  (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte  CADJ STORE tr1  (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
544  #endif  #endif
545    #ifdef ALLOW_PTRACERS
546    cph-- moved to forward_step to avoid key computation
547    cphCADJ STORE ptracer(:,:,:,bi,bj,itracer) = comlev1_bibj,
548    cphCADJ &                              key=itdkey, byte=isbyte
549    #endif
550  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
551    
552  #ifdef ALLOW_AIM  #ifdef ALLOW_AIM
553  C       AIM - atmospheric intermediate model, physics package code.  C       AIM - atmospheric intermediate model, physics package code.
554          IF ( useAIM ) THEN          IF ( useAIM ) THEN
555    #ifndef DISABLE_DEBUGMODE
556              IF ( debugLevel .GE. debLevB )
557         &     CALL DEBUG_CALL('AIM_DO_PHYSICS',myThid)
558    #endif
559           CALL TIMER_START('AIM_DO_PHYSICS   [THERMODYNAMICS]', myThid)           CALL TIMER_START('AIM_DO_PHYSICS   [THERMODYNAMICS]', myThid)
560           CALL AIM_DO_PHYSICS( bi, bj, myTime, myIter, myThid )           CALL AIM_DO_PHYSICS( bi, bj, myTime, myIter, myThid )
561           CALL TIMER_STOP( 'AIM_DO_PHYSICS   [THERMODYNAMICS]', myThid)           CALL TIMER_STOP( 'AIM_DO_PHYSICS   [THERMODYNAMICS]', myThid)
562          ENDIF          ENDIF
563  #endif /* ALLOW_AIM */  #endif /* ALLOW_AIM */
564    
 #ifdef ALLOW_TIMEAVE  
         IF (taveFreq.GT.0. .AND. ivdc_kappa.NE.0.) THEN  
           CALL TIMEAVE_CUMULATE(ConvectCountTave, ConvectCount, Nr,  
      I                               deltaTclock, bi, bj, myThid)  
         ENDIF  
 #endif /* ALLOW_TIMEAVE */  
   
565  #ifndef DISABLE_MULTIDIM_ADVECTION  #ifndef DISABLE_MULTIDIM_ADVECTION
566  C--     Some advection schemes are better calculated using a multi-dimensional  C--     Some advection schemes are better calculated using a multi-dimensional
567  C       method in the absence of any other terms and, if used, is done here.  C       method in the absence of any other terms and, if used, is done here.
# Line 529  C recomputation. It *is* differentiable, Line 574  C recomputation. It *is* differentiable,
574  C Edit GAD_OPTIONS.h and #define DISABLE_MULTIDIM_ADVECTION to  C Edit GAD_OPTIONS.h and #define DISABLE_MULTIDIM_ADVECTION to
575  C disable this section of code.  C disable this section of code.
576          IF (tempMultiDimAdvec) THEN          IF (tempMultiDimAdvec) THEN
577    #ifndef DISABLE_DEBUGMODE
578              IF ( debugLevel .GE. debLevB )
579         &     CALL DEBUG_CALL('GAD_ADVECTION',myThid)
580    #endif
581            CALL GAD_ADVECTION(bi,bj,tempAdvScheme,GAD_TEMPERATURE,            CALL GAD_ADVECTION(bi,bj,tempAdvScheme,GAD_TEMPERATURE,
582       U                      theta,gT,       U                      theta,gT,
583       I                      myTime,myIter,myThid)       I                      myTime,myIter,myThid)
584          ENDIF          ENDIF
585          IF (saltMultiDimAdvec) THEN          IF (saltMultiDimAdvec) THEN
586    #ifndef DISABLE_DEBUGMODE
587              IF ( debugLevel .GE. debLevB )
588         &     CALL DEBUG_CALL('GAD_ADVECTION',myThid)
589    #endif
590            CALL GAD_ADVECTION(bi,bj,saltAdvScheme,GAD_SALINITY,            CALL GAD_ADVECTION(bi,bj,saltAdvScheme,GAD_SALINITY,
591       U                      salt,gS,       U                      salt,gS,
592       I                      myTime,myIter,myThid)       I                      myTime,myIter,myThid)
# Line 543  C call the multi-dimensional method for Line 596  C call the multi-dimensional method for
596  C of whether multiDimAdvection is set or not.  C of whether multiDimAdvection is set or not.
597  #ifdef ALLOW_PTRACERS  #ifdef ALLOW_PTRACERS
598          IF ( usePTRACERS ) THEN          IF ( usePTRACERS ) THEN
599    #ifndef DISABLE_DEBUGMODE
600              IF ( debugLevel .GE. debLevB )
601         &     CALL DEBUG_CALL('PTRACERS_ADVECTION',myThid)
602    #endif
603           CALL PTRACERS_ADVECTION( bi,bj,myIter,myTime,myThid )           CALL PTRACERS_ADVECTION( bi,bj,myIter,myTime,myThid )
604          ENDIF          ENDIF
605  #endif /* ALLOW_PTRACERS */  #endif /* ALLOW_PTRACERS */
606  #endif /* DISABLE_MULTIDIM_ADVECTION */  #endif /* DISABLE_MULTIDIM_ADVECTION */
607    
608    #ifndef DISABLE_DEBUGMODE
609           IF ( debugLevel .GE. debLevB )
610         &    CALL DEBUG_MSG('ENTERING DOWNWARD K LOOP',myThid)
611    #endif
612    
613  C--     Start of thermodynamics loop  C--     Start of thermodynamics loop
614          DO k=Nr,1,-1          DO k=Nr,1,-1
615  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
# Line 577  C--       Get temporary terms used by te Line 639  C--       Get temporary terms used by te
639       I         myThid)       I         myThid)
640    
641  #ifdef ALLOW_GMREDI  #ifdef ALLOW_GMREDI
642    
643  C--   Residual transp = Bolus transp + Eulerian transp  C--   Residual transp = Bolus transp + Eulerian transp
644            IF (useGMRedi) THEN            IF (useGMRedi) THEN
645              CALL GMREDI_CALC_UVFLOW(              CALL GMREDI_CALC_UVFLOW(
# Line 584  C--   Residual transp = Bolus transp + E Line 647  C--   Residual transp = Bolus transp + E
647              IF (K.GE.2) CALL GMREDI_CALC_WFLOW(              IF (K.GE.2) CALL GMREDI_CALC_WFLOW(
648       &                    rTrans, bi, bj, k, myThid)       &                    rTrans, bi, bj, k, myThid)
649            ENDIF            ENDIF
650    
651    #ifdef ALLOW_AUTODIFF_TAMC
652    #ifdef GM_BOLUS_ADVEC
653    CADJ STORE uTrans(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
654    CADJ STORE vTrans(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
655    CADJ STORE rTrans(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
656    #endif
657    #endif /* ALLOW_AUTODIFF_TAMC */
658    
659  #endif /* ALLOW_GMREDI */  #endif /* ALLOW_GMREDI */
660    
661  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
# Line 654  cswdice -- end add --- Line 726  cswdice -- end add ---
726  #endif  #endif
727  #ifdef ALLOW_PTRACERS  #ifdef ALLOW_PTRACERS
728           IF ( usePTRACERS ) THEN           IF ( usePTRACERS ) THEN
729             CALL PTRACERS_INTEGERATE(             CALL PTRACERS_INTEGRATE(
730       I         bi,bj,k,       I         bi,bj,k,
731       I         xA,yA,uTrans,vTrans,rTrans,maskUp,       I         xA,yA,uTrans,vTrans,rTrans,maskUp,
732       X         KappaRS,       X         KappaRS,
# Line 748  C--      Apply open boundary conditions Line 820  C--      Apply open boundary conditions
820  C--     End If implicitDiffusion  C--     End If implicitDiffusion
821          ENDIF          ENDIF
822    
823    #ifdef ALLOW_TIMEAVE
824            IF (taveFreq.GT.0. .AND. ivdc_kappa.NE.0.) THEN
825              CALL TIMEAVE_CUMUL_1T(ConvectCountTave, ConvectCount,
826         I                           Nr, deltaTclock, bi, bj, myThid)
827            ENDIF
828            useVariableK = useKPP .OR. useGMredi .OR. ivdc_kappa.NE.0.
829            IF (taveFreq.GT.0. .AND. useVariableK ) THEN
830             IF (implicitDiffusion) THEN
831              CALL TIMEAVE_CUMUL_DIF_1T(TdiffRtave, gT, kappaRT,
832         I                        Nr, 3, deltaTclock, bi, bj, myThid)
833             ELSE
834              CALL TIMEAVE_CUMUL_DIF_1T(TdiffRtave, theta, kappaRT,
835         I                        Nr, 3, deltaTclock, bi, bj, myThid)
836             ENDIF
837            ENDIF
838    #endif /* ALLOW_TIMEAVE */
839    
840  #endif /* SINGLE_LAYER_MODE */  #endif /* SINGLE_LAYER_MODE */
841    
842  Ccs-  C--   end bi,bj loops.
843         ENDDO         ENDDO
844        ENDDO        ENDDO
845    
 #ifdef ALLOW_AIM  
 c     IF ( useAIM ) THEN  
 c      CALL AIM_AIM2DYN_EXCHANGES( myTime, myThid )  
 c     ENDIF  
 #endif /* ALLOW_AIM */  
 c     IF ( staggerTimeStep ) THEN  
 c      IF ( useAIM .OR. useCubedSphereExchange ) THEN  
 c        IF (tempStepping) _EXCH_XYZ_R8(gT,myThid)  
 c        IF (saltStepping) _EXCH_XYZ_R8(gS,myThid)  
 c      ELSEIF ( useGMRedi .AND. Oly.LT.4 ) THEN  
 cc       .AND. GM_AdvForm .AND. .NOT.GM_AdvSeparate ) THEN  
 c        IF (tempMultiDimAdvec) _EXCH_XYZ_R8(gT,myThid)  
 c        IF (saltMultiDimAdvec) _EXCH_XYZ_R8(gS,myThid)  
 c      ENDIF    
 c     ENDIF    
   
846  #ifndef DISABLE_DEBUGMODE  #ifndef DISABLE_DEBUGMODE
847        If (debugMode) THEN        If (debugMode) THEN
848         CALL DEBUG_STATS_RL(Nr,uVel,'Uvel (THERMODYNAMICS)',myThid)         CALL DEBUG_STATS_RL(Nr,uVel,'Uvel (THERMODYNAMICS)',myThid)
# Line 789  c     ENDIF Line 862  c     ENDIF
862        ENDIF        ENDIF
863  #endif  #endif
864    
865    #ifndef DISABLE_DEBUGMODE
866             IF ( debugLevel .GE. debLevB )
867         &    CALL DEBUG_LEAVE('FORWARD_STEP',myThid)
868    #endif
869    
870        RETURN        RETURN
871        END        END
Legend:
Removed from v.1.34  
changed lines
  Added in v.1.43
  ViewVC Help
Powered by ViewVC 1.1.22