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