/[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.7 by edhill, Tue Sep 7 17:29:14 2004 UTC revision 1.61 by dimitri, Wed Nov 28 09:26:16 2007 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 35  C     == Global variables === Line 38  C     == Global variables ===
38  #include "PARAMS.h"  #include "PARAMS.h"
39  #include "DYNVARS.h"  #include "DYNVARS.h"
40  #include "GRID.h"  #include "GRID.h"
41  c #include "GAD.h"  #ifdef ALLOW_TIMEAVE
42  c #ifdef ALLOW_PASSIVE_TRACER  #include "TIMEAVE_STATV.h"
43  c #include "TR1.h"  #endif
44  c #endif  #if defined (ALLOW_BALANCE_FLUXES) && !(defined ALLOW_AUTODIFF_TAMC)
45  c #ifdef ALLOW_PTRACERS  #include "FFIELDS.h"
46  c #include "PTRACERS_SIZE.h"  #endif
 c #include "PTRACERS.h"  
 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 "tamc.h"  # include "tamc.h"
50  # include "tamc_keys.h"  # include "tamc_keys.h"
51  # include "FFIELDS.h"  # include "FFIELDS.h"
52    # include "SURFACE.h"
53  # include "EOS.h"  # include "EOS.h"
54  # ifdef ALLOW_KPP  # ifdef ALLOW_KPP
55  #  include "KPP.h"  #  include "KPP.h"
# Line 61  c #endif Line 60  c #endif
60  # ifdef ALLOW_EBM  # ifdef ALLOW_EBM
61  #  include "EBM.h"  #  include "EBM.h"
62  # endif  # endif
63    # ifdef ALLOW_EXF
64    #  include "ctrl.h"
65    #  include "EXF_FIELDS.h"
66    #  ifdef ALLOW_BULKFORMULAE
67    #   include "EXF_CONSTANTS.h"
68    #  endif
69    # endif
70    # ifdef ALLOW_SEAICE
71    #  include "SEAICE.h"
72    # endif
73  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
74    
75  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
76  C     == Routine arguments ==  C     == Routine arguments ==
77  C     myTime - Current time in simulation  C     myTime :: Current time in simulation
78  C     myIter - Current iteration number in simulation  C     myIter :: Current iteration number in simulation
79  C     myThid - Thread number for this instance of the routine.  C     myThid :: Thread number for this instance of the routine.
80        _RL myTime        _RL myTime
81        INTEGER myIter        INTEGER myIter
82        INTEGER myThid        INTEGER myThid
83    
84  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
85  C     == Local variables  C     == Local variables
86  C     rhoK, rhoKM1   - Density at current level, and level above  C     rhoK, rhoKm1  :: Density at current level, and level above
87  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  
88  C     jMin, jMax       are applied.  C     jMin, jMax       are applied.
89  C     bi, bj  C     bi, bj        :: tile indices
90  C     k, kup,        - Index for layer above and below. kup and kDown  C     i,j,k         :: loop indices
91  C     kDown, km1       are switched with layer to be the appropriate        _RL rhoKp1  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
92  C                      index into fVerTerm.        _RL rhoKm1  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
93        _RL rhokm1  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL rhoK    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
       _RL rhok    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
94        _RL sigmaX  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL sigmaX  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
95        _RL sigmaY  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL sigmaY  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
96        _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  
97        INTEGER iMin, iMax        INTEGER iMin, iMax
98        INTEGER jMin, jMax        INTEGER jMin, jMax
99        INTEGER bi, bj        INTEGER bi, bj
100        INTEGER i, j        INTEGER i, j, k
101        INTEGER k, km1, kup, kDown        INTEGER doDiagsRho
102        INTEGER iTracer, ip  #ifdef ALLOW_DIAGNOSTICS
103          LOGICAL  DIAGNOSTICS_IS_ON
104          EXTERNAL DIAGNOSTICS_IS_ON
105    #endif /* ALLOW_DIAGNOSTICS */
106    
107  CEOP  CEOP
108    
109    #ifdef ALLOW_AUTODIFF_TAMC
110    C--   dummy statement to end declaration part
111          itdkey = 1
112    #endif /* ALLOW_AUTODIFF_TAMC */
113    
114    #ifdef ALLOW_DEBUG
115          IF ( debugLevel .GE. debLevB )
116         &     CALL DEBUG_ENTER('DO_OCEANIC_PHYS',myThid)
117    #endif
118    
119          doDiagsRho = 0
120    #ifdef ALLOW_DIAGNOSTICS
121          IF ( useDiagnostics .AND. fluidIsWater ) THEN
122            IF ( DIAGNOSTICS_IS_ON('RHOANOSQ',myThid) .OR.
123         &       DIAGNOSTICS_IS_ON('URHOMASS',myThid) .OR.
124         &       DIAGNOSTICS_IS_ON('VRHOMASS',myThid) .OR.
125         &       DIAGNOSTICS_IS_ON('WRHOMASS',myThid) .OR.
126         &       DIAGNOSTICS_IS_ON('WRHOMASS',myThid) ) doDiagsRho = 2
127            IF ( doDiagsRho.EQ.0 .AND.
128         &       DIAGNOSTICS_IS_ON('MXLDEPTH',myThid) ) doDiagsRho = 1
129            IF ( doDiagsRho.EQ.0 .AND.
130         &       DIAGNOSTICS_IS_ON('DRHODR  ',myThid) ) doDiagsRho = 1
131          ENDIF
132    #endif /* ALLOW_DIAGNOSTICS */
133    
134    #ifdef ALLOW_SEAICE
135    C--   Call sea ice model to compute forcing/external data fields.  In
136    C     addition to computing prognostic sea-ice variables and diagnosing the
137    C     forcing/external data fields that drive the ocean model, SEAICE_MODEL
138    C     also sets theta to the freezing point under sea-ice.  The implied
139    C     surface heat flux is then stored in variable surfaceTendencyTice,
140    C     which is needed by KPP package (kpp_calc.F and kpp_transport_t.F)
141    C     to diagnose surface buoyancy fluxes and for the non-local transport
142    C     term.  Because this call precedes model thermodynamics, temperature
143    C     under sea-ice may not be "exactly" at the freezing point by the time
144    C     theta is dumped or time-averaged.
145          IF ( useSEAICE ) THEN
146    #ifdef ALLOW_AUTODIFF_TAMC
147    CADJ STORE atemp,aqh,precip    = comlev1, key = ikey_dynamics
148    CADJ STORE swdown,lwdown       = comlev1, key = ikey_dynamics
149    cph# ifdef EXF_READ_EVAP
150    CADJ STORE evap                = comlev1, key = ikey_dynamics
151    cph# endif
152    CADJ STORE uvel,vvel           = comlev1, key = ikey_dynamics
153    # ifdef SEAICE_ALLOW_EVP
154    CADJ STORE seaice_sigma1       = comlev1, key = ikey_dynamics
155    CADJ STORE seaice_sigma2       = comlev1, key = ikey_dynamics
156    CADJ STORE seaice_sigma12      = comlev1, key = ikey_dynamics
157    # endif
158    # ifdef SEAICE_SALINITY
159    CADJ STORE salt                = comlev1, key = ikey_dynamics
160    # endif
161    # ifdef ATMOSPHERIC_LOADING
162    CADJ STORE siceload            = comlev1, key = ikey_dynamics
163    # endif
164    # ifdef NONLIN_FRSURF
165    CADJ STORE recip_hfacc         = comlev1, key = ikey_dynamics
166    # endif
167    #endif
168  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
169        IF ( debugLevel .GE. debLevB )          IF ( debugLevel .GE. debLevB )
170       &    CALL DEBUG_ENTER('DO_OCEANIC_PHYS',myThid)       &    CALL DEBUG_CALL('SEAICE_MODEL',myThid)
171    #endif
172            CALL TIMER_START('SEAICE_MODEL    [DO_OCEANIC_PHYS]', myThid)
173            CALL SEAICE_MODEL( myTime, myIter, myThid )
174            CALL TIMER_STOP ('SEAICE_MODEL    [DO_OCEANIC_PHYS]', myThid)
175    #ifdef ALLOW_COST
176            CALL SEAICE_COST_SENSI ( myTime, myIter, myThid )
177  #endif  #endif
178          ENDIF
179  #ifdef ALLOW_THSICE  #endif /* ALLOW_SEAICE */
180        IF ( useThSIce .AND. buoyancyRelation(1:7) .EQ. 'OCEANIC' ) THEN  
181    #if (defined ALLOW_THSICE) && !(defined ALLOW_ATM2D)
182          IF ( useThSIce .AND. fluidIsWater ) THEN
183  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
184          IF ( debugLevel .GE. debLevB )          IF ( debugLevel .GE. debLevB )
185       &    CALL DEBUG_CALL('THSICE_MAIN',myThid)       &    CALL DEBUG_CALL('THSICE_MAIN',myThid)
# Line 117  C       and modify forcing terms includi Line 192  C       and modify forcing terms includi
192        ENDIF        ENDIF
193  #endif /* ALLOW_THSICE */  #endif /* ALLOW_THSICE */
194    
195    #ifdef ALLOW_SHELFICE
196          IF ( useShelfIce .AND. fluidIsWater ) THEN
197    #ifdef ALLOW_DEBUG
198            IF ( debugLevel .GE. debLevB )
199         &    CALL DEBUG_CALL('SHELFICE_THERMODYNAMICS',myThid)
200    #endif
201    C     compute temperature and (virtual) salt flux at the
202    C     shelf-ice ocean interface
203           CALL TIMER_START('SHELFICE_THERMODYNAMICS [DO_OCEANIC_PHYS]',
204         &       myThid)
205           CALL SHELFICE_THERMODYNAMICS( myTime, myIter, myThid )
206           CALL TIMER_STOP( 'SHELFICE_THERMODYNAMICS [DO_OCEANIC_PHYS]',
207         &      myThid)
208          ENDIF
209    #endif /* ALLOW_SHELFICE */
210    
211  C--   Freeze water at the surface  C--   Freeze water at the surface
212  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
213  CADJ STORE theta = comlev1, key = ikey_dynamics  CADJ STORE theta = comlev1, key = ikey_dynamics
214  #endif  #endif
215        IF ( allowFreezing .AND. .NOT. useSEAICE        IF ( allowFreezing
216         &                   .AND. .NOT. useSEAICE
217       &                   .AND. .NOT. useThSIce ) THEN       &                   .AND. .NOT. useThSIce ) THEN
218          CALL FREEZE_SURFACE(  myTime, myIter, myThid )          CALL FREEZE_SURFACE(  myTime, myIter, myThid )
219        ENDIF        ENDIF
220    
221  #ifdef COMPONENT_MODULE  #ifdef ALLOW_OCN_COMPON_INTERF
 # ifndef ALLOW_AIM  
222  C--    Apply imported data (from coupled interface) to forcing fields  C--    Apply imported data (from coupled interface) to forcing fields
223  C jmc: do not know precisely where to put this call (bf or af thSIce ?)  C jmc: do not know precisely where to put this call (bf or af thSIce ?)
224         IF ( useCoupler ) THEN        IF ( useCoupler ) THEN
225           CALL OCN_APPLY_IMPORT( .TRUE., myTime, myIter, myThid )           CALL OCN_APPLY_IMPORT( .TRUE., myTime, myIter, myThid )
226         ENDIF        ENDIF
227  # endif  #endif /* ALLOW_OCN_COMPON_INTERF */
 #endif /* COMPONENT_MODULE */  
228    
229  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_BALANCE_FLUXES
230  C--   dummy statement to end declaration part  C     balance fluxes
231        ikey = 1        IF ( balanceEmPmR )
232        itdkey = 1       &        CALL REMOVE_MEAN_RS( 1, EmPmR, maskH, maskH, rA, drF,
233  #endif /* ALLOW_AUTODIFF_TAMC */       &        'EmPmR', myTime, myThid )
234          IF ( balanceQnet )
235         &        CALL REMOVE_MEAN_RS( 1, Qnet,  maskH, maskH, rA, drF,
236         &        'Qnet ', myTime, myThid )
237    #endif /* ALLOW_BALANCE_FLUXES */
238    
239  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
240  C--   HPF directive to help TAMC  C--   HPF directive to help TAMC
241  CHPF$ INDEPENDENT  CHPF$ INDEPENDENT
242  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
   
243        DO bj=myByLo(myThid),myByHi(myThid)        DO bj=myByLo(myThid),myByHi(myThid)
   
244  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
245  C--    HPF directive to help TAMC  C--   HPF directive to help TAMC
246  CHPF$  INDEPENDENT, NEW (rTrans,fVerT,fVerS  CHPF$ INDEPENDENT
 CHPF$&                  ,utrans,vtrans,xA,yA  
 CHPF$&                  )  
247  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
   
248         DO bi=myBxLo(myThid),myBxHi(myThid)         DO bi=myBxLo(myThid),myBxHi(myThid)
249    
250  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
# Line 169  CHPF$&                  ) Line 258  CHPF$&                  )
258            itdkey = (act1 + 1) + act2*max1            itdkey = (act1 + 1) + act2*max1
259       &                      + act3*max1*max2       &                      + act3*max1*max2
260       &                      + act4*max1*max2*max3       &                      + act4*max1*max2*max3
261    #else  /* ALLOW_AUTODIFF_TAMC */
262    C     if fluid is not water, by-pass find_rho, gmredi, surfaceForcing
263    C     and all vertical mixing schemes, but keep OBCS_CALC
264            IF ( fluidIsWater ) THEN
265  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
266    
267  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 179  C     uninitialised but inert locations. Line 272  C     uninitialised but inert locations.
272    
273          DO j=1-OLy,sNy+OLy          DO j=1-OLy,sNy+OLy
274           DO i=1-OLx,sNx+OLx           DO i=1-OLx,sNx+OLx
275            rhok   (i,j)   = 0. _d 0            rhoK   (i,j)   = 0. _d 0
276            rhoKM1 (i,j)   = 0. _d 0            rhoKm1 (i,j)   = 0. _d 0
277              rhoKp1 (i,j)   = 0. _d 0
278           ENDDO           ENDDO
279          ENDDO          ENDDO
280    
# Line 215  cph although some of these are re-initia Line 309  cph although some of these are re-initia
309             VisbeckK(i,j,bi,bj)   = 0. _d 0             VisbeckK(i,j,bi,bj)   = 0. _d 0
310  #  endif  #  endif
311  # endif /* ALLOW_GMREDI */  # endif /* ALLOW_GMREDI */
312    # ifdef ALLOW_KPP
313               KPPdiffKzS(i,j,k,bi,bj)  = 0. _d 0
314               KPPdiffKzT(i,j,k,bi,bj)  = 0. _d 0
315    # endif /* ALLOW_KPP */
316  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
317            ENDDO            ENDDO
318           ENDDO           ENDDO
# Line 228  cph although some of these are re-initia Line 326  cph although some of these are re-initia
326  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
327  CADJ STORE theta(:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte  CADJ STORE theta(:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
328  CADJ STORE salt (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte  CADJ STORE salt (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
329  CADJ STORE totphihyd  CADJ STORE totphihyd(:,:,:,bi,bj)
330  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte
331  #ifdef ALLOW_KPP  # ifdef ALLOW_KPP
332  CADJ STORE uvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte  CADJ STORE uvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
333  CADJ STORE vvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte  CADJ STORE vvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
334  #endif  # endif
335  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
336    
337  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
338          IF ( debugLevel .GE. debLevB )          IF ( debugLevel .GE. debLevB )
339       &    CALL DEBUG_MSG('ENTERING UPWARD K LOOP',myThid)       &    CALL DEBUG_MSG('ENTERING UPWARD K LOOP',myThid)
340  #endif  #endif
341    
# Line 248  C--     Start of diagnostic loop Line 346  C--     Start of diagnostic loop
346  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?
347  C? Do we still need this?  C? Do we still need this?
348  cph kkey formula corrected.  cph kkey formula corrected.
349  cph Needed for rhok, rhokm1, in the case useGMREDI.  cph Needed for rhoK, rhoKm1, in the case useGMREDI.
350           kkey = (itdkey-1)*Nr + k           kkey = (itdkey-1)*Nr + k
351  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
352    
353  C--       Calculate gradients of potential density for isoneutral  C--       Calculate gradients of potential density for isoneutral
354  C         slope terms (e.g. GM/Redi tensor or IVDC diffusivity)  C         slope terms (e.g. GM/Redi tensor or IVDC diffusivity)
355  c         IF ( k.GT.1 .AND. (useGMRedi.OR.ivdc_kappa.NE.0.) ) THEN            IF ( useGMRedi .OR. (k.GT.1 .AND. ivdc_kappa.NE.0.)
356            IF ( useGMRedi .OR. (k.GT.1 .AND. ivdc_kappa.NE.0.) ) THEN       &         .OR. useSALT_PLUME .OR. doDiagsRho.GE.1 ) THEN
357  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
358              IF ( debugLevel .GE. debLevB )              IF ( debugLevel .GE. debLevB )
359       &       CALL DEBUG_CALL('FIND_RHO',myThid)       &       CALL DEBUG_CALL('FIND_RHO',myThid)
360  #endif  #endif
361  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
# Line 282  CADJ STORE salt (:,:,k-1,bi,bj) = comlev Line 380  CADJ STORE salt (:,:,k-1,bi,bj) = comlev
380       I        myThid )       I        myThid )
381              ENDIF              ENDIF
382  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
383              IF ( debugLevel .GE. debLevB )              IF ( debugLevel .GE. debLevB )
384       &       CALL DEBUG_CALL('GRAD_SIGMA',myThid)       &       CALL DEBUG_CALL('GRAD_SIGMA',myThid)
385  #endif  #endif
386    cph Avoid variable aliasing for adjoint !!!
387                DO j=jMin,jMax
388                 DO i=iMin,iMax
389                  rhoKp1(i,j) = rhoK(i,j)
390                 ENDDO
391                ENDDO
392              CALL GRAD_SIGMA(              CALL GRAD_SIGMA(
393       I             bi, bj, iMin, iMax, jMin, jMax, k,       I             bi, bj, iMin, iMax, jMin, jMax, k,
394       I             rhoK, rhoKm1, rhoK,       I             rhoK, rhoKm1, rhoKp1,
395       O             sigmaX, sigmaY, sigmaR,       O             sigmaX, sigmaY, sigmaR,
396       I             myThid )       I             myThid )
397            ENDIF            ENDIF
398    
 #ifdef ALLOW_AUTODIFF_TAMC  
 CADJ STORE rhok   (:,:) = comlev1_bibj_k ,       key=kkey, byte=isbyte  
 CADJ STORE rhokm1 (:,:) = comlev1_bibj_k ,       key=kkey, byte=isbyte  
 #endif /* ALLOW_AUTODIFF_TAMC */  
399  C--       Implicit Vertical Diffusion for Convection  C--       Implicit Vertical Diffusion for Convection
400  c ==> should use sigmaR !!!  c ==> should use sigmaR !!!
401            IF (k.GT.1 .AND. ivdc_kappa.NE.0.) THEN            IF (k.GT.1 .AND. ivdc_kappa.NE.0.) THEN
402  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
403              IF ( debugLevel .GE. debLevB )              IF ( debugLevel .GE. debLevB )
404       &       CALL DEBUG_CALL('CALC_IVDC',myThid)       &       CALL DEBUG_CALL('CALC_IVDC',myThid)
405  #endif  #endif
406              CALL CALC_IVDC(              CALL CALC_IVDC(
# Line 309  c ==> should use sigmaR !!! Line 409  c ==> should use sigmaR !!!
409       I        myTime, myIter, myThid)       I        myTime, myIter, myThid)
410            ENDIF            ENDIF
411    
412    #ifdef ALLOW_DIAGNOSTICS
413              IF ( doDiagsRho.GE.2 ) THEN
414                CALL DIAGS_RHO( k, bi, bj,
415         I                      rhoK, rhoKm1,
416         I                      myTime, myIter, myThid)
417              ENDIF
418    #endif
419    
420  C--     end of diagnostic k loop (Nr:1)  C--     end of diagnostic k loop (Nr:1)
421          ENDDO          ENDDO
422    
423  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
424  cph avoids recomputation of integrate_for_w  CADJ STORE IVDConvCount(:,:,:,bi,bj)
425  CADJ STORE wvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte
 #endif /* ALLOW_AUTODIFF_TAMC */  
   
 #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)  
426  #endif  #endif
427            CALL OBCS_CALC( bi, bj, myTime+deltaT, myIter+1,  
428       I            uVel, vVel, wVel, theta, salt,  C--     Diagnose Mixed Layer Depth:
429       I            myThid )          IF ( useGMRedi .OR. doDiagsRho.GE.1 ) THEN
430              CALL CALC_OCE_MXLAYER( rhoK, sigmaR,
431         &              bi, bj, myTime, myIter, myThid )
432          ENDIF          ENDIF
 #endif  /* ALLOW_OBCS */  
433    
434  #ifndef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_SALT_PLUME
435          IF ( buoyancyRelation(1:7) .EQ. 'OCEANIC' ) THEN          IF ( useSALT_PLUME ) THEN
436  #endif            CALL SALT_PLUME_CALC_DEPTH( rhoK, sigmaR,
437         &              bi, bj, myTime, myIter, myThid )
438            ENDIF
439    #endif /* ALLOW_SALT_PLUME */
440    
441    #ifdef ALLOW_DIAGNOSTICS
442            IF ( doDiagsRho.GE.1 ) THEN
443              CALL DIAGNOSTICS_FILL (sigmaR, 'DRHODR  ', 0, Nr,
444         &         2, bi, bj, myThid)
445            ENDIF
446    #endif /* ALLOW_DIAGNOSTICS */
447    
448  C--     Determines forcing terms based on external fields  C--     Determines forcing terms based on external fields
449  C       relaxation terms, etc.  C       relaxation terms, etc.
450  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
451          IF ( debugLevel .GE. debLevB )          IF ( debugLevel .GE. debLevB )
452       &    CALL DEBUG_CALL('EXTERNAL_FORCING_SURF',myThid)       &    CALL DEBUG_CALL('EXTERNAL_FORCING_SURF',myThid)
453  #endif  #endif
454           CALL EXTERNAL_FORCING_SURF(  #ifdef ALLOW_AUTODIFF_TAMC
455    CADJ STORE EmPmR(:,:,bi,bj)
456    CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte
457    # ifdef EXACT_CONSERV
458    CADJ STORE PmEpR(:,:,bi,bj)
459    CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte
460    # endif
461    # ifdef NONLIN_FRSURF
462    CADJ STORE hFac_surfC(:,:,bi,bj)
463    CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte
464    CADJ STORE recip_hFacC(:,:,:,bi,bj)
465    CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte
466    # endif
467    #endif
468            CALL EXTERNAL_FORCING_SURF(
469       I             bi, bj, iMin, iMax, jMin, jMax,       I             bi, bj, iMin, iMax, jMin, jMax,
470       I             myTime, myIter, myThid )       I             myTime, myIter, myThid )
471  #ifndef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
472          ENDIF  # ifdef EXACT_CONSERV
473    cph-test
474    cphCADJ STORE PmEpR(:,:,bi,bj)
475    cphCADJ &     = comlev1_bibj, key=itdkey, byte=isbyte
476    # endif
477  #endif  #endif
478    
479  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
# Line 356  CADJ STORE surfaceForcingS(:,:,bi,bj) Line 486  CADJ STORE surfaceForcingS(:,:,bi,bj)
486  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte
487  CADJ STORE surfaceForcingT(:,:,bi,bj)  CADJ STORE surfaceForcingT(:,:,bi,bj)
488  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte
 # ifdef ALLOW_SEAICE  
489  CADJ STORE surfaceForcingTice(:,:,bi,bj)  CADJ STORE surfaceForcingTice(:,:,bi,bj)
490  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte
 # endif  
491  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
492    
 #ifdef  ALLOW_GMREDI  
   
 #ifdef ALLOW_AUTODIFF_TAMC  
 cph storing here is needed only for one GMREDI_OPTIONS:  
 cph define GM_BOLUS_ADVEC  
 cph but I've avoided the #ifdef for now, in case more things change  
 CADJ STORE sigmaX(:,:,:)        = comlev1_bibj, key=itdkey, byte=isbyte  
 CADJ STORE sigmaY(:,:,:)        = comlev1_bibj, key=itdkey, byte=isbyte  
 CADJ STORE sigmaR(:,:,:)        = comlev1_bibj, key=itdkey, byte=isbyte  
 #endif /* ALLOW_AUTODIFF_TAMC */  
   
 C--     Calculate iso-neutral slopes for the GM/Redi parameterisation  
         IF (useGMRedi) THEN  
 #ifdef ALLOW_DEBUG  
           IF ( debugLevel .GE. debLevB )  
      &     CALL DEBUG_CALL('GMREDI_CALC_TENSOR',myThid)  
 #endif  
           CALL GMREDI_CALC_TENSOR(  
      I             bi, bj, iMin, iMax, jMin, jMax,  
      I             sigmaX, sigmaY, sigmaR,  
      I             myThid )  
 #ifdef ALLOW_AUTODIFF_TAMC  
         ELSE  
           CALL GMREDI_CALC_TENSOR_DUMMY(  
      I             bi, bj, iMin, iMax, jMin, jMax,  
      I             sigmaX, sigmaY, sigmaR,  
      I             myThid )  
 #endif /* ALLOW_AUTODIFF_TAMC */  
         ENDIF  
   
 #ifdef ALLOW_AUTODIFF_TAMC  
 CADJ STORE Kwx(:,:,:,bi,bj)   = comlev1_bibj, key=itdkey, byte=isbyte  
 CADJ STORE Kwy(:,:,:,bi,bj)   = comlev1_bibj, key=itdkey, byte=isbyte  
 CADJ STORE Kwz(:,:,:,bi,bj)   = comlev1_bibj, key=itdkey, byte=isbyte  
 #endif /* ALLOW_AUTODIFF_TAMC */  
   
 #endif  /* ALLOW_GMREDI */  
   
493  #ifdef  ALLOW_KPP  #ifdef  ALLOW_KPP
494  C--     Compute KPP mixing coefficients  C--     Compute KPP mixing coefficients
495          IF (useKPP) THEN          IF (useKPP) THEN
496  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
497            IF ( debugLevel .GE. debLevB )            IF ( debugLevel .GE. debLevB )
498       &     CALL DEBUG_CALL('KPP_CALC',myThid)       &     CALL DEBUG_CALL('KPP_CALC',myThid)
499  #endif  #endif
500            CALL KPP_CALC(            CALL KPP_CALC(
501       I                  bi, bj, myTime, myThid )       I                  bi, bj, myTime, myIter, myThid )
502  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
503          ELSE          ELSE
504            CALL KPP_CALC_DUMMY(            CALL KPP_CALC_DUMMY(
505       I                  bi, bj, myTime, myThid )       I                  bi, bj, myTime, myIter, myThid )
506  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
507          ENDIF          ENDIF
508    
 #ifdef ALLOW_AUTODIFF_TAMC  
 CADJ STORE KPPghat   (:,:,:,bi,bj)  
 CADJ &   , KPPfrac   (:,:  ,bi,bj)  
 CADJ &                 = comlev1_bibj, key=itdkey, byte=isbyte  
 #endif /* ALLOW_AUTODIFF_TAMC */  
   
509  #endif  /* ALLOW_KPP */  #endif  /* ALLOW_KPP */
510    
511  #ifdef  ALLOW_PP81  #ifdef  ALLOW_PP81
512  C--     Compute PP81 mixing coefficients  C--     Compute PP81 mixing coefficients
513          IF (usePP81) THEN          IF (usePP81) THEN
514  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
515            IF ( debugLevel .GE. debLevB )            IF ( debugLevel .GE. debLevB )
516       &     CALL DEBUG_CALL('PP81_CALC',myThid)       &     CALL DEBUG_CALL('PP81_CALC',myThid)
517  #endif  #endif
518            CALL PP81_CALC(            CALL PP81_CALC(
# Line 440  C--     Compute PP81 mixing coefficients Line 524  C--     Compute PP81 mixing coefficients
524  C--     Compute MY82 mixing coefficients  C--     Compute MY82 mixing coefficients
525          IF (useMY82) THEN          IF (useMY82) THEN
526  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
527            IF ( debugLevel .GE. debLevB )            IF ( debugLevel .GE. debLevB )
528       &     CALL DEBUG_CALL('MY82_CALC',myThid)       &     CALL DEBUG_CALL('MY82_CALC',myThid)
529  #endif  #endif
530            CALL MY82_CALC(            CALL MY82_CALC(
# Line 448  C--     Compute MY82 mixing coefficients Line 532  C--     Compute MY82 mixing coefficients
532          ENDIF          ENDIF
533  #endif /* ALLOW_MY82 */  #endif /* ALLOW_MY82 */
534    
535  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef  ALLOW_GGL90
536  CADJ STORE theta(:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte  C--     Compute GGL90 mixing coefficients
537  CADJ STORE salt (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte          IF (useGGL90) THEN
538  CADJ STORE uvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte  #ifdef ALLOW_DEBUG
539  CADJ STORE vvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte            IF ( debugLevel .GE. debLevB )
540  #ifdef ALLOW_PASSIVE_TRACER       &     CALL DEBUG_CALL('GGL90_CALC',myThid)
 CADJ STORE tr1  (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte  
541  #endif  #endif
542  #ifdef ALLOW_PTRACERS            CALL GGL90_CALC(
543  cph-- moved to forward_step to avoid key computation       I                  bi, bj, myTime, myThid )
544  cphCADJ STORE ptracer(:,:,:,bi,bj,itracer) = comlev1_bibj,          ENDIF
545  cphCADJ &                              key=itdkey, byte=isbyte  #endif /* ALLOW_GGL90 */
546    
547    #ifdef ALLOW_TIMEAVE
548            IF ( taveFreq.GT. 0. _d 0 ) THEN
549              CALL TIMEAVE_SURF_FLUX( bi, bj, myTime, myIter, myThid)
550            ENDIF
551            IF (taveFreq.GT.0. .AND. ivdc_kappa.NE.0.) THEN
552              CALL TIMEAVE_CUMULATE(ConvectCountTave, IVDConvCount,
553         I                           Nr, deltaTclock, bi, bj, myThid)
554            ENDIF
555    #endif /* ALLOW_TIMEAVE */
556    
557    #ifdef  ALLOW_GMREDI
558    #ifdef ALLOW_AUTODIFF_TAMC
559    # ifndef GM_EXCLUDE_CLIPPING
560    cph storing here is needed only for one GMREDI_OPTIONS:
561    cph define GM_BOLUS_ADVEC
562    cph keep it although TAF says you dont need to.
563    cph but I've avoided the #ifdef for now, in case more things change
564    CADJ STORE sigmaX(:,:,:)        = comlev1_bibj, key=itdkey, byte=isbyte
565    CADJ STORE sigmaY(:,:,:)        = comlev1_bibj, key=itdkey, byte=isbyte
566    CADJ STORE sigmaR(:,:,:)        = comlev1_bibj, key=itdkey, byte=isbyte
567    # endif
568    #endif /* ALLOW_AUTODIFF_TAMC */
569    
570    C--     Calculate iso-neutral slopes for the GM/Redi parameterisation
571            IF (useGMRedi) THEN
572    #ifdef ALLOW_DEBUG
573              IF ( debugLevel .GE. debLevB )
574         &     CALL DEBUG_CALL('GMREDI_CALC_TENSOR',myThid)
575  #endif  #endif
576              CALL GMREDI_CALC_TENSOR(
577    c    I             bi, bj, iMin, iMax, jMin, jMax,
578    c    I             sigmaX, sigmaY, sigmaR,
579    c    I             myThid )
580         I             iMin, iMax, jMin, jMax,
581         I             sigmaX, sigmaY, sigmaR,
582         I             bi, bj, myTime, myIter, myThid )
583    #ifdef ALLOW_AUTODIFF_TAMC
584            ELSE
585              CALL GMREDI_CALC_TENSOR_DUMMY(
586    c    I             bi, bj, iMin, iMax, jMin, jMax,
587    c    I             sigmaX, sigmaY, sigmaR,
588    c    I             myThid )
589         I             iMin, iMax, jMin, jMax,
590         I             sigmaX, sigmaY, sigmaR,
591         I             bi, bj, myTime, myIter, myThid )
592  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
593            ENDIF
594    #endif  /* ALLOW_GMREDI */
595    
596    #ifndef ALLOW_AUTODIFF_TAMC
597    C---  if fluid Is Water: end
598            ENDIF
599    #endif
600    
601    #ifdef  ALLOW_OBCS
602    C--     Calculate future values on open boundaries
603            IF (useOBCS) THEN
604    #ifdef ALLOW_DEBUG
605              IF ( debugLevel .GE. debLevB )
606         &     CALL DEBUG_CALL('OBCS_CALC',myThid)
607    #endif
608              CALL OBCS_CALC( bi, bj, myTime+deltaTclock, myIter+1,
609         I            uVel, vVel, wVel, theta, salt,
610         I            myThid )
611            ENDIF
612    #endif  /* ALLOW_OBCS */
613    
614  C--   end bi,bj loops.  C--   end bi,bj loops.
615         ENDDO         ENDDO
616        ENDDO        ENDDO
617    
618    #ifdef  ALLOW_KPP
619          IF (useKPP) THEN
620            CALL KPP_DO_EXCH( myThid )
621          ENDIF
622    #endif  /* ALLOW_KPP */
623    
624    #ifdef ALLOW_DIAGNOSTICS
625          IF ( fluidIsWater .AND. useDiagnostics ) THEN
626            CALL DIAGS_OCEANIC_SURF_FLUX( myTime, myIter, myThid )
627          ENDIF
628          IF ( ivdc_kappa.NE.0 .AND. useDiagnostics ) THEN
629            CALL DIAGNOSTICS_FILL( IVDConvCount,'CONVADJ ',
630         &                         0, Nr, 0, 1, 1, myThid )
631          ENDIF
632    #endif
633    
634  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
635           IF ( debugLevel .GE. debLevB )        IF ( debugLevel .GE. debLevB )
636       &    CALL DEBUG_LEAVE('DO_OCEANIC_PHYS',myThid)       &     CALL DEBUG_LEAVE('DO_OCEANIC_PHYS',myThid)
637  #endif  #endif
638    
639        RETURN        RETURN
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.61
  ViewVC Help
Powered by ViewVC 1.1.22