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