/[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.54.2.7 by adcroft, Tue Jan 9 21:26:07 2001 UTC revision 1.72 by heimbach, Fri Jul 13 14:26:57 2001 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2    C $Name$
3    
4  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
5    
# Line 25  C     \================================= Line 26  C     \=================================
26  C     == Global variables ===  C     == Global variables ===
27  #include "SIZE.h"  #include "SIZE.h"
28  #include "EEPARAMS.h"  #include "EEPARAMS.h"
 #include "CG2D.h"  
29  #include "PARAMS.h"  #include "PARAMS.h"
30  #include "DYNVARS.h"  #include "DYNVARS.h"
31  #include "GRID.h"  #include "GRID.h"
32    #include "TR1.h"
33    
34  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
35  # include "tamc.h"  # include "tamc.h"
36  # include "tamc_keys.h"  # include "tamc_keys.h"
37    # include "FFIELDS.h"
38    # ifdef ALLOW_KPP
39    #  include "KPP.h"
40    # endif
41    # ifdef ALLOW_GMREDI
42    #  include "GMREDI.h"
43    # endif
44  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
45    
46  #ifdef ALLOW_KPP  #ifdef ALLOW_TIMEAVE
47  # include "KPP.h"  #include "TIMEAVE_STATV.h"
48  #endif  #endif
49    
50  C     == Routine arguments ==  C     == Routine arguments ==
# Line 51  C     == Local variables Line 59  C     == Local variables
59  C     xA, yA                 - Per block temporaries holding face areas  C     xA, yA                 - Per block temporaries holding face areas
60  C     uTrans, vTrans, rTrans - Per block temporaries holding flow  C     uTrans, vTrans, rTrans - Per block temporaries holding flow
61  C                              transport  C                              transport
62  C     rVel                     o uTrans: Zonal transport  C                              o uTrans: Zonal transport
63  C                              o vTrans: Meridional transport  C                              o vTrans: Meridional transport
64  C                              o rTrans: Vertical transport  C                              o rTrans: Vertical transport
65  C                              o rVel:   Vertical velocity at upper and  C     maskUp                   o maskUp: land/water mask for W points
 C                                        lower cell faces.  
 C     maskC,maskUp             o maskC: land/water mask for tracer cells  
 C                              o maskUp: land/water mask for W points  
66  C     fVer[STUV]               o fVer: Vertical flux term - note fVer  C     fVer[STUV]               o fVer: Vertical flux term - note fVer
67  C                                      is "pipelined" in the vertical  C                                      is "pipelined" in the vertical
68  C                                      so we need an fVer for each  C                                      so we need an fVer for each
69  C                                      variable.  C                                      variable.
70  C     rhoK, rhoKM1   - Density at current level, level above and level  C     rhoK, rhoKM1   - Density at current level, and level above
 C                      below.  
 C     rhoKP1                                                                    
 C     buoyK, buoyKM1 - Buoyancy at current level and level above.  
71  C     phiHyd         - Hydrostatic part of the potential phiHydi.  C     phiHyd         - Hydrostatic part of the potential phiHydi.
72  C                      In z coords phiHydiHyd is the hydrostatic  C                      In z coords phiHydiHyd is the hydrostatic
73  C                      pressure anomaly  C                      Potential (=pressure/rho0) anomaly
74  C                      In p coords phiHydiHyd is the geopotential  C                      In p coords phiHydiHyd is the geopotential
75  C                      surface height  C                      surface height anomaly.
76  C                      anomaly.  C     phiSurfX, - gradient of Surface potentiel (Pressure/rho, ocean)
77  C     etaSurfX,      - Holds surface elevation gradient in X and Y.  C     phiSurfY             or geopotentiel (atmos) in X and Y direction
 C     etaSurfY  
78  C     KappaRT,       - Total diffusion in vertical for T and S.  C     KappaRT,       - Total diffusion in vertical for T and S.
79  C     KappaRS          (background + spatially varying, isopycnal term).  C     KappaRS          (background + spatially varying, isopycnal term).
80  C     iMin, iMax     - Ranges and sub-block indices on which calculations  C     iMin, iMax     - Ranges and sub-block indices on which calculations
# Line 82  C     bi, bj Line 83  C     bi, bj
83  C     k, kup,        - Index for layer above and below. kup and kDown  C     k, kup,        - Index for layer above and below. kup and kDown
84  C     kDown, km1       are switched with layer to be the appropriate  C     kDown, km1       are switched with layer to be the appropriate
85  C                      index into fVerTerm.  C                      index into fVerTerm.
86    C     tauAB - Adams-Bashforth timestepping weight: 0=forward ; 1/2=Adams-Bashf.
87        _RS xA      (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RS xA      (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
88        _RS yA      (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RS yA      (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
89        _RL uTrans  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL uTrans  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
90        _RL vTrans  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL vTrans  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
91        _RL rTrans  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL rTrans  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
       _RL rVel    (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)  
       _RS maskC   (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
92        _RS maskUp  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RS maskUp  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
93        _RL fVerT   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)        _RL fVerT   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
94        _RL fVerS   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)        _RL fVerS   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
95          _RL fVerTr1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
96        _RL fVerU   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)        _RL fVerU   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
97        _RL fVerV   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)        _RL fVerV   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
98        _RL phiHyd  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL phiHyd  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
99        _RL rhokm1  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL rhokm1  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
       _RL rhokp1  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
100        _RL rhok    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL rhok    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
101        _RL buoyKM1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL phiSurfX(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
102        _RL buoyK   (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL phiSurfY(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
       _RL rhotmp  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
103        _RL KappaRT (1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)        _RL KappaRT (1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
104        _RL KappaRS (1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)        _RL KappaRS (1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
105        _RL KappaRU (1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)        _RL KappaRU (1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
# Line 108  C                      index into fVerTe Line 107  C                      index into fVerTe
107        _RL sigmaX  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL sigmaX  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
108        _RL sigmaY  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL sigmaY  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
109        _RL sigmaR  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL sigmaR  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
110          _RL tauAB
111    
112  C This is currently also used by IVDC and Diagnostics  C This is currently used by IVDC and Diagnostics
 C #ifdef INCLUDE_CONVECT_CALL  
113        _RL ConvectCount (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL ConvectCount (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
 C #endif  
114    
115        INTEGER iMin, iMax        INTEGER iMin, iMax
116        INTEGER jMin, jMax        INTEGER jMin, jMax
# Line 120  C #endif Line 118  C #endif
118        INTEGER i, j        INTEGER i, j
119        INTEGER k, km1, kup, kDown        INTEGER k, km1, kup, kDown
120    
121  #ifdef ALLOW_AUTODIFF_TAMC  Cjmc : add for phiHyd output <- but not working if multi tile per CPU
122        INTEGER    isbyte  c     CHARACTER*(MAX_LEN_MBUF) suff
123        PARAMETER( isbyte = 4 )  c     LOGICAL  DIFFERENT_MULTIPLE
124    c     EXTERNAL DIFFERENT_MULTIPLE
125        INTEGER act1, act2, act3, act4  Cjmc(end)
126        INTEGER max1, max2, max3  
       INTEGER iikey, kkey  
       INTEGER maximpl  
 #endif /* ALLOW_AUTODIFF_TAMC */  
   
127  C---    The algorithm...  C---    The algorithm...
128  C  C
129  C       "Correction Step"  C       "Correction Step"
# Line 144  C       "Calculation of Gs" Line 138  C       "Calculation of Gs"
138  C       ===================  C       ===================
139  C       This is where all the accelerations and tendencies (ie.  C       This is where all the accelerations and tendencies (ie.
140  C       physics, parameterizations etc...) are calculated  C       physics, parameterizations etc...) are calculated
 C         rVel = sum_r ( div. u[n] )  
141  C         rho = rho ( theta[n], salt[n] )  C         rho = rho ( theta[n], salt[n] )
142  C         b   = b(rho, theta)  C         b   = b(rho, theta)
143  C         K31 = K31 ( rho )  C         K31 = K31 ( rho )
144  C         Gu[n] = Gu( u[n], v[n], rVel, b, ... )  C         Gu[n] = Gu( u[n], v[n], wVel, b, ... )
145  C         Gv[n] = Gv( u[n], v[n], rVel, b, ... )  C         Gv[n] = Gv( u[n], v[n], wVel, b, ... )
146  C         Gt[n] = Gt( theta[n], u[n], v[n], rVel, K31, ... )  C         Gt[n] = Gt( theta[n], u[n], v[n], wVel, K31, ... )
147  C         Gs[n] = Gs( salt[n], u[n], v[n], rVel, K31, ... )  C         Gs[n] = Gs( salt[n], u[n], v[n], wVel, K31, ... )
148  C  C
149  C       "Time-stepping" or "Prediction"  C       "Time-stepping" or "Prediction"
150  C       ================================  C       ================================
# Line 192  C     uninitialised but inert locations. Line 185  C     uninitialised but inert locations.
185          uTrans(i,j)  = 0. _d 0          uTrans(i,j)  = 0. _d 0
186          vTrans(i,j)  = 0. _d 0          vTrans(i,j)  = 0. _d 0
187          DO k=1,Nr          DO k=1,Nr
188           phiHyd (i,j,k)  = 0. _d 0           phiHyd(i,j,k)  = 0. _d 0
189           KappaRU(i,j,k) = 0. _d 0           KappaRU(i,j,k) = 0. _d 0
190           KappaRV(i,j,k) = 0. _d 0           KappaRV(i,j,k) = 0. _d 0
191           sigmaX(i,j,k) = 0. _d 0           sigmaX(i,j,k) = 0. _d 0
# Line 201  C     uninitialised but inert locations. Line 194  C     uninitialised but inert locations.
194          ENDDO          ENDDO
195          rhoKM1 (i,j) = 0. _d 0          rhoKM1 (i,j) = 0. _d 0
196          rhok   (i,j) = 0. _d 0          rhok   (i,j) = 0. _d 0
197          rhoKP1 (i,j) = 0. _d 0          phiSurfX(i,j) = 0. _d 0
198          rhoTMP (i,j) = 0. _d 0          phiSurfY(i,j) = 0. _d 0
         buoyKM1(i,j) = 0. _d 0  
         buoyK  (i,j) = 0. _d 0  
         maskC  (i,j) = 0. _d 0  
199         ENDDO         ENDDO
200        ENDDO        ENDDO
201    
# Line 219  CHPF$ INDEPENDENT Line 209  CHPF$ INDEPENDENT
209    
210  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
211  C--    HPF directive to help TAMC  C--    HPF directive to help TAMC
212  CHPF$  INDEPENDENT, NEW (rTrans,rVel,fVerT,fVerS,fVerU,fVerV  CHPF$  INDEPENDENT, NEW (rTrans,fVerT,fVerS,fVerU,fVerV
213  CHPF$&                  ,phiHyd,utrans,vtrans,maskc,xA,yA  CHPF$&                  ,phiHyd,utrans,vtrans,xA,yA
214  CHPF$&                  ,KappaRT,KappaRS,KappaRU,KappaRV  CHPF$&                  ,KappaRT,KappaRS,KappaRU,KappaRV
215  CHPF$&                  )  CHPF$&                  )
216  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
# Line 247  CHPF$&                  ) Line 237  CHPF$&                  )
237  C--     Set up work arrays that need valid initial values  C--     Set up work arrays that need valid initial values
238          DO j=1-OLy,sNy+OLy          DO j=1-OLy,sNy+OLy
239           DO i=1-OLx,sNx+OLx           DO i=1-OLx,sNx+OLx
240            rTrans(i,j)   = 0. _d 0            rTrans (i,j)   = 0. _d 0
241            rVel  (i,j,1) = 0. _d 0            fVerT  (i,j,1) = 0. _d 0
242            rVel  (i,j,2) = 0. _d 0            fVerT  (i,j,2) = 0. _d 0
243            fVerT (i,j,1) = 0. _d 0            fVerS  (i,j,1) = 0. _d 0
244            fVerT (i,j,2) = 0. _d 0            fVerS  (i,j,2) = 0. _d 0
245            fVerS (i,j,1) = 0. _d 0            fVerTr1(i,j,1) = 0. _d 0
246            fVerS (i,j,2) = 0. _d 0            fVerTr1(i,j,2) = 0. _d 0
247            fVerU (i,j,1) = 0. _d 0            fVerU  (i,j,1) = 0. _d 0
248            fVerU (i,j,2) = 0. _d 0            fVerU  (i,j,2) = 0. _d 0
249            fVerV (i,j,1) = 0. _d 0            fVerV  (i,j,1) = 0. _d 0
250            fVerV (i,j,2) = 0. _d 0            fVerV  (i,j,2) = 0. _d 0
           phiHyd(i,j,1) = 0. _d 0  
251           ENDDO           ENDDO
252          ENDDO          ENDDO
253    
254          DO k=1,Nr          DO k=1,Nr
255           DO j=1-OLy,sNy+OLy           DO j=1-OLy,sNy+OLy
256            DO i=1-OLx,sNx+OLx            DO i=1-OLx,sNx+OLx
257  #ifdef INCLUDE_CONVECT_CALL  C This is currently also used by IVDC and Diagnostics
258             ConvectCount(i,j,k) = 0.             ConvectCount(i,j,k) = 0.
 #endif  
259             KappaRT(i,j,k) = 0. _d 0             KappaRT(i,j,k) = 0. _d 0
260             KappaRS(i,j,k) = 0. _d 0             KappaRS(i,j,k) = 0. _d 0
261            ENDDO            ENDDO
# Line 280  C--     Set up work arrays that need val Line 268  C--     Set up work arrays that need val
268          jMax = sNy+OLy          jMax = sNy+OLy
269    
270    
271    #ifdef ALLOW_AUTODIFF_TAMC
272    CADJ STORE theta(:,:,:,bi,bj) = comlev1_bibj, key = ikey, byte = isbyte
273    CADJ STORE salt (:,:,:,bi,bj) = comlev1_bibj, key = ikey, byte = isbyte
274    CADJ STORE uvel (:,:,:,bi,bj) = comlev1_bibj, key = ikey, byte = isbyte
275    CADJ STORE vvel (:,:,:,bi,bj) = comlev1_bibj, key = ikey, byte = isbyte
276    CADJ STORE tr1  (:,:,:,bi,bj) = comlev1_bibj, key = ikey, byte = isbyte
277    #endif /* ALLOW_AUTODIFF_TAMC */
278    
279  C--     Start of diagnostic loop  C--     Start of diagnostic loop
280          DO k=Nr,1,-1          DO k=Nr,1,-1
281    
282  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
283  C? Patrick, is this formula correct now that we change the loop range?  C? Patrick, is this formula correct now that we change the loop range?
284  C? Do we still need this?  C? Do we still need this?
285           kkey = (ikey-1)*(Nr-2+1) + (k-2) + 1  cph kkey formula corrected.
286    cph Needed for rhok, rhokm1, in the case useGMREDI.
287             kkey = (ikey-1)*Nr + k
288    CADJ STORE rhokm1(:,:) = comlev1_bibj_k ,       key=kkey, byte=isbyte
289    CADJ STORE rhok  (:,:) = comlev1_bibj_k ,       key=kkey, byte=isbyte
290  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
291    
292  C--       Integrate continuity vertically for vertical velocity  C--       Integrate continuity vertically for vertical velocity
# Line 296  C--       Integrate continuity verticall Line 296  C--       Integrate continuity verticall
296       I                         myThid )       I                         myThid )
297    
298  #ifdef    ALLOW_OBCS  #ifdef    ALLOW_OBCS
299  C--       Calculate future values on open boundaries  #ifdef    ALLOW_NONHYDROSTATIC
300            IF (openBoundaries) THEN  C--       Apply OBC to W if in N-H mode
301  #ifdef      ALLOW_NONHYDROSTATIC            IF (useOBCS.AND.nonHydrostatic) THEN
302              IF (nonHydrostatic) THEN              CALL OBCS_APPLY_W( bi, bj, k, wVel, myThid )
               CALL OBCS_APPLY_W( bi, bj, k, wVel, myThid )  
             ENDIF  
 #endif      /* ALLOW_NONHYDROSTATIC */  
             CALL OBCS_CALC( bi, bj, k, myTime+deltaT, myThid )  
303            ENDIF            ENDIF
304    #endif    /* ALLOW_NONHYDROSTATIC */
305  #endif    /* ALLOW_OBCS */  #endif    /* ALLOW_OBCS */
306    
307  C--       Calculate gradients of potential density for isoneutral  C--       Calculate gradients of potential density for isoneutral
308  C         slope terms (e.g. GM/Redi tensor or IVDC diffusivity)  C         slope terms (e.g. GM/Redi tensor or IVDC diffusivity)
309            IF ( k.GT.1 .AND. (useGMRedi.OR.ivdc_kappa.NE.0.) ) THEN  c         IF ( k.GT.1 .AND. (useGMRedi.OR.ivdc_kappa.NE.0.) ) THEN
310              IF ( useGMRedi .OR. (k.GT.1 .AND. ivdc_kappa.NE.0.) ) THEN
311    #ifdef ALLOW_AUTODIFF_TAMC
312    CADJ STORE theta(:,:,k,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte
313    CADJ STORE salt (:,:,k,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte
314    #endif /* ALLOW_AUTODIFF_TAMC */
315              CALL FIND_RHO(              CALL FIND_RHO(
316       I        bi, bj, iMin, iMax, jMin, jMax, k, k, eosType,       I        bi, bj, iMin, iMax, jMin, jMax, k, k, eosType,
317         I        theta, salt,
318       O        rhoK,       O        rhoK,
319       I        myThid )       I        myThid )
320              CALL FIND_RHO(              IF (k.GT.1) THEN
321    #ifdef ALLOW_AUTODIFF_TAMC
322    CADJ STORE theta(:,:,k-1,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte
323    CADJ STORE salt (:,:,k-1,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte
324    #endif /* ALLOW_AUTODIFF_TAMC */
325                 CALL FIND_RHO(
326       I        bi, bj, iMin, iMax, jMin, jMax, k-1, k, eosType,       I        bi, bj, iMin, iMax, jMin, jMax, k-1, k, eosType,
327         I        theta, salt,
328       O        rhoKm1,       O        rhoKm1,
329       I        myThid )       I        myThid )
330                ENDIF
331              CALL GRAD_SIGMA(              CALL GRAD_SIGMA(
332       I             bi, bj, iMin, iMax, jMin, jMax, k,       I             bi, bj, iMin, iMax, jMin, jMax, k,
333       I             rhoK, rhoKm1, rhoK,       I             rhoK, rhoKm1, rhoK,
# Line 326  C         slope terms (e.g. GM/Redi tens Line 336  C         slope terms (e.g. GM/Redi tens
336            ENDIF            ENDIF
337    
338  C--       Implicit Vertical Diffusion for Convection  C--       Implicit Vertical Diffusion for Convection
339    c ==> should use sigmaR !!!
340            IF (k.GT.1 .AND. ivdc_kappa.NE.0.) THEN            IF (k.GT.1 .AND. ivdc_kappa.NE.0.) THEN
341              CALL CALC_IVDC(              CALL CALC_IVDC(
342       I        bi, bj, iMin, iMax, jMin, jMax, k,       I        bi, bj, iMin, iMax, jMin, jMax, k,
343       I        rhoKm1, rhoK,       I        rhoKm1, rhoK,
 c should use sigmaR !!!  
344       U        ConvectCount, KappaRT, KappaRS,       U        ConvectCount, KappaRT, KappaRS,
345       I        myTime, myIter, myThid)       I        myTime, myIter, myThid)
346            END IF            ENDIF
347    
348  C--     end of diagnostic k loop (Nr:1)  C--     end of diagnostic k loop (Nr:1)
349          ENDDO          ENDDO
350    
351    #ifdef ALLOW_AUTODIFF_TAMC
352    cph avoids recomputation of integrate_for_w
353    CADJ STORE wvel (:,:,:,bi,bj) = comlev1_bibj, key = ikey, byte = isbyte
354    #endif /* ALLOW_AUTODIFF_TAMC */
355    
356    #ifdef  ALLOW_OBCS
357    C--     Calculate future values on open boundaries
358            IF (useOBCS) THEN
359              CALL OBCS_CALC( bi, bj, myTime+deltaT,
360         I            uVel, vVel, wVel, theta, salt,
361         I            myThid )
362            ENDIF
363    #endif  /* ALLOW_OBCS */
364    
365  C--     Determines forcing terms based on external fields  C--     Determines forcing terms based on external fields
366  C       relaxation terms, etc.  C       relaxation terms, etc.
367          CALL EXTERNAL_FORCING_SURF(          CALL EXTERNAL_FORCING_SURF(
368       I             bi, bj, iMin, iMax, jMin, jMax,       I             bi, bj, iMin, iMax, jMin, jMax,
369       I             myThid )       I             myThid )
370    #ifdef ALLOW_AUTODIFF_TAMC
371    cph needed for KPP
372    CADJ STORE surfacetendencyU(:,:,bi,bj)
373    CADJ &     = comlev1_bibj, key=ikey, byte=isbyte
374    CADJ STORE surfacetendencyV(:,:,bi,bj)
375    CADJ &     = comlev1_bibj, key=ikey, byte=isbyte
376    CADJ STORE surfacetendencyS(:,:,bi,bj)
377    CADJ &     = comlev1_bibj, key=ikey, byte=isbyte
378    CADJ STORE surfacetendencyT(:,:,bi,bj)
379    CADJ &     = comlev1_bibj, key=ikey, byte=isbyte
380    #endif /* ALLOW_AUTODIFF_TAMC */
381    
382  #ifdef  ALLOW_GMREDI  #ifdef  ALLOW_GMREDI
383    
384    #ifdef ALLOW_AUTODIFF_TAMC
385    CADJ STORE sigmaX(:,:,:) = comlev1, key=ikey, byte=isbyte
386    CADJ STORE sigmaY(:,:,:) = comlev1, key=ikey, byte=isbyte
387    CADJ STORE sigmaR(:,:,:) = comlev1, key=ikey, byte=isbyte
388    #endif /* ALLOW_AUTODIFF_TAMC */
389  C--     Calculate iso-neutral slopes for the GM/Redi parameterisation  C--     Calculate iso-neutral slopes for the GM/Redi parameterisation
390          IF (useGMRedi) THEN          IF (useGMRedi) THEN
391            DO k=1,Nr            DO k=1,Nr
# Line 353  C--     Calculate iso-neutral slopes for Line 394  C--     Calculate iso-neutral slopes for
394       I             sigmaX, sigmaY, sigmaR,       I             sigmaX, sigmaY, sigmaR,
395       I             myThid )       I             myThid )
396            ENDDO            ENDDO
397    #ifdef ALLOW_AUTODIFF_TAMC
398            ELSE
399              DO k=1, Nr
400                CALL GMREDI_CALC_TENSOR_DUMMY(
401         I             bi, bj, iMin, iMax, jMin, jMax, k,
402         I             sigmaX, sigmaY, sigmaR,
403         I             myThid )
404              ENDDO
405    #endif /* ALLOW_AUTODIFF_TAMC */
406          ENDIF          ENDIF
407    
408    #ifdef ALLOW_AUTODIFF_TAMC
409    CADJ STORE Kwx(:,:,:,bi,bj)   = comlev1_bibj, key=ikey, byte=isbyte
410    CADJ STORE Kwy(:,:,:,bi,bj)   = comlev1_bibj, key=ikey, byte=isbyte
411    CADJ STORE Kwz(:,:,:,bi,bj)   = comlev1_bibj, key=ikey, byte=isbyte
412    #endif /* ALLOW_AUTODIFF_TAMC */
413    
414  #endif  /* ALLOW_GMREDI */  #endif  /* ALLOW_GMREDI */
415    
416  #ifdef  ALLOW_KPP  #ifdef  ALLOW_KPP
# Line 361  C--     Compute KPP mixing coefficients Line 418  C--     Compute KPP mixing coefficients
418          IF (useKPP) THEN          IF (useKPP) THEN
419            CALL KPP_CALC(            CALL KPP_CALC(
420       I                  bi, bj, myTime, myThid )       I                  bi, bj, myTime, myThid )
421    #ifdef ALLOW_AUTODIFF_TAMC
422            ELSE
423              CALL KPP_CALC_DUMMY(
424         I                  bi, bj, myTime, myThid )
425    #endif /* ALLOW_AUTODIFF_TAMC */
426          ENDIF          ENDIF
427    
428    #ifdef ALLOW_AUTODIFF_TAMC
429    CADJ STORE KPPghat   (:,:,:,bi,bj)
430    CADJ &   , KPPviscAz (:,:,:,bi,bj)
431    CADJ &   , KPPdiffKzT(:,:,:,bi,bj)
432    CADJ &   , KPPdiffKzS(:,:,:,bi,bj)
433    CADJ &   , KPPfrac   (:,:  ,bi,bj)
434    CADJ &                 = comlev1_bibj, key=ikey, byte=isbyte
435    #endif /* ALLOW_AUTODIFF_TAMC */
436    
437  #endif  /* ALLOW_KPP */  #endif  /* ALLOW_KPP */
438    
439  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
# Line 371  CADJ STORE theta(:,:,:,bi,bj) = comlev1_ Line 443  CADJ STORE theta(:,:,:,bi,bj) = comlev1_
443  CADJ STORE salt (:,:,:,bi,bj) = comlev1_bibj, key = ikey, byte = isbyte  CADJ STORE salt (:,:,:,bi,bj) = comlev1_bibj, key = ikey, byte = isbyte
444  CADJ STORE uvel (:,:,:,bi,bj) = comlev1_bibj, key = ikey, byte = isbyte  CADJ STORE uvel (:,:,:,bi,bj) = comlev1_bibj, key = ikey, byte = isbyte
445  CADJ STORE vvel (:,:,:,bi,bj) = comlev1_bibj, key = ikey, byte = isbyte  CADJ STORE vvel (:,:,:,bi,bj) = comlev1_bibj, key = ikey, byte = isbyte
446    CADJ STORE tr1  (:,:,:,bi,bj) = comlev1_bibj, key = ikey, byte = isbyte
447  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
448    
449    #ifdef ALLOW_AIM
450    C       AIM - atmospheric intermediate model, physics package code.
451    C note(jmc) : phiHyd=0 at this point but is not really used in Molteni Physics
452            IF ( useAIM ) THEN
453             CALL TIMER_START('AIM_DO_ATMOS_PHYS      [DYNAMICS]', myThid)
454             CALL AIM_DO_ATMOS_PHYSICS( phiHyd, bi, bj, myTime, myThid )
455             CALL TIMER_STOP ('AIM_DO_ATMOS_PHYS      [DYNAMICS]', myThid)
456            ENDIF
457    #endif /* ALLOW_AIM */
458    
459    
460  C--     Start of thermodynamics loop  C--     Start of thermodynamics loop
461          DO k=Nr,1,-1          DO k=Nr,1,-1
462    #ifdef ALLOW_AUTODIFF_TAMC
463    C? Patrick Is this formula correct?
464    cph Yes, but I rewrote it.
465    cph Also, the KappaR? need the index and subscript k!
466             kkey = (ikey-1)*Nr + k
467    #endif /* ALLOW_AUTODIFF_TAMC */
468    
469  C--       km1    Points to level above k (=k-1)  C--       km1    Points to level above k (=k-1)
470  C--       kup    Cycles through 1,2 to point to layer above  C--       kup    Cycles through 1,2 to point to layer above
# Line 391  C--       kDown  Cycles through 2,1 to p Line 479  C--       kDown  Cycles through 2,1 to p
479            jMin = 1-OLy+2            jMin = 1-OLy+2
480            jMax = sNy+OLy-1            jMax = sNy+OLy-1
481    
 #ifdef ALLOW_AUTODIFF_TAMC  
 CPatrick Is this formula correct?  
          kkey = (ikey-1)*(Nr-1+1) + (k-1) + 1  
 CADJ STORE rvel  (:,:,kDown) = comlev1_bibj_k, key = kkey, byte = isbyte  
 CADJ STORE rTrans(:,:)       = comlev1_bibj_k, key = kkey, byte = isbyte  
 CADJ STORE KappaRT(:,:,:)    = comlev1_bibj_k, key = kkey, byte = isbyte  
 CADJ STORE KappaRS(:,:,:)    = comlev1_bibj_k, key = kkey, byte = isbyte  
 #endif /* ALLOW_AUTODIFF_TAMC */  
   
482  C--      Get temporary terms used by tendency routines  C--      Get temporary terms used by tendency routines
483           CALL CALC_COMMON_FACTORS (           CALL CALC_COMMON_FACTORS (
484       I        bi,bj,iMin,iMax,jMin,jMax,k,km1,kup,kDown,       I        bi,bj,iMin,iMax,jMin,jMax,k,
485       O        xA,yA,uTrans,vTrans,rTrans,rVel,maskC,maskUp,       O        xA,yA,uTrans,vTrans,rTrans,maskUp,
486       I        myThid)       I        myThid)
487    
488    #ifdef ALLOW_AUTODIFF_TAMC
489    CADJ STORE KappaRT(:,:,k)    = comlev1_bibj_k, key=kkey, byte=isbyte
490    CADJ STORE KappaRS(:,:,k)    = comlev1_bibj_k, key=kkey, byte=isbyte
491    #endif /* ALLOW_AUTODIFF_TAMC */
492    
493  #ifdef  INCLUDE_CALC_DIFFUSIVITY_CALL  #ifdef  INCLUDE_CALC_DIFFUSIVITY_CALL
494  C--      Calculate the total vertical diffusivity  C--      Calculate the total vertical diffusivity
495           CALL CALC_DIFFUSIVITY(           CALL CALC_DIFFUSIVITY(
496       I        bi,bj,iMin,iMax,jMin,jMax,k,       I        bi,bj,iMin,iMax,jMin,jMax,k,
497       I        maskC,maskup,       I        maskUp,
498       O        KappaRT,KappaRS,KappaRU,KappaRV,       O        KappaRT,KappaRS,KappaRU,KappaRV,
499       I        myThid)       I        myThid)
500  #endif  #endif
# Line 420  C        and step forward storing result Line 504  C        and step forward storing result
504           IF ( tempStepping ) THEN           IF ( tempStepping ) THEN
505             CALL CALC_GT(             CALL CALC_GT(
506       I         bi,bj,iMin,iMax,jMin,jMax, k,km1,kup,kDown,       I         bi,bj,iMin,iMax,jMin,jMax, k,km1,kup,kDown,
507       I         xA,yA,uTrans,vTrans,rTrans,maskUp,maskC,       I         xA,yA,uTrans,vTrans,rTrans,maskUp,
508       I         KappaRT,       I         KappaRT,
509       U         fVerT,       U         fVerT,
510       I         myTime, myThid)       I         myTime, myThid)
511               tauAB = 0.5d0 + abEps
512             CALL TIMESTEP_TRACER(             CALL TIMESTEP_TRACER(
513       I         bi,bj,iMin,iMax,jMin,jMax,k,       I         bi,bj,iMin,iMax,jMin,jMax,k,tauAB,
514       I         theta, gT,       I         theta, gT,
515       U         gTnm1,       U         gTnm1,
516       I         myIter, myThid)       I         myIter, myThid)
# Line 433  C        and step forward storing result Line 518  C        and step forward storing result
518           IF ( saltStepping ) THEN           IF ( saltStepping ) THEN
519             CALL CALC_GS(             CALL CALC_GS(
520       I         bi,bj,iMin,iMax,jMin,jMax, k,km1,kup,kDown,       I         bi,bj,iMin,iMax,jMin,jMax, k,km1,kup,kDown,
521       I         xA,yA,uTrans,vTrans,rTrans,maskUp,maskC,       I         xA,yA,uTrans,vTrans,rTrans,maskUp,
522       I         KappaRS,       I         KappaRS,
523       U         fVerS,       U         fVerS,
524       I         myTime, myThid)       I         myTime, myThid)
525               tauAB = 0.5d0 + abEps
526             CALL TIMESTEP_TRACER(             CALL TIMESTEP_TRACER(
527       I         bi,bj,iMin,iMax,jMin,jMax,k,       I         bi,bj,iMin,iMax,jMin,jMax,k,tauAB,
528       I         salt, gS,       I         salt, gS,
529       U         gSnm1,       U         gSnm1,
530       I         myIter, myThid)       I         myIter, myThid)
531           ENDIF           ENDIF
532             IF ( tr1Stepping ) THEN
533               CALL CALC_GTR1(
534         I         bi,bj,iMin,iMax,jMin,jMax, k,km1,kup,kDown,
535         I         xA,yA,uTrans,vTrans,rTrans,maskUp,
536         I         KappaRT,
537         U         fVerTr1,
538         I         myTime, myThid)
539               tauAB = 0.5d0 + abEps
540               CALL TIMESTEP_TRACER(
541         I         bi,bj,iMin,iMax,jMin,jMax,k,tauAB,
542         I         Tr1, gTr1,
543         U         gTr1NM1,
544         I         myIter, myThid)
545             ENDIF
546    
547  #ifdef   ALLOW_OBCS  #ifdef   ALLOW_OBCS
548  C--      Apply open boundary conditions  C--      Apply open boundary conditions
549           IF (openBoundaries) THEN           IF (useOBCS) THEN
550             CALL OBCS_APPLY_TS( bi, bj, k, gTnm1, gSnm1, myThid )             CALL OBCS_APPLY_TS( bi, bj, k, gTnm1, gSnm1, myThid )
551           END IF           END IF
552  #endif   /* ALLOW_OBCS */  #endif   /* ALLOW_OBCS */
# Line 465  C--     end of thermodynamic k loop (Nr: Line 565  C--     end of thermodynamic k loop (Nr:
565    
566    
567  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
568  CPatrick? What about this one?  C? Patrick? What about this one?
569             maximpl = 6  cph Keys iikey and idkey don't seem to be needed
570             iikey = (ikey-1)*maximpl  cph since storing occurs on different tape for each
571    cph impldiff call anyways.
572    cph Thus, common block comlev1_impl isn't needed either.
573    cph Storing below needed in the case useGMREDI.
574            iikey = (ikey-1)*maximpl
575  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
576    
577  C--     Implicit diffusion  C--     Implicit diffusion
578          IF (implicitDiffusion) THEN          IF (implicitDiffusion) THEN
579    
580            IF (tempStepping) THEN           IF (tempStepping) THEN
581  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
582              idkey = iikey + 1              idkey = iikey + 1
583    CADJ STORE gTNm1(:,:,:,bi,bj) = comlev1_bibj , key=ikey, byte=isbyte
584  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
585              CALL IMPLDIFF(              CALL IMPLDIFF(
586       I         bi, bj, iMin, iMax, jMin, jMax,       I         bi, bj, iMin, iMax, jMin, jMax,
# Line 487  C--     Implicit diffusion Line 592  C--     Implicit diffusion
592           IF (saltStepping) THEN           IF (saltStepping) THEN
593  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
594           idkey = iikey + 2           idkey = iikey + 2
595    CADJ STORE gSNm1(:,:,:,bi,bj) = comlev1_bibj , key=ikey, byte=isbyte
596  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
597              CALL IMPLDIFF(              CALL IMPLDIFF(
598       I         bi, bj, iMin, iMax, jMin, jMax,       I         bi, bj, iMin, iMax, jMin, jMax,
# Line 495  C--     Implicit diffusion Line 601  C--     Implicit diffusion
601       I         myThid )       I         myThid )
602           ENDIF           ENDIF
603    
604             IF (tr1Stepping) THEN
605    #ifdef ALLOW_AUTODIFF_TAMC
606    CADJ STORE gTr1Nm1(:,:,:,bi,bj) = comlev1_bibj , key=ikey, byte=isbyte
607    #endif /* ALLOW_AUTODIFF_TAMC */
608              CALL IMPLDIFF(
609         I      bi, bj, iMin, iMax, jMin, jMax,
610         I      deltaTtracer, KappaRT, recip_HFacC,
611         U      gTr1Nm1,
612         I      myThid )
613             ENDIF
614    
615  #ifdef   ALLOW_OBCS  #ifdef   ALLOW_OBCS
616  C--      Apply open boundary conditions  C--      Apply open boundary conditions
617           IF (openBoundaries) THEN           IF (useOBCS) THEN
618             DO K=1,Nr             DO K=1,Nr
619               CALL OBCS_APPLY_TS( bi, bj, k, gTnm1, gSnm1, myThid )               CALL OBCS_APPLY_TS( bi, bj, k, gTnm1, gSnm1, myThid )
620             ENDDO             ENDDO
# Line 507  C--      Apply open boundary conditions Line 624  C--      Apply open boundary conditions
624  C--     End If implicitDiffusion  C--     End If implicitDiffusion
625          ENDIF          ENDIF
626    
627    C--     Start computation of dynamics
628            iMin = 1-OLx+2
629            iMax = sNx+OLx-1
630            jMin = 1-OLy+2
631            jMax = sNy+OLy-1
632    
633    C--     Explicit part of the Surface Potentiel Gradient (add in TIMESTEP)
634    C       (note: this loop will be replaced by CALL CALC_GRAD_ETA)
635            IF (implicSurfPress.NE.1.) THEN
636              CALL CALC_GRAD_PHI_SURF(
637         I         bi,bj,iMin,iMax,jMin,jMax,
638         I         etaN,
639         O         phiSurfX,phiSurfY,
640         I         myThid )                        
641            ENDIF
642    
643  C--     Start of dynamics loop  C--     Start of dynamics loop
644          DO k=1,Nr          DO k=1,Nr
# Line 520  C--       kDown  Cycles through 2,1 to p Line 651  C--       kDown  Cycles through 2,1 to p
651            kup  = 1+MOD(k+1,2)            kup  = 1+MOD(k+1,2)
652            kDown= 1+MOD(k,2)            kDown= 1+MOD(k,2)
653    
           iMin = 1-OLx+2  
           iMax = sNx+OLx-1  
           jMin = 1-OLy+2  
           jMax = sNy+OLy-1  
   
 C--      Calculate buoyancy  
          CALL FIND_RHO(  
      I        bi, bj, iMin, iMax, jMin, jMax, km1, km1, eosType,  
      O        rhoKm1,  
      I        myThid )  
          CALL CALC_BUOYANCY(  
      I        bi,bj,iMin,iMax,jMin,jMax,k,rhoKm1,  
      O        buoyKm1,  
      I        myThid )  
          CALL FIND_RHO(  
      I        bi, bj, iMin, iMax, jMin, jMax, k, k, eosType,  
      O        rhoK,  
      I        myThid )  
          CALL CALC_BUOYANCY(  
      I        bi,bj,iMin,iMax,jMin,jMax,k,rhoK,  
      O        buoyK,  
      I        myThid )  
   
654  C--      Integrate hydrostatic balance for phiHyd with BC of  C--      Integrate hydrostatic balance for phiHyd with BC of
655  C--      phiHyd(z=0)=0  C        phiHyd(z=0)=0
656           CALL CALC_PHI_HYD(  C        distinguishe between Stagger and Non Stagger time stepping
657       I        bi,bj,iMin,iMax,jMin,jMax,k,buoyKm1,buoyK,           IF (staggerTimeStep) THEN
658               CALL CALC_PHI_HYD(
659         I        bi,bj,iMin,iMax,jMin,jMax,k,
660         I        gTnm1, gSnm1,
661       U        phiHyd,       U        phiHyd,
662       I        myThid )       I        myThid )
663             ELSE
664               CALL CALC_PHI_HYD(
665         I        bi,bj,iMin,iMax,jMin,jMax,k,
666         I        theta, salt,
667         U        phiHyd,
668         I        myThid )
669             ENDIF
670    
671  C--      Calculate accelerations in the momentum equations (gU, gV, ...)  C--      Calculate accelerations in the momentum equations (gU, gV, ...)
672  C        and step forward storing the result in gUnm1, gVnm1, etc...  C        and step forward storing the result in gUnm1, gVnm1, etc...
# Line 560  C        and step forward storing the re Line 678  C        and step forward storing the re
678       I         myTime, myThid)       I         myTime, myThid)
679             CALL TIMESTEP(             CALL TIMESTEP(
680       I         bi,bj,iMin,iMax,jMin,jMax,k,       I         bi,bj,iMin,iMax,jMin,jMax,k,
681         I         phiHyd, phiSurfX, phiSurfY,
682       I         myIter, myThid)       I         myIter, myThid)
683    
684  #ifdef   ALLOW_OBCS  #ifdef   ALLOW_OBCS
685  C--      Apply open boundary conditions  C--      Apply open boundary conditions
686           IF (openBoundaries) THEN           IF (useOBCS) THEN
687             CALL OBCS_APPLY_UV( bi, bj, k, gUnm1, gVnm1, myThid )             CALL OBCS_APPLY_UV( bi, bj, k, gUnm1, gVnm1, myThid )
688           END IF           END IF
689  #endif   /* ALLOW_OBCS */  #endif   /* ALLOW_OBCS */
# Line 592  C--     Implicit viscosity Line 711  C--     Implicit viscosity
711          IF (implicitViscosity.AND.momStepping) THEN          IF (implicitViscosity.AND.momStepping) THEN
712  #ifdef    ALLOW_AUTODIFF_TAMC  #ifdef    ALLOW_AUTODIFF_TAMC
713            idkey = iikey + 3            idkey = iikey + 3
714    CADJ STORE gUNm1(:,:,:,bi,bj) = comlev1_bibj , key=ikey, byte=isbyte
715  #endif    /* ALLOW_AUTODIFF_TAMC */  #endif    /* ALLOW_AUTODIFF_TAMC */
716            CALL IMPLDIFF(            CALL IMPLDIFF(
717       I         bi, bj, iMin, iMax, jMin, jMax,       I         bi, bj, iMin, iMax, jMin, jMax,
# Line 600  C--     Implicit viscosity Line 720  C--     Implicit viscosity
720       I         myThid )       I         myThid )
721  #ifdef    ALLOW_AUTODIFF_TAMC  #ifdef    ALLOW_AUTODIFF_TAMC
722            idkey = iikey + 4            idkey = iikey + 4
723    CADJ STORE gVNm1(:,:,:,bi,bj) = comlev1_bibj , key=ikey, byte=isbyte
724  #endif    /* ALLOW_AUTODIFF_TAMC */  #endif    /* ALLOW_AUTODIFF_TAMC */
725            CALL IMPLDIFF(            CALL IMPLDIFF(
726       I         bi, bj, iMin, iMax, jMin, jMax,       I         bi, bj, iMin, iMax, jMin, jMax,
# Line 609  C--     Implicit viscosity Line 730  C--     Implicit viscosity
730    
731  #ifdef   ALLOW_OBCS  #ifdef   ALLOW_OBCS
732  C--      Apply open boundary conditions  C--      Apply open boundary conditions
733           IF (openBoundaries) THEN           IF (useOBCS) THEN
734             DO K=1,Nr             DO K=1,Nr
735               CALL OBCS_APPLY_UV( bi, bj, k, gUnm1, gVnm1, myThid )               CALL OBCS_APPLY_UV( bi, bj, k, gUnm1, gVnm1, myThid )
736             ENDDO             ENDDO
# Line 619  C--      Apply open boundary conditions Line 740  C--      Apply open boundary conditions
740  #ifdef    INCLUDE_CD_CODE  #ifdef    INCLUDE_CD_CODE
741  #ifdef    ALLOW_AUTODIFF_TAMC  #ifdef    ALLOW_AUTODIFF_TAMC
742            idkey = iikey + 5            idkey = iikey + 5
743    CADJ STORE vVelD(:,:,:,bi,bj) = comlev1_bibj , key=ikey, byte=isbyte
744  #endif    /* ALLOW_AUTODIFF_TAMC */  #endif    /* ALLOW_AUTODIFF_TAMC */
745            CALL IMPLDIFF(            CALL IMPLDIFF(
746       I         bi, bj, iMin, iMax, jMin, jMax,       I         bi, bj, iMin, iMax, jMin, jMax,
# Line 627  C--      Apply open boundary conditions Line 749  C--      Apply open boundary conditions
749       I         myThid )       I         myThid )
750  #ifdef    ALLOW_AUTODIFF_TAMC  #ifdef    ALLOW_AUTODIFF_TAMC
751            idkey = iikey + 6            idkey = iikey + 6
752    CADJ STORE uVelD(:,:,:,bi,bj) = comlev1_bibj , key=ikey, byte=isbyte
753  #endif    /* ALLOW_AUTODIFF_TAMC */  #endif    /* ALLOW_AUTODIFF_TAMC */
754            CALL IMPLDIFF(            CALL IMPLDIFF(
755       I         bi, bj, iMin, iMax, jMin, jMax,       I         bi, bj, iMin, iMax, jMin, jMax,
# Line 637  C--      Apply open boundary conditions Line 760  C--      Apply open boundary conditions
760  C--     End If implicitViscosity.AND.momStepping  C--     End If implicitViscosity.AND.momStepping
761          ENDIF          ENDIF
762    
763    Cjmc : add for phiHyd output <- but not working if multi tile per CPU
764    c       IF ( DIFFERENT_MULTIPLE(dumpFreq,myTime+deltaTClock,myTime)
765    c    &  .AND. buoyancyRelation .eq. 'ATMOSPHERIC' ) THEN
766    c         WRITE(suff,'(I10.10)') myIter+1
767    c         CALL WRITE_FLD_XYZ_RL('PH.',suff,phiHyd,myIter+1,myThid)
768    c       ENDIF
769    Cjmc(end)
770    
771    #ifdef ALLOW_TIMEAVE
772            IF (taveFreq.GT.0.) THEN
773              CALL TIMEAVE_CUMUL_1T(phiHydtave, phiHyd, Nr,
774         I                              deltaTclock, bi, bj, myThid)
775              IF (ivdc_kappa.NE.0.) THEN
776                CALL TIMEAVE_CUMULATE(ConvectCountTave, ConvectCount, Nr,
777         I                              deltaTclock, bi, bj, myThid)
778              ENDIF
779            ENDIF
780    #endif /* ALLOW_TIMEAVE */
781    
782         ENDDO         ENDDO
783        ENDDO        ENDDO
784    
785        RETURN  #ifndef EXCLUDE_DEBUGMODE
786        END        If (debugMode) THEN
787           CALL DEBUG_STATS_RL(1,EtaN,'EtaN (DYNAMICS)',myThid)
788           CALL DEBUG_STATS_RL(Nr,vVel,'Vvel (DYNAMICS)',myThid)
789  C--      Cumulative diagnostic calculations (ie. time-averaging)         CALL DEBUG_STATS_RL(Nr,wVel,'Wvel (DYNAMICS)',myThid)
790  #ifdef INCLUDE_DIAGNOSTICS_INTERFACE_CODE         CALL DEBUG_STATS_RL(Nr,theta,'Theta (DYNAMICS)',myThid)
791  c        IF (taveFreq.GT.0.) THEN         CALL DEBUG_STATS_RL(Nr,salt,'Salt (DYNAMICS)',myThid)
792  c         CALL DO_TIME_AVERAGES(         CALL DEBUG_STATS_RL(Nr,Gu,'Gu (DYNAMICS)',myThid)
793  c    I                           myTime, myIter, bi, bj, k, kup, kDown,         CALL DEBUG_STATS_RL(Nr,Gv,'Gv (DYNAMICS)',myThid)
794  c    I                           ConvectCount,         CALL DEBUG_STATS_RL(Nr,Gt,'Gt (DYNAMICS)',myThid)
795  c    I                           myThid )         CALL DEBUG_STATS_RL(Nr,Gs,'Gs (DYNAMICS)',myThid)
796  c        ENDIF         CALL DEBUG_STATS_RL(Nr,GuNm1,'GuNm1 (DYNAMICS)',myThid)
797           CALL DEBUG_STATS_RL(Nr,GvNm1,'GvNm1 (DYNAMICS)',myThid)
798           CALL DEBUG_STATS_RL(Nr,GtNm1,'GtNm1 (DYNAMICS)',myThid)
799           CALL DEBUG_STATS_RL(Nr,GsNm1,'GsNm1 (DYNAMICS)',myThid)
800          ENDIF
801  #endif  #endif
802    
803          RETURN
804          END
Legend:
Removed from v.1.54.2.7  
changed lines
  Added in v.1.72
  ViewVC Help
Powered by ViewVC 1.1.22