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