/[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.18 by adcroft, Tue Mar 5 14:15:34 2002 UTC revision 1.43 by heimbach, Tue Jul 8 15:00:26 2003 UTC
# Line 2  C $Header$ Line 2  C $Header$
2  C $Name$  C $Name$
3    
4  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
5    #ifdef ALLOW_AUTODIFF_TAMC
6    # ifdef ALLOW_GMREDI
7    #  include "GMREDI_OPTIONS.h"
8    # endif
9    # ifdef ALLOW_KPP
10    #  include "KPP_OPTIONS.h"
11    # endif
12    # ifdef ALLOW_PTRACERS
13    #  include "PTRACERS_OPTIONS.h"
14    # endif
15    #endif /* ALLOW_AUTODIFF_TAMC */
16    
17  CBOP  CBOP
18  C     !ROUTINE: THERMODYNAMICS  C     !ROUTINE: THERMODYNAMICS
# Line 71  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"
92  # include "FFIELDS.h"  # include "FFIELDS.h"
93    # include "EOS.h"
94  # ifdef ALLOW_KPP  # ifdef ALLOW_KPP
95  #  include "KPP.h"  #  include "KPP.h"
96  # endif  # endif
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 109  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 133  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 145  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
181        ikey = 1        ikey = 1
182          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  
         DO k=1,Nr  
          phiHyd(i,j,k)  = 0. _d 0  
          sigmaX(i,j,k) = 0. _d 0  
          sigmaY(i,j,k) = 0. _d 0  
          sigmaR(i,j,k) = 0. _d 0  
         ENDDO  
         rhoKM1 (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 193  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 208  CHPF$&                  ) Line 207  CHPF$&                  )
207            act3 = myThid - 1            act3 = myThid - 1
208            max3 = nTx*nTy            max3 = nTx*nTy
209            act4 = ikey_dynamics - 1            act4 = ikey_dynamics - 1
210            ikey = (act1 + 1) + act2*max1            itdkey = (act1 + 1) + act2*max1
211       &                      + act3*max1*max2       &                      + act3*max1*max2
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 230  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
245               sigmaX(i,j,k) = 0. _d 0
246               sigmaY(i,j,k) = 0. _d 0
247               sigmaR(i,j,k) = 0. _d 0
248             ConvectCount(i,j,k) = 0.             ConvectCount(i,j,k) = 0.
249             KappaRT(i,j,k) = 0. _d 0             KappaRT(i,j,k)    = 0. _d 0
250             KappaRS(i,j,k) = 0. _d 0             KappaRS(i,j,k)    = 0. _d 0
251  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
252             gT(i,j,k,bi,bj) = 0. _d 0  cph all the following init. are necessary for TAF
253             gS(i,j,k,bi,bj) = 0. _d 0  cph although some of these are re-initialised later.
254  #ifdef ALLOW_PASSIVE_TRACER             gT(i,j,k,bi,bj)   = 0. _d 0
255               gS(i,j,k,bi,bj)   = 0. _d 0
256    # 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  #endif  # 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
265               Kwx(i,j,k,bi,bj)  = 0. _d 0
266               Kwy(i,j,k,bi,bj)  = 0. _d 0
267               Kwz(i,j,k,bi,bj)  = 0. _d 0
268    #  ifdef GM_NON_UNITY_DIAGONAL
269               Kux(i,j,k,bi,bj)  = 0. _d 0
270               Kvy(i,j,k,bi,bj)  = 0. _d 0
271    #  endif
272    #  ifdef GM_EXTRA_DIAGONAL
273               Kuz(i,j,k,bi,bj)  = 0. _d 0
274               Kvz(i,j,k,bi,bj)  = 0. _d 0
275    #  endif
276    #  ifdef GM_BOLUS_ADVEC
277               GM_PsiX(i,j,k,bi,bj)  = 0. _d 0
278               GM_PsiY(i,j,k,bi,bj)  = 0. _d 0
279    #  endif
280    #  ifdef GM_VISBECK_VARIABLE_K
281               VisbeckK(i,j,bi,bj)   = 0. _d 0
282    #  endif
283    # endif /* ALLOW_GMREDI */
284    #endif /* ALLOW_AUTODIFF_TAMC */
285            ENDDO            ENDDO
286           ENDDO           ENDDO
287          ENDDO          ENDDO
288    
289          iMin = 1-OLx+1          iMin = 1-OLx
290          iMax = sNx+OLx          iMax = sNx+OLx
291          jMin = 1-OLy+1          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=ikey, byte=isbyte  CADJ STORE theta(:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
296  CADJ STORE salt (:,:,:,bi,bj) = comlev1_bibj, key=ikey, 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=ikey, byte=isbyte  CADJ STORE uvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
301  CADJ STORE vvel (:,:,:,bi,bj) = comlev1_bibj, key=ikey, 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 267  C? Patrick, is this formula correct now Line 315  C? Patrick, is this formula correct now
315  C? Do we still need this?  C? Do we still need this?
316  cph kkey formula corrected.  cph kkey formula corrected.
317  cph Needed for rhok, rhokm1, in the case useGMREDI.  cph Needed for rhok, rhokm1, in the case useGMREDI.
318           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  
319  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
320    
321  C--       Integrate continuity vertically for vertical velocity  C--       Integrate continuity vertically for vertical velocity
322            CALL INTEGRATE_FOR_W(  c         CALL INTEGRATE_FOR_W(
323       I                         bi, bj, k, uVel, vVel,  c    I                         bi, bj, k, uVel, vVel,
324       O                         wVel,  c    O                         wVel,
325       I                         myThid )  c    I                         myThid )
326    
327  #ifdef    ALLOW_OBCS  #ifdef    ALLOW_OBCS
328  #ifdef    ALLOW_NONHYDROSTATIC  #ifdef    ALLOW_NONHYDROSTATIC
329  C--       Apply OBC to W if in N-H mode  C--       Apply OBC to W if in N-H mode
330            IF (useOBCS.AND.nonHydrostatic) THEN  c         IF (useOBCS.AND.nonHydrostatic) THEN
331              CALL OBCS_APPLY_W( bi, bj, k, wVel, myThid )  c           CALL OBCS_APPLY_W( bi, bj, k, wVel, myThid )
332            ENDIF  c         ENDIF
333  #endif    /* ALLOW_NONHYDROSTATIC */  #endif    /* ALLOW_NONHYDROSTATIC */
334  #endif    /* ALLOW_OBCS */  #endif    /* ALLOW_OBCS */
335    
336    C--       Attention: by defining "SINGLE_LAYER_MODE" in CPP_OPTIONS.h
337    C--       MOST of THERMODYNAMICS will be disabled
338    #ifndef SINGLE_LAYER_MODE
339    
340  C--       Calculate gradients of potential density for isoneutral  C--       Calculate gradients of potential density for isoneutral
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
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, eosType,       I        bi, bj, iMin, iMax, jMin, jMax, k, k,
354       I        theta, salt,       I        theta, salt,
355       O        rhoK,       O        rhoK,
356       I        myThid )       I        myThid )
357    
358              IF (k.GT.1) THEN              IF (k.GT.1) THEN
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
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, eosType,       I        bi, bj, iMin, iMax, jMin, jMax, k-1, k,
365       I        theta, salt,       I        theta, salt,
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 318  CADJ STORE salt (:,:,k-1,bi,bj) = comlev Line 377  CADJ STORE salt (:,:,k-1,bi,bj) = comlev
377       I             myThid )       I             myThid )
378            ENDIF            ENDIF
379    
380    #ifdef ALLOW_AUTODIFF_TAMC
381    CADJ STORE rhok   (:,:) = comlev1_bibj_k ,       key=kkey, byte=isbyte
382    CADJ STORE rhokm1 (:,:) = comlev1_bibj_k ,       key=kkey, byte=isbyte
383    #endif /* ALLOW_AUTODIFF_TAMC */
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 328  c ==> should use sigmaR !!! Line 395  c ==> should use sigmaR !!!
395       I        myTime, myIter, myThid)       I        myTime, myIter, myThid)
396            ENDIF            ENDIF
397    
398    #endif /* SINGLE_LAYER_MODE */
399    
400  C--     end of diagnostic k loop (Nr:1)  C--     end of diagnostic k loop (Nr:1)
401          ENDDO          ENDDO
402    
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=ikey, byte=isbyte  CADJ STORE wvel (:,:,:,bi,bj) = 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 )
418          ENDIF          ENDIF
419  #endif  /* ALLOW_OBCS */  #endif  /* ALLOW_OBCS */
420    
421    
422    c********************************************
423    cswdice --- add ---
424    #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
430    c--     including effects from ice
431            CALL ICE_FORCING(
432         I             bi, bj, iMin, iMax, jMin, jMax,
433         I             myThid )
434    #else
435    
436    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          CALL EXTERNAL_FORCING_SURF(  #ifndef DISABLE_DEBUGMODE
441            IF ( debugLevel .GE. debLevB )
442         &    CALL DEBUG_CALL('EXTERNAL_FORCING_SURF',myThid)
443    #endif
444            CALL EXTERNAL_FORCING_SURF(
445       I             bi, bj, iMin, iMax, jMin, jMax,       I             bi, bj, iMin, iMax, jMin, jMax,
446       I             myThid )       I             myThid )
447    cswdice --- add ----
448    #endif
449    cswdice --- end add ---
450    c******************************************
451    
452    
453    
454    
455  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
456  cph needed for KPP  cph needed for KPP
457  CADJ STORE surfacetendencyU(:,:,bi,bj)  CADJ STORE surfacetendencyU(:,:,bi,bj)
458  CADJ &     = comlev1_bibj, key=ikey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte
459  CADJ STORE surfacetendencyV(:,:,bi,bj)  CADJ STORE surfacetendencyV(:,:,bi,bj)
460  CADJ &     = comlev1_bibj, key=ikey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte
461  CADJ STORE surfacetendencyS(:,:,bi,bj)  CADJ STORE surfacetendencyS(:,:,bi,bj)
462  CADJ &     = comlev1_bibj, key=ikey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte
463  CADJ STORE surfacetendencyT(:,:,bi,bj)  CADJ STORE surfacetendencyT(:,:,bi,bj)
464  CADJ &     = comlev1_bibj, key=ikey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte
465  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
466    
467    C--     Attention: by defining "SINGLE_LAYER_MODE" in CPP_OPTIONS.h
468    C--     MOST of THERMODYNAMICS will be disabled
469    #ifndef SINGLE_LAYER_MODE
470    
471  #ifdef  ALLOW_GMREDI  #ifdef  ALLOW_GMREDI
472    
473  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
474  CADJ STORE sigmaX(:,:,:) = comlev1, key=ikey, byte=isbyte  cph storing here is needed only for one GMREDI_OPTIONS:
475  CADJ STORE sigmaY(:,:,:) = comlev1, key=ikey, byte=isbyte  cph define GM_BOLUS_ADVEC
476  CADJ STORE sigmaR(:,:,:) = comlev1, key=ikey, byte=isbyte  cph but I've avoided the #ifdef for now, in case more things change
477    CADJ STORE sigmaX(:,:,:)        = comlev1_bibj, key=itdkey, byte=isbyte
478    CADJ STORE sigmaY(:,:,:)        = comlev1_bibj, key=itdkey, byte=isbyte
479    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 385  C--     Calculate iso-neutral slopes for Line 499  C--     Calculate iso-neutral slopes for
499          ENDIF          ENDIF
500    
501  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
502  CADJ STORE Kwx(:,:,:,bi,bj)   = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE Kwx(:,:,:,bi,bj)   = comlev1_bibj, key=itdkey, byte=isbyte
503  CADJ STORE Kwy(:,:,:,bi,bj)   = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE Kwy(:,:,:,bi,bj)   = comlev1_bibj, key=itdkey, byte=isbyte
504  CADJ STORE Kwz(:,:,:,bi,bj)   = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE Kwz(:,:,:,bi,bj)   = comlev1_bibj, key=itdkey, byte=isbyte
505  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
506    
507  #endif  /* ALLOW_GMREDI */  #endif  /* ALLOW_GMREDI */
# Line 395  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 409  CADJ STORE KPPghat   (:,:,:,bi,bj) Line 527  CADJ STORE KPPghat   (:,:,:,bi,bj)
527  CADJ &   , KPPdiffKzT(:,:,:,bi,bj)  CADJ &   , KPPdiffKzT(:,:,:,bi,bj)
528  CADJ &   , KPPdiffKzS(:,:,:,bi,bj)  CADJ &   , KPPdiffKzS(:,:,:,bi,bj)
529  CADJ &   , KPPfrac   (:,:  ,bi,bj)  CADJ &   , KPPfrac   (:,:  ,bi,bj)
530  CADJ &                 = comlev1_bibj, key=ikey, byte=isbyte  CADJ &                 = comlev1_bibj, key=itdkey, byte=isbyte
531  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
532    
533  #endif  /* ALLOW_KPP */  #endif  /* ALLOW_KPP */
534    
535  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
536  CADJ STORE KappaRT(:,:,:)     = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE KappaRT(:,:,:)     = comlev1_bibj, key=itdkey, byte=isbyte
537  CADJ STORE KappaRS(:,:,:)     = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE KappaRS(:,:,:)     = comlev1_bibj, key=itdkey, byte=isbyte
538  CADJ STORE theta(:,:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE theta(:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
539  CADJ STORE salt (:,:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE salt (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
540  CADJ STORE uvel (:,:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE uvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
541  CADJ STORE vvel (:,:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE vvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
542  #ifdef ALLOW_PASSIVE_TRACER  #ifdef ALLOW_PASSIVE_TRACER
543  CADJ STORE tr1  (:,:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE tr1  (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
544    #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  #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.
 C note(jmc) : phiHyd=0 at this point but is not really used in Molteni Physics  
554          IF ( useAIM ) THEN          IF ( useAIM ) THEN
555           CALL TIMER_START('AIM_DO_ATMOS_PHYS      [DYNAMICS]', myThid)  #ifndef DISABLE_DEBUGMODE
556           CALL AIM_DO_ATMOS_PHYSICS( phiHyd, bi, bj, myTime, myThid )            IF ( debugLevel .GE. debLevB )
557           CALL TIMER_STOP ('AIM_DO_ATMOS_PHYS      [DYNAMICS]', myThid)       &     CALL DEBUG_CALL('AIM_DO_PHYSICS',myThid)
558    #endif
559             CALL TIMER_START('AIM_DO_PHYSICS   [THERMODYNAMICS]', myThid)
560             CALL AIM_DO_PHYSICS( bi, bj, myTime, myIter, myThid )
561             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 454  C to be able to exclude this scheme to a Line 573  C to be able to exclude this scheme to a
573  C recomputation. It *is* differentiable, if you need it.  C recomputation. It *is* differentiable, if you need it.
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 (multiDimAdvection) THEN          IF (tempMultiDimAdvec) THEN
577           IF (tempStepping .AND.  #ifndef DISABLE_DEBUGMODE
578       &       tempAdvScheme.NE.ENUM_CENTERED_2ND .AND.            IF ( debugLevel .GE. debLevB )
579       &       tempAdvScheme.NE.ENUM_UPWIND_3RD .AND.       &     CALL DEBUG_CALL('GAD_ADVECTION',myThid)
580       &       tempAdvScheme.NE.ENUM_CENTERED_4TH ) THEN  #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 (saltStepping .AND.          IF (saltMultiDimAdvec) THEN
586       &       saltAdvScheme.NE.ENUM_CENTERED_2ND .AND.  #ifndef DISABLE_DEBUGMODE
587       &       saltAdvScheme.NE.ENUM_UPWIND_3RD .AND.            IF ( debugLevel .GE. debLevB )
588       &       saltAdvScheme.NE.ENUM_CENTERED_4TH ) THEN       &     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)
          ENDIF  
593          ENDIF          ENDIF
594  C Since passive tracers are configurable separately from T,S we  C Since passive tracers are configurable separately from T,S we
595  C call the multi-dimensional method for PTRACERS regardless  C call the multi-dimensional method for PTRACERS regardless
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
616  C? Patrick Is this formula correct?  C? Patrick Is this formula correct?
617  cph Yes, but I rewrote it.  cph Yes, but I rewrote it.
618  cph Also, the KappaR? need the index and subscript k!  cph Also, the KappaR? need the index and subscript k!
619           kkey = (ikey-1)*Nr + k           kkey = (itdkey-1)*Nr + k
620  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
621    
622  C--       km1    Points to level above k (=k-1)  C--       km1    Points to level above k (=k-1)
# Line 510  C--       Get temporary terms used by te Line 638  C--       Get temporary terms used by te
638       O         xA,yA,uTrans,vTrans,rTrans,maskUp,       O         xA,yA,uTrans,vTrans,rTrans,maskUp,
639       I         myThid)       I         myThid)
640    
641    #ifdef ALLOW_GMREDI
642    
643    C--   Residual transp = Bolus transp + Eulerian transp
644              IF (useGMRedi) THEN
645                CALL GMREDI_CALC_UVFLOW(
646         &            uTrans, vTrans, bi, bj, k, myThid)
647                IF (K.GE.2) CALL GMREDI_CALC_WFLOW(
648         &                    rTrans, bi, bj, k, myThid)
649              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 */
660    
661  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
662  CADJ STORE KappaRT(:,:,k)    = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE KappaRT(:,:,k)    = comlev1_bibj_k, key=kkey, byte=isbyte
663  CADJ STORE KappaRS(:,:,k)    = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE KappaRS(:,:,k)    = comlev1_bibj_k, key=kkey, byte=isbyte
# Line 543  C        and step forward storing result Line 691  C        and step forward storing result
691       I         theta, gT,       I         theta, gT,
692       I         myIter, myThid)       I         myIter, myThid)
693           ENDIF           ENDIF
694    cswdice ---- add ---
695    #ifdef ALLOW_THERM_SEAICE
696           if (k.eq.1) then
697            call ICE_FREEZE(bi, bj, iMin, iMax, jMin, jMax, myThid )
698           endif
699    #endif
700    cswdice -- end add ---
701           IF ( saltStepping ) THEN           IF ( saltStepping ) THEN
702             CALL CALC_GS(             CALL CALC_GS(
703       I         bi,bj,iMin,iMax,jMin,jMax, k,km1,kup,kDown,       I         bi,bj,iMin,iMax,jMin,jMax, k,km1,kup,kDown,
# Line 571  C        and step forward storing result Line 726  C        and step forward storing result
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 587  C--      Apply open boundary conditions Line 742  C--      Apply open boundary conditions
742  #endif   /* ALLOW_OBCS */  #endif   /* ALLOW_OBCS */
743    
744  C--      Freeze water  C--      Freeze water
745           IF (allowFreezing) THEN           IF ( allowFreezing .AND. .NOT. useSEAICE ) THEN
746  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
747  CADJ STORE gT(:,:,k,bi,bj) = comlev1_bibj_k  CADJ STORE gT(:,:,k,bi,bj) = comlev1_bibj_k
748  CADJ &   , key = kkey, byte = isbyte  CADJ &   , key = kkey, byte = isbyte
# Line 598  CADJ &   , key = kkey, byte = isbyte Line 753  CADJ &   , key = kkey, byte = isbyte
753  C--     end of thermodynamic k loop (Nr:1)  C--     end of thermodynamic k loop (Nr:1)
754          ENDDO          ENDDO
755    
756    cswdice -- add ---
757    #ifdef ALLOW_THERM_SEAICE
758    c timeaveraging for ice model values
759               CALL ICE_AVE(bi,bj,iMin,iMax,jMin,jMax,myThid )
760    #endif
761    cswdice --- end add ---
762    
763    
764    
 #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 */  
765    
766  C--     Implicit diffusion  C--     Implicit diffusion
767          IF (implicitDiffusion) THEN          IF (implicitDiffusion) THEN
768    
769           IF (tempStepping) THEN           IF (tempStepping) THEN
770  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
771              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  
772  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
773              CALL IMPLDIFF(              CALL IMPLDIFF(
774       I         bi, bj, iMin, iMax, jMin, jMax,       I         bi, bj, iMin, iMax, jMin, jMax,
# Line 626  CADJ STORE gT(:,:,:,bi,bj) = comlev1_bib Line 779  CADJ STORE gT(:,:,:,bi,bj) = comlev1_bib
779    
780           IF (saltStepping) THEN           IF (saltStepping) THEN
781  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
782           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  
783  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
784              CALL IMPLDIFF(              CALL IMPLDIFF(
785       I         bi, bj, iMin, iMax, jMin, jMax,       I         bi, bj, iMin, iMax, jMin, jMax,
# Line 639  CADJ STORE gS(:,:,:,bi,bj) = comlev1_bib Line 791  CADJ STORE gS(:,:,:,bi,bj) = comlev1_bib
791  #ifdef ALLOW_PASSIVE_TRACER  #ifdef ALLOW_PASSIVE_TRACER
792           IF (tr1Stepping) THEN           IF (tr1Stepping) THEN
793  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
794  CADJ STORE gTr1(:,:,:,bi,bj) = comlev1_bibj , key=ikey, byte=isbyte  CADJ STORE gTr1(:,:,:,bi,bj) = comlev1_bibj , key=itdkey, byte=isbyte
795  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
796            CALL IMPLDIFF(            CALL IMPLDIFF(
797       I      bi, bj, iMin, iMax, jMin, jMax,       I      bi, bj, iMin, iMax, jMin, jMax,
# Line 668  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  Ccs-  #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 */
841    
842    C--   end bi,bj loops.
843         ENDDO         ENDDO
844        ENDDO        ENDDO
845    
 #ifdef ALLOW_AIM  
       IF ( useAIM ) THEN  
        CALL AIM_AIM2DYN_EXCHANGES( myTime, myThid )  
       ENDIF  
        _EXCH_XYZ_R8(gT,myThid)  
        _EXCH_XYZ_R8(gS,myThid)  
 #else  
       IF (staggerTimeStep.AND.useCubedSphereExchange) THEN  
        _EXCH_XYZ_R8(gT,myThid)  
        _EXCH_XYZ_R8(gS,myThid)  
       ENDIF  
 #endif /* ALLOW_AIM */  
   
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 704  Ccs- Line 862  Ccs-
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.18  
changed lines
  Added in v.1.43
  ViewVC Help
Powered by ViewVC 1.1.22