/[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.126 - (hide annotations) (download)
Thu Dec 8 00:15:52 2005 UTC (18 years, 5 months ago) by stephd
Branch: MAIN
CVS Tags: checkpoint57y_pre
Changes since 1.125: +7 -1 lines
o add hooks for new package rbcs

1 stephd 1.126 C $Header: /u/gcmpack/MITgcm/model/src/forward_step.F,v 1.125 2005/12/03 08:30:32 edhill 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 stephd 1.126 #ifdef ALLOW_RBCS
268     IF ( useRBCS ) THEN
269     CALL RBCS_FIELDS_LOAD( mytime, myiter, mythid )
270     ENDIF
271     #endif
272    
273 jmc 1.78 #ifdef COMPONENT_MODULE
274 jmc 1.93 IF ( useCoupler .AND. cpl_earlyExpImpCall ) THEN
275 jmc 1.78 C Post coupling data that I export.
276     C Read in coupling data that I import.
277     CALL TIMER_START('CPL_EXPORT-IMPORT [FORWARD_STEP]',myThid)
278     CALL CPL_EXPORT_MY_DATA( myIter, myTime, myThid )
279     CALL CPL_IMPORT_EXTERNAL_DATA( myIter, myTime, myThid )
280     CALL TIMER_STOP ('CPL_EXPORT-IMPORT [FORWARD_STEP]',myThid)
281     ENDIF
282     #endif /* COMPONENT_MODULE */
283 stephd 1.62
284 heimbach 1.92 #ifdef ALLOW_EBM
285     IF ( useEBM ) THEN
286     # ifdef ALLOW_DEBUG
287     IF ( debugLevel .GE. debLevB )
288     & CALL DEBUG_CALL('EBM',myThid)
289     # endif
290     CALL TIMER_START('EBM [FORWARD_STEP]',mythid)
291     CALL EBM_DRIVER ( myTime, myIter, myThid )
292     CALL TIMER_STOP ('EBM [FORWARD_STEP]',mythid)
293     ENDIF
294     #endif
295 molod 1.79
296 jmc 1.97 C-- Step forward fields and calculate time tendency terms.
297    
298     #ifdef ALLOW_DEBUG
299     IF ( debugLevel .GE. debLevB )
300     & CALL DEBUG_CALL('DO_ATMOSPHERIC_PHYS',myThid)
301     #endif
302     CALL TIMER_START('DO_ATMOSPHERIC_PHYS [FORWARD_STEP]',mythid)
303     CALL DO_ATMOSPHERIC_PHYS( myTime, myIter, myThid )
304     CALL TIMER_STOP ('DO_ATMOSPHERIC_PHYS [FORWARD_STEP]',mythid)
305    
306 heimbach 1.104 #ifdef ALLOW_AUTODIFF_TAMC
307     CADJ STORE theta = comlev1, key = ikey_dynamics
308     CADJ STORE salt = comlev1, key = ikey_dynamics
309     CADJ STORE totphihyd = comlev1, key = ikey_dynamics
310     CADJ STORE surfaceforcingtice = comlev1, key = ikey_dynamics
311     # ifdef ALLOW_KPP
312     CADJ STORE uvel = comlev1, key = ikey_dynamics
313     CADJ STORE vvel = comlev1, key = ikey_dynamics
314     # endif
315     # ifdef EXACT_CONSERV
316 heimbach 1.105 CADJ STORE empmr = comlev1, key = ikey_dynamics
317 heimbach 1.104 CADJ STORE pmepr = comlev1, key = ikey_dynamics
318     # endif
319     #endif /* ALLOW_AUTODIFF_TAMC */
320    
321 stephd 1.101 #ifndef ALLOW_OFFLINE
322 edhill 1.71 #ifdef ALLOW_DEBUG
323 jmc 1.96 IF ( debugLevel .GE. debLevB )
324     & CALL DEBUG_CALL('DO_OCEANIC_PHYS',myThid)
325     #endif
326     CALL TIMER_START('DO_OCEANIC_PHYS [FORWARD_STEP]',mythid)
327     CALL DO_OCEANIC_PHYS( myTime, myIter, myThid )
328     CALL TIMER_STOP ('DO_OCEANIC_PHYS [FORWARD_STEP]',mythid)
329 stephd 1.101 #endif
330 jmc 1.96
331 mlosch 1.110 #ifdef ALLOW_GCHEM
332     C GCHEM package is an interface for any bio-geochemical or
333     C ecosystem model you would like to include.
334     C If GCHEM_SEPARATE_FORCING is not defined, you are
335     C responsible for computing tendency terms for passive
336     C tracers and storing them on a 3DxNumPtracers-array called
337     C gchemTendency in GCHEM_CALC_TENDENCY. This tendency is then added
338     C to gPtr in ptracers_forcing later-on.
339     C If GCHEM_SEPARATE_FORCING is defined, you are reponsible for
340     C UPDATING ptracers directly in GCHEM_FORCING_SEP. This amounts
341     C to a completely separate time step that you have to implement
342     C yourself (Eulerian seems to be fine in most cases).
343     CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
344     C CAVEAT: Up to now, when GCHEM is turned on the field ptracerForcingSurf,
345     C which is needed for KPP is not set properly. ptracerForcingSurf must
346     C be treated differently depending on whether GCHEM_SEPARATE_FORCING
347     C is define or not. TBD.
348     CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
349 mlosch 1.113 IF ( useGCHEM ) THEN
350 mlosch 1.110 #ifdef ALLOW_DEBUG
351 mlosch 1.113 IF ( debugLevel .GE. debLevB )
352     & CALL DEBUG_CALL('GCHEM_CALC_TENDENCY',myThid)
353 mlosch 1.110 #endif
354     CALL TIMER_START('GCHEM_CALC_TENDENCY [FORWARD_STEP]',myThid)
355     CALL GCHEM_CALC_TENDENCY( myTime, myIter, myThid )
356     CALL TIMER_STOP ('GCHEM_CALC_TENDENCY [FORWARD_STEP]',myThid)
357     ENDIF
358     #endif /* ALLOW_GCHEM */
359 mlosch 1.109
360 heimbach 1.104 #ifdef ALLOW_AUTODIFF_TAMC
361     cph needed to be moved here from do_oceanic_physics
362     cph to be visible down the road
363     c
364     CADJ STORE surfaceForcingS = comlev1, key = ikey_dynamics
365     CADJ STORE surfaceForcingT = comlev1, key = ikey_dynamics
366     CADJ STORE surfaceForcingTice = comlev1, key = ikey_dynamics
367     ctest(
368 heimbach 1.105 CADJ STORE IVDConvCount = comlev1, key = ikey_dynamics
369     ctest)
370     # ifdef ALLOW_PTRACERS
371     CADJ STORE surfaceForcingPtr = comlev1, key = ikey_dynamics
372 heimbach 1.104 # endif
373     c
374     # ifdef ALLOW_GMREDI
375     CADJ STORE Kwx = comlev1, key = ikey_dynamics
376     CADJ STORE Kwy = comlev1, key = ikey_dynamics
377     CADJ STORE Kwz = comlev1, key = ikey_dynamics
378     # ifdef GM_BOLUS_ADVEC
379     CADJ STORE GM_PsiX = comlev1, key = ikey_dynamics
380     CADJ STORE GM_PsiY = comlev1, key = ikey_dynamics
381     # endif
382     # endif
383     c
384     # ifdef ALLOW_KPP
385     CADJ STORE KPPghat = comlev1, key = ikey_dynamics
386     CADJ STORE KPPfrac = comlev1, key = ikey_dynamics
387 heimbach 1.105 CADJ STORE KPPdiffKzS = comlev1, key = ikey_dynamics
388     CADJ STORE KPPdiffKzT = comlev1, key = ikey_dynamics
389 heimbach 1.104 # endif
390     #endif /* ALLOW_AUTODIFF_TAMC */
391    
392 jmc 1.96 IF ( .NOT.staggerTimeStep ) THEN
393     #ifdef ALLOW_DEBUG
394     IF ( debugLevel .GE. debLevB )
395 heimbach 1.57 & CALL DEBUG_CALL('THERMODYNAMICS',myThid)
396 adcroft 1.53 #endif
397 heimbach 1.36 CALL TIMER_START('THERMODYNAMICS [FORWARD_STEP]',mythid)
398 adcroft 1.15 CALL THERMODYNAMICS( myTime, myIter, myThid )
399 heimbach 1.36 CALL TIMER_STOP ('THERMODYNAMICS [FORWARD_STEP]',mythid)
400 jmc 1.96 C-- if not staggerTimeStep: end
401 dimitri 1.45 ENDIF
402 jmc 1.93
403     #ifdef COMPONENT_MODULE
404     IF ( useCoupler .AND. .NOT.cpl_earlyExpImpCall ) THEN
405     C Post coupling data that I export.
406     C Read in coupling data that I import.
407     myItP1 = myIter + 1
408     CALL TIMER_START('CPL_EXPORT-IMPORT [FORWARD_STEP]',myThid)
409     CALL CPL_EXPORT_MY_DATA( myItP1, myTime, myThid )
410     CALL CPL_IMPORT_EXTERNAL_DATA( myItP1, myTime, myThid )
411     CALL TIMER_STOP ('CPL_EXPORT-IMPORT [FORWARD_STEP]',myThid)
412     # ifndef ALLOW_AIM
413     IF ( useRealFreshWaterFlux ) THEN
414     CALL OCN_APPLY_IMPORT( .FALSE., myTime, myIter, myThid )
415     ENDIF
416     # endif
417     ENDIF
418     #endif /* COMPONENT_MODULE */
419 heimbach 1.12
420 dimitri 1.45 C-- Step forward fields and calculate time tendency terms.
421 stephd 1.101 #ifndef ALLOW_OFFLINE
422 heimbach 1.61 #ifndef ALLOW_AUTODIFF_TAMC
423 dimitri 1.45 IF ( momStepping ) THEN
424 heimbach 1.61 #endif
425 edhill 1.71 #ifdef ALLOW_DEBUG
426 heimbach 1.57 IF ( debugLevel .GE. debLevB )
427     & CALL DEBUG_CALL('DYNAMICS',myThid)
428 adcroft 1.53 #endif
429 heimbach 1.36 CALL TIMER_START('DYNAMICS [FORWARD_STEP]',mythid)
430 heimbach 1.12 CALL DYNAMICS( myTime, myIter, myThid )
431 heimbach 1.36 CALL TIMER_STOP ('DYNAMICS [FORWARD_STEP]',mythid)
432 heimbach 1.61 #ifndef ALLOW_AUTODIFF_TAMC
433 dimitri 1.45 ENDIF
434 heimbach 1.61 #endif
435 stephd 1.101 #endif
436 heimbach 1.12
437 jmc 1.96 C-- Update time-counter
438     myIter = nIter0 + iLoop
439     myTime = startTime + deltaTClock * float(iLoop)
440    
441 edhill 1.119 #ifdef ALLOW_MNC
442     C Update the default next iter for MNC
443     IF ( useMNC ) THEN
444 jmc 1.120 CALL MNC_CW_CITER_SETG( 1, 1, -1, myIter , myThid )
445 edhill 1.119
446     C TODO: Logic should be added here so that users can specify, on
447     C a per-citer-group basis, when it is time to update the
448     C "current" (and not just the "next") iteration
449 edhill 1.121
450     C TODO: the following is just a temporary band-aid (mostly, for
451     C Baylor) until someone writes a routine that better handles time
452     C boundaries such as weeks, months, years, etc.
453     IF ( mnc_filefreq .GT. 0 ) THEN
454     IF (DIFFERENT_MULTIPLE(mnc_filefreq,myTime,deltaTClock))
455     & THEN
456     CALL MNC_CW_CITER_SETG( 1, 1, myIter, -1 , myThid )
457     ENDIF
458     ENDIF
459 edhill 1.119 ENDIF
460     #endif
461    
462 jmc 1.96 C-- Update geometric factors:
463 jmc 1.18 #ifdef NONLIN_FRSURF
464 jmc 1.96 C- update hfacC,W,S and recip_hFac according to etaH(n+1) :
465 jmc 1.18 IF ( nonlinFreeSurf.GT.0) THEN
466 jmc 1.48 IF ( select_rStar.GT.0 ) THEN
467     CALL TIMER_START('UPDATE_R_STAR [FORWARD_STEP]',myThid)
468     CALL UPDATE_R_STAR( myTime, myIter, myThid )
469     CALL TIMER_STOP ('UPDATE_R_STAR [FORWARD_STEP]',myThid)
470     ELSE
471 dimitri 1.45 CALL TIMER_START('UPDATE_SURF_DR [FORWARD_STEP]',myThid)
472 jmc 1.18 CALL UPDATE_SURF_DR( myTime, myIter, myThid )
473 heimbach 1.36 CALL TIMER_STOP ('UPDATE_SURF_DR [FORWARD_STEP]',myThid)
474 jmc 1.48 ENDIF
475 jmc 1.18 ENDIF
476     C- update also CG2D matrix (and preconditioner)
477 jmc 1.33 IF ( momStepping .AND. nonlinFreeSurf.GT.2 ) THEN
478 dimitri 1.45 CALL TIMER_START('UPDATE_CG2D [FORWARD_STEP]',myThid)
479 jmc 1.18 CALL UPDATE_CG2D( myTime, myIter, myThid )
480 jmc 1.47 CALL TIMER_STOP ('UPDATE_CG2D [FORWARD_STEP]',myThid)
481 adcroft 1.19 ENDIF
482 jmc 1.18 #endif
483 adcroft 1.1
484 jmc 1.27 C-- Apply Filters to u*,v* before SOLVE_FOR_PRESSURE
485     #ifdef ALLOW_SHAP_FILT
486     IF (useSHAP_FILT .AND. shap_filt_uvStar) THEN
487 jmc 1.122 CALL TIMER_START('SHAP_FILT_UV [FORWARD_STEP]',myThid)
488 jmc 1.27 IF (implicDiv2Dflow.LT.1.) THEN
489     C-- Explicit+Implicit part of the Barotropic Flow Divergence
490     C => Filtering of uVel,vVel is necessary
491 jmc 1.59 CALL SHAP_FILT_APPLY_UV( uVel,vVel,
492 jmc 1.96 & myTime, myIter, myThid )
493 jmc 1.27 ENDIF
494 jmc 1.96 CALL SHAP_FILT_APPLY_UV( gU,gV,myTime,myIter,myThid)
495 jmc 1.122 CALL TIMER_STOP ('SHAP_FILT_UV [FORWARD_STEP]',myThid)
496 jmc 1.27 ENDIF
497     #endif
498     #ifdef ALLOW_ZONAL_FILT
499     IF (useZONAL_FILT .AND. zonal_filt_uvStar) THEN
500 jmc 1.122 CALL TIMER_START('ZONAL_FILT_UV [FORWARD_STEP]',myThid)
501 jmc 1.27 IF (implicDiv2Dflow.LT.1.) THEN
502     C-- Explicit+Implicit part of the Barotropic Flow Divergence
503     C => Filtering of uVel,vVel is necessary
504     CALL ZONAL_FILT_APPLY_UV( uVel, vVel, myThid )
505     ENDIF
506 jmc 1.59 CALL ZONAL_FILT_APPLY_UV( gU, gV, myThid )
507 jmc 1.122 CALL TIMER_STOP ('ZONAL_FILT_UV [FORWARD_STEP]',myThid)
508 jmc 1.27 ENDIF
509     #endif
510 heimbach 1.12
511 adcroft 1.1 C-- Solve elliptic equation(s).
512     C Two-dimensional only for conventional hydrostatic or
513     C three-dimensional for non-hydrostatic and/or IGW scheme.
514 stephd 1.101 #ifndef ALLOW_OFFLINE
515 adcroft 1.19 IF ( momStepping ) THEN
516 jmc 1.96 CALL TIMER_START('SOLVE_FOR_PRESSURE [FORWARD_STEP]',myThid)
517     CALL SOLVE_FOR_PRESSURE(myTime, myIter, myThid)
518     CALL TIMER_STOP ('SOLVE_FOR_PRESSURE [FORWARD_STEP]',myThid)
519     ENDIF
520 stephd 1.101 #endif
521 jmc 1.96
522     C-- Correct divergence in flow field and cycle time-stepping momentum
523     c IF ( momStepping ) THEN
524 stephd 1.101 #ifndef ALLOW_OFFLINE
525 jmc 1.122 CALL TIMER_START('MOM_CORRECTION_STEP [FORWARD_STEP]',myThid)
526 jmc 1.96 CALL MOMENTUM_CORRECTION_STEP(myTime, myIter, myThid)
527 jmc 1.122 CALL TIMER_STOP ('MOM_CORRECTION_STEP [FORWARD_STEP]',myThid)
528 stephd 1.101 #endif
529 jmc 1.96 c ENDIF
530    
531     #ifdef EXACT_CONSERV
532     IF (exactConserv) THEN
533     C-- Update etaH(n+1) :
534 jmc 1.122 CALL TIMER_START('UPDATE_ETAH [FORWARD_STEP]',mythid)
535 jmc 1.96 CALL UPDATE_ETAH( myTime, myIter, myThid )
536 jmc 1.122 CALL TIMER_STOP ('UPDATE_ETAH [FORWARD_STEP]',mythid)
537 adcroft 1.19 ENDIF
538 jmc 1.96 #endif /* EXACT_CONSERV */
539    
540     #ifdef NONLIN_FRSURF
541     IF ( select_rStar.NE.0 ) THEN
542     C-- r* : compute the future level thickness according to etaH(n+1)
543     CALL TIMER_START('CALC_R_STAR [FORWARD_STEP]',mythid)
544     CALL CALC_R_STAR(etaH, myTime, myIter, myThid )
545     CALL TIMER_STOP ('CALC_R_STAR [FORWARD_STEP]',mythid)
546     ELSEIF ( nonlinFreeSurf.GT.0) THEN
547     C-- compute the future surface level thickness according to etaH(n+1)
548     CALL TIMER_START('CALC_SURF_DR [FORWARD_STEP]',mythid)
549     CALL CALC_SURF_DR(etaH, myTime, myIter, myThid )
550     CALL TIMER_STOP ('CALC_SURF_DR [FORWARD_STEP]',mythid)
551     ENDIF
552     #endif /* NONLIN_FRSURF */
553    
554     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
555     IF ( staggerTimeStep ) THEN
556 jmc 1.98 C-- do exchanges of U,V (needed for multiDim) when using stagger time-step :
557     #ifdef ALLOW_DEBUG
558     IF ( debugLevel .GE. debLevB )
559     & CALL DEBUG_CALL('DO_STAGGER_FIELDS_EXCH.',myThid)
560     #endif
561     CALL TIMER_START('BLOCKING_EXCHANGES [FORWARD_STEP]',myThid)
562     CALL DO_STAGGER_FIELDS_EXCHANGES( myTime, myIter, myThid )
563     CALL TIMER_STOP ('BLOCKING_EXCHANGES [FORWARD_STEP]',myThid)
564 jmc 1.96
565 jmc 1.112 C-- State-variables diagnostics
566     IF ( usediagnostics ) THEN
567     CALL TIMER_START('DO_STATEVARS_DIAGS [FORWARD_STEP]',myThid)
568     CALL DO_STATEVARS_DIAGS( myTime, 1, myIter, myThid )
569     CALL TIMER_STOP ('DO_STATEVARS_DIAGS [FORWARD_STEP]',myThid)
570     ENDIF
571    
572 jmc 1.96 #ifdef ALLOW_DEBUG
573     IF ( debugLevel .GE. debLevB )
574     & CALL DEBUG_CALL('THERMODYNAMICS',myThid)
575     #endif
576     CALL TIMER_START('THERMODYNAMICS [FORWARD_STEP]',mythid)
577     CALL THERMODYNAMICS( myTime, myIter, myThid )
578     CALL TIMER_STOP ('THERMODYNAMICS [FORWARD_STEP]',mythid)
579    
580     C-- if staggerTimeStep: end
581     ENDIF
582     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
583 adcroft 1.1
584 heimbach 1.37 #ifdef ALLOW_AUTODIFF_TAMC
585     cph This is needed because convective_adjustment calls
586     cph find_rho which may use pressure()
587 heimbach 1.51 CADJ STORE totphihyd = comlev1, key = ikey_dynamics
588 heimbach 1.37 #endif
589 jmc 1.96 C-- Cycle time-stepping Tracers arrays (T,S,+pTracers)
590 jmc 1.122 CALL TIMER_START('TRC_CORRECTION_STEP [FORWARD_STEP]',myThid)
591 jmc 1.96 CALL TRACERS_CORRECTION_STEP(myTime, myIter, myThid)
592 jmc 1.122 CALL TIMER_STOP ('TRC_CORRECTION_STEP [FORWARD_STEP]',myThid)
593 adcroft 1.5
594 mlosch 1.110 #ifdef ALLOW_GCHEM
595 mlosch 1.109 C Add separate timestepping of chemical/biological/forcing
596     C of ptracers here in GCHEM_FORCING_SEP
597 mlosch 1.113 IF ( useGCHEM ) THEN
598 mlosch 1.109 #ifdef ALLOW_DEBUG
599 mlosch 1.113 IF ( debugLevel .GE. debLevB )
600     & CALL DEBUG_CALL('GCHEM_FORCING_SEP',myThid)
601 mlosch 1.109 #endif /* ALLOW_DEBUG */
602     CALL TIMER_START('GCHEM_FORCING_SEP [FORWARD_STEP]',myThid)
603 mlosch 1.108 CALL GCHEM_FORCING_SEP( myTime,myIter,myThid )
604 mlosch 1.109 CALL TIMER_STOP ('GCHEM_FORCING_SEP [FORWARD_STEP]',myThid)
605 mlosch 1.108 ENDIF
606 mlosch 1.107 #endif /* ALLOW_GCHEM */
607    
608 adcroft 1.1 C-- Do "blocking" sends and receives for tendency "overlap" terms
609 heimbach 1.36 c CALL TIMER_START('BLOCKING_EXCHANGES [FORWARD_STEP]',myThid)
610 jmc 1.7 c CALL DO_GTERM_BLOCKING_EXCHANGES( myThid )
611 heimbach 1.36 c CALL TIMER_STOP ('BLOCKING_EXCHANGES [FORWARD_STEP]',myThid)
612 adcroft 1.5
613     C-- Do "blocking" sends and receives for field "overlap" terms
614 heimbach 1.36 CALL TIMER_START('BLOCKING_EXCHANGES [FORWARD_STEP]',myThid)
615 adcroft 1.5 CALL DO_FIELDS_BLOCKING_EXCHANGES( myThid )
616 heimbach 1.36 CALL TIMER_STOP ('BLOCKING_EXCHANGES [FORWARD_STEP]',myThid)
617 stephd 1.54
618 molod 1.83
619     C AMM
620     #ifdef ALLOW_GRIDALT
621 molod 1.88 if (useGRIDALT) then
622     CALL GRIDALT_UPDATE(myThid)
623 molod 1.89 endif
624 molod 1.83 #endif
625     C AMM
626 stephd 1.54
627 molod 1.79 C AMM
628     #ifdef ALLOW_FIZHI
629 molod 1.88 if( useFIZHI) then
630 molod 1.90 CALL TIMER_START('FIZHI [FORWARD_STEP]',mythid)
631 molod 1.88 CALL STEP_FIZHI_CORR ( myTime, myIter, myThid )
632 molod 1.90 CALL TIMER_STOP('FIZHI [FORWARD_STEP]',mythid)
633 molod 1.88 endif
634 molod 1.79 #endif
635     C AMM
636 adcroft 1.20
637     #ifdef ALLOW_FLT
638     C-- Calculate float trajectories
639     IF (useFLT) THEN
640 heimbach 1.36 CALL TIMER_START('FLOATS [FORWARD_STEP]',myThid)
641 adcroft 1.20 CALL FLT_MAIN(myIter,myTime, myThid)
642 heimbach 1.36 CALL TIMER_STOP ('FLOATS [FORWARD_STEP]',myThid)
643 adcroft 1.20 ENDIF
644     #endif
645 heimbach 1.12
646 jmc 1.112 C-- State-variables time-averaging
647     CALL TIMER_START('DO_STATEVARS_TAVE [FORWARD_STEP]',myThid)
648     CALL DO_STATEVARS_TAVE( myTime, myIter, myThid )
649     CALL TIMER_STOP ('DO_STATEVARS_TAVE [FORWARD_STEP]',myThid)
650 jmc 1.97
651 stephd 1.101 #ifndef ALLOW_OFFLINE
652 edhill 1.70 #ifdef ALLOW_MONITOR
653 heimbach 1.12 C-- Check status of solution (statistics, cfl, etc...)
654 dimitri 1.45 CALL TIMER_START('MONITOR [FORWARD_STEP]',myThid)
655 heimbach 1.12 CALL MONITOR( myIter, myTime, myThid )
656 heimbach 1.36 CALL TIMER_STOP ('MONITOR [FORWARD_STEP]',myThid)
657 edhill 1.70 #endif /* ALLOW_MONITOR */
658 stephd 1.101 #endif
659 molod 1.86
660 heimbach 1.103 #ifdef ALLOW_COST
661     C-- compare model with data and compute cost function
662     C-- this is done after exchanges to allow interpolation
663     CALL TIMER_START('COST_TILE [FORWARD_STEP]',myThid)
664     CALL COST_TILE ( mytime, myiter, myThid )
665     CALL TIMER_STOP ('COST_TILE [FORWARD_STEP]',myThid)
666     #endif
667    
668 jmc 1.7 C-- Do IO if needed.
669 stephd 1.101 #ifdef ALLOW_OFFLINE
670 heimbach 1.103 CALL TIMER_START('OFFLINE_MODEL_IO [FORWARD_STEP]',myThid)
671 stephd 1.101 CALL OFFLINE_MODEL_IO( myTime, myIter, myThid )
672 heimbach 1.103 CALL TIMER_STOP ('OFFLINE_MODEL_IO [FORWARD_STEP]',myThid)
673 stephd 1.101 #else
674 heimbach 1.36 CALL TIMER_START('DO_THE_MODEL_IO [FORWARD_STEP]',myThid)
675 heimbach 1.12 CALL DO_THE_MODEL_IO( myTime, myIter, myThid )
676 heimbach 1.36 CALL TIMER_STOP ('DO_THE_MODEL_IO [FORWARD_STEP]',myThid)
677 stephd 1.101 #endif
678 adcroft 1.1
679 edhill 1.125 #ifdef HAVE_SIGREG
680     IF ( useSIGREG ) THEN
681     IF ( i_got_signal .GT. 0 ) THEN
682     CALL PACKAGES_WRITE_PICKUP(
683     I .TRUE., myTime, myIter, myThid )
684     #ifndef ALLOW_OFFLINE
685     CALL WRITE_CHECKPOINT(
686     I .TRUE., myTime, myIter, myThid )
687     #endif
688     STOP 'Checkpoint completed -- killed by signal handler'
689     ENDIF
690     ENDIF
691     #endif
692    
693 adcroft 1.1 C-- Save state for restarts
694 heimbach 1.36 CALL TIMER_START('WRITE_CHECKPOINT [FORWARD_STEP]',myThid)
695 jmc 1.77 CALL PACKAGES_WRITE_PICKUP(
696     I .FALSE., myTime, myIter, myThid )
697 stephd 1.101 #ifndef ALLOW_OFFLINE
698 adcroft 1.1 CALL WRITE_CHECKPOINT(
699 jmc 1.77 I .FALSE., myTime, myIter, myThid )
700 stephd 1.101 #endif
701 heimbach 1.36 CALL TIMER_STOP ('WRITE_CHECKPOINT [FORWARD_STEP]',myThid)
702 adcroft 1.53
703 edhill 1.71 #ifdef ALLOW_DEBUG
704 heimbach 1.57 IF ( debugLevel .GE. debLevB )
705     & CALL DEBUG_LEAVE('FORWARD_STEP',myThid)
706 adcroft 1.53 #endif
707 adcroft 1.1
708 jmc 1.77 RETURN
709 adcroft 1.1 END

  ViewVC Help
Powered by ViewVC 1.1.22