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

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

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

revision 1.74 by heimbach, Mon Jul 30 20:37:45 2001 UTC revision 1.163 by dimitri, Thu Nov 15 15:55:42 2012 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    #ifdef ALLOW_OBCS
7    # include "OBCS_OPTIONS.h"
8    #endif
9    
10    #undef DYNAMICS_GUGV_EXCH_CHECK
11    
12    CBOP
13    C     !ROUTINE: DYNAMICS
14    C     !INTERFACE:
15        SUBROUTINE DYNAMICS(myTime, myIter, myThid)        SUBROUTINE DYNAMICS(myTime, myIter, myThid)
16  C     /==========================================================\  C     !DESCRIPTION: \bv
17  C     | SUBROUTINE DYNAMICS                                      |  C     *==========================================================*
18  C     | o Controlling routine for the explicit part of the model |  C     | SUBROUTINE DYNAMICS
19  C     |   dynamics.                                              |  C     | o Controlling routine for the explicit part of the model
20  C     |==========================================================|  C     |   dynamics.
21  C     | This routine evaluates the "dynamics" terms for each     |  C     *==========================================================*
22  C     | block of ocean in turn. Because the blocks of ocean have |  C     | This routine evaluates the "dynamics" terms for each
23  C     | overlap regions they are independent of one another.     |  C     | block of ocean in turn. Because the blocks of ocean have
24  C     | If terms involving lateral integrals are needed in this  |  C     | overlap regions they are independent of one another.
25  C     | routine care will be needed. Similarly finite-difference |  C     | If terms involving lateral integrals are needed in this
26  C     | operations with stencils wider than the overlap region   |  C     | routine care will be needed. Similarly finite-difference
27  C     | require special consideration.                           |  C     | operations with stencils wider than the overlap region
28  C     | Notes                                                    |  C     | require special consideration.
29  C     | =====                                                    |  C     | The algorithm...
30  C     | C*P* comments indicating place holders for which code is |  C     |
31  C     |      presently being developed.                          |  C     | "Correction Step"
32  C     \==========================================================/  C     | =================
33    C     | Here we update the horizontal velocities with the surface
34    C     | pressure such that the resulting flow is either consistent
35    C     | with the free-surface evolution or the rigid-lid:
36    C     |   U[n] = U* + dt x d/dx P
37    C     |   V[n] = V* + dt x d/dy P
38    C     |   W[n] = W* + dt x d/dz P  (NH mode)
39    C     |
40    C     | "Calculation of Gs"
41    C     | ===================
42    C     | This is where all the accelerations and tendencies (ie.
43    C     | physics, parameterizations etc...) are calculated
44    C     |   rho = rho ( theta[n], salt[n] )
45    C     |   b   = b(rho, theta)
46    C     |   K31 = K31 ( rho )
47    C     |   Gu[n] = Gu( u[n], v[n], wVel, b, ... )
48    C     |   Gv[n] = Gv( u[n], v[n], wVel, b, ... )
49    C     |   Gt[n] = Gt( theta[n], u[n], v[n], wVel, K31, ... )
50    C     |   Gs[n] = Gs( salt[n], u[n], v[n], wVel, K31, ... )
51    C     |
52    C     | "Time-stepping" or "Prediction"
53    C     | ================================
54    C     | The models variables are stepped forward with the appropriate
55    C     | time-stepping scheme (currently we use Adams-Bashforth II)
56    C     | - For momentum, the result is always *only* a "prediction"
57    C     | in that the flow may be divergent and will be "corrected"
58    C     | later with a surface pressure gradient.
59    C     | - Normally for tracers the result is the new field at time
60    C     | level [n+1} *BUT* in the case of implicit diffusion the result
61    C     | is also *only* a prediction.
62    C     | - We denote "predictors" with an asterisk (*).
63    C     |   U* = U[n] + dt x ( 3/2 Gu[n] - 1/2 Gu[n-1] )
64    C     |   V* = V[n] + dt x ( 3/2 Gv[n] - 1/2 Gv[n-1] )
65    C     |   theta[n+1] = theta[n] + dt x ( 3/2 Gt[n] - 1/2 atG[n-1] )
66    C     |   salt[n+1] = salt[n] + dt x ( 3/2 Gt[n] - 1/2 atG[n-1] )
67    C     | With implicit diffusion:
68    C     |   theta* = theta[n] + dt x ( 3/2 Gt[n] - 1/2 atG[n-1] )
69    C     |   salt* = salt[n] + dt x ( 3/2 Gt[n] - 1/2 atG[n-1] )
70    C     |   (1 + dt * K * d_zz) theta[n] = theta*
71    C     |   (1 + dt * K * d_zz) salt[n] = salt*
72    C     |
73    C     *==========================================================*
74    C     \ev
75    C     !USES:
76        IMPLICIT NONE        IMPLICIT NONE
   
77  C     == Global variables ===  C     == Global variables ===
78  #include "SIZE.h"  #include "SIZE.h"
79  #include "EEPARAMS.h"  #include "EEPARAMS.h"
80  #include "PARAMS.h"  #include "PARAMS.h"
81  #include "DYNVARS.h"  #include "DYNVARS.h"
82  #include "GRID.h"  #ifdef ALLOW_CD_CODE
83  #ifdef ALLOW_PASSIVE_TRACER  #include "CD_CODE_VARS.h"
 #include "TR1.h"  
84  #endif  #endif
85    #include "GRID.h"
86  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
87  # include "tamc.h"  # include "tamc.h"
88  # include "tamc_keys.h"  # include "tamc_keys.h"
89  # include "FFIELDS.h"  # include "FFIELDS.h"
90    # include "EOS.h"
91  # ifdef ALLOW_KPP  # ifdef ALLOW_KPP
92  #  include "KPP.h"  #  include "KPP.h"
93  # endif  # endif
94  # ifdef ALLOW_GMREDI  # ifdef ALLOW_PTRACERS
95  #  include "GMREDI.h"  #  include "PTRACERS_SIZE.h"
96    #  include "PTRACERS_FIELDS.h"
97    # endif
98    # ifdef ALLOW_OBCS
99    #include "OBCS_PARAMS.h"
100    #  include "OBCS_FIELDS.h"
101    #  ifdef ALLOW_PTRACERS
102    #   include "OBCS_PTRACERS.h"
103    #  endif
104    # endif
105    # ifdef ALLOW_MOM_FLUXFORM
106    #  include "MOM_FLUXFORM.h"
107  # endif  # endif
108  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
109    
110  #ifdef ALLOW_TIMEAVE  C     !CALLING SEQUENCE:
111  #include "TIMEAVE_STATV.h"  C     DYNAMICS()
112  #endif  C      |
113    C      |-- CALC_EP_FORCING
114    C      |
115    C      |-- CALC_GRAD_PHI_SURF
116    C      |
117    C      |-- CALC_VISCOSITY
118    C      |
119    C      |-- CALC_PHI_HYD
120    C      |
121    C      |-- MOM_FLUXFORM
122    C      |
123    C      |-- MOM_VECINV
124    C      |
125    C      |-- TIMESTEP
126    C      |
127    C      |-- MOM_U_IMPLICIT_R
128    C      |-- MOM_V_IMPLICIT_R
129    C      |
130    C      |-- IMPLDIFF
131    C      |
132    C      |-- OBCS_APPLY_UV
133    C      |
134    C      |-- CALC_GW
135    C      |
136    C      |-- DIAGNOSTICS_FILL
137    C      |-- DEBUG_STATS_RL
138    
139    C     !INPUT/OUTPUT PARAMETERS:
140  C     == Routine arguments ==  C     == Routine arguments ==
141  C     myTime - Current time in simulation  C     myTime :: Current time in simulation
142  C     myIter - Current iteration number in simulation  C     myIter :: Current iteration number in simulation
143  C     myThid - Thread number for this instance of the routine.  C     myThid :: Thread number for this instance of the routine.
144        _RL myTime        _RL myTime
145        INTEGER myIter        INTEGER myIter
146        INTEGER myThid        INTEGER myThid
147    
148    C     !FUNCTIONS:
149    #ifdef ALLOW_DIAGNOSTICS
150          LOGICAL  DIAGNOSTICS_IS_ON
151          EXTERNAL DIAGNOSTICS_IS_ON
152    #endif
153    
154    C     !LOCAL VARIABLES:
155  C     == Local variables  C     == Local variables
156  C     xA, yA                 - Per block temporaries holding face areas  C     fVer[UV]               o fVer: Vertical flux term - note fVer
157  C     uTrans, vTrans, rTrans - Per block temporaries holding flow  C                                    is "pipelined" in the vertical
158  C                              transport  C                                    so we need an fVer for each
159  C                              o uTrans: Zonal transport  C                                    variable.
160  C                              o vTrans: Meridional transport  C     phiHydC    :: hydrostatic potential anomaly at cell center
161  C                              o rTrans: Vertical transport  C                   In z coords phiHyd is the hydrostatic potential
162  C     maskUp                   o maskUp: land/water mask for W points  C                      (=pressure/rho0) anomaly
163  C     fVer[STUV]               o fVer: Vertical flux term - note fVer  C                   In p coords phiHyd is the geopotential height anomaly.
164  C                                      is "pipelined" in the vertical  C     phiHydF    :: hydrostatic potential anomaly at middle between 2 centers
165  C                                      so we need an fVer for each  C     dPhiHydX,Y :: Gradient (X & Y directions) of hydrostatic potential anom.
166  C                                      variable.  C     phiSurfX,  ::  gradient of Surface potential (Pressure/rho, ocean)
167  C     rhoK, rhoKM1   - Density at current level, and level above  C     phiSurfY             or geopotential (atmos) in X and Y direction
168  C     phiHyd         - Hydrostatic part of the potential phiHydi.  C     guDissip   :: dissipation tendency (all explicit terms), u component
169  C                      In z coords phiHydiHyd is the hydrostatic  C     gvDissip   :: dissipation tendency (all explicit terms), v component
170  C                      Potential (=pressure/rho0) anomaly  C     KappaRU    :: vertical viscosity
171  C                      In p coords phiHydiHyd is the geopotential  C     KappaRV    :: vertical viscosity
172  C                      surface height anomaly.  C     iMin, iMax :: Ranges and sub-block indices on which calculations
173  C     phiSurfX, - gradient of Surface potentiel (Pressure/rho, ocean)  C     jMin, jMax    are applied.
174  C     phiSurfY             or geopotentiel (atmos) in X and Y direction  C     bi, bj     :: tile indices
175  C     KappaRT,       - Total diffusion in vertical for T and S.  C     k          :: current level index
176  C     KappaRS          (background + spatially varying, isopycnal term).  C     km1, kp1   :: index of level above (k-1) and below (k+1)
177  C     iMin, iMax     - Ranges and sub-block indices on which calculations  C     kUp, kDown :: Index for interface above and below. kUp and kDown are
178  C     jMin, jMax       are applied.  C                   are switched with k to be the appropriate index into fVerU,V
 C     bi, bj  
 C     k, kup,        - Index for layer above and below. kup and kDown  
 C     kDown, km1       are switched with layer to be the appropriate  
 C                      index into fVerTerm.  
 C     tauAB - Adams-Bashforth timestepping weight: 0=forward ; 1/2=Adams-Bashf.  
       _RS xA      (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
       _RS yA      (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
       _RL uTrans  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
       _RL vTrans  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
       _RL rTrans  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
       _RS maskUp  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
       _RL fVerT   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)  
       _RL fVerS   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)  
       _RL fVerTr1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)  
179        _RL fVerU   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)        _RL fVerU   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
180        _RL fVerV   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)        _RL fVerV   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
181        _RL phiHyd  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL phiHydF (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
182        _RL rhokm1  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL phiHydC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
183        _RL rhok    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL dPhiHydX(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
184          _RL dPhiHydY(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
185        _RL phiSurfX(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL phiSurfX(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
186        _RL phiSurfY(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL phiSurfY(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
187        _RL KappaRT (1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)        _RL guDissip(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
188        _RL KappaRS (1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)        _RL gvDissip(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
189        _RL KappaRU (1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)        _RL KappaRU (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
190        _RL KappaRV (1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)        _RL KappaRV (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
       _RL sigmaX  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)  
       _RL sigmaY  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)  
       _RL sigmaR  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)  
       _RL tauAB  
   
 C This is currently used by IVDC and Diagnostics  
       _RL ConvectCount (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)  
191    
192        INTEGER iMin, iMax        INTEGER iMin, iMax
193        INTEGER jMin, jMax        INTEGER jMin, jMax
194        INTEGER bi, bj        INTEGER bi, bj
195        INTEGER i, j        INTEGER i, j
196        INTEGER k, km1, kup, kDown        INTEGER k, km1, kp1, kUp, kDown
197    
198    #ifdef ALLOW_DIAGNOSTICS
199          LOGICAL dPhiHydDiagIsOn
200          _RL tmpFac
201    #endif /* ALLOW_DIAGNOSTICS */
202    
203    
 Cjmc : add for phiHyd output <- but not working if multi tile per CPU  
 c     CHARACTER*(MAX_LEN_MBUF) suff  
 c     LOGICAL  DIFFERENT_MULTIPLE  
 c     EXTERNAL DIFFERENT_MULTIPLE  
 Cjmc(end)  
   
204  C---    The algorithm...  C---    The algorithm...
205  C  C
206  C       "Correction Step"  C       "Correction Step"
# Line 169  C         salt* = salt[n] + dt x ( 3/2 G Line 244  C         salt* = salt[n] + dt x ( 3/2 G
244  C         (1 + dt * K * d_zz) theta[n] = theta*  C         (1 + dt * K * d_zz) theta[n] = theta*
245  C         (1 + dt * K * d_zz) salt[n] = salt*  C         (1 + dt * K * d_zz) salt[n] = salt*
246  C---  C---
247    CEOP
248    
249  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_DEBUG
250  C--   dummy statement to end declaration part        IF (debugMode) CALL DEBUG_ENTER( 'DYNAMICS', myThid )
251        ikey = 1  #endif
 #endif /* ALLOW_AUTODIFF_TAMC */  
252    
253  C--   Set up work arrays with valid (i.e. not NaN) values  #ifdef ALLOW_DIAGNOSTICS
254  C     These inital values do not alter the numerical results. They        dPhiHydDiagIsOn = .FALSE.
255  C     just ensure that all memory references are to valid floating        IF ( useDiagnostics )
256  C     point numbers. This prevents spurious hardware signals due to       &  dPhiHydDiagIsOn = DIAGNOSTICS_IS_ON( 'Um_dPHdx', myThid )
257  C     uninitialised but inert locations.       &               .OR. DIAGNOSTICS_IS_ON( 'Vm_dPHdy', myThid )
258        DO j=1-OLy,sNy+OLy  #endif
        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  
          KappaRU(i,j,k) = 0. _d 0  
          KappaRV(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  
259    
260    C-- Call to routine for calculation of
261    C   Eliassen-Palm-flux-forced U-tendency,
262    C   if desired:
263    #ifdef INCLUDE_EP_FORCING_CODE
264          CALL CALC_EP_FORCING(myThid)
265    #endif
266    
267    #ifdef ALLOW_AUTODIFF_MONITOR_DIAG
268          CALL DUMMY_IN_DYNAMICS( myTime, myIter, myThid )
269    #endif
270    
271  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
272  C--   HPF directive to help TAMC  C--   HPF directive to help TAMC
# Line 211  CHPF$ INDEPENDENT Line 277  CHPF$ INDEPENDENT
277    
278  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
279  C--    HPF directive to help TAMC  C--    HPF directive to help TAMC
280  CHPF$  INDEPENDENT, NEW (rTrans,fVerT,fVerS,fVerU,fVerV  CHPF$  INDEPENDENT, NEW (fVerU,fVerV
281  CHPF$&                  ,phiHyd,utrans,vtrans,xA,yA  CHPF$&                  ,phiHydF
282  CHPF$&                  ,KappaRT,KappaRS,KappaRU,KappaRV  CHPF$&                  ,KappaRU,KappaRV
283  CHPF$&                  )  CHPF$&                  )
284  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
285    
# Line 222  CHPF$&                  ) Line 288  CHPF$&                  )
288  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
289            act1 = bi - myBxLo(myThid)            act1 = bi - myBxLo(myThid)
290            max1 = myBxHi(myThid) - myBxLo(myThid) + 1            max1 = myBxHi(myThid) - myBxLo(myThid) + 1
   
291            act2 = bj - myByLo(myThid)            act2 = bj - myByLo(myThid)
292            max2 = myByHi(myThid) - myByLo(myThid) + 1            max2 = myByHi(myThid) - myByLo(myThid) + 1
   
293            act3 = myThid - 1            act3 = myThid - 1
294            max3 = nTx*nTy            max3 = nTx*nTy
   
295            act4 = ikey_dynamics - 1            act4 = ikey_dynamics - 1
296              idynkey = (act1 + 1) + act2*max1
           ikey = (act1 + 1) + act2*max1  
297       &                      + act3*max1*max2       &                      + act3*max1*max2
298       &                      + act4*max1*max2*max3       &                      + act4*max1*max2*max3
299  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
300    
301  C--     Set up work arrays that need valid initial values  C--   Set up work arrays with valid (i.e. not NaN) values
302          DO j=1-OLy,sNy+OLy  C     These initial values do not alter the numerical results. They
303           DO i=1-OLx,sNx+OLx  C     just ensure that all memory references are to valid floating
304            rTrans (i,j)   = 0. _d 0  C     point numbers. This prevents spurious hardware signals due to
305            fVerT  (i,j,1) = 0. _d 0  C     uninitialised but inert locations.
           fVerT  (i,j,2) = 0. _d 0  
           fVerS  (i,j,1) = 0. _d 0  
           fVerS  (i,j,2) = 0. _d 0  
           fVerTr1(i,j,1) = 0. _d 0  
           fVerTr1(i,j,2) = 0. _d 0  
           fVerU  (i,j,1) = 0. _d 0  
           fVerU  (i,j,2) = 0. _d 0  
           fVerV  (i,j,1) = 0. _d 0  
           fVerV  (i,j,2) = 0. _d 0  
          ENDDO  
         ENDDO  
306    
307    #ifdef ALLOW_AUTODIFF_TAMC
308          DO k=1,Nr          DO k=1,Nr
309           DO j=1-OLy,sNy+OLy           DO j=1-OLy,sNy+OLy
310            DO i=1-OLx,sNx+OLx            DO i=1-OLx,sNx+OLx
311  C This is currently also used by IVDC and Diagnostics             KappaRU(i,j,k) = 0. _d 0
312             ConvectCount(i,j,k) = 0.             KappaRV(i,j,k) = 0. _d 0
313             KappaRT(i,j,k) = 0. _d 0  cph(
314             KappaRS(i,j,k) = 0. _d 0  c--   need some re-initialisation here to break dependencies
315    cph)
316               gU(i,j,k,bi,bj) = 0. _d 0
317               gV(i,j,k,bi,bj) = 0. _d 0
318            ENDDO            ENDDO
319           ENDDO           ENDDO
320          ENDDO          ENDDO
   
         iMin = 1-OLx+1  
         iMax = sNx+OLx  
         jMin = 1-OLy+1  
         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  
 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  
 #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  
321  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
322            DO j=1-OLy,sNy+OLy
323  C--       Integrate continuity vertically for vertical velocity           DO i=1-OLx,sNx+OLx
324            CALL INTEGRATE_FOR_W(            fVerU  (i,j,1) = 0. _d 0
325       I                         bi, bj, k, uVel, vVel,            fVerU  (i,j,2) = 0. _d 0
326       O                         wVel,            fVerV  (i,j,1) = 0. _d 0
327       I                         myThid )            fVerV  (i,j,2) = 0. _d 0
328              phiHydF (i,j)  = 0. _d 0
329  #ifdef    ALLOW_OBCS            phiHydC (i,j)  = 0. _d 0
330  #ifdef    ALLOW_NONHYDROSTATIC  #ifndef INCLUDE_PHIHYD_CALCULATION_CODE
331  C--       Apply OBC to W if in N-H mode            dPhiHydX(i,j)  = 0. _d 0
332            IF (useOBCS.AND.nonHydrostatic) THEN            dPhiHydY(i,j)  = 0. _d 0
333              CALL OBCS_APPLY_W( bi, bj, k, wVel, myThid )  #endif
334            ENDIF            phiSurfX(i,j)  = 0. _d 0
335  #endif    /* ALLOW_NONHYDROSTATIC */            phiSurfY(i,j)  = 0. _d 0
336  #endif    /* ALLOW_OBCS */            guDissip(i,j)  = 0. _d 0
337              gvDissip(i,j)  = 0. _d 0
338  C--       Calculate gradients of potential density for isoneutral  #ifdef ALLOW_AUTODIFF_TAMC
339  C         slope terms (e.g. GM/Redi tensor or IVDC diffusivity)            phiHydLow(i,j,bi,bj) = 0. _d 0
340  c         IF ( k.GT.1 .AND. (useGMRedi.OR.ivdc_kappa.NE.0.) ) THEN  # if (defined NONLIN_FRSURF) && (defined ALLOW_MOM_FLUXFORM)
341            IF ( useGMRedi .OR. (k.GT.1 .AND. ivdc_kappa.NE.0.) ) THEN  #  ifndef DISABLE_RSTAR_CODE
342  #ifdef ALLOW_AUTODIFF_TAMC            dWtransC(i,j,bi,bj) = 0. _d 0
343  CADJ STORE theta(:,:,k,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte            dWtransU(i,j,bi,bj) = 0. _d 0
344  CADJ STORE salt (:,:,k,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte            dWtransV(i,j,bi,bj) = 0. _d 0
345  #endif /* ALLOW_AUTODIFF_TAMC */  #  endif
346              CALL FIND_RHO(  # endif
347       I        bi, bj, iMin, iMax, jMin, jMax, k, k, eosType,  #endif
348       I        theta, salt,           ENDDO
      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)  
349          ENDDO          ENDDO
350    
351  #ifdef ALLOW_AUTODIFF_TAMC  C--     Start computation of dynamics
352  cph avoids recomputation of integrate_for_w          iMin = 0
353  CADJ STORE wvel (:,:,:,bi,bj) = comlev1_bibj, key = ikey, byte = isbyte          iMax = sNx+1
354  #endif /* ALLOW_AUTODIFF_TAMC */          jMin = 0
355            jMax = sNy+1
 #ifdef  ALLOW_OBCS  
 C--     Calculate future values on open boundaries  
         IF (useOBCS) THEN  
           CALL OBCS_CALC( bi, bj, myTime+deltaT,  
      I            uVel, vVel, wVel, theta, salt,  
      I            myThid )  
         ENDIF  
 #endif  /* ALLOW_OBCS */  
   
 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 )  
 #ifdef ALLOW_AUTODIFF_TAMC  
 cph needed for KPP  
 CADJ STORE surfacetendencyU(:,:,bi,bj)  
 CADJ &     = comlev1_bibj, key=ikey, byte=isbyte  
 CADJ STORE surfacetendencyV(:,:,bi,bj)  
 CADJ &     = comlev1_bibj, key=ikey, byte=isbyte  
 CADJ STORE surfacetendencyS(:,:,bi,bj)  
 CADJ &     = comlev1_bibj, key=ikey, byte=isbyte  
 CADJ STORE surfacetendencyT(:,:,bi,bj)  
 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  
           DO k=1,Nr  
             CALL GMREDI_CALC_TENSOR(  
      I             bi, bj, iMin, iMax, jMin, jMax, k,  
      I             sigmaX, sigmaY, sigmaR,  
      I             myThid )  
           ENDDO  
 #ifdef ALLOW_AUTODIFF_TAMC  
         ELSE  
           DO k=1, Nr  
             CALL GMREDI_CALC_TENSOR_DUMMY(  
      I             bi, bj, iMin, iMax, jMin, jMax, k,  
      I             sigmaX, sigmaY, sigmaR,  
      I             myThid )  
           ENDDO  
 #endif /* ALLOW_AUTODIFF_TAMC */  
         ENDIF  
356    
357  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
358  CADJ STORE Kwx(:,:,:,bi,bj)   = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE wVel (:,:,:,bi,bj) =
359  CADJ STORE Kwy(:,:,:,bi,bj)   = comlev1_bibj, key=ikey, byte=isbyte  CADJ &     comlev1_bibj, key=idynkey, byte=isbyte
 CADJ STORE Kwz(:,:,:,bi,bj)   = comlev1_bibj, key=ikey, byte=isbyte  
360  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
361    
362  #endif  /* ALLOW_GMREDI */  C--     Explicit part of the Surface Potential Gradient (add in TIMESTEP)
363    C       (note: this loop will be replaced by CALL CALC_GRAD_ETA)
364  #ifdef  ALLOW_KPP          IF (implicSurfPress.NE.1.) THEN
365  C--     Compute KPP mixing coefficients            CALL CALC_GRAD_PHI_SURF(
366          IF (useKPP) THEN       I         bi,bj,iMin,iMax,jMin,jMax,
367            CALL KPP_CALC(       I         etaN,
368       I                  bi, bj, myTime, myThid )       O         phiSurfX,phiSurfY,
369  #ifdef ALLOW_AUTODIFF_TAMC       I         myThid )
         ELSE  
           CALL KPP_CALC_DUMMY(  
      I                  bi, bj, myTime, myThid )  
 #endif /* ALLOW_AUTODIFF_TAMC */  
370          ENDIF          ENDIF
371    
372  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
373  CADJ STORE KPPghat   (:,:,:,bi,bj)  CADJ STORE uVel (:,:,:,bi,bj) = comlev1_bibj, key=idynkey, byte=isbyte
374  CADJ &   , KPPviscAz (:,:,:,bi,bj)  CADJ STORE vVel (:,:,:,bi,bj) = comlev1_bibj, key=idynkey, byte=isbyte
375  CADJ &   , KPPdiffKzT(:,:,:,bi,bj)  #ifdef ALLOW_KPP
376  CADJ &   , KPPdiffKzS(:,:,:,bi,bj)  CADJ STORE KPPviscAz (:,:,:,bi,bj)
377  CADJ &   , KPPfrac   (:,:  ,bi,bj)  CADJ &                 = comlev1_bibj, key=idynkey, byte=isbyte
378  CADJ &                 = comlev1_bibj, key=ikey, byte=isbyte  #endif /* ALLOW_KPP */
 #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  
 #endif  
 #endif /* ALLOW_AUTODIFF_TAMC */  
   
 #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 */  
   
   
 C--     Start of thermodynamics loop  
         DO k=Nr,1,-1  
 #ifdef ALLOW_AUTODIFF_TAMC  
 C? Patrick Is this formula correct?  
 cph Yes, but I rewrote it.  
 cph Also, the KappaR? need the index and subscript k!  
          kkey = (ikey-1)*Nr + k  
 #endif /* ALLOW_AUTODIFF_TAMC */  
   
 C--       km1    Points to level above k (=k-1)  
 C--       kup    Cycles through 1,2 to point to layer above  
 C--       kDown  Cycles through 2,1 to point to current layer  
   
           km1  = MAX(1,k-1)  
           kup  = 1+MOD(k+1,2)  
           kDown= 1+MOD(k,2)  
   
           iMin = 1-OLx  
           iMax = sNx+OLx  
           jMin = 1-OLy  
           jMax = sNy+OLy  
   
 C--       Get temporary terms used by tendency routines  
           CALL CALC_COMMON_FACTORS (  
      I         bi,bj,iMin,iMax,jMin,jMax,k,  
      O         xA,yA,uTrans,vTrans,rTrans,maskUp,  
      I         myThid)  
   
 #ifdef ALLOW_AUTODIFF_TAMC  
 CADJ STORE KappaRT(:,:,k)    = comlev1_bibj_k, key=kkey, byte=isbyte  
 CADJ STORE KappaRS(:,:,k)    = comlev1_bibj_k, key=kkey, byte=isbyte  
379  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
380    
381  #ifdef  INCLUDE_CALC_DIFFUSIVITY_CALL  #ifdef  INCLUDE_CALC_DIFFUSIVITY_CALL
382  C--      Calculate the total vertical diffusivity  C--     Calculate the total vertical viscosity
383           CALL CALC_DIFFUSIVITY(          CALL CALC_VISCOSITY(
384       I        bi,bj,iMin,iMax,jMin,jMax,k,       I            bi,bj, iMin,iMax,jMin,jMax,
385       I        maskUp,       O            KappaRU, KappaRV,
386       O        KappaRT,KappaRS,KappaRU,KappaRV,       I            myThid )
387       I        myThid)  #else
388  #endif          DO k=1,Nr
389             DO j=1-OLy,sNy+OLy
390            iMin = 1-OLx+2            DO i=1-OLx,sNx+OLx
391            iMax = sNx+OLx-1             KappaRU(i,j,k) = 0. _d 0
392            jMin = 1-OLy+2             KappaRV(i,j,k) = 0. _d 0
393            jMax = sNy+OLy-1            ENDDO
394             ENDDO
 C--      Calculate active tracer tendencies (gT,gS,...)  
 C        and step forward storing result in gTnm1, gSnm1, etc.  
          IF ( tempStepping ) THEN  
            CALL CALC_GT(  
      I         bi,bj,iMin,iMax,jMin,jMax, k,km1,kup,kDown,  
      I         xA,yA,uTrans,vTrans,rTrans,maskUp,  
      I         KappaRT,  
      U         fVerT,  
      I         myTime, myThid)  
            tauAB = 0.5d0 + abEps  
            CALL TIMESTEP_TRACER(  
      I         bi,bj,iMin,iMax,jMin,jMax,k,tauAB,  
      I         theta, gT,  
      U         gTnm1,  
      I         myIter, myThid)  
          ENDIF  
          IF ( saltStepping ) THEN  
            CALL CALC_GS(  
      I         bi,bj,iMin,iMax,jMin,jMax, k,km1,kup,kDown,  
      I         xA,yA,uTrans,vTrans,rTrans,maskUp,  
      I         KappaRS,  
      U         fVerS,  
      I         myTime, myThid)  
            tauAB = 0.5d0 + abEps  
            CALL TIMESTEP_TRACER(  
      I         bi,bj,iMin,iMax,jMin,jMax,k,tauAB,  
      I         salt, gS,  
      U         gSnm1,  
      I         myIter, myThid)  
          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, myThid)  
            tauAB = 0.5d0 + abEps  
            CALL TIMESTEP_TRACER(  
      I         bi,bj,iMin,iMax,jMin,jMax,k,tauAB,  
      I         Tr1, gTr1,  
      U         gTr1NM1,  
      I         myIter, myThid)  
          ENDIF  
 #endif  
   
 #ifdef   ALLOW_OBCS  
 C--      Apply open boundary conditions  
          IF (useOBCS) THEN  
            CALL OBCS_APPLY_TS( bi, bj, k, gTnm1, gSnm1, myThid )  
          END IF  
 #endif   /* ALLOW_OBCS */  
   
 C--      Freeze water  
          IF (allowFreezing) THEN  
 #ifdef ALLOW_AUTODIFF_TAMC  
 CADJ STORE gTNm1(:,:,k,bi,bj) = comlev1_bibj_k  
 CADJ &   , key = kkey, byte = isbyte  
 #endif /* ALLOW_AUTODIFF_TAMC */  
             CALL FREEZE( bi, bj, iMin, iMax, jMin, jMax, k, myThid )  
          END IF  
   
 C--     end of thermodynamic k loop (Nr:1)  
395          ENDDO          ENDDO
396    #endif
397    
   
 #ifdef ALLOW_AUTODIFF_TAMC  
 C? Patrick? What about this one?  
 cph Keys iikey and idkey don't seem to be needed  
 cph since storing occurs on different tape for each  
 cph impldiff call anyways.  
 cph Thus, common block comlev1_impl isn't needed either.  
 cph Storing below needed in the case useGMREDI.  
         iikey = (ikey-1)*maximpl  
 #endif /* ALLOW_AUTODIFF_TAMC */  
   
 C--     Implicit diffusion  
         IF (implicitDiffusion) THEN  
   
          IF (tempStepping) THEN  
 #ifdef ALLOW_AUTODIFF_TAMC  
             idkey = iikey + 1  
 CADJ STORE gTNm1(:,:,:,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         gTNm1,  
      I         myThid )  
          ENDIF  
   
          IF (saltStepping) THEN  
398  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
399           idkey = iikey + 2  CADJ STORE KappaRU(:,:,:)
400  CADJ STORE gSNm1(:,:,:,bi,bj) = comlev1_bibj , key=ikey, byte=isbyte  CADJ &     = comlev1_bibj, key=idynkey, byte=isbyte
401    CADJ STORE KappaRV(:,:,:)
402    CADJ &     = comlev1_bibj, key=idynkey, byte=isbyte
403  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
             CALL IMPLDIFF(  
      I         bi, bj, iMin, iMax, jMin, jMax,  
      I         deltaTtracer, KappaRS, recip_HFacC,  
      U         gSNm1,  
      I         myThid )  
          ENDIF  
404    
405  #ifdef ALLOW_PASSIVE_TRACER  #ifdef ALLOW_OBCS
406           IF (tr1Stepping) THEN  C--   For Stevens boundary conditions velocities need to be extrapolated
407  #ifdef ALLOW_AUTODIFF_TAMC  C     (copied) to a narrow strip outside the domain
408  CADJ STORE gTr1Nm1(:,:,:,bi,bj) = comlev1_bibj , key=ikey, byte=isbyte           IF ( useOBCS ) THEN
409  #endif /* ALLOW_AUTODIFF_TAMC */            CALL OBCS_COPY_UV_N(
410            CALL IMPLDIFF(       U         uVel(1-OLx,1-OLy,1,bi,bj),
411       I      bi, bj, iMin, iMax, jMin, jMax,       U         vVel(1-OLx,1-OLy,1,bi,bj),
412       I      deltaTtracer, KappaRT, recip_HFacC,       I         Nr, bi, bj, myThid )
      U      gTr1Nm1,  
      I      myThid )  
413           ENDIF           ENDIF
414  #endif  #endif /* ALLOW_OBCS */
   
 #ifdef   ALLOW_OBCS  
 C--      Apply open boundary conditions  
          IF (useOBCS) THEN  
            DO K=1,Nr  
              CALL OBCS_APPLY_TS( bi, bj, k, gTnm1, gSnm1, myThid )  
            ENDDO  
          END IF  
 #endif   /* ALLOW_OBCS */  
   
 C--     End If implicitDiffusion  
         ENDIF  
   
 C--     Start computation of dynamics  
         iMin = 1-OLx+2  
         iMax = sNx+OLx-1  
         jMin = 1-OLy+2  
         jMax = sNy+OLy-1  
   
 C--     Explicit part of the Surface Potentiel Gradient (add in TIMESTEP)  
 C       (note: this loop will be replaced by CALL CALC_GRAD_ETA)  
         IF (implicSurfPress.NE.1.) THEN  
           CALL CALC_GRAD_PHI_SURF(  
      I         bi,bj,iMin,iMax,jMin,jMax,  
      I         etaN,  
      O         phiSurfX,phiSurfY,  
      I         myThid )                          
         ENDIF  
415    
416  C--     Start of dynamics loop  C--     Start of dynamics loop
417          DO k=1,Nr          DO k=1,Nr
# Line 663  C--       kup    Cycles through 1,2 to p Line 421  C--       kup    Cycles through 1,2 to p
421  C--       kDown  Cycles through 2,1 to point to current layer  C--       kDown  Cycles through 2,1 to point to current layer
422    
423            km1  = MAX(1,k-1)            km1  = MAX(1,k-1)
424              kp1  = MIN(k+1,Nr)
425            kup  = 1+MOD(k+1,2)            kup  = 1+MOD(k+1,2)
426            kDown= 1+MOD(k,2)            kDown= 1+MOD(k,2)
427    
428  C--      Integrate hydrostatic balance for phiHyd with BC of  #ifdef ALLOW_AUTODIFF_TAMC
429             kkey = (idynkey-1)*Nr + k
430    c
431    CADJ STORE totPhiHyd (:,:,k,bi,bj)
432    CADJ &     = comlev1_bibj_k, key=kkey, byte=isbyte
433    CADJ STORE phiHydLow (:,:,bi,bj)
434    CADJ &     = comlev1_bibj_k, key=kkey, byte=isbyte
435    CADJ STORE theta (:,:,k,bi,bj)
436    CADJ &     = comlev1_bibj_k, key=kkey, byte=isbyte
437    CADJ STORE salt  (:,:,k,bi,bj)
438    CADJ &     = comlev1_bibj_k, key=kkey, byte=isbyte
439    CADJ STORE gT(:,:,k,bi,bj)
440    CADJ &     = comlev1_bibj_k, key=kkey, byte=isbyte
441    CADJ STORE gS(:,:,k,bi,bj)
442    CADJ &     = comlev1_bibj_k, key=kkey, byte=isbyte
443    # ifdef NONLIN_FRSURF
444    cph-test
445    CADJ STORE  phiHydC (:,:)
446    CADJ &     = comlev1_bibj_k, key=kkey, byte=isbyte
447    CADJ STORE  phiHydF (:,:)
448    CADJ &     = comlev1_bibj_k, key=kkey, byte=isbyte
449    CADJ STORE  guDissip (:,:)
450    CADJ &     = comlev1_bibj_k, key=kkey, byte=isbyte
451    CADJ STORE  gvDissip (:,:)
452    CADJ &     = comlev1_bibj_k, key=kkey, byte=isbyte
453    CADJ STORE  fVerU (:,:,:)
454    CADJ &     = comlev1_bibj_k, key=kkey, byte=isbyte
455    CADJ STORE  fVerV (:,:,:)
456    CADJ &     = comlev1_bibj_k, key=kkey, byte=isbyte
457    CADJ STORE gU(:,:,k,bi,bj)
458    CADJ &     = comlev1_bibj_k, key=kkey, byte=isbyte
459    CADJ STORE gV(:,:,k,bi,bj)
460    CADJ &     = comlev1_bibj_k, key=kkey, byte=isbyte
461    #  ifndef ALLOW_ADAMSBASHFORTH_3
462    CADJ STORE guNm1(:,:,k,bi,bj)
463    CADJ &     = comlev1_bibj_k, key=kkey, byte=isbyte
464    CADJ STORE gvNm1(:,:,k,bi,bj)
465    CADJ &     = comlev1_bibj_k, key=kkey, byte=isbyte
466    #  else
467    CADJ STORE guNm(:,:,k,bi,bj,1)
468    CADJ &     = comlev1_bibj_k, key=kkey, byte=isbyte
469    CADJ STORE guNm(:,:,k,bi,bj,2)
470    CADJ &     = comlev1_bibj_k, key=kkey, byte=isbyte
471    CADJ STORE gvNm(:,:,k,bi,bj,1)
472    CADJ &     = comlev1_bibj_k, key=kkey, byte=isbyte
473    CADJ STORE gvNm(:,:,k,bi,bj,2)
474    CADJ &     = comlev1_bibj_k, key=kkey, byte=isbyte
475    #  endif
476    #  ifdef ALLOW_CD_CODE
477    CADJ STORE uNM1(:,:,k,bi,bj)
478    CADJ &     = comlev1_bibj_k, key=kkey, byte=isbyte
479    CADJ STORE vNM1(:,:,k,bi,bj)
480    CADJ &     = comlev1_bibj_k, key=kkey, byte=isbyte
481    CADJ STORE uVelD(:,:,k,bi,bj)
482    CADJ &     = comlev1_bibj_k, key=kkey, byte=isbyte
483    CADJ STORE vVelD(:,:,k,bi,bj)
484    CADJ &     = comlev1_bibj_k, key=kkey, byte=isbyte
485    #  endif
486    # endif
487    # ifdef ALLOW_DEPTH_CONTROL
488    CADJ STORE  fVerU (:,:,:)
489    CADJ &     = comlev1_bibj_k, key=kkey, byte=isbyte
490    CADJ STORE  fVerV (:,:,:)
491    CADJ &     = comlev1_bibj_k, key=kkey, byte=isbyte
492    # endif
493    #endif /* ALLOW_AUTODIFF_TAMC */
494    
495    C--      Integrate hydrostatic balance for phiHyd with BC of
496  C        phiHyd(z=0)=0  C        phiHyd(z=0)=0
497  C        distinguishe between Stagger and Non Stagger time stepping           IF ( implicitIntGravWave ) THEN
          IF (staggerTimeStep) THEN  
498             CALL CALC_PHI_HYD(             CALL CALC_PHI_HYD(
499       I        bi,bj,iMin,iMax,jMin,jMax,k,       I        bi,bj,iMin,iMax,jMin,jMax,k,
500       I        gTnm1, gSnm1,       I        gT, gS,
501       U        phiHyd,       U        phiHydF,
502       I        myThid )       O        phiHydC, dPhiHydX, dPhiHydY,
503         I        myTime, myIter, myThid )
504           ELSE           ELSE
505             CALL CALC_PHI_HYD(             CALL CALC_PHI_HYD(
506       I        bi,bj,iMin,iMax,jMin,jMax,k,       I        bi,bj,iMin,iMax,jMin,jMax,k,
507       I        theta, salt,       I        theta, salt,
508       U        phiHyd,       U        phiHydF,
509       I        myThid )       O        phiHydC, dPhiHydX, dPhiHydY,
510         I        myTime, myIter, myThid )
511             ENDIF
512    #ifdef ALLOW_DIAGNOSTICS
513             IF ( dPhiHydDiagIsOn ) THEN
514               tmpFac = -1. _d 0
515               CALL DIAGNOSTICS_SCALE_FILL( dPhiHydX, tmpFac, 1,
516         &                           'Um_dPHdx', k, 1, 2, bi, bj, myThid )
517               CALL DIAGNOSTICS_SCALE_FILL( dPhiHydY, tmpFac, 1,
518         &                           'Vm_dPHdy', k, 1, 2, bi, bj, myThid )
519           ENDIF           ENDIF
520    #endif /* ALLOW_DIAGNOSTICS */
521    
522  C--      Calculate accelerations in the momentum equations (gU, gV, ...)  C--      Calculate accelerations in the momentum equations (gU, gV, ...)
523  C        and step forward storing the result in gUnm1, gVnm1, etc...  C        and step forward storing the result in gU, gV, etc...
524           IF ( momStepping ) THEN           IF ( momStepping ) THEN
525             CALL CALC_MOM_RHS(  #ifdef ALLOW_AUTODIFF_TAMC
526       I         bi,bj,iMin,iMax,jMin,jMax,k,kup,kDown,  # ifdef NONLIN_FRSURF
527       I         phiHyd,KappaRU,KappaRV,  #  if (defined ALLOW_MOM_FLUXFORM) && !(defined DISABLE_RSTAR_CODE)
528       U         fVerU, fVerV,  CADJ STORE dWtransC(:,:,bi,bj)
529       I         myTime, myThid)  CADJ &     = comlev1_bibj_k, key=kkey, byte=isbyte
530    CADJ STORE dWtransU(:,:,bi,bj)
531    CADJ &     = comlev1_bibj_k, key=kkey, byte=isbyte
532    CADJ STORE dWtransV(:,:,bi,bj)
533    CADJ &     = comlev1_bibj_k, key=kkey, byte=isbyte
534    #  endif
535    CADJ STORE fVerU(:,:,:)
536    CADJ &     = comlev1_bibj_k, key=kkey, byte=isbyte
537    CADJ STORE fVerV(:,:,:)
538    CADJ &     = comlev1_bibj_k, key=kkey, byte=isbyte
539    # endif /* NONLIN_FRSURF */
540    #endif /* ALLOW_AUTODIFF_TAMC */
541               IF (.NOT. vectorInvariantMomentum) THEN
542    #ifdef ALLOW_MOM_FLUXFORM
543                  CALL MOM_FLUXFORM(
544         I         bi,bj,k,iMin,iMax,jMin,jMax,
545         I         KappaRU, KappaRV,
546         U         fVerU(1-OLx,1-OLy,kUp),   fVerV(1-OLx,1-OLy,kUp),
547         O         fVerU(1-OLx,1-OLy,kDown), fVerV(1-OLx,1-OLy,kDown),
548         O         guDissip, gvDissip,
549         I         myTime, myIter, myThid)
550    #endif
551               ELSE
552    #ifdef ALLOW_MOM_VECINV
553                 CALL MOM_VECINV(
554         I         bi,bj,k,iMin,iMax,jMin,jMax,
555         I         KappaRU, KappaRV,
556         I         fVerU(1-OLx,1-OLy,kUp),   fVerV(1-OLx,1-OLy,kUp),
557         O         fVerU(1-OLx,1-OLy,kDown), fVerV(1-OLx,1-OLy,kDown),
558         O         guDissip, gvDissip,
559         I         myTime, myIter, myThid)
560    #endif
561               ENDIF
562    C
563             CALL TIMESTEP(             CALL TIMESTEP(
564       I         bi,bj,iMin,iMax,jMin,jMax,k,       I         bi,bj,iMin,iMax,jMin,jMax,k,
565       I         phiHyd, phiSurfX, phiSurfY,       I         dPhiHydX,dPhiHydY, phiSurfX, phiSurfY,
566       I         myIter, myThid)       I         guDissip, gvDissip,
567         I         myTime, myIter, myThid)
568    
 #ifdef   ALLOW_OBCS  
 C--      Apply open boundary conditions  
          IF (useOBCS) THEN  
            CALL OBCS_APPLY_UV( bi, bj, k, gUnm1, gVnm1, myThid )  
          END IF  
 #endif   /* ALLOW_OBCS */  
   
 #ifdef   ALLOW_AUTODIFF_TAMC  
 #ifdef   INCLUDE_CD_CODE  
          ELSE  
            DO j=1-OLy,sNy+OLy  
              DO i=1-OLx,sNx+OLx  
                guCD(i,j,k,bi,bj) = 0.0  
                gvCD(i,j,k,bi,bj) = 0.0  
              END DO  
            END DO  
 #endif   /* INCLUDE_CD_CODE */  
 #endif   /* ALLOW_AUTODIFF_TAMC */  
569           ENDIF           ENDIF
570    
   
571  C--     end of dynamics k loop (1:Nr)  C--     end of dynamics k loop (1:Nr)
572          ENDDO          ENDDO
573    
574    C--     Implicit Vertical advection & viscosity
575    #if (defined (INCLUDE_IMPLVERTADV_CODE) && \
576  C--     Implicit viscosity       defined (ALLOW_MOM_COMMON) && !(defined ALLOW_AUTODIFF_TAMC))
577          IF (implicitViscosity.AND.momStepping) THEN          IF ( momImplVertAdv ) THEN
578              CALL MOM_U_IMPLICIT_R( kappaRU,
579         I                           bi, bj, myTime, myIter, myThid )
580              CALL MOM_V_IMPLICIT_R( kappaRV,
581         I                           bi, bj, myTime, myIter, myThid )
582            ELSEIF ( implicitViscosity ) THEN
583    #else /* INCLUDE_IMPLVERTADV_CODE */
584            IF     ( implicitViscosity ) THEN
585    #endif /* INCLUDE_IMPLVERTADV_CODE */
586  #ifdef    ALLOW_AUTODIFF_TAMC  #ifdef    ALLOW_AUTODIFF_TAMC
587            idkey = iikey + 3  CADJ STORE KappaRU(:,:,:) = comlev1_bibj , key=idynkey, byte=isbyte
588  CADJ STORE gUNm1(:,:,:,bi,bj) = comlev1_bibj , key=ikey, byte=isbyte  CADJ STORE gU(:,:,:,bi,bj) = comlev1_bibj , key=idynkey, byte=isbyte
589  #endif    /* ALLOW_AUTODIFF_TAMC */  #endif    /* ALLOW_AUTODIFF_TAMC */
590            CALL IMPLDIFF(            CALL IMPLDIFF(
591       I         bi, bj, iMin, iMax, jMin, jMax,       I         bi, bj, iMin, iMax, jMin, jMax,
592       I         deltaTmom, KappaRU,recip_HFacW,       I         -1, KappaRU, recip_hFacW(1-OLx,1-OLy,1,bi,bj),
593       U         gUNm1,       U         gU,
594       I         myThid )       I         myThid )
595  #ifdef    ALLOW_AUTODIFF_TAMC  #ifdef    ALLOW_AUTODIFF_TAMC
596            idkey = iikey + 4  CADJ STORE KappaRV(:,:,:) = comlev1_bibj , key=idynkey, byte=isbyte
597  CADJ STORE gVNm1(:,:,:,bi,bj) = comlev1_bibj , key=ikey, byte=isbyte  CADJ STORE gV(:,:,:,bi,bj) = comlev1_bibj , key=idynkey, byte=isbyte
598  #endif    /* ALLOW_AUTODIFF_TAMC */  #endif    /* ALLOW_AUTODIFF_TAMC */
599            CALL IMPLDIFF(            CALL IMPLDIFF(
600       I         bi, bj, iMin, iMax, jMin, jMax,       I         bi, bj, iMin, iMax, jMin, jMax,
601       I         deltaTmom, KappaRV,recip_HFacS,       I         -2, KappaRV, recip_hFacS(1-OLx,1-OLy,1,bi,bj),
602       U         gVNm1,       U         gV,
603       I         myThid )       I         myThid )
604            ENDIF
605    
606  #ifdef   ALLOW_OBCS  #ifdef ALLOW_OBCS
607  C--      Apply open boundary conditions  C--      Apply open boundary conditions
608           IF (useOBCS) THEN          IF ( useOBCS ) THEN
609             DO K=1,Nr  C--      but first save intermediate velocities to be used in the
610               CALL OBCS_APPLY_UV( bi, bj, k, gUnm1, gVnm1, myThid )  C        next time step for the Stevens boundary conditions
611             ENDDO            CALL OBCS_SAVE_UV_N(
612           END IF       I        bi, bj, iMin, iMax, jMin, jMax, 0,
613  #endif   /* ALLOW_OBCS */       I        gU, gV, myThid )
614              CALL OBCS_APPLY_UV( bi, bj, 0, gU, gV, myThid )
615            ENDIF
616    #endif /* ALLOW_OBCS */
617    
618  #ifdef    INCLUDE_CD_CODE  #ifdef    ALLOW_CD_CODE
619            IF (implicitViscosity.AND.useCDscheme) THEN
620  #ifdef    ALLOW_AUTODIFF_TAMC  #ifdef    ALLOW_AUTODIFF_TAMC
621            idkey = iikey + 5  CADJ STORE vVelD(:,:,:,bi,bj) = comlev1_bibj , key=idynkey, byte=isbyte
 CADJ STORE vVelD(:,:,:,bi,bj) = comlev1_bibj , key=ikey, byte=isbyte  
622  #endif    /* ALLOW_AUTODIFF_TAMC */  #endif    /* ALLOW_AUTODIFF_TAMC */
623            CALL IMPLDIFF(            CALL IMPLDIFF(
624       I         bi, bj, iMin, iMax, jMin, jMax,       I         bi, bj, iMin, iMax, jMin, jMax,
625       I         deltaTmom, KappaRU,recip_HFacW,       I         0, KappaRU, recip_hFacW(1-OLx,1-OLy,1,bi,bj),
626       U         vVelD,       U         vVelD,
627       I         myThid )       I         myThid )
628  #ifdef    ALLOW_AUTODIFF_TAMC  #ifdef    ALLOW_AUTODIFF_TAMC
629            idkey = iikey + 6  CADJ STORE uVelD(:,:,:,bi,bj) = comlev1_bibj , key=idynkey, byte=isbyte
 CADJ STORE uVelD(:,:,:,bi,bj) = comlev1_bibj , key=ikey, byte=isbyte  
630  #endif    /* ALLOW_AUTODIFF_TAMC */  #endif    /* ALLOW_AUTODIFF_TAMC */
631            CALL IMPLDIFF(            CALL IMPLDIFF(
632       I         bi, bj, iMin, iMax, jMin, jMax,       I         bi, bj, iMin, iMax, jMin, jMax,
633       I         deltaTmom, KappaRV,recip_HFacS,       I         0, KappaRV, recip_hFacS(1-OLx,1-OLy,1,bi,bj),
634       U         uVelD,       U         uVelD,
635       I         myThid )       I         myThid )
 #endif    /* INCLUDE_CD_CODE */  
 C--     End If implicitViscosity.AND.momStepping  
636          ENDIF          ENDIF
637    #endif    /* ALLOW_CD_CODE */
638  Cjmc : add for phiHyd output <- but not working if multi tile per CPU  C--     End implicit Vertical advection & viscosity
639  c       IF ( DIFFERENT_MULTIPLE(dumpFreq,myTime+deltaTClock,myTime)  
640  c    &  .AND. buoyancyRelation .eq. 'ATMOSPHERIC' ) THEN  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
641  c         WRITE(suff,'(I10.10)') myIter+1  
642  c         CALL WRITE_FLD_XYZ_RL('PH.',suff,phiHyd,myIter+1,myThid)  #ifdef ALLOW_NONHYDROSTATIC
643  c       ENDIF  C--   Step forward W field in N-H algorithm
644  Cjmc(end)          IF ( nonHydrostatic ) THEN
645    #ifdef ALLOW_DEBUG
646  #ifdef ALLOW_TIMEAVE           IF (debugMode) CALL DEBUG_CALL('CALC_GW', myThid )
647          IF (taveFreq.GT.0.) THEN  #endif
648            CALL TIMEAVE_CUMUL_1T(phiHydtave, phiHyd, Nr,           CALL TIMER_START('CALC_GW          [DYNAMICS]',myThid)
649       I                              deltaTclock, bi, bj, myThid)           CALL CALC_GW(
650            IF (ivdc_kappa.NE.0.) THEN       I                 bi,bj, KappaRU, KappaRV,
651              CALL TIMEAVE_CUMULATE(ConvectCountTave, ConvectCount, Nr,       I                 myTime, myIter, myThid )
      I                              deltaTclock, bi, bj, myThid)  
           ENDIF  
652          ENDIF          ENDIF
653  #endif /* ALLOW_TIMEAVE */          IF ( nonHydrostatic.OR.implicitIntGravWave )
654         &   CALL TIMESTEP_WVEL( bi,bj, myTime, myIter, myThid )
655            IF ( nonHydrostatic )
656         &   CALL TIMER_STOP ('CALC_GW          [DYNAMICS]',myThid)
657    #endif
658    
659    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
660    
661    C-    end of bi,bj loops
662         ENDDO         ENDDO
663        ENDDO        ENDDO
664    
665  #ifndef EXCLUDE_DEBUGMODE  #ifdef ALLOW_OBCS
666        If (debugMode) THEN        IF (useOBCS) THEN
667            CALL OBCS_EXCHANGES( myThid )
668          ENDIF
669    #endif
670    
671    Cml(
672    C     In order to compare the variance of phiHydLow of a p/z-coordinate
673    C     run with etaH of a z/p-coordinate run the drift of phiHydLow
674    C     has to be removed by something like the following subroutine:
675    C      CALL REMOVE_MEAN_RL( 1, phiHydLow, maskInC, maskInC, rA, drF,
676    C     &                     'phiHydLow', myTime, myThid )
677    Cml)
678    
679    #ifdef ALLOW_DIAGNOSTICS
680          IF ( useDiagnostics ) THEN
681    
682           CALL DIAGNOSTICS_FILL(totPhihyd,'PHIHYD  ',0,Nr,0,1,1,myThid)
683           CALL DIAGNOSTICS_FILL(phiHydLow,'PHIBOT  ',0, 1,0,1,1,myThid)
684    
685           tmpFac = 1. _d 0
686           CALL DIAGNOSTICS_SCALE_FILL(totPhihyd,tmpFac,2,
687         &                                 'PHIHYDSQ',0,Nr,0,1,1,myThid)
688    
689           CALL DIAGNOSTICS_SCALE_FILL(phiHydLow,tmpFac,2,
690         &                                 'PHIBOTSQ',0, 1,0,1,1,myThid)
691    
692          ENDIF
693    #endif /* ALLOW_DIAGNOSTICS */
694    
695    #ifdef ALLOW_DEBUG
696          IF ( debugLevel .GE. debLevD ) THEN
697         CALL DEBUG_STATS_RL(1,EtaN,'EtaN (DYNAMICS)',myThid)         CALL DEBUG_STATS_RL(1,EtaN,'EtaN (DYNAMICS)',myThid)
698         CALL DEBUG_STATS_RL(Nr,uVel,'Uvel (DYNAMICS)',myThid)         CALL DEBUG_STATS_RL(Nr,uVel,'Uvel (DYNAMICS)',myThid)
699         CALL DEBUG_STATS_RL(Nr,vVel,'Vvel (DYNAMICS)',myThid)         CALL DEBUG_STATS_RL(Nr,vVel,'Vvel (DYNAMICS)',myThid)
700         CALL DEBUG_STATS_RL(Nr,wVel,'Wvel (DYNAMICS)',myThid)         CALL DEBUG_STATS_RL(Nr,wVel,'Wvel (DYNAMICS)',myThid)
701         CALL DEBUG_STATS_RL(Nr,theta,'Theta (DYNAMICS)',myThid)         CALL DEBUG_STATS_RL(Nr,theta,'Theta (DYNAMICS)',myThid)
702         CALL DEBUG_STATS_RL(Nr,salt,'Salt (DYNAMICS)',myThid)         CALL DEBUG_STATS_RL(Nr,salt,'Salt (DYNAMICS)',myThid)
703         CALL DEBUG_STATS_RL(Nr,Gu,'Gu (DYNAMICS)',myThid)         CALL DEBUG_STATS_RL(Nr,gU,'Gu (DYNAMICS)',myThid)
704         CALL DEBUG_STATS_RL(Nr,Gv,'Gv (DYNAMICS)',myThid)         CALL DEBUG_STATS_RL(Nr,gV,'Gv (DYNAMICS)',myThid)
705         CALL DEBUG_STATS_RL(Nr,Gt,'Gt (DYNAMICS)',myThid)         CALL DEBUG_STATS_RL(Nr,gT,'Gt (DYNAMICS)',myThid)
706         CALL DEBUG_STATS_RL(Nr,Gs,'Gs (DYNAMICS)',myThid)         CALL DEBUG_STATS_RL(Nr,gS,'Gs (DYNAMICS)',myThid)
707         CALL DEBUG_STATS_RL(Nr,GuNm1,'GuNm1 (DYNAMICS)',myThid)  #ifndef ALLOW_ADAMSBASHFORTH_3
708         CALL DEBUG_STATS_RL(Nr,GvNm1,'GvNm1 (DYNAMICS)',myThid)         CALL DEBUG_STATS_RL(Nr,guNm1,'GuNm1 (DYNAMICS)',myThid)
709         CALL DEBUG_STATS_RL(Nr,GtNm1,'GtNm1 (DYNAMICS)',myThid)         CALL DEBUG_STATS_RL(Nr,gvNm1,'GvNm1 (DYNAMICS)',myThid)
710         CALL DEBUG_STATS_RL(Nr,GsNm1,'GsNm1 (DYNAMICS)',myThid)         CALL DEBUG_STATS_RL(Nr,gtNm1,'GtNm1 (DYNAMICS)',myThid)
711           CALL DEBUG_STATS_RL(Nr,gsNm1,'GsNm1 (DYNAMICS)',myThid)
712    #endif
713          ENDIF
714    #endif
715    
716    #ifdef DYNAMICS_GUGV_EXCH_CHECK
717    C- jmc: For safety checking only: This Exchange here should not change
718    C       the solution. If solution changes, it means something is wrong,
719    C       but it does not mean that it is less wrong with this exchange.
720          IF ( debugLevel .GE. debLevE ) THEN
721           CALL EXCH_UV_XYZ_RL(gU,gV,.TRUE.,myThid)
722        ENDIF        ENDIF
723  #endif  #endif
724    
725    #ifdef ALLOW_DEBUG
726          IF (debugMode) CALL DEBUG_LEAVE( 'DYNAMICS', myThid )
727    #endif
728    
729        RETURN        RETURN
730        END        END
Legend:
Removed from v.1.74  
changed lines
  Added in v.1.163
  ViewVC Help
Powered by ViewVC 1.1.22