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

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

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


Revision 1.114 - (hide annotations) (download)
Wed Apr 6 18:29:53 2005 UTC (19 years, 2 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint57g_pre, checkpoint57g_post, checkpoint57f_post, checkpoint57h_pre
Changes since 1.113: +3 -3 lines
use baseTime as time origin ; DIFF_BASE_MULTIPLE replaces DIFFERENT_MULTIPLE

1 jmc 1.114 C $Header: /u/gcmpack/MITgcm/model/src/forward_step.F,v 1.113 2005/02/04 11:01:49 mlosch Exp $
2 adcroft 1.15 C $Name: $
3 adcroft 1.1
4 edhill 1.64 #include "PACKAGES_CONFIG.h"
5 adcroft 1.1 #include "CPP_OPTIONS.h"
6 edhill 1.64
7 stephd 1.101 #ifdef ALLOW_OFFLINE
8     # include "OFFLINE_OPTIONS.h"
9     #endif
10 heimbach 1.104 #ifdef ALLOW_GMREDI
11     # include "GMREDI_OPTIONS.h"
12     #endif
13 adcroft 1.1
14 cnh 1.22 CBOP
15     C !ROUTINE: FORWARD_STEP
16     C !INTERFACE:
17 adcroft 1.13 SUBROUTINE FORWARD_STEP( iloop, myTime, myIter, myThid )
18 heimbach 1.12
19 cnh 1.22 C !DESCRIPTION: \bv
20     C *==================================================================
21     C | SUBROUTINE forward_step
22     C | o Run the ocean model and, optionally, evaluate a cost function.
23     C *==================================================================
24     C |
25     C | THE_MAIN_LOOP is the toplevel routine for the Tangent Linear and
26     C | Adjoint Model Compiler (TAMC). For this purpose the initialization
27     C | of the model was split into two parts. Those parameters that do
28     C | not depend on a specific model run are set in INITIALISE_FIXED,
29     C | whereas those that do depend on the specific realization are
30     C | initialized in INITIALISE_VARIA.
31     C |
32     C *==================================================================
33     C \ev
34 adcroft 1.1
35 cnh 1.22 C !USES:
36     IMPLICIT NONE
37     C == Global variables ==
38 adcroft 1.1 #include "SIZE.h"
39     #include "EEPARAMS.h"
40     #include "PARAMS.h"
41     #include "DYNVARS.h"
42    
43 jmc 1.27 #ifdef ALLOW_SHAP_FILT
44 jmc 1.91 # include "SHAP_FILT.h"
45 jmc 1.27 #endif
46     #ifdef ALLOW_ZONAL_FILT
47 jmc 1.91 # include "ZONAL_FILT.h"
48 jmc 1.27 #endif
49 jmc 1.93 #ifdef COMPONENT_MODULE
50     # include "CPL_PARAMS.h"
51     #endif
52 jmc 1.27
53 heimbach 1.12 #ifdef ALLOW_AUTODIFF_TAMC
54 jmc 1.91 # include "FFIELDS.h"
55    
56     # ifdef ALLOW_NONHYDROSTATIC
57     # include "CG3D.h"
58     # endif
59    
60 heimbach 1.30 # include "tamc.h"
61     # include "ctrl.h"
62     # include "ctrl_dummy.h"
63     # include "cost.h"
64 heimbach 1.37 # include "EOS.h"
65 edhill 1.69 # ifdef ALLOW_EXF
66 heimbach 1.30 # include "exf_fields.h"
67 heimbach 1.85 # include "exf_clim_fields.h"
68 jmc 1.63 # ifdef ALLOW_BULKFORMULAE
69 heimbach 1.30 # include "exf_constants.h"
70     # endif
71     # endif
72     # ifdef ALLOW_OBCS
73     # include "OBCS.h"
74     # endif
75 heimbach 1.56 # ifdef ALLOW_PTRACERS
76 jmc 1.99 # include "PTRACERS_SIZE.h"
77 heimbach 1.56 # include "PTRACERS.h"
78 heimbach 1.82 # endif
79     # ifdef ALLOW_CD_CODE
80     # include "CD_CODE_VARS.h"
81 heimbach 1.56 # endif
82 heimbach 1.92 # ifdef ALLOW_EBM
83     # include "EBM.h"
84     # endif
85 heimbach 1.102 # ifdef EXACT_CONSERV
86     # include "SURFACE.h"
87     # endif
88 heimbach 1.104 # ifdef ALLOW_KPP
89     # include "KPP.h"
90     # endif
91     # ifdef ALLOW_GMREDI
92     # include "GMREDI.h"
93     # endif
94 heimbach 1.56 #endif /* ALLOW_AUTODIFF_TAMC */
95 heimbach 1.12
96 cnh 1.22 C !LOCAL VARIABLES:
97     C == Routine arguments ==
98 adcroft 1.13 C note: under the multi-threaded model myiter and
99     C mytime are local variables passed around as routine
100     C arguments. Although this is fiddly it saves the need to
101     C impose additional synchronisation points when they are
102     C updated.
103 jmc 1.93 C myIter - iteration counter for this thread
104     C myTime - time counter for this thread
105     C myThid - thread number for this instance of the routine.
106     INTEGER iloop
107     INTEGER myThid
108     INTEGER myIter
109     _RL myTime
110 molod 1.83
111 jmc 1.93 C == Local variables ==
112     INTEGER myItP1
113 cnh 1.22 CEOP
114 heimbach 1.12
115 edhill 1.71 #ifdef ALLOW_DEBUG
116 heimbach 1.57 IF ( debugLevel .GE. debLevB )
117     & CALL DEBUG_ENTER('FORWARD_STEP',myThid)
118 adcroft 1.53 #endif
119    
120 heimbach 1.12 #ifdef ALLOW_AUTODIFF_TAMC
121 dimitri 1.45 C-- Reset the model iteration counter and the model time.
122 jmc 1.114 myIter = nIter0 + (iloop-1)
123     myTime = startTime + float(iloop-1)*deltaTclock
124 heimbach 1.12 #endif
125    
126 heimbach 1.28 #ifdef ALLOW_AUTODIFF_TAMC
127     c**************************************
128     #include "checkpoint_lev1_directives.h"
129     c**************************************
130 heimbach 1.23 #endif
131 cheisey 1.38
132 jmc 1.111 C-- Switch on/off diagnostics for snap-shot output:
133     #ifdef ALLOW_DIAGNOSTICS
134     IF ( useDiagnostics ) THEN
135     CALL DIAGNOSTICS_SWITCH_ONOFF( myIter, myThid )
136     ENDIF
137     #endif
138    
139 jmc 1.112 C-- State-variables diagnostics
140     IF ( usediagnostics ) THEN
141     CALL TIMER_START('DO_STATEVARS_DIAGS [FORWARD_STEP]',myThid)
142     CALL DO_STATEVARS_DIAGS( myTime, 0, myIter, myThid )
143     CALL TIMER_STOP ('DO_STATEVARS_DIAGS [FORWARD_STEP]',myThid)
144     ENDIF
145    
146 heimbach 1.37 C-- Call external forcing package
147 cheisey 1.40 #ifdef ALLOW_BULK_FORCE
148 jmc 1.76 IF ( useBulkForce ) THEN
149 edhill 1.71 #ifdef ALLOW_DEBUG
150 jmc 1.58 IF ( debugLevel .GE. debLevB )
151 heimbach 1.57 & CALL DEBUG_CALL('BULKF_FIELDS_LOAD',myThid)
152 adcroft 1.53 #endif
153 jmc 1.76 CALL TIMER_START('BULKF_FORCING [FORWARD_STEP]',mythid)
154     C- load all forcing fields at current time
155     CALL BULKF_FIELDS_LOAD( myTime, myIter, myThid )
156     C- calculate qnet and empmr (and wind stress)
157     CALL BULKF_FORCING( myTime, myIter, myThid )
158     CALL TIMER_STOP ('BULKF_FORCING [FORWARD_STEP]',mythid)
159 jmc 1.63 ELSE
160 jmc 1.58 #endif /* ALLOW_BULK_FORCE */
161 jmc 1.63
162 edhill 1.64 # ifdef ALLOW_EXF
163 heimbach 1.72 # ifdef ALLOW_DEBUG
164 heimbach 1.57 IF ( debugLevel .GE. debLevB )
165     & CALL DEBUG_CALL('EXF_GETFORCING',myThid)
166 heimbach 1.72 # endif
167 dimitri 1.45 CALL TIMER_START('EXF_GETFORCING [FORWARD_STEP]',mythid)
168     CALL EXF_GETFORCING( mytime, myiter, mythid )
169     CALL TIMER_STOP ('EXF_GETFORCING [FORWARD_STEP]',mythid)
170 edhill 1.64 # else /* ALLOW_EXF undef */
171 heimbach 1.49 cph The following IF-statement creates an additional dependency
172     cph for the forcing fields requiring additional storing.
173     cph Therefore, the IF-statement will be put between CPP-OPTIONS,
174     cph assuming that ALLOW_SEAICE has not yet been differentiated.
175 heimbach 1.92 # if (defined (ALLOW_SEAICE) || defined (ALLOW_EBM))
176     IF ( .NOT. useSEAICE .AND. .NOT. useEBM ) THEN
177 heimbach 1.49 # endif
178 edhill 1.71 #ifdef ALLOW_DEBUG
179 heimbach 1.57 IF ( debugLevel .GE. debLevB )
180     & CALL DEBUG_CALL('EXTERNAL_FIELDS_LOAD',myThid)
181 adcroft 1.53 #endif
182 dimitri 1.45 CALL TIMER_START('EXTERNAL_FIELDS_LOAD[FORWARD_STEP]',mythid)
183     CALL EXTERNAL_FIELDS_LOAD( mytime, myiter, mythid )
184     CALL TIMER_STOP ('EXTERNAL_FIELDS_LOAD[FORWARD_STEP]',mythid)
185 heimbach 1.92 # if (defined (ALLOW_SEAICE) || defined (ALLOW_EBM))
186 dimitri 1.45 ENDIF
187 heimbach 1.49 # endif
188 edhill 1.64 # endif /* ALLOW_EXF */
189 jmc 1.63 #ifdef ALLOW_BULK_FORCE
190     C-- end of if/else block useBulfforce --
191     ENDIF
192     #endif /* ALLOW_BULK_FORCE */
193 heimbach 1.49
194 heimbach 1.68 #ifdef ALLOW_AUTODIFF
195 heimbach 1.49 c-- Add control vector for forcing and parameter fields
196     if ( myiter .EQ. nIter0 )
197     & CALL CTRL_MAP_FORCING (mythid)
198     #endif
199 cheisey 1.38
200 heimbach 1.106 #if (defined (ALLOW_AUTODIFF_TAMC) && defined (ALLOW_AUTODIFF_MONITOR))
201     C Include call to a dummy routine. Its adjoint will be
202     C called at the proper place in the adjoint code.
203     C The adjoint routine will print out adjoint values
204     C if requested. The location of the call is important,
205     C it has to be after the adjoint of the exchanges
206     C (DO_GTERM_BLOCKING_EXCHANGES).
207     CALL DUMMY_IN_STEPPING( myTime, myIter, myThid )
208     cph I've commented this line since it may conflict with MITgcm's adjoint
209     cph However, need to check whether that's still consistent
210     cph with the ecco-branch (it should).
211     cph CALL DO_FIELDS_BLOCKING_EXCHANGES( myThid )
212     #endif
213    
214 heimbach 1.49 # ifdef ALLOW_SEAICE
215 dimitri 1.45 C-- Call sea ice model to compute forcing/external data fields. In
216     C addition to computing prognostic sea-ice variables and diagnosing the
217     C forcing/external data fields that drive the ocean model, SEAICE_MODEL
218     C also sets theta to the freezing point under sea-ice. The implied
219     C surface heat flux is then stored in variable surfaceTendencyTice,
220     C which is needed by KPP package (kpp_calc.F and kpp_transport_t.F)
221     C to diagnose surface buoyancy fluxes and for the non-local transport
222     C term. Because this call precedes model thermodynamics, temperature
223     C under sea-ice may not be "exactly" at the freezing point by the time
224     C theta is dumped or time-averaged.
225     IF ( useSEAICE ) THEN
226 edhill 1.71 #ifdef ALLOW_DEBUG
227 heimbach 1.57 IF ( debugLevel .GE. debLevB )
228     & CALL DEBUG_CALL('SEAICE_MODEL',myThid)
229 adcroft 1.53 #endif
230 heimbach 1.36 CALL TIMER_START('SEAICE_MODEL [FORWARD_STEP]',myThid)
231 jmc 1.41 CALL SEAICE_MODEL( myTime, myIter, myThid )
232 heimbach 1.36 CALL TIMER_STOP ('SEAICE_MODEL [FORWARD_STEP]',myThid)
233 dimitri 1.45 ENDIF
234 dimitri 1.50 # endif /* ALLOW_SEAICE */
235 dimitri 1.73
236 heimbach 1.56 #ifdef ALLOW_AUTODIFF_TAMC
237     # ifdef ALLOW_PTRACERS
238     cph this replaces _bibj storing of ptracer within thermodynamics
239     CADJ STORE ptracer = comlev1, key = ikey_dynamics
240     # endif
241     #endif
242 stephd 1.62
243 stephd 1.101 #ifdef ALLOW_OFFLINE
244     call OFFLINE_FIELDS_LOAD( myTime, myIter, myThid )
245     #endif
246    
247 stephd 1.62 #ifdef ALLOW_PTRACERS
248     # ifdef ALLOW_GCHEM
249 mlosch 1.108 IF ( useGCHEM ) THEN
250 mlosch 1.113 #ifdef ALLOW_DEBUG
251     IF ( debugLevel .GE. debLevB )
252     & CALL DEBUG_CALL('GCHEM_FIELDS_LOAD',myThid)
253     #endif /* ALLOW_DEBUG */
254 stephd 1.62 CALL GCHEM_FIELDS_LOAD( mytime, myiter, mythid )
255 mlosch 1.108 ENDIF
256 stephd 1.62 # endif
257     #endif
258 jmc 1.78
259     #ifdef COMPONENT_MODULE
260 jmc 1.93 IF ( useCoupler .AND. cpl_earlyExpImpCall ) THEN
261 jmc 1.78 C Post coupling data that I export.
262     C Read in coupling data that I import.
263     CALL TIMER_START('CPL_EXPORT-IMPORT [FORWARD_STEP]',myThid)
264     CALL CPL_EXPORT_MY_DATA( myIter, myTime, myThid )
265     CALL CPL_IMPORT_EXTERNAL_DATA( myIter, myTime, myThid )
266     CALL TIMER_STOP ('CPL_EXPORT-IMPORT [FORWARD_STEP]',myThid)
267     ENDIF
268     #endif /* COMPONENT_MODULE */
269 stephd 1.62
270 heimbach 1.92 #ifdef ALLOW_EBM
271     IF ( useEBM ) THEN
272     # ifdef ALLOW_DEBUG
273     IF ( debugLevel .GE. debLevB )
274     & CALL DEBUG_CALL('EBM',myThid)
275     # endif
276     CALL TIMER_START('EBM [FORWARD_STEP]',mythid)
277     CALL EBM_DRIVER ( myTime, myIter, myThid )
278     CALL TIMER_STOP ('EBM [FORWARD_STEP]',mythid)
279     ENDIF
280     #endif
281 molod 1.79
282 jmc 1.97 C-- Step forward fields and calculate time tendency terms.
283    
284     #ifdef ALLOW_DEBUG
285     IF ( debugLevel .GE. debLevB )
286     & CALL DEBUG_CALL('DO_ATMOSPHERIC_PHYS',myThid)
287     #endif
288     CALL TIMER_START('DO_ATMOSPHERIC_PHYS [FORWARD_STEP]',mythid)
289     CALL DO_ATMOSPHERIC_PHYS( myTime, myIter, myThid )
290     CALL TIMER_STOP ('DO_ATMOSPHERIC_PHYS [FORWARD_STEP]',mythid)
291    
292 heimbach 1.104 #ifdef ALLOW_AUTODIFF_TAMC
293     CADJ STORE theta = comlev1, key = ikey_dynamics
294     CADJ STORE salt = comlev1, key = ikey_dynamics
295     CADJ STORE totphihyd = comlev1, key = ikey_dynamics
296     CADJ STORE surfaceforcingtice = comlev1, key = ikey_dynamics
297     # ifdef ALLOW_KPP
298     CADJ STORE uvel = comlev1, key = ikey_dynamics
299     CADJ STORE vvel = comlev1, key = ikey_dynamics
300     # endif
301     # ifdef EXACT_CONSERV
302 heimbach 1.105 CADJ STORE empmr = comlev1, key = ikey_dynamics
303 heimbach 1.104 CADJ STORE pmepr = comlev1, key = ikey_dynamics
304     # endif
305     #endif /* ALLOW_AUTODIFF_TAMC */
306    
307 stephd 1.101 #ifndef ALLOW_OFFLINE
308 edhill 1.71 #ifdef ALLOW_DEBUG
309 jmc 1.96 IF ( debugLevel .GE. debLevB )
310     & CALL DEBUG_CALL('DO_OCEANIC_PHYS',myThid)
311     #endif
312     CALL TIMER_START('DO_OCEANIC_PHYS [FORWARD_STEP]',mythid)
313     CALL DO_OCEANIC_PHYS( myTime, myIter, myThid )
314     CALL TIMER_STOP ('DO_OCEANIC_PHYS [FORWARD_STEP]',mythid)
315 stephd 1.101 #endif
316 jmc 1.96
317 mlosch 1.110 #ifdef ALLOW_GCHEM
318     C GCHEM package is an interface for any bio-geochemical or
319     C ecosystem model you would like to include.
320     C If GCHEM_SEPARATE_FORCING is not defined, you are
321     C responsible for computing tendency terms for passive
322     C tracers and storing them on a 3DxNumPtracers-array called
323     C gchemTendency in GCHEM_CALC_TENDENCY. This tendency is then added
324     C to gPtr in ptracers_forcing later-on.
325     C If GCHEM_SEPARATE_FORCING is defined, you are reponsible for
326     C UPDATING ptracers directly in GCHEM_FORCING_SEP. This amounts
327     C to a completely separate time step that you have to implement
328     C yourself (Eulerian seems to be fine in most cases).
329     CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
330     C CAVEAT: Up to now, when GCHEM is turned on the field ptracerForcingSurf,
331     C which is needed for KPP is not set properly. ptracerForcingSurf must
332     C be treated differently depending on whether GCHEM_SEPARATE_FORCING
333     C is define or not. TBD.
334     CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
335 mlosch 1.113 IF ( useGCHEM ) THEN
336 mlosch 1.110 #ifdef ALLOW_DEBUG
337 mlosch 1.113 IF ( debugLevel .GE. debLevB )
338     & CALL DEBUG_CALL('GCHEM_CALC_TENDENCY',myThid)
339 mlosch 1.110 #endif
340     CALL TIMER_START('GCHEM_CALC_TENDENCY [FORWARD_STEP]',myThid)
341     CALL GCHEM_CALC_TENDENCY( myTime, myIter, myThid )
342     CALL TIMER_STOP ('GCHEM_CALC_TENDENCY [FORWARD_STEP]',myThid)
343     ENDIF
344     #endif /* ALLOW_GCHEM */
345 mlosch 1.109
346 heimbach 1.104 #ifdef ALLOW_AUTODIFF_TAMC
347     cph needed to be moved here from do_oceanic_physics
348     cph to be visible down the road
349     c
350     CADJ STORE surfaceForcingS = comlev1, key = ikey_dynamics
351     CADJ STORE surfaceForcingT = comlev1, key = ikey_dynamics
352     CADJ STORE surfaceForcingTice = comlev1, key = ikey_dynamics
353     ctest(
354 heimbach 1.105 CADJ STORE IVDConvCount = comlev1, key = ikey_dynamics
355     ctest)
356     # ifdef ALLOW_PTRACERS
357     CADJ STORE surfaceForcingPtr = comlev1, key = ikey_dynamics
358 heimbach 1.104 # endif
359     c
360     # ifdef ALLOW_GMREDI
361     CADJ STORE Kwx = comlev1, key = ikey_dynamics
362     CADJ STORE Kwy = comlev1, key = ikey_dynamics
363     CADJ STORE Kwz = comlev1, key = ikey_dynamics
364     # ifdef GM_BOLUS_ADVEC
365     CADJ STORE GM_PsiX = comlev1, key = ikey_dynamics
366     CADJ STORE GM_PsiY = comlev1, key = ikey_dynamics
367     # endif
368     # endif
369     c
370     # ifdef ALLOW_KPP
371     CADJ STORE KPPghat = comlev1, key = ikey_dynamics
372     CADJ STORE KPPfrac = comlev1, key = ikey_dynamics
373 heimbach 1.105 CADJ STORE KPPdiffKzS = comlev1, key = ikey_dynamics
374     CADJ STORE KPPdiffKzT = comlev1, key = ikey_dynamics
375 heimbach 1.104 # endif
376     #endif /* ALLOW_AUTODIFF_TAMC */
377    
378 jmc 1.96 IF ( .NOT.staggerTimeStep ) THEN
379     #ifdef ALLOW_DEBUG
380     IF ( debugLevel .GE. debLevB )
381 heimbach 1.57 & CALL DEBUG_CALL('THERMODYNAMICS',myThid)
382 adcroft 1.53 #endif
383 heimbach 1.36 CALL TIMER_START('THERMODYNAMICS [FORWARD_STEP]',mythid)
384 adcroft 1.15 CALL THERMODYNAMICS( myTime, myIter, myThid )
385 heimbach 1.36 CALL TIMER_STOP ('THERMODYNAMICS [FORWARD_STEP]',mythid)
386 jmc 1.96 C-- if not staggerTimeStep: end
387 dimitri 1.45 ENDIF
388 jmc 1.93
389     #ifdef COMPONENT_MODULE
390     IF ( useCoupler .AND. .NOT.cpl_earlyExpImpCall ) THEN
391     C Post coupling data that I export.
392     C Read in coupling data that I import.
393     myItP1 = myIter + 1
394     CALL TIMER_START('CPL_EXPORT-IMPORT [FORWARD_STEP]',myThid)
395     CALL CPL_EXPORT_MY_DATA( myItP1, myTime, myThid )
396     CALL CPL_IMPORT_EXTERNAL_DATA( myItP1, myTime, myThid )
397     CALL TIMER_STOP ('CPL_EXPORT-IMPORT [FORWARD_STEP]',myThid)
398     # ifndef ALLOW_AIM
399     IF ( useRealFreshWaterFlux ) THEN
400     CALL OCN_APPLY_IMPORT( .FALSE., myTime, myIter, myThid )
401     ENDIF
402     # endif
403     ENDIF
404     #endif /* COMPONENT_MODULE */
405 heimbach 1.12
406 dimitri 1.45 C-- Step forward fields and calculate time tendency terms.
407 stephd 1.101 #ifndef ALLOW_OFFLINE
408 heimbach 1.61 #ifndef ALLOW_AUTODIFF_TAMC
409 dimitri 1.45 IF ( momStepping ) THEN
410 heimbach 1.61 #endif
411 edhill 1.71 #ifdef ALLOW_DEBUG
412 heimbach 1.57 IF ( debugLevel .GE. debLevB )
413     & CALL DEBUG_CALL('DYNAMICS',myThid)
414 adcroft 1.53 #endif
415 heimbach 1.36 CALL TIMER_START('DYNAMICS [FORWARD_STEP]',mythid)
416 heimbach 1.12 CALL DYNAMICS( myTime, myIter, myThid )
417 heimbach 1.36 CALL TIMER_STOP ('DYNAMICS [FORWARD_STEP]',mythid)
418 heimbach 1.61 #ifndef ALLOW_AUTODIFF_TAMC
419 dimitri 1.45 ENDIF
420 heimbach 1.61 #endif
421 stephd 1.101 #endif
422 heimbach 1.12
423 adcroft 1.1 #ifdef ALLOW_NONHYDROSTATIC
424     C-- Step forward W field in N-H algorithm
425 dimitri 1.45 IF ( momStepping .AND. nonHydrostatic ) THEN
426 edhill 1.71 #ifdef ALLOW_DEBUG
427 heimbach 1.57 IF ( debugLevel .GE. debLevB )
428     & CALL DEBUG_CALL('CALC_GW',myThid)
429 adcroft 1.53 #endif
430 dimitri 1.45 CALL TIMER_START('CALC_GW [FORWARD_STEP]',myThid)
431     CALL CALC_GW(myThid)
432     CALL TIMER_STOP ('CALC_GW [FORWARD_STEP]',myThid)
433     ENDIF
434 adcroft 1.1 #endif
435 jmc 1.18
436 jmc 1.96 C-- Update time-counter
437     myIter = nIter0 + iLoop
438     myTime = startTime + deltaTClock * float(iLoop)
439    
440     C-- Update geometric factors:
441 jmc 1.18 #ifdef NONLIN_FRSURF
442 jmc 1.96 C- update hfacC,W,S and recip_hFac according to etaH(n+1) :
443 jmc 1.18 IF ( nonlinFreeSurf.GT.0) THEN
444 jmc 1.48 IF ( select_rStar.GT.0 ) THEN
445     CALL TIMER_START('UPDATE_R_STAR [FORWARD_STEP]',myThid)
446     CALL UPDATE_R_STAR( myTime, myIter, myThid )
447     CALL TIMER_STOP ('UPDATE_R_STAR [FORWARD_STEP]',myThid)
448     ELSE
449 dimitri 1.45 CALL TIMER_START('UPDATE_SURF_DR [FORWARD_STEP]',myThid)
450 jmc 1.18 CALL UPDATE_SURF_DR( myTime, myIter, myThid )
451 heimbach 1.36 CALL TIMER_STOP ('UPDATE_SURF_DR [FORWARD_STEP]',myThid)
452 jmc 1.48 ENDIF
453 jmc 1.18 ENDIF
454     C- update also CG2D matrix (and preconditioner)
455 jmc 1.33 IF ( momStepping .AND. nonlinFreeSurf.GT.2 ) THEN
456 dimitri 1.45 CALL TIMER_START('UPDATE_CG2D [FORWARD_STEP]',myThid)
457 jmc 1.18 CALL UPDATE_CG2D( myTime, myIter, myThid )
458 jmc 1.47 CALL TIMER_STOP ('UPDATE_CG2D [FORWARD_STEP]',myThid)
459 adcroft 1.19 ENDIF
460 jmc 1.18 #endif
461 adcroft 1.1
462 jmc 1.27 C-- Apply Filters to u*,v* before SOLVE_FOR_PRESSURE
463     #ifdef ALLOW_SHAP_FILT
464     IF (useSHAP_FILT .AND. shap_filt_uvStar) THEN
465 heimbach 1.36 CALL TIMER_START('SHAP_FILT [FORWARD_STEP]',myThid)
466 jmc 1.27 IF (implicDiv2Dflow.LT.1.) THEN
467     C-- Explicit+Implicit part of the Barotropic Flow Divergence
468     C => Filtering of uVel,vVel is necessary
469 jmc 1.59 CALL SHAP_FILT_APPLY_UV( uVel,vVel,
470 jmc 1.96 & myTime, myIter, myThid )
471 jmc 1.27 ENDIF
472 jmc 1.96 CALL SHAP_FILT_APPLY_UV( gU,gV,myTime,myIter,myThid)
473 heimbach 1.36 CALL TIMER_STOP ('SHAP_FILT [FORWARD_STEP]',myThid)
474 jmc 1.27 ENDIF
475     #endif
476     #ifdef ALLOW_ZONAL_FILT
477     IF (useZONAL_FILT .AND. zonal_filt_uvStar) THEN
478 heimbach 1.36 CALL TIMER_START('ZONAL_FILT_APPLY [FORWARD_STEP]',myThid)
479 jmc 1.27 IF (implicDiv2Dflow.LT.1.) THEN
480     C-- Explicit+Implicit part of the Barotropic Flow Divergence
481     C => Filtering of uVel,vVel is necessary
482     CALL ZONAL_FILT_APPLY_UV( uVel, vVel, myThid )
483     ENDIF
484 jmc 1.59 CALL ZONAL_FILT_APPLY_UV( gU, gV, myThid )
485 heimbach 1.36 CALL TIMER_STOP ('ZONAL_FILT_APPLY [FORWARD_STEP]',myThid)
486 jmc 1.27 ENDIF
487     #endif
488 heimbach 1.12
489 adcroft 1.1 C-- Solve elliptic equation(s).
490     C Two-dimensional only for conventional hydrostatic or
491     C three-dimensional for non-hydrostatic and/or IGW scheme.
492 stephd 1.101 #ifndef ALLOW_OFFLINE
493 adcroft 1.19 IF ( momStepping ) THEN
494 jmc 1.96 CALL TIMER_START('SOLVE_FOR_PRESSURE [FORWARD_STEP]',myThid)
495     CALL SOLVE_FOR_PRESSURE(myTime, myIter, myThid)
496     CALL TIMER_STOP ('SOLVE_FOR_PRESSURE [FORWARD_STEP]',myThid)
497     ENDIF
498 stephd 1.101 #endif
499 jmc 1.96
500     C-- Correct divergence in flow field and cycle time-stepping momentum
501     c IF ( momStepping ) THEN
502 stephd 1.101 #ifndef ALLOW_OFFLINE
503 jmc 1.96 CALL TIMER_START('UV_CORRECTION_STEP [FORWARD_STEP]',myThid)
504     CALL MOMENTUM_CORRECTION_STEP(myTime, myIter, myThid)
505     CALL TIMER_STOP ('UV_CORRECTION_STEP [FORWARD_STEP]',myThid)
506 stephd 1.101 #endif
507 jmc 1.96 c ENDIF
508    
509     #ifdef EXACT_CONSERV
510     IF (exactConserv) THEN
511     C-- Update etaH(n+1) :
512     CALL TIMER_START('UPDATE_ETAH [FORWARD_STEP]',mythid)
513     CALL UPDATE_ETAH( myTime, myIter, myThid )
514     CALL TIMER_STOP ('UPDATE_ETAH [FORWARD_STEP]',mythid)
515 adcroft 1.19 ENDIF
516 jmc 1.96 #endif /* EXACT_CONSERV */
517    
518     #ifdef NONLIN_FRSURF
519     IF ( select_rStar.NE.0 ) THEN
520     C-- r* : compute the future level thickness according to etaH(n+1)
521     CALL TIMER_START('CALC_R_STAR [FORWARD_STEP]',mythid)
522     CALL CALC_R_STAR(etaH, myTime, myIter, myThid )
523     CALL TIMER_STOP ('CALC_R_STAR [FORWARD_STEP]',mythid)
524     ELSEIF ( nonlinFreeSurf.GT.0) THEN
525     C-- compute the future surface level thickness according to etaH(n+1)
526     CALL TIMER_START('CALC_SURF_DR [FORWARD_STEP]',mythid)
527     CALL CALC_SURF_DR(etaH, myTime, myIter, myThid )
528     CALL TIMER_STOP ('CALC_SURF_DR [FORWARD_STEP]',mythid)
529     ENDIF
530     #endif /* NONLIN_FRSURF */
531    
532     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
533     IF ( staggerTimeStep ) THEN
534 jmc 1.98 C-- do exchanges of U,V (needed for multiDim) when using stagger time-step :
535     #ifdef ALLOW_DEBUG
536     IF ( debugLevel .GE. debLevB )
537     & CALL DEBUG_CALL('DO_STAGGER_FIELDS_EXCH.',myThid)
538     #endif
539     CALL TIMER_START('BLOCKING_EXCHANGES [FORWARD_STEP]',myThid)
540     CALL DO_STAGGER_FIELDS_EXCHANGES( myTime, myIter, myThid )
541     CALL TIMER_STOP ('BLOCKING_EXCHANGES [FORWARD_STEP]',myThid)
542 jmc 1.96
543 jmc 1.112 C-- State-variables diagnostics
544     IF ( usediagnostics ) THEN
545     CALL TIMER_START('DO_STATEVARS_DIAGS [FORWARD_STEP]',myThid)
546     CALL DO_STATEVARS_DIAGS( myTime, 1, myIter, myThid )
547     CALL TIMER_STOP ('DO_STATEVARS_DIAGS [FORWARD_STEP]',myThid)
548     ENDIF
549    
550 jmc 1.96 #ifdef ALLOW_DEBUG
551     IF ( debugLevel .GE. debLevB )
552     & CALL DEBUG_CALL('THERMODYNAMICS',myThid)
553     #endif
554     CALL TIMER_START('THERMODYNAMICS [FORWARD_STEP]',mythid)
555     CALL THERMODYNAMICS( myTime, myIter, myThid )
556     CALL TIMER_STOP ('THERMODYNAMICS [FORWARD_STEP]',mythid)
557    
558     C-- if staggerTimeStep: end
559     ENDIF
560     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
561 adcroft 1.1
562 heimbach 1.37 #ifdef ALLOW_AUTODIFF_TAMC
563     cph This is needed because convective_adjustment calls
564     cph find_rho which may use pressure()
565 heimbach 1.51 CADJ STORE totphihyd = comlev1, key = ikey_dynamics
566 heimbach 1.37 #endif
567 jmc 1.96 C-- Cycle time-stepping Tracers arrays (T,S,+pTracers)
568     CALL TIMER_START('TS_CORRECTION_STEP [FORWARD_STEP]',myThid)
569     CALL TRACERS_CORRECTION_STEP(myTime, myIter, myThid)
570     CALL TIMER_STOP ('TS_CORRECTION_STEP [FORWARD_STEP]',myThid)
571 adcroft 1.5
572 mlosch 1.110 #ifdef ALLOW_GCHEM
573 mlosch 1.109 C Add separate timestepping of chemical/biological/forcing
574     C of ptracers here in GCHEM_FORCING_SEP
575 mlosch 1.113 IF ( useGCHEM ) THEN
576 mlosch 1.109 #ifdef ALLOW_DEBUG
577 mlosch 1.113 IF ( debugLevel .GE. debLevB )
578     & CALL DEBUG_CALL('GCHEM_FORCING_SEP',myThid)
579 mlosch 1.109 #endif /* ALLOW_DEBUG */
580     CALL TIMER_START('GCHEM_FORCING_SEP [FORWARD_STEP]',myThid)
581 mlosch 1.108 CALL GCHEM_FORCING_SEP( myTime,myIter,myThid )
582 mlosch 1.109 CALL TIMER_STOP ('GCHEM_FORCING_SEP [FORWARD_STEP]',myThid)
583 mlosch 1.108 ENDIF
584 mlosch 1.107 #endif /* ALLOW_GCHEM */
585    
586 adcroft 1.1 C-- Do "blocking" sends and receives for tendency "overlap" terms
587 heimbach 1.36 c CALL TIMER_START('BLOCKING_EXCHANGES [FORWARD_STEP]',myThid)
588 jmc 1.7 c CALL DO_GTERM_BLOCKING_EXCHANGES( myThid )
589 heimbach 1.36 c CALL TIMER_STOP ('BLOCKING_EXCHANGES [FORWARD_STEP]',myThid)
590 adcroft 1.5
591     C-- Do "blocking" sends and receives for field "overlap" terms
592 heimbach 1.36 CALL TIMER_START('BLOCKING_EXCHANGES [FORWARD_STEP]',myThid)
593 adcroft 1.5 CALL DO_FIELDS_BLOCKING_EXCHANGES( myThid )
594 heimbach 1.36 CALL TIMER_STOP ('BLOCKING_EXCHANGES [FORWARD_STEP]',myThid)
595 stephd 1.54
596 molod 1.83
597     C AMM
598     #ifdef ALLOW_GRIDALT
599 molod 1.88 if (useGRIDALT) then
600     CALL GRIDALT_UPDATE(myThid)
601 molod 1.89 endif
602 molod 1.83 #endif
603     C AMM
604 stephd 1.54
605 molod 1.79 C AMM
606     #ifdef ALLOW_FIZHI
607 molod 1.88 if( useFIZHI) then
608 molod 1.90 CALL TIMER_START('FIZHI [FORWARD_STEP]',mythid)
609 molod 1.88 CALL STEP_FIZHI_CORR ( myTime, myIter, myThid )
610 molod 1.90 CALL TIMER_STOP('FIZHI [FORWARD_STEP]',mythid)
611 molod 1.88 endif
612 molod 1.79 #endif
613     C AMM
614 adcroft 1.20
615     #ifdef ALLOW_FLT
616     C-- Calculate float trajectories
617     IF (useFLT) THEN
618 heimbach 1.36 CALL TIMER_START('FLOATS [FORWARD_STEP]',myThid)
619 adcroft 1.20 CALL FLT_MAIN(myIter,myTime, myThid)
620 heimbach 1.36 CALL TIMER_STOP ('FLOATS [FORWARD_STEP]',myThid)
621 adcroft 1.20 ENDIF
622     #endif
623 heimbach 1.12
624 jmc 1.112 C-- State-variables time-averaging
625     CALL TIMER_START('DO_STATEVARS_TAVE [FORWARD_STEP]',myThid)
626     CALL DO_STATEVARS_TAVE( myTime, myIter, myThid )
627     CALL TIMER_STOP ('DO_STATEVARS_TAVE [FORWARD_STEP]',myThid)
628 jmc 1.97
629 stephd 1.101 #ifndef ALLOW_OFFLINE
630 edhill 1.70 #ifdef ALLOW_MONITOR
631 heimbach 1.12 C-- Check status of solution (statistics, cfl, etc...)
632 dimitri 1.45 CALL TIMER_START('MONITOR [FORWARD_STEP]',myThid)
633 heimbach 1.12 CALL MONITOR( myIter, myTime, myThid )
634 heimbach 1.36 CALL TIMER_STOP ('MONITOR [FORWARD_STEP]',myThid)
635 edhill 1.70 #endif /* ALLOW_MONITOR */
636 stephd 1.101 #endif
637 molod 1.86
638 heimbach 1.103 #ifdef ALLOW_COST
639     C-- compare model with data and compute cost function
640     C-- this is done after exchanges to allow interpolation
641     CALL TIMER_START('COST_TILE [FORWARD_STEP]',myThid)
642     CALL COST_TILE ( mytime, myiter, myThid )
643     CALL TIMER_STOP ('COST_TILE [FORWARD_STEP]',myThid)
644     #endif
645    
646 jmc 1.7 C-- Do IO if needed.
647 stephd 1.101 #ifdef ALLOW_OFFLINE
648 heimbach 1.103 CALL TIMER_START('OFFLINE_MODEL_IO [FORWARD_STEP]',myThid)
649 stephd 1.101 CALL OFFLINE_MODEL_IO( myTime, myIter, myThid )
650 heimbach 1.103 CALL TIMER_STOP ('OFFLINE_MODEL_IO [FORWARD_STEP]',myThid)
651 stephd 1.101 #else
652 heimbach 1.36 CALL TIMER_START('DO_THE_MODEL_IO [FORWARD_STEP]',myThid)
653 heimbach 1.12 CALL DO_THE_MODEL_IO( myTime, myIter, myThid )
654 heimbach 1.36 CALL TIMER_STOP ('DO_THE_MODEL_IO [FORWARD_STEP]',myThid)
655 stephd 1.101 #endif
656 adcroft 1.1
657     C-- Save state for restarts
658 heimbach 1.36 CALL TIMER_START('WRITE_CHECKPOINT [FORWARD_STEP]',myThid)
659 jmc 1.77 CALL PACKAGES_WRITE_PICKUP(
660     I .FALSE., myTime, myIter, myThid )
661 stephd 1.101 #ifndef ALLOW_OFFLINE
662 adcroft 1.1 CALL WRITE_CHECKPOINT(
663 jmc 1.77 I .FALSE., myTime, myIter, myThid )
664 stephd 1.101 #endif
665 heimbach 1.36 CALL TIMER_STOP ('WRITE_CHECKPOINT [FORWARD_STEP]',myThid)
666 adcroft 1.53
667 edhill 1.71 #ifdef ALLOW_DEBUG
668 heimbach 1.57 IF ( debugLevel .GE. debLevB )
669     & CALL DEBUG_LEAVE('FORWARD_STEP',myThid)
670 adcroft 1.53 #endif
671 adcroft 1.1
672 jmc 1.77 RETURN
673 adcroft 1.1 END

  ViewVC Help
Powered by ViewVC 1.1.22