/[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.118 - (hide annotations) (download)
Wed Aug 1 03:00:59 2012 UTC (11 years, 9 months ago) by jmc
Branch: MAIN
Changes since 1.117: +11 -10 lines
fix previous modif: no need to remove traditional flux balancing if useThSIce

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

  ViewVC Help
Powered by ViewVC 1.1.22