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