/[MITgcm]/MITgcm/model/src/do_oceanic_phys.F
ViewVC logotype

Annotation of /MITgcm/model/src/do_oceanic_phys.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph

Revision 1.131 - (hide annotations) (download)
Sun Jul 7 22:27:30 2013 UTC (10 years, 11 months ago) by jmc
Branch: MAIN
Changes since 1.130: +81 -40 lines 
when using pkg/offline, enable to calculate GMRedi tensor, KPP mixing and
 convective index when the corresponding file(s) is/are not specified.
1 jmc 1.131 C $Header: /u/gcmpack/MITgcm/model/src/do_oceanic_phys.F,v 1.130 2013/07/04 23:05:09 jmc Exp $
2 jmc 1.1 C $Name: $
3    
4     #include "PACKAGES_CONFIG.h"
5     #include "CPP_OPTIONS.h"
6    
7     #ifdef ALLOW_AUTODIFF_TAMC
8     # ifdef ALLOW_GMREDI
9     # include "GMREDI_OPTIONS.h"
10     # endif
11     # ifdef ALLOW_KPP
12     # include "KPP_OPTIONS.h"
13     # endif
14 jmc 1.29 # ifdef ALLOW_SEAICE
15     # include "SEAICE_OPTIONS.h"
16     # endif
17 gforget 1.117 # ifdef ALLOW_EXF
18     # include "EXF_OPTIONS.h"
19     # endif
20 jmc 1.1 #endif /* ALLOW_AUTODIFF_TAMC */
21    
22     CBOP
23     C !ROUTINE: DO_OCEANIC_PHYS
24     C !INTERFACE:
25     SUBROUTINE DO_OCEANIC_PHYS(myTime, myIter, myThid)
26     C !DESCRIPTION: \bv
27     C *==========================================================*
28 jmc 1.28 C | SUBROUTINE DO_OCEANIC_PHYS
29     C | o Controlling routine for oceanic physics and
30 jmc 1.1 C | parameterization
31     C *==========================================================*
32     C | o originally, part of S/R thermodynamics
33     C *==========================================================*
34     C \ev
35    
36     C !USES:
37     IMPLICIT NONE
38     C == Global variables ===
39     #include "SIZE.h"
40     #include "EEPARAMS.h"
41     #include "PARAMS.h"
42 jmc 1.69 #include "GRID.h"
43 jmc 1.1 #include "DYNVARS.h"
44 jmc 1.20 #ifdef ALLOW_TIMEAVE
45 jmc 1.131 # include "TIMEAVE_STATV.h"
46     #endif
47     #ifdef ALLOW_OFFLINE
48     # include "OFFLINE_SWITCH.h"
49 jmc 1.20 #endif
50 jmc 1.1
51     #ifdef ALLOW_AUTODIFF_TAMC
52 heimbach 1.80 # include "AUTODIFF_MYFIELDS.h"
53 jmc 1.1 # include "tamc.h"
54     # include "tamc_keys.h"
55     # include "FFIELDS.h"
56 heimbach 1.54 # include "SURFACE.h"
57 jmc 1.1 # include "EOS.h"
58     # ifdef ALLOW_KPP
59     # include "KPP.h"
60     # endif
61 gforget 1.91 # ifdef ALLOW_GGL90
62     # include "GGL90.h"
63     # endif
64 jmc 1.1 # ifdef ALLOW_GMREDI
65     # include "GMREDI.h"
66     # endif
67     # ifdef ALLOW_EBM
68     # include "EBM.h"
69     # endif
70 jmc 1.29 # ifdef ALLOW_EXF
71     # include "ctrl.h"
72 jmc 1.40 # include "EXF_FIELDS.h"
73 jmc 1.29 # ifdef ALLOW_BULKFORMULAE
74 jmc 1.40 # include "EXF_CONSTANTS.h"
75 jmc 1.29 # endif
76     # endif
77     # ifdef ALLOW_SEAICE
78 jmc 1.114 # include "SEAICE_SIZE.h"
79 jmc 1.29 # include "SEAICE.h"
80 gforget 1.124 # include "SEAICE_PARAMS.h"
81 jmc 1.29 # endif
82 heimbach 1.105 # ifdef ALLOW_THSICE
83     # include "THSICE_VARS.h"
84     # endif
85 heimbach 1.75 # ifdef ALLOW_SALT_PLUME
86     # include "SALT_PLUME.h"
87     # endif
88 jmc 1.1 #endif /* ALLOW_AUTODIFF_TAMC */
89    
90     C !INPUT/OUTPUT PARAMETERS:
91     C == Routine arguments ==
92 jmc 1.18 C myTime :: Current time in simulation
93     C myIter :: Current iteration number in simulation
94     C myThid :: Thread number for this instance of the routine.
95 jmc 1.1 _RL myTime
96     INTEGER myIter
97     INTEGER myThid
98    
99     C !LOCAL VARIABLES:
100     C == Local variables
101 jmc 1.47 C rhoK, rhoKm1 :: Density at current level, and level above
102 jmc 1.18 C iMin, iMax :: Ranges and sub-block indices on which calculations
103 jmc 1.1 C jMin, jMax are applied.
104 jmc 1.18 C bi, bj :: tile indices
105     C i,j,k :: loop indices
106 jmc 1.47 _RL rhoKp1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
107     _RL rhoKm1 (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
108 jmc 1.1 _RL sigmaX (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
109     _RL sigmaY (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
110     _RL sigmaR (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
111     INTEGER iMin, iMax
112     INTEGER jMin, jMax
113     INTEGER bi, bj
114 jmc 1.18 INTEGER i, j, k
115 jmc 1.17 INTEGER doDiagsRho
116 jmc 1.131 LOGICAL calcGMRedi, calcKPP, calcConvect
117 jmc 1.17 #ifdef ALLOW_DIAGNOSTICS
118     LOGICAL DIAGNOSTICS_IS_ON
119     EXTERNAL DIAGNOSTICS_IS_ON
120     #endif /* ALLOW_DIAGNOSTICS */
121 jmc 1.1
122     CEOP
123    
124 heimbach 1.12 #ifdef ALLOW_AUTODIFF_TAMC
125     C-- dummy statement to end declaration part
126     itdkey = 1
127     #endif /* ALLOW_AUTODIFF_TAMC */
128    
129 jmc 1.1 #ifdef ALLOW_DEBUG
130 jmc 1.96 IF (debugMode) CALL DEBUG_ENTER('DO_OCEANIC_PHYS',myThid)
131 jmc 1.1 #endif
132 jmc 1.36
133 jmc 1.17 doDiagsRho = 0
134     #ifdef ALLOW_DIAGNOSTICS
135     IF ( useDiagnostics .AND. fluidIsWater ) THEN
136 jmc 1.110 IF ( DIAGNOSTICS_IS_ON('MXLDEPTH',myThid) )
137 jmc 1.71 & doDiagsRho = doDiagsRho + 1
138     IF ( DIAGNOSTICS_IS_ON('DRHODR ',myThid) )
139     & doDiagsRho = doDiagsRho + 2
140 jmc 1.110 IF ( DIAGNOSTICS_IS_ON('WdRHO_P ',myThid) )
141 jmc 1.71 & doDiagsRho = doDiagsRho + 4
142 jmc 1.110 IF ( DIAGNOSTICS_IS_ON('WdRHOdP ',myThid) )
143     & doDiagsRho = doDiagsRho + 8
144 jmc 1.17 ENDIF
145     #endif /* ALLOW_DIAGNOSTICS */
146    
147 jmc 1.131 calcGMRedi = useGMRedi
148     calcKPP = useKPP
149     calcConvect = ivdc_kappa.NE.0.
150     #ifdef ALLOW_OFFLINE
151     IF ( useOffLine ) THEN
152     calcGMRedi = useGMRedi .AND. .NOT.offlineLoadGMRedi
153     calcKPP = useKPP .AND. .NOT.offlineLoadKPP
154     calcConvect=calcConvect.AND. .NOT.offlineLoadConvec
155     ENDIF
156     #endif /* ALLOW_OFFLINE */
157    
158 jmc 1.82 #ifdef ALLOW_OBCS
159     IF (useOBCS) THEN
160     C-- Calculate future values on open boundaries
161     C-- moved before SEAICE_MODEL call since SEAICE_MODEL needs seaice-obcs fields
162 heimbach 1.100 # ifdef ALLOW_AUTODIFF_TAMC
163     CADJ STORE theta = comlev1, key=ikey_dynamics, kind=isbyte
164     CADJ STORE salt = comlev1, key=ikey_dynamics, kind=isbyte
165     # endif
166     # ifdef ALLOW_DEBUG
167 jmc 1.96 IF (debugMode) CALL DEBUG_CALL('OBCS_CALC',myThid)
168 heimbach 1.100 # endif
169 jmc 1.120 CALL OBCS_CALC( myTime+deltaTClock, myIter+1,
170 jahn 1.83 I uVel, vVel, wVel, theta, salt, myThid )
171 jmc 1.82 ENDIF
172     #endif /* ALLOW_OBCS */
173 jmc 1.69
174 gforget 1.87 #ifdef ALLOW_AUTODIFF_TAMC
175     # ifdef ALLOW_SALT_PLUME
176     DO bj=myByLo(myThid),myByHi(myThid)
177     DO bi=myBxLo(myThid),myBxHi(myThid)
178     DO j=1-OLy,sNy+OLy
179     DO i=1-OLx,sNx+OLx
180     saltPlumeDepth(i,j,bi,bj) = 0. _d 0
181     saltPlumeFlux(i,j,bi,bj) = 0. _d 0
182     ENDDO
183     ENDDO
184     ENDDO
185     ENDDO
186     # endif
187     #endif /* ALLOW_AUTODIFF_TAMC */
188    
189 dimitri 1.113 #ifdef ALLOW_FRAZIL
190     IF ( useFRAZIL ) THEN
191     C-- Freeze water in the ocean interior and let it rise to the surface
192     CALL FRAZIL_CALC_RHS( myTime, myIter, myThid )
193     ENDIF
194     #endif /* ALLOW_FRAZIL */
195    
196 jmc 1.121 #ifndef OLD_THSICE_CALL_SEQUENCE
197     #if (defined ALLOW_THSICE) && !(defined ALLOW_ATM2D)
198     IF ( useThSIce .AND. fluidIsWater ) THEN
199 jmc 1.122 # ifdef ALLOW_AUTODIFF_TAMC
200     CADJ STORE uice,vice = comlev1, key = ikey_dynamics,
201     CADJ & kind = isbyte
202     CADJ STORE iceMask,iceHeight = comlev1, key = ikey_dynamics,
203     CADJ & kind = isbyte
204     CADJ STORE snowHeight, Tsrf = comlev1, key = ikey_dynamics,
205     CADJ & kind = isbyte
206     CADJ STORE Qice1, Qice2 = comlev1, key = ikey_dynamics,
207     CADJ & kind = isbyte
208     CADJ STORE sHeating, snowAge = comlev1, key = ikey_dynamics,
209     CADJ & kind = isbyte
210 heimbach 1.125 CADJ STORE hocemxl = comlev1, key = ikey_dynamics,
211     CADJ & kind = isbyte
212 jmc 1.128 CADJ STORE icflxsw = comlev1, key = ikey_dynamics,
213 heimbach 1.126 CADJ & kind = isbyte
214 jmc 1.122 CADJ STORE salt,theta = comlev1, key = ikey_dynamics,
215     CADJ & kind = isbyte
216     CADJ STORE uvel,vvel = comlev1, key = ikey_dynamics,
217     CADJ & kind = isbyte
218     CADJ STORE qnet,qsw, empmr = comlev1, key = ikey_dynamics,
219     CADJ & kind = isbyte
220     CADJ STORE atemp,aqh,precip = comlev1, key = ikey_dynamics,
221     CADJ & kind = isbyte
222     CADJ STORE swdown,lwdown = comlev1, key = ikey_dynamics,
223     CADJ & kind = isbyte
224     # ifdef NONLIN_FRSURF
225     CADJ STORE hFac_surfC = comlev1, key = ikey_dynamics,
226     CADJ & kind = isbyte
227     # endif
228 heimbach 1.126 # endif /* ALLOW_AUTODIFF_TAMC */
229 jmc 1.121 # ifdef ALLOW_DEBUG
230     IF (debugMode) CALL DEBUG_CALL('THSICE_MAIN',myThid)
231     # endif
232     C-- Step forward Therm.Sea-Ice variables
233     C and modify forcing terms including effects from ice
234     CALL TIMER_START('THSICE_MAIN [DO_OCEANIC_PHYS]', myThid)
235     CALL THSICE_MAIN( myTime, myIter, myThid )
236     CALL TIMER_STOP( 'THSICE_MAIN [DO_OCEANIC_PHYS]', myThid)
237     ENDIF
238     #endif /* ALLOW_THSICE */
239     #endif /* ndef OLD_THSICE_CALL_SEQUENCE */
240    
241 jmc 1.29 #ifdef ALLOW_SEAICE
242 gforget 1.124 # ifdef ALLOW_AUTODIFF_TAMC
243     CADJ STORE area = comlev1, key=ikey_dynamics, kind=isbyte
244     CADJ STORE fu,fv = comlev1, key=ikey_dynamics, kind=isbyte
245     CADJ STORE qnet = comlev1, key=ikey_dynamics, kind=isbyte
246     CADJ STORE qsw = comlev1, key=ikey_dynamics, kind=isbyte
247     CADJ STORE theta = comlev1, key=ikey_dynamics, kind=isbyte
248     CADJ STORE salt = comlev1, key=ikey_dynamics, kind=isbyte
249     #if (defined ALLOW_EXF) && (defined ALLOW_ATM_TEMP)
250     CADJ STORE evap = comlev1, key=ikey_dynamics, kind=isbyte
251     #endif
252     IF ( .NOT.useSEAICE ) THEN
253     IF ( SEAICEadjMODE .EQ. -1 ) THEN
254     CALL SEAICE_FAKE( myTime, myIter, myThid )
255     ENDIF
256     ENDIF
257     CADJ STORE area = comlev1, key=ikey_dynamics, kind=isbyte
258     CADJ STORE fu,fv = comlev1, key=ikey_dynamics, kind=isbyte
259     CADJ STORE qnet = comlev1, key=ikey_dynamics, kind=isbyte
260     CADJ STORE qsw = comlev1, key=ikey_dynamics, kind=isbyte
261     CADJ STORE theta = comlev1, key=ikey_dynamics, kind=isbyte
262     CADJ STORE salt = comlev1, key=ikey_dynamics, kind=isbyte
263     #if (defined ALLOW_EXF) && (defined ALLOW_ATM_TEMP)
264     CADJ STORE evap = comlev1, key=ikey_dynamics, kind=isbyte
265     #endif
266     # endif /* ALLOW_AUTODIFF_TAMC */
267     #endif /* ALLOW_SEAICE */
268    
269     #ifdef ALLOW_SEAICE
270 jmc 1.29 IF ( useSEAICE ) THEN
271 heimbach 1.62 # ifdef ALLOW_AUTODIFF_TAMC
272 heimbach 1.65 cph-adj-test(
273 heimbach 1.81 CADJ STORE area = comlev1, key=ikey_dynamics, kind=isbyte
274     CADJ STORE hsnow = comlev1, key=ikey_dynamics, kind=isbyte
275 heimbach 1.88 CADJ STORE heff = comlev1, key=ikey_dynamics, kind=isbyte
276 heimbach 1.81 CADJ STORE empmr,qsw,theta = comlev1, key = ikey_dynamics,
277 heimbach 1.77 CADJ & kind = isbyte
278 heimbach 1.65 cph-adj-test)
279 heimbach 1.77 CADJ STORE atemp,aqh,precip = comlev1, key = ikey_dynamics,
280     CADJ & kind = isbyte
281     CADJ STORE swdown,lwdown = comlev1, key = ikey_dynamics,
282     CADJ & kind = isbyte
283 heimbach 1.34 cph# ifdef EXF_READ_EVAP
284 heimbach 1.77 CADJ STORE evap = comlev1, key = ikey_dynamics,
285     CADJ & kind = isbyte
286 heimbach 1.34 cph# endif
287 heimbach 1.77 CADJ STORE uvel,vvel = comlev1, key = ikey_dynamics,
288     CADJ & kind = isbyte
289 heimbach 1.95 # ifdef SEAICE_CGRID
290 heimbach 1.93 CADJ STORE stressdivergencex = comlev1, key = ikey_dynamics,
291     CADJ & kind = isbyte
292     CADJ STORE stressdivergencey = comlev1, key = ikey_dynamics,
293     CADJ & kind = isbyte
294     # endif
295 heimbach 1.62 # ifdef SEAICE_ALLOW_DYNAMICS
296 heimbach 1.77 CADJ STORE uice = comlev1, key = ikey_dynamics,
297     CADJ & kind = isbyte
298     CADJ STORE vice = comlev1, key = ikey_dynamics,
299     CADJ & kind = isbyte
300 heimbach 1.62 # ifdef SEAICE_ALLOW_EVP
301 heimbach 1.77 CADJ STORE seaice_sigma1 = comlev1, key = ikey_dynamics,
302     CADJ & kind = isbyte
303     CADJ STORE seaice_sigma2 = comlev1, key = ikey_dynamics,
304     CADJ & kind = isbyte
305     CADJ STORE seaice_sigma12 = comlev1, key = ikey_dynamics,
306     CADJ & kind = isbyte
307 heimbach 1.62 # endif
308     # endif
309 heimbach 1.104 cph# ifdef SEAICE_SALINITY
310 heimbach 1.77 CADJ STORE salt = comlev1, key = ikey_dynamics,
311     CADJ & kind = isbyte
312 heimbach 1.104 cph# endif
313 heimbach 1.62 # ifdef ATMOSPHERIC_LOADING
314 heimbach 1.77 CADJ STORE pload = comlev1, key = ikey_dynamics,
315     CADJ & kind = isbyte
316     CADJ STORE siceload = comlev1, key = ikey_dynamics,
317     CADJ & kind = isbyte
318 heimbach 1.62 # endif
319     # ifdef NONLIN_FRSURF
320 heimbach 1.77 CADJ STORE recip_hfacc = comlev1, key = ikey_dynamics,
321     CADJ & kind = isbyte
322 heimbach 1.62 # endif
323 heimbach 1.78 # ifdef ANNUAL_BALANCE
324     CADJ STORE balance_itcount = comlev1, key = ikey_dynamics,
325     CADJ & kind = isbyte
326     # endif /* ANNUAL_BALANCE */
327 heimbach 1.126 # ifdef ALLOW_THSICE
328     CADJ STORE fu, fv = comlev1, key = ikey_dynamics,
329     CADJ & kind = isbyte
330     # endif
331     # endif /* ALLOW_AUTODIFF_TAMC */
332 heimbach 1.62 # ifdef ALLOW_DEBUG
333 jmc 1.96 IF (debugMode) CALL DEBUG_CALL('SEAICE_MODEL',myThid)
334 heimbach 1.62 # endif
335 jmc 1.29 CALL TIMER_START('SEAICE_MODEL [DO_OCEANIC_PHYS]', myThid)
336     CALL SEAICE_MODEL( myTime, myIter, myThid )
337     CALL TIMER_STOP ('SEAICE_MODEL [DO_OCEANIC_PHYS]', myThid)
338 heimbach 1.62 # ifdef ALLOW_COST
339 heimbach 1.57 CALL SEAICE_COST_SENSI ( myTime, myIter, myThid )
340 heimbach 1.62 # endif
341 heimbach 1.35 ENDIF
342 jmc 1.29 #endif /* ALLOW_SEAICE */
343    
344 heimbach 1.64 #ifdef ALLOW_AUTODIFF_TAMC
345 heimbach 1.77 CADJ STORE sst, sss = comlev1, key = ikey_dynamics,
346     CADJ & kind = isbyte
347     CADJ STORE qsw = comlev1, key = ikey_dynamics,
348     CADJ & kind = isbyte
349 heimbach 1.64 # ifdef ALLOW_SEAICE
350 heimbach 1.77 CADJ STORE area = comlev1, key = ikey_dynamics,
351     CADJ & kind = isbyte
352 heimbach 1.64 # endif
353     #endif
354    
355 jmc 1.121 #ifdef OLD_THSICE_CALL_SEQUENCE
356 jscott 1.30 #if (defined ALLOW_THSICE) && !(defined ALLOW_ATM2D)
357 jmc 1.14 IF ( useThSIce .AND. fluidIsWater ) THEN
358 heimbach 1.101 # ifdef ALLOW_AUTODIFF_TAMC
359     cph(
360     # ifdef NONLIN_FRSURF
361     CADJ STORE uice,vice = comlev1, key = ikey_dynamics,
362     CADJ & kind = isbyte
363     CADJ STORE salt,theta = comlev1, key = ikey_dynamics,
364     CADJ & kind = isbyte
365     CADJ STORE qnet,qsw, empmr = comlev1, key = ikey_dynamics,
366     CADJ & kind = isbyte
367     CADJ STORE hFac_surfC = comlev1, key = ikey_dynamics,
368     CADJ & kind = isbyte
369     # endif
370     # endif
371     # ifdef ALLOW_DEBUG
372 jmc 1.96 IF (debugMode) CALL DEBUG_CALL('THSICE_MAIN',myThid)
373 heimbach 1.101 # endif
374 jmc 1.5 C-- Step forward Therm.Sea-Ice variables
375     C and modify forcing terms including effects from ice
376     CALL TIMER_START('THSICE_MAIN [DO_OCEANIC_PHYS]', myThid)
377     CALL THSICE_MAIN( myTime, myIter, myThid )
378     CALL TIMER_STOP( 'THSICE_MAIN [DO_OCEANIC_PHYS]', myThid)
379     ENDIF
380     #endif /* ALLOW_THSICE */
381 jmc 1.121 #endif /* OLD_THSICE_CALL_SEQUENCE */
382 jmc 1.5
383 mlosch 1.21 #ifdef ALLOW_SHELFICE
384 heimbach 1.92 # ifdef ALLOW_AUTODIFF_TAMC
385     CADJ STORE salt, theta = comlev1, key = ikey_dynamics,
386     CADJ & kind = isbyte
387     # endif
388 mlosch 1.21 IF ( useShelfIce .AND. fluidIsWater ) THEN
389     #ifdef ALLOW_DEBUG
390 jmc 1.96 IF (debugMode) CALL DEBUG_CALL('SHELFICE_THERMODYNAMICS',myThid)
391 mlosch 1.21 #endif
392 jmc 1.47 C compute temperature and (virtual) salt flux at the
393 mlosch 1.21 C shelf-ice ocean interface
394     CALL TIMER_START('SHELFICE_THERMODYNAMICS [DO_OCEANIC_PHYS]',
395     & myThid)
396     CALL SHELFICE_THERMODYNAMICS( myTime, myIter, myThid )
397     CALL TIMER_STOP( 'SHELFICE_THERMODYNAMICS [DO_OCEANIC_PHYS]',
398     & myThid)
399     ENDIF
400     #endif /* ALLOW_SHELFICE */
401    
402 dimitri 1.85 #ifdef ALLOW_ICEFRONT
403     IF ( useICEFRONT .AND. fluidIsWater ) THEN
404     #ifdef ALLOW_DEBUG
405 jmc 1.96 IF (debugMode) CALL DEBUG_CALL('ICEFRONT_THERMODYNAMICS',myThid)
406 dimitri 1.85 #endif
407     C compute temperature and (virtual) salt flux at the
408     C ice-front ocean interface
409     CALL TIMER_START('ICEFRONT_THERMODYNAMICS [DO_OCEANIC_PHYS]',
410     & myThid)
411     CALL ICEFRONT_THERMODYNAMICS( myTime, myIter, myThid )
412     CALL TIMER_STOP( 'ICEFRONT_THERMODYNAMICS [DO_OCEANIC_PHYS]',
413     & myThid)
414     ENDIF
415     #endif /* ALLOW_ICEFRONT */
416    
417 jmc 1.112 #ifdef ALLOW_SALT_PLUME
418     IF ( useSALT_PLUME ) THEN
419     CALL SALT_PLUME_DO_EXCH( myTime, myIter, myThid )
420     ENDIF
421     #endif /* ALLOW_SALT_PLUME */
422    
423 jmc 1.5 C-- Freeze water at the surface
424 heimbach 1.104 IF ( allowFreezing ) THEN
425 jmc 1.5 #ifdef ALLOW_AUTODIFF_TAMC
426 heimbach 1.77 CADJ STORE theta = comlev1, key = ikey_dynamics,
427     CADJ & kind = isbyte
428 jmc 1.5 #endif
429 jmc 1.129 CALL FREEZE_SURFACE( myTime, myIter, myThid )
430 jmc 1.5 ENDIF
431    
432 jmc 1.28 #ifdef ALLOW_OCN_COMPON_INTERF
433 jmc 1.5 C-- Apply imported data (from coupled interface) to forcing fields
434 jmc 1.28 C jmc: do not know precisely where to put this call (bf or af thSIce ?)
435 jmc 1.36 IF ( useCoupler ) THEN
436 jmc 1.5 CALL OCN_APPLY_IMPORT( .TRUE., myTime, myIter, myThid )
437 jmc 1.36 ENDIF
438 jmc 1.28 #endif /* ALLOW_OCN_COMPON_INTERF */
439 jmc 1.5
440 jmc 1.130 iMin = 1-OLx
441     iMax = sNx+OLx
442     jMin = 1-OLy
443     jMax = sNy+OLy
444    
445     C--- Determines forcing terms based on external fields
446     C relaxation terms, etc.
447     #ifdef ALLOW_DEBUG
448     IF (debugMode) CALL DEBUG_CALL('EXTERNAL_FORCING_SURF',myThid)
449     #endif
450     #ifdef ALLOW_AUTODIFF_TAMC
451     CADJ STORE salt, theta = comlev1, key = ikey_dynamics,
452     CADJ & kind = isbyte
453     #else /* ALLOW_AUTODIFF_TAMC */
454     C-- if fluid is not water, by-pass surfaceForcing, find_rho, gmredi
455     C and all vertical mixing schemes, but keep OBCS_CALC
456 jmc 1.127 IF ( fluidIsWater ) THEN
457 jmc 1.130 #endif /* ALLOW_AUTODIFF_TAMC */
458     CALL EXTERNAL_FORCING_SURF(
459     I iMin, iMax, jMin, jMax,
460     I myTime, myIter, myThid )
461 jmc 1.25
462 jmc 1.1 #ifdef ALLOW_AUTODIFF_TAMC
463     C-- HPF directive to help TAMC
464     CHPF$ INDEPENDENT
465     #endif /* ALLOW_AUTODIFF_TAMC */
466     DO bj=myByLo(myThid),myByHi(myThid)
467     #ifdef ALLOW_AUTODIFF_TAMC
468 heimbach 1.15 C-- HPF directive to help TAMC
469     CHPF$ INDEPENDENT
470 jmc 1.1 #endif /* ALLOW_AUTODIFF_TAMC */
471     DO bi=myBxLo(myThid),myBxHi(myThid)
472    
473     #ifdef ALLOW_AUTODIFF_TAMC
474     act1 = bi - myBxLo(myThid)
475     max1 = myBxHi(myThid) - myBxLo(myThid) + 1
476     act2 = bj - myByLo(myThid)
477     max2 = myByHi(myThid) - myByLo(myThid) + 1
478     act3 = myThid - 1
479     max3 = nTx*nTy
480     act4 = ikey_dynamics - 1
481     itdkey = (act1 + 1) + act2*max1
482     & + act3*max1*max2
483     & + act4*max1*max2*max3
484 jmc 1.74 #endif /* ALLOW_AUTODIFF_TAMC */
485 jmc 1.1
486     C-- Set up work arrays with valid (i.e. not NaN) values
487     C These inital values do not alter the numerical results. They
488     C just ensure that all memory references are to valid floating
489     C point numbers. This prevents spurious hardware signals due to
490     C uninitialised but inert locations.
491 jmc 1.131 DO k=1,Nr
492     DO j=1-OLy,sNy+OLy
493     DO i=1-OLx,sNx+OLx
494     C This is currently used by GMRedi, IVDC, MXL-depth and Diagnostics
495     sigmaX(i,j,k) = 0. _d 0
496     sigmaY(i,j,k) = 0. _d 0
497     sigmaR(i,j,k) = 0. _d 0
498     ENDDO
499     ENDDO
500     ENDDO
501 jmc 1.1
502 jmc 1.69 #ifdef ALLOW_AUTODIFF_TAMC
503 jmc 1.1 DO j=1-OLy,sNy+OLy
504     DO i=1-OLx,sNx+OLx
505 jmc 1.69 rhoKm1 (i,j) = 0. _d 0
506 jmc 1.47 rhoKp1 (i,j) = 0. _d 0
507 jmc 1.1 ENDDO
508     ENDDO
509 jmc 1.131 cph all the following init. are necessary for TAF
510     cph although some of these are re-initialised later.
511 jmc 1.1 DO k=1,Nr
512     DO j=1-OLy,sNy+OLy
513     DO i=1-OLx,sNx+OLx
514 heimbach 1.109 rhoInSitu(i,j,k,bi,bj) = 0.
515 jmc 1.131 # ifdef ALLOW_GGL90
516     GGL90viscArU(i,j,k,bi,bj) = 0. _d 0
517     GGL90viscArV(i,j,k,bi,bj) = 0. _d 0
518     GGL90diffKr(i,j,k,bi,bj) = 0. _d 0
519     # endif /* ALLOW_GGL90 */
520     ENDDO
521     ENDDO
522     ENDDO
523     #ifdef ALLOW_OFFLINE
524     IF ( calcConvect ) THEN
525     #endif
526     DO k=1,Nr
527     DO j=1-OLy,sNy+OLy
528     DO i=1-OLx,sNx+OLx
529 jmc 1.1 IVDConvCount(i,j,k,bi,bj) = 0.
530 jmc 1.131 ENDDO
531     ENDDO
532     ENDDO
533     #ifdef ALLOW_OFFLINE
534     ENDIF
535     IF ( calcGMRedi ) THEN
536     #endif
537 jmc 1.1 # ifdef ALLOW_GMREDI
538 jmc 1.131 DO k=1,Nr
539     DO j=1-OLy,sNy+OLy
540     DO i=1-OLx,sNx+OLx
541 jmc 1.1 Kwx(i,j,k,bi,bj) = 0. _d 0
542     Kwy(i,j,k,bi,bj) = 0. _d 0
543     Kwz(i,j,k,bi,bj) = 0. _d 0
544     # ifdef GM_NON_UNITY_DIAGONAL
545     Kux(i,j,k,bi,bj) = 0. _d 0
546     Kvy(i,j,k,bi,bj) = 0. _d 0
547     # endif
548     # ifdef GM_EXTRA_DIAGONAL
549     Kuz(i,j,k,bi,bj) = 0. _d 0
550     Kvz(i,j,k,bi,bj) = 0. _d 0
551     # endif
552     # ifdef GM_BOLUS_ADVEC
553     GM_PsiX(i,j,k,bi,bj) = 0. _d 0
554     GM_PsiY(i,j,k,bi,bj) = 0. _d 0
555     # endif
556     # ifdef GM_VISBECK_VARIABLE_K
557     VisbeckK(i,j,bi,bj) = 0. _d 0
558     # endif
559 jmc 1.131 ENDDO
560     ENDDO
561     ENDDO
562 jmc 1.1 # endif /* ALLOW_GMREDI */
563 jmc 1.131 #ifdef ALLOW_OFFLINE
564     ENDIF
565     IF ( calcKPP ) THEN
566     #endif
567 heimbach 1.42 # ifdef ALLOW_KPP
568 jmc 1.131 DO k=1,Nr
569     DO j=1-OLy,sNy+OLy
570     DO i=1-OLx,sNx+OLx
571 heimbach 1.42 KPPdiffKzS(i,j,k,bi,bj) = 0. _d 0
572     KPPdiffKzT(i,j,k,bi,bj) = 0. _d 0
573 jmc 1.1 ENDDO
574     ENDDO
575     ENDDO
576 jmc 1.131 # endif /* ALLOW_KPP */
577     #ifdef ALLOW_OFFLINE
578     ENDIF
579     #endif
580     #endif /* ALLOW_AUTODIFF_TAMC */
581 jmc 1.1
582     #ifdef ALLOW_AUTODIFF_TAMC
583 jmc 1.96 CADJ STORE theta(:,:,:,bi,bj) = comlev1_bibj, key=itdkey,
584 heimbach 1.77 CADJ & kind = isbyte
585 jmc 1.96 CADJ STORE salt (:,:,:,bi,bj) = comlev1_bibj, key=itdkey,
586 heimbach 1.77 CADJ & kind = isbyte
587 heimbach 1.12 CADJ STORE totphihyd(:,:,:,bi,bj)
588 jmc 1.96 CADJ & = comlev1_bibj, key=itdkey,
589 heimbach 1.77 CADJ & kind = isbyte
590 heimbach 1.10 # ifdef ALLOW_KPP
591 jmc 1.96 CADJ STORE uvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey,
592 heimbach 1.77 CADJ & kind = isbyte
593 jmc 1.96 CADJ STORE vvel (:,:,:,bi,bj) = comlev1_bibj, key=itdkey,
594 heimbach 1.77 CADJ & kind = isbyte
595 heimbach 1.10 # endif
596 heimbach 1.115 # ifdef ALLOW_SALT_PLUME
597     CADJ STORE saltplumedepth(:,:,bi,bj) = comlev1_bibj, key=itdkey,
598     CADJ & kind = isbyte
599     # endif
600 jmc 1.1 #endif /* ALLOW_AUTODIFF_TAMC */
601    
602 jmc 1.71 C-- Always compute density (stored in common block) here; even when it is not
603     C needed here, will be used anyway in calc_phi_hyd (data flow easier this way)
604     #ifdef ALLOW_DEBUG
605 jmc 1.110 IF (debugMode) CALL DEBUG_CALL('FIND_RHO_2D (xNr)',myThid)
606 jmc 1.71 #endif
607     #ifdef ALLOW_AUTODIFF_TAMC
608 jmc 1.110 IF ( fluidIsWater ) THEN
609 jmc 1.71 #endif /* ALLOW_AUTODIFF_TAMC */
610 jmc 1.69 #ifdef ALLOW_DOWN_SLOPE
611 jmc 1.110 IF ( useDOWN_SLOPE ) THEN
612     DO k=1,Nr
613 jmc 1.69 CALL DWNSLP_CALC_RHO(
614     I theta, salt,
615 jmc 1.71 O rhoInSitu(1-OLx,1-OLy,k,bi,bj),
616 jmc 1.69 I k, bi, bj, myTime, myIter, myThid )
617 jmc 1.110 ENDDO
618     ENDIF
619 jmc 1.71 #endif /* ALLOW_DOWN_SLOPE */
620 dimitri 1.107 #ifdef ALLOW_BBL
621 jmc 1.110 IF ( useBBL ) THEN
622 dimitri 1.108 C pkg/bbl requires in-situ bbl density for depths equal to and deeper than the bbl.
623     C To reduce computation and storage requirement, these densities are stored in the
624     C dry grid boxes of rhoInSitu. See BBL_CALC_RHO for details.
625 jmc 1.110 DO k=Nr,1,-1
626 dimitri 1.107 CALL BBL_CALC_RHO(
627     I theta, salt,
628     O rhoInSitu,
629     I k, bi, bj, myTime, myIter, myThid )
630    
631 jmc 1.110 ENDDO
632     ENDIF
633 dimitri 1.107 #endif /* ALLOW_BBL */
634 jmc 1.110 IF ( .NOT. ( useDOWN_SLOPE .OR. useBBL ) ) THEN
635     DO k=1,Nr
636 jmc 1.71 CALL FIND_RHO_2D(
637     I iMin, iMax, jMin, jMax, k,
638     I theta(1-OLx,1-OLy,k,bi,bj),
639     I salt (1-OLx,1-OLy,k,bi,bj),
640     O rhoInSitu(1-OLx,1-OLy,k,bi,bj),
641     I k, bi, bj, myThid )
642 jmc 1.110 ENDDO
643     ENDIF
644 jmc 1.74 #ifdef ALLOW_AUTODIFF_TAMC
645 jmc 1.110 ELSE
646 jmc 1.74 C- fluid is not water:
647 jmc 1.110 DO k=1,Nr
648 jmc 1.74 DO j=1-OLy,sNy+OLy
649     DO i=1-OLx,sNx+OLx
650     rhoInSitu(i,j,k,bi,bj) = 0.
651     ENDDO
652     ENDDO
653 jmc 1.110 ENDDO
654     ENDIF
655     #endif /* ALLOW_AUTODIFF_TAMC */
656    
657     #ifdef ALLOW_DEBUG
658     IF (debugMode) CALL DEBUG_MSG('ENTERING UPWARD K LOOP',myThid)
659     #endif
660    
661     C-- Start of diagnostic loop
662     DO k=Nr,1,-1
663    
664     #ifdef ALLOW_AUTODIFF_TAMC
665     C? Patrick, is this formula correct now that we change the loop range?
666     C? Do we still need this?
667     cph kkey formula corrected.
668     cph Needed for rhoK, rhoKm1, in the case useGMREDI.
669     kkey = (itdkey-1)*Nr + k
670 jmc 1.74 #endif /* ALLOW_AUTODIFF_TAMC */
671 jmc 1.69
672 jmc 1.110 c#ifdef ALLOW_AUTODIFF_TAMC
673     cCADJ STORE theta(:,:,k,bi,bj) = comlev1_bibj_k, key=kkey,
674     cCADJ & kind = isbyte
675     cCADJ STORE salt(:,:,k,bi,bj) = comlev1_bibj_k, key=kkey,
676     cCADJ & kind = isbyte
677     c#endif /* ALLOW_AUTODIFF_TAMC */
678    
679 jmc 1.1 C-- Calculate gradients of potential density for isoneutral
680     C slope terms (e.g. GM/Redi tensor or IVDC diffusivity)
681 jmc 1.131 IF ( calcGMRedi .OR. (k.GT.1 .AND. calcConvect)
682 jmc 1.116 & .OR. usePP81 .OR. useMY82 .OR. useGGL90
683 dimitri 1.61 & .OR. useSALT_PLUME .OR. doDiagsRho.GE.1 ) THEN
684 jmc 1.1 IF (k.GT.1) THEN
685     #ifdef ALLOW_AUTODIFF_TAMC
686 jmc 1.96 CADJ STORE theta(:,:,k-1,bi,bj) = comlev1_bibj_k, key=kkey,
687 heimbach 1.77 CADJ & kind = isbyte
688 jmc 1.96 CADJ STORE salt (:,:,k-1,bi,bj) = comlev1_bibj_k, key=kkey,
689 heimbach 1.77 CADJ & kind = isbyte
690 jmc 1.96 CADJ STORE rhokm1 (bi,bj) = comlev1_bibj_k, key=kkey,
691 heimbach 1.77 CADJ & kind = isbyte
692 jmc 1.1 #endif /* ALLOW_AUTODIFF_TAMC */
693 jmc 1.68 CALL FIND_RHO_2D(
694     I iMin, iMax, jMin, jMax, k,
695     I theta(1-OLx,1-OLy,k-1,bi,bj),
696     I salt (1-OLx,1-OLy,k-1,bi,bj),
697     O rhoKm1,
698     I k-1, bi, bj, myThid )
699 jmc 1.1 ENDIF
700     #ifdef ALLOW_DEBUG
701 jmc 1.96 IF (debugMode) CALL DEBUG_CALL('GRAD_SIGMA',myThid)
702 jmc 1.1 #endif
703 heimbach 1.31 cph Avoid variable aliasing for adjoint !!!
704     DO j=jMin,jMax
705     DO i=iMin,iMax
706 jmc 1.71 rhoKp1(i,j) = rhoInSitu(i,j,k,bi,bj)
707 heimbach 1.31 ENDDO
708     ENDDO
709 jmc 1.1 CALL GRAD_SIGMA(
710     I bi, bj, iMin, iMax, jMin, jMax, k,
711 jmc 1.71 I rhoInSitu(1-OLx,1-OLy,k,bi,bj), rhoKm1, rhoKp1,
712 jmc 1.1 O sigmaX, sigmaY, sigmaR,
713     I myThid )
714 gforget 1.66 #ifdef ALLOW_AUTODIFF_TAMC
715 jmc 1.69 #ifdef GMREDI_WITH_STABLE_ADJOINT
716 gforget 1.66 cgf zero out adjoint fields to stabilize pkg/gmredi adjoint
717     cgf -> cuts adjoint dependency from slope to state
718 jmc 1.69 CALL ZERO_ADJ_LOC( Nr, sigmaX, myThid)
719     CALL ZERO_ADJ_LOC( Nr, sigmaY, myThid)
720     CALL ZERO_ADJ_LOC( Nr, sigmaR, myThid)
721 gforget 1.66 #endif
722     #endif /* ALLOW_AUTODIFF_TAMC */
723 jmc 1.1 ENDIF
724    
725     C-- Implicit Vertical Diffusion for Convection
726 jmc 1.131 IF (k.GT.1 .AND. calcConvect) THEN
727 jmc 1.1 #ifdef ALLOW_DEBUG
728 jmc 1.96 IF (debugMode) CALL DEBUG_CALL('CALC_IVDC',myThid)
729 jmc 1.1 #endif
730     CALL CALC_IVDC(
731     I bi, bj, iMin, iMax, jMin, jMax, k,
732 mlosch 1.111 I sigmaR,
733 jmc 1.1 I myTime, myIter, myThid)
734     ENDIF
735    
736 jmc 1.17 #ifdef ALLOW_DIAGNOSTICS
737 jmc 1.110 IF ( doDiagsRho.GE.4 ) THEN
738     CALL DIAGS_RHO_L( doDiagsRho, k, bi, bj,
739     I rhoInSitu(1-OLx,1-OLy,1,bi,bj),
740 jmc 1.74 I rhoKm1, wVel,
741 jmc 1.71 I myTime, myIter, myThid )
742 jmc 1.17 ENDIF
743     #endif
744    
745 jmc 1.1 C-- end of diagnostic k loop (Nr:1)
746     ENDDO
747    
748 heimbach 1.57 #ifdef ALLOW_AUTODIFF_TAMC
749 jmc 1.69 CADJ STORE IVDConvCount(:,:,:,bi,bj)
750 jmc 1.96 CADJ & = comlev1_bibj, key=itdkey,
751 heimbach 1.77 CADJ & kind = isbyte
752 heimbach 1.57 #endif
753    
754 jmc 1.47 C-- Diagnose Mixed Layer Depth:
755 jmc 1.131 IF ( calcGMRedi .OR. MOD(doDiagsRho,2).EQ.1 ) THEN
756 jmc 1.71 CALL CALC_OCE_MXLAYER(
757     I rhoInSitu(1-OLx,1-OLy,1,bi,bj), sigmaR,
758     I bi, bj, myTime, myIter, myThid )
759 jmc 1.47 ENDIF
760 heimbach 1.53
761 dimitri 1.52 #ifdef ALLOW_SALT_PLUME
762 dimitri 1.61 IF ( useSALT_PLUME ) THEN
763 jmc 1.71 CALL SALT_PLUME_CALC_DEPTH(
764     I rhoInSitu(1-OLx,1-OLy,1,bi,bj), sigmaR,
765     I bi, bj, myTime, myIter, myThid )
766 dimitri 1.60 ENDIF
767 dimitri 1.61 #endif /* ALLOW_SALT_PLUME */
768    
769 jmc 1.8 #ifdef ALLOW_DIAGNOSTICS
770 jmc 1.71 IF ( MOD(doDiagsRho,4).GE.2 ) THEN
771 jmc 1.16 CALL DIAGNOSTICS_FILL (sigmaR, 'DRHODR ', 0, Nr,
772     & 2, bi, bj, myThid)
773 jmc 1.8 ENDIF
774 dimitri 1.61 #endif /* ALLOW_DIAGNOSTICS */
775 jmc 1.8
776 jmc 1.130 C-- This is where EXTERNAL_FORCING_SURF(bi,bj) used to be called;
777     C now called earlier, before bi,bj loop.
778 jmc 1.1
779     #ifdef ALLOW_AUTODIFF_TAMC
780     cph needed for KPP
781 jmc 1.4 CADJ STORE surfaceForcingU(:,:,bi,bj)
782 jmc 1.96 CADJ & = comlev1_bibj, key=itdkey,
783 heimbach 1.77 CADJ & kind = isbyte
784 jmc 1.4 CADJ STORE surfaceForcingV(:,:,bi,bj)
785 jmc 1.96 CADJ & = comlev1_bibj, key=itdkey,
786 heimbach 1.77 CADJ & kind = isbyte
787 jmc 1.4 CADJ STORE surfaceForcingS(:,:,bi,bj)
788 jmc 1.96 CADJ & = comlev1_bibj, key=itdkey,
789 heimbach 1.77 CADJ & kind = isbyte
790 jmc 1.4 CADJ STORE surfaceForcingT(:,:,bi,bj)
791 jmc 1.96 CADJ & = comlev1_bibj, key=itdkey,
792 heimbach 1.77 CADJ & kind = isbyte
793 jmc 1.4 CADJ STORE surfaceForcingTice(:,:,bi,bj)
794 jmc 1.96 CADJ & = comlev1_bibj, key=itdkey,
795 heimbach 1.77 CADJ & kind = isbyte
796 jmc 1.1 #endif /* ALLOW_AUTODIFF_TAMC */
797    
798     #ifdef ALLOW_KPP
799     C-- Compute KPP mixing coefficients
800 jmc 1.131 IF ( calcKPP ) THEN
801 jmc 1.1 #ifdef ALLOW_DEBUG
802 jmc 1.96 IF (debugMode) CALL DEBUG_CALL('KPP_CALC',myThid)
803 jmc 1.1 #endif
804 dfer 1.76 CALL TIMER_START('KPP_CALC [DO_OCEANIC_PHYS]', myThid)
805 jmc 1.1 CALL KPP_CALC(
806 jmc 1.44 I bi, bj, myTime, myIter, myThid )
807 dfer 1.76 CALL TIMER_STOP ('KPP_CALC [DO_OCEANIC_PHYS]', myThid)
808 jmc 1.131 #if (defined ALLOW_AUTODIFF_TAMC) && !(defined ALLOW_OFFLINE)
809 jmc 1.1 ELSE
810     CALL KPP_CALC_DUMMY(
811 jmc 1.44 I bi, bj, myTime, myIter, myThid )
812 jmc 1.131 #endif /* ALLOW_AUTODIFF_TAMC and not ALLOW_OFFLINE */
813 jmc 1.1 ENDIF
814     #endif /* ALLOW_KPP */
815    
816 mlosch 1.6 #ifdef ALLOW_PP81
817     C-- Compute PP81 mixing coefficients
818     IF (usePP81) THEN
819     #ifdef ALLOW_DEBUG
820 jmc 1.96 IF (debugMode) CALL DEBUG_CALL('PP81_CALC',myThid)
821 mlosch 1.6 #endif
822     CALL PP81_CALC(
823 jmc 1.116 I bi, bj, sigmaR, myTime, myIter, myThid )
824 mlosch 1.6 ENDIF
825     #endif /* ALLOW_PP81 */
826    
827     #ifdef ALLOW_MY82
828     C-- Compute MY82 mixing coefficients
829     IF (useMY82) THEN
830     #ifdef ALLOW_DEBUG
831 jmc 1.96 IF (debugMode) CALL DEBUG_CALL('MY82_CALC',myThid)
832 mlosch 1.6 #endif
833     CALL MY82_CALC(
834 jmc 1.116 I bi, bj, sigmaR, myTime, myIter, myThid )
835 mlosch 1.6 ENDIF
836     #endif /* ALLOW_MY82 */
837    
838 mlosch 1.9 #ifdef ALLOW_GGL90
839 gforget 1.91 #ifdef ALLOW_AUTODIFF_TAMC
840     CADJ STORE GGL90TKE (:,:,:,bi,bj) = comlev1_bibj, key=itdkey,
841     CADJ & kind = isbyte
842     #endif /* ALLOW_AUTODIFF_TAMC */
843 mlosch 1.9 C-- Compute GGL90 mixing coefficients
844     IF (useGGL90) THEN
845     #ifdef ALLOW_DEBUG
846 jmc 1.96 IF (debugMode) CALL DEBUG_CALL('GGL90_CALC',myThid)
847 mlosch 1.9 #endif
848 dfer 1.76 CALL TIMER_START('GGL90_CALC [DO_OCEANIC_PHYS]', myThid)
849 mlosch 1.9 CALL GGL90_CALC(
850 jmc 1.116 I bi, bj, sigmaR, myTime, myIter, myThid )
851 dfer 1.76 CALL TIMER_STOP ('GGL90_CALC [DO_OCEANIC_PHYS]', myThid)
852 mlosch 1.9 ENDIF
853     #endif /* ALLOW_GGL90 */
854    
855 jmc 1.20 #ifdef ALLOW_TIMEAVE
856 jmc 1.36 IF ( taveFreq.GT. 0. _d 0 ) THEN
857 jmc 1.20 CALL TIMEAVE_SURF_FLUX( bi, bj, myTime, myIter, myThid)
858     ENDIF
859 jmc 1.131 IF ( taveFreq.GT.0. .AND. calcConvect ) THEN
860 jmc 1.20 CALL TIMEAVE_CUMULATE(ConvectCountTave, IVDConvCount,
861 jmc 1.120 I Nr, deltaTClock, bi, bj, myThid)
862 jmc 1.20 ENDIF
863     #endif /* ALLOW_TIMEAVE */
864    
865 jmc 1.69 #ifdef ALLOW_GMREDI
866 jmc 1.47 #ifdef ALLOW_AUTODIFF_TAMC
867     # ifndef GM_EXCLUDE_CLIPPING
868     cph storing here is needed only for one GMREDI_OPTIONS:
869     cph define GM_BOLUS_ADVEC
870     cph keep it although TAF says you dont need to.
871 jmc 1.86 cph but I have avoided the #ifdef for now, in case more things change
872 jmc 1.96 CADJ STORE sigmaX(:,:,:) = comlev1_bibj, key=itdkey,
873 heimbach 1.77 CADJ & kind = isbyte
874 jmc 1.96 CADJ STORE sigmaY(:,:,:) = comlev1_bibj, key=itdkey,
875 heimbach 1.77 CADJ & kind = isbyte
876 jmc 1.96 CADJ STORE sigmaR(:,:,:) = comlev1_bibj, key=itdkey,
877 heimbach 1.77 CADJ & kind = isbyte
878 jmc 1.47 # endif
879     #endif /* ALLOW_AUTODIFF_TAMC */
880    
881     C-- Calculate iso-neutral slopes for the GM/Redi parameterisation
882 jmc 1.131 IF ( calcGMRedi ) THEN
883 jmc 1.47 #ifdef ALLOW_DEBUG
884 jmc 1.96 IF (debugMode) CALL DEBUG_CALL('GMREDI_CALC_TENSOR',myThid)
885 jmc 1.47 #endif
886     CALL GMREDI_CALC_TENSOR(
887 jmc 1.51 I iMin, iMax, jMin, jMax,
888 jmc 1.47 I sigmaX, sigmaY, sigmaR,
889 jmc 1.51 I bi, bj, myTime, myIter, myThid )
890 jmc 1.131 #if (defined ALLOW_AUTODIFF_TAMC) && !(defined ALLOW_OFFLINE)
891 jmc 1.47 ELSE
892     CALL GMREDI_CALC_TENSOR_DUMMY(
893 jmc 1.51 I iMin, iMax, jMin, jMax,
894 jmc 1.47 I sigmaX, sigmaY, sigmaR,
895 jmc 1.51 I bi, bj, myTime, myIter, myThid )
896 jmc 1.131 #endif /* ALLOW_AUTODIFF_TAMC and not ALLOW_OFFLINE */
897 jmc 1.47 ENDIF
898 jmc 1.69 #endif /* ALLOW_GMREDI */
899    
900     #ifdef ALLOW_DOWN_SLOPE
901     IF ( useDOWN_SLOPE ) THEN
902     C-- Calculate Downsloping Flow for Down_Slope parameterization
903     IF ( usingPCoords ) THEN
904     CALL DWNSLP_CALC_FLOW(
905 jmc 1.71 I bi, bj, kSurfC, rhoInSitu,
906 jmc 1.69 I myTime, myIter, myThid )
907     ELSE
908     CALL DWNSLP_CALC_FLOW(
909 jmc 1.71 I bi, bj, kLowC, rhoInSitu,
910 jmc 1.69 I myTime, myIter, myThid )
911     ENDIF
912     ENDIF
913     #endif /* ALLOW_DOWN_SLOPE */
914 jmc 1.47
915 jmc 1.106 C-- end bi,bj loops.
916     ENDDO
917     ENDDO
918    
919 jmc 1.98 #ifndef ALLOW_AUTODIFF_TAMC
920     C--- if fluid Is Water: end
921 jmc 1.106 ENDIF
922 jmc 1.98 #endif
923    
924 dimitri 1.107 #ifdef ALLOW_BBL
925     IF ( useBBL ) THEN
926     CALL BBL_CALC_RHS(
927     I myTime, myIter, myThid )
928     ENDIF
929     #endif /* ALLOW_BBL */
930    
931 dimitri 1.94 #ifdef ALLOW_MYPACKAGE
932 jmc 1.106 IF ( useMYPACKAGE ) THEN
933     CALL MYPACKAGE_CALC_RHS(
934     I myTime, myIter, myThid )
935     ENDIF
936 dimitri 1.94 #endif /* ALLOW_MYPACKAGE */
937    
938 jmc 1.99 #ifdef ALLOW_GMREDI
939 jmc 1.131 IF ( calcGMRedi ) THEN
940 jmc 1.99 CALL GMREDI_DO_EXCH( myTime, myIter, myThid )
941     ENDIF
942     #endif /* ALLOW_GMREDI */
943    
944 jmc 1.98 #ifdef ALLOW_KPP
945 jmc 1.131 IF ( calcKPP ) THEN
946 jmc 1.45 CALL KPP_DO_EXCH( myThid )
947     ENDIF
948 jmc 1.98 #endif /* ALLOW_KPP */
949 jmc 1.45
950 jmc 1.18 #ifdef ALLOW_DIAGNOSTICS
951     IF ( fluidIsWater .AND. useDiagnostics ) THEN
952 jmc 1.74 CALL DIAGS_RHO_G(
953 jmc 1.110 I rhoInSitu, uVel, vVel, wVel,
954 jmc 1.71 I myTime, myIter, myThid )
955 jmc 1.18 CALL DIAGS_OCEANIC_SURF_FLUX( myTime, myIter, myThid )
956     ENDIF
957 jmc 1.131 IF ( calcConvect .AND. useDiagnostics ) THEN
958 jmc 1.71 CALL DIAGNOSTICS_FILL( IVDConvCount, 'CONVADJ ',
959     & 0, Nr, 0, 1, 1, myThid )
960 jmc 1.19 ENDIF
961 jmc 1.18 #endif
962    
963 gforget 1.123 #ifdef ALLOW_ECCO
964 jmc 1.129 CALL ECCO_PHYS( myThid )
965 gforget 1.123 #endif
966    
967 jmc 1.1 #ifdef ALLOW_DEBUG
968 jmc 1.96 IF (debugMode) CALL DEBUG_LEAVE('DO_OCEANIC_PHYS',myThid)
969 jmc 1.1 #endif
970    
971     RETURN
972     END
  ViewVC Help
Powered by ViewVC 1.1.22