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

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

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

revision 1.3 by jmc, Tue Jul 13 16:48:48 2004 UTC revision 1.116 by jmc, Wed Jun 27 22:36:15 2012 UTC
# Line 11  C $Name$ Line 11  C $Name$
11  # ifdef ALLOW_KPP  # ifdef ALLOW_KPP
12  #  include "KPP_OPTIONS.h"  #  include "KPP_OPTIONS.h"
13  # endif  # endif
14    # ifdef ALLOW_SEAICE
15    #  include "SEAICE_OPTIONS.h"
16    # endif
17  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
18    
19  CBOP  CBOP
# Line 19  C     !INTERFACE: Line 22  C     !INTERFACE:
22        SUBROUTINE DO_OCEANIC_PHYS(myTime, myIter, myThid)        SUBROUTINE DO_OCEANIC_PHYS(myTime, myIter, myThid)
23  C     !DESCRIPTION: \bv  C     !DESCRIPTION: \bv
24  C     *==========================================================*  C     *==========================================================*
25  C     | SUBROUTINE DO_OCEANIC_PHYS                                  C     | SUBROUTINE DO_OCEANIC_PHYS
26  C     | o Controlling routine for oceanic physics and  C     | o Controlling routine for oceanic physics and
27  C     |   parameterization  C     |   parameterization
28  C     *==========================================================*  C     *==========================================================*
29  C     | o originally, part of S/R thermodynamics  C     | o originally, part of S/R thermodynamics
# Line 33  C     == Global variables === Line 36  C     == Global variables ===
36  #include "SIZE.h"  #include "SIZE.h"
37  #include "EEPARAMS.h"  #include "EEPARAMS.h"
38  #include "PARAMS.h"  #include "PARAMS.h"
 #include "DYNVARS.h"  
39  #include "GRID.h"  #include "GRID.h"
40  c #include "GAD.h"  #include "DYNVARS.h"
41  c #ifdef ALLOW_PASSIVE_TRACER  #ifdef ALLOW_TIMEAVE
42  c #include "TR1.h"  #include "TIMEAVE_STATV.h"
43  c #endif  #endif
44  c #ifdef ALLOW_PTRACERS  #if defined (ALLOW_BALANCE_FLUXES) && !(defined ALLOW_AUTODIFF_TAMC)
45  c #include "PTRACERS_SIZE.h"  #include "FFIELDS.h"
46  c #include "PTRACERS.h"  #endif
 c #endif  
 c #ifdef ALLOW_TIMEAVE  
 c #include "TIMEAVE_STATV.h"  
 c #endif  
47    
48  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
49    # include "AUTODIFF_MYFIELDS.h"
50  # include "tamc.h"  # include "tamc.h"
51  # include "tamc_keys.h"  # include "tamc_keys.h"
52  # include "FFIELDS.h"  # include "FFIELDS.h"
53    # include "SURFACE.h"
54  # include "EOS.h"  # include "EOS.h"
55  # ifdef ALLOW_KPP  # ifdef ALLOW_KPP
56  #  include "KPP.h"  #  include "KPP.h"
57  # endif  # endif
58    # ifdef ALLOW_GGL90
59    #  include "GGL90.h"
60    # endif
61  # ifdef ALLOW_GMREDI  # ifdef ALLOW_GMREDI
62  #  include "GMREDI.h"  #  include "GMREDI.h"
63  # endif  # endif
64  # ifdef ALLOW_EBM  # ifdef ALLOW_EBM
65  #  include "EBM.h"  #  include "EBM.h"
66  # endif  # endif
67    # ifdef ALLOW_EXF
68    #  include "ctrl.h"
69    #  include "EXF_FIELDS.h"
70    #  ifdef ALLOW_BULKFORMULAE
71    #   include "EXF_CONSTANTS.h"
72    #  endif
73    # endif
74    # ifdef ALLOW_SEAICE
75    #  include "SEAICE_SIZE.h"
76    #  include "SEAICE.h"
77    # endif
78    # ifdef ALLOW_THSICE
79    #  include "THSICE_VARS.h"
80    # endif
81    # ifdef ALLOW_SALT_PLUME
82    #  include "SALT_PLUME.h"
83    # endif
84  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
85    
86  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
87  C     == Routine arguments ==  C     == Routine arguments ==
88  C     myTime - Current time in simulation  C     myTime :: Current time in simulation
89  C     myIter - Current iteration number in simulation  C     myIter :: Current iteration number in simulation
90  C     myThid - Thread number for this instance of the routine.  C     myThid :: Thread number for this instance of the routine.
91        _RL myTime        _RL myTime
92        INTEGER myIter        INTEGER myIter
93        INTEGER myThid        INTEGER myThid
94    
95  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
96  C     == Local variables  C     == Local variables
97  C     rhoK, rhoKM1   - Density at current level, and level above  C     rhoK, rhoKm1  :: Density at current level, and level above
98  C     useVariableK   = T when vertical diffusion is not constant  C     iMin, iMax    :: Ranges and sub-block indices on which calculations
 C     iMin, iMax     - Ranges and sub-block indices on which calculations  
99  C     jMin, jMax       are applied.  C     jMin, jMax       are applied.
100  C     bi, bj  C     bi, bj        :: tile indices
101  C     k, kup,        - Index for layer above and below. kup and kDown  C     i,j,k         :: loop indices
102  C     kDown, km1       are switched with layer to be the appropriate        _RL rhoKp1  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
103  C                      index into fVerTerm.        _RL rhoKm1  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
       _RL rhokm1  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
       _RL rhok    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
104        _RL sigmaX  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL sigmaX  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
105        _RL sigmaY  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL sigmaY  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
106        _RL sigmaR  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL sigmaR  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
       _RL kp1Msk  
       LOGICAL useVariableK  
107        INTEGER iMin, iMax        INTEGER iMin, iMax
108        INTEGER jMin, jMax        INTEGER jMin, jMax
109        INTEGER bi, bj        INTEGER bi, bj
110        INTEGER i, j        INTEGER i, j, k
111        INTEGER k, km1, kup, kDown        INTEGER doDiagsRho
112        INTEGER iTracer, ip  #ifdef ALLOW_DIAGNOSTICS
113          LOGICAL  DIAGNOSTICS_IS_ON
114          EXTERNAL DIAGNOSTICS_IS_ON
115    #endif /* ALLOW_DIAGNOSTICS */
116    
117  CEOP  CEOP
118    
 #ifdef ALLOW_DEBUG  
          IF ( debugLevel .GE. debLevB )  
      &    CALL DEBUG_ENTER('DO_OCEANIC_PHYS',myThid)  
 #endif  
   
119  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
120  C--   dummy statement to end declaration part  C--   dummy statement to end declaration part
       ikey = 1  
121        itdkey = 1        itdkey = 1
122  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
123    
124    #ifdef ALLOW_DEBUG
125          IF (debugMode) CALL DEBUG_ENTER('DO_OCEANIC_PHYS',myThid)
126    #endif
127    
128          doDiagsRho = 0
129    #ifdef ALLOW_DIAGNOSTICS
130          IF ( useDiagnostics .AND. fluidIsWater ) THEN
131            IF ( DIAGNOSTICS_IS_ON('MXLDEPTH',myThid) )
132         &       doDiagsRho = doDiagsRho + 1
133            IF ( DIAGNOSTICS_IS_ON('DRHODR  ',myThid) )
134         &       doDiagsRho = doDiagsRho + 2
135            IF ( DIAGNOSTICS_IS_ON('WdRHO_P ',myThid) )
136         &       doDiagsRho = doDiagsRho + 4
137            IF ( DIAGNOSTICS_IS_ON('WdRHOdP ',myThid) )
138         &       doDiagsRho = doDiagsRho + 8
139          ENDIF
140    #endif /* ALLOW_DIAGNOSTICS */
141    
142    #ifdef  ALLOW_OBCS
143          IF (useOBCS) THEN
144    C--   Calculate future values on open boundaries
145    C--   moved before SEAICE_MODEL call since SEAICE_MODEL needs seaice-obcs fields
146    # ifdef ALLOW_AUTODIFF_TAMC
147    CADJ STORE theta = comlev1, key=ikey_dynamics, kind=isbyte
148    CADJ STORE salt  = comlev1, key=ikey_dynamics, kind=isbyte
149    # endif
150    # ifdef ALLOW_DEBUG
151           IF (debugMode) CALL DEBUG_CALL('OBCS_CALC',myThid)
152    # endif
153           CALL OBCS_CALC( myTime+deltaTclock, myIter+1,
154         I                 uVel, vVel, wVel, theta, salt, myThid )
155          ENDIF
156    #endif  /* ALLOW_OBCS */
157    
158    #ifdef ALLOW_ADDFLUID
159    c     IF ( fluidIsWater ) THEN
160          IF ( useICEFRONT ) THEN
161            DO bj=myByLo(myThid),myByHi(myThid)
162             DO bi=myBxLo(myThid),myBxHi(myThid)
163              DO k=1,Nr
164               DO j=1-OLy,sNy+OLy
165                DO i=1-OLx,sNx+OLx
166                 addMass(i,j,k,bi,bj) =  0. _d 0
167                ENDDO
168               ENDDO
169              ENDDO
170             ENDDO
171            ENDDO
172          ENDIF
173    #endif /* ALLOW_ADDFLUID */
174    
175    #ifdef ALLOW_AUTODIFF_TAMC
176    # ifdef ALLOW_SALT_PLUME
177          DO bj=myByLo(myThid),myByHi(myThid)
178           DO bi=myBxLo(myThid),myBxHi(myThid)
179            DO j=1-OLy,sNy+OLy
180             DO i=1-OLx,sNx+OLx
181              saltPlumeDepth(i,j,bi,bj) = 0. _d 0
182              saltPlumeFlux(i,j,bi,bj)  = 0. _d 0
183             ENDDO
184            ENDDO
185           ENDDO
186          ENDDO
187    # endif
188    #endif /* ALLOW_AUTODIFF_TAMC */
189    
190    #ifdef ALLOW_FRAZIL
191          IF ( useFRAZIL ) THEN
192    C--   Freeze water in the ocean interior and let it rise to the surface
193           CALL FRAZIL_CALC_RHS( myTime, myIter, myThid )
194          ENDIF
195    #endif /* ALLOW_FRAZIL */
196    
197    #ifdef ALLOW_SEAICE
198          IF ( useSEAICE ) THEN
199    # ifdef ALLOW_AUTODIFF_TAMC
200    cph-adj-test(
201    CADJ STORE area   = comlev1, key=ikey_dynamics, kind=isbyte
202    CADJ STORE hsnow  = comlev1, key=ikey_dynamics, kind=isbyte
203    CADJ STORE heff   = comlev1, key=ikey_dynamics, kind=isbyte
204    CADJ STORE empmr,qsw,theta   = comlev1, key = ikey_dynamics,
205    CADJ &     kind = isbyte
206    cph-adj-test)
207    CADJ STORE atemp,aqh,precip    = comlev1, key = ikey_dynamics,
208    CADJ &     kind = isbyte
209    CADJ STORE swdown,lwdown       = comlev1, key = ikey_dynamics,
210    CADJ &     kind = isbyte
211    cph# ifdef EXF_READ_EVAP
212    CADJ STORE evap                = comlev1, key = ikey_dynamics,
213    CADJ &     kind = isbyte
214    cph# endif
215    CADJ STORE uvel,vvel           = comlev1, key = ikey_dynamics,
216    CADJ &     kind = isbyte
217    #  ifdef SEAICE_CGRID
218    CADJ STORE stressdivergencex   = comlev1, key = ikey_dynamics,
219    CADJ &     kind = isbyte
220    CADJ STORE stressdivergencey   = comlev1, key = ikey_dynamics,
221    CADJ &     kind = isbyte
222    #  endif
223    #  ifdef SEAICE_ALLOW_DYNAMICS
224    CADJ STORE uice                = comlev1, key = ikey_dynamics,
225    CADJ &     kind = isbyte
226    CADJ STORE vice                = comlev1, key = ikey_dynamics,
227    CADJ &     kind = isbyte
228    #   ifdef SEAICE_ALLOW_EVP
229    CADJ STORE seaice_sigma1       = comlev1, key = ikey_dynamics,
230    CADJ &     kind = isbyte
231    CADJ STORE seaice_sigma2       = comlev1, key = ikey_dynamics,
232    CADJ &     kind = isbyte
233    CADJ STORE seaice_sigma12      = comlev1, key = ikey_dynamics,
234    CADJ &     kind = isbyte
235    #   endif
236    #  endif
237    cph#  ifdef SEAICE_SALINITY
238    CADJ STORE salt                = comlev1, key = ikey_dynamics,
239    CADJ &     kind = isbyte
240    cph#  endif
241    #  ifdef ATMOSPHERIC_LOADING
242    CADJ STORE pload               = comlev1, key = ikey_dynamics,
243    CADJ &     kind = isbyte
244    CADJ STORE siceload            = comlev1, key = ikey_dynamics,
245    CADJ &     kind = isbyte
246    #  endif
247    #  ifdef NONLIN_FRSURF
248    CADJ STORE recip_hfacc         = comlev1, key = ikey_dynamics,
249    CADJ &     kind = isbyte
250    #  endif
251    #  ifdef ANNUAL_BALANCE
252    CADJ STORE balance_itcount     = comlev1, key = ikey_dynamics,
253    CADJ &     kind = isbyte
254    #  endif /* ANNUAL_BALANCE */
255    # endif
256    # ifdef ALLOW_DEBUG
257            IF (debugMode) CALL DEBUG_CALL('SEAICE_MODEL',myThid)
258    # endif
259            CALL TIMER_START('SEAICE_MODEL    [DO_OCEANIC_PHYS]', myThid)
260            CALL SEAICE_MODEL( myTime, myIter, myThid )
261            CALL TIMER_STOP ('SEAICE_MODEL    [DO_OCEANIC_PHYS]', myThid)
262    # ifdef ALLOW_COST
263            CALL SEAICE_COST_SENSI ( myTime, myIter, myThid )
264    # endif
265          ENDIF
266    #endif /* ALLOW_SEAICE */
267    
268    #ifdef ALLOW_AUTODIFF_TAMC
269    CADJ STORE sst, sss           = comlev1, key = ikey_dynamics,
270    CADJ &     kind = isbyte
271    CADJ STORE qsw                = comlev1, key = ikey_dynamics,
272    CADJ &     kind = isbyte
273    # ifdef ALLOW_SEAICE
274    CADJ STORE area               = comlev1, key = ikey_dynamics,
275    CADJ &     kind = isbyte
276    # endif
277    #endif
278    
279    #if (defined ALLOW_THSICE) && !(defined ALLOW_ATM2D)
280          IF ( useThSIce .AND. fluidIsWater ) THEN
281    # ifdef ALLOW_AUTODIFF_TAMC
282    cph(
283    #  ifdef NONLIN_FRSURF
284    CADJ STORE uice,vice        = comlev1, key = ikey_dynamics,
285    CADJ &     kind = isbyte
286    CADJ STORE salt,theta       = comlev1, key = ikey_dynamics,
287    CADJ &     kind = isbyte
288    CADJ STORE qnet,qsw, empmr  = comlev1, key = ikey_dynamics,
289    CADJ &     kind = isbyte
290    CADJ STORE hFac_surfC       = comlev1, key = ikey_dynamics,
291    CADJ &     kind = isbyte
292    #  endif
293    # endif
294    # ifdef ALLOW_DEBUG
295            IF (debugMode) CALL DEBUG_CALL('THSICE_MAIN',myThid)
296    # endif
297    C--     Step forward Therm.Sea-Ice variables
298    C       and modify forcing terms including effects from ice
299            CALL TIMER_START('THSICE_MAIN     [DO_OCEANIC_PHYS]', myThid)
300            CALL THSICE_MAIN( myTime, myIter, myThid )
301            CALL TIMER_STOP( 'THSICE_MAIN     [DO_OCEANIC_PHYS]', myThid)
302          ENDIF
303    #endif /* ALLOW_THSICE */
304    
305    #ifdef ALLOW_SHELFICE
306    # ifdef ALLOW_AUTODIFF_TAMC
307    CADJ STORE salt, theta = comlev1, key = ikey_dynamics,
308    CADJ &     kind = isbyte
309    # endif
310          IF ( useShelfIce .AND. fluidIsWater ) THEN
311    #ifdef ALLOW_DEBUG
312           IF (debugMode) CALL DEBUG_CALL('SHELFICE_THERMODYNAMICS',myThid)
313    #endif
314    C     compute temperature and (virtual) salt flux at the
315    C     shelf-ice ocean interface
316           CALL TIMER_START('SHELFICE_THERMODYNAMICS [DO_OCEANIC_PHYS]',
317         &       myThid)
318           CALL SHELFICE_THERMODYNAMICS( myTime, myIter, myThid )
319           CALL TIMER_STOP( 'SHELFICE_THERMODYNAMICS [DO_OCEANIC_PHYS]',
320         &      myThid)
321          ENDIF
322    #endif /* ALLOW_SHELFICE */
323    
324    #ifdef ALLOW_ICEFRONT
325          IF ( useICEFRONT .AND. fluidIsWater ) THEN
326    #ifdef ALLOW_DEBUG
327           IF (debugMode) CALL DEBUG_CALL('ICEFRONT_THERMODYNAMICS',myThid)
328    #endif
329    C     compute temperature and (virtual) salt flux at the
330    C     ice-front ocean interface
331           CALL TIMER_START('ICEFRONT_THERMODYNAMICS [DO_OCEANIC_PHYS]',
332         &       myThid)
333           CALL ICEFRONT_THERMODYNAMICS( myTime, myIter, myThid )
334           CALL TIMER_STOP( 'ICEFRONT_THERMODYNAMICS [DO_OCEANIC_PHYS]',
335         &      myThid)
336          ENDIF
337    #endif /* ALLOW_ICEFRONT */
338    
339    #ifdef ALLOW_SALT_PLUME
340          IF ( useSALT_PLUME ) THEN
341              CALL SALT_PLUME_DO_EXCH( myTime, myIter, myThid )
342          ENDIF
343    #endif /* ALLOW_SALT_PLUME */
344    
345    C--   Freeze water at the surface
346          IF ( allowFreezing ) THEN
347    #ifdef ALLOW_AUTODIFF_TAMC
348    CADJ STORE theta = comlev1, key = ikey_dynamics,
349    CADJ &     kind = isbyte
350    #endif
351            CALL FREEZE_SURFACE(  myTime, myIter, myThid )
352          ENDIF
353    
354    #ifdef ALLOW_OCN_COMPON_INTERF
355    C--    Apply imported data (from coupled interface) to forcing fields
356    C jmc: do not know precisely where to put this call (bf or af thSIce ?)
357          IF ( useCoupler ) THEN
358             CALL OCN_APPLY_IMPORT( .TRUE., myTime, myIter, myThid )
359          ENDIF
360    #endif /* ALLOW_OCN_COMPON_INTERF */
361    
362    #ifdef ALLOW_BALANCE_FLUXES
363    C     balance fluxes
364          IF ( balanceEmPmR )
365         &      CALL REMOVE_MEAN_RS( 1, EmPmR, maskInC, maskInC, rA, drF,
366         &        'EmPmR', myTime, myThid )
367          IF ( balanceQnet )
368         &      CALL REMOVE_MEAN_RS( 1, Qnet,  maskInC, maskInC, rA, drF,
369         &        'Qnet ', myTime, myThid )
370    #endif /* ALLOW_BALANCE_FLUXES */
371    
372  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
373  C--   HPF directive to help TAMC  C--   HPF directive to help TAMC
374  CHPF$ INDEPENDENT  CHPF$ INDEPENDENT
375    #else  /* ALLOW_AUTODIFF_TAMC */
376    C     if fluid is not water, by-pass find_rho, gmredi, surfaceForcing
377    C     and all vertical mixing schemes, but keep OBCS_CALC
378          IF ( fluidIsWater ) THEN
379  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
   
380        DO bj=myByLo(myThid),myByHi(myThid)        DO bj=myByLo(myThid),myByHi(myThid)
   
381  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
382  C--    HPF directive to help TAMC  C--   HPF directive to help TAMC
383  CHPF$  INDEPENDENT, NEW (rTrans,fVerT,fVerS  CHPF$ INDEPENDENT
 CHPF$&                  ,utrans,vtrans,xA,yA  
 CHPF$&                  )  
384  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
   
385         DO bi=myBxLo(myThid),myBxHi(myThid)         DO bi=myBxLo(myThid),myBxHi(myThid)
386    
387  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
# Line 144  C     just ensure that all memory refere Line 403  C     just ensure that all memory refere
403  C     point numbers. This prevents spurious hardware signals due to  C     point numbers. This prevents spurious hardware signals due to
404  C     uninitialised but inert locations.  C     uninitialised but inert locations.
405    
406    #ifdef ALLOW_AUTODIFF_TAMC
407          DO j=1-OLy,sNy+OLy          DO j=1-OLy,sNy+OLy
408           DO i=1-OLx,sNx+OLx           DO i=1-OLx,sNx+OLx
409            rhok   (i,j)   = 0. _d 0            rhoKm1 (i,j)   = 0. _d 0
410            rhoKM1 (i,j)   = 0. _d 0            rhoKp1 (i,j)   = 0. _d 0
411           ENDDO           ENDDO
412          ENDDO          ENDDO
413    #endif /* ALLOW_AUTODIFF_TAMC */
414    
415          DO k=1,Nr          DO k=1,Nr
416           DO j=1-OLy,sNy+OLy           DO j=1-OLy,sNy+OLy
417            DO i=1-OLx,sNx+OLx            DO i=1-OLx,sNx+OLx
418  C This is currently also used by IVDC and Diagnostics  C This is currently used by GMRedi, IVDC, MXL-depth  and Diagnostics
419             sigmaX(i,j,k) = 0. _d 0             sigmaX(i,j,k) = 0. _d 0
420             sigmaY(i,j,k) = 0. _d 0             sigmaY(i,j,k) = 0. _d 0
421             sigmaR(i,j,k) = 0. _d 0             sigmaR(i,j,k) = 0. _d 0
422  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
423  cph all the following init. are necessary for TAF  cph all the following init. are necessary for TAF
424  cph although some of these are re-initialised later.  cph although some of these are re-initialised later.
425               rhoInSitu(i,j,k,bi,bj) = 0.
426             IVDConvCount(i,j,k,bi,bj) = 0.             IVDConvCount(i,j,k,bi,bj) = 0.
427  # ifdef ALLOW_GMREDI  # ifdef ALLOW_GMREDI
428             Kwx(i,j,k,bi,bj)  = 0. _d 0             Kwx(i,j,k,bi,bj)  = 0. _d 0
# Line 182  cph although some of these are re-initia Line 444  cph although some of these are re-initia
444             VisbeckK(i,j,bi,bj)   = 0. _d 0             VisbeckK(i,j,bi,bj)   = 0. _d 0
445  #  endif  #  endif
446  # endif /* ALLOW_GMREDI */  # endif /* ALLOW_GMREDI */
447    # ifdef ALLOW_KPP
448               KPPdiffKzS(i,j,k,bi,bj)  = 0. _d 0
449               KPPdiffKzT(i,j,k,bi,bj)  = 0. _d 0
450    # endif /* ALLOW_KPP */
451    # ifdef ALLOW_GGL90
452               GGL90viscArU(i,j,k,bi,bj)  = 0. _d 0
453               GGL90viscArV(i,j,k,bi,bj)  = 0. _d 0
454               GGL90diffKr(i,j,k,bi,bj)  = 0. _d 0
455    # endif /* ALLOW_GGL90 */
456  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
457            ENDDO            ENDDO
458           ENDDO           ENDDO
# Line 193  cph although some of these are re-initia Line 464  cph although some of these are re-initia
464          jMax = sNy+OLy          jMax = sNy+OLy
465    
466  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
467  CADJ STORE theta(:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte  CADJ STORE theta(:,:,:,bi,bj) = comlev1_bibj, key=itdkey,
468  CADJ STORE salt (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     kind = isbyte
469  CADJ STORE totphihyd  CADJ STORE salt (:,:,:,bi,bj) = comlev1_bibj, key=itdkey,
470  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     kind = isbyte
471  #ifdef ALLOW_KPP  CADJ STORE totphihyd(:,:,:,bi,bj)
472  CADJ STORE uvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey,
473  CADJ STORE vvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     kind = isbyte
474    # ifdef ALLOW_KPP
475    CADJ STORE uvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey,
476    CADJ &     kind = isbyte
477    CADJ STORE vvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey,
478    CADJ &     kind = isbyte
479    # endif
480    # ifdef ALLOW_SALT_PLUME
481    CADJ STORE saltplumedepth(:,:,bi,bj) = comlev1_bibj, key=itdkey,
482    CADJ &     kind = isbyte
483    # endif
484    #endif /* ALLOW_AUTODIFF_TAMC */
485    
486    C--   Always compute density (stored in common block) here; even when it is not
487    C     needed here, will be used anyway in calc_phi_hyd (data flow easier this way)
488    #ifdef ALLOW_DEBUG
489            IF (debugMode) CALL DEBUG_CALL('FIND_RHO_2D (xNr)',myThid)
490  #endif  #endif
491    #ifdef ALLOW_AUTODIFF_TAMC
492            IF ( fluidIsWater ) THEN
493    #endif /* ALLOW_AUTODIFF_TAMC */
494    #ifdef ALLOW_DOWN_SLOPE
495             IF ( useDOWN_SLOPE ) THEN
496               DO k=1,Nr
497                CALL DWNSLP_CALC_RHO(
498         I                  theta, salt,
499         O                  rhoInSitu(1-OLx,1-OLy,k,bi,bj),
500         I                  k, bi, bj, myTime, myIter, myThid )
501               ENDDO
502             ENDIF
503    #endif /* ALLOW_DOWN_SLOPE */
504    #ifdef ALLOW_BBL
505             IF ( useBBL ) THEN
506    C     pkg/bbl requires in-situ bbl density for depths equal to and deeper than the bbl.
507    C     To reduce computation and storage requirement, these densities are stored in the
508    C     dry grid boxes of rhoInSitu.  See BBL_CALC_RHO for details.
509               DO k=Nr,1,-1
510                CALL BBL_CALC_RHO(
511         I                  theta, salt,
512         O                  rhoInSitu,
513         I                  k, bi, bj, myTime, myIter, myThid )
514    
515               ENDDO
516             ENDIF
517    #endif /* ALLOW_BBL */
518             IF ( .NOT. ( useDOWN_SLOPE .OR. useBBL ) ) THEN
519               DO k=1,Nr
520                CALL FIND_RHO_2D(
521         I                iMin, iMax, jMin, jMax, k,
522         I                theta(1-OLx,1-OLy,k,bi,bj),
523         I                salt (1-OLx,1-OLy,k,bi,bj),
524         O                rhoInSitu(1-OLx,1-OLy,k,bi,bj),
525         I                k, bi, bj, myThid )
526               ENDDO
527             ENDIF
528    #ifdef ALLOW_AUTODIFF_TAMC
529            ELSE
530    C-        fluid is not water:
531              DO k=1,Nr
532               DO j=1-OLy,sNy+OLy
533                DO i=1-OLx,sNx+OLx
534                  rhoInSitu(i,j,k,bi,bj) = 0.
535                ENDDO
536               ENDDO
537              ENDDO
538            ENDIF
539  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
540    
541  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
542          IF ( debugLevel .GE. debLevB )          IF (debugMode) CALL DEBUG_MSG('ENTERING UPWARD K LOOP',myThid)
      &    CALL DEBUG_MSG('ENTERING UPWARD K LOOP',myThid)  
543  #endif  #endif
544    
545  C--     Start of diagnostic loop  C--     Start of diagnostic loop
# Line 214  C--     Start of diagnostic loop Line 548  C--     Start of diagnostic loop
548  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
549  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?
550  C? Do we still need this?  C? Do we still need this?
551  cph kkey formula corrected.  cph kkey formula corrected.
552  cph Needed for rhok, rhokm1, in the case useGMREDI.  cph Needed for rhoK, rhoKm1, in the case useGMREDI.
553           kkey = (itdkey-1)*Nr + k            kkey = (itdkey-1)*Nr + k
554  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
555    
556    c#ifdef ALLOW_AUTODIFF_TAMC
557    cCADJ STORE theta(:,:,k,bi,bj) = comlev1_bibj_k, key=kkey,
558    cCADJ &     kind = isbyte
559    cCADJ STORE salt(:,:,k,bi,bj)  = comlev1_bibj_k, key=kkey,
560    cCADJ &     kind = isbyte
561    c#endif /* ALLOW_AUTODIFF_TAMC */
562    
563  C--       Calculate gradients of potential density for isoneutral  C--       Calculate gradients of potential density for isoneutral
564  C         slope terms (e.g. GM/Redi tensor or IVDC diffusivity)  C         slope terms (e.g. GM/Redi tensor or IVDC diffusivity)
565  c         IF ( k.GT.1 .AND. (useGMRedi.OR.ivdc_kappa.NE.0.) ) THEN            IF ( useGMRedi .OR. (k.GT.1 .AND. ivdc_kappa.NE.0.)
566            IF ( useGMRedi .OR. (k.GT.1 .AND. ivdc_kappa.NE.0.) ) THEN       &         .OR. usePP81 .OR. useMY82 .OR. useGGL90
567  #ifdef ALLOW_DEBUG       &         .OR. useSALT_PLUME .OR. doDiagsRho.GE.1 ) THEN
             IF ( debugLevel .GE. debLevB )  
      &       CALL DEBUG_CALL('FIND_RHO',myThid)  
 #endif  
 #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,  
      I        theta, salt,  
      O        rhoK,  
      I        myThid )  
   
568              IF (k.GT.1) THEN              IF (k.GT.1) THEN
569  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
570  CADJ STORE theta(:,:,k-1,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE theta(:,:,k-1,bi,bj) = comlev1_bibj_k, key=kkey,
571  CADJ STORE salt (:,:,k-1,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ &     kind = isbyte
572  #endif /* ALLOW_AUTODIFF_TAMC */  CADJ STORE salt (:,:,k-1,bi,bj) = comlev1_bibj_k, key=kkey,
573               CALL FIND_RHO(  CADJ &     kind = isbyte
574       I        bi, bj, iMin, iMax, jMin, jMax, k-1, k,  CADJ STORE rhokm1 (bi,bj)       = comlev1_bibj_k, key=kkey,
575       I        theta, salt,  CADJ &     kind = isbyte
576       O        rhoKm1,  #endif /* ALLOW_AUTODIFF_TAMC */
577       I        myThid )               CALL FIND_RHO_2D(
578         I                 iMin, iMax, jMin, jMax, k,
579         I                 theta(1-OLx,1-OLy,k-1,bi,bj),
580         I                 salt (1-OLx,1-OLy,k-1,bi,bj),
581         O                 rhoKm1,
582         I                 k-1, bi, bj, myThid )
583              ENDIF              ENDIF
584  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
585              IF ( debugLevel .GE. debLevB )              IF (debugMode) CALL DEBUG_CALL('GRAD_SIGMA',myThid)
      &       CALL DEBUG_CALL('GRAD_SIGMA',myThid)  
586  #endif  #endif
587    cph Avoid variable aliasing for adjoint !!!
588                DO j=jMin,jMax
589                 DO i=iMin,iMax
590                  rhoKp1(i,j) = rhoInSitu(i,j,k,bi,bj)
591                 ENDDO
592                ENDDO
593              CALL GRAD_SIGMA(              CALL GRAD_SIGMA(
594       I             bi, bj, iMin, iMax, jMin, jMax, k,       I             bi, bj, iMin, iMax, jMin, jMax, k,
595       I             rhoK, rhoKm1, rhoK,       I             rhoInSitu(1-OLx,1-OLy,k,bi,bj), rhoKm1, rhoKp1,
596       O             sigmaX, sigmaY, sigmaR,       O             sigmaX, sigmaY, sigmaR,
597       I             myThid )       I             myThid )
           ENDIF  
   
598  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
599  CADJ STORE rhok   (:,:) = comlev1_bibj_k ,       key=kkey, byte=isbyte  #ifdef GMREDI_WITH_STABLE_ADJOINT
600  CADJ STORE rhokm1 (:,:) = comlev1_bibj_k ,       key=kkey, byte=isbyte  cgf zero out adjoint fields to stabilize pkg/gmredi adjoint
601    cgf -> cuts adjoint dependency from slope to state
602                CALL ZERO_ADJ_LOC( Nr, sigmaX, myThid)
603                CALL ZERO_ADJ_LOC( Nr, sigmaY, myThid)
604                CALL ZERO_ADJ_LOC( Nr, sigmaR, myThid)
605    #endif
606  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
607              ENDIF
608    
609  C--       Implicit Vertical Diffusion for Convection  C--       Implicit Vertical Diffusion for Convection
 c ==> should use sigmaR !!!  
610            IF (k.GT.1 .AND. ivdc_kappa.NE.0.) THEN            IF (k.GT.1 .AND. ivdc_kappa.NE.0.) THEN
611  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
612              IF ( debugLevel .GE. debLevB )              IF (debugMode) CALL DEBUG_CALL('CALC_IVDC',myThid)
      &       CALL DEBUG_CALL('CALC_IVDC',myThid)  
613  #endif  #endif
614              CALL CALC_IVDC(              CALL CALC_IVDC(
615       I        bi, bj, iMin, iMax, jMin, jMax, k,       I        bi, bj, iMin, iMax, jMin, jMax, k,
616       I        rhoKm1, rhoK,       I        sigmaR,
617       I        myTime, myIter, myThid)       I        myTime, myIter, myThid)
618            ENDIF            ENDIF
619    
620    #ifdef ALLOW_DIAGNOSTICS
621              IF ( doDiagsRho.GE.4 ) THEN
622                CALL DIAGS_RHO_L( doDiagsRho, k, bi, bj,
623         I                        rhoInSitu(1-OLx,1-OLy,1,bi,bj),
624         I                        rhoKm1, wVel,
625         I                        myTime, myIter, myThid )
626              ENDIF
627    #endif
628    
629  C--     end of diagnostic k loop (Nr:1)  C--     end of diagnostic k loop (Nr:1)
630          ENDDO          ENDDO
631    
632  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
633  cph avoids recomputation of integrate_for_w  CADJ STORE IVDConvCount(:,:,:,bi,bj)
634  CADJ STORE wvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey,
635  #endif /* ALLOW_AUTODIFF_TAMC */  CADJ &     kind = isbyte
   
 #ifdef  ALLOW_OBCS  
 C--     Calculate future values on open boundaries  
         IF (useOBCS) THEN  
 #ifdef ALLOW_DEBUG  
           IF ( debugLevel .GE. debLevB )  
      &     CALL DEBUG_CALL('OBCS_CALC',myThid)  
636  #endif  #endif
637            CALL OBCS_CALC( bi, bj, myTime+deltaT, myIter+1,  
638       I            uVel, vVel, wVel, theta, salt,  C--     Diagnose Mixed Layer Depth:
639       I            myThid )          IF ( useGMRedi .OR. MOD(doDiagsRho,2).EQ.1 ) THEN
640              CALL CALC_OCE_MXLAYER(
641         I              rhoInSitu(1-OLx,1-OLy,1,bi,bj), sigmaR,
642         I              bi, bj, myTime, myIter, myThid )
643          ENDIF          ENDIF
 #endif  /* ALLOW_OBCS */  
644    
645  #ifndef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_SALT_PLUME
646          IF ( buoyancyRelation(1:7) .EQ. 'OCEANIC' ) THEN          IF ( useSALT_PLUME ) THEN
647  #endif            CALL SALT_PLUME_CALC_DEPTH(
648         I              rhoInSitu(1-OLx,1-OLy,1,bi,bj), sigmaR,
649         I              bi, bj, myTime, myIter, myThid )
650            ENDIF
651    #endif /* ALLOW_SALT_PLUME */
652    
653    #ifdef ALLOW_DIAGNOSTICS
654            IF ( MOD(doDiagsRho,4).GE.2 ) THEN
655              CALL DIAGNOSTICS_FILL (sigmaR, 'DRHODR  ', 0, Nr,
656         &         2, bi, bj, myThid)
657            ENDIF
658    #endif /* ALLOW_DIAGNOSTICS */
659    
660  C--     Determines forcing terms based on external fields  C--     Determines forcing terms based on external fields
661  C       relaxation terms, etc.  C       relaxation terms, etc.
662  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
663          IF ( debugLevel .GE. debLevB )          IF (debugMode) CALL DEBUG_CALL('EXTERNAL_FORCING_SURF',myThid)
      &    CALL DEBUG_CALL('EXTERNAL_FORCING_SURF',myThid)  
664  #endif  #endif
665           CALL EXTERNAL_FORCING_SURF(  #ifdef ALLOW_AUTODIFF_TAMC
666    CADJ STORE EmPmR(:,:,bi,bj)
667    CADJ &     = comlev1_bibj, key=itdkey,
668    CADJ &     kind = isbyte
669    # ifdef EXACT_CONSERV
670    CADJ STORE PmEpR(:,:,bi,bj)
671    CADJ &     = comlev1_bibj, key=itdkey,
672    CADJ &     kind = isbyte
673    # endif
674    # ifdef NONLIN_FRSURF
675    CADJ STORE hFac_surfC(:,:,bi,bj)
676    CADJ &     = comlev1_bibj, key=itdkey,
677    CADJ &     kind = isbyte
678    CADJ STORE recip_hFacC(:,:,:,bi,bj)
679    CADJ &     = comlev1_bibj, key=itdkey,
680    CADJ &     kind = isbyte
681    #  if (defined (ALLOW_PTRACERS))
682    CADJ STORE surfaceForcingS(:,:,bi,bj)   = comlev1_bibj, key=itdkey,
683    CADJ &     kind = isbyte
684    CADJ STORE surfaceForcingT(:,:,bi,bj)   = comlev1_bibj, key=itdkey,
685    CADJ &     kind = isbyte
686    #  endif /* ALLOW_PTRACERS */
687    # endif /* NONLIN_FRSURF */
688    #endif
689            CALL EXTERNAL_FORCING_SURF(
690       I             bi, bj, iMin, iMax, jMin, jMax,       I             bi, bj, iMin, iMax, jMin, jMax,
691       I             myTime, myIter, myThid )       I             myTime, myIter, myThid )
692  #ifndef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
693          ENDIF  # ifdef EXACT_CONSERV
694    cph-test
695    cphCADJ STORE PmEpR(:,:,bi,bj)
696    cphCADJ &     = comlev1_bibj, key=itdkey,
697    cphCADJ &     kind = isbyte
698    # endif
699  #endif  #endif
700    
701  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
702  cph needed for KPP  cph needed for KPP
703  CADJ STORE surfacetendencyU(:,:,bi,bj)  CADJ STORE surfaceForcingU(:,:,bi,bj)
704  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey,
705  CADJ STORE surfacetendencyV(:,:,bi,bj)  CADJ &     kind = isbyte
706  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ STORE surfaceForcingV(:,:,bi,bj)
707  CADJ STORE surfacetendencyS(:,:,bi,bj)  CADJ &     = comlev1_bibj, key=itdkey,
708  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     kind = isbyte
709  CADJ STORE surfacetendencyT(:,:,bi,bj)  CADJ STORE surfaceForcingS(:,:,bi,bj)
710  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey,
711  # ifdef ALLOW_SEAICE  CADJ &     kind = isbyte
712  CADJ STORE surfacetendencyTice(:,:,bi,bj)  CADJ STORE surfaceForcingT(:,:,bi,bj)
713  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey,
714  # endif  CADJ &     kind = isbyte
715    CADJ STORE surfaceForcingTice(:,:,bi,bj)
716    CADJ &     = comlev1_bibj, key=itdkey,
717    CADJ &     kind = isbyte
718  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
719    
720  #ifdef  ALLOW_GMREDI  #ifdef  ALLOW_KPP
721    C--     Compute KPP mixing coefficients
722            IF (useKPP) THEN
723    #ifdef ALLOW_DEBUG
724              IF (debugMode) CALL DEBUG_CALL('KPP_CALC',myThid)
725    #endif
726              CALL TIMER_START('KPP_CALC [DO_OCEANIC_PHYS]', myThid)
727              CALL KPP_CALC(
728         I                  bi, bj, myTime, myIter, myThid )
729              CALL TIMER_STOP ('KPP_CALC [DO_OCEANIC_PHYS]', myThid)
730    #ifdef ALLOW_AUTODIFF_TAMC
731            ELSE
732              CALL KPP_CALC_DUMMY(
733         I                  bi, bj, myTime, myIter, myThid )
734    #endif /* ALLOW_AUTODIFF_TAMC */
735            ENDIF
736    
737    #endif  /* ALLOW_KPP */
738    
739    #ifdef  ALLOW_PP81
740    C--     Compute PP81 mixing coefficients
741            IF (usePP81) THEN
742    #ifdef ALLOW_DEBUG
743              IF (debugMode) CALL DEBUG_CALL('PP81_CALC',myThid)
744    #endif
745              CALL PP81_CALC(
746         I                     bi, bj, sigmaR, myTime, myIter, myThid )
747            ENDIF
748    #endif /* ALLOW_PP81 */
749    
750    #ifdef  ALLOW_MY82
751    C--     Compute MY82 mixing coefficients
752            IF (useMY82) THEN
753    #ifdef ALLOW_DEBUG
754              IF (debugMode) CALL DEBUG_CALL('MY82_CALC',myThid)
755    #endif
756              CALL MY82_CALC(
757         I                     bi, bj, sigmaR, myTime, myIter, myThid )
758            ENDIF
759    #endif /* ALLOW_MY82 */
760    
761    #ifdef  ALLOW_GGL90
762    #ifdef ALLOW_AUTODIFF_TAMC
763    CADJ STORE GGL90TKE (:,:,:,bi,bj) = comlev1_bibj, key=itdkey,
764    CADJ &     kind = isbyte
765    #endif /* ALLOW_AUTODIFF_TAMC */
766    C--     Compute GGL90 mixing coefficients
767            IF (useGGL90) THEN
768    #ifdef ALLOW_DEBUG
769              IF (debugMode) CALL DEBUG_CALL('GGL90_CALC',myThid)
770    #endif
771              CALL TIMER_START('GGL90_CALC [DO_OCEANIC_PHYS]', myThid)
772              CALL GGL90_CALC(
773         I                     bi, bj, sigmaR, myTime, myIter, myThid )
774              CALL TIMER_STOP ('GGL90_CALC [DO_OCEANIC_PHYS]', myThid)
775            ENDIF
776    #endif /* ALLOW_GGL90 */
777    
778    #ifdef ALLOW_TIMEAVE
779            IF ( taveFreq.GT. 0. _d 0 ) THEN
780              CALL TIMEAVE_SURF_FLUX( bi, bj, myTime, myIter, myThid)
781            ENDIF
782            IF (taveFreq.GT.0. .AND. ivdc_kappa.NE.0.) THEN
783              CALL TIMEAVE_CUMULATE(ConvectCountTave, IVDConvCount,
784         I                           Nr, deltaTclock, bi, bj, myThid)
785            ENDIF
786    #endif /* ALLOW_TIMEAVE */
787    
788    #ifdef ALLOW_GMREDI
789  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
790    # ifndef GM_EXCLUDE_CLIPPING
791  cph storing here is needed only for one GMREDI_OPTIONS:  cph storing here is needed only for one GMREDI_OPTIONS:
792  cph define GM_BOLUS_ADVEC  cph define GM_BOLUS_ADVEC
793  cph but I've avoided the #ifdef for now, in case more things change  cph keep it although TAF says you dont need to.
794  CADJ STORE sigmaX(:,:,:)        = comlev1_bibj, key=itdkey, byte=isbyte  cph but I have avoided the #ifdef for now, in case more things change
795  CADJ STORE sigmaY(:,:,:)        = comlev1_bibj, key=itdkey, byte=isbyte  CADJ STORE sigmaX(:,:,:)        = comlev1_bibj, key=itdkey,
796  CADJ STORE sigmaR(:,:,:)        = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     kind = isbyte
797    CADJ STORE sigmaY(:,:,:)        = comlev1_bibj, key=itdkey,
798    CADJ &     kind = isbyte
799    CADJ STORE sigmaR(:,:,:)        = comlev1_bibj, key=itdkey,
800    CADJ &     kind = isbyte
801    # endif
802  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
803    
804  C--     Calculate iso-neutral slopes for the GM/Redi parameterisation  C--     Calculate iso-neutral slopes for the GM/Redi parameterisation
805          IF (useGMRedi) THEN          IF (useGMRedi) THEN
806  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
807            IF ( debugLevel .GE. debLevB )            IF (debugMode) CALL DEBUG_CALL('GMREDI_CALC_TENSOR',myThid)
      &     CALL DEBUG_CALL('GMREDI_CALC_TENSOR',myThid)  
808  #endif  #endif
809            CALL GMREDI_CALC_TENSOR(            CALL GMREDI_CALC_TENSOR(
810       I             bi, bj, iMin, iMax, jMin, jMax,       I             iMin, iMax, jMin, jMax,
811       I             sigmaX, sigmaY, sigmaR,       I             sigmaX, sigmaY, sigmaR,
812       I             myThid )       I             bi, bj, myTime, myIter, myThid )
813  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
814          ELSE          ELSE
815            CALL GMREDI_CALC_TENSOR_DUMMY(            CALL GMREDI_CALC_TENSOR_DUMMY(
816       I             bi, bj, iMin, iMax, jMin, jMax,       I             iMin, iMax, jMin, jMax,
817       I             sigmaX, sigmaY, sigmaR,       I             sigmaX, sigmaY, sigmaR,
818       I             myThid )       I             bi, bj, myTime, myIter, myThid )
819  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
820          ENDIF          ENDIF
821    #endif /* ALLOW_GMREDI */
822    
823  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_DOWN_SLOPE
824  CADJ STORE Kwx(:,:,:,bi,bj)   = comlev1_bibj, key=itdkey, byte=isbyte          IF ( useDOWN_SLOPE ) THEN
825  CADJ STORE Kwy(:,:,:,bi,bj)   = comlev1_bibj, key=itdkey, byte=isbyte  C--     Calculate Downsloping Flow for Down_Slope parameterization
826  CADJ STORE Kwz(:,:,:,bi,bj)   = comlev1_bibj, key=itdkey, byte=isbyte           IF ( usingPCoords ) THEN
827  #endif /* ALLOW_AUTODIFF_TAMC */            CALL DWNSLP_CALC_FLOW(
828         I                bi, bj, kSurfC, rhoInSitu,
829         I                myTime, myIter, myThid )
830             ELSE
831              CALL DWNSLP_CALC_FLOW(
832         I                bi, bj, kLowC, rhoInSitu,
833         I                myTime, myIter, myThid )
834             ENDIF
835            ENDIF
836    #endif /* ALLOW_DOWN_SLOPE */
837    
838  #endif  /* ALLOW_GMREDI */  C--   end bi,bj loops.
839           ENDDO
840          ENDDO
841    
842  #ifdef  ALLOW_KPP  #ifndef ALLOW_AUTODIFF_TAMC
843  C--     Compute KPP mixing coefficients  C---  if fluid Is Water: end
844          IF (useKPP) THEN        ENDIF
 #ifdef ALLOW_DEBUG  
           IF ( debugLevel .GE. debLevB )  
      &     CALL DEBUG_CALL('KPP_CALC',myThid)  
845  #endif  #endif
           CALL KPP_CALC(  
      I                  bi, bj, myTime, myThid )  
 #ifdef ALLOW_AUTODIFF_TAMC  
         ELSE  
           CALL KPP_CALC_DUMMY(  
      I                  bi, bj, myTime, myThid )  
 #endif /* ALLOW_AUTODIFF_TAMC */  
         ENDIF  
846    
847  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_BBL
848  CADJ STORE KPPghat   (:,:,:,bi,bj)        IF ( useBBL ) THEN
849  CADJ &   , KPPfrac   (:,:  ,bi,bj)         CALL BBL_CALC_RHS(
850  CADJ &                 = comlev1_bibj, key=itdkey, byte=isbyte       I                          myTime, myIter, myThid )
851  #endif /* ALLOW_AUTODIFF_TAMC */        ENDIF
852    #endif /* ALLOW_BBL */
853  #endif  /* ALLOW_KPP */  
854    #ifdef ALLOW_MYPACKAGE
855          IF ( useMYPACKAGE ) THEN
856           CALL MYPACKAGE_CALC_RHS(
857         I                          myTime, myIter, myThid )
858          ENDIF
859    #endif /* ALLOW_MYPACKAGE */
860    
861    #ifdef ALLOW_GMREDI
862          IF ( useGMRedi ) THEN
863            CALL GMREDI_DO_EXCH( myTime, myIter, myThid )
864          ENDIF
865    #endif /* ALLOW_GMREDI */
866    
867  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_KPP
868  CADJ STORE theta(:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte        IF (useKPP) THEN
869  CADJ STORE salt (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte          CALL KPP_DO_EXCH( myThid )
870  CADJ STORE uvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte        ENDIF
871  CADJ STORE vvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte  #endif /* ALLOW_KPP */
872  #ifdef ALLOW_PASSIVE_TRACER  
873  CADJ STORE tr1  (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte  #ifdef ALLOW_DIAGNOSTICS
874  #endif        IF ( fluidIsWater .AND. useDiagnostics ) THEN
875  #ifdef ALLOW_PTRACERS          CALL DIAGS_RHO_G(
876  cph-- moved to forward_step to avoid key computation       I                    rhoInSitu, uVel, vVel, wVel,
877  cphCADJ STORE ptracer(:,:,:,bi,bj,itracer) = comlev1_bibj,       I                    myTime, myIter, myThid )
878  cphCADJ &                              key=itdkey, byte=isbyte          CALL DIAGS_OCEANIC_SURF_FLUX( myTime, myIter, myThid )
879          ENDIF
880          IF ( ivdc_kappa.NE.0 .AND. useDiagnostics ) THEN
881            CALL DIAGNOSTICS_FILL( IVDConvCount, 'CONVADJ ',
882         &                               0, Nr, 0, 1, 1, myThid )
883          ENDIF
884  #endif  #endif
 #endif /* ALLOW_AUTODIFF_TAMC */  
   
 C--   end bi,bj loops.  
        ENDDO  
       ENDDO  
885    
886  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
887           IF ( debugLevel .GE. debLevB )        IF (debugMode) CALL DEBUG_LEAVE('DO_OCEANIC_PHYS',myThid)
      &    CALL DEBUG_LEAVE('DO_OCEANIC_PHYS',myThid)  
888  #endif  #endif
889    
890        RETURN        RETURN
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.116
  ViewVC Help
Powered by ViewVC 1.1.22