/[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.31 by heimbach, Sun Oct 22 01:11:44 2006 UTC revision 1.86 by jmc, Tue Mar 16 00:08:27 2010 UTC
# Line 36  C     == Global variables === Line 36  C     == Global variables ===
36  #include "SIZE.h"  #include "SIZE.h"
37  #include "EEPARAMS.h"  #include "EEPARAMS.h"
38  #include "PARAMS.h"  #include "PARAMS.h"
 #include "DYNVARS.h"  
39  #include "GRID.h"  #include "GRID.h"
40    #include "DYNVARS.h"
41  #ifdef ALLOW_TIMEAVE  #ifdef ALLOW_TIMEAVE
42  #include "TIMEAVE_STATV.h"  #include "TIMEAVE_STATV.h"
43  #endif  #endif
# Line 46  C     == Global variables === Line 46  C     == Global variables ===
46  #endif  #endif
47    
48  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
49    # include "AUTODIFF_MYFIELDS.h"
50  # include "tamc.h"  # include "tamc.h"
51  # include "tamc_keys.h"  # include "tamc_keys.h"
52  # include "FFIELDS.h"  # include "FFIELDS.h"
53    # include "SURFACE.h"
54  # include "EOS.h"  # include "EOS.h"
55  # ifdef ALLOW_KPP  # ifdef ALLOW_KPP
56  #  include "KPP.h"  #  include "KPP.h"
# Line 59  C     == Global variables === Line 61  C     == Global variables ===
61  # ifdef ALLOW_EBM  # ifdef ALLOW_EBM
62  #  include "EBM.h"  #  include "EBM.h"
63  # endif  # endif
 # ifdef EXACT_CONSERV  
 #  include "SURFACE.h"  
 # endif  
64  # ifdef ALLOW_EXF  # ifdef ALLOW_EXF
65  #  include "ctrl.h"  #  include "ctrl.h"
66  #  include "exf_fields.h"  #  include "EXF_FIELDS.h"
 #  include "exf_clim_fields.h"  
67  #  ifdef ALLOW_BULKFORMULAE  #  ifdef ALLOW_BULKFORMULAE
68  #   include "exf_constants.h"  #   include "EXF_CONSTANTS.h"
69  #  endif  #  endif
70  # endif  # endif
71  # ifdef ALLOW_SEAICE  # ifdef ALLOW_SEAICE
72  #  include "SEAICE.h"  #  include "SEAICE.h"
73  # endif  # endif
74    # ifdef ALLOW_SALT_PLUME
75    #  include "SALT_PLUME.h"
76    # endif
77  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
78    
79  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
# Line 86  C     myThid :: Thread number for this i Line 87  C     myThid :: Thread number for this i
87    
88  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
89  C     == Local variables  C     == Local variables
90  C     rhoK, rhoKM1  :: Density at current level, and level above  C     rhoK, rhoKm1  :: Density at current level, and level above
91  C     iMin, iMax    :: Ranges and sub-block indices on which calculations  C     iMin, iMax    :: Ranges and sub-block indices on which calculations
92  C     jMin, jMax       are applied.  C     jMin, jMax       are applied.
93  C     bi, bj        :: tile indices  C     bi, bj        :: tile indices
94  C     i,j,k         :: loop indices  C     i,j,k         :: loop indices
95        _RL rhokp1  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL rhoKp1  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
96        _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)  
97        _RL sigmaX  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL sigmaX  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
98        _RL sigmaY  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL sigmaY  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
99        _RL sigmaR  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL sigmaR  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
# Line 118  C--   dummy statement to end declaration Line 118  C--   dummy statement to end declaration
118        IF ( debugLevel .GE. debLevB )        IF ( debugLevel .GE. debLevB )
119       &     CALL DEBUG_ENTER('DO_OCEANIC_PHYS',myThid)       &     CALL DEBUG_ENTER('DO_OCEANIC_PHYS',myThid)
120  #endif  #endif
121    
122        doDiagsRho = 0        doDiagsRho = 0
123  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
124        IF ( useDiagnostics .AND. fluidIsWater ) THEN        IF ( useDiagnostics .AND. fluidIsWater ) THEN
125          IF ( DIAGNOSTICS_IS_ON('DRHODR  ',myThid) ) doDiagsRho = 1          IF ( DIAGNOSTICS_IS_ON('WRHOMASS',myThid) )
126          IF ( DIAGNOSTICS_IS_ON('RHOANOSQ',myThid) .OR.       &       doDiagsRho = doDiagsRho + 1
127       &       DIAGNOSTICS_IS_ON('URHOMASS',myThid) .OR.          IF ( DIAGNOSTICS_IS_ON('DRHODR  ',myThid) )
128       &       DIAGNOSTICS_IS_ON('VRHOMASS',myThid) .OR.       &       doDiagsRho = doDiagsRho + 2
129       &       DIAGNOSTICS_IS_ON('WRHOMASS',myThid) .OR.          IF ( DIAGNOSTICS_IS_ON('MXLDEPTH',myThid) )
130       &       DIAGNOSTICS_IS_ON('WRHOMASS',myThid) ) doDiagsRho = 2       &       doDiagsRho = doDiagsRho + 4
131        ENDIF        ENDIF
132  #endif /* ALLOW_DIAGNOSTICS */  #endif /* ALLOW_DIAGNOSTICS */
133    
134    #ifdef  ALLOW_OBCS
135          IF (useOBCS) THEN
136    C--   Calculate future values on open boundaries
137    C--   moved before SEAICE_MODEL call since SEAICE_MODEL needs seaice-obcs fields
138    #ifdef ALLOW_DEBUG
139           IF ( debugLevel .GE. debLevB )
140         &     CALL DEBUG_CALL('OBCS_CALC',myThid)
141    #endif
142           CALL OBCS_CALC( myTime+deltaTclock, myIter+1,
143         I                 uVel, vVel, wVel, theta, salt, myThid )
144          ENDIF
145    #endif  /* ALLOW_OBCS */
146    
147  #ifdef ALLOW_SEAICE  #ifdef ALLOW_SEAICE
 C--   Call sea ice model to compute forcing/external data fields.  In  
 C     addition to computing prognostic sea-ice variables and diagnosing the  
 C     forcing/external data fields that drive the ocean model, SEAICE_MODEL  
 C     also sets theta to the freezing point under sea-ice.  The implied  
 C     surface heat flux is then stored in variable surfaceTendencyTice,  
 C     which is needed by KPP package (kpp_calc.F and kpp_transport_t.F)  
 C     to diagnose surface buoyancy fluxes and for the non-local transport  
 C     term.  Because this call precedes model thermodynamics, temperature  
 C     under sea-ice may not be "exactly" at the freezing point by the time  
 C     theta is dumped or time-averaged.  
148        IF ( useSEAICE ) THEN        IF ( useSEAICE ) THEN
149  #ifdef ALLOW_AUTODIFF_TAMC  # ifdef ALLOW_AUTODIFF_TAMC
150  CADJ STORE qnet,qsw            = comlev1, key = ikey_dynamics  cph-adj-test(
151  CADJ STORE aqh,precip,swdown   = comlev1, key = ikey_dynamics  CADJ STORE area   = comlev1, key=ikey_dynamics, kind=isbyte
152  CADJ STORE theta               = comlev1, key = ikey_dynamics  CADJ STORE hsnow  = comlev1, key=ikey_dynamics, kind=isbyte
153  # ifdef SEAICE_ALLOW_DYNAMICS  CADJ STORE empmr,qsw,theta   = comlev1, key = ikey_dynamics,
154  CADJ STORE uvel,vvel           = comlev1, key = ikey_dynamics  CADJ &     kind = isbyte
155    cph-adj-test)
156    CADJ STORE atemp,aqh,precip    = comlev1, key = ikey_dynamics,
157    CADJ &     kind = isbyte
158    CADJ STORE swdown,lwdown       = comlev1, key = ikey_dynamics,
159    CADJ &     kind = isbyte
160    cph# ifdef EXF_READ_EVAP
161    CADJ STORE evap                = comlev1, key = ikey_dynamics,
162    CADJ &     kind = isbyte
163    cph# endif
164    CADJ STORE uvel,vvel           = comlev1, key = ikey_dynamics,
165    CADJ &     kind = isbyte
166    #  ifdef SEAICE_ALLOW_DYNAMICS
167    CADJ STORE uice                = comlev1, key = ikey_dynamics,
168    CADJ &     kind = isbyte
169    CADJ STORE vice                = comlev1, key = ikey_dynamics,
170    CADJ &     kind = isbyte
171    CADJ STORE stressdivergencex   = comlev1, key = ikey_dynamics,
172    CADJ &     kind = isbyte
173    CADJ STORE stressdivergencey   = comlev1, key = ikey_dynamics,
174    CADJ &     kind = isbyte
175    #   ifdef SEAICE_ALLOW_EVP
176    CADJ STORE seaice_sigma1       = comlev1, key = ikey_dynamics,
177    CADJ &     kind = isbyte
178    CADJ STORE seaice_sigma2       = comlev1, key = ikey_dynamics,
179    CADJ &     kind = isbyte
180    CADJ STORE seaice_sigma12      = comlev1, key = ikey_dynamics,
181    CADJ &     kind = isbyte
182    #   endif
183    #  endif
184    #  ifdef SEAICE_SALINITY
185    CADJ STORE salt                = comlev1, key = ikey_dynamics,
186    CADJ &     kind = isbyte
187    #  endif
188    #  ifdef ATMOSPHERIC_LOADING
189    CADJ STORE pload               = comlev1, key = ikey_dynamics,
190    CADJ &     kind = isbyte
191    CADJ STORE siceload            = comlev1, key = ikey_dynamics,
192    CADJ &     kind = isbyte
193    #  endif
194    #  ifdef NONLIN_FRSURF
195    CADJ STORE recip_hfacc         = comlev1, key = ikey_dynamics,
196    CADJ &     kind = isbyte
197    #  endif
198    #  ifdef ANNUAL_BALANCE
199    CADJ STORE balance_itcount     = comlev1, key = ikey_dynamics,
200    CADJ &     kind = isbyte
201    #  endif /* ANNUAL_BALANCE */
202  # endif  # endif
203  #endif  # ifdef ALLOW_DEBUG
 #ifdef ALLOW_DEBUG  
204          IF ( debugLevel .GE. debLevB )          IF ( debugLevel .GE. debLevB )
205       &    CALL DEBUG_CALL('SEAICE_MODEL',myThid)       &    CALL DEBUG_CALL('SEAICE_MODEL',myThid)
206  #endif  # endif
207          CALL TIMER_START('SEAICE_MODEL    [DO_OCEANIC_PHYS]', myThid)          CALL TIMER_START('SEAICE_MODEL    [DO_OCEANIC_PHYS]', myThid)
208          CALL SEAICE_MODEL( myTime, myIter, myThid )          CALL SEAICE_MODEL( myTime, myIter, myThid )
209          CALL TIMER_STOP ('SEAICE_MODEL    [DO_OCEANIC_PHYS]', myThid)          CALL TIMER_STOP ('SEAICE_MODEL    [DO_OCEANIC_PHYS]', myThid)
210  #ifdef ALLOW_COST_ICE  # ifdef ALLOW_COST
211          CALL COST_ICE_TEST ( myTime, myIter, myThid )          CALL SEAICE_COST_SENSI ( myTime, myIter, myThid )
212  #endif  # endif
213        ENDIF        ENDIF
214  #endif /* ALLOW_SEAICE */  #endif /* ALLOW_SEAICE */
215    
216    #ifdef ALLOW_AUTODIFF_TAMC
217    CADJ STORE sst, sss           = comlev1, key = ikey_dynamics,
218    CADJ &     kind = isbyte
219    CADJ STORE qsw                = comlev1, key = ikey_dynamics,
220    CADJ &     kind = isbyte
221    # ifdef ALLOW_SEAICE
222    CADJ STORE area               = comlev1, key = ikey_dynamics,
223    CADJ &     kind = isbyte
224    # endif
225    #endif
226    
227  #if (defined ALLOW_THSICE) && !(defined ALLOW_ATM2D)  #if (defined ALLOW_THSICE) && !(defined ALLOW_ATM2D)
228        IF ( useThSIce .AND. fluidIsWater ) THEN        IF ( useThSIce .AND. fluidIsWater ) THEN
229  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
# Line 184  C       and modify forcing terms includi Line 244  C       and modify forcing terms includi
244          IF ( debugLevel .GE. debLevB )          IF ( debugLevel .GE. debLevB )
245       &    CALL DEBUG_CALL('SHELFICE_THERMODYNAMICS',myThid)       &    CALL DEBUG_CALL('SHELFICE_THERMODYNAMICS',myThid)
246  #endif  #endif
247  C     compute temperature and (virtual) salt flux at the  C     compute temperature and (virtual) salt flux at the
248  C     shelf-ice ocean interface  C     shelf-ice ocean interface
249         CALL TIMER_START('SHELFICE_THERMODYNAMICS [DO_OCEANIC_PHYS]',         CALL TIMER_START('SHELFICE_THERMODYNAMICS [DO_OCEANIC_PHYS]',
250       &       myThid)       &       myThid)
# Line 194  C     shelf-ice ocean interface Line 254  C     shelf-ice ocean interface
254        ENDIF        ENDIF
255  #endif /* ALLOW_SHELFICE */  #endif /* ALLOW_SHELFICE */
256    
257    #ifdef ALLOW_ICEFRONT
258          IF ( useICEFRONT .AND. fluidIsWater ) THEN
259    #ifdef ALLOW_DEBUG
260            IF ( debugLevel .GE. debLevB )
261         &    CALL DEBUG_CALL('ICEFRONT_THERMODYNAMICS',myThid)
262    #endif
263    C     compute temperature and (virtual) salt flux at the
264    C     ice-front ocean interface
265           CALL TIMER_START('ICEFRONT_THERMODYNAMICS [DO_OCEANIC_PHYS]',
266         &       myThid)
267           CALL ICEFRONT_THERMODYNAMICS( myTime, myIter, myThid )
268           CALL TIMER_STOP( 'ICEFRONT_THERMODYNAMICS [DO_OCEANIC_PHYS]',
269         &      myThid)
270          ENDIF
271    #endif /* ALLOW_ICEFRONT */
272    
273  C--   Freeze water at the surface  C--   Freeze water at the surface
274  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
275  CADJ STORE theta = comlev1, key = ikey_dynamics  CADJ STORE theta = comlev1, key = ikey_dynamics,
276    CADJ &     kind = isbyte
277  #endif  #endif
278        IF ( allowFreezing        IF ( allowFreezing ) THEN
      &                   .AND. .NOT. useSEAICE  
      &                   .AND. .NOT. useThSIce ) THEN  
279          CALL FREEZE_SURFACE(  myTime, myIter, myThid )          CALL FREEZE_SURFACE(  myTime, myIter, myThid )
280        ENDIF        ENDIF
281    
282  #ifdef ALLOW_OCN_COMPON_INTERF  #ifdef ALLOW_OCN_COMPON_INTERF
283  C--    Apply imported data (from coupled interface) to forcing fields  C--    Apply imported data (from coupled interface) to forcing fields
284  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 ?)
285         IF ( useCoupler ) THEN        IF ( useCoupler ) THEN
286           CALL OCN_APPLY_IMPORT( .TRUE., myTime, myIter, myThid )           CALL OCN_APPLY_IMPORT( .TRUE., myTime, myIter, myThid )
287         ENDIF        ENDIF
288  #endif /* ALLOW_OCN_COMPON_INTERF */  #endif /* ALLOW_OCN_COMPON_INTERF */
289    
290  #ifdef ALLOW_BALANCE_FLUXES  #ifdef ALLOW_BALANCE_FLUXES
291  C     balance fluxes  C     balance fluxes
292         IF ( balanceEmPmR )        IF ( balanceEmPmR )
293       &        CALL REMOVE_MEAN_RS( 1, EmPmR, maskH, maskH, rA, drF,       &      CALL REMOVE_MEAN_RS( 1, EmPmR, maskInC, maskInC, rA, drF,
294       &        'EmPmR', myTime, myThid )       &        'EmPmR', myTime, myThid )
295         IF ( balanceQnet )        IF ( balanceQnet )
296       &        CALL REMOVE_MEAN_RS( 1, Qnet,  maskH, maskH, rA, drF,       &      CALL REMOVE_MEAN_RS( 1, Qnet,  maskInC, maskInC, rA, drF,
297       &        'Qnet ', myTime, myThid )       &        'Qnet ', myTime, myThid )
298  #endif /* ALLOW_BALANCE_FLUXES */  #endif /* ALLOW_BALANCE_FLUXES */
299    
# Line 244  CHPF$ INDEPENDENT Line 319  CHPF$ INDEPENDENT
319            itdkey = (act1 + 1) + act2*max1            itdkey = (act1 + 1) + act2*max1
320       &                      + act3*max1*max2       &                      + act3*max1*max2
321       &                      + act4*max1*max2*max3       &                      + act4*max1*max2*max3
322    #else  /* ALLOW_AUTODIFF_TAMC */
323    C     if fluid is not water, by-pass find_rho, gmredi, surfaceForcing
324    C     and all vertical mixing schemes, but keep OBCS_CALC
325            IF ( fluidIsWater ) THEN
326  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
327    
328  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 252  C     just ensure that all memory refere Line 331  C     just ensure that all memory refere
331  C     point numbers. This prevents spurious hardware signals due to  C     point numbers. This prevents spurious hardware signals due to
332  C     uninitialised but inert locations.  C     uninitialised but inert locations.
333    
334    #ifdef ALLOW_AUTODIFF_TAMC
335          DO j=1-OLy,sNy+OLy          DO j=1-OLy,sNy+OLy
336           DO i=1-OLx,sNx+OLx           DO i=1-OLx,sNx+OLx
337            rhok   (i,j)   = 0. _d 0            rhoKm1 (i,j)   = 0. _d 0
338            rhoKM1 (i,j)   = 0. _d 0            rhoKp1 (i,j)   = 0. _d 0
           rhoKP1 (i,j)   = 0. _d 0  
339           ENDDO           ENDDO
340          ENDDO          ENDDO
341    #endif /* ALLOW_AUTODIFF_TAMC */
342    
343          DO k=1,Nr          DO k=1,Nr
344           DO j=1-OLy,sNy+OLy           DO j=1-OLy,sNy+OLy
345            DO i=1-OLx,sNx+OLx            DO i=1-OLx,sNx+OLx
346  C This is currently also used by IVDC and Diagnostics  C This is currently used by GMRedi, IVDC, MXL-depth  and Diagnostics
347             sigmaX(i,j,k) = 0. _d 0             sigmaX(i,j,k) = 0. _d 0
348             sigmaY(i,j,k) = 0. _d 0             sigmaY(i,j,k) = 0. _d 0
349             sigmaR(i,j,k) = 0. _d 0             sigmaR(i,j,k) = 0. _d 0
350  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
351  cph all the following init. are necessary for TAF  cph all the following init. are necessary for TAF
352  cph although some of these are re-initialised later.  cph although some of these are re-initialised later.
353    c          rhoInSitu(i,j,k,bi,bj) = 0.
354             IVDConvCount(i,j,k,bi,bj) = 0.             IVDConvCount(i,j,k,bi,bj) = 0.
355  # ifdef ALLOW_GMREDI  # ifdef ALLOW_GMREDI
356             Kwx(i,j,k,bi,bj)  = 0. _d 0             Kwx(i,j,k,bi,bj)  = 0. _d 0
# Line 291  cph although some of these are re-initia Line 372  cph although some of these are re-initia
372             VisbeckK(i,j,bi,bj)   = 0. _d 0             VisbeckK(i,j,bi,bj)   = 0. _d 0
373  #  endif  #  endif
374  # endif /* ALLOW_GMREDI */  # endif /* ALLOW_GMREDI */
375    # ifdef ALLOW_KPP
376               KPPdiffKzS(i,j,k,bi,bj)  = 0. _d 0
377               KPPdiffKzT(i,j,k,bi,bj)  = 0. _d 0
378    # endif /* ALLOW_KPP */
379  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
380            ENDDO            ENDDO
381           ENDDO           ENDDO
382          ENDDO          ENDDO
383            DO j=1-OLy,sNy+OLy
384             DO i=1-OLx,sNx+OLx
385    #ifdef ALLOW_AUTODIFF_TAMC
386    # ifdef ALLOW_SALT_PLUME
387              saltPlumeDepth(i,j,bi,bj) = 0. _d 0
388              saltPlumeFlux(i,j,bi,bj)  = 0. _d 0
389    # endif
390    #endif /* ALLOW_AUTODIFF_TAMC */
391             ENDDO
392            ENDDO
393    
394          iMin = 1-OLx          iMin = 1-OLx
395          iMax = sNx+OLx          iMax = sNx+OLx
# Line 302  cph although some of these are re-initia Line 397  cph although some of these are re-initia
397          jMax = sNy+OLy          jMax = sNy+OLy
398    
399  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
400  CADJ STORE theta(:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte  CADJ STORE theta(:,:,:,bi,bj) = comlev1_bibj, key=itdkey,
401  CADJ STORE salt (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     kind = isbyte
402    CADJ STORE salt (:,:,:,bi,bj) = comlev1_bibj, key=itdkey,
403    CADJ &     kind = isbyte
404  CADJ STORE totphihyd(:,:,:,bi,bj)  CADJ STORE totphihyd(:,:,:,bi,bj)
405  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey,
406    CADJ &     kind = isbyte
407  # ifdef ALLOW_KPP  # ifdef ALLOW_KPP
408  CADJ STORE uvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte  CADJ STORE uvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey,
409  CADJ STORE vvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     kind = isbyte
410    CADJ STORE vvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey,
411    CADJ &     kind = isbyte
412  # endif  # endif
413  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
414    
415  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
416          IF ( debugLevel .GE. debLevB )          IF ( debugLevel .GE. debLevB )
417       &    CALL DEBUG_MSG('ENTERING UPWARD K LOOP',myThid)       &    CALL DEBUG_MSG('ENTERING UPWARD K LOOP',myThid)
418  #endif  #endif
419    
# Line 323  C--     Start of diagnostic loop Line 423  C--     Start of diagnostic loop
423  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
424  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?
425  C? Do we still need this?  C? Do we still need this?
426  cph kkey formula corrected.  cph kkey formula corrected.
427  cph Needed for rhok, rhokm1, in the case useGMREDI.  cph Needed for rhoK, rhoKm1, in the case useGMREDI.
428           kkey = (itdkey-1)*Nr + k            kkey = (itdkey-1)*Nr + k
429    #endif /* ALLOW_AUTODIFF_TAMC */
430    
431    C--   Always compute density (stored in common block) here; even when it is not
432    C     needed here, will be used anyway in calc_phi_hyd (data flow easier this way)
433    #ifdef ALLOW_DEBUG
434              IF ( debugLevel .GE. debLevB )
435         &       CALL DEBUG_CALL('FIND_RHO_2D',myThid)
436    #endif
437    #ifdef ALLOW_AUTODIFF_TAMC
438              IF ( fluidIsWater ) THEN
439    CADJ STORE theta(:,:,k,bi,bj) = comlev1_bibj_k, key=kkey,
440    CADJ &     kind = isbyte
441    CADJ STORE salt(:,:,k,bi,bj)  = comlev1_bibj_k, key=kkey,
442    CADJ &     kind = isbyte
443    #endif /* ALLOW_AUTODIFF_TAMC */
444    #ifdef ALLOW_DOWN_SLOPE
445              IF ( useDOWN_SLOPE ) THEN
446                CALL DWNSLP_CALC_RHO(
447         I                  theta, salt,
448         O                  rhoInSitu(1-OLx,1-OLy,k,bi,bj),
449         I                  k, bi, bj, myTime, myIter, myThid )
450              ELSE
451    #endif /* ALLOW_DOWN_SLOPE */
452                CALL FIND_RHO_2D(
453         I                iMin, iMax, jMin, jMax, k,
454         I                theta(1-OLx,1-OLy,k,bi,bj),
455         I                salt (1-OLx,1-OLy,k,bi,bj),
456         O                rhoInSitu(1-OLx,1-OLy,k,bi,bj),
457         I                k, bi, bj, myThid )
458    #ifdef ALLOW_DOWN_SLOPE
459              ENDIF
460    #endif /* ALLOW_DOWN_SLOPE */
461    #ifdef ALLOW_AUTODIFF_TAMC
462              ELSE
463    C-        fluid is not water:
464               DO j=1-OLy,sNy+OLy
465                DO i=1-OLx,sNx+OLx
466                  rhoInSitu(i,j,k,bi,bj) = 0.
467                ENDDO
468               ENDDO
469              ENDIF
470  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
471    
472  C--       Calculate gradients of potential density for isoneutral  C--       Calculate gradients of potential density for isoneutral
473  C         slope terms (e.g. GM/Redi tensor or IVDC diffusivity)  C         slope terms (e.g. GM/Redi tensor or IVDC diffusivity)
 c         IF ( k.GT.1 .AND. (useGMRedi.OR.ivdc_kappa.NE.0.) ) THEN  
474            IF ( useGMRedi .OR. (k.GT.1 .AND. ivdc_kappa.NE.0.)            IF ( useGMRedi .OR. (k.GT.1 .AND. ivdc_kappa.NE.0.)
475       &                   .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 )  
   
476              IF (k.GT.1) THEN              IF (k.GT.1) THEN
477  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
478  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,
479  CADJ STORE salt (:,:,k-1,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ &     kind = isbyte
480  #endif /* ALLOW_AUTODIFF_TAMC */  CADJ STORE salt (:,:,k-1,bi,bj) = comlev1_bibj_k, key=kkey,
481               CALL FIND_RHO(  CADJ &     kind = isbyte
482       I        bi, bj, iMin, iMax, jMin, jMax, k-1, k,  CADJ STORE rhokm1 (bi,bj)       = comlev1_bibj_k, key=kkey,
483       I        theta, salt,  CADJ &     kind = isbyte
484       O        rhoKm1,  #endif /* ALLOW_AUTODIFF_TAMC */
485       I        myThid )               CALL FIND_RHO_2D(
486         I                 iMin, iMax, jMin, jMax, k,
487         I                 theta(1-OLx,1-OLy,k-1,bi,bj),
488         I                 salt (1-OLx,1-OLy,k-1,bi,bj),
489         O                 rhoKm1,
490         I                 k-1, bi, bj, myThid )
491              ENDIF              ENDIF
492  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
493              IF ( debugLevel .GE. debLevB )              IF ( debugLevel .GE. debLevB )
494       &       CALL DEBUG_CALL('GRAD_SIGMA',myThid)       &       CALL DEBUG_CALL('GRAD_SIGMA',myThid)
495  #endif  #endif
496  cph Avoid variable aliasing for adjoint !!!  cph Avoid variable aliasing for adjoint !!!
497              DO j=jMin,jMax              DO j=jMin,jMax
498               DO i=iMin,iMax               DO i=iMin,iMax
499                rhoKP1(i,j) = rhoK(i,j)                rhoKp1(i,j) = rhoInSitu(i,j,k,bi,bj)
500               ENDDO               ENDDO
501              ENDDO              ENDDO
502              CALL GRAD_SIGMA(              CALL GRAD_SIGMA(
503       I             bi, bj, iMin, iMax, jMin, jMax, k,       I             bi, bj, iMin, iMax, jMin, jMax, k,
504       I             rhoK, rhoKm1, rhoKp1,       I             rhoInSitu(1-OLx,1-OLy,k,bi,bj), rhoKm1, rhoKp1,
505       O             sigmaX, sigmaY, sigmaR,       O             sigmaX, sigmaY, sigmaR,
506       I             myThid )       I             myThid )
           ENDIF  
   
507  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
508  ctest# ifndef GM_EXCLUDE_CLIPPING  #ifdef GMREDI_WITH_STABLE_ADJOINT
509  CADJ STORE rhok   (:,:) = comlev1_bibj_k ,       key=kkey, byte=isbyte  cgf zero out adjoint fields to stabilize pkg/gmredi adjoint
510  ctest# endif  cgf -> cuts adjoint dependency from slope to state
511  CADJ STORE rhokm1 (:,:) = comlev1_bibj_k ,       key=kkey, byte=isbyte              CALL ZERO_ADJ_LOC( Nr, sigmaX, myThid)
512                CALL ZERO_ADJ_LOC( Nr, sigmaY, myThid)
513                CALL ZERO_ADJ_LOC( Nr, sigmaR, myThid)
514    #endif
515  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
516              ENDIF
517    
518  C--       Implicit Vertical Diffusion for Convection  C--       Implicit Vertical Diffusion for Convection
519  c ==> should use sigmaR !!!  c ==> should use sigmaR !!!
520            IF (k.GT.1 .AND. ivdc_kappa.NE.0.) THEN            IF (k.GT.1 .AND. ivdc_kappa.NE.0.) THEN
521  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
522              IF ( debugLevel .GE. debLevB )              IF ( debugLevel .GE. debLevB )
523       &       CALL DEBUG_CALL('CALC_IVDC',myThid)       &       CALL DEBUG_CALL('CALC_IVDC',myThid)
524  #endif  #endif
525              CALL CALC_IVDC(              CALL CALC_IVDC(
526       I        bi, bj, iMin, iMax, jMin, jMax, k,       I        bi, bj, iMin, iMax, jMin, jMax, k,
527       I        rhoKm1, rhoK,       I        rhoKm1, rhoInSitu(1-OLx,1-OLy,k,bi,bj),
528       I        myTime, myIter, myThid)       I        myTime, myIter, myThid)
529            ENDIF            ENDIF
530    
531  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
532            IF ( doDiagsRho.GE.2 ) THEN            IF ( MOD(doDiagsRho,2).EQ.1 ) THEN
533              CALL DIAGS_RHO( k, bi, bj,              CALL DIAGS_RHO_L( k, bi, bj,
534       I                      rhoK, rhoKm1,       I                        rhoInSitu(1-OLx,1-OLy,k,bi,bj),
535       I                      myTime, myIter, myThid)       I                        rhoKm1, wVel,
536         I                        myTime, myIter, myThid )
537            ENDIF            ENDIF
538  #endif  #endif
539    
540  C--     end of diagnostic k loop (Nr:1)  C--     end of diagnostic k loop (Nr:1)
541          ENDDO          ENDDO
542    
543    #ifdef ALLOW_AUTODIFF_TAMC
544    CADJ STORE IVDConvCount(:,:,:,bi,bj)
545    CADJ &     = comlev1_bibj, key=itdkey,
546    CADJ &     kind = isbyte
547    #endif
548    
549    C--     Diagnose Mixed Layer Depth:
550            IF ( useGMRedi .OR. doDiagsRho.GE.4 ) THEN
551              CALL CALC_OCE_MXLAYER(
552         I              rhoInSitu(1-OLx,1-OLy,1,bi,bj), sigmaR,
553         I              bi, bj, myTime, myIter, myThid )
554            ENDIF
555    
556    #ifdef ALLOW_SALT_PLUME
557            IF ( useSALT_PLUME ) THEN
558              CALL SALT_PLUME_CALC_DEPTH(
559         I              rhoInSitu(1-OLx,1-OLy,1,bi,bj), sigmaR,
560         I              bi, bj, myTime, myIter, myThid )
561            ENDIF
562    #endif /* ALLOW_SALT_PLUME */
563    
564  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
565  c       IF ( useDiagnostics .AND.          IF ( MOD(doDiagsRho,4).GE.2 ) THEN
 c    &       (useGMRedi .OR. ivdc_kappa.NE.0.) ) THEN  
         IF ( doDiagsRho.GE.1 ) THEN  
566            CALL DIAGNOSTICS_FILL (sigmaR, 'DRHODR  ', 0, Nr,            CALL DIAGNOSTICS_FILL (sigmaR, 'DRHODR  ', 0, Nr,
567       &         2, bi, bj, myThid)       &         2, bi, bj, myThid)
568          ENDIF          ENDIF
569  #endif  #endif /* ALLOW_DIAGNOSTICS */
   
 #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)  
 #endif  
           CALL OBCS_CALC( bi, bj, myTime+deltaTclock, myIter+1,  
      I            uVel, vVel, wVel, theta, salt,  
      I            myThid )  
         ENDIF  
 #endif  /* ALLOW_OBCS */  
570    
 #ifndef ALLOW_AUTODIFF_TAMC  
         IF ( fluidIsWater ) THEN  
 #endif  
571  C--     Determines forcing terms based on external fields  C--     Determines forcing terms based on external fields
572  C       relaxation terms, etc.  C       relaxation terms, etc.
573  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
574          IF ( debugLevel .GE. debLevB )          IF ( debugLevel .GE. debLevB )
575       &    CALL DEBUG_CALL('EXTERNAL_FORCING_SURF',myThid)       &    CALL DEBUG_CALL('EXTERNAL_FORCING_SURF',myThid)
576  #endif  #endif
577  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
578  CADJ STORE EmPmR(:,:,bi,bj)  CADJ STORE EmPmR(:,:,bi,bj)
579  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey,
580    CADJ &     kind = isbyte
581  # ifdef EXACT_CONSERV  # ifdef EXACT_CONSERV
582  CADJ STORE PmEpR(:,:,bi,bj)  CADJ STORE PmEpR(:,:,bi,bj)
583  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey,
584    CADJ &     kind = isbyte
585  # endif  # endif
586  # ifdef NONLIN_FRSURF  # ifdef NONLIN_FRSURF
587  CADJ STORE hFac_surfC(:,:,bi,bj)  CADJ STORE hFac_surfC(:,:,bi,bj)
588  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey,
589    CADJ &     kind = isbyte
590  CADJ STORE recip_hFacC(:,:,:,bi,bj)  CADJ STORE recip_hFacC(:,:,:,bi,bj)
591  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey,
592    CADJ &     kind = isbyte
593  # endif  # endif
594  #endif  #endif
595           CALL EXTERNAL_FORCING_SURF(          CALL EXTERNAL_FORCING_SURF(
596       I             bi, bj, iMin, iMax, jMin, jMax,       I             bi, bj, iMin, iMax, jMin, jMax,
597       I             myTime, myIter, myThid )       I             myTime, myIter, myThid )
 #ifndef ALLOW_AUTODIFF_TAMC  
         ENDIF  
 #endif  
598  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
599  # ifdef EXACT_CONSERV  # ifdef EXACT_CONSERV
600  cph-test  cph-test
601  cphCADJ STORE PmEpR(:,:,bi,bj)  cphCADJ STORE PmEpR(:,:,bi,bj)
602  cphCADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  cphCADJ &     = comlev1_bibj, key=itdkey,
603    cphCADJ &     kind = isbyte
604  # endif  # endif
605  #endif  #endif
606    
607  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
608  cph needed for KPP  cph needed for KPP
609  CADJ STORE surfaceForcingU(:,:,bi,bj)  CADJ STORE surfaceForcingU(:,:,bi,bj)
610  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey,
611    CADJ &     kind = isbyte
612  CADJ STORE surfaceForcingV(:,:,bi,bj)  CADJ STORE surfaceForcingV(:,:,bi,bj)
613  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey,
614    CADJ &     kind = isbyte
615  CADJ STORE surfaceForcingS(:,:,bi,bj)  CADJ STORE surfaceForcingS(:,:,bi,bj)
616  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey,
617    CADJ &     kind = isbyte
618  CADJ STORE surfaceForcingT(:,:,bi,bj)  CADJ STORE surfaceForcingT(:,:,bi,bj)
619  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey,
620    CADJ &     kind = isbyte
621  CADJ STORE surfaceForcingTice(:,:,bi,bj)  CADJ STORE surfaceForcingTice(:,:,bi,bj)
622  CADJ &     = comlev1_bibj, key=itdkey, byte=isbyte  CADJ &     = comlev1_bibj, key=itdkey,
623  #endif /* ALLOW_AUTODIFF_TAMC */  CADJ &     kind = isbyte
   
 #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 )  
624  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
         ENDIF  
   
 #endif  /* ALLOW_GMREDI */  
625    
626  #ifdef  ALLOW_KPP  #ifdef  ALLOW_KPP
627  C--     Compute KPP mixing coefficients  C--     Compute KPP mixing coefficients
628          IF (useKPP) THEN          IF (useKPP) THEN
629  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
630            IF ( debugLevel .GE. debLevB )            IF ( debugLevel .GE. debLevB )
631       &     CALL DEBUG_CALL('KPP_CALC',myThid)       &     CALL DEBUG_CALL('KPP_CALC',myThid)
632  #endif  #endif
633              CALL TIMER_START('KPP_CALC [DO_OCEANIC_PHYS]', myThid)
634            CALL KPP_CALC(            CALL KPP_CALC(
635       I                  bi, bj, myTime, myThid )       I                  bi, bj, myTime, myIter, myThid )
636              CALL TIMER_STOP ('KPP_CALC [DO_OCEANIC_PHYS]', myThid)
637  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
638          ELSE          ELSE
639            CALL KPP_CALC_DUMMY(            CALL KPP_CALC_DUMMY(
640       I                  bi, bj, myTime, myThid )       I                  bi, bj, myTime, myIter, myThid )
641  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
642          ENDIF          ENDIF
643    
# Line 535  C--     Compute KPP mixing coefficients Line 647  C--     Compute KPP mixing coefficients
647  C--     Compute PP81 mixing coefficients  C--     Compute PP81 mixing coefficients
648          IF (usePP81) THEN          IF (usePP81) THEN
649  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
650            IF ( debugLevel .GE. debLevB )            IF ( debugLevel .GE. debLevB )
651       &     CALL DEBUG_CALL('PP81_CALC',myThid)       &     CALL DEBUG_CALL('PP81_CALC',myThid)
652  #endif  #endif
653            CALL PP81_CALC(            CALL PP81_CALC(
# Line 547  C--     Compute PP81 mixing coefficients Line 659  C--     Compute PP81 mixing coefficients
659  C--     Compute MY82 mixing coefficients  C--     Compute MY82 mixing coefficients
660          IF (useMY82) THEN          IF (useMY82) THEN
661  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
662            IF ( debugLevel .GE. debLevB )            IF ( debugLevel .GE. debLevB )
663       &     CALL DEBUG_CALL('MY82_CALC',myThid)       &     CALL DEBUG_CALL('MY82_CALC',myThid)
664  #endif  #endif
665            CALL MY82_CALC(            CALL MY82_CALC(
# Line 559  C--     Compute MY82 mixing coefficients Line 671  C--     Compute MY82 mixing coefficients
671  C--     Compute GGL90 mixing coefficients  C--     Compute GGL90 mixing coefficients
672          IF (useGGL90) THEN          IF (useGGL90) THEN
673  #ifdef ALLOW_DEBUG  #ifdef ALLOW_DEBUG
674            IF ( debugLevel .GE. debLevB )            IF ( debugLevel .GE. debLevB )
675       &     CALL DEBUG_CALL('GGL90_CALC',myThid)       &     CALL DEBUG_CALL('GGL90_CALC',myThid)
676  #endif  #endif
677              CALL TIMER_START('GGL90_CALC [DO_OCEANIC_PHYS]', myThid)
678            CALL GGL90_CALC(            CALL GGL90_CALC(
679       I                  bi, bj, myTime, myThid )       I                  bi, bj, myTime, myThid )
680              CALL TIMER_STOP ('GGL90_CALC [DO_OCEANIC_PHYS]', myThid)
681          ENDIF          ENDIF
682  #endif /* ALLOW_GGL90 */  #endif /* ALLOW_GGL90 */
683    
684  #ifdef ALLOW_TIMEAVE  #ifdef ALLOW_TIMEAVE
685          IF ( taveFreq.GT. 0. _d 0 .AND. fluidIsWater ) THEN          IF ( taveFreq.GT. 0. _d 0 ) THEN
686            CALL TIMEAVE_SURF_FLUX( bi, bj, myTime, myIter, myThid)            CALL TIMEAVE_SURF_FLUX( bi, bj, myTime, myIter, myThid)
687          ENDIF          ENDIF
688          IF (taveFreq.GT.0. .AND. ivdc_kappa.NE.0.) THEN          IF (taveFreq.GT.0. .AND. ivdc_kappa.NE.0.) THEN
# Line 577  C--     Compute GGL90 mixing coefficient Line 691  C--     Compute GGL90 mixing coefficient
691          ENDIF          ENDIF
692  #endif /* ALLOW_TIMEAVE */  #endif /* ALLOW_TIMEAVE */
693    
694    #ifdef ALLOW_GMREDI
695    #ifdef ALLOW_AUTODIFF_TAMC
696    # ifndef GM_EXCLUDE_CLIPPING
697    cph storing here is needed only for one GMREDI_OPTIONS:
698    cph define GM_BOLUS_ADVEC
699    cph keep it although TAF says you dont need to.
700    cph but I have avoided the #ifdef for now, in case more things change
701    CADJ STORE sigmaX(:,:,:)        = comlev1_bibj, key=itdkey,
702    CADJ &     kind = isbyte
703    CADJ STORE sigmaY(:,:,:)        = comlev1_bibj, key=itdkey,
704    CADJ &     kind = isbyte
705    CADJ STORE sigmaR(:,:,:)        = comlev1_bibj, key=itdkey,
706    CADJ &     kind = isbyte
707    # endif
708    #endif /* ALLOW_AUTODIFF_TAMC */
709    
710    C--     Calculate iso-neutral slopes for the GM/Redi parameterisation
711            IF (useGMRedi) THEN
712    #ifdef ALLOW_DEBUG
713              IF ( debugLevel .GE. debLevB )
714         &     CALL DEBUG_CALL('GMREDI_CALC_TENSOR',myThid)
715    #endif
716              CALL GMREDI_CALC_TENSOR(
717         I             iMin, iMax, jMin, jMax,
718         I             sigmaX, sigmaY, sigmaR,
719         I             bi, bj, myTime, myIter, myThid )
720    #ifdef ALLOW_AUTODIFF_TAMC
721            ELSE
722              CALL GMREDI_CALC_TENSOR_DUMMY(
723         I             iMin, iMax, jMin, jMax,
724         I             sigmaX, sigmaY, sigmaR,
725         I             bi, bj, myTime, myIter, myThid )
726    #endif /* ALLOW_AUTODIFF_TAMC */
727            ENDIF
728    #endif /* ALLOW_GMREDI */
729    
730    #ifdef ALLOW_DOWN_SLOPE
731            IF ( useDOWN_SLOPE ) THEN
732    C--     Calculate Downsloping Flow for Down_Slope parameterization
733             IF ( usingPCoords ) THEN
734              CALL DWNSLP_CALC_FLOW(
735         I                bi, bj, kSurfC, rhoInSitu,
736         I                myTime, myIter, myThid )
737             ELSE
738              CALL DWNSLP_CALC_FLOW(
739         I                bi, bj, kLowC, rhoInSitu,
740         I                myTime, myIter, myThid )
741             ENDIF
742            ENDIF
743    #endif /* ALLOW_DOWN_SLOPE */
744    
745    #ifndef ALLOW_AUTODIFF_TAMC
746    C---  if fluid Is Water: end
747            ENDIF
748    #endif
749    
750  C--   end bi,bj loops.  C--   end bi,bj loops.
751         ENDDO         ENDDO
752        ENDDO        ENDDO
753    
754    #ifdef  ALLOW_KPP
755          IF (useKPP) THEN
756            CALL KPP_DO_EXCH( myThid )
757          ENDIF
758    #endif  /* ALLOW_KPP */
759    
760  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
761        IF ( fluidIsWater .AND. useDiagnostics ) THEN        IF ( fluidIsWater .AND. useDiagnostics ) THEN
762            CALL DIAGS_RHO_G(
763         I                    rhoInSitu, uVel, vVel,
764         I                    myTime, myIter, myThid )
765          CALL DIAGS_OCEANIC_SURF_FLUX( myTime, myIter, myThid )          CALL DIAGS_OCEANIC_SURF_FLUX( myTime, myIter, myThid )
766        ENDIF        ENDIF
767        IF ( ivdc_kappa.NE.0 .AND. useDiagnostics ) THEN        IF ( ivdc_kappa.NE.0 .AND. useDiagnostics ) THEN
768          CALL DIAGNOSTICS_FILL( IVDConvCount,'CONVADJ ',          CALL DIAGNOSTICS_FILL( IVDConvCount, 'CONVADJ ',
769       &                         0, Nr, 0, 1, 1, myThid )       &                               0, Nr, 0, 1, 1, myThid )
770        ENDIF        ENDIF
771  #endif  #endif
772    
Legend:
Removed from v.1.31  
changed lines
  Added in v.1.86
  ViewVC Help
Powered by ViewVC 1.1.22