/[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.73 by adcroft, Fri Jul 20 19:16:28 2001 UTC revision 1.93 by jmc, Tue Feb 11 04:05:32 2003 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
5    
6    CBOP
7    C     !ROUTINE: DYNAMICS
8    C     !INTERFACE:
9        SUBROUTINE DYNAMICS(myTime, myIter, myThid)        SUBROUTINE DYNAMICS(myTime, myIter, myThid)
10  C     /==========================================================\  C     !DESCRIPTION: \bv
11  C     | SUBROUTINE DYNAMICS                                      |  C     *==========================================================*
12  C     | o Controlling routine for the explicit part of the model |  C     | SUBROUTINE DYNAMICS                                      
13  C     |   dynamics.                                              |  C     | o Controlling routine for the explicit part of the model  
14  C     |==========================================================|  C     |   dynamics.                                              
15  C     | This routine evaluates the "dynamics" terms for each     |  C     *==========================================================*
16  C     | block of ocean in turn. Because the blocks of ocean have |  C     | This routine evaluates the "dynamics" terms for each      
17  C     | overlap regions they are independent of one another.     |  C     | block of ocean in turn. Because the blocks of ocean have  
18  C     | If terms involving lateral integrals are needed in this  |  C     | overlap regions they are independent of one another.      
19  C     | routine care will be needed. Similarly finite-difference |  C     | If terms involving lateral integrals are needed in this  
20  C     | operations with stencils wider than the overlap region   |  C     | routine care will be needed. Similarly finite-difference  
21  C     | require special consideration.                           |  C     | operations with stencils wider than the overlap region    
22  C     | Notes                                                    |  C     | require special consideration.                            
23  C     | =====                                                    |  C     | The algorithm...
24  C     | C*P* comments indicating place holders for which code is |  C     |
25  C     |      presently being developed.                          |  C     | "Correction Step"
26  C     \==========================================================/  C     | =================
27    C     | Here we update the horizontal velocities with the surface
28    C     | pressure such that the resulting flow is either consistent
29    C     | with the free-surface evolution or the rigid-lid:
30    C     |   U[n] = U* + dt x d/dx P
31    C     |   V[n] = V* + dt x d/dy P
32    C     |
33    C     | "Calculation of Gs"
34    C     | ===================
35    C     | This is where all the accelerations and tendencies (ie.
36    C     | physics, parameterizations etc...) are calculated
37    C     |   rho = rho ( theta[n], salt[n] )
38    C     |   b   = b(rho, theta)
39    C     |   K31 = K31 ( rho )
40    C     |   Gu[n] = Gu( u[n], v[n], wVel, b, ... )
41    C     |   Gv[n] = Gv( u[n], v[n], wVel, b, ... )
42    C     |   Gt[n] = Gt( theta[n], u[n], v[n], wVel, K31, ... )
43    C     |   Gs[n] = Gs( salt[n], u[n], v[n], wVel, K31, ... )
44    C     |
45    C     | "Time-stepping" or "Prediction"
46    C     | ================================
47    C     | The models variables are stepped forward with the appropriate
48    C     | time-stepping scheme (currently we use Adams-Bashforth II)
49    C     | - For momentum, the result is always *only* a "prediction"
50    C     | in that the flow may be divergent and will be "corrected"
51    C     | later with a surface pressure gradient.
52    C     | - Normally for tracers the result is the new field at time
53    C     | level [n+1} *BUT* in the case of implicit diffusion the result
54    C     | is also *only* a prediction.
55    C     | - We denote "predictors" with an asterisk (*).
56    C     |   U* = U[n] + dt x ( 3/2 Gu[n] - 1/2 Gu[n-1] )
57    C     |   V* = V[n] + dt x ( 3/2 Gv[n] - 1/2 Gv[n-1] )
58    C     |   theta[n+1] = theta[n] + dt x ( 3/2 Gt[n] - 1/2 atG[n-1] )
59    C     |   salt[n+1] = salt[n] + dt x ( 3/2 Gt[n] - 1/2 atG[n-1] )
60    C     | With implicit diffusion:
61    C     |   theta* = theta[n] + dt x ( 3/2 Gt[n] - 1/2 atG[n-1] )
62    C     |   salt* = salt[n] + dt x ( 3/2 Gt[n] - 1/2 atG[n-1] )
63    C     |   (1 + dt * K * d_zz) theta[n] = theta*
64    C     |   (1 + dt * K * d_zz) salt[n] = salt*
65    C     |
66    C     *==========================================================*
67    C     \ev
68    C     !USES:
69        IMPLICIT NONE        IMPLICIT NONE
   
70  C     == Global variables ===  C     == Global variables ===
71  #include "SIZE.h"  #include "SIZE.h"
72  #include "EEPARAMS.h"  #include "EEPARAMS.h"
73  #include "PARAMS.h"  #include "PARAMS.h"
74  #include "DYNVARS.h"  #include "DYNVARS.h"
75  #include "GRID.h"  #include "GRID.h"
76    #ifdef ALLOW_PASSIVE_TRACER
77  #include "TR1.h"  #include "TR1.h"
78    #endif
79  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
80  # include "tamc.h"  # include "tamc.h"
81  # include "tamc_keys.h"  # include "tamc_keys.h"
82  # include "FFIELDS.h"  # include "FFIELDS.h"
83    # include "EOS.h"
84  # ifdef ALLOW_KPP  # ifdef ALLOW_KPP
85  #  include "KPP.h"  #  include "KPP.h"
86  # endif  # endif
 # ifdef ALLOW_GMREDI  
 #  include "GMREDI.h"  
 # endif  
87  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
   
88  #ifdef ALLOW_TIMEAVE  #ifdef ALLOW_TIMEAVE
89  #include "TIMEAVE_STATV.h"  #include "TIMEAVE_STATV.h"
90  #endif  #endif
91    
92    C     !CALLING SEQUENCE:
93    C     DYNAMICS()
94    C      |
95    C      |-- CALC_GRAD_PHI_SURF
96    C      |
97    C      |-- CALC_VISCOSITY
98    C      |
99    C      |-- CALC_PHI_HYD  
100    C      |
101    C      |-- STORE_PRESSURE
102    C      |
103    C      |-- MOM_FLUXFORM  
104    C      |
105    C      |-- MOM_VECINV    
106    C      |
107    C      |-- TIMESTEP      
108    C      |
109    C      |-- OBCS_APPLY_UV
110    C      |
111    C      |-- IMPLDIFF      
112    C      |
113    C      |-- OBCS_APPLY_UV
114    C      |
115    C      |-- CALL TIMEAVE_CUMUL_1T
116    C      |-- CALL DEBUG_STATS_RL
117    
118    C     !INPUT/OUTPUT PARAMETERS:
119  C     == Routine arguments ==  C     == Routine arguments ==
120  C     myTime - Current time in simulation  C     myTime - Current time in simulation
121  C     myIter - Current iteration number in simulation  C     myIter - Current iteration number in simulation
# Line 55  C     myThid - Thread number for this in Line 124  C     myThid - Thread number for this in
124        INTEGER myIter        INTEGER myIter
125        INTEGER myThid        INTEGER myThid
126    
127    C     !LOCAL VARIABLES:
128  C     == Local variables  C     == Local variables
 C     xA, yA                 - Per block temporaries holding face areas  
 C     uTrans, vTrans, rTrans - Per block temporaries holding flow  
 C                              transport  
 C                              o uTrans: Zonal transport  
 C                              o vTrans: Meridional transport  
 C                              o rTrans: Vertical transport  
 C     maskUp                   o maskUp: land/water mask for W points  
129  C     fVer[STUV]               o fVer: Vertical flux term - note fVer  C     fVer[STUV]               o fVer: Vertical flux term - note fVer
130  C                                      is "pipelined" in the vertical  C                                      is "pipelined" in the vertical
131  C                                      so we need an fVer for each  C                                      so we need an fVer for each
132  C                                      variable.  C                                      variable.
133  C     rhoK, rhoKM1   - Density at current level, and level above  C     rhoK, rhoKM1   - Density at current level, and level above
134  C     phiHyd         - Hydrostatic part of the potential phiHydi.  C     phiHyd         - Hydrostatic part of the potential.
135  C                      In z coords phiHydiHyd is the hydrostatic  C                      In z coords phiHyd is the hydrostatic
136  C                      Potential (=pressure/rho0) anomaly  C                      Potential (=pressure/rho0) anomaly
137  C                      In p coords phiHydiHyd is the geopotential  C                      In p coords phiHyd is the geopotential
138  C                      surface height anomaly.  C                      surface height anomaly.
139  C     phiSurfX, - gradient of Surface potentiel (Pressure/rho, ocean)  C     dPhiHydX,Y :: Gradient (X & Y directions) of Hydrostatic Potential
140  C     phiSurfY             or geopotentiel (atmos) in X and Y direction  C     phiSurfX, - gradient of Surface potential (Pressure/rho, ocean)
141  C     KappaRT,       - Total diffusion in vertical for T and S.  C     phiSurfY             or geopotential (atmos) in X and Y direction
 C     KappaRS          (background + spatially varying, isopycnal term).  
142  C     iMin, iMax     - Ranges and sub-block indices on which calculations  C     iMin, iMax     - Ranges and sub-block indices on which calculations
143  C     jMin, jMax       are applied.  C     jMin, jMax       are applied.
144  C     bi, bj  C     bi, bj
145  C     k, kup,        - Index for layer above and below. kup and kDown  C     k, kup,        - Index for layer above and below. kup and kDown
146  C     kDown, km1       are switched with layer to be the appropriate  C     kDown, km1       are switched with layer to be the appropriate
147  C                      index into fVerTerm.  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)  
148        _RL fVerU   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)        _RL fVerU   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
149        _RL fVerV   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)        _RL fVerV   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
150        _RL phiHyd  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL phiHyd  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
151          _RL dPhiHydX(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
152          _RL dPhiHydY(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
153        _RL rhokm1  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL rhokm1  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
154        _RL rhok    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL rhok    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
155        _RL phiSurfX(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL phiSurfX(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
156        _RL phiSurfY(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL phiSurfY(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
       _RL KappaRT (1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)  
       _RL KappaRS (1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)  
157        _RL KappaRU (1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)        _RL KappaRU (1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
158        _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)  
159    
160        INTEGER iMin, iMax        INTEGER iMin, iMax
161        INTEGER jMin, jMax        INTEGER jMin, jMax
162        INTEGER bi, bj        INTEGER bi, bj
163        INTEGER i, j        INTEGER i, j
164        INTEGER k, km1, kup, kDown        INTEGER k, km1, kp1, kup, kDown
165    
166  Cjmc : add for phiHyd output <- but not working if multi tile per CPU        LOGICAL  DIFFERENT_MULTIPLE
167  c     CHARACTER*(MAX_LEN_MBUF) suff        EXTERNAL DIFFERENT_MULTIPLE
 c     LOGICAL  DIFFERENT_MULTIPLE  
 c     EXTERNAL DIFFERENT_MULTIPLE  
 Cjmc(end)  
168    
169  C---    The algorithm...  C---    The algorithm...
170  C  C
# Line 167  C         salt* = salt[n] + dt x ( 3/2 G Line 209  C         salt* = salt[n] + dt x ( 3/2 G
209  C         (1 + dt * K * d_zz) theta[n] = theta*  C         (1 + dt * K * d_zz) theta[n] = theta*
210  C         (1 + dt * K * d_zz) salt[n] = salt*  C         (1 + dt * K * d_zz) salt[n] = salt*
211  C---  C---
212    CEOP
 #ifdef ALLOW_AUTODIFF_TAMC  
 C--   dummy statement to end declaration part  
       ikey = 1  
 #endif /* ALLOW_AUTODIFF_TAMC */  
213    
214  C--   Set up work arrays with valid (i.e. not NaN) values  C--   Set up work arrays with valid (i.e. not NaN) values
215  C     These inital values do not alter the numerical results. They  C     These inital values do not alter the numerical results. They
# Line 180  C     point numbers. This prevents spuri Line 218  C     point numbers. This prevents spuri
218  C     uninitialised but inert locations.  C     uninitialised but inert locations.
219        DO j=1-OLy,sNy+OLy        DO j=1-OLy,sNy+OLy
220         DO i=1-OLx,sNx+OLx         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  
221          rhoKM1 (i,j) = 0. _d 0          rhoKM1 (i,j) = 0. _d 0
222          rhok   (i,j) = 0. _d 0          rhok   (i,j) = 0. _d 0
223          phiSurfX(i,j) = 0. _d 0          phiSurfX(i,j) = 0. _d 0
# Line 199  C     uninitialised but inert locations. Line 225  C     uninitialised but inert locations.
225         ENDDO         ENDDO
226        ENDDO        ENDDO
227    
228    C-- Call to routine for calculation of
229    C   Eliassen-Palm-flux-forced U-tendency,
230    C   if desired:
231    #ifdef INCLUDE_EP_FORCING_CODE
232          CALL CALC_EP_FORCING(myThid)
233    #endif
234    
235  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
236  C--   HPF directive to help TAMC  C--   HPF directive to help TAMC
# Line 209  CHPF$ INDEPENDENT Line 241  CHPF$ INDEPENDENT
241    
242  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
243  C--    HPF directive to help TAMC  C--    HPF directive to help TAMC
244  CHPF$  INDEPENDENT, NEW (rTrans,fVerT,fVerS,fVerU,fVerV  CHPF$  INDEPENDENT, NEW (fVerU,fVerV
245  CHPF$&                  ,phiHyd,utrans,vtrans,xA,yA  CHPF$&                  ,phiHyd
246  CHPF$&                  ,KappaRT,KappaRS,KappaRU,KappaRV  CHPF$&                  ,KappaRU,KappaRV
247  CHPF$&                  )  CHPF$&                  )
248  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
249    
# Line 220  CHPF$&                  ) Line 252  CHPF$&                  )
252  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
253            act1 = bi - myBxLo(myThid)            act1 = bi - myBxLo(myThid)
254            max1 = myBxHi(myThid) - myBxLo(myThid) + 1            max1 = myBxHi(myThid) - myBxLo(myThid) + 1
   
255            act2 = bj - myByLo(myThid)            act2 = bj - myByLo(myThid)
256            max2 = myByHi(myThid) - myByLo(myThid) + 1            max2 = myByHi(myThid) - myByLo(myThid) + 1
   
257            act3 = myThid - 1            act3 = myThid - 1
258            max3 = nTx*nTy            max3 = nTx*nTy
   
259            act4 = ikey_dynamics - 1            act4 = ikey_dynamics - 1
260              idynkey = (act1 + 1) + act2*max1
           ikey = (act1 + 1) + act2*max1  
261       &                      + act3*max1*max2       &                      + act3*max1*max2
262       &                      + act4*max1*max2*max3       &                      + act4*max1*max2*max3
263  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
# Line 237  CHPF$&                  ) Line 265  CHPF$&                  )
265  C--     Set up work arrays that need valid initial values  C--     Set up work arrays that need valid initial values
266          DO j=1-OLy,sNy+OLy          DO j=1-OLy,sNy+OLy
267           DO i=1-OLx,sNx+OLx           DO i=1-OLx,sNx+OLx
268            rTrans (i,j)   = 0. _d 0            DO k=1,Nr
269            fVerT  (i,j,1) = 0. _d 0             phiHyd(i,j,k)  = 0. _d 0
270            fVerT  (i,j,2) = 0. _d 0             KappaRU(i,j,k) = 0. _d 0
271            fVerS  (i,j,1) = 0. _d 0             KappaRV(i,j,k) = 0. _d 0
272            fVerS  (i,j,2) = 0. _d 0            ENDDO
           fVerTr1(i,j,1) = 0. _d 0  
           fVerTr1(i,j,2) = 0. _d 0  
273            fVerU  (i,j,1) = 0. _d 0            fVerU  (i,j,1) = 0. _d 0
274            fVerU  (i,j,2) = 0. _d 0            fVerU  (i,j,2) = 0. _d 0
275            fVerV  (i,j,1) = 0. _d 0            fVerV  (i,j,1) = 0. _d 0
276            fVerV  (i,j,2) = 0. _d 0            fVerV  (i,j,2) = 0. _d 0
277              dPhiHydX(i,j)  = 0. _d 0
278              dPhiHydY(i,j)  = 0. _d 0
279           ENDDO           ENDDO
280          ENDDO          ENDDO
281    
282          DO k=1,Nr  C--     Start computation of dynamics
283           DO j=1-OLy,sNy+OLy          iMin = 0
284            DO i=1-OLx,sNx+OLx          iMax = sNx+1
285  C This is currently also used by IVDC and Diagnostics          jMin = 0
286             ConvectCount(i,j,k) = 0.          jMax = sNy+1
            KappaRT(i,j,k) = 0. _d 0  
            KappaRS(i,j,k) = 0. _d 0  
           ENDDO  
          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  
 CADJ STORE tr1  (:,:,:,bi,bj) = comlev1_bibj, key = ikey, byte = isbyte  
 #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  
   
 #ifdef ALLOW_AUTODIFF_TAMC  
 cph avoids recomputation of integrate_for_w  
 CADJ STORE wvel (:,:,:,bi,bj) = comlev1_bibj, key = ikey, byte = isbyte  
 #endif /* ALLOW_AUTODIFF_TAMC */  
   
 #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  
287    
288  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
289  CADJ STORE Kwx(:,:,:,bi,bj)   = comlev1_bibj, key=ikey, byte=isbyte  CADJ STORE wvel (:,:,:,bi,bj) =
290  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  
291  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
292    
293  #endif  /* ALLOW_GMREDI */  C--     Explicit part of the Surface Potentiel Gradient (add in TIMESTEP)
294    C       (note: this loop will be replaced by CALL CALC_GRAD_ETA)
295  #ifdef  ALLOW_KPP          IF (implicSurfPress.NE.1.) THEN
296  C--     Compute KPP mixing coefficients            CALL CALC_GRAD_PHI_SURF(
297          IF (useKPP) THEN       I         bi,bj,iMin,iMax,jMin,jMax,
298            CALL KPP_CALC(       I         etaN,
299       I                  bi, bj, myTime, myThid )       O         phiSurfX,phiSurfY,
300  #ifdef ALLOW_AUTODIFF_TAMC       I         myThid )                        
         ELSE  
           CALL KPP_CALC_DUMMY(  
      I                  bi, bj, myTime, myThid )  
 #endif /* ALLOW_AUTODIFF_TAMC */  
301          ENDIF          ENDIF
302    
303  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
304  CADJ STORE KPPghat   (:,:,:,bi,bj)  CADJ STORE uvel (:,:,:,bi,bj) = comlev1_bibj, key=idynkey, byte=isbyte
305  CADJ &   , KPPviscAz (:,:,:,bi,bj)  CADJ STORE vvel (:,:,:,bi,bj) = comlev1_bibj, key=idynkey, byte=isbyte
306  CADJ &   , KPPdiffKzT(:,:,:,bi,bj)  #ifdef ALLOW_KPP
307  CADJ &   , KPPdiffKzS(:,:,:,bi,bj)  CADJ STORE KPPviscAz (:,:,:,bi,bj)
308  CADJ &   , KPPfrac   (:,:  ,bi,bj)  CADJ &                 = comlev1_bibj, key=idynkey, byte=isbyte
309  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  
 CADJ STORE tr1  (:,:,:,bi,bj) = comlev1_bibj, key = ikey, byte = isbyte  
 #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+2  
           iMax = sNx+OLx-1  
           jMin = 1-OLy+2  
           jMax = sNy+OLy-1  
   
 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  
310  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
311    
312  #ifdef  INCLUDE_CALC_DIFFUSIVITY_CALL  #ifdef  INCLUDE_CALC_DIFFUSIVITY_CALL
313  C--      Calculate the total vertical diffusivity  C--      Calculate the total vertical diffusivity
314           CALL CALC_DIFFUSIVITY(          DO k=1,Nr
315             CALL CALC_VISCOSITY(
316       I        bi,bj,iMin,iMax,jMin,jMax,k,       I        bi,bj,iMin,iMax,jMin,jMax,k,
317       I        maskUp,       O        KappaRU,KappaRV,
      O        KappaRT,KappaRS,KappaRU,KappaRV,  
318       I        myThid)       I        myThid)
319           ENDDO
320  #endif  #endif
321    
 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  
          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  
   
 #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)  
         ENDDO  
   
   
 #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  
 #ifdef ALLOW_AUTODIFF_TAMC  
          idkey = iikey + 2  
 CADJ STORE gSNm1(:,:,:,bi,bj) = comlev1_bibj , key=ikey, byte=isbyte  
 #endif /* ALLOW_AUTODIFF_TAMC */  
             CALL IMPLDIFF(  
      I         bi, bj, iMin, iMax, jMin, jMax,  
      I         deltaTtracer, KappaRS, recip_HFacC,  
      U         gSNm1,  
      I         myThid )  
          ENDIF  
   
          IF (tr1Stepping) THEN  
 #ifdef ALLOW_AUTODIFF_TAMC  
 CADJ STORE gTr1Nm1(:,:,:,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      gTr1Nm1,  
      I      myThid )  
          ENDIF  
   
 #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  
   
322  C--     Start of dynamics loop  C--     Start of dynamics loop
323          DO k=1,Nr          DO k=1,Nr
324    
# Line 648  C--       kup    Cycles through 1,2 to p Line 327  C--       kup    Cycles through 1,2 to p
327  C--       kDown  Cycles through 2,1 to point to current layer  C--       kDown  Cycles through 2,1 to point to current layer
328    
329            km1  = MAX(1,k-1)            km1  = MAX(1,k-1)
330              kp1  = MIN(k+1,Nr)
331            kup  = 1+MOD(k+1,2)            kup  = 1+MOD(k+1,2)
332            kDown= 1+MOD(k,2)            kDown= 1+MOD(k,2)
333    
334    #ifdef ALLOW_AUTODIFF_TAMC
335             kkey = (idynkey-1)*Nr + k
336    CADJ STORE pressure(:,:,k,bi,bj) = comlev1_bibj_k ,
337    CADJ &     key=kkey , byte=isbyte
338    #endif /* ALLOW_AUTODIFF_TAMC */
339    
340  C--      Integrate hydrostatic balance for phiHyd with BC of  C--      Integrate hydrostatic balance for phiHyd with BC of
341  C        phiHyd(z=0)=0  C        phiHyd(z=0)=0
342  C        distinguishe between Stagger and Non Stagger time stepping  C        distinguishe between Stagger and Non Stagger time stepping
343           IF (staggerTimeStep) THEN           IF (staggerTimeStep) THEN
344             CALL CALC_PHI_HYD(             CALL CALC_PHI_HYD(
345       I        bi,bj,iMin,iMax,jMin,jMax,k,       I        bi,bj,iMin,iMax,jMin,jMax,k,
346       I        gTnm1, gSnm1,       I        gT, gS,
347       U        phiHyd,       U        phiHyd,
348       I        myThid )       O        dPhiHydX, dPhiHydY,
349         I        myTime, myIter, myThid )
350           ELSE           ELSE
351             CALL CALC_PHI_HYD(             CALL CALC_PHI_HYD(
352       I        bi,bj,iMin,iMax,jMin,jMax,k,       I        bi,bj,iMin,iMax,jMin,jMax,k,
353       I        theta, salt,       I        theta, salt,
354       U        phiHyd,       U        phiHyd,
355       I        myThid )       O        dPhiHydX, dPhiHydY,
356         I        myTime, myIter, myThid )
357           ENDIF           ENDIF
358    
359    C        calculate pressure from phiHyd and store it on common block
360    C        variable pressure
361             CALL STORE_PRESSURE( bi, bj, k, phiHyd, myThid )
362    
363  C--      Calculate accelerations in the momentum equations (gU, gV, ...)  C--      Calculate accelerations in the momentum equations (gU, gV, ...)
364  C        and step forward storing the result in gUnm1, gVnm1, etc...  C        and step forward storing the result in gUnm1, gVnm1, etc...
365           IF ( momStepping ) THEN           IF ( momStepping ) THEN
366             CALL CALC_MOM_RHS(  #ifndef DISABLE_MOM_FLUXFORM
367               IF (.NOT. vectorInvariantMomentum) CALL MOM_FLUXFORM(
368       I         bi,bj,iMin,iMax,jMin,jMax,k,kup,kDown,       I         bi,bj,iMin,iMax,jMin,jMax,k,kup,kDown,
369       I         phiHyd,KappaRU,KappaRV,       I         phiHyd,dPhiHydX,dPhiHydY,KappaRU,KappaRV,
370       U         fVerU, fVerV,       U         fVerU, fVerV,
371       I         myTime, myThid)       I         myTime, myIter, myThid)
372    #endif
373    #ifndef DISABLE_MOM_VECINV
374               IF (vectorInvariantMomentum) CALL MOM_VECINV(
375         I         bi,bj,iMin,iMax,jMin,jMax,k,kup,kDown,
376         I         dPhiHydX,dPhiHydY,KappaRU,KappaRV,
377         U         fVerU, fVerV,
378         I         myTime, myIter, myThid)
379    #endif
380             CALL TIMESTEP(             CALL TIMESTEP(
381       I         bi,bj,iMin,iMax,jMin,jMax,k,       I         bi,bj,iMin,iMax,jMin,jMax,k,
382       I         phiHyd, phiSurfX, phiSurfY,       I         phiHyd, dPhiHydX,dPhiHydY, phiSurfX, phiSurfY,
383       I         myIter, myThid)       I         myIter, myThid)
384    
385  #ifdef   ALLOW_OBCS  #ifdef   ALLOW_OBCS
# Line 705  C--      Apply open boundary conditions Line 406  C--      Apply open boundary conditions
406  C--     end of dynamics k loop (1:Nr)  C--     end of dynamics k loop (1:Nr)
407          ENDDO          ENDDO
408    
   
   
409  C--     Implicit viscosity  C--     Implicit viscosity
410          IF (implicitViscosity.AND.momStepping) THEN          IF (implicitViscosity.AND.momStepping) THEN
411  #ifdef    ALLOW_AUTODIFF_TAMC  #ifdef    ALLOW_AUTODIFF_TAMC
412            idkey = iikey + 3  CADJ STORE gUNm1(:,:,:,bi,bj) = comlev1_bibj , key=idynkey, byte=isbyte
 CADJ STORE gUNm1(:,:,:,bi,bj) = comlev1_bibj , key=ikey, byte=isbyte  
413  #endif    /* ALLOW_AUTODIFF_TAMC */  #endif    /* ALLOW_AUTODIFF_TAMC */
414            CALL IMPLDIFF(            CALL IMPLDIFF(
415       I         bi, bj, iMin, iMax, jMin, jMax,       I         bi, bj, iMin, iMax, jMin, jMax,
# Line 719  CADJ STORE gUNm1(:,:,:,bi,bj) = comlev1_ Line 417  CADJ STORE gUNm1(:,:,:,bi,bj) = comlev1_
417       U         gUNm1,       U         gUNm1,
418       I         myThid )       I         myThid )
419  #ifdef    ALLOW_AUTODIFF_TAMC  #ifdef    ALLOW_AUTODIFF_TAMC
420            idkey = iikey + 4  CADJ STORE gVNm1(:,:,:,bi,bj) = comlev1_bibj , key=idynkey, byte=isbyte
 CADJ STORE gVNm1(:,:,:,bi,bj) = comlev1_bibj , key=ikey, byte=isbyte  
421  #endif    /* ALLOW_AUTODIFF_TAMC */  #endif    /* ALLOW_AUTODIFF_TAMC */
422            CALL IMPLDIFF(            CALL IMPLDIFF(
423       I         bi, bj, iMin, iMax, jMin, jMax,       I         bi, bj, iMin, iMax, jMin, jMax,
# Line 739  C--      Apply open boundary conditions Line 436  C--      Apply open boundary conditions
436    
437  #ifdef    INCLUDE_CD_CODE  #ifdef    INCLUDE_CD_CODE
438  #ifdef    ALLOW_AUTODIFF_TAMC  #ifdef    ALLOW_AUTODIFF_TAMC
439            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  
440  #endif    /* ALLOW_AUTODIFF_TAMC */  #endif    /* ALLOW_AUTODIFF_TAMC */
441            CALL IMPLDIFF(            CALL IMPLDIFF(
442       I         bi, bj, iMin, iMax, jMin, jMax,       I         bi, bj, iMin, iMax, jMin, jMax,
# Line 748  CADJ STORE vVelD(:,:,:,bi,bj) = comlev1_ Line 444  CADJ STORE vVelD(:,:,:,bi,bj) = comlev1_
444       U         vVelD,       U         vVelD,
445       I         myThid )       I         myThid )
446  #ifdef    ALLOW_AUTODIFF_TAMC  #ifdef    ALLOW_AUTODIFF_TAMC
447            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  
448  #endif    /* ALLOW_AUTODIFF_TAMC */  #endif    /* ALLOW_AUTODIFF_TAMC */
449            CALL IMPLDIFF(            CALL IMPLDIFF(
450       I         bi, bj, iMin, iMax, jMin, jMax,       I         bi, bj, iMin, iMax, jMin, jMax,
# Line 760  CADJ STORE uVelD(:,:,:,bi,bj) = comlev1_ Line 455  CADJ STORE uVelD(:,:,:,bi,bj) = comlev1_
455  C--     End If implicitViscosity.AND.momStepping  C--     End If implicitViscosity.AND.momStepping
456          ENDIF          ENDIF
457    
458  Cjmc : add for phiHyd output <- but not working if multi tile per CPU  C- jmc: add for diagnostic of phiHyd
459  c       IF ( DIFFERENT_MULTIPLE(dumpFreq,myTime+deltaTClock,myTime)          IF ( DIFFERENT_MULTIPLE(diagFreq,myTime+deltaTClock,myTime)
460  c    &  .AND. buoyancyRelation .eq. 'ATMOSPHERIC' ) THEN       &       .AND. buoyancyRelation .NE. 'OCEANIC' ) THEN
461  c         WRITE(suff,'(I10.10)') myIter+1            CALL WRITE_LOCAL_RL('Ph','I10',Nr,phiHyd,
462  c         CALL WRITE_FLD_XYZ_RL('PH.',suff,phiHyd,myIter+1,myThid)       &                         bi,bj,1,myIter+1,myThid)
463  c       ENDIF          ENDIF
 Cjmc(end)  
464    
465  #ifdef ALLOW_TIMEAVE  #ifdef ALLOW_TIMEAVE
466          IF (taveFreq.GT.0.) THEN          IF (taveFreq.GT.0.) THEN
467            CALL TIMEAVE_CUMUL_1T(phiHydtave, phiHyd, Nr,            CALL TIMEAVE_CUMUL_1T(phiHydtave, phiHyd, Nr,
468       I                              deltaTclock, bi, bj, myThid)       I                              deltaTclock, bi, bj, myThid)
           IF (ivdc_kappa.NE.0.) THEN  
             CALL TIMEAVE_CUMULATE(ConvectCountTave, ConvectCount, Nr,  
      I                              deltaTclock, bi, bj, myThid)  
           ENDIF  
469          ENDIF          ENDIF
470  #endif /* ALLOW_TIMEAVE */  #endif /* ALLOW_TIMEAVE */
471    
472         ENDDO         ENDDO
473        ENDDO        ENDDO
474    
475  #ifndef EXCLUDE_DEBUGMODE  Cml(
476    C     In order to compare the variance of phiHydLow of a p/z-coordinate
477    C     run with etaH of a z/p-coordinate run the drift of phiHydLow
478    C     has to be removed by something like the following subroutine:
479    C      CALL REMOVE_MEAN_RL( 1, phiHydLow, maskH, maskH, rA, drF,
480    C     &                'phiHydLow', myThid )
481    Cml)
482    
483    #ifndef DISABLE_DEBUGMODE
484        If (debugMode) THEN        If (debugMode) THEN
485         CALL DEBUG_STATS_RL(1,EtaN,'EtaN (DYNAMICS)',myThid)         CALL DEBUG_STATS_RL(1,EtaN,'EtaN (DYNAMICS)',myThid)
486         CALL DEBUG_STATS_RL(Nr,uVel,'Uvel (DYNAMICS)',myThid)         CALL DEBUG_STATS_RL(Nr,uVel,'Uvel (DYNAMICS)',myThid)
Legend:
Removed from v.1.73  
changed lines
  Added in v.1.93
  ViewVC Help
Powered by ViewVC 1.1.22