/[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.67 by gforget, Wed Jun 11 18:29:08 2008 UTC revision 1.120 by jmc, Fri Nov 9 22:42:00 2012 UTC
# Line 14  C $Name$ Line 14  C $Name$
14  # ifdef ALLOW_SEAICE  # ifdef ALLOW_SEAICE
15  #  include "SEAICE_OPTIONS.h"  #  include "SEAICE_OPTIONS.h"
16  # endif  # endif
17    # ifdef ALLOW_EXF
18    #  include "EXF_OPTIONS.h"
19    # endif
20  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
21    
22  CBOP  CBOP
# Line 36  C     == Global variables === Line 39  C     == Global variables ===
39  #include "SIZE.h"  #include "SIZE.h"
40  #include "EEPARAMS.h"  #include "EEPARAMS.h"
41  #include "PARAMS.h"  #include "PARAMS.h"
 #include "DYNVARS.h"  
42  #include "GRID.h"  #include "GRID.h"
43    #include "DYNVARS.h"
44  #ifdef ALLOW_TIMEAVE  #ifdef ALLOW_TIMEAVE
45  #include "TIMEAVE_STATV.h"  #include "TIMEAVE_STATV.h"
46  #endif  #endif
47  #if defined (ALLOW_BALANCE_FLUXES) && !(defined ALLOW_AUTODIFF_TAMC)  #ifdef ALLOW_BALANCE_FLUXES
48  #include "FFIELDS.h"  #include "FFIELDS.h"
49  #endif  #endif
50    
51  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
52    # include "AUTODIFF_MYFIELDS.h"
53  # include "tamc.h"  # include "tamc.h"
54  # include "tamc_keys.h"  # include "tamc_keys.h"
55    #ifndef ALLOW_BALANCE_FLUXES
56  # include "FFIELDS.h"  # include "FFIELDS.h"
57    #endif
58  # include "SURFACE.h"  # include "SURFACE.h"
59  # include "EOS.h"  # include "EOS.h"
60  # ifdef ALLOW_KPP  # ifdef ALLOW_KPP
61  #  include "KPP.h"  #  include "KPP.h"
62  # endif  # endif
63    # ifdef ALLOW_GGL90
64    #  include "GGL90.h"
65    # endif
66  # ifdef ALLOW_GMREDI  # ifdef ALLOW_GMREDI
67  #  include "GMREDI.h"  #  include "GMREDI.h"
68  # endif  # endif
# Line 68  C     == Global variables === Line 77  C     == Global variables ===
77  #  endif  #  endif
78  # endif  # endif
79  # ifdef ALLOW_SEAICE  # ifdef ALLOW_SEAICE
80    #  include "SEAICE_SIZE.h"
81  #  include "SEAICE.h"  #  include "SEAICE.h"
82  # endif  # endif
83    # ifdef ALLOW_THSICE
84    #  include "THSICE_VARS.h"
85    # endif
86    # ifdef ALLOW_SALT_PLUME
87    #  include "SALT_PLUME.h"
88    # endif
89  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
90    
91  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
# Line 90  C     bi, bj        :: tile indices Line 106  C     bi, bj        :: tile indices
106  C     i,j,k         :: loop indices  C     i,j,k         :: loop indices
107        _RL rhoKp1  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL rhoKp1  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
108        _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)  
109        _RL sigmaX  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL sigmaX  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
110        _RL sigmaY  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL sigmaY  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
111        _RL sigmaR  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL sigmaR  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
# Line 112  C--   dummy statement to end declaration Line 127  C--   dummy statement to end declaration
127  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
128    
129  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
130        IF ( debugLevel .GE. debLevB )        IF (debugMode) CALL DEBUG_ENTER('DO_OCEANIC_PHYS',myThid)
      &     CALL DEBUG_ENTER('DO_OCEANIC_PHYS',myThid)  
131  #endif  #endif
132    
133        doDiagsRho = 0        doDiagsRho = 0
134  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
135        IF ( useDiagnostics .AND. fluidIsWater ) THEN        IF ( useDiagnostics .AND. fluidIsWater ) THEN
136          IF ( DIAGNOSTICS_IS_ON('RHOANOSQ',myThid) .OR.          IF ( DIAGNOSTICS_IS_ON('MXLDEPTH',myThid) )
137       &       DIAGNOSTICS_IS_ON('URHOMASS',myThid) .OR.       &       doDiagsRho = doDiagsRho + 1
138       &       DIAGNOSTICS_IS_ON('VRHOMASS',myThid) .OR.          IF ( DIAGNOSTICS_IS_ON('DRHODR  ',myThid) )
139       &       DIAGNOSTICS_IS_ON('WRHOMASS',myThid) .OR.       &       doDiagsRho = doDiagsRho + 2
140       &       DIAGNOSTICS_IS_ON('WRHOMASS',myThid) ) doDiagsRho = 2          IF ( DIAGNOSTICS_IS_ON('WdRHO_P ',myThid) )
141          IF ( doDiagsRho.EQ.0 .AND.       &       doDiagsRho = doDiagsRho + 4
142       &       DIAGNOSTICS_IS_ON('MXLDEPTH',myThid) ) doDiagsRho = 1          IF ( DIAGNOSTICS_IS_ON('WdRHOdP ',myThid) )
143          IF ( doDiagsRho.EQ.0 .AND.       &       doDiagsRho = doDiagsRho + 8
      &       DIAGNOSTICS_IS_ON('DRHODR  ',myThid) ) doDiagsRho = 1  
144        ENDIF        ENDIF
145  #endif /* ALLOW_DIAGNOSTICS */  #endif /* ALLOW_DIAGNOSTICS */
146    
147    #ifdef  ALLOW_OBCS
148          IF (useOBCS) THEN
149    C--   Calculate future values on open boundaries
150    C--   moved before SEAICE_MODEL call since SEAICE_MODEL needs seaice-obcs fields
151    # ifdef ALLOW_AUTODIFF_TAMC
152    CADJ STORE theta = comlev1, key=ikey_dynamics, kind=isbyte
153    CADJ STORE salt  = comlev1, key=ikey_dynamics, kind=isbyte
154    # endif
155    # ifdef ALLOW_DEBUG
156           IF (debugMode) CALL DEBUG_CALL('OBCS_CALC',myThid)
157    # endif
158           CALL OBCS_CALC( myTime+deltaTClock, myIter+1,
159         I                 uVel, vVel, wVel, theta, salt, myThid )
160          ENDIF
161    #endif  /* ALLOW_OBCS */
162    
163    #ifdef ALLOW_AUTODIFF_TAMC
164    # ifdef ALLOW_SALT_PLUME
165          DO bj=myByLo(myThid),myByHi(myThid)
166           DO bi=myBxLo(myThid),myBxHi(myThid)
167            DO j=1-OLy,sNy+OLy
168             DO i=1-OLx,sNx+OLx
169              saltPlumeDepth(i,j,bi,bj) = 0. _d 0
170              saltPlumeFlux(i,j,bi,bj)  = 0. _d 0
171             ENDDO
172            ENDDO
173           ENDDO
174          ENDDO
175    # endif
176    #endif /* ALLOW_AUTODIFF_TAMC */
177    
178    #ifdef ALLOW_FRAZIL
179          IF ( useFRAZIL ) THEN
180    C--   Freeze water in the ocean interior and let it rise to the surface
181           CALL FRAZIL_CALC_RHS( myTime, myIter, myThid )
182          ENDIF
183    #endif /* ALLOW_FRAZIL */
184    
185  #ifdef ALLOW_SEAICE  #ifdef ALLOW_SEAICE
186        IF ( useSEAICE ) THEN        IF ( useSEAICE ) THEN
187  # ifdef ALLOW_AUTODIFF_TAMC  # ifdef ALLOW_AUTODIFF_TAMC
188  cph-adj-test(  cph-adj-test(
189  CADJ STORE area,empmr,qsw,theta   = comlev1, key = ikey_dynamics  CADJ STORE area   = comlev1, key=ikey_dynamics, kind=isbyte
190    CADJ STORE hsnow  = comlev1, key=ikey_dynamics, kind=isbyte
191    CADJ STORE heff   = comlev1, key=ikey_dynamics, kind=isbyte
192    CADJ STORE empmr,qsw,theta   = comlev1, key = ikey_dynamics,
193    CADJ &     kind = isbyte
194  cph-adj-test)  cph-adj-test)
195  CADJ STORE atemp,aqh,precip    = comlev1, key = ikey_dynamics  CADJ STORE atemp,aqh,precip    = comlev1, key = ikey_dynamics,
196  CADJ STORE swdown,lwdown       = comlev1, key = ikey_dynamics  CADJ &     kind = isbyte
197    CADJ STORE swdown,lwdown       = comlev1, key = ikey_dynamics,
198    CADJ &     kind = isbyte
199  cph# ifdef EXF_READ_EVAP  cph# ifdef EXF_READ_EVAP
200  CADJ STORE evap                = comlev1, key = ikey_dynamics  CADJ STORE evap                = comlev1, key = ikey_dynamics,
201    CADJ &     kind = isbyte
202  cph# endif  cph# endif
203  CADJ STORE uvel,vvel           = comlev1, key = ikey_dynamics  CADJ STORE uvel,vvel           = comlev1, key = ikey_dynamics,
204    CADJ &     kind = isbyte
205    #  ifdef SEAICE_CGRID
206    CADJ STORE stressdivergencex   = comlev1, key = ikey_dynamics,
207    CADJ &     kind = isbyte
208    CADJ STORE stressdivergencey   = comlev1, key = ikey_dynamics,
209    CADJ &     kind = isbyte
210    #  endif
211  #  ifdef SEAICE_ALLOW_DYNAMICS  #  ifdef SEAICE_ALLOW_DYNAMICS
212  CADJ STORE uice                = comlev1, key = ikey_dynamics  CADJ STORE uice                = comlev1, key = ikey_dynamics,
213  CADJ STORE vice                = comlev1, key = ikey_dynamics  CADJ &     kind = isbyte
214    CADJ STORE vice                = comlev1, key = ikey_dynamics,
215    CADJ &     kind = isbyte
216  #   ifdef SEAICE_ALLOW_EVP  #   ifdef SEAICE_ALLOW_EVP
217  CADJ STORE seaice_sigma1       = comlev1, key = ikey_dynamics  CADJ STORE seaice_sigma1       = comlev1, key = ikey_dynamics,
218  CADJ STORE seaice_sigma2       = comlev1, key = ikey_dynamics  CADJ &     kind = isbyte
219  CADJ STORE seaice_sigma12      = comlev1, key = ikey_dynamics  CADJ STORE seaice_sigma2       = comlev1, key = ikey_dynamics,
220    CADJ &     kind = isbyte
221    CADJ STORE seaice_sigma12      = comlev1, key = ikey_dynamics,
222    CADJ &     kind = isbyte
223  #   endif  #   endif
224  #  endif  #  endif
225  #  ifdef SEAICE_SALINITY  cph#  ifdef SEAICE_SALINITY
226  CADJ STORE salt                = comlev1, key = ikey_dynamics  CADJ STORE salt                = comlev1, key = ikey_dynamics,
227  #  endif  CADJ &     kind = isbyte
228    cph#  endif
229  #  ifdef ATMOSPHERIC_LOADING  #  ifdef ATMOSPHERIC_LOADING
230  CADJ STORE pload               = comlev1, key = ikey_dynamics  CADJ STORE pload               = comlev1, key = ikey_dynamics,
231  CADJ STORE siceload            = comlev1, key = ikey_dynamics  CADJ &     kind = isbyte
232    CADJ STORE siceload            = comlev1, key = ikey_dynamics,
233    CADJ &     kind = isbyte
234  #  endif  #  endif
235  #  ifdef NONLIN_FRSURF  #  ifdef NONLIN_FRSURF
236  CADJ STORE recip_hfacc         = comlev1, key = ikey_dynamics  CADJ STORE recip_hfacc         = comlev1, key = ikey_dynamics,
237    CADJ &     kind = isbyte
238  #  endif  #  endif
239    #  ifdef ANNUAL_BALANCE
240    CADJ STORE balance_itcount     = comlev1, key = ikey_dynamics,
241    CADJ &     kind = isbyte
242    #  endif /* ANNUAL_BALANCE */
243  # endif  # endif
244  # ifdef ALLOW_DEBUG  # ifdef ALLOW_DEBUG
245          IF ( debugLevel .GE. debLevB )          IF (debugMode) CALL DEBUG_CALL('SEAICE_MODEL',myThid)
      &    CALL DEBUG_CALL('SEAICE_MODEL',myThid)  
246  # endif  # endif
247          CALL TIMER_START('SEAICE_MODEL    [DO_OCEANIC_PHYS]', myThid)          CALL TIMER_START('SEAICE_MODEL    [DO_OCEANIC_PHYS]', myThid)
248          CALL SEAICE_MODEL( myTime, myIter, myThid )          CALL SEAICE_MODEL( myTime, myIter, myThid )
# Line 177  CADJ STORE recip_hfacc         = comlev1 Line 254  CADJ STORE recip_hfacc         = comlev1
254  #endif /* ALLOW_SEAICE */  #endif /* ALLOW_SEAICE */
255    
256  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
257  CADJ STORE sst, sss           = comlev1, key = ikey_dynamics  CADJ STORE sst, sss           = comlev1, key = ikey_dynamics,
258  CADJ STORE qsw                = comlev1, key = ikey_dynamics  CADJ &     kind = isbyte
259    CADJ STORE qsw                = comlev1, key = ikey_dynamics,
260    CADJ &     kind = isbyte
261  # ifdef ALLOW_SEAICE  # ifdef ALLOW_SEAICE
262  CADJ STORE area               = comlev1, key = ikey_dynamics  CADJ STORE area               = comlev1, key = ikey_dynamics,
263    CADJ &     kind = isbyte
264  # endif  # endif
265  #endif  #endif
266    
267  #if (defined ALLOW_THSICE) && !(defined ALLOW_ATM2D)  #if (defined ALLOW_THSICE) && !(defined ALLOW_ATM2D)
268        IF ( useThSIce .AND. fluidIsWater ) THEN        IF ( useThSIce .AND. fluidIsWater ) THEN
269  #ifdef ALLOW_DEBUG  # ifdef ALLOW_AUTODIFF_TAMC
270          IF ( debugLevel .GE. debLevB )  cph(
271       &    CALL DEBUG_CALL('THSICE_MAIN',myThid)  #  ifdef NONLIN_FRSURF
272  #endif  CADJ STORE uice,vice        = comlev1, key = ikey_dynamics,
273    CADJ &     kind = isbyte
274    CADJ STORE salt,theta       = comlev1, key = ikey_dynamics,
275    CADJ &     kind = isbyte
276    CADJ STORE qnet,qsw, empmr  = comlev1, key = ikey_dynamics,
277    CADJ &     kind = isbyte
278    CADJ STORE hFac_surfC       = comlev1, key = ikey_dynamics,
279    CADJ &     kind = isbyte
280    #  endif
281    # endif
282    # ifdef ALLOW_DEBUG
283            IF (debugMode) CALL DEBUG_CALL('THSICE_MAIN',myThid)
284    # endif
285  C--     Step forward Therm.Sea-Ice variables  C--     Step forward Therm.Sea-Ice variables
286  C       and modify forcing terms including effects from ice  C       and modify forcing terms including effects from ice
287          CALL TIMER_START('THSICE_MAIN     [DO_OCEANIC_PHYS]', myThid)          CALL TIMER_START('THSICE_MAIN     [DO_OCEANIC_PHYS]', myThid)
# Line 199  C       and modify forcing terms includi Line 291  C       and modify forcing terms includi
291  #endif /* ALLOW_THSICE */  #endif /* ALLOW_THSICE */
292    
293  #ifdef ALLOW_SHELFICE  #ifdef ALLOW_SHELFICE
294    # ifdef ALLOW_AUTODIFF_TAMC
295    CADJ STORE salt, theta = comlev1, key = ikey_dynamics,
296    CADJ &     kind = isbyte
297    # endif
298        IF ( useShelfIce .AND. fluidIsWater ) THEN        IF ( useShelfIce .AND. fluidIsWater ) THEN
299  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
300          IF ( debugLevel .GE. debLevB )         IF (debugMode) CALL DEBUG_CALL('SHELFICE_THERMODYNAMICS',myThid)
      &    CALL DEBUG_CALL('SHELFICE_THERMODYNAMICS',myThid)  
301  #endif  #endif
302  C     compute temperature and (virtual) salt flux at the  C     compute temperature and (virtual) salt flux at the
303  C     shelf-ice ocean interface  C     shelf-ice ocean interface
# Line 214  C     shelf-ice ocean interface Line 309  C     shelf-ice ocean interface
309        ENDIF        ENDIF
310  #endif /* ALLOW_SHELFICE */  #endif /* ALLOW_SHELFICE */
311    
312    #ifdef ALLOW_ICEFRONT
313          IF ( useICEFRONT .AND. fluidIsWater ) THEN
314    #ifdef ALLOW_DEBUG
315           IF (debugMode) CALL DEBUG_CALL('ICEFRONT_THERMODYNAMICS',myThid)
316    #endif
317    C     compute temperature and (virtual) salt flux at the
318    C     ice-front ocean interface
319           CALL TIMER_START('ICEFRONT_THERMODYNAMICS [DO_OCEANIC_PHYS]',
320         &       myThid)
321           CALL ICEFRONT_THERMODYNAMICS( myTime, myIter, myThid )
322           CALL TIMER_STOP( 'ICEFRONT_THERMODYNAMICS [DO_OCEANIC_PHYS]',
323         &      myThid)
324          ENDIF
325    #endif /* ALLOW_ICEFRONT */
326    
327    #ifdef ALLOW_SALT_PLUME
328          IF ( useSALT_PLUME ) THEN
329              CALL SALT_PLUME_DO_EXCH( myTime, myIter, myThid )
330          ENDIF
331    #endif /* ALLOW_SALT_PLUME */
332    
333  C--   Freeze water at the surface  C--   Freeze water at the surface
334          IF ( allowFreezing ) THEN
335  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
336  CADJ STORE theta = comlev1, key = ikey_dynamics  CADJ STORE theta = comlev1, key = ikey_dynamics,
337    CADJ &     kind = isbyte
338  #endif  #endif
       IF ( allowFreezing  
      &                   .AND. .NOT. useSEAICE  
      &                   .AND. .NOT. useThSIce ) THEN  
339          CALL FREEZE_SURFACE(  myTime, myIter, myThid )          CALL FREEZE_SURFACE(  myTime, myIter, myThid )
340        ENDIF        ENDIF
341    
# Line 234  C jmc: do not know precisely where to pu Line 349  C jmc: do not know precisely where to pu
349    
350  #ifdef ALLOW_BALANCE_FLUXES  #ifdef ALLOW_BALANCE_FLUXES
351  C     balance fluxes  C     balance fluxes
352        IF ( balanceEmPmR )        IF ( balanceEmPmR .AND. (.NOT.useSeaice .OR. useThSIce) )
353       &        CALL REMOVE_MEAN_RS( 1, EmPmR, maskH, maskH, rA, drF,       &      CALL REMOVE_MEAN_RS( 1, EmPmR, maskInC, maskInC, rA, drF,
354       &        'EmPmR', myTime, myThid )       &        'EmPmR', myTime, myThid )
355        IF ( balanceQnet )        IF ( balanceQnet  .AND. (.NOT.useSeaice .OR. useThSIce) )
356       &        CALL REMOVE_MEAN_RS( 1, Qnet,  maskH, maskH, rA, drF,       &      CALL REMOVE_MEAN_RS( 1, Qnet,  maskInC, maskInC, rA, drF,
357       &        'Qnet ', myTime, myThid )       &        'Qnet ', myTime, myThid )
358  #endif /* ALLOW_BALANCE_FLUXES */  #endif /* ALLOW_BALANCE_FLUXES */
359    
360  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
361  C--   HPF directive to help TAMC  C--   HPF directive to help TAMC
362  CHPF$ INDEPENDENT  CHPF$ INDEPENDENT
363    #else  /* ALLOW_AUTODIFF_TAMC */
364    C     if fluid is not water, by-pass find_rho, gmredi, surfaceForcing
365    C     and all vertical mixing schemes, but keep OBCS_CALC
366          IF ( fluidIsWater ) THEN
367  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
368        DO bj=myByLo(myThid),myByHi(myThid)        DO bj=myByLo(myThid),myByHi(myThid)
369  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
# Line 264  CHPF$ INDEPENDENT Line 383  CHPF$ INDEPENDENT
383            itdkey = (act1 + 1) + act2*max1            itdkey = (act1 + 1) + act2*max1
384       &                      + act3*max1*max2       &                      + act3*max1*max2
385       &                      + act4*max1*max2*max3       &                      + act4*max1*max2*max3
 #else  /* ALLOW_AUTODIFF_TAMC */  
 C     if fluid is not water, by-pass find_rho, gmredi, surfaceForcing  
 C     and all vertical mixing schemes, but keep OBCS_CALC  
         IF ( fluidIsWater ) THEN  
386  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
387    
388  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 276  C     just ensure that all memory refere Line 391  C     just ensure that all memory refere
391  C     point numbers. This prevents spurious hardware signals due to  C     point numbers. This prevents spurious hardware signals due to
392  C     uninitialised but inert locations.  C     uninitialised but inert locations.
393    
394    #ifdef ALLOW_AUTODIFF_TAMC
395          DO j=1-OLy,sNy+OLy          DO j=1-OLy,sNy+OLy
396           DO i=1-OLx,sNx+OLx           DO i=1-OLx,sNx+OLx
           rhoK   (i,j)   = 0. _d 0  
397            rhoKm1 (i,j)   = 0. _d 0            rhoKm1 (i,j)   = 0. _d 0
398            rhoKp1 (i,j)   = 0. _d 0            rhoKp1 (i,j)   = 0. _d 0
399           ENDDO           ENDDO
400          ENDDO          ENDDO
401    #endif /* ALLOW_AUTODIFF_TAMC */
402    
403          DO k=1,Nr          DO k=1,Nr
404           DO j=1-OLy,sNy+OLy           DO j=1-OLy,sNy+OLy
405            DO i=1-OLx,sNx+OLx            DO i=1-OLx,sNx+OLx
406  C This is currently also used by IVDC and Diagnostics  C This is currently used by GMRedi, IVDC, MXL-depth  and Diagnostics
407             sigmaX(i,j,k) = 0. _d 0             sigmaX(i,j,k) = 0. _d 0
408             sigmaY(i,j,k) = 0. _d 0             sigmaY(i,j,k) = 0. _d 0
409             sigmaR(i,j,k) = 0. _d 0             sigmaR(i,j,k) = 0. _d 0
410  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
411  cph all the following init. are necessary for TAF  cph all the following init. are necessary for TAF
412  cph although some of these are re-initialised later.  cph although some of these are re-initialised later.
413               rhoInSitu(i,j,k,bi,bj) = 0.
414             IVDConvCount(i,j,k,bi,bj) = 0.             IVDConvCount(i,j,k,bi,bj) = 0.
415  # ifdef ALLOW_GMREDI  # ifdef ALLOW_GMREDI
416             Kwx(i,j,k,bi,bj)  = 0. _d 0             Kwx(i,j,k,bi,bj)  = 0. _d 0
# Line 319  cph although some of these are re-initia Line 436  cph although some of these are re-initia
436             KPPdiffKzS(i,j,k,bi,bj)  = 0. _d 0             KPPdiffKzS(i,j,k,bi,bj)  = 0. _d 0
437             KPPdiffKzT(i,j,k,bi,bj)  = 0. _d 0             KPPdiffKzT(i,j,k,bi,bj)  = 0. _d 0
438  # endif /* ALLOW_KPP */  # endif /* ALLOW_KPP */
439    # ifdef ALLOW_GGL90
440               GGL90viscArU(i,j,k,bi,bj)  = 0. _d 0
441               GGL90viscArV(i,j,k,bi,bj)  = 0. _d 0
442               GGL90diffKr(i,j,k,bi,bj)  = 0. _d 0
443    # endif /* ALLOW_GGL90 */
444  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
445            ENDDO            ENDDO
446           ENDDO           ENDDO
# Line 330  cph although some of these are re-initia Line 452  cph although some of these are re-initia
452          jMax = sNy+OLy          jMax = sNy+OLy
453    
454  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
455  CADJ STORE theta(:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte  CADJ STORE theta(:,:,:,bi,bj) = comlev1_bibj, key=itdkey,
456  CADJ STORE salt (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     kind = isbyte
457    CADJ STORE salt (:,:,:,bi,bj) = comlev1_bibj, key=itdkey,
458    CADJ &     kind = isbyte
459  CADJ STORE totphihyd(:,:,:,bi,bj)  CADJ STORE totphihyd(:,:,:,bi,bj)
460  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey,
461    CADJ &     kind = isbyte
462  # ifdef ALLOW_KPP  # ifdef ALLOW_KPP
463  CADJ STORE uvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte  CADJ STORE uvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey,
464  CADJ STORE vvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     kind = isbyte
465    CADJ STORE vvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey,
466    CADJ &     kind = isbyte
467    # endif
468    # ifdef ALLOW_SALT_PLUME
469    CADJ STORE saltplumedepth(:,:,bi,bj) = comlev1_bibj, key=itdkey,
470    CADJ &     kind = isbyte
471  # endif  # endif
472  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
473    
474    C--   Always compute density (stored in common block) here; even when it is not
475    C     needed here, will be used anyway in calc_phi_hyd (data flow easier this way)
476    #ifdef ALLOW_DEBUG
477            IF (debugMode) CALL DEBUG_CALL('FIND_RHO_2D (xNr)',myThid)
478    #endif
479    #ifdef ALLOW_AUTODIFF_TAMC
480            IF ( fluidIsWater ) THEN
481    #endif /* ALLOW_AUTODIFF_TAMC */
482    #ifdef ALLOW_DOWN_SLOPE
483             IF ( useDOWN_SLOPE ) THEN
484               DO k=1,Nr
485                CALL DWNSLP_CALC_RHO(
486         I                  theta, salt,
487         O                  rhoInSitu(1-OLx,1-OLy,k,bi,bj),
488         I                  k, bi, bj, myTime, myIter, myThid )
489               ENDDO
490             ENDIF
491    #endif /* ALLOW_DOWN_SLOPE */
492    #ifdef ALLOW_BBL
493             IF ( useBBL ) THEN
494    C     pkg/bbl requires in-situ bbl density for depths equal to and deeper than the bbl.
495    C     To reduce computation and storage requirement, these densities are stored in the
496    C     dry grid boxes of rhoInSitu.  See BBL_CALC_RHO for details.
497               DO k=Nr,1,-1
498                CALL BBL_CALC_RHO(
499         I                  theta, salt,
500         O                  rhoInSitu,
501         I                  k, bi, bj, myTime, myIter, myThid )
502    
503               ENDDO
504             ENDIF
505    #endif /* ALLOW_BBL */
506             IF ( .NOT. ( useDOWN_SLOPE .OR. useBBL ) ) THEN
507               DO k=1,Nr
508                CALL FIND_RHO_2D(
509         I                iMin, iMax, jMin, jMax, k,
510         I                theta(1-OLx,1-OLy,k,bi,bj),
511         I                salt (1-OLx,1-OLy,k,bi,bj),
512         O                rhoInSitu(1-OLx,1-OLy,k,bi,bj),
513         I                k, bi, bj, myThid )
514               ENDDO
515             ENDIF
516    #ifdef ALLOW_AUTODIFF_TAMC
517            ELSE
518    C-        fluid is not water:
519              DO k=1,Nr
520               DO j=1-OLy,sNy+OLy
521                DO i=1-OLx,sNx+OLx
522                  rhoInSitu(i,j,k,bi,bj) = 0.
523                ENDDO
524               ENDDO
525              ENDDO
526            ENDIF
527    #endif /* ALLOW_AUTODIFF_TAMC */
528    
529  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
530          IF ( debugLevel .GE. debLevB )          IF (debugMode) CALL DEBUG_MSG('ENTERING UPWARD K LOOP',myThid)
      &    CALL DEBUG_MSG('ENTERING UPWARD K LOOP',myThid)  
531  #endif  #endif
532    
533  C--     Start of diagnostic loop  C--     Start of diagnostic loop
# Line 351  C--     Start of diagnostic loop Line 536  C--     Start of diagnostic loop
536  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
537  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?
538  C? Do we still need this?  C? Do we still need this?
539  cph kkey formula corrected.  cph kkey formula corrected.
540  cph Needed for rhoK, rhoKm1, in the case useGMREDI.  cph Needed for rhoK, rhoKm1, in the case useGMREDI.
541           kkey = (itdkey-1)*Nr + k            kkey = (itdkey-1)*Nr + k
542  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
543    
544    c#ifdef ALLOW_AUTODIFF_TAMC
545    cCADJ STORE theta(:,:,k,bi,bj) = comlev1_bibj_k, key=kkey,
546    cCADJ &     kind = isbyte
547    cCADJ STORE salt(:,:,k,bi,bj)  = comlev1_bibj_k, key=kkey,
548    cCADJ &     kind = isbyte
549    c#endif /* ALLOW_AUTODIFF_TAMC */
550    
551  C--       Calculate gradients of potential density for isoneutral  C--       Calculate gradients of potential density for isoneutral
552  C         slope terms (e.g. GM/Redi tensor or IVDC diffusivity)  C         slope terms (e.g. GM/Redi tensor or IVDC diffusivity)
553            IF ( useGMRedi .OR. (k.GT.1 .AND. ivdc_kappa.NE.0.)            IF ( useGMRedi .OR. (k.GT.1 .AND. ivdc_kappa.NE.0.)
554         &         .OR. usePP81 .OR. useMY82 .OR. useGGL90
555       &         .OR. useSALT_PLUME .OR. doDiagsRho.GE.1 ) THEN       &         .OR. useSALT_PLUME .OR. doDiagsRho.GE.1 ) THEN
 #ifdef ALLOW_DEBUG  
             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 )  
   
556              IF (k.GT.1) THEN              IF (k.GT.1) THEN
557  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
558  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,
559  CADJ STORE salt (:,:,k-1,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ &     kind = isbyte
560  #endif /* ALLOW_AUTODIFF_TAMC */  CADJ STORE salt (:,:,k-1,bi,bj) = comlev1_bibj_k, key=kkey,
561               CALL FIND_RHO(  CADJ &     kind = isbyte
562       I        bi, bj, iMin, iMax, jMin, jMax, k-1, k,  CADJ STORE rhokm1 (bi,bj)       = comlev1_bibj_k, key=kkey,
563       I        theta, salt,  CADJ &     kind = isbyte
564       O        rhoKm1,  #endif /* ALLOW_AUTODIFF_TAMC */
565       I        myThid )               CALL FIND_RHO_2D(
566         I                 iMin, iMax, jMin, jMax, k,
567         I                 theta(1-OLx,1-OLy,k-1,bi,bj),
568         I                 salt (1-OLx,1-OLy,k-1,bi,bj),
569         O                 rhoKm1,
570         I                 k-1, bi, bj, myThid )
571              ENDIF              ENDIF
572  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
573              IF ( debugLevel .GE. debLevB )              IF (debugMode) CALL DEBUG_CALL('GRAD_SIGMA',myThid)
      &       CALL DEBUG_CALL('GRAD_SIGMA',myThid)  
574  #endif  #endif
575  cph Avoid variable aliasing for adjoint !!!  cph Avoid variable aliasing for adjoint !!!
576              DO j=jMin,jMax              DO j=jMin,jMax
577               DO i=iMin,iMax               DO i=iMin,iMax
578                rhoKp1(i,j) = rhoK(i,j)                rhoKp1(i,j) = rhoInSitu(i,j,k,bi,bj)
579               ENDDO               ENDDO
580              ENDDO              ENDDO
581              CALL GRAD_SIGMA(              CALL GRAD_SIGMA(
582       I             bi, bj, iMin, iMax, jMin, jMax, k,       I             bi, bj, iMin, iMax, jMin, jMax, k,
583       I             rhoK, rhoKm1, rhoKp1,       I             rhoInSitu(1-OLx,1-OLy,k,bi,bj), rhoKm1, rhoKp1,
584       O             sigmaX, sigmaY, sigmaR,       O             sigmaX, sigmaY, sigmaR,
585       I             myThid )       I             myThid )
586  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
587  #ifdef GMREDI_WITH_STABLE_ADJOINT  #ifdef GMREDI_WITH_STABLE_ADJOINT
588  cgf zero out adjoint fields to stabilize pkg/gmredi adjoint  cgf zero out adjoint fields to stabilize pkg/gmredi adjoint
589  cgf -> cuts adjoint dependency from slope to state  cgf -> cuts adjoint dependency from slope to state
590        CALL ZERO_ADJ_LOC( Nr, sigmaX, myThid)              CALL ZERO_ADJ_LOC( Nr, sigmaX, myThid)
591        CALL ZERO_ADJ_LOC( Nr, sigmaY, myThid)              CALL ZERO_ADJ_LOC( Nr, sigmaY, myThid)
592        CALL ZERO_ADJ_LOC( Nr, sigmaR, myThid)              CALL ZERO_ADJ_LOC( Nr, sigmaR, myThid)
593  #endif  #endif
594  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
595            ENDIF            ENDIF
596    
597  C--       Implicit Vertical Diffusion for Convection  C--       Implicit Vertical Diffusion for Convection
 c ==> should use sigmaR !!!  
598            IF (k.GT.1 .AND. ivdc_kappa.NE.0.) THEN            IF (k.GT.1 .AND. ivdc_kappa.NE.0.) THEN
599  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
600              IF ( debugLevel .GE. debLevB )              IF (debugMode) CALL DEBUG_CALL('CALC_IVDC',myThid)
      &       CALL DEBUG_CALL('CALC_IVDC',myThid)  
601  #endif  #endif
602              CALL CALC_IVDC(              CALL CALC_IVDC(
603       I        bi, bj, iMin, iMax, jMin, jMax, k,       I        bi, bj, iMin, iMax, jMin, jMax, k,
604       I        rhoKm1, rhoK,       I        sigmaR,
605       I        myTime, myIter, myThid)       I        myTime, myIter, myThid)
606            ENDIF            ENDIF
607    
608  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
609            IF ( doDiagsRho.GE.2 ) THEN            IF ( doDiagsRho.GE.4 ) THEN
610              CALL DIAGS_RHO( k, bi, bj,              CALL DIAGS_RHO_L( doDiagsRho, k, bi, bj,
611       I                      rhoK, rhoKm1,       I                        rhoInSitu(1-OLx,1-OLy,1,bi,bj),
612       I                      myTime, myIter, myThid)       I                        rhoKm1, wVel,
613         I                        myTime, myIter, myThid )
614            ENDIF            ENDIF
615  #endif  #endif
616    
# Line 436  C--     end of diagnostic k loop (Nr:1) Line 618  C--     end of diagnostic k loop (Nr:1)
618          ENDDO          ENDDO
619    
620  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
621  CADJ STORE IVDConvCount(:,:,:,bi,bj)  CADJ STORE IVDConvCount(:,:,:,bi,bj)
622  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey,
623    CADJ &     kind = isbyte
624  #endif  #endif
625    
626  C--     Diagnose Mixed Layer Depth:  C--     Diagnose Mixed Layer Depth:
627          IF ( useGMRedi .OR. doDiagsRho.GE.1 ) THEN          IF ( useGMRedi .OR. MOD(doDiagsRho,2).EQ.1 ) THEN
628            CALL CALC_OCE_MXLAYER( rhoK, sigmaR,            CALL CALC_OCE_MXLAYER(
629       &              bi, bj, myTime, myIter, myThid )       I              rhoInSitu(1-OLx,1-OLy,1,bi,bj), sigmaR,
630         I              bi, bj, myTime, myIter, myThid )
631          ENDIF          ENDIF
632    
633  #ifdef ALLOW_SALT_PLUME  #ifdef ALLOW_SALT_PLUME
634          IF ( useSALT_PLUME ) THEN          IF ( useSALT_PLUME ) THEN
635            CALL SALT_PLUME_CALC_DEPTH( rhoK, sigmaR,            CALL SALT_PLUME_CALC_DEPTH(
636       &              bi, bj, myTime, myIter, myThid )       I              rhoInSitu(1-OLx,1-OLy,1,bi,bj), sigmaR,
637         I              bi, bj, myTime, myIter, myThid )
638          ENDIF          ENDIF
639  #endif /* ALLOW_SALT_PLUME */  #endif /* ALLOW_SALT_PLUME */
640    
641  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
642          IF ( doDiagsRho.GE.1 ) THEN          IF ( MOD(doDiagsRho,4).GE.2 ) THEN
643            CALL DIAGNOSTICS_FILL (sigmaR, 'DRHODR  ', 0, Nr,            CALL DIAGNOSTICS_FILL (sigmaR, 'DRHODR  ', 0, Nr,
644       &         2, bi, bj, myThid)       &         2, bi, bj, myThid)
645          ENDIF          ENDIF
# Line 463  C--     Diagnose Mixed Layer Depth: Line 648  C--     Diagnose Mixed Layer Depth:
648  C--     Determines forcing terms based on external fields  C--     Determines forcing terms based on external fields
649  C       relaxation terms, etc.  C       relaxation terms, etc.
650  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
651          IF ( debugLevel .GE. debLevB )          IF (debugMode) CALL DEBUG_CALL('EXTERNAL_FORCING_SURF',myThid)
      &    CALL DEBUG_CALL('EXTERNAL_FORCING_SURF',myThid)  
652  #endif  #endif
653  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
654  CADJ STORE EmPmR(:,:,bi,bj)  CADJ STORE EmPmR(:,:,bi,bj)
655  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey,
656    CADJ &     kind = isbyte
657  # ifdef EXACT_CONSERV  # ifdef EXACT_CONSERV
658  CADJ STORE PmEpR(:,:,bi,bj)  CADJ STORE PmEpR(:,:,bi,bj)
659  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey,
660    CADJ &     kind = isbyte
661  # endif  # endif
662  # ifdef NONLIN_FRSURF  # ifdef NONLIN_FRSURF
663  CADJ STORE hFac_surfC(:,:,bi,bj)  CADJ STORE hFac_surfC(:,:,bi,bj)
664  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey,
665    CADJ &     kind = isbyte
666  CADJ STORE recip_hFacC(:,:,:,bi,bj)  CADJ STORE recip_hFacC(:,:,:,bi,bj)
667  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey,
668  # endif  CADJ &     kind = isbyte
669    #  if (defined (ALLOW_PTRACERS))
670    CADJ STORE surfaceForcingS(:,:,bi,bj)   = comlev1_bibj, key=itdkey,
671    CADJ &     kind = isbyte
672    CADJ STORE surfaceForcingT(:,:,bi,bj)   = comlev1_bibj, key=itdkey,
673    CADJ &     kind = isbyte
674    #  endif /* ALLOW_PTRACERS */
675    # endif /* NONLIN_FRSURF */
676  #endif  #endif
677          CALL EXTERNAL_FORCING_SURF(          CALL EXTERNAL_FORCING_SURF(
678       I             bi, bj, iMin, iMax, jMin, jMax,       I             bi, bj, iMin, iMax, jMin, jMax,
# Line 487  CADJ &     = comlev1_bibj, key=itdkey, b Line 681  CADJ &     = comlev1_bibj, key=itdkey, b
681  # ifdef EXACT_CONSERV  # ifdef EXACT_CONSERV
682  cph-test  cph-test
683  cphCADJ STORE PmEpR(:,:,bi,bj)  cphCADJ STORE PmEpR(:,:,bi,bj)
684  cphCADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  cphCADJ &     = comlev1_bibj, key=itdkey,
685    cphCADJ &     kind = isbyte
686  # endif  # endif
687  #endif  #endif
688    
689  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
690  cph needed for KPP  cph needed for KPP
691  CADJ STORE surfaceForcingU(:,:,bi,bj)  CADJ STORE surfaceForcingU(:,:,bi,bj)
692  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey,
693    CADJ &     kind = isbyte
694  CADJ STORE surfaceForcingV(:,:,bi,bj)  CADJ STORE surfaceForcingV(:,:,bi,bj)
695  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey,
696    CADJ &     kind = isbyte
697  CADJ STORE surfaceForcingS(:,:,bi,bj)  CADJ STORE surfaceForcingS(:,:,bi,bj)
698  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey,
699    CADJ &     kind = isbyte
700  CADJ STORE surfaceForcingT(:,:,bi,bj)  CADJ STORE surfaceForcingT(:,:,bi,bj)
701  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey,
702    CADJ &     kind = isbyte
703  CADJ STORE surfaceForcingTice(:,:,bi,bj)  CADJ STORE surfaceForcingTice(:,:,bi,bj)
704  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey,
705    CADJ &     kind = isbyte
706  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
707    
708  #ifdef  ALLOW_KPP  #ifdef  ALLOW_KPP
709  C--     Compute KPP mixing coefficients  C--     Compute KPP mixing coefficients
710          IF (useKPP) THEN          IF (useKPP) THEN
711  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
712            IF ( debugLevel .GE. debLevB )            IF (debugMode) CALL DEBUG_CALL('KPP_CALC',myThid)
      &     CALL DEBUG_CALL('KPP_CALC',myThid)  
713  #endif  #endif
714              CALL TIMER_START('KPP_CALC [DO_OCEANIC_PHYS]', myThid)
715            CALL KPP_CALC(            CALL KPP_CALC(
716       I                  bi, bj, myTime, myIter, myThid )       I                  bi, bj, myTime, myIter, myThid )
717              CALL TIMER_STOP ('KPP_CALC [DO_OCEANIC_PHYS]', myThid)
718  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
719          ELSE          ELSE
720            CALL KPP_CALC_DUMMY(            CALL KPP_CALC_DUMMY(
# Line 527  C--     Compute KPP mixing coefficients Line 728  C--     Compute KPP mixing coefficients
728  C--     Compute PP81 mixing coefficients  C--     Compute PP81 mixing coefficients
729          IF (usePP81) THEN          IF (usePP81) THEN
730  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
731            IF ( debugLevel .GE. debLevB )            IF (debugMode) CALL DEBUG_CALL('PP81_CALC',myThid)
      &     CALL DEBUG_CALL('PP81_CALC',myThid)  
732  #endif  #endif
733            CALL PP81_CALC(            CALL PP81_CALC(
734       I                  bi, bj, myTime, myThid )       I                     bi, bj, sigmaR, myTime, myIter, myThid )
735          ENDIF          ENDIF
736  #endif /* ALLOW_PP81 */  #endif /* ALLOW_PP81 */
737    
# Line 539  C--     Compute PP81 mixing coefficients Line 739  C--     Compute PP81 mixing coefficients
739  C--     Compute MY82 mixing coefficients  C--     Compute MY82 mixing coefficients
740          IF (useMY82) THEN          IF (useMY82) THEN
741  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
742            IF ( debugLevel .GE. debLevB )            IF (debugMode) CALL DEBUG_CALL('MY82_CALC',myThid)
      &     CALL DEBUG_CALL('MY82_CALC',myThid)  
743  #endif  #endif
744            CALL MY82_CALC(            CALL MY82_CALC(
745       I                  bi, bj, myTime, myThid )       I                     bi, bj, sigmaR, myTime, myIter, myThid )
746          ENDIF          ENDIF
747  #endif /* ALLOW_MY82 */  #endif /* ALLOW_MY82 */
748    
749  #ifdef  ALLOW_GGL90  #ifdef  ALLOW_GGL90
750    #ifdef ALLOW_AUTODIFF_TAMC
751    CADJ STORE GGL90TKE (:,:,:,bi,bj) = comlev1_bibj, key=itdkey,
752    CADJ &     kind = isbyte
753    #endif /* ALLOW_AUTODIFF_TAMC */
754  C--     Compute GGL90 mixing coefficients  C--     Compute GGL90 mixing coefficients
755          IF (useGGL90) THEN          IF (useGGL90) THEN
756  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
757            IF ( debugLevel .GE. debLevB )            IF (debugMode) CALL DEBUG_CALL('GGL90_CALC',myThid)
      &     CALL DEBUG_CALL('GGL90_CALC',myThid)  
758  #endif  #endif
759              CALL TIMER_START('GGL90_CALC [DO_OCEANIC_PHYS]', myThid)
760            CALL GGL90_CALC(            CALL GGL90_CALC(
761       I                  bi, bj, myTime, myThid )       I                     bi, bj, sigmaR, myTime, myIter, myThid )
762              CALL TIMER_STOP ('GGL90_CALC [DO_OCEANIC_PHYS]', myThid)
763          ENDIF          ENDIF
764  #endif /* ALLOW_GGL90 */  #endif /* ALLOW_GGL90 */
765    
# Line 565  C--     Compute GGL90 mixing coefficient Line 769  C--     Compute GGL90 mixing coefficient
769          ENDIF          ENDIF
770          IF (taveFreq.GT.0. .AND. ivdc_kappa.NE.0.) THEN          IF (taveFreq.GT.0. .AND. ivdc_kappa.NE.0.) THEN
771            CALL TIMEAVE_CUMULATE(ConvectCountTave, IVDConvCount,            CALL TIMEAVE_CUMULATE(ConvectCountTave, IVDConvCount,
772       I                           Nr, deltaTclock, bi, bj, myThid)       I                           Nr, deltaTClock, bi, bj, myThid)
773          ENDIF          ENDIF
774  #endif /* ALLOW_TIMEAVE */  #endif /* ALLOW_TIMEAVE */
775    
776  #ifdef  ALLOW_GMREDI  #ifdef ALLOW_GMREDI
777  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
778  # ifndef GM_EXCLUDE_CLIPPING  # ifndef GM_EXCLUDE_CLIPPING
779  cph storing here is needed only for one GMREDI_OPTIONS:  cph storing here is needed only for one GMREDI_OPTIONS:
780  cph define GM_BOLUS_ADVEC  cph define GM_BOLUS_ADVEC
781  cph keep it although TAF says you dont need to.  cph keep it although TAF says you dont need to.
782  cph but I've avoided the #ifdef for now, in case more things change  cph but I have avoided the #ifdef for now, in case more things change
783  CADJ STORE sigmaX(:,:,:)        = comlev1_bibj, key=itdkey, byte=isbyte  CADJ STORE sigmaX(:,:,:)        = comlev1_bibj, key=itdkey,
784  CADJ STORE sigmaY(:,:,:)        = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     kind = isbyte
785  CADJ STORE sigmaR(:,:,:)        = comlev1_bibj, key=itdkey, byte=isbyte  CADJ STORE sigmaY(:,:,:)        = comlev1_bibj, key=itdkey,
786    CADJ &     kind = isbyte
787    CADJ STORE sigmaR(:,:,:)        = comlev1_bibj, key=itdkey,
788    CADJ &     kind = isbyte
789  # endif  # endif
790  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
791    
792  C--     Calculate iso-neutral slopes for the GM/Redi parameterisation  C--     Calculate iso-neutral slopes for the GM/Redi parameterisation
793          IF (useGMRedi) THEN          IF (useGMRedi) THEN
794  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
795            IF ( debugLevel .GE. debLevB )            IF (debugMode) CALL DEBUG_CALL('GMREDI_CALC_TENSOR',myThid)
      &     CALL DEBUG_CALL('GMREDI_CALC_TENSOR',myThid)  
796  #endif  #endif
797            CALL GMREDI_CALC_TENSOR(            CALL GMREDI_CALC_TENSOR(
 c    I             bi, bj, iMin, iMax, jMin, jMax,  
 c    I             sigmaX, sigmaY, sigmaR,  
 c    I             myThid )  
798       I             iMin, iMax, jMin, jMax,       I             iMin, iMax, jMin, jMax,
799       I             sigmaX, sigmaY, sigmaR,       I             sigmaX, sigmaY, sigmaR,
800       I             bi, bj, myTime, myIter, myThid )       I             bi, bj, myTime, myIter, myThid )
801  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
802          ELSE          ELSE
803            CALL GMREDI_CALC_TENSOR_DUMMY(            CALL GMREDI_CALC_TENSOR_DUMMY(
 c    I             bi, bj, iMin, iMax, jMin, jMax,  
 c    I             sigmaX, sigmaY, sigmaR,  
 c    I             myThid )  
804       I             iMin, iMax, jMin, jMax,       I             iMin, iMax, jMin, jMax,
805       I             sigmaX, sigmaY, sigmaR,       I             sigmaX, sigmaY, sigmaR,
806       I             bi, bj, myTime, myIter, myThid )       I             bi, bj, myTime, myIter, myThid )
807  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
808          ENDIF          ENDIF
809  #endif  /* ALLOW_GMREDI */  #endif /* ALLOW_GMREDI */
   
 #ifndef ALLOW_AUTODIFF_TAMC  
 C---  if fluid Is Water: end  
         ENDIF  
 #endif  
810    
811  #ifdef  ALLOW_OBCS  #ifdef ALLOW_DOWN_SLOPE
812  C--     Calculate future values on open boundaries          IF ( useDOWN_SLOPE ) THEN
813          IF (useOBCS) THEN  C--     Calculate Downsloping Flow for Down_Slope parameterization
814  #ifdef ALLOW_DEBUG           IF ( usingPCoords ) THEN
815            IF ( debugLevel .GE. debLevB )            CALL DWNSLP_CALC_FLOW(
816       &     CALL DEBUG_CALL('OBCS_CALC',myThid)       I                bi, bj, kSurfC, rhoInSitu,
817  #endif       I                myTime, myIter, myThid )
818            CALL OBCS_CALC( bi, bj, myTime+deltaTclock, myIter+1,           ELSE
819       I            uVel, vVel, wVel, theta, salt,            CALL DWNSLP_CALC_FLOW(
820       I            myThid )       I                bi, bj, kLowC, rhoInSitu,
821         I                myTime, myIter, myThid )
822             ENDIF
823          ENDIF          ENDIF
824  #endif  /* ALLOW_OBCS */  #endif /* ALLOW_DOWN_SLOPE */
825    
826  C--   end bi,bj loops.  C--   end bi,bj loops.
827         ENDDO         ENDDO
828        ENDDO        ENDDO
829    
830  #ifdef  ALLOW_KPP  #ifdef ALLOW_BALANCE_RELAX
831    # ifdef ALLOW_AUTODIFF_TAMC
832    CADJ STORE SSSrlx = comlev1, key=ikey_dynamics, kind=isbyte
833    CADJ STORE SSSrlxTile = comlev1, key=ikey_dynamics, kind=isbyte
834    CADJ STORE SSSrlxGlob = comlev1, key=ikey_dynamics, kind=isbyte
835    CADJ STORE SSTrlx = comlev1, key=ikey_dynamics, kind=isbyte
836    CADJ STORE SSTrlxTile = comlev1, key=ikey_dynamics, kind=isbyte
837    CADJ STORE SSTrlxGlob = comlev1, key=ikey_dynamics, kind=isbyte
838    # endif /* ALLOW_AUTODIFF_TAMC */
839           CALL BALANCE_RELAX( myTime, myIter, myThid )
840    #endif /* ALLOW_BALANCE_RELAX */
841    
842    #ifndef ALLOW_AUTODIFF_TAMC
843    C---  if fluid Is Water: end
844          ENDIF
845    #endif
846    
847    #ifdef ALLOW_BBL
848          IF ( useBBL ) THEN
849           CALL BBL_CALC_RHS(
850         I                          myTime, myIter, myThid )
851          ENDIF
852    #endif /* ALLOW_BBL */
853    
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_KPP
868        IF (useKPP) THEN        IF (useKPP) THEN
869          CALL KPP_DO_EXCH( myThid )          CALL KPP_DO_EXCH( myThid )
870        ENDIF        ENDIF
871  #endif  /* ALLOW_KPP */  #endif /* ALLOW_KPP */
872    
873  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
874        IF ( fluidIsWater .AND. useDiagnostics ) THEN        IF ( fluidIsWater .AND. useDiagnostics ) THEN
875            CALL DIAGS_RHO_G(
876         I                    rhoInSitu, uVel, vVel, wVel,
877         I                    myTime, myIter, myThid )
878          CALL DIAGS_OCEANIC_SURF_FLUX( myTime, myIter, myThid )          CALL DIAGS_OCEANIC_SURF_FLUX( myTime, myIter, myThid )
879        ENDIF        ENDIF
880        IF ( ivdc_kappa.NE.0 .AND. useDiagnostics ) THEN        IF ( ivdc_kappa.NE.0 .AND. useDiagnostics ) THEN
881          CALL DIAGNOSTICS_FILL( IVDConvCount,'CONVADJ ',          CALL DIAGNOSTICS_FILL( IVDConvCount, 'CONVADJ ',
882       &                         0, Nr, 0, 1, 1, myThid )       &                               0, Nr, 0, 1, 1, myThid )
883        ENDIF        ENDIF
884  #endif  #endif
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.67  
changed lines
  Added in v.1.120
  ViewVC Help
Powered by ViewVC 1.1.22