/[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.15 by heimbach, Fri Dec 10 20:15:10 2004 UTC revision 1.64 by heimbach, Thu May 1 23:52:24 2008 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_PTRACERS  #include "TIMEAVE_STATV.h"
43  c #include "PTRACERS_SIZE.h"  #endif
44  c #include "PTRACERS.h"  #if defined (ALLOW_BALANCE_FLUXES) && !(defined ALLOW_AUTODIFF_TAMC)
45  c #endif  #include "FFIELDS.h"
46  c #ifdef ALLOW_TIMEAVE  #endif
 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 58  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 EXACT_CONSERV  # ifdef ALLOW_EXF
64  #  include "SURFACE.h"  #  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  # 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    
# Line 104  C--   dummy statement to end declaration Line 112  C--   dummy statement to end declaration
112  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
113    
114  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
115        IF ( debugLevel .GE. debLevB )        IF ( debugLevel .GE. debLevB )
116       &    CALL DEBUG_ENTER('DO_OCEANIC_PHYS',myThid)       &     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          IF ( useSEAICE ) THEN
136    # ifdef ALLOW_AUTODIFF_TAMC
137    CADJ STORE atemp,aqh,precip    = comlev1, key = ikey_dynamics
138    CADJ STORE swdown,lwdown       = comlev1, key = ikey_dynamics
139    cph# ifdef EXF_READ_EVAP
140    CADJ STORE evap                = comlev1, key = ikey_dynamics
141    cph# endif
142    CADJ STORE uvel,vvel           = comlev1, key = ikey_dynamics
143    #  ifdef SEAICE_ALLOW_DYNAMICS
144    CADJ STORE uice                = comlev1, key = ikey_dynamics
145    CADJ STORE vice                = comlev1, key = ikey_dynamics
146    #   ifdef SEAICE_ALLOW_EVP
147    CADJ STORE seaice_sigma1       = comlev1, key = ikey_dynamics
148    CADJ STORE seaice_sigma2       = comlev1, key = ikey_dynamics
149    CADJ STORE seaice_sigma12      = comlev1, key = ikey_dynamics
150    #   endif
151    #  endif
152    #  ifdef SEAICE_SALINITY
153    CADJ STORE salt                = comlev1, key = ikey_dynamics
154    #  endif
155    #  ifdef ATMOSPHERIC_LOADING
156    CADJ STORE pload               = comlev1, key = ikey_dynamics
157    CADJ STORE siceload            = comlev1, key = ikey_dynamics
158    #  endif
159    #  ifdef NONLIN_FRSURF
160    CADJ STORE recip_hfacc         = comlev1, key = ikey_dynamics
161    #  endif
162    # endif
163    # ifdef ALLOW_DEBUG
164            IF ( debugLevel .GE. debLevB )
165         &    CALL DEBUG_CALL('SEAICE_MODEL',myThid)
166    # endif
167            CALL TIMER_START('SEAICE_MODEL    [DO_OCEANIC_PHYS]', myThid)
168            CALL SEAICE_MODEL( myTime, myIter, myThid )
169            CALL TIMER_STOP ('SEAICE_MODEL    [DO_OCEANIC_PHYS]', myThid)
170    # ifdef ALLOW_COST
171            CALL SEAICE_COST_SENSI ( myTime, myIter, myThid )
172    # endif
173          ENDIF
174    #endif /* ALLOW_SEAICE */
175    
176    #ifdef ALLOW_AUTODIFF_TAMC
177    CADJ STORE sst, sss           = comlev1, key = ikey_dynamics
178    CADJ STORE qsw                = comlev1, key = ikey_dynamics
179    # ifdef ALLOW_SEAICE
180    CADJ STORE area               = comlev1, key = ikey_dynamics
181    # endif
182  #endif  #endif
183    
184  #ifdef ALLOW_THSICE  #if (defined ALLOW_THSICE) && !(defined ALLOW_ATM2D)
185        IF ( useThSIce .AND. fluidIsWater ) THEN        IF ( useThSIce .AND. fluidIsWater ) THEN
186  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
187          IF ( debugLevel .GE. debLevB )          IF ( debugLevel .GE. debLevB )
# Line 122  C       and modify forcing terms includi Line 195  C       and modify forcing terms includi
195        ENDIF        ENDIF
196  #endif /* ALLOW_THSICE */  #endif /* ALLOW_THSICE */
197    
198    #ifdef ALLOW_SHELFICE
199          IF ( useShelfIce .AND. fluidIsWater ) THEN
200    #ifdef ALLOW_DEBUG
201            IF ( debugLevel .GE. debLevB )
202         &    CALL DEBUG_CALL('SHELFICE_THERMODYNAMICS',myThid)
203    #endif
204    C     compute temperature and (virtual) salt flux at the
205    C     shelf-ice ocean interface
206           CALL TIMER_START('SHELFICE_THERMODYNAMICS [DO_OCEANIC_PHYS]',
207         &       myThid)
208           CALL SHELFICE_THERMODYNAMICS( myTime, myIter, myThid )
209           CALL TIMER_STOP( 'SHELFICE_THERMODYNAMICS [DO_OCEANIC_PHYS]',
210         &      myThid)
211          ENDIF
212    #endif /* ALLOW_SHELFICE */
213    
214  C--   Freeze water at the surface  C--   Freeze water at the surface
215  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
216  CADJ STORE theta = comlev1, key = ikey_dynamics  CADJ STORE theta = comlev1, key = ikey_dynamics
# Line 132  CADJ STORE theta = comlev1, key = ikey_d Line 221  CADJ STORE theta = comlev1, key = ikey_d
221          CALL FREEZE_SURFACE(  myTime, myIter, myThid )          CALL FREEZE_SURFACE(  myTime, myIter, myThid )
222        ENDIF        ENDIF
223    
224  #ifdef COMPONENT_MODULE  #ifdef ALLOW_OCN_COMPON_INTERF
 # ifndef ALLOW_AIM  
225  C--    Apply imported data (from coupled interface) to forcing fields  C--    Apply imported data (from coupled interface) to forcing fields
226  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 ?)
227         IF ( useCoupler ) THEN        IF ( useCoupler ) THEN
228           CALL OCN_APPLY_IMPORT( .TRUE., myTime, myIter, myThid )           CALL OCN_APPLY_IMPORT( .TRUE., myTime, myIter, myThid )
229         ENDIF        ENDIF
230  # endif  #endif /* ALLOW_OCN_COMPON_INTERF */
231  #endif /* COMPONENT_MODULE */  
232    #ifdef ALLOW_BALANCE_FLUXES
233    C     balance fluxes
234          IF ( balanceEmPmR )
235         &        CALL REMOVE_MEAN_RS( 1, EmPmR, maskH, maskH, rA, drF,
236         &        'EmPmR', myTime, myThid )
237          IF ( balanceQnet )
238         &        CALL REMOVE_MEAN_RS( 1, Qnet,  maskH, maskH, rA, drF,
239         &        'Qnet ', myTime, myThid )
240    #endif /* ALLOW_BALANCE_FLUXES */
241    
242  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
243  C--   HPF directive to help TAMC  C--   HPF directive to help TAMC
# Line 164  CHPF$ INDEPENDENT Line 261  CHPF$ INDEPENDENT
261            itdkey = (act1 + 1) + act2*max1            itdkey = (act1 + 1) + act2*max1
262       &                      + act3*max1*max2       &                      + act3*max1*max2
263       &                      + act4*max1*max2*max3       &                      + act4*max1*max2*max3
264    #else  /* ALLOW_AUTODIFF_TAMC */
265    C     if fluid is not water, by-pass find_rho, gmredi, surfaceForcing
266    C     and all vertical mixing schemes, but keep OBCS_CALC
267            IF ( fluidIsWater ) THEN
268  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
269    
270  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 174  C     uninitialised but inert locations. Line 275  C     uninitialised but inert locations.
275    
276          DO j=1-OLy,sNy+OLy          DO j=1-OLy,sNy+OLy
277           DO i=1-OLx,sNx+OLx           DO i=1-OLx,sNx+OLx
278            rhok   (i,j)   = 0. _d 0            rhoK   (i,j)   = 0. _d 0
279            rhoKM1 (i,j)   = 0. _d 0            rhoKm1 (i,j)   = 0. _d 0
280              rhoKp1 (i,j)   = 0. _d 0
281           ENDDO           ENDDO
282          ENDDO          ENDDO
283    
# Line 210  cph although some of these are re-initia Line 312  cph although some of these are re-initia
312             VisbeckK(i,j,bi,bj)   = 0. _d 0             VisbeckK(i,j,bi,bj)   = 0. _d 0
313  #  endif  #  endif
314  # endif /* ALLOW_GMREDI */  # endif /* ALLOW_GMREDI */
315    # ifdef ALLOW_KPP
316               KPPdiffKzS(i,j,k,bi,bj)  = 0. _d 0
317               KPPdiffKzT(i,j,k,bi,bj)  = 0. _d 0
318    # endif /* ALLOW_KPP */
319  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
320            ENDDO            ENDDO
321           ENDDO           ENDDO
# Line 229  CADJ &     = comlev1_bibj, key=itdkey, b Line 335  CADJ &     = comlev1_bibj, key=itdkey, b
335  CADJ STORE uvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte  CADJ STORE uvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
336  CADJ STORE vvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte  CADJ STORE vvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte
337  # endif  # endif
 # ifdef EXACT_CONSERV  
 CADJ STORE pmepr(:,:,bi,bj)   = comlev1_bibj, key=itdkey, byte=isbyte  
 # endif  
338  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
339    
340  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
341          IF ( debugLevel .GE. debLevB )          IF ( debugLevel .GE. debLevB )
342       &    CALL DEBUG_MSG('ENTERING UPWARD K LOOP',myThid)       &    CALL DEBUG_MSG('ENTERING UPWARD K LOOP',myThid)
343  #endif  #endif
344    
# Line 246  C--     Start of diagnostic loop Line 349  C--     Start of diagnostic loop
349  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?
350  C? Do we still need this?  C? Do we still need this?
351  cph kkey formula corrected.  cph kkey formula corrected.
352  cph Needed for rhok, rhokm1, in the case useGMREDI.  cph Needed for rhoK, rhoKm1, in the case useGMREDI.
353           kkey = (itdkey-1)*Nr + k           kkey = (itdkey-1)*Nr + k
354  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
355    
356  C--       Calculate gradients of potential density for isoneutral  C--       Calculate gradients of potential density for isoneutral
357  C         slope terms (e.g. GM/Redi tensor or IVDC diffusivity)  C         slope terms (e.g. GM/Redi tensor or IVDC diffusivity)
358  c         IF ( k.GT.1 .AND. (useGMRedi.OR.ivdc_kappa.NE.0.) ) THEN            IF ( useGMRedi .OR. (k.GT.1 .AND. ivdc_kappa.NE.0.)
359            IF ( useGMRedi .OR. (k.GT.1 .AND. ivdc_kappa.NE.0.) ) THEN       &         .OR. useSALT_PLUME .OR. doDiagsRho.GE.1 ) THEN
360  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
361              IF ( debugLevel .GE. debLevB )              IF ( debugLevel .GE. debLevB )
362       &       CALL DEBUG_CALL('FIND_RHO',myThid)       &       CALL DEBUG_CALL('FIND_RHO',myThid)
363  #endif  #endif
364  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
# Line 280  CADJ STORE salt (:,:,k-1,bi,bj) = comlev Line 383  CADJ STORE salt (:,:,k-1,bi,bj) = comlev
383       I        myThid )       I        myThid )
384              ENDIF              ENDIF
385  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
386              IF ( debugLevel .GE. debLevB )              IF ( debugLevel .GE. debLevB )
387       &       CALL DEBUG_CALL('GRAD_SIGMA',myThid)       &       CALL DEBUG_CALL('GRAD_SIGMA',myThid)
388  #endif  #endif
389    cph Avoid variable aliasing for adjoint !!!
390                DO j=jMin,jMax
391                 DO i=iMin,iMax
392                  rhoKp1(i,j) = rhoK(i,j)
393                 ENDDO
394                ENDDO
395              CALL GRAD_SIGMA(              CALL GRAD_SIGMA(
396       I             bi, bj, iMin, iMax, jMin, jMax, k,       I             bi, bj, iMin, iMax, jMin, jMax, k,
397       I             rhoK, rhoKm1, rhoK,       I             rhoK, rhoKm1, rhoKp1,
398       O             sigmaX, sigmaY, sigmaR,       O             sigmaX, sigmaY, sigmaR,
399       I             myThid )       I             myThid )
400            ENDIF            ENDIF
401    
 #ifdef ALLOW_AUTODIFF_TAMC  
 ctest# ifndef GM_EXCLUDE_CLIPPING  
 CADJ STORE rhok   (:,:) = comlev1_bibj_k ,       key=kkey, byte=isbyte  
 ctest# endif  
 CADJ STORE rhokm1 (:,:) = comlev1_bibj_k ,       key=kkey, byte=isbyte  
 #endif /* ALLOW_AUTODIFF_TAMC */  
402  C--       Implicit Vertical Diffusion for Convection  C--       Implicit Vertical Diffusion for Convection
403  c ==> should use sigmaR !!!  c ==> should use sigmaR !!!
404            IF (k.GT.1 .AND. ivdc_kappa.NE.0.) THEN            IF (k.GT.1 .AND. ivdc_kappa.NE.0.) THEN
405  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
406              IF ( debugLevel .GE. debLevB )              IF ( debugLevel .GE. debLevB )
407       &       CALL DEBUG_CALL('CALC_IVDC',myThid)       &       CALL DEBUG_CALL('CALC_IVDC',myThid)
408  #endif  #endif
409              CALL CALC_IVDC(              CALL CALC_IVDC(
# Line 309  c ==> should use sigmaR !!! Line 412  c ==> should use sigmaR !!!
412       I        myTime, myIter, myThid)       I        myTime, myIter, myThid)
413            ENDIF            ENDIF
414    
415    #ifdef ALLOW_DIAGNOSTICS
416              IF ( doDiagsRho.GE.2 ) THEN
417                CALL DIAGS_RHO( k, bi, bj,
418         I                      rhoK, rhoKm1,
419         I                      myTime, myIter, myThid)
420              ENDIF
421    #endif
422    
423  C--     end of diagnostic k loop (Nr:1)  C--     end of diagnostic k loop (Nr:1)
424          ENDDO          ENDDO
425    
426  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_AUTODIFF_TAMC
427          IF ( usediagnostics .AND.  CADJ STORE IVDConvCount(:,:,:,bi,bj)
428       &       (useGMRedi .OR. ivdc_kappa.NE.0.) ) THEN  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte
           CALL fill_diagnostics (myThid, 'DRHODR  ', 0, Nr,  
      &         3, bi, bj, sigmaR)  
         ENDIF  
429  #endif  #endif
430    
431  #ifdef  ALLOW_OBCS  C--     Diagnose Mixed Layer Depth:
432  C--     Calculate future values on open boundaries          IF ( useGMRedi .OR. doDiagsRho.GE.1 ) THEN
433          IF (useOBCS) THEN            CALL CALC_OCE_MXLAYER( rhoK, sigmaR,
434  #ifdef ALLOW_DEBUG       &              bi, bj, myTime, myIter, myThid )
           IF ( debugLevel .GE. debLevB )  
      &     CALL DEBUG_CALL('OBCS_CALC',myThid)  
 #endif  
           CALL OBCS_CALC( bi, bj, myTime+deltaTclock, myIter+1,  
      I            uVel, vVel, wVel, theta, salt,  
      I            myThid )  
435          ENDIF          ENDIF
 #endif  /* ALLOW_OBCS */  
436    
437  #ifndef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_SALT_PLUME
438          IF ( fluidIsWater ) THEN          IF ( useSALT_PLUME ) THEN
439  #endif            CALL SALT_PLUME_CALC_DEPTH( rhoK, sigmaR,
440         &              bi, bj, myTime, myIter, myThid )
441            ENDIF
442    #endif /* ALLOW_SALT_PLUME */
443    
444    #ifdef ALLOW_DIAGNOSTICS
445            IF ( doDiagsRho.GE.1 ) THEN
446              CALL DIAGNOSTICS_FILL (sigmaR, 'DRHODR  ', 0, Nr,
447         &         2, bi, bj, myThid)
448            ENDIF
449    #endif /* ALLOW_DIAGNOSTICS */
450    
451  C--     Determines forcing terms based on external fields  C--     Determines forcing terms based on external fields
452  C       relaxation terms, etc.  C       relaxation terms, etc.
453  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
454          IF ( debugLevel .GE. debLevB )          IF ( debugLevel .GE. debLevB )
455       &    CALL DEBUG_CALL('EXTERNAL_FORCING_SURF',myThid)       &    CALL DEBUG_CALL('EXTERNAL_FORCING_SURF',myThid)
456  #endif  #endif
457           CALL EXTERNAL_FORCING_SURF(  #ifdef ALLOW_AUTODIFF_TAMC
458    CADJ STORE EmPmR(:,:,bi,bj)
459    CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte
460    # ifdef EXACT_CONSERV
461    CADJ STORE PmEpR(:,:,bi,bj)
462    CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte
463    # endif
464    # ifdef NONLIN_FRSURF
465    CADJ STORE hFac_surfC(:,:,bi,bj)
466    CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte
467    CADJ STORE recip_hFacC(:,:,:,bi,bj)
468    CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte
469    # endif
470    #endif
471            CALL EXTERNAL_FORCING_SURF(
472       I             bi, bj, iMin, iMax, jMin, jMax,       I             bi, bj, iMin, iMax, jMin, jMax,
473       I             myTime, myIter, myThid )       I             myTime, myIter, myThid )
474  #ifndef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
475          ENDIF  # ifdef EXACT_CONSERV
476    cph-test
477    cphCADJ STORE PmEpR(:,:,bi,bj)
478    cphCADJ &     = comlev1_bibj, key=itdkey, byte=isbyte
479    # endif
480  #endif  #endif
481    
482  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
# Line 361  CADJ STORE surfaceForcingT(:,:,bi,bj) Line 491  CADJ STORE surfaceForcingT(:,:,bi,bj)
491  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte
492  CADJ STORE surfaceForcingTice(:,:,bi,bj)  CADJ STORE surfaceForcingTice(:,:,bi,bj)
493  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte
   
 #endif /* ALLOW_AUTODIFF_TAMC */  
   
 #ifdef  ALLOW_GMREDI  
   
 #ifdef ALLOW_AUTODIFF_TAMC  
 # ifndef GM_EXCLUDE_CLIPPING  
 cph storing here is needed only for one GMREDI_OPTIONS:  
 cph define GM_BOLUS_ADVEC  
 cph keep it although TAF says you dont need to.  
 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  
 #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 )  
494  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
         ENDIF  
   
 #endif  /* ALLOW_GMREDI */  
495    
496  #ifdef  ALLOW_KPP  #ifdef  ALLOW_KPP
497  C--     Compute KPP mixing coefficients  C--     Compute KPP mixing coefficients
498          IF (useKPP) THEN          IF (useKPP) THEN
499  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
500            IF ( debugLevel .GE. debLevB )            IF ( debugLevel .GE. debLevB )
501       &     CALL DEBUG_CALL('KPP_CALC',myThid)       &     CALL DEBUG_CALL('KPP_CALC',myThid)
502  #endif  #endif
503            CALL KPP_CALC(            CALL KPP_CALC(
504       I                  bi, bj, myTime, myThid )       I                  bi, bj, myTime, myIter, myThid )
505  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
506          ELSE          ELSE
507            CALL KPP_CALC_DUMMY(            CALL KPP_CALC_DUMMY(
508       I                  bi, bj, myTime, myThid )       I                  bi, bj, myTime, myIter, myThid )
509  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
510          ENDIF          ENDIF
511    
# Line 421  C--     Compute KPP mixing coefficients Line 515  C--     Compute KPP mixing coefficients
515  C--     Compute PP81 mixing coefficients  C--     Compute PP81 mixing coefficients
516          IF (usePP81) THEN          IF (usePP81) THEN
517  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
518            IF ( debugLevel .GE. debLevB )            IF ( debugLevel .GE. debLevB )
519       &     CALL DEBUG_CALL('PP81_CALC',myThid)       &     CALL DEBUG_CALL('PP81_CALC',myThid)
520  #endif  #endif
521            CALL PP81_CALC(            CALL PP81_CALC(
# Line 433  C--     Compute PP81 mixing coefficients Line 527  C--     Compute PP81 mixing coefficients
527  C--     Compute MY82 mixing coefficients  C--     Compute MY82 mixing coefficients
528          IF (useMY82) THEN          IF (useMY82) THEN
529  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
530            IF ( debugLevel .GE. debLevB )            IF ( debugLevel .GE. debLevB )
531       &     CALL DEBUG_CALL('MY82_CALC',myThid)       &     CALL DEBUG_CALL('MY82_CALC',myThid)
532  #endif  #endif
533            CALL MY82_CALC(            CALL MY82_CALC(
# Line 445  C--     Compute MY82 mixing coefficients Line 539  C--     Compute MY82 mixing coefficients
539  C--     Compute GGL90 mixing coefficients  C--     Compute GGL90 mixing coefficients
540          IF (useGGL90) THEN          IF (useGGL90) THEN
541  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
542            IF ( debugLevel .GE. debLevB )            IF ( debugLevel .GE. debLevB )
543       &     CALL DEBUG_CALL('GGL90_CALC',myThid)       &     CALL DEBUG_CALL('GGL90_CALC',myThid)
544  #endif  #endif
545            CALL GGL90_CALC(            CALL GGL90_CALC(
# Line 453  C--     Compute GGL90 mixing coefficient Line 547  C--     Compute GGL90 mixing coefficient
547          ENDIF          ENDIF
548  #endif /* ALLOW_GGL90 */  #endif /* ALLOW_GGL90 */
549    
550    #ifdef ALLOW_TIMEAVE
551            IF ( taveFreq.GT. 0. _d 0 ) THEN
552              CALL TIMEAVE_SURF_FLUX( bi, bj, myTime, myIter, myThid)
553            ENDIF
554            IF (taveFreq.GT.0. .AND. ivdc_kappa.NE.0.) THEN
555              CALL TIMEAVE_CUMULATE(ConvectCountTave, IVDConvCount,
556         I                           Nr, deltaTclock, bi, bj, myThid)
557            ENDIF
558    #endif /* ALLOW_TIMEAVE */
559    
560    #ifdef  ALLOW_GMREDI
561    #ifdef ALLOW_AUTODIFF_TAMC
562    # ifndef GM_EXCLUDE_CLIPPING
563    cph storing here is needed only for one GMREDI_OPTIONS:
564    cph define GM_BOLUS_ADVEC
565    cph keep it although TAF says you dont need to.
566    cph but I've avoided the #ifdef for now, in case more things change
567    CADJ STORE sigmaX(:,:,:)        = comlev1_bibj, key=itdkey, byte=isbyte
568    CADJ STORE sigmaY(:,:,:)        = comlev1_bibj, key=itdkey, byte=isbyte
569    CADJ STORE sigmaR(:,:,:)        = comlev1_bibj, key=itdkey, byte=isbyte
570    # endif
571    #endif /* ALLOW_AUTODIFF_TAMC */
572    
573    C--     Calculate iso-neutral slopes for the GM/Redi parameterisation
574            IF (useGMRedi) THEN
575    #ifdef ALLOW_DEBUG
576              IF ( debugLevel .GE. debLevB )
577         &     CALL DEBUG_CALL('GMREDI_CALC_TENSOR',myThid)
578    #endif
579              CALL GMREDI_CALC_TENSOR(
580    c    I             bi, bj, iMin, iMax, jMin, jMax,
581    c    I             sigmaX, sigmaY, sigmaR,
582    c    I             myThid )
583         I             iMin, iMax, jMin, jMax,
584         I             sigmaX, sigmaY, sigmaR,
585         I             bi, bj, myTime, myIter, myThid )
586    #ifdef ALLOW_AUTODIFF_TAMC
587            ELSE
588              CALL GMREDI_CALC_TENSOR_DUMMY(
589    c    I             bi, bj, iMin, iMax, jMin, jMax,
590    c    I             sigmaX, sigmaY, sigmaR,
591    c    I             myThid )
592         I             iMin, iMax, jMin, jMax,
593         I             sigmaX, sigmaY, sigmaR,
594         I             bi, bj, myTime, myIter, myThid )
595    #endif /* ALLOW_AUTODIFF_TAMC */
596            ENDIF
597    #endif  /* ALLOW_GMREDI */
598    
599    #ifndef ALLOW_AUTODIFF_TAMC
600    C---  if fluid Is Water: end
601            ENDIF
602    #endif
603    
604    #ifdef  ALLOW_OBCS
605    C--     Calculate future values on open boundaries
606            IF (useOBCS) THEN
607    #ifdef ALLOW_DEBUG
608              IF ( debugLevel .GE. debLevB )
609         &     CALL DEBUG_CALL('OBCS_CALC',myThid)
610    #endif
611              CALL OBCS_CALC( bi, bj, myTime+deltaTclock, myIter+1,
612         I            uVel, vVel, wVel, theta, salt,
613         I            myThid )
614            ENDIF
615    #endif  /* ALLOW_OBCS */
616    
617  C--   end bi,bj loops.  C--   end bi,bj loops.
618         ENDDO         ENDDO
619        ENDDO        ENDDO
620    
621    #ifdef  ALLOW_KPP
622          IF (useKPP) THEN
623            CALL KPP_DO_EXCH( myThid )
624          ENDIF
625    #endif  /* ALLOW_KPP */
626    
627    #ifdef ALLOW_DIAGNOSTICS
628          IF ( fluidIsWater .AND. useDiagnostics ) THEN
629            CALL DIAGS_OCEANIC_SURF_FLUX( myTime, myIter, myThid )
630          ENDIF
631          IF ( ivdc_kappa.NE.0 .AND. useDiagnostics ) THEN
632            CALL DIAGNOSTICS_FILL( IVDConvCount,'CONVADJ ',
633         &                         0, Nr, 0, 1, 1, myThid )
634          ENDIF
635    #endif
636    
637  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
638           IF ( debugLevel .GE. debLevB )        IF ( debugLevel .GE. debLevB )
639       &    CALL DEBUG_LEAVE('DO_OCEANIC_PHYS',myThid)       &     CALL DEBUG_LEAVE('DO_OCEANIC_PHYS',myThid)
640  #endif  #endif
641    
642        RETURN        RETURN
Legend:
Removed from v.1.15  
changed lines
  Added in v.1.64
  ViewVC Help
Powered by ViewVC 1.1.22