/[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.24 by jmc, Wed Jul 3 20:22:39 2002 UTC revision 1.48 by dimitri, Thu Sep 25 03:01:59 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    #ifdef ALLOW_PTRACERS
13    # include "PTRACERS_OPTIONS.h"
14    #endif
15  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
16    
17  CBOP  CBOP
# Line 79  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_PTRACERS
86    #include "PTRACERS.h"
87    #endif
88    #ifdef ALLOW_TIMEAVE
89    #include "TIMEAVE_STATV.h"
90    #endif
91    
92  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
93  # include "tamc.h"  # include "tamc.h"
94  # include "tamc_keys.h"  # include "tamc_keys.h"
95  # include "FFIELDS.h"  # include "FFIELDS.h"
96    # include "EOS.h"
97  # ifdef ALLOW_KPP  # ifdef ALLOW_KPP
98  #  include "KPP.h"  #  include "KPP.h"
99  # endif  # endif
# Line 90  C     == Global variables === Line 101  C     == Global variables ===
101  #  include "GMREDI.h"  #  include "GMREDI.h"
102  # endif  # endif
103  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
 #ifdef ALLOW_TIMEAVE  
 #include "TIMEAVE_STATV.h"  
 #endif  
104    
105  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
106  C     == Routine arguments ==  C     == Routine arguments ==
# Line 117  C                                      i Line 125  C                                      i
125  C                                      so we need an fVer for each  C                                      so we need an fVer for each
126  C                                      variable.  C                                      variable.
127  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.  
128  C     phiSurfX, - gradient of Surface potentiel (Pressure/rho, ocean)  C     phiSurfX, - gradient of Surface potentiel (Pressure/rho, ocean)
129  C     phiSurfY             or geopotentiel (atmos) in X and Y direction  C     phiSurfY             or geopotentiel (atmos) in X and Y direction
130  C     KappaRT,       - Total diffusion in vertical for T and S.  C     KappaRT,       - Total diffusion in vertical for T and S.
131  C     KappaRS          (background + spatially varying, isopycnal term).  C     KappaRS          (background + spatially varying, isopycnal term).
132    C     useVariableK   = T when vertical diffusion is not constant
133  C     iMin, iMax     - Ranges and sub-block indices on which calculations  C     iMin, iMax     - Ranges and sub-block indices on which calculations
134  C     jMin, jMax       are applied.  C     jMin, jMax       are applied.
135  C     bi, bj  C     bi, bj
# Line 141  C                      index into fVerTe Line 145  C                      index into fVerTe
145        _RL fVerT   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)        _RL fVerT   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
146        _RL fVerS   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)        _RL fVerS   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
147        _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)  
148        _RL rhokm1  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL rhokm1  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
149        _RL rhok    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL rhok    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
150        _RL phiSurfX(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL phiSurfX(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
# Line 153  C                      index into fVerTe Line 156  C                      index into fVerTe
156        _RL sigmaR  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL sigmaR  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
157  C     This is currently used by IVDC and Diagnostics  C     This is currently used by IVDC and Diagnostics
158        _RL ConvectCount (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL ConvectCount (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
159          LOGICAL useVariableK
160        INTEGER iMin, iMax        INTEGER iMin, iMax
161        INTEGER jMin, jMax        INTEGER jMin, jMax
162        INTEGER bi, bj        INTEGER bi, bj
163        INTEGER i, j        INTEGER i, j
164        INTEGER k, km1, kup, kDown        INTEGER k, km1, kup, kDown
165          INTEGER iTracer
166    
167  CEOP  CEOP
168    
169    #ifndef DISABLE_DEBUGMODE
170             IF ( debugLevel .GE. debLevB )
171         &    CALL DEBUG_ENTER('FORWARD_STEP',myThid)
172    #endif
173    
174  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
175  C--   dummy statement to end declaration part  C--   dummy statement to end declaration part
176        ikey = 1        ikey = 1
177          itdkey = 1
178  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
179    
 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  
   
   
180  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
181  C--   HPF directive to help TAMC  C--   HPF directive to help TAMC
182  CHPF$ INDEPENDENT  CHPF$ INDEPENDENT
# Line 194  CHPF$ INDEPENDENT Line 187  CHPF$ INDEPENDENT
187  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
188  C--    HPF directive to help TAMC  C--    HPF directive to help TAMC
189  CHPF$  INDEPENDENT, NEW (rTrans,fVerT,fVerS  CHPF$  INDEPENDENT, NEW (rTrans,fVerT,fVerS
190  CHPF$&                  ,phiHyd,utrans,vtrans,xA,yA  CHPF$&                  ,utrans,vtrans,xA,yA
191  CHPF$&                  ,KappaRT,KappaRS  CHPF$&                  ,KappaRT,KappaRS
192  CHPF$&                  )  CHPF$&                  )
193  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
# Line 209  CHPF$&                  ) Line 202  CHPF$&                  )
202            act3 = myThid - 1            act3 = myThid - 1
203            max3 = nTx*nTy            max3 = nTx*nTy
204            act4 = ikey_dynamics - 1            act4 = ikey_dynamics - 1
205            ikey = (act1 + 1) + act2*max1            itdkey = (act1 + 1) + act2*max1
206       &                      + act3*max1*max2       &                      + act3*max1*max2
207       &                      + act4*max1*max2*max3       &                      + act4*max1*max2*max3
208  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
209    
210  C--     Set up work arrays that need valid initial values  C--   Set up work arrays with valid (i.e. not NaN) values
211    C     These inital values do not alter the numerical results. They
212    C     just ensure that all memory references are to valid floating
213    C     point numbers. This prevents spurious hardware signals due to
214    C     uninitialised but inert locations.
215    
216          DO j=1-OLy,sNy+OLy          DO j=1-OLy,sNy+OLy
217           DO i=1-OLx,sNx+OLx           DO i=1-OLx,sNx+OLx
218              xA(i,j)        = 0. _d 0
219              yA(i,j)        = 0. _d 0
220              uTrans(i,j)    = 0. _d 0
221              vTrans(i,j)    = 0. _d 0
222              rhok   (i,j)   = 0. _d 0
223              rhoKM1 (i,j)   = 0. _d 0
224              phiSurfX(i,j)  = 0. _d 0
225              phiSurfY(i,j)  = 0. _d 0
226            rTrans (i,j)   = 0. _d 0            rTrans (i,j)   = 0. _d 0
227            fVerT  (i,j,1) = 0. _d 0            fVerT  (i,j,1) = 0. _d 0
228            fVerT  (i,j,2) = 0. _d 0            fVerT  (i,j,2) = 0. _d 0
# Line 224  C--     Set up work arrays that need val Line 230  C--     Set up work arrays that need val
230            fVerS  (i,j,2) = 0. _d 0            fVerS  (i,j,2) = 0. _d 0
231            fVerTr1(i,j,1) = 0. _d 0            fVerTr1(i,j,1) = 0. _d 0
232            fVerTr1(i,j,2) = 0. _d 0            fVerTr1(i,j,2) = 0. _d 0
           rhoKM1 (i,j)   = 0. _d 0  
233           ENDDO           ENDDO
234          ENDDO          ENDDO
235    
# Line 232  C--     Set up work arrays that need val Line 237  C--     Set up work arrays that need val
237           DO j=1-OLy,sNy+OLy           DO j=1-OLy,sNy+OLy
238            DO i=1-OLx,sNx+OLx            DO i=1-OLx,sNx+OLx
239  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  
240             sigmaX(i,j,k) = 0. _d 0             sigmaX(i,j,k) = 0. _d 0
241             sigmaY(i,j,k) = 0. _d 0             sigmaY(i,j,k) = 0. _d 0
242             sigmaR(i,j,k) = 0. _d 0             sigmaR(i,j,k) = 0. _d 0
243             ConvectCount(i,j,k) = 0.             ConvectCount(i,j,k) = 0.
244             KappaRT(i,j,k) = 0. _d 0             KappaRT(i,j,k)    = 0. _d 0
245             KappaRS(i,j,k) = 0. _d 0             KappaRS(i,j,k)    = 0. _d 0
246  #ifdef ALLOW_AUTODIFF_TAMC  C- tracer tendency needs to be set to zero (moved here from gad_calc_rhs):
247             gT(i,j,k,bi,bj) = 0. _d 0             gT(i,j,k,bi,bj)   = 0. _d 0
248             gS(i,j,k,bi,bj) = 0. _d 0             gS(i,j,k,bi,bj)   = 0. _d 0
249  #ifdef ALLOW_PASSIVE_TRACER  # ifdef ALLOW_PASSIVE_TRACER
250             gTr1(i,j,k,bi,bj) = 0. _d 0             gTr1(i,j,k,bi,bj) = 0. _d 0
251  #endif  # endif
252  #ifdef ALLOW_GMREDI  # ifdef ALLOW_PTRACERS
253             Kwx(i,j,k,bi,bj)    = 0. _d 0             DO iTracer=1,PTRACERS_numInUse
254             Kwy(i,j,k,bi,bj)    = 0. _d 0              gPTr(i,j,k,bi,bj,itracer) = 0. _d 0
255             Kwz(i,j,k,bi,bj)    = 0. _d 0             ENDDO
256  #ifdef GM_NON_UNITY_DIAGONAL  # endif
257             Kux(i,j,k,bi,bj)    = 0. _d 0  #ifdef ALLOW_AUTODIFF_TAMC
258             Kvy(i,j,k,bi,bj)    = 0. _d 0  cph all the following init. are necessary for TAF
259  #endif  cph although some of these are re-initialised later.
260  #endif /* ALLOW_GMREDI */  # ifdef ALLOW_GMREDI
261  #endif             Kwx(i,j,k,bi,bj)  = 0. _d 0
262               Kwy(i,j,k,bi,bj)  = 0. _d 0
263               Kwz(i,j,k,bi,bj)  = 0. _d 0
264    #  ifdef GM_NON_UNITY_DIAGONAL
265               Kux(i,j,k,bi,bj)  = 0. _d 0
266               Kvy(i,j,k,bi,bj)  = 0. _d 0
267    #  endif
268    #  ifdef GM_EXTRA_DIAGONAL
269               Kuz(i,j,k,bi,bj)  = 0. _d 0
270               Kvz(i,j,k,bi,bj)  = 0. _d 0
271    #  endif
272    #  ifdef GM_BOLUS_ADVEC
273               GM_PsiX(i,j,k,bi,bj)  = 0. _d 0
274               GM_PsiY(i,j,k,bi,bj)  = 0. _d 0
275    #  endif
276    #  ifdef GM_VISBECK_VARIABLE_K
277               VisbeckK(i,j,bi,bj)   = 0. _d 0
278    #  endif
279    # endif /* ALLOW_GMREDI */
280    #endif /* ALLOW_AUTODIFF_TAMC */
281            ENDDO            ENDDO
282           ENDDO           ENDDO
283          ENDDO          ENDDO
# Line 264  C This is currently also used by IVDC an Line 287  C This is currently also used by IVDC an
287          jMin = 1-OLy          jMin = 1-OLy
288          jMax = sNy+OLy          jMax = sNy+OLy
289    
   
290  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
291  CADJ STORE theta(:,:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE theta(:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
292  CADJ STORE salt (:,:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE salt (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
293    CADJ STORE totphihyd
294    CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte
295  #ifdef ALLOW_KPP  #ifdef ALLOW_KPP
296  CADJ STORE uvel (:,:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE uvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
297  CADJ STORE vvel (:,:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE vvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
298  #endif  #endif
299  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
300    
301    #ifndef DISABLE_DEBUGMODE
302            IF ( debugLevel .GE. debLevB )
303         &    CALL DEBUG_MSG('ENTERING UPWARD K LOOP',myThid)
304    #endif
305    
306  C--     Start of diagnostic loop  C--     Start of diagnostic loop
307          DO k=Nr,1,-1          DO k=Nr,1,-1
308    
# Line 282  C? Patrick, is this formula correct now Line 311  C? Patrick, is this formula correct now
311  C? Do we still need this?  C? Do we still need this?
312  cph kkey formula corrected.  cph kkey formula corrected.
313  cph Needed for rhok, rhokm1, in the case useGMREDI.  cph Needed for rhok, rhokm1, in the case useGMREDI.
314           kkey = (ikey-1)*Nr + k           kkey = (itdkey-1)*Nr + k
 CADJ STORE rhokm1(:,:) = comlev1_bibj_k ,       key=kkey, byte=isbyte  
 CADJ STORE rhok  (:,:) = comlev1_bibj_k ,       key=kkey, byte=isbyte  
315  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
316    
317  C--       Integrate continuity vertically for vertical velocity  C--       Integrate continuity vertically for vertical velocity
318            CALL INTEGRATE_FOR_W(  c         CALL INTEGRATE_FOR_W(
319       I                         bi, bj, k, uVel, vVel,  c    I                         bi, bj, k, uVel, vVel,
320       O                         wVel,  c    O                         wVel,
321       I                         myThid )  c    I                         myThid )
322    
323  #ifdef    ALLOW_OBCS  #ifdef    ALLOW_OBCS
324  #ifdef    ALLOW_NONHYDROSTATIC  #ifdef    ALLOW_NONHYDROSTATIC
325  C--       Apply OBC to W if in N-H mode  C--       Apply OBC to W if in N-H mode
326            IF (useOBCS.AND.nonHydrostatic) THEN  c         IF (useOBCS.AND.nonHydrostatic) THEN
327              CALL OBCS_APPLY_W( bi, bj, k, wVel, myThid )  c           CALL OBCS_APPLY_W( bi, bj, k, wVel, myThid )
328            ENDIF  c         ENDIF
329  #endif    /* ALLOW_NONHYDROSTATIC */  #endif    /* ALLOW_NONHYDROSTATIC */
330  #endif    /* ALLOW_OBCS */  #endif    /* ALLOW_OBCS */
331    
# Line 310  C--       Calculate gradients of potenti Line 337  C--       Calculate gradients of potenti
337  C         slope terms (e.g. GM/Redi tensor or IVDC diffusivity)  C         slope terms (e.g. GM/Redi tensor or IVDC diffusivity)
338  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
339            IF ( useGMRedi .OR. (k.GT.1 .AND. ivdc_kappa.NE.0.) ) THEN            IF ( useGMRedi .OR. (k.GT.1 .AND. ivdc_kappa.NE.0.) ) THEN
340    #ifndef DISABLE_DEBUGMODE
341                IF ( debugLevel .GE. debLevB )
342         &       CALL DEBUG_CALL('FIND_RHO',myThid)
343    #endif
344  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
345  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
346  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
347  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
348              CALL FIND_RHO(              CALL FIND_RHO(
349       I        bi, bj, iMin, iMax, jMin, jMax, k, k, eosType,       I        bi, bj, iMin, iMax, jMin, jMax, k, k,
350       I        theta, salt,       I        theta, salt,
351       O        rhoK,       O        rhoK,
352       I        myThid )       I        myThid )
353    
354              IF (k.GT.1) THEN              IF (k.GT.1) THEN
355  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
356  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
357  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
358  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
359               CALL FIND_RHO(               CALL FIND_RHO(
360       I        bi, bj, iMin, iMax, jMin, jMax, k-1, k, eosType,       I        bi, bj, iMin, iMax, jMin, jMax, k-1, k,
361       I        theta, salt,       I        theta, salt,
362       O        rhoKm1,       O        rhoKm1,
363       I        myThid )       I        myThid )
364              ENDIF              ENDIF
365    #ifndef DISABLE_DEBUGMODE
366                IF ( debugLevel .GE. debLevB )
367         &       CALL DEBUG_CALL('GRAD_SIGMA',myThid)
368    #endif
369              CALL GRAD_SIGMA(              CALL GRAD_SIGMA(
370       I             bi, bj, iMin, iMax, jMin, jMax, k,       I             bi, bj, iMin, iMax, jMin, jMax, k,
371       I             rhoK, rhoKm1, rhoK,       I             rhoK, rhoKm1, rhoK,
# Line 337  CADJ STORE salt (:,:,k-1,bi,bj) = comlev Line 373  CADJ STORE salt (:,:,k-1,bi,bj) = comlev
373       I             myThid )       I             myThid )
374            ENDIF            ENDIF
375    
376    #ifdef ALLOW_AUTODIFF_TAMC
377    CADJ STORE rhok   (:,:) = comlev1_bibj_k ,       key=kkey, byte=isbyte
378    CADJ STORE rhokm1 (:,:) = comlev1_bibj_k ,       key=kkey, byte=isbyte
379    #endif /* ALLOW_AUTODIFF_TAMC */
380  C--       Implicit Vertical Diffusion for Convection  C--       Implicit Vertical Diffusion for Convection
381  c ==> should use sigmaR !!!  c ==> should use sigmaR !!!
382            IF (k.GT.1 .AND. ivdc_kappa.NE.0.) THEN            IF (k.GT.1 .AND. ivdc_kappa.NE.0.) THEN
383    #ifndef DISABLE_DEBUGMODE
384                IF ( debugLevel .GE. debLevB )
385         &       CALL DEBUG_CALL('CALC_IVDC',myThid)
386    #endif
387              CALL CALC_IVDC(              CALL CALC_IVDC(
388       I        bi, bj, iMin, iMax, jMin, jMax, k,       I        bi, bj, iMin, iMax, jMin, jMax, k,
389       I        rhoKm1, rhoK,       I        rhoKm1, rhoK,
# Line 354  C--     end of diagnostic k loop (Nr:1) Line 398  C--     end of diagnostic k loop (Nr:1)
398    
399  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
400  cph avoids recomputation of integrate_for_w  cph avoids recomputation of integrate_for_w
401  CADJ STORE wvel (:,:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE wvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
402  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
403    
404  #ifdef  ALLOW_OBCS  #ifdef  ALLOW_OBCS
405  C--     Calculate future values on open boundaries  C--     Calculate future values on open boundaries
406          IF (useOBCS) THEN          IF (useOBCS) THEN
407    #ifndef DISABLE_DEBUGMODE
408              IF ( debugLevel .GE. debLevB )
409         &     CALL DEBUG_CALL('OBCS_CALC',myThid)
410    #endif
411            CALL OBCS_CALC( bi, bj, myTime+deltaT, myIter+1,            CALL OBCS_CALC( bi, bj, myTime+deltaT, myIter+1,
412       I            uVel, vVel, wVel, theta, salt,       I            uVel, vVel, wVel, theta, salt,
413       I            myThid )       I            myThid )
414          ENDIF          ENDIF
415  #endif  /* ALLOW_OBCS */  #endif  /* ALLOW_OBCS */
416    
417    
418    #ifdef ALLOW_THERM_SEAICE
419           IF (useThermSeaIce) THEN
420    #ifndef DISABLE_DEBUGMODE
421            IF ( debugLevel .GE. debLevB )
422         &    CALL DEBUG_CALL('ICE_FORCING',myThid)
423    #endif
424  C--     Determines forcing terms based on external fields  C--     Determines forcing terms based on external fields
425  C       relaxation terms, etc.  C       including effects from ice
426          CALL EXTERNAL_FORCING_SURF(          CALL ICE_FORCING(
427       I             bi, bj, iMin, iMax, jMin, jMax,       I             bi, bj, iMin, iMax, jMin, jMax,
428       I             myThid )       I             myThid )
429           ELSE
430    #else  /* ALLOW_THERM_SEAICE */
431           IF (.TRUE.) THEN
432    #endif /* ALLOW_THERM_SEAICE */
433    
434    C--     Determines forcing terms based on external fields
435    C       relaxation terms, etc.
436    #ifndef DISABLE_DEBUGMODE
437            IF ( debugLevel .GE. debLevB )
438         &    CALL DEBUG_CALL('EXTERNAL_FORCING_SURF',myThid)
439    #endif
440            CALL EXTERNAL_FORCING_SURF(
441         I             bi, bj, iMin, iMax, jMin, jMax,
442         I             myTime, myIter, myThid )
443    
444    C--    end of if/else block useThermSeaIce --
445           ENDIF
446    
447    
448  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
449  cph needed for KPP  cph needed for KPP
450  CADJ STORE surfacetendencyU(:,:,bi,bj)  CADJ STORE surfacetendencyU(:,:,bi,bj)
451  CADJ &     = comlev1_bibj, key=ikey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte
452  CADJ STORE surfacetendencyV(:,:,bi,bj)  CADJ STORE surfacetendencyV(:,:,bi,bj)
453  CADJ &     = comlev1_bibj, key=ikey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte
454  CADJ STORE surfacetendencyS(:,:,bi,bj)  CADJ STORE surfacetendencyS(:,:,bi,bj)
455  CADJ &     = comlev1_bibj, key=ikey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte
456  CADJ STORE surfacetendencyT(:,:,bi,bj)  CADJ STORE surfacetendencyT(:,:,bi,bj)
457  CADJ &     = comlev1_bibj, key=ikey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte
458  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
459    
460  C--     Attention: by defining "SINGLE_LAYER_MODE" in CPP_OPTIONS.h  C--     Attention: by defining "SINGLE_LAYER_MODE" in CPP_OPTIONS.h
# Line 390  C--     MOST of THERMODYNAMICS will be d Line 464  C--     MOST of THERMODYNAMICS will be d
464  #ifdef  ALLOW_GMREDI  #ifdef  ALLOW_GMREDI
465    
466  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
467  CADJ STORE sigmaX(:,:,k)        = comlev1_bibj_k, key=kkey, byte=isbyte  cph storing here is needed only for one GMREDI_OPTIONS:
468  CADJ STORE sigmaY(:,:,k)        = comlev1_bibj_k, key=kkey, byte=isbyte  cph define GM_BOLUS_ADVEC
469  CADJ STORE sigmaR(:,:,k)        = comlev1_bibj_k, key=kkey, byte=isbyte  cph but I've avoided the #ifdef for now, in case more things change
470    CADJ STORE sigmaX(:,:,:)        = comlev1_bibj, key=itdkey, byte=isbyte
471    CADJ STORE sigmaY(:,:,:)        = comlev1_bibj, key=itdkey, byte=isbyte
472    CADJ STORE sigmaR(:,:,:)        = comlev1_bibj, key=itdkey, byte=isbyte
473  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
474    
475  C--     Calculate iso-neutral slopes for the GM/Redi parameterisation  C--     Calculate iso-neutral slopes for the GM/Redi parameterisation
476          IF (useGMRedi) THEN          IF (useGMRedi) THEN
477    #ifndef DISABLE_DEBUGMODE
478              IF ( debugLevel .GE. debLevB )
479         &     CALL DEBUG_CALL('GMREDI_CALC_TENSOR',myThid)
480    #endif
481            CALL GMREDI_CALC_TENSOR(            CALL GMREDI_CALC_TENSOR(
482       I             bi, bj, iMin, iMax, jMin, jMax,       I             bi, bj, iMin, iMax, jMin, jMax,
483       I             sigmaX, sigmaY, sigmaR,       I             sigmaX, sigmaY, sigmaR,
# Line 410  C--     Calculate iso-neutral slopes for Line 492  C--     Calculate iso-neutral slopes for
492          ENDIF          ENDIF
493    
494  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
495  CADJ STORE Kwx(:,:,:,bi,bj)   = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE Kwx(:,:,:,bi,bj)   = comlev1_bibj, key=itdkey, byte=isbyte
496  CADJ STORE Kwy(:,:,:,bi,bj)   = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE Kwy(:,:,:,bi,bj)   = comlev1_bibj, key=itdkey, byte=isbyte
497  CADJ STORE Kwz(:,:,:,bi,bj)   = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE Kwz(:,:,:,bi,bj)   = comlev1_bibj, key=itdkey, byte=isbyte
498  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
499    
500  #endif  /* ALLOW_GMREDI */  #endif  /* ALLOW_GMREDI */
# Line 420  CADJ STORE Kwz(:,:,:,bi,bj)   = comlev1_ Line 502  CADJ STORE Kwz(:,:,:,bi,bj)   = comlev1_
502  #ifdef  ALLOW_KPP  #ifdef  ALLOW_KPP
503  C--     Compute KPP mixing coefficients  C--     Compute KPP mixing coefficients
504          IF (useKPP) THEN          IF (useKPP) THEN
505    #ifndef DISABLE_DEBUGMODE
506              IF ( debugLevel .GE. debLevB )
507         &     CALL DEBUG_CALL('KPP_CALC',myThid)
508    #endif
509            CALL KPP_CALC(            CALL KPP_CALC(
510       I                  bi, bj, myTime, myThid )       I                  bi, bj, myTime, myThid )
511  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
# Line 434  CADJ STORE KPPghat   (:,:,:,bi,bj) Line 520  CADJ STORE KPPghat   (:,:,:,bi,bj)
520  CADJ &   , KPPdiffKzT(:,:,:,bi,bj)  CADJ &   , KPPdiffKzT(:,:,:,bi,bj)
521  CADJ &   , KPPdiffKzS(:,:,:,bi,bj)  CADJ &   , KPPdiffKzS(:,:,:,bi,bj)
522  CADJ &   , KPPfrac   (:,:  ,bi,bj)  CADJ &   , KPPfrac   (:,:  ,bi,bj)
523  CADJ &                 = comlev1_bibj, key=ikey, byte=isbyte  CADJ &                 = comlev1_bibj, key=itdkey, byte=isbyte
524  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
525    
526  #endif  /* ALLOW_KPP */  #endif  /* ALLOW_KPP */
527    
528  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
529  CADJ STORE KappaRT(:,:,:)     = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE KappaRT(:,:,:)     = comlev1_bibj, key=itdkey, byte=isbyte
530  CADJ STORE KappaRS(:,:,:)     = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE KappaRS(:,:,:)     = comlev1_bibj, key=itdkey, byte=isbyte
531  CADJ STORE theta(:,:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE theta(:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
532  CADJ STORE salt (:,:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE salt (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
533  CADJ STORE uvel (:,:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE uvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
534  CADJ STORE vvel (:,:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE vvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
535  #ifdef ALLOW_PASSIVE_TRACER  #ifdef ALLOW_PASSIVE_TRACER
536  CADJ STORE tr1  (:,:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE tr1  (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
537    #endif
538    #ifdef ALLOW_PTRACERS
539    cph-- moved to forward_step to avoid key computation
540    cphCADJ STORE ptracer(:,:,:,bi,bj,itracer) = comlev1_bibj,
541    cphCADJ &                              key=itdkey, byte=isbyte
542  #endif  #endif
543  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
544    
545  #ifdef ALLOW_AIM  #ifdef ALLOW_AIM
546  C       AIM - atmospheric intermediate model, physics package code.  C       AIM - atmospheric intermediate model, physics package code.
 C note(jmc) : phiHyd=0 at this point but is not really used in Molteni Physics  
547          IF ( useAIM ) THEN          IF ( useAIM ) THEN
548           CALL TIMER_START('AIM_DO_ATMOS_PHYS      [DYNAMICS]', myThid)  #ifndef DISABLE_DEBUGMODE
549           CALL AIM_DO_ATMOS_PHYSICS( phiHyd, bi, bj, myTime, myThid )            IF ( debugLevel .GE. debLevB )
550           CALL TIMER_STOP ('AIM_DO_ATMOS_PHYS      [DYNAMICS]', myThid)       &     CALL DEBUG_CALL('AIM_DO_PHYSICS',myThid)
551    #endif
552             CALL TIMER_START('AIM_DO_PHYSICS   [THERMODYNAMICS]', myThid)
553             CALL AIM_DO_PHYSICS( bi, bj, myTime, myIter, myThid )
554             CALL TIMER_STOP( 'AIM_DO_PHYSICS   [THERMODYNAMICS]', myThid)
555          ENDIF          ENDIF
556  #endif /* ALLOW_AIM */  #endif /* ALLOW_AIM */
557    
 #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 */  
   
558  #ifndef DISABLE_MULTIDIM_ADVECTION  #ifndef DISABLE_MULTIDIM_ADVECTION
559  C--     Some advection schemes are better calculated using a multi-dimensional  C--     Some advection schemes are better calculated using a multi-dimensional
560  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 480  C recomputation. It *is* differentiable, Line 567  C recomputation. It *is* differentiable,
567  C Edit GAD_OPTIONS.h and #define DISABLE_MULTIDIM_ADVECTION to  C Edit GAD_OPTIONS.h and #define DISABLE_MULTIDIM_ADVECTION to
568  C disable this section of code.  C disable this section of code.
569          IF (tempMultiDimAdvec) THEN          IF (tempMultiDimAdvec) THEN
570    #ifndef DISABLE_DEBUGMODE
571              IF ( debugLevel .GE. debLevB )
572         &     CALL DEBUG_CALL('GAD_ADVECTION',myThid)
573    #endif
574            CALL GAD_ADVECTION(bi,bj,tempAdvScheme,GAD_TEMPERATURE,            CALL GAD_ADVECTION(bi,bj,tempAdvScheme,GAD_TEMPERATURE,
575       U                      theta,gT,       U                      theta,gT,
576       I                      myTime,myIter,myThid)       I                      myTime,myIter,myThid)
577          ENDIF          ENDIF
578          IF (saltMultiDimAdvec) THEN          IF (saltMultiDimAdvec) THEN
579    #ifndef DISABLE_DEBUGMODE
580              IF ( debugLevel .GE. debLevB )
581         &     CALL DEBUG_CALL('GAD_ADVECTION',myThid)
582    #endif
583            CALL GAD_ADVECTION(bi,bj,saltAdvScheme,GAD_SALINITY,            CALL GAD_ADVECTION(bi,bj,saltAdvScheme,GAD_SALINITY,
584       U                      salt,gS,       U                      salt,gS,
585       I                      myTime,myIter,myThid)       I                      myTime,myIter,myThid)
# Line 494  C call the multi-dimensional method for Line 589  C call the multi-dimensional method for
589  C of whether multiDimAdvection is set or not.  C of whether multiDimAdvection is set or not.
590  #ifdef ALLOW_PTRACERS  #ifdef ALLOW_PTRACERS
591          IF ( usePTRACERS ) THEN          IF ( usePTRACERS ) THEN
592    #ifndef DISABLE_DEBUGMODE
593              IF ( debugLevel .GE. debLevB )
594         &     CALL DEBUG_CALL('PTRACERS_ADVECTION',myThid)
595    #endif
596           CALL PTRACERS_ADVECTION( bi,bj,myIter,myTime,myThid )           CALL PTRACERS_ADVECTION( bi,bj,myIter,myTime,myThid )
597          ENDIF          ENDIF
598  #endif /* ALLOW_PTRACERS */  #endif /* ALLOW_PTRACERS */
599  #endif /* DISABLE_MULTIDIM_ADVECTION */  #endif /* DISABLE_MULTIDIM_ADVECTION */
600    
601    #ifndef DISABLE_DEBUGMODE
602           IF ( debugLevel .GE. debLevB )
603         &    CALL DEBUG_MSG('ENTERING DOWNWARD K LOOP',myThid)
604    #endif
605    
606  C--     Start of thermodynamics loop  C--     Start of thermodynamics loop
607          DO k=Nr,1,-1          DO k=Nr,1,-1
608  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
609  C? Patrick Is this formula correct?  C? Patrick Is this formula correct?
610  cph Yes, but I rewrote it.  cph Yes, but I rewrote it.
611  cph Also, the KappaR? need the index and subscript k!  cph Also, the KappaR? need the index and subscript k!
612           kkey = (ikey-1)*Nr + k           kkey = (itdkey-1)*Nr + k
613  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
614    
615  C--       km1    Points to level above k (=k-1)  C--       km1    Points to level above k (=k-1)
# Line 528  C--       Get temporary terms used by te Line 632  C--       Get temporary terms used by te
632       I         myThid)       I         myThid)
633    
634  #ifdef ALLOW_GMREDI  #ifdef ALLOW_GMREDI
635    
636  C--   Residual transp = Bolus transp + Eulerian transp  C--   Residual transp = Bolus transp + Eulerian transp
637            IF (useGMRedi) THEN            IF (useGMRedi) THEN
638              CALL GMREDI_CALC_UVFLOW(              CALL GMREDI_CALC_UVFLOW(
# Line 535  C--   Residual transp = Bolus transp + E Line 640  C--   Residual transp = Bolus transp + E
640              IF (K.GE.2) CALL GMREDI_CALC_WFLOW(              IF (K.GE.2) CALL GMREDI_CALC_WFLOW(
641       &                    rTrans, bi, bj, k, myThid)       &                    rTrans, bi, bj, k, myThid)
642            ENDIF            ENDIF
643    
644    #ifdef ALLOW_AUTODIFF_TAMC
645    #ifdef GM_BOLUS_ADVEC
646    CADJ STORE uTrans(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
647    CADJ STORE vTrans(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
648    CADJ STORE rTrans(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
649    #endif
650    #endif /* ALLOW_AUTODIFF_TAMC */
651    
652  #endif /* ALLOW_GMREDI */  #endif /* ALLOW_GMREDI */
653    
654  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
# Line 570  C        and step forward storing result Line 684  C        and step forward storing result
684       I         theta, gT,       I         theta, gT,
685       I         myIter, myThid)       I         myIter, myThid)
686           ENDIF           ENDIF
687    
688    #ifdef ALLOW_THERM_SEAICE
689             IF (useThermSeaIce .AND. k.EQ.1) THEN
690               CALL ICE_FREEZE( bi,bj, iMin,iMax,jMin,jMax, myThid )
691             ENDIF
692    #endif
693    
694           IF ( saltStepping ) THEN           IF ( saltStepping ) THEN
695             CALL CALC_GS(             CALL CALC_GS(
696       I         bi,bj,iMin,iMax,jMin,jMax, k,km1,kup,kDown,       I         bi,bj,iMin,iMax,jMin,jMax, k,km1,kup,kDown,
# Line 598  C        and step forward storing result Line 719  C        and step forward storing result
719  #endif  #endif
720  #ifdef ALLOW_PTRACERS  #ifdef ALLOW_PTRACERS
721           IF ( usePTRACERS ) THEN           IF ( usePTRACERS ) THEN
722             CALL PTRACERS_INTEGERATE(             CALL PTRACERS_INTEGRATE(
723       I         bi,bj,k,       I         bi,bj,k,
724       I         xA,yA,uTrans,vTrans,rTrans,maskUp,       I         xA,yA,uTrans,vTrans,rTrans,maskUp,
725       X         KappaRS,       X         KappaRS,
# Line 614  C--      Apply open boundary conditions Line 735  C--      Apply open boundary conditions
735  #endif   /* ALLOW_OBCS */  #endif   /* ALLOW_OBCS */
736    
737  C--      Freeze water  C--      Freeze water
738           IF (allowFreezing) THEN           IF ( allowFreezing .AND. .NOT. useSEAICE
739         &       .AND. .NOT.(useThermSeaIce.AND.k.EQ.1) ) THEN
740  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
741  CADJ STORE gT(:,:,k,bi,bj) = comlev1_bibj_k  CADJ STORE gT(:,:,k,bi,bj) = comlev1_bibj_k
742  CADJ &   , key = kkey, byte = isbyte  CADJ &   , key = kkey, byte = isbyte
743  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
744              CALL FREEZE( bi, bj, iMin, iMax, jMin, jMax, k, myThid )              CALL FREEZE( bi, bj, iMin, iMax, jMin, jMax, k, myThid )
745           END IF           ENDIF
746    
747  C--     end of thermodynamic k loop (Nr:1)  C--     end of thermodynamic k loop (Nr:1)
748          ENDDO          ENDDO
749    
750    cswdice -- add ---
751    #ifdef ALLOW_THERM_SEAICE
752    c timeaveraging for ice model values
753               CALL ICE_AVE(bi,bj,iMin,iMax,jMin,jMax,myThid )
754    #endif
755    cswdice --- end add ---
756    
757    
758    
 #ifdef ALLOW_AUTODIFF_TAMC  
 C? Patrick? What about this one?  
 cph Keys iikey and idkey dont seem to be needed  
 cph since storing occurs on different tape for each  
 cph impldiff call anyways.  
 cph Thus, common block comlev1_impl isnt needed either.  
 cph Storing below needed in the case useGMREDI.  
         iikey = (ikey-1)*maximpl  
 #endif /* ALLOW_AUTODIFF_TAMC */  
759    
760  C--     Implicit diffusion  C--     Implicit diffusion
761          IF (implicitDiffusion) THEN          IF (implicitDiffusion) THEN
762    
763           IF (tempStepping) THEN           IF (tempStepping) THEN
764  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
765              idkey = iikey + 1  CADJ STORE gT(:,:,:,bi,bj) = comlev1_bibj , key=itdkey, byte=isbyte
 CADJ STORE gT(:,:,:,bi,bj) = comlev1_bibj , key=ikey, byte=isbyte  
766  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
767              CALL IMPLDIFF(              CALL IMPLDIFF(
768       I         bi, bj, iMin, iMax, jMin, jMax,       I         bi, bj, iMin, iMax, jMin, jMax,
# Line 653  CADJ STORE gT(:,:,:,bi,bj) = comlev1_bib Line 773  CADJ STORE gT(:,:,:,bi,bj) = comlev1_bib
773    
774           IF (saltStepping) THEN           IF (saltStepping) THEN
775  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
776           idkey = iikey + 2  CADJ STORE gS(:,:,:,bi,bj) = comlev1_bibj , key=itdkey, byte=isbyte
 CADJ STORE gS(:,:,:,bi,bj) = comlev1_bibj , key=ikey, byte=isbyte  
777  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
778              CALL IMPLDIFF(              CALL IMPLDIFF(
779       I         bi, bj, iMin, iMax, jMin, jMax,       I         bi, bj, iMin, iMax, jMin, jMax,
# Line 666  CADJ STORE gS(:,:,:,bi,bj) = comlev1_bib Line 785  CADJ STORE gS(:,:,:,bi,bj) = comlev1_bib
785  #ifdef ALLOW_PASSIVE_TRACER  #ifdef ALLOW_PASSIVE_TRACER
786           IF (tr1Stepping) THEN           IF (tr1Stepping) THEN
787  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
788  CADJ STORE gTr1(:,:,:,bi,bj) = comlev1_bibj , key=ikey, byte=isbyte  CADJ STORE gTr1(:,:,:,bi,bj) = comlev1_bibj , key=itdkey, byte=isbyte
789  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
790            CALL IMPLDIFF(            CALL IMPLDIFF(
791       I      bi, bj, iMin, iMax, jMin, jMax,       I      bi, bj, iMin, iMax, jMin, jMax,
# Line 695  C--      Apply open boundary conditions Line 814  C--      Apply open boundary conditions
814  C--     End If implicitDiffusion  C--     End If implicitDiffusion
815          ENDIF          ENDIF
816    
817    #ifdef ALLOW_TIMEAVE
818            IF (taveFreq.GT.0. .AND. ivdc_kappa.NE.0.) THEN
819              CALL TIMEAVE_CUMUL_1T(ConvectCountTave, ConvectCount,
820         I                           Nr, deltaTclock, bi, bj, myThid)
821            ENDIF
822            useVariableK = useKPP .OR. useGMredi .OR. ivdc_kappa.NE.0.
823            IF (taveFreq.GT.0. .AND. useVariableK ) THEN
824             IF (implicitDiffusion) THEN
825              CALL TIMEAVE_CUMUL_DIF_1T(TdiffRtave, gT, kappaRT,
826         I                        Nr, 3, deltaTclock, bi, bj, myThid)
827             ELSE
828              CALL TIMEAVE_CUMUL_DIF_1T(TdiffRtave, theta, kappaRT,
829         I                        Nr, 3, deltaTclock, bi, bj, myThid)
830             ENDIF
831            ENDIF
832    #endif /* ALLOW_TIMEAVE */
833    
834  #endif /* SINGLE_LAYER_MODE */  #endif /* SINGLE_LAYER_MODE */
835    
836  Ccs-  C--   end bi,bj loops.
837         ENDDO         ENDDO
838        ENDDO        ENDDO
839    
 #ifdef ALLOW_AIM  
       IF ( useAIM ) THEN  
        CALL AIM_AIM2DYN_EXCHANGES( myTime, myThid )  
       ENDIF  
 #endif /* ALLOW_AIM */  
       IF ( staggerTimeStep ) THEN  
        IF ( useAIM .OR. useCubedSphereExchange ) THEN  
          IF (tempStepping) _EXCH_XYZ_R8(gT,myThid)  
          IF (saltStepping) _EXCH_XYZ_R8(gS,myThid)  
        ELSEIF ( useGMRedi .AND. Oly.LT.4 ) THEN  
 c        .AND. GM_AdvForm .AND. .NOT.GM_AdvSeparate ) THEN  
          IF (tempMultiDimAdvec) _EXCH_XYZ_R8(gT,myThid)  
          IF (saltMultiDimAdvec) _EXCH_XYZ_R8(gS,myThid)  
        ENDIF    
       ENDIF    
   
840  #ifndef DISABLE_DEBUGMODE  #ifndef DISABLE_DEBUGMODE
841        If (debugMode) THEN        If (debugMode) THEN
842         CALL DEBUG_STATS_RL(Nr,uVel,'Uvel (THERMODYNAMICS)',myThid)         CALL DEBUG_STATS_RL(Nr,uVel,'Uvel (THERMODYNAMICS)',myThid)
# Line 736  c        .AND. GM_AdvForm .AND. .NOT.GM_ Line 856  c        .AND. GM_AdvForm .AND. .NOT.GM_
856        ENDIF        ENDIF
857  #endif  #endif
858    
859    #ifndef DISABLE_DEBUGMODE
860             IF ( debugLevel .GE. debLevB )
861         &    CALL DEBUG_LEAVE('FORWARD_STEP',myThid)
862    #endif
863    
864        RETURN        RETURN
865        END        END
Legend:
Removed from v.1.24  
changed lines
  Added in v.1.48
  ViewVC Help
Powered by ViewVC 1.1.22