/[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.88 by dimitri, Fri Dec 17 19:17:56 2004 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
4    #include "PACKAGES_CONFIG.h"
5  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
6    
7    #ifdef ALLOW_AUTODIFF_TAMC
8    # ifdef ALLOW_GMREDI
9    #  include "GMREDI_OPTIONS.h"
10    # endif
11    # ifdef ALLOW_KPP
12    #  include "KPP_OPTIONS.h"
13    # endif
14    #endif /* ALLOW_AUTODIFF_TAMC */
15    
16  CBOP  CBOP
17  C     !ROUTINE: THERMODYNAMICS  C     !ROUTINE: THERMODYNAMICS
18  C     !INTERFACE:  C     !INTERFACE:
# Line 67  C     == Global variables === Line 77  C     == Global variables ===
77  #include "PARAMS.h"  #include "PARAMS.h"
78  #include "DYNVARS.h"  #include "DYNVARS.h"
79  #include "GRID.h"  #include "GRID.h"
80    #ifdef ALLOW_GENERIC_ADVDIFF
81  #include "GAD.h"  #include "GAD.h"
 #ifdef ALLOW_PASSIVE_TRACER  
 #include "TR1.h"  
82  #endif  #endif
83    #ifdef ALLOW_OFFLINE
84    #include "OFFLINE.h"
85    #endif
86    #ifdef ALLOW_PTRACERS
87    #include "PTRACERS_SIZE.h"
88    #include "PTRACERS.h"
89    #endif
90    #ifdef ALLOW_TIMEAVE
91    #include "TIMEAVE_STATV.h"
92    #endif
93    
94  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
95  # include "tamc.h"  # include "tamc.h"
96  # include "tamc_keys.h"  # include "tamc_keys.h"
97  # include "FFIELDS.h"  # include "FFIELDS.h"
98    # include "EOS.h"
99  # ifdef ALLOW_KPP  # ifdef ALLOW_KPP
100  #  include "KPP.h"  #  include "KPP.h"
101  # endif  # endif
102  # ifdef ALLOW_GMREDI  # ifdef ALLOW_GMREDI
103  #  include "GMREDI.h"  #  include "GMREDI.h"
104  # endif  # endif
105    # ifdef ALLOW_EBM
106    #  include "EBM.h"
107    # endif
108  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
109  #ifdef ALLOW_TIMEAVE  
 #include "TIMEAVE_STATV.h"  
 #endif  
110    
111  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
112  C     == Routine arguments ==  C     == Routine arguments ==
# Line 95  C     myThid - Thread number for this in Line 117  C     myThid - Thread number for this in
117        INTEGER myIter        INTEGER myIter
118        INTEGER myThid        INTEGER myThid
119    
120    #ifdef ALLOW_GENERIC_ADVDIFF
121  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
122  C     == Local variables  C     == Local variables
123  C     xA, yA                 - Per block temporaries holding face areas  C     xA, yA                 - Per block temporaries holding face areas
# Line 103  C                              transport Line 126  C                              transport
126  C                              o uTrans: Zonal transport  C                              o uTrans: Zonal transport
127  C                              o vTrans: Meridional transport  C                              o vTrans: Meridional transport
128  C                              o rTrans: Vertical transport  C                              o rTrans: Vertical transport
129    C     rTransKp1                o vertical volume transp. at interface k+1
130  C     maskUp                   o maskUp: land/water mask for W points  C     maskUp                   o maskUp: land/water mask for W points
131  C     fVer[STUV]               o fVer: Vertical flux term - note fVer  C     fVer[STUV]               o fVer: Vertical flux term - note fVer
132  C                                      is "pipelined" in the vertical  C                                      is "pipelined" in the vertical
133  C                                      so we need an fVer for each  C                                      so we need an fVer for each
134  C                                      variable.  C                                      variable.
135  C     rhoK, rhoKM1   - Density at current level, and level above  C     kappaRT,       - Total diffusion in vertical at level k, for T and S
136  C     phiHyd         - Hydrostatic part of the potential phiHydi.  C     kappaRS          (background + spatially varying, isopycnal term).
137  C                      In z coords phiHydiHyd is the hydrostatic  C     kappaRTr       - Total diffusion in vertical at level k,
138  C                      Potential (=pressure/rho0) anomaly  C                      for each passive Tracer
139  C                      In p coords phiHydiHyd is the geopotential  C     kappaRk        - Total diffusion in vertical, all levels, 1 tracer  
140  C                      surface height anomaly.  C     useVariableK   = T when vertical diffusion is not constant
 C     phiSurfX, - gradient of Surface potentiel (Pressure/rho, ocean)  
 C     phiSurfY             or geopotentiel (atmos) in X and Y direction  
 C     KappaRT,       - Total diffusion in vertical for T and S.  
 C     KappaRS          (background + spatially varying, isopycnal term).  
141  C     iMin, iMax     - Ranges and sub-block indices on which calculations  C     iMin, iMax     - Ranges and sub-block indices on which calculations
142  C     jMin, jMax       are applied.  C     jMin, jMax       are applied.
143  C     bi, bj  C     bi, bj
# Line 129  C                      index into fVerTe Line 149  C                      index into fVerTe
149        _RL uTrans  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL uTrans  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
150        _RL vTrans  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL vTrans  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
151        _RL rTrans  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL rTrans  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
152          _RL rTransKp1(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
153        _RS maskUp  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RS maskUp  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
154        _RL fVerT   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)        _RL fVerT   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
155        _RL fVerS   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)        _RL fVerS   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
156        _RL fVerTr1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)        _RL kappaRT (1-Olx:sNx+Olx,1-Oly:sNy+Oly)
157        _RL phiHyd  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL kappaRS (1-Olx:sNx+Olx,1-Oly:sNy+Oly)
158        _RL rhokm1  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  #ifdef ALLOW_PTRACERS
159        _RL rhok    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL fVerP   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2,PTRACERS_num)
160        _RL phiSurfX(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL kappaRTr(1-Olx:sNx+Olx,1-Oly:sNy+Oly,PTRACERS_num)
161        _RL phiSurfY(1-OLx:sNx+OLx,1-OLy:sNy+OLy)  #endif
162        _RL KappaRT (1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)        _RL kappaRk (1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
163        _RL KappaRS (1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)        _RL kp1Msk
164        _RL sigmaX  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        LOGICAL useVariableK
       _RL sigmaY  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)  
       _RL sigmaR  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)  
 C     This is currently used by IVDC and Diagnostics  
       _RL ConvectCount (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)  
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, ip
171    
172  CEOP  CEOP
173    
174    #ifdef ALLOW_DEBUG
175             IF ( debugLevel .GE. debLevB )
176         &    CALL DEBUG_ENTER('THERMODYNAMICS',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 */
199    
# 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            rTrans (i,j)   = 0. _d 0            rTrans (i,j)   = 0. _d 0
228              rTransKp1(i,j) = 0. _d 0
229            fVerT  (i,j,1) = 0. _d 0            fVerT  (i,j,1) = 0. _d 0
230            fVerT  (i,j,2) = 0. _d 0            fVerT  (i,j,2) = 0. _d 0
231            fVerS  (i,j,1) = 0. _d 0            fVerS  (i,j,1) = 0. _d 0
232            fVerS  (i,j,2) = 0. _d 0            fVerS  (i,j,2) = 0. _d 0
233            fVerTr1(i,j,1) = 0. _d 0            kappaRT(i,j)   = 0. _d 0
234            fVerTr1(i,j,2) = 0. _d 0            kappaRS(i,j)   = 0. _d 0
235    #ifdef ALLOW_PTRACERS
236              DO ip=1,PTRACERS_num
237               fVerP  (i,j,1,ip) = 0. _d 0
238               fVerP  (i,j,2,ip) = 0. _d 0
239               kappaRTr(i,j,ip)  = 0. _d 0
240              ENDDO
241    #endif
242           ENDDO           ENDDO
243          ENDDO          ENDDO
244    
# Line 230  C--     Set up work arrays that need val Line 246  C--     Set up work arrays that need val
246           DO j=1-OLy,sNy+OLy           DO j=1-OLy,sNy+OLy
247            DO i=1-OLx,sNx+OLx            DO i=1-OLx,sNx+OLx
248  C This is currently also used by IVDC and Diagnostics  C This is currently also used by IVDC and Diagnostics
249             ConvectCount(i,j,k) = 0.             kappaRk(i,j,k)    = 0. _d 0
250             KappaRT(i,j,k) = 0. _d 0  C- tracer tendency needs to be set to zero (moved here from gad_calc_rhs):
251             KappaRS(i,j,k) = 0. _d 0             gT(i,j,k,bi,bj)   = 0. _d 0
252  #ifdef ALLOW_AUTODIFF_TAMC             gS(i,j,k,bi,bj)   = 0. _d 0
253             gT(i,j,k,bi,bj) = 0. _d 0  # ifdef ALLOW_PTRACERS
254             gS(i,j,k,bi,bj) = 0. _d 0             DO iTracer=1,PTRACERS_numInUse
255  #ifdef ALLOW_PASSIVE_TRACER              gPTr(i,j,k,bi,bj,itracer) = 0. _d 0
256             gTr1(i,j,k,bi,bj) = 0. _d 0             ENDDO
257  #endif  # endif
 #endif  
258            ENDDO            ENDDO
259           ENDDO           ENDDO
260          ENDDO          ENDDO
261    
262          iMin = 1-OLx+1  c       iMin = 1-OLx
263          iMax = sNx+OLx  c       iMax = sNx+OLx
264          jMin = 1-OLy+1  c       jMin = 1-OLy
265          jMax = sNy+OLy  c       jMax = sNy+OLy
   
   
 #ifdef ALLOW_AUTODIFF_TAMC  
 CADJ STORE theta(:,:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte  
 CADJ STORE salt (:,:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte  
 #ifdef ALLOW_KPP  
 CADJ STORE uvel (:,:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte  
 CADJ STORE vvel (:,:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte  
 #endif  
 #endif /* ALLOW_AUTODIFF_TAMC */  
   
 C--     Start of diagnostic loop  
         DO k=Nr,1,-1  
   
 #ifdef ALLOW_AUTODIFF_TAMC  
 C? Patrick, is this formula correct now that we change the loop range?  
 C? Do we still need this?  
 cph kkey formula corrected.  
 cph Needed for rhok, rhokm1, in the case useGMREDI.  
          kkey = (ikey-1)*Nr + k  
 CADJ STORE rhokm1(:,:) = comlev1_bibj_k ,       key=kkey, byte=isbyte  
 CADJ STORE rhok  (:,:) = comlev1_bibj_k ,       key=kkey, byte=isbyte  
 #endif /* ALLOW_AUTODIFF_TAMC */  
   
 C--       Integrate continuity vertically for vertical velocity  
           CALL INTEGRATE_FOR_W(  
      I                         bi, bj, k, uVel, vVel,  
      O                         wVel,  
      I                         myThid )  
   
 #ifdef    ALLOW_OBCS  
 #ifdef    ALLOW_NONHYDROSTATIC  
 C--       Apply OBC to W if in N-H mode  
           IF (useOBCS.AND.nonHydrostatic) THEN  
             CALL OBCS_APPLY_W( bi, bj, k, wVel, myThid )  
           ENDIF  
 #endif    /* ALLOW_NONHYDROSTATIC */  
 #endif    /* ALLOW_OBCS */  
   
 C--       Calculate gradients of potential density for isoneutral  
 C         slope terms (e.g. GM/Redi tensor or IVDC diffusivity)  
 c         IF ( k.GT.1 .AND. (useGMRedi.OR.ivdc_kappa.NE.0.) ) THEN  
           IF ( useGMRedi .OR. (k.GT.1 .AND. ivdc_kappa.NE.0.) ) THEN  
 #ifdef ALLOW_AUTODIFF_TAMC  
 CADJ STORE theta(:,:,k,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte  
 CADJ STORE salt (:,:,k,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte  
 #endif /* ALLOW_AUTODIFF_TAMC */  
             CALL FIND_RHO(  
      I        bi, bj, iMin, iMax, jMin, jMax, k, k, eosType,  
      I        theta, salt,  
      O        rhoK,  
      I        myThid )  
             IF (k.GT.1) THEN  
 #ifdef ALLOW_AUTODIFF_TAMC  
 CADJ STORE theta(:,:,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  
 #endif /* ALLOW_AUTODIFF_TAMC */  
              CALL FIND_RHO(  
      I        bi, bj, iMin, iMax, jMin, jMax, k-1, k, eosType,  
      I        theta, salt,  
      O        rhoKm1,  
      I        myThid )  
             ENDIF  
             CALL GRAD_SIGMA(  
      I             bi, bj, iMin, iMax, jMin, jMax, k,  
      I             rhoK, rhoKm1, rhoK,  
      O             sigmaX, sigmaY, sigmaR,  
      I             myThid )  
           ENDIF  
   
 C--       Implicit Vertical Diffusion for Convection  
 c ==> should use sigmaR !!!  
           IF (k.GT.1 .AND. ivdc_kappa.NE.0.) THEN  
             CALL CALC_IVDC(  
      I        bi, bj, iMin, iMax, jMin, jMax, k,  
      I        rhoKm1, rhoK,  
      U        ConvectCount, KappaRT, KappaRS,  
      I        myTime, myIter, myThid)  
           ENDIF  
   
 C--     end of diagnostic k loop (Nr:1)  
         ENDDO  
266    
267  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
268  cph avoids recomputation of integrate_for_w  cph avoids recomputation of integrate_for_w
269  CADJ STORE wvel (:,:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE wvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
270  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
271    
272  #ifdef  ALLOW_OBCS  C--     Attention: by defining "SINGLE_LAYER_MODE" in CPP_OPTIONS.h
273  C--     Calculate future values on open boundaries  C--     MOST of THERMODYNAMICS will be disabled
274          IF (useOBCS) THEN  #ifndef SINGLE_LAYER_MODE
           CALL OBCS_CALC( bi, bj, myTime+deltaT, myIter+1,  
      I            uVel, vVel, wVel, theta, salt,  
      I            myThid )  
         ENDIF  
 #endif  /* ALLOW_OBCS */  
275    
 C--     Determines forcing terms based on external fields  
 C       relaxation terms, etc.  
         CALL EXTERNAL_FORCING_SURF(  
      I             bi, bj, iMin, iMax, jMin, jMax,  
      I             myThid )  
276  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
277  cph needed for KPP  CADJ STORE theta(:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
278  CADJ STORE surfacetendencyU(:,:,bi,bj)  CADJ STORE salt (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
279  CADJ &     = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE uvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
280  CADJ STORE surfacetendencyV(:,:,bi,bj)  CADJ STORE vvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
281  CADJ &     = comlev1_bibj, key=ikey, byte=isbyte  #ifdef ALLOW_PTRACERS
282  CADJ STORE surfacetendencyS(:,:,bi,bj)  cph-- moved to forward_step to avoid key computation
283  CADJ &     = comlev1_bibj, key=ikey, byte=isbyte  cphCADJ STORE ptracer(:,:,:,bi,bj,itracer) = comlev1_bibj,
284  CADJ STORE surfacetendencyT(:,:,bi,bj)  cphCADJ &                              key=itdkey, byte=isbyte
 CADJ &     = comlev1_bibj, key=ikey, byte=isbyte  
 #endif /* ALLOW_AUTODIFF_TAMC */  
   
 #ifdef  ALLOW_GMREDI  
   
 #ifdef ALLOW_AUTODIFF_TAMC  
 CADJ STORE sigmaX(:,:,:) = comlev1, key=ikey, byte=isbyte  
 CADJ STORE sigmaY(:,:,:) = comlev1, key=ikey, byte=isbyte  
 CADJ STORE sigmaR(:,:,:) = comlev1, key=ikey, byte=isbyte  
 #endif /* ALLOW_AUTODIFF_TAMC */  
 C--     Calculate iso-neutral slopes for the GM/Redi parameterisation  
         IF (useGMRedi) THEN  
           CALL GMREDI_CALC_TENSOR(  
      I             bi, bj, iMin, iMax, jMin, jMax,  
      I             sigmaX, sigmaY, sigmaR,  
      I             myThid )  
 #ifdef ALLOW_AUTODIFF_TAMC  
         ELSE  
           CALL GMREDI_CALC_TENSOR_DUMMY(  
      I             bi, bj, iMin, iMax, jMin, jMax,  
      I             sigmaX, sigmaY, sigmaR,  
      I             myThid )  
 #endif /* ALLOW_AUTODIFF_TAMC */  
         ENDIF  
   
 #ifdef ALLOW_AUTODIFF_TAMC  
 CADJ STORE Kwx(:,:,:,bi,bj)   = comlev1_bibj, key=ikey, byte=isbyte  
 CADJ STORE Kwy(:,:,:,bi,bj)   = comlev1_bibj, key=ikey, byte=isbyte  
 CADJ STORE Kwz(:,:,:,bi,bj)   = comlev1_bibj, key=ikey, byte=isbyte  
 #endif /* ALLOW_AUTODIFF_TAMC */  
   
 #endif  /* ALLOW_GMREDI */  
   
 #ifdef  ALLOW_KPP  
 C--     Compute KPP mixing coefficients  
         IF (useKPP) THEN  
           CALL KPP_CALC(  
      I                  bi, bj, myTime, myThid )  
 #ifdef ALLOW_AUTODIFF_TAMC  
         ELSE  
           CALL KPP_CALC_DUMMY(  
      I                  bi, bj, myTime, myThid )  
 #endif /* ALLOW_AUTODIFF_TAMC */  
         ENDIF  
   
 #ifdef ALLOW_AUTODIFF_TAMC  
 CADJ STORE KPPghat   (:,:,:,bi,bj)  
 CADJ &   , KPPdiffKzT(:,:,:,bi,bj)  
 CADJ &   , KPPdiffKzS(:,:,:,bi,bj)  
 CADJ &   , KPPfrac   (:,:  ,bi,bj)  
 CADJ &                 = comlev1_bibj, key=ikey, byte=isbyte  
 #endif /* ALLOW_AUTODIFF_TAMC */  
   
 #endif  /* ALLOW_KPP */  
   
 #ifdef ALLOW_AUTODIFF_TAMC  
 CADJ STORE KappaRT(:,:,:)     = comlev1_bibj, key=ikey, byte=isbyte  
 CADJ STORE KappaRS(:,:,:)     = comlev1_bibj, key=ikey, byte=isbyte  
 CADJ STORE theta(:,:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte  
 CADJ STORE salt (:,:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte  
 CADJ STORE uvel (:,:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte  
 CADJ STORE vvel (:,:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte  
 #ifdef ALLOW_PASSIVE_TRACER  
 CADJ STORE tr1  (:,:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte  
285  #endif  #endif
286  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
287    
 #ifdef ALLOW_AIM  
 C       AIM - atmospheric intermediate model, physics package code.  
 C note(jmc) : phiHyd=0 at this point but is not really used in Molteni Physics  
         IF ( useAIM ) THEN  
          CALL TIMER_START('AIM_DO_ATMOS_PHYS      [DYNAMICS]', myThid)  
          CALL AIM_DO_ATMOS_PHYSICS( phiHyd, bi, bj, myTime, myThid )  
          CALL TIMER_STOP ('AIM_DO_ATMOS_PHYS      [DYNAMICS]', myThid)  
         ENDIF  
 #endif /* ALLOW_AIM */  
   
 #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 */  
   
288  #ifndef DISABLE_MULTIDIM_ADVECTION  #ifndef DISABLE_MULTIDIM_ADVECTION
289  C--     Some advection schemes are better calculated using a multi-dimensional  C--     Some advection schemes are better calculated using a multi-dimensional
290  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 296  C to be able to exclude this scheme to a
296  C recomputation. It *is* differentiable, if you need it.  C recomputation. It *is* differentiable, if you need it.
297  C Edit GAD_OPTIONS.h and #define DISABLE_MULTIDIM_ADVECTION to  C Edit GAD_OPTIONS.h and #define DISABLE_MULTIDIM_ADVECTION to
298  C disable this section of code.  C disable this section of code.
299          IF (multiDimAdvection) THEN  #ifndef ALLOW_OFFLINE
300           IF (tempStepping .AND.          IF (tempMultiDimAdvec) THEN
301       &       tempAdvScheme.NE.ENUM_CENTERED_2ND .AND.  #ifdef ALLOW_DEBUG
302       &       tempAdvScheme.NE.ENUM_UPWIND_3RD .AND.            IF ( debugLevel .GE. debLevB )
303       &       tempAdvScheme.NE.ENUM_CENTERED_4TH ) THEN       &     CALL DEBUG_CALL('GAD_ADVECTION',myThid)
304            CALL GAD_ADVECTION(bi,bj,tempAdvScheme,GAD_TEMPERATURE,  #endif
305       U                      theta,gT,            CALL GAD_ADVECTION(
306       I                      myTime,myIter,myThid)       I             tempImplVertAdv, tempAdvScheme, tempVertAdvScheme,
307           ENDIF       I             GAD_TEMPERATURE,
308           IF (saltStepping .AND.       I             uVel, vVel, wVel, theta,
309       &       saltAdvScheme.NE.ENUM_CENTERED_2ND .AND.       O             gT,
310       &       saltAdvScheme.NE.ENUM_UPWIND_3RD .AND.       I             bi,bj,myTime,myIter,myThid)
311       &       saltAdvScheme.NE.ENUM_CENTERED_4TH ) THEN          ENDIF
312            CALL GAD_ADVECTION(bi,bj,saltAdvScheme,GAD_SALINITY,  #endif
313       U                      salt,gS,  #ifndef ALLOW_OFFLINE
314       I                      myTime,myIter,myThid)          IF (saltMultiDimAdvec) THEN
315           ENDIF  #ifdef ALLOW_DEBUG
316              IF ( debugLevel .GE. debLevB )
317         &     CALL DEBUG_CALL('GAD_ADVECTION',myThid)
318    #endif
319              CALL GAD_ADVECTION(
320         I             saltImplVertAdv, saltAdvScheme, saltVertAdvScheme,
321         I             GAD_SALINITY,
322         I             uVel, vVel, wVel, salt,
323         O             gS,
324         I             bi,bj,myTime,myIter,myThid)
325          ENDIF          ENDIF
326    #endif
327  C Since passive tracers are configurable separately from T,S we  C Since passive tracers are configurable separately from T,S we
328  C call the multi-dimensional method for PTRACERS regardless  C call the multi-dimensional method for PTRACERS regardless
329  C of whether multiDimAdvection is set or not.  C of whether multiDimAdvection is set or not.
330  #ifdef ALLOW_PTRACERS  #ifdef ALLOW_PTRACERS
331          IF ( usePTRACERS ) THEN          IF ( usePTRACERS ) THEN
332    #ifdef ALLOW_DEBUG
333              IF ( debugLevel .GE. debLevB )
334         &     CALL DEBUG_CALL('PTRACERS_ADVECTION',myThid)
335    #endif
336           CALL PTRACERS_ADVECTION( bi,bj,myIter,myTime,myThid )           CALL PTRACERS_ADVECTION( bi,bj,myIter,myTime,myThid )
337          ENDIF          ENDIF
338  #endif /* ALLOW_PTRACERS */  #endif /* ALLOW_PTRACERS */
339  #endif /* DISABLE_MULTIDIM_ADVECTION */  #endif /* DISABLE_MULTIDIM_ADVECTION */
340    
341    #ifdef ALLOW_DEBUG
342            IF ( debugLevel .GE. debLevB )
343         &    CALL DEBUG_MSG('ENTERING DOWNWARD K LOOP',myThid)
344    #endif
345    
346  C--     Start of thermodynamics loop  C--     Start of thermodynamics loop
347          DO k=Nr,1,-1          DO k=Nr,1,-1
348  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
349  C? Patrick Is this formula correct?  C? Patrick Is this formula correct?
350  cph Yes, but I rewrote it.  cph Yes, but I rewrote it.
351  cph Also, the KappaR? need the index and subscript k!  cph Also, the kappaR? need the index and subscript k!
352           kkey = (ikey-1)*Nr + k           kkey = (itdkey-1)*Nr + k
353  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
354    
355  C--       km1    Points to level above k (=k-1)  C--       km1    Points to level above k (=k-1)
# Line 504  C--       kDown  Cycles through 2,1 to p Line 365  C--       kDown  Cycles through 2,1 to p
365            jMin = 1-OLy            jMin = 1-OLy
366            jMax = sNy+OLy            jMax = sNy+OLy
367    
368              kp1Msk=1.
369              IF (k.EQ.Nr) kp1Msk=0.
370               DO j=1-Oly,sNy+Oly
371                DO i=1-Olx,sNx+Olx
372                 rTransKp1(i,j) = kp1Msk*rTrans(i,j)
373                ENDDO
374               ENDDO
375    #ifdef ALLOW_AUTODIFF_TAMC
376    CADJ STORE rTransKp1(:,:) = comlev1_bibj_k, key=kkey, byte=isbyte
377    #endif
378    
379  C--       Get temporary terms used by tendency routines  C--       Get temporary terms used by tendency routines
380            CALL CALC_COMMON_FACTORS (            CALL CALC_COMMON_FACTORS (
381       I         bi,bj,iMin,iMax,jMin,jMax,k,       I         bi,bj,iMin,iMax,jMin,jMax,k,
382       O         xA,yA,uTrans,vTrans,rTrans,maskUp,       O         xA,yA,uTrans,vTrans,rTrans,maskUp,
383       I         myThid)       I         myThid)
384    
385  #ifdef ALLOW_AUTODIFF_TAMC            IF (k.EQ.1) THEN
386  CADJ STORE KappaRT(:,:,k)    = comlev1_bibj_k, key=kkey, byte=isbyte  C- Surface interface :
387  CADJ STORE KappaRS(:,:,k)    = comlev1_bibj_k, key=kkey, byte=isbyte             DO j=1-Oly,sNy+Oly
388                DO i=1-Olx,sNx+Olx
389                 rTrans(i,j) = 0.
390                ENDDO
391               ENDDO
392              ELSE
393    C- Interior interface :
394               DO j=1-Oly,sNy+Oly
395                DO i=1-Olx,sNx+Olx
396                 rTrans(i,j) = rTrans(i,j)*maskC(i,j,k-1,bi,bj)
397                ENDDO
398               ENDDO
399              ENDIF
400    
401    #ifdef ALLOW_GMREDI
402    
403    C--   Residual transp = Bolus transp + Eulerian transp
404              IF (useGMRedi) THEN
405                CALL GMREDI_CALC_UVFLOW(
406         &            uTrans, vTrans, bi, bj, k, myThid)
407                IF (K.GE.2) CALL GMREDI_CALC_WFLOW(
408         &                    rTrans, bi, bj, k, myThid)
409              ENDIF
410    
411    #ifdef ALLOW_AUTODIFF_TAMC
412    CADJ STORE rTrans(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
413    #ifdef GM_BOLUS_ADVEC
414    CADJ STORE uTrans(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
415    CADJ STORE vTrans(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
416    #endif
417  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
418    
419    #endif /* ALLOW_GMREDI */
420    
421  #ifdef  INCLUDE_CALC_DIFFUSIVITY_CALL  #ifdef  INCLUDE_CALC_DIFFUSIVITY_CALL
422  C--      Calculate the total vertical diffusivity  C--      Calculate the total vertical diffusivity
423           CALL CALC_DIFFUSIVITY(            IF ( .NOT.implicitDiffusion ) THEN
424       I        bi,bj,iMin,iMax,jMin,jMax,k,              CALL CALC_DIFFUSIVITY(
425       I        maskUp,       I          bi,bj,iMin,iMax,jMin,jMax,k,
426       O        KappaRT,KappaRS,       I          maskUp,
427       I        myThid)       O          kappaRT,kappaRS,
428         I          myThid)
429              ENDIF
430    # ifdef ALLOW_AUTODIFF_TAMC
431    CADJ STORE kappaRT(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
432    CADJ STORE kappaRS(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
433    # endif /* ALLOW_AUTODIFF_TAMC */
434  #endif  #endif
435    
436            iMin = 1-OLx+2            iMin = 1-OLx+2
# Line 531  C--      Calculate the total vertical di Line 440  C--      Calculate the total vertical di
440    
441  C--      Calculate active tracer tendencies (gT,gS,...)  C--      Calculate active tracer tendencies (gT,gS,...)
442  C        and step forward storing result in gTnm1, gSnm1, etc.  C        and step forward storing result in gTnm1, gSnm1, etc.
443    #ifndef ALLOW_OFFLINE
444           IF ( tempStepping ) THEN           IF ( tempStepping ) THEN
445             CALL CALC_GT(             CALL CALC_GT(
446       I         bi,bj,iMin,iMax,jMin,jMax, k,km1,kup,kDown,       I         bi,bj,iMin,iMax,jMin,jMax, k,km1,kup,kDown,
447       I         xA,yA,uTrans,vTrans,rTrans,maskUp,       I         xA,yA,uTrans,vTrans,rTrans,rTransKp1,maskUp,
448       I         KappaRT,       I         kappaRT,
449       U         fVerT,       U         fVerT,
450       I         myTime,myIter,myThid)       I         myTime,myIter,myThid)
451             CALL TIMESTEP_TRACER(             CALL TIMESTEP_TRACER(
# Line 543  C        and step forward storing result Line 453  C        and step forward storing result
453       I         theta, gT,       I         theta, gT,
454       I         myIter, myThid)       I         myIter, myThid)
455           ENDIF           ENDIF
456    #endif
457    
458    #ifndef ALLOW_OFFLINE
459           IF ( saltStepping ) THEN           IF ( saltStepping ) THEN
460             CALL CALC_GS(             CALL CALC_GS(
461       I         bi,bj,iMin,iMax,jMin,jMax, k,km1,kup,kDown,       I         bi,bj,iMin,iMax,jMin,jMax, k,km1,kup,kDown,
462       I         xA,yA,uTrans,vTrans,rTrans,maskUp,       I         xA,yA,uTrans,vTrans,rTrans,rTransKp1,maskUp,
463       I         KappaRS,       I         kappaRS,
464       U         fVerS,       U         fVerS,
465       I         myTime,myIter,myThid)       I         myTime,myIter,myThid)
466             CALL TIMESTEP_TRACER(             CALL TIMESTEP_TRACER(
# Line 555  C        and step forward storing result Line 468  C        and step forward storing result
468       I         salt, gS,       I         salt, gS,
469       I         myIter, myThid)       I         myIter, myThid)
470           ENDIF           ENDIF
 #ifdef ALLOW_PASSIVE_TRACER  
          IF ( tr1Stepping ) THEN  
            CALL CALC_GTR1(  
      I         bi,bj,iMin,iMax,jMin,jMax, k,km1,kup,kDown,  
      I         xA,yA,uTrans,vTrans,rTrans,maskUp,  
      I         KappaRT,  
      U         fVerTr1,  
      I         myTime,myIter,myThid)  
            CALL TIMESTEP_TRACER(  
      I         bi,bj,iMin,iMax,jMin,jMax,k,tracerAdvScheme,  
      I         Tr1, gTr1,  
      I         myIter,myThid)  
          ENDIF  
471  #endif  #endif
472  #ifdef ALLOW_PTRACERS  #ifdef ALLOW_PTRACERS
473           IF ( usePTRACERS ) THEN           IF ( usePTRACERS ) THEN
474             CALL PTRACERS_INTEGERATE(             IF ( .NOT.implicitDiffusion ) THEN
475                 CALL PTRACERS_CALC_DIFF(
476         I            bi,bj,iMin,iMax,jMin,jMax,k,
477         I            maskUp,
478         O            kappaRTr,
479         I            myThid)
480               ENDIF
481               CALL PTRACERS_INTEGRATE(
482       I         bi,bj,k,       I         bi,bj,k,
483       I         xA,yA,uTrans,vTrans,rTrans,maskUp,       I         xA,yA,uTrans,vTrans,rTrans,rTransKp1,maskUp,
484       X         KappaRS,       U         fVerP,
485         I         kappaRTr,
486       I         myIter,myTime,myThid)       I         myIter,myTime,myThid)
487           ENDIF           ENDIF
488  #endif /* ALLOW_PTRACERS */  #endif /* ALLOW_PTRACERS */
# Line 587  C--      Apply open boundary conditions Line 495  C--      Apply open boundary conditions
495  #endif   /* ALLOW_OBCS */  #endif   /* ALLOW_OBCS */
496    
497  C--      Freeze water  C--      Freeze water
498           IF (allowFreezing) THEN  C  this bit of code is left here for backward compatibility.
499    C  freezing at surface level has been moved to FORWARD_STEP
500    #ifndef ALLOW_OFFLINE
501             IF ( useOldFreezing .AND. .NOT. useSEAICE
502         &       .AND. .NOT.(useThSIce.AND.k.EQ.1) ) THEN
503  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
504  CADJ STORE gT(:,:,k,bi,bj) = comlev1_bibj_k  CADJ STORE gT(:,:,k,bi,bj) = comlev1_bibj_k
505  CADJ &   , key = kkey, byte = isbyte  CADJ &   , key = kkey, byte = isbyte
506  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
507              CALL FREEZE( bi, bj, iMin, iMax, jMin, jMax, k, myThid )              CALL FREEZE( bi, bj, iMin, iMax, jMin, jMax, k, myThid )
508           END IF           ENDIF
509    #endif
510    
511  C--     end of thermodynamic k loop (Nr:1)  C--     end of thermodynamic k loop (Nr:1)
512          ENDDO          ENDDO
513    
514            iMin = 1
515  #ifdef ALLOW_AUTODIFF_TAMC          iMax = sNx
516  C? Patrick? What about this one?          jMin = 1
517  cph Keys iikey and idkey dont seem to be needed          jMax = sNy
518  cph since storing occurs on different tape for each  
519  cph impldiff call anyways.  C--     Implicit vertical advection & diffusion
520  cph Thus, common block comlev1_impl isnt needed either.  #ifndef ALLOW_OFFLINE
521  cph Storing below needed in the case useGMREDI.          IF ( tempStepping .AND. implicitDiffusion ) THEN
522          iikey = (ikey-1)*maximpl            CALL CALC_3D_DIFFUSIVITY(
523  #endif /* ALLOW_AUTODIFF_TAMC */       I         bi,bj,iMin,iMax,jMin,jMax,
524         I         GAD_TEMPERATURE, useGMredi, useKPP,
525  C--     Implicit diffusion       O         kappaRk,
526          IF (implicitDiffusion) THEN       I         myThid)
527            ENDIF
528           IF (tempStepping) THEN  #ifdef INCLUDE_IMPLVERTADV_CODE
529            IF ( tempImplVertAdv ) THEN
530              CALL GAD_IMPLICIT_R(
531         I         tempImplVertAdv, tempAdvScheme, GAD_TEMPERATURE,
532         I         kappaRk, wVel, theta,
533         U         gT,
534         I         bi, bj, myTime, myIter, myThid )
535            ELSEIF ( tempStepping .AND. implicitDiffusion ) THEN
536    #else /* INCLUDE_IMPLVERTADV_CODE */
537            IF     ( tempStepping .AND. implicitDiffusion ) THEN
538    #endif /* INCLUDE_IMPLVERTADV_CODE */
539  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
540              idkey = iikey + 1  CADJ STORE kappaRk(:,:,:) = comlev1_bibj , key=itdkey, byte=isbyte
541  CADJ STORE gT(:,:,:,bi,bj) = comlev1_bibj , key=ikey, byte=isbyte  CADJ STORE gT(:,:,:,bi,bj) = comlev1_bibj , key=itdkey, byte=isbyte
542  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
543              CALL IMPLDIFF(            CALL IMPLDIFF(
544       I         bi, bj, iMin, iMax, jMin, jMax,       I         bi, bj, iMin, iMax, jMin, jMax,
545       I         deltaTtracer, KappaRT, recip_HFacC,       I         GAD_TEMPERATURE, kappaRk, recip_hFacC,
546       U         gT,       U         gT,
547       I         myThid )       I         myThid )
548            ENDIF
549    #endif /* ndef ALLOW_OFFLINE */
550    
551    #ifdef ALLOW_TIMEAVE
552    #ifndef MINIMAL_TAVE_OUTPUT
553            useVariableK = useKPP .OR. usePP81 .OR. useMY82 .OR. useGGL90
554         &       .OR. useGMredi .OR. ivdc_kappa.NE.0.
555            IF (taveFreq.GT.0. .AND. useVariableK ) THEN
556             IF (implicitDiffusion) THEN
557               CALL TIMEAVE_CUMUL_DIF_1T(TdiffRtave, gT, kappaRk,
558         I                        Nr, 3, deltaTclock, bi, bj, myThid)
559    c        ELSE
560    c          CALL TIMEAVE_CUMUL_DIF_1T(TdiffRtave, theta, kappaRT,
561    c    I                        Nr, 3, deltaTclock, bi, bj, myThid)
562           ENDIF           ENDIF
563            ENDIF
564    #endif /* ndef MINIMAL_TAVE_OUTPUT */
565    #endif /* ALLOW_TIMEAVE */
566    
567    #ifndef ALLOW_OFFLINE
568            IF ( saltStepping .AND. implicitDiffusion ) THEN
569              CALL CALC_3D_DIFFUSIVITY(
570         I         bi,bj,iMin,iMax,jMin,jMax,
571         I         GAD_SALINITY, useGMredi, useKPP,
572         O         kappaRk,
573         I         myThid)
574            ENDIF
575    
576           IF (saltStepping) THEN  #ifdef INCLUDE_IMPLVERTADV_CODE
577            IF ( saltImplVertAdv ) THEN
578              CALL GAD_IMPLICIT_R(
579         I         saltImplVertAdv, saltAdvScheme, GAD_SALINITY,
580         I         kappaRk, wVel, salt,
581         U         gS,
582         I         bi, bj, myTime, myIter, myThid )
583            ELSEIF ( saltStepping .AND. implicitDiffusion ) THEN
584    #else /* INCLUDE_IMPLVERTADV_CODE */
585            IF     ( saltStepping .AND. implicitDiffusion ) THEN
586    #endif /* INCLUDE_IMPLVERTADV_CODE */
587  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
588           idkey = iikey + 2  CADJ STORE kappaRk(:,:,:) = comlev1_bibj , key=itdkey, byte=isbyte
589  CADJ STORE gS(:,:,:,bi,bj) = comlev1_bibj , key=ikey, byte=isbyte  CADJ STORE gS(:,:,:,bi,bj) = comlev1_bibj , key=itdkey, byte=isbyte
590  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
591              CALL IMPLDIFF(            CALL IMPLDIFF(
592       I         bi, bj, iMin, iMax, jMin, jMax,       I         bi, bj, iMin, iMax, jMin, jMax,
593       I         deltaTtracer, KappaRS, recip_HFacC,       I         GAD_SALINITY, kappaRk, recip_hFacC,
594       U         gS,       U         gS,
595       I         myThid )       I         myThid )
596           ENDIF          ENDIF
   
 #ifdef ALLOW_PASSIVE_TRACER  
          IF (tr1Stepping) THEN  
 #ifdef ALLOW_AUTODIFF_TAMC  
 CADJ STORE gTr1(:,:,:,bi,bj) = comlev1_bibj , key=ikey, byte=isbyte  
 #endif /* ALLOW_AUTODIFF_TAMC */  
           CALL IMPLDIFF(  
      I      bi, bj, iMin, iMax, jMin, jMax,  
      I      deltaTtracer, KappaRT, recip_HFacC,  
      U      gTr1,  
      I      myThid )  
          ENDIF  
597  #endif  #endif
598    
599  #ifdef ALLOW_PTRACERS  #ifdef ALLOW_PTRACERS
600  C Vertical diffusion (implicit) for passive tracers          IF     ( usePTRACERS ) THEN
601           IF ( usePTRACERS ) THEN  C--     Vertical advection/diffusion (implicit) for passive tracers
602             CALL PTRACERS_IMPLDIFF( bi,bj,KappaRS,myThid )             CALL PTRACERS_IMPLICIT(
603           ENDIF       U                             kappaRk,
604         I                             bi, bj, myTime, myIter, myThid )
605            ENDIF
606  #endif /* ALLOW_PTRACERS */  #endif /* ALLOW_PTRACERS */
607    
608  #ifdef   ALLOW_OBCS  #ifdef   ALLOW_OBCS
609  C--      Apply open boundary conditions  C--      Apply open boundary conditions
610           IF (useOBCS) THEN          IF ( ( implicitDiffusion
611         &    .OR. tempImplVertAdv
612         &    .OR. saltImplVertAdv
613         &       ) .AND. useOBCS     ) THEN
614             DO K=1,Nr             DO K=1,Nr
615               CALL OBCS_APPLY_TS( bi, bj, k, gT, gS, myThid )               CALL OBCS_APPLY_TS( bi, bj, k, gT, gS, myThid )
616             ENDDO             ENDDO
617           END IF          ENDIF
618  #endif   /* ALLOW_OBCS */  #endif   /* ALLOW_OBCS */
619    
620  C--     End If implicitDiffusion  #ifdef ALLOW_TIMEAVE
621            IF ( taveFreq.GT. 0. _d 0 .AND. fluidIsWater ) THEN
622              CALL TIMEAVE_SURF_FLUX( bi, bj, myTime, myIter, myThid)
623            ENDIF
624    #ifndef MINIMAL_TAVE_OUTPUT
625            IF (taveFreq.GT.0. .AND. ivdc_kappa.NE.0.) THEN
626              CALL TIMEAVE_CUMULATE(ConvectCountTave, IVDConvCount,
627         I                           Nr, deltaTclock, bi, bj, myThid)
628          ENDIF          ENDIF
629    #endif /* ndef MINIMAL_TAVE_OUTPUT */
630    #endif /* ALLOW_TIMEAVE */
631    
632    #ifdef ALLOW_DIAGNOSTICS
633            IF ( usediagnostics ) CALL DIAGNOSTICS_FILL_SURF_FLUX(myThid)
634    #endif
635    
636  Ccs-  #endif /* SINGLE_LAYER_MODE */
637    
638    C--   end bi,bj loops.
639         ENDDO         ENDDO
640        ENDDO        ENDDO
641    
642  #ifdef ALLOW_AIM  #ifdef ALLOW_DEBUG
       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 */  
   
 #ifndef DISABLE_DEBUGMODE  
643        If (debugMode) THEN        If (debugMode) THEN
644         CALL DEBUG_STATS_RL(Nr,uVel,'Uvel (THERMODYNAMICS)',myThid)         CALL DEBUG_STATS_RL(Nr,uVel,'Uvel (THERMODYNAMICS)',myThid)
645         CALL DEBUG_STATS_RL(Nr,vVel,'Vvel (THERMODYNAMICS)',myThid)         CALL DEBUG_STATS_RL(Nr,vVel,'Vvel (THERMODYNAMICS)',myThid)
# Line 704  Ccs- Line 658  Ccs-
658        ENDIF        ENDIF
659  #endif  #endif
660    
661    #ifdef ALLOW_DEBUG
662             IF ( debugLevel .GE. debLevB )
663         &    CALL DEBUG_LEAVE('THERMODYNAMICS',myThid)
664    #endif
665    
666    #endif /* ALLOW_GENERIC_ADVDIFF */
667    
668        RETURN        RETURN
669        END        END
Legend:
Removed from v.1.18  
changed lines
  Added in v.1.88
  ViewVC Help
Powered by ViewVC 1.1.22