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

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

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

revision 1.32 by heimbach, Thu May 30 02:32:14 2002 UTC revision 1.135 by jmc, Fri Mar 17 04:24:34 2006 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
4    #include "PACKAGES_CONFIG.h"
5  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
6    
7    #ifdef ALLOW_GMREDI
8    # include "GMREDI_OPTIONS.h"
9    #endif
10    
11  CBOP  CBOP
12  C     !ROUTINE: FORWARD_STEP  C     !ROUTINE: FORWARD_STEP
13  C     !INTERFACE:  C     !INTERFACE:
# Line 17  C     | Line 22  C     |
22  C     | THE_MAIN_LOOP is the toplevel routine for the Tangent Linear and  C     | THE_MAIN_LOOP is the toplevel routine for the Tangent Linear and
23  C     | Adjoint Model Compiler (TAMC). For this purpose the initialization  C     | Adjoint Model Compiler (TAMC). For this purpose the initialization
24  C     | of the model was split into two parts. Those parameters that do  C     | of the model was split into two parts. Those parameters that do
25  C     | not depend on a specific model run are set in INITIALISE_FIXED,    C     | not depend on a specific model run are set in INITIALISE_FIXED,
26  C     | whereas those that do depend on the specific realization are  C     | whereas those that do depend on the specific realization are
27  C     | initialized in INITIALISE_VARIA.    C     | initialized in INITIALISE_VARIA.
28  C     |  C     |
29  C     *==================================================================  C     *==================================================================
30  C     \ev  C     \ev
# Line 31  C     == Global variables == Line 36  C     == Global variables ==
36  #include "EEPARAMS.h"  #include "EEPARAMS.h"
37  #include "PARAMS.h"  #include "PARAMS.h"
38  #include "DYNVARS.h"  #include "DYNVARS.h"
 #include "FFIELDS.h"  
39    
40  #ifdef ALLOW_NONHYDROSTATIC  #ifdef ALLOW_MNC
41  #include "CG3D.h"  #include "MNC_PARAMS.h"
42          EXTERNAL DIFFERENT_MULTIPLE
43          LOGICAL  DIFFERENT_MULTIPLE
44    #endif
45    
46    #ifdef HAVE_SIGREG
47    #include "SIGREG.h"
48  #endif  #endif
49    
50  #ifdef ALLOW_SHAP_FILT  #ifdef ALLOW_SHAP_FILT
51  #include "SHAP_FILT.h"  # include "SHAP_FILT.h"
52  #endif  #endif
53  #ifdef ALLOW_ZONAL_FILT  #ifdef ALLOW_ZONAL_FILT
54  #include "ZONAL_FILT.h"  # include "ZONAL_FILT.h"
55    #endif
56    #ifdef COMPONENT_MODULE
57    # include "CPL_PARAMS.h"
58  #endif  #endif
59    
60  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
61    # include "FFIELDS.h"
62    
63  # include "tamc.h"  # include "tamc.h"
64  # include "ctrl.h"  # include "ctrl.h"
65  # include "ctrl_dummy.h"  # include "ctrl_dummy.h"
66  # include "cost.h"  # include "cost.h"
67  # ifdef INCLUDE_EXTERNAL_FORCING_PACKAGE  # include "EOS.h"
68    # ifdef NONLIN_FRSURF
69    #  include "GRID.h"
70    # endif
71    # ifdef ALLOW_EXF
72  #  include "exf_fields.h"  #  include "exf_fields.h"
73    #  include "exf_clim_fields.h"
74  #  ifdef ALLOW_BULKFORMULAE  #  ifdef ALLOW_BULKFORMULAE
75  #   include "exf_constants.h"  #   include "exf_constants.h"
76  #  endif  #  endif
# Line 58  C     == Global variables == Line 78  C     == Global variables ==
78  # ifdef ALLOW_OBCS  # ifdef ALLOW_OBCS
79  #  include "OBCS.h"  #  include "OBCS.h"
80  # endif  # endif
81  #endif  # ifdef ALLOW_PTRACERS
82    #  include "PTRACERS_SIZE.h"
83    #  include "PTRACERS.h"
84    # endif
85    # ifdef ALLOW_CD_CODE
86    #  include "CD_CODE_VARS.h"
87    # endif
88    # ifdef ALLOW_EBM
89    #  include "EBM.h"
90    # endif
91    # ifdef EXACT_CONSERV
92    #  include "SURFACE.h"
93    # endif
94    # ifdef ALLOW_KPP
95    #  include "KPP.h"
96    # endif
97    # ifdef ALLOW_GMREDI
98    #  include "GMREDI.h"
99    # endif
100    #endif /* ALLOW_AUTODIFF_TAMC */
101    
102  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
103  C     == Routine arguments ==  C     == Routine arguments ==
# Line 67  C           mytime are local variables p Line 106  C           mytime are local variables p
106  C           arguments. Although this is fiddly it saves the need to  C           arguments. Although this is fiddly it saves the need to
107  C           impose additional synchronisation points when they are  C           impose additional synchronisation points when they are
108  C           updated.  C           updated.
109  C     myiter - iteration counter for this thread  C     myIter - iteration counter for this thread
110  C     mytime - time counter for this thread  C     myTime - time counter for this thread
111  C     mythid - thread number for this instance of the routine.  C     myThid - thread number for this instance of the routine.
112        integer iloop        INTEGER iloop
113        integer mythid        INTEGER myThid
114        integer myiter        INTEGER myIter
115        _RL     mytime        _RL     myTime
116        INTEGER bi,bj  
117    C     == Local variables ==
118    #ifdef COMPONENT_MODULE
119          INTEGER myItP1
120    #endif
121  CEOP  CEOP
122    
123    #ifdef ALLOW_DEBUG
124          IF ( debugLevel .GE. debLevB )
125         &    CALL DEBUG_ENTER('FORWARD_STEP',myThid)
126    #endif
127    
128  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
129  C--     Reset the model iteration counter and the model time.  C--   Reset the model iteration counter and the model time.
130          myiter = nIter0 + (iloop-1)        myIter = nIter0 + (iloop-1)
131          mytime = startTime + float(iloop-1)*deltaTclock        myTime = startTime + float(iloop-1)*deltaTclock
132    #endif
133    
134    #ifdef ALLOW_AUTODIFF_TAMC
135    c**************************************
136    #include "checkpoint_lev1_directives.h"
137    c**************************************
138    #endif
139    
140    C--   Switch on/off diagnostics for snap-shot output:
141    #ifdef ALLOW_DIAGNOSTICS
142          IF ( useDiagnostics ) THEN
143            CALL DIAGNOSTICS_SWITCH_ONOFF( myTime, myIter, myThid )
144    C--   State-variables diagnostics
145            CALL TIMER_START('DO_STATEVARS_DIAGS  [FORWARD_STEP]',myThid)
146            CALL DO_STATEVARS_DIAGS( myTime, 0, myIter, myThid )
147            CALL TIMER_STOP ('DO_STATEVARS_DIAGS  [FORWARD_STEP]',myThid)
148          ENDIF
149    #endif
150    
151    C--   Call Bulk-Formulae forcing package
152    #ifdef ALLOW_BULK_FORCE
153          IF ( useBulkForce ) THEN
154    #ifdef ALLOW_DEBUG
155           IF ( debugLevel .GE. debLevB )
156         &    CALL DEBUG_CALL('BULKF_FIELDS_LOAD',myThid)
157    #endif
158           CALL TIMER_START('BULKF_FORCING      [FORWARD_STEP]',mythid)
159    C-    load all forcing fields at current time
160           CALL BULKF_FIELDS_LOAD( myTime, myIter, myThid )
161    C-    calculate qnet and empmr (and wind stress)
162           CALL BULKF_FORCING( myTime, myIter, myThid )
163           CALL TIMER_STOP ('BULKF_FORCING      [FORWARD_STEP]',mythid)
164          ENDIF
165    #endif /* ALLOW_BULK_FORCE */
166    
167    C--   Call external forcing package
168    # ifdef ALLOW_EXF
169    #  ifdef ALLOW_DEBUG
170          IF ( debugLevel .GE. debLevB )
171         &    CALL DEBUG_CALL('EXF_GETFORCING',myThid)
172    #  endif
173          CALL TIMER_START('EXF_GETFORCING     [FORWARD_STEP]',mythid)
174          CALL EXF_GETFORCING( mytime, myiter, mythid )
175          CALL TIMER_STOP ('EXF_GETFORCING     [FORWARD_STEP]',mythid)
176    # else /* ALLOW_EXF undef */
177    cph The following IF-statement creates an additional dependency
178    cph for the forcing fields requiring additional storing.
179    cph Therefore, the IF-statement will be put between CPP-OPTIONS,
180    cph assuming that ALLOW_SEAICE has not yet been differentiated.
181    #  if (defined (ALLOW_SEAICE) || defined (ALLOW_EBM))
182          IF ( .NOT. useSEAICE .AND. .NOT. useEBM ) THEN
183    #  endif
184    #ifdef ALLOW_DEBUG
185           IF ( debugLevel .GE. debLevB )
186         &    CALL DEBUG_CALL('EXTERNAL_FIELDS_LOAD',myThid)
187    #endif
188           CALL TIMER_START('EXTERNAL_FIELDS_LOAD[FORWARD_STEP]',mythid)
189           CALL EXTERNAL_FIELDS_LOAD( mytime, myiter, mythid )
190           CALL TIMER_STOP ('EXTERNAL_FIELDS_LOAD[FORWARD_STEP]',mythid)
191    # ifdef NONLIN_FRSURF
192    CADJ STORE SST    = comlev1, key = ikey_dynamics
193    CADJ STORE SSS    = comlev1, key = ikey_dynamics
194    #  ifdef SHORTWAVE_HEATING
195    CADJ STORE Qsw    = comlev1, key = ikey_dynamics
196    #  endif
197    # endif
198    #  if (defined (ALLOW_SEAICE) || defined (ALLOW_EBM))
199          ENDIF
200    #  endif
201    # endif /* ALLOW_EXF */
202    
203    #ifdef ALLOW_AUTODIFF
204    c--   Add control vector for forcing and parameter fields
205          if ( myiter .EQ. nIter0 )
206         &     CALL CTRL_MAP_FORCING (mythid)
207  #endif  #endif
208    
209  #if (defined (ALLOW_AUTODIFF_TAMC) && defined (ALLOW_AUTODIFF_MONITOR))  #if (defined (ALLOW_AUTODIFF_TAMC) && defined (ALLOW_AUTODIFF_MONITOR))
210  C       Include call to a dummy routine. Its adjoint will be  C     Include call to a dummy routine. Its adjoint will be
211  C       called at the proper place in the adjoint code.  C     called at the proper place in the adjoint code.
212  C       The adjoint routine will print out adjoint values  C     The adjoint routine will print out adjoint values
213  C       if requested. The location of the call is important,  C     if requested. The location of the call is important,
214  C       it has to be after the adjoint of the exchanges  C     it has to be after the adjoint of the exchanges
215  C       (DO_GTERM_BLOCKING_EXCHANGES).  C     (DO_GTERM_BLOCKING_EXCHANGES).
216          CALL DUMMY_IN_STEPPING( myTime, myIter, myThid )        CALL DUMMY_IN_STEPPING( myTime, myIter, myThid )
217          CALL DO_FIELDS_BLOCKING_EXCHANGES( myThid )  cph   I've commented this line since it may conflict with MITgcm's adjoint
218    cph   However, need to check whether that's still consistent
219    cph   with the ecco-branch (it should).
220    cph      CALL DO_FIELDS_BLOCKING_EXCHANGES( myThid )
221    #endif
222    
223    # ifdef ALLOW_SEAICE
224    C--   Call sea ice model to compute forcing/external data fields.  In
225    C     addition to computing prognostic sea-ice variables and diagnosing the
226    C     forcing/external data fields that drive the ocean model, SEAICE_MODEL
227    C     also sets theta to the freezing point under sea-ice.  The implied
228    C     surface heat flux is then stored in variable surfaceTendencyTice,
229    C     which is needed by KPP package (kpp_calc.F and kpp_transport_t.F)
230    C     to diagnose surface buoyancy fluxes and for the non-local transport
231    C     term.  Because this call precedes model thermodynamics, temperature
232    C     under sea-ice may not be "exactly" at the freezing point by the time
233    C     theta is dumped or time-averaged.
234          IF ( useSEAICE ) THEN
235    #ifdef ALLOW_DEBUG
236             IF ( debugLevel .GE. debLevB )
237         &    CALL DEBUG_CALL('SEAICE_MODEL',myThid)
238    #endif
239             CALL TIMER_START('SEAICE_MODEL       [FORWARD_STEP]',myThid)
240             CALL SEAICE_MODEL( myTime, myIter, myThid )
241             CALL TIMER_STOP ('SEAICE_MODEL       [FORWARD_STEP]',myThid)
242          ENDIF
243    # endif /* ALLOW_SEAICE */
244    
245    #ifdef ALLOW_AUTODIFF_TAMC
246    # ifdef ALLOW_PTRACERS
247    cph this replaces _bibj storing of ptracer within thermodynamics
248    CADJ STORE ptracer  = comlev1, key = ikey_dynamics
249    # endif
250  #endif  #endif
251    
252  #ifdef EXACT_CONSERV  #ifdef ALLOW_OFFLINE
253        IF (exactConserv) THEN        IF ( useOffLine ) THEN
254  C--   Update etaH(n+1) :          CALL TIMER_START('OFFLINE_FIELDS_LOAD [FORWARD_STEP]',myThid)
255          DO bj=myByLo(myThid),myByHi(myThid)  #ifdef ALLOW_DEBUG
256           DO bi=myBxLo(myThid),myBxHi(myThid)          IF ( debugLevel .GE. debLevB )
257             CALL CALC_EXACT_ETA( .FALSE., bi,bj, uVel,vVel,       &        CALL DEBUG_CALL('OFFLINE_FIELDS_LOAD',myThid)
258       I                          myTime, myIter, myThid )  #endif /* ALLOW_DEBUG */
259           ENDDO          CALL OFFLINE_FIELDS_LOAD( myTime, myIter, myThid )
260          ENDDO          CALL TIMER_STOP ('OFFLINE_FIELDS_LOAD [FORWARD_STEP]',myThid)
         IF (implicDiv2Dflow .NE. 1. _d 0 .OR. useOBCS )  
      &     _EXCH_XY_R8(etaH, myThid )  
261        ENDIF        ENDIF
262  #endif /* EXACT_CONSERV */  #endif /* ALLOW_OFFLINE */
263    
264  #ifdef NONLIN_FRSURF  #ifdef ALLOW_GCHEM
265  C--   compute the future surface level thickness          IF ( useGCHEM ) THEN
266  C      according to etaH(n+1)  #ifdef ALLOW_DEBUG
267          IF ( nonlinFreeSurf.GT.0) THEN           IF ( debugLevel .GE. debLevB )
268            CALL CALC_SURF_DR(etaH, myTime, myIter, myThid )       &        CALL DEBUG_CALL('GCHEM_FIELDS_LOAD',myThid)
269    #endif /* ALLOW_DEBUG */
270             CALL GCHEM_FIELDS_LOAD( mytime, myiter, mythid )
271          ENDIF          ENDIF
272  #endif /* NONLIN_FRSURF */  #endif /* ALLOW_GCHEM */
273    
274    #ifdef ALLOW_RBCS
275            IF ( useRBCS ) THEN
276             CALL RBCS_FIELDS_LOAD( mytime, myiter, mythid )
277            ENDIF
278    #endif
279    
280    #ifdef COMPONENT_MODULE
281           IF ( useCoupler .AND. cpl_earlyExpImpCall ) THEN
282    C      Post coupling data that I export.
283    C      Read in coupling data that I import.
284             CALL TIMER_START('CPL_EXPORT-IMPORT  [FORWARD_STEP]',myThid)
285             CALL CPL_EXPORT_MY_DATA(       myIter, myTime, myThid )
286             CALL CPL_IMPORT_EXTERNAL_DATA( myIter, myTime, myThid )
287             CALL TIMER_STOP ('CPL_EXPORT-IMPORT  [FORWARD_STEP]',myThid)
288           ENDIF
289    #endif /* COMPONENT_MODULE */
290    
291    #ifdef ALLOW_EBM
292            IF ( useEBM ) THEN
293    # ifdef ALLOW_DEBUG
294             IF ( debugLevel .GE. debLevB )
295         &    CALL DEBUG_CALL('EBM',myThid)
296    # endif
297             CALL TIMER_START('EBM                [FORWARD_STEP]',mythid)
298             CALL EBM_DRIVER ( myTime, myIter, myThid )
299             CALL TIMER_STOP ('EBM                [FORWARD_STEP]',mythid)
300            ENDIF
301    #endif
302    
303    C--     Step forward fields and calculate time tendency terms.
304    
305    #ifdef ALLOW_DEBUG
306           IF ( debugLevel .GE. debLevB )
307         &    CALL DEBUG_CALL('DO_ATMOSPHERIC_PHYS',myThid)
308    #endif
309           CALL TIMER_START('DO_ATMOSPHERIC_PHYS [FORWARD_STEP]',mythid)
310           CALL DO_ATMOSPHERIC_PHYS( myTime, myIter, myThid )
311           CALL TIMER_STOP ('DO_ATMOSPHERIC_PHYS [FORWARD_STEP]',mythid)
312    
 C--     Load forcing/external data fields.  
 #ifdef INCLUDE_EXTERNAL_FORCING_PACKAGE  
 C       NOTE, that although the exf package is part of the  
 C       distribution, it is not currently maintained, i.e.  
 C       exf is disabled by default in genmake.  
313  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
314  c**************************************  # ifdef ALLOW_KPP
315  #include "checkpoint_lev1_directives.h"  CADJ STORE uvel               = comlev1, key = ikey_dynamics
316  c**************************************  CADJ STORE vvel               = comlev1, key = ikey_dynamics
317    # endif
318    # ifdef EXACT_CONSERV
319    cphCADJ STORE empmr              = comlev1, key = ikey_dynamics
320    cphCADJ STORE pmepr              = comlev1, key = ikey_dynamics
321    # endif
322    # ifdef NONLIN_FRSURF
323    cph-test
324    CADJ STORE hFacC              = comlev1, key = ikey_dynamics
325    # endif
326    #endif /* ALLOW_AUTODIFF_TAMC */
327    
328    #ifndef ALLOW_AUTODIFF_TAMC
329           IF ( .NOT. useOffLine ) THEN
330  #endif  #endif
331          CALL EXF_GETFORCING( mytime, myiter, mythid )  #ifdef ALLOW_DEBUG
332           IF ( debugLevel .GE. debLevB )
333         &    CALL DEBUG_CALL('DO_OCEANIC_PHYS',myThid)
334    #endif
335           CALL TIMER_START('DO_OCEANIC_PHYS     [FORWARD_STEP]',mythid)
336           CALL DO_OCEANIC_PHYS( myTime, myIter, myThid )
337           CALL TIMER_STOP ('DO_OCEANIC_PHYS     [FORWARD_STEP]',mythid)
338    #ifdef ALLOW_AUTODIFF_TAMC
339    CADJ STORE EmPmR    = comlev1, key = ikey_dynamics
340    # ifdef EXACT_CONSERV
341    CADJ STORE pmepr    = comlev1, key = ikey_dynamics
342    # endif
343  #else  #else
344          CALL TIMER_START('EXTERNAL_FIELDS_LOAD[THE_MAIN_LOOP]',mythid)         ENDIF
         CALL EXTERNAL_FIELDS_LOAD( mytime, myiter, mythid )  
         CALL TIMER_STOP ('EXTERNAL_FIELDS_LOAD[THE_MAIN_LOOP]',mythid)  
345  #endif  #endif
346    
347  C--     Step forward fields and calculate time tendency terms.  #ifdef ALLOW_AUTODIFF_TAMC
348          CALL TIMER_START('THERMODYNAMICS      [THE_MAIN_LOOP]',mythid)  # ifdef NONLIN_FRSURF
349          CALL THERMODYNAMICS( myTime, myIter, myThid )  cph-test
350          CALL TIMER_STOP ('THERMODYNAMICS      [THE_MAIN_LOOP]',mythid)  CADJ STORE hFac_surfC         = comlev1, key = ikey_dynamics
351    CADJ STORE hfac_surfs         = comlev1, key = ikey_dynamics
352    CADJ STORE hfac_surfw         = comlev1, key = ikey_dynamics
353    CADJ STORE hFacC, hFacS, hFacW
354    CADJ &     = comlev1, key = ikey_dynamics
355    CADJ STORE recip_hFacC, recip_hFacS, recip_hFacW
356    CADJ &     = comlev1, key = ikey_dynamics
357    c
358    CADJ STORE surfaceforcingu = comlev1, key = ikey_dynamics
359    CADJ STORE surfaceforcingv = comlev1, key = ikey_dynamics
360    # endif
361    #endif /* ALLOW_AUTODIFF_TAMC */
362    
363  #ifdef ALLOW_SHAP_FILT  #ifdef ALLOW_GCHEM
364         IF (useSHAP_FILT .AND.  C     GCHEM package is an interface for any bio-geochemical or
365       &     staggerTimeStep .AND. shap_filt_TrStagg ) THEN  C     ecosystem model you would like to include.
366          CALL TIMER_START('SHAP_FILT           [THE_MAIN_LOOP]',myThid)  C     If GCHEM_SEPARATE_FORCING is not defined, you are
367          CALL SHAP_FILT_APPLY_TS( gT, gS, myTime, myIter, myThid )  C     responsible for computing tendency terms for passive
368          CALL TIMER_STOP ('SHAP_FILT           [THE_MAIN_LOOP]',myThid)  C     tracers and storing them on a 3DxNumPtracers-array called
369    C     gchemTendency in GCHEM_CALC_TENDENCY. This tendency is then added
370    C     to gPtr in ptracers_forcing later-on.
371    C     If GCHEM_SEPARATE_FORCING is defined, you are reponsible for
372    C     UPDATING ptracers directly in GCHEM_FORCING_SEP. This amounts
373    C     to a completely separate time step that you have to implement
374    C     yourself (Eulerian seems to be fine in most cases).
375    CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
376    C     CAVEAT: Up to now, when GCHEM is turned on the field ptracerForcingSurf,
377    C     which is needed for KPP is not set properly. ptracerForcingSurf must
378    C     be treated differently depending on whether GCHEM_SEPARATE_FORCING
379    C     is define or not. TBD.
380    CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
381           IF ( useGCHEM ) THEN
382    #ifdef ALLOW_DEBUG
383            IF ( debugLevel .GE. debLevB )
384         &       CALL DEBUG_CALL('GCHEM_CALC_TENDENCY',myThid)
385    #endif
386            CALL TIMER_START('GCHEM_CALC_TENDENCY [FORWARD_STEP]',myThid)
387            CALL GCHEM_CALC_TENDENCY( myTime, myIter, myThid )
388            CALL TIMER_STOP ('GCHEM_CALC_TENDENCY [FORWARD_STEP]',myThid)
389         ENDIF         ENDIF
390    #endif /* ALLOW_GCHEM */
391    
392    #ifdef ALLOW_AUTODIFF_TAMC
393    cph needed to be moved here from do_oceanic_physics
394    cph to be visible down the road
395    c
396    CADJ STORE surfaceForcingS    = comlev1, key = ikey_dynamics
397    CADJ STORE surfaceForcingT    = comlev1, key = ikey_dynamics
398    CADJ STORE surfaceForcingTice = comlev1, key = ikey_dynamics
399    ctest(
400    CADJ STORE IVDConvCount       = comlev1, key = ikey_dynamics
401    ctest)
402    # ifdef ALLOW_PTRACERS
403    CADJ STORE surfaceForcingPtr  = comlev1, key = ikey_dynamics
404    # endif
405    c
406    # ifdef ALLOW_GMREDI
407    CADJ STORE Kwx                = comlev1, key = ikey_dynamics
408    CADJ STORE Kwy                = comlev1, key = ikey_dynamics
409    CADJ STORE Kwz                = comlev1, key = ikey_dynamics
410    #  ifdef GM_BOLUS_ADVEC
411    CADJ STORE GM_PsiX            = comlev1, key = ikey_dynamics
412    CADJ STORE GM_PsiY            = comlev1, key = ikey_dynamics
413    #  endif
414    # endif
415    c
416    # ifdef ALLOW_KPP
417    CADJ STORE KPPghat            = comlev1, key = ikey_dynamics
418    CADJ STORE KPPfrac            = comlev1, key = ikey_dynamics
419    CADJ STORE KPPdiffKzS         = comlev1, key = ikey_dynamics
420    CADJ STORE KPPdiffKzT         = comlev1, key = ikey_dynamics
421    # endif
422    c
423    # ifdef NONLIN_FRSURF
424    CADJ STORE etaH               = comlev1, key = ikey_dynamics
425    #  ifdef ALLOW_CD_CODE
426    CADJ STORE etanm1             = comlev1, key = ikey_dynamics
427    #  endif
428    # endif
429    #endif /* ALLOW_AUTODIFF_TAMC */
430    
431          IF ( .NOT.staggerTimeStep ) THEN
432    #ifdef ALLOW_DEBUG
433            IF ( debugLevel .GE. debLevB )
434         &    CALL DEBUG_CALL('THERMODYNAMICS',myThid)
435  #endif  #endif
436  #ifdef ALLOW_ZONAL_FILT          CALL TIMER_START('THERMODYNAMICS      [FORWARD_STEP]',mythid)
437         IF (useZONAL_FILT .AND.          CALL THERMODYNAMICS( myTime, myIter, myThid )
438       &     staggerTimeStep .AND. zonal_filt_TrStagg ) THEN          CALL TIMER_STOP ('THERMODYNAMICS      [FORWARD_STEP]',mythid)
439          CALL TIMER_START('ZONAL_FILT_APPLY    [THE_MAIN_LOOP]',myThid)  C--    if not staggerTimeStep: end
440          CALL ZONAL_FILT_APPLY_TS( gT, gS, myThid )        ENDIF
441          CALL TIMER_STOP ('ZONAL_FILT_APPLY    [THE_MAIN_LOOP]',myThid)  c #ifdef ALLOW_NONHYDROSTATIC
442          IF ( implicitIntGravWave ) THEN
443            CALL TIMER_START('BLOCKING_EXCHANGES  [FORWARD_STEP]',myThid)
444            CALL DO_STAGGER_FIELDS_EXCHANGES( myTime, myIter, myThid )
445            CALL TIMER_STOP ('BLOCKING_EXCHANGES  [FORWARD_STEP]',myThid)
446        ENDIF        ENDIF
447  #endif    c #endif
448    
449  C--     Step forward fields and calculate time tendency terms.  #ifdef COMPONENT_MODULE
450          IF ( momStepping ) THEN         IF ( useCoupler .AND. .NOT.cpl_earlyExpImpCall ) THEN
451          CALL TIMER_START('DYNAMICS            [THE_MAIN_LOOP]',mythid)  C      Post coupling data that I export.
452          CALL DYNAMICS( myTime, myIter, myThid )  C      Read in coupling data that I import.
453          CALL TIMER_STOP ('DYNAMICS            [THE_MAIN_LOOP]',mythid)           myItP1 = myIter + 1
454             CALL TIMER_START('CPL_EXPORT-IMPORT  [FORWARD_STEP]',myThid)
455             CALL CPL_EXPORT_MY_DATA(       myItP1, myTime, myThid )
456             CALL CPL_IMPORT_EXTERNAL_DATA( myItP1, myTime, myThid )
457             CALL TIMER_STOP ('CPL_EXPORT-IMPORT  [FORWARD_STEP]',myThid)
458    # ifndef ALLOW_AIM
459            IF ( useRealFreshWaterFlux ) THEN
460             CALL OCN_APPLY_IMPORT( .FALSE., myTime, myIter, myThid )
461          ENDIF          ENDIF
462    # endif
463           ENDIF
464    #endif /* COMPONENT_MODULE */
465    
466  #ifdef ALLOW_NONHYDROSTATIC  #ifdef ALLOW_AUTODIFF_TAMC
467  C--   Step forward W field in N-H algorithm  # ifdef NONLIN_FRSURF
468          IF ( momStepping .AND. nonHydrostatic ) THEN  CADJ STORE hFacC          = comlev1, key = ikey_dynamics
469            CALL TIMER_START('CALC_GW          [THE_MAIN_LOOP]',myThid)  CADJ STORE hFacS          = comlev1, key = ikey_dynamics
470            CALL CALC_GW(myThid)  CADJ STORE hFacW          = comlev1, key = ikey_dynamics
471            CALL TIMER_STOP ('CALC_GW          [THE_MAIN_LOOP]',myThid)  CADJ STORE recip_hFacC    = comlev1, key = ikey_dynamics
472          ENDIF  CADJ STORE recip_hFacS    = comlev1, key = ikey_dynamics
473    CADJ STORE recip_hFacW    = comlev1, key = ikey_dynamics
474    CADJ STORE etaN           = comlev1, key = ikey_dynamics
475    # endif
476    #endif
477    C--   Step forward fields and calculate time tendency terms.
478    #ifndef ALLOW_AUTODIFF_TAMC
479          IF ( momStepping ) THEN
480    #endif
481    #ifdef ALLOW_DEBUG
482            IF ( debugLevel .GE. debLevB )
483         &    CALL DEBUG_CALL('DYNAMICS',myThid)
484    #endif
485            CALL TIMER_START('DYNAMICS            [FORWARD_STEP]',mythid)
486            CALL DYNAMICS( myTime, myIter, myThid )
487            CALL TIMER_STOP ('DYNAMICS            [FORWARD_STEP]',mythid)
488    #ifndef ALLOW_AUTODIFF_TAMC
489          ENDIF
490    #endif
491    
492    #ifdef ALLOW_AUTODIFF_TAMC
493    # ifdef NONLIN_FRSURF
494    cph-test
495    CADJ STORE gU, gV  = comlev1, key = ikey_dynamics
496    # endif
497    #endif
498    
499    C--   Update time-counter
500          myIter = nIter0 + iLoop
501          myTime = startTime + deltaTClock * float(iLoop)
502    
503    #ifdef ALLOW_MNC
504    C     Update the default next iter for MNC
505          IF ( useMNC ) THEN
506             CALL MNC_CW_CITER_SETG( 1, 1, -1, myIter , myThid )
507    
508    C        TODO: Logic should be added here so that users can specify, on
509    C        a per-citer-group basis, when it is time to update the
510    C        "current" (and not just the "next") iteration
511    
512    C        TODO: the following is just a temporary band-aid (mostly, for
513    C        Baylor) until someone writes a routine that better handles time
514    C        boundaries such as weeks, months, years, etc.
515             IF ( mnc_filefreq .GT. 0 ) THEN
516               IF (DIFFERENT_MULTIPLE(mnc_filefreq,myTime,deltaTClock))
517         &          THEN
518                 CALL MNC_CW_CITER_SETG( 1, 1, myIter, -1 , myThid )
519               ENDIF
520             ENDIF
521           ENDIF
522  #endif  #endif
523    
524    C--   Update geometric factors:
525  #ifdef NONLIN_FRSURF  #ifdef NONLIN_FRSURF
526  C--   update hfacC,W,S and recip_hFac according to etaH(n+1) :  C-    update hfacC,W,S and recip_hFac according to etaH(n+1) :
       IF ( momStepping ) THEN  
527        IF ( nonlinFreeSurf.GT.0) THEN        IF ( nonlinFreeSurf.GT.0) THEN
528           IF ( select_rStar.GT.0 ) THEN
529    # ifndef DISABLE_RSTAR_CODE
530    # ifdef ALLOW_AUTODIFF_TAMC
531    cph-test
532    CADJ STORE hFacC    = comlev1, key = ikey_dynamics
533    CADJ STORE hFacS    = comlev1, key = ikey_dynamics
534    CADJ STORE hFacW    = comlev1, key = ikey_dynamics
535    CADJ STORE recip_hFacC    = comlev1, key = ikey_dynamics
536    CADJ STORE recip_hFacS    = comlev1, key = ikey_dynamics
537    CADJ STORE recip_hFacW    = comlev1, key = ikey_dynamics
538    # endif
539            CALL TIMER_START('UPDATE_R_STAR      [FORWARD_STEP]',myThid)
540            CALL UPDATE_R_STAR( myTime, myIter, myThid )
541            CALL TIMER_STOP ('UPDATE_R_STAR      [FORWARD_STEP]',myThid)
542    # ifdef ALLOW_AUTODIFF_TAMC
543    cph-test
544    CADJ STORE hFacC    = comlev1, key = ikey_dynamics
545    CADJ STORE hFacS    = comlev1, key = ikey_dynamics
546    CADJ STORE hFacW    = comlev1, key = ikey_dynamics
547    CADJ STORE recip_hFacC    = comlev1, key = ikey_dynamics
548    CADJ STORE recip_hFacS    = comlev1, key = ikey_dynamics
549    CADJ STORE recip_hFacW    = comlev1, key = ikey_dynamics
550    # endif
551    # endif /* DISABLE_RSTAR_CODE */
552           ELSE
553    #ifdef ALLOW_AUTODIFF_TAMC
554    CADJ STORE hFac_surfC, hFac_surfS, hFac_surfW
555    CADJ &     = comlev1, key = ikey_dynamics
556    #endif
557            CALL TIMER_START('UPDATE_SURF_DR     [FORWARD_STEP]',myThid)
558          CALL UPDATE_SURF_DR( myTime, myIter, myThid )          CALL UPDATE_SURF_DR( myTime, myIter, myThid )
559            CALL TIMER_STOP ('UPDATE_SURF_DR     [FORWARD_STEP]',myThid)
560           ENDIF
561        ENDIF        ENDIF
562    # ifdef ALLOW_AUTODIFF_TAMC
563    cph-test
564    CADJ STORE hFacC    = comlev1, key = ikey_dynamics
565    CADJ STORE hFacS    = comlev1, key = ikey_dynamics
566    CADJ STORE hFacW    = comlev1, key = ikey_dynamics
567    CADJ STORE recip_hFacC    = comlev1, key = ikey_dynamics
568    CADJ STORE recip_hFacS    = comlev1, key = ikey_dynamics
569    CADJ STORE recip_hFacW    = comlev1, key = ikey_dynamics
570    # endif
571  C-    update also CG2D matrix (and preconditioner)  C-    update also CG2D matrix (and preconditioner)
572        IF ( nonlinFreeSurf.GT.2) THEN        IF ( momStepping .AND. nonlinFreeSurf.GT.2 ) THEN
573            CALL TIMER_START('UPDATE_CG2D        [FORWARD_STEP]',myThid)
574          CALL UPDATE_CG2D( myTime, myIter, myThid )          CALL UPDATE_CG2D( myTime, myIter, myThid )
575            CALL TIMER_STOP ('UPDATE_CG2D        [FORWARD_STEP]',myThid)
576        ENDIF        ENDIF
577        ENDIF  #endif /* NONLIN_FRSURF */
 #endif  
578    
579  C--   Apply Filters to u*,v* before SOLVE_FOR_PRESSURE  C--   Apply Filters to u*,v* before SOLVE_FOR_PRESSURE
580  #ifdef ALLOW_SHAP_FILT  #ifdef ALLOW_SHAP_FILT
581        IF (useSHAP_FILT .AND. shap_filt_uvStar) THEN        IF (useSHAP_FILT .AND. shap_filt_uvStar) THEN
582          CALL TIMER_START('SHAP_FILT           [THE_MAIN_LOOP]',myThid)          CALL TIMER_START('SHAP_FILT_UV        [FORWARD_STEP]',myThid)
         CALL SHAP_FILT_APPLY_UV( gUnm1,gVnm1, myTime,myIter,myThid )  
583          IF (implicDiv2Dflow.LT.1.) THEN          IF (implicDiv2Dflow.LT.1.) THEN
584  C--   Explicit+Implicit part of the Barotropic Flow Divergence  C--   Explicit+Implicit part of the Barotropic Flow Divergence
585  C      => Filtering of uVel,vVel is necessary  C      => Filtering of uVel,vVel is necessary
586            CALL SHAP_FILT_APPLY_UV( uVel,vVel, myTime,myIter,myThid )            CALL SHAP_FILT_APPLY_UV( uVel,vVel,
587         &                             myTime, myIter, myThid )
588          ENDIF          ENDIF
589          CALL TIMER_STOP ('SHAP_FILT           [THE_MAIN_LOOP]',myThid)          CALL SHAP_FILT_APPLY_UV( gU,gV,myTime,myIter,myThid)
590            CALL TIMER_STOP ('SHAP_FILT_UV        [FORWARD_STEP]',myThid)
591        ENDIF        ENDIF
592  #endif  #endif
593  #ifdef ALLOW_ZONAL_FILT  #ifdef ALLOW_ZONAL_FILT
594        IF (useZONAL_FILT .AND. zonal_filt_uvStar) THEN        IF (useZONAL_FILT .AND. zonal_filt_uvStar) THEN
595          CALL TIMER_START('ZONAL_FILT_APPLY    [THE_MAIN_LOOP]',myThid)          CALL TIMER_START('ZONAL_FILT_UV       [FORWARD_STEP]',myThid)
         CALL ZONAL_FILT_APPLY_UV( gUnm1, gVnm1, myThid )  
596          IF (implicDiv2Dflow.LT.1.) THEN          IF (implicDiv2Dflow.LT.1.) THEN
597  C--   Explicit+Implicit part of the Barotropic Flow Divergence  C--   Explicit+Implicit part of the Barotropic Flow Divergence
598  C      => Filtering of uVel,vVel is necessary  C      => Filtering of uVel,vVel is necessary
599            CALL ZONAL_FILT_APPLY_UV( uVel, vVel, myThid )            CALL ZONAL_FILT_APPLY_UV( uVel, vVel, myThid )
600          ENDIF          ENDIF
601          CALL TIMER_STOP ('ZONAL_FILT_APPLY    [THE_MAIN_LOOP]',myThid)          CALL ZONAL_FILT_APPLY_UV( gU, gV, myThid )
602            CALL TIMER_STOP ('ZONAL_FILT_UV       [FORWARD_STEP]',myThid)
603        ENDIF        ENDIF
604  #endif    #endif
605    
606  C--   Solve elliptic equation(s).  C--   Solve elliptic equation(s).
607  C     Two-dimensional only for conventional hydrostatic or  C     Two-dimensional only for conventional hydrostatic or
608  C     three-dimensional for non-hydrostatic and/or IGW scheme.  C     three-dimensional for non-hydrostatic and/or IGW scheme.
609        IF ( momStepping ) THEN        IF ( momStepping ) THEN
610        CALL TIMER_START('SOLVE_FOR_PRESSURE  [THE_MAIN_LOOP]',myThid)  #ifdef ALLOW_AUTODIFF_TAMC
611        CALL SOLVE_FOR_PRESSURE(myTime, myIter, myThid)  # ifdef NONLIN_FRSURF
612        CALL TIMER_STOP ('SOLVE_FOR_PRESSURE  [THE_MAIN_LOOP]',myThid)  CADJ STORE uvel, vvel
613    CADJ &     = comlev1, key = ikey_dynamics
614    CADJ STORE empmr,hfacs,hfacw
615    CADJ &     = comlev1, key = ikey_dynamics
616    # endif
617    #endif
618            CALL TIMER_START('SOLVE_FOR_PRESSURE  [FORWARD_STEP]',myThid)
619            CALL SOLVE_FOR_PRESSURE(myTime, myIter, myThid)
620            CALL TIMER_STOP ('SOLVE_FOR_PRESSURE  [FORWARD_STEP]',myThid)
621        ENDIF        ENDIF
622    
623  C--   Correct divergence in flow field and cycle time-stepping  C--   Correct divergence in flow field and cycle time-stepping momentum
624  C     arrays (for all fields) ; update time-counter  #ifndef ALLOW_AUTODIFF_TAMC
625        myIter = nIter0 + iLoop        IF ( momStepping ) THEN
626        myTime = startTime + deltaTClock * float(iLoop)  #endif
627        CALL TIMER_START('THE_CORRECTION_STEP [THE_MAIN_LOOP]',myThid)          CALL TIMER_START('MOM_CORRECTION_STEP [FORWARD_STEP]',myThid)
628        CALL THE_CORRECTION_STEP(myTime, myIter, myThid)          CALL MOMENTUM_CORRECTION_STEP(myTime, myIter, myThid)
629        CALL TIMER_STOP ('THE_CORRECTION_STEP [THE_MAIN_LOOP]',myThid)          CALL TIMER_STOP ('MOM_CORRECTION_STEP [FORWARD_STEP]',myThid)
630    #ifndef ALLOW_AUTODIFF_TAMC
631          ENDIF
632    #endif
633    
634    #ifdef EXACT_CONSERV
635          IF (exactConserv) THEN
636    #ifdef ALLOW_AUTODIFF_TAMC
637    cph-test
638    cphCADJ STORE etaH          = comlev1, key = ikey_dynamics
639    #endif
640    C--   Update etaH(n+1) :
641            CALL TIMER_START('UPDATE_ETAH         [FORWARD_STEP]',mythid)
642            CALL UPDATE_ETAH( myTime, myIter, myThid )
643            CALL TIMER_STOP ('UPDATE_ETAH         [FORWARD_STEP]',mythid)
644          ENDIF
645    #endif /* EXACT_CONSERV */
646    
647    #ifdef NONLIN_FRSURF
648          IF ( select_rStar.NE.0 ) THEN
649    # ifndef DISABLE_RSTAR_CODE
650    C--   r* : compute the future level thickness according to etaH(n+1)
651            CALL TIMER_START('CALC_R_STAR       [FORWARD_STEP]',mythid)
652            CALL CALC_R_STAR(etaH, myTime, myIter, myThid )
653            CALL TIMER_STOP ('CALC_R_STAR       [FORWARD_STEP]',mythid)
654    # endif /* DISABLE_RSTAR_CODE */
655          ELSEIF ( nonlinFreeSurf.GT.0) THEN
656    C--   compute the future surface level thickness according to etaH(n+1)
657    # ifdef ALLOW_AUTODIFF_TAMC
658    CADJ STORE etaH          = comlev1, key = ikey_dynamics
659    # endif
660            CALL TIMER_START('CALC_SURF_DR      [FORWARD_STEP]',mythid)
661            CALL CALC_SURF_DR(etaH, myTime, myIter, myThid )
662            CALL TIMER_STOP ('CALC_SURF_DR      [FORWARD_STEP]',mythid)
663          ENDIF
664    # ifdef ALLOW_AUTODIFF_TAMC
665    cph-test
666    CADJ STORE hFac_surfC    = comlev1, key = ikey_dynamics
667    # endif
668    #endif /* NONLIN_FRSURF */
669    
670    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
671          IF ( staggerTimeStep ) THEN
672    C--   do exchanges of U,V (needed for multiDim) when using stagger time-step :
673    #ifdef ALLOW_DEBUG
674            IF ( debugLevel .GE. debLevB )
675         &    CALL DEBUG_CALL('DO_STAGGER_FIELDS_EXCH.',myThid)
676    #endif
677            CALL TIMER_START('BLOCKING_EXCHANGES  [FORWARD_STEP]',myThid)
678            CALL DO_STAGGER_FIELDS_EXCHANGES( myTime, myIter, myThid )
679            CALL TIMER_STOP ('BLOCKING_EXCHANGES  [FORWARD_STEP]',myThid)
680    
681    #ifdef ALLOW_DIAGNOSTICS
682    C--   State-variables diagnostics
683           IF ( useDiagnostics ) THEN
684            CALL TIMER_START('DO_STATEVARS_DIAGS  [FORWARD_STEP]',myThid)
685            CALL DO_STATEVARS_DIAGS( myTime, 1, myIter, myThid )
686            CALL TIMER_STOP ('DO_STATEVARS_DIAGS  [FORWARD_STEP]',myThid)
687           ENDIF
688    #endif
689    
690    #ifdef ALLOW_DEBUG
691            IF ( debugLevel .GE. debLevB )
692         &    CALL DEBUG_CALL('THERMODYNAMICS',myThid)
693    #endif
694            CALL TIMER_START('THERMODYNAMICS      [FORWARD_STEP]',mythid)
695            CALL THERMODYNAMICS( myTime, myIter, myThid )
696            CALL TIMER_STOP ('THERMODYNAMICS      [FORWARD_STEP]',mythid)
697    
698    C--    if staggerTimeStep: end
699          ENDIF
700    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
701    
702    #ifdef ALLOW_AUTODIFF_TAMC
703    cph This is needed because convective_adjustment calls
704    cph find_rho which may use pressure()
705    CADJ STORE totphihyd  = comlev1, key = ikey_dynamics
706    #endif
707    C--   Cycle time-stepping Tracers arrays (T,S,+pTracers)
708            CALL TIMER_START('TRC_CORRECTION_STEP [FORWARD_STEP]',myThid)
709            CALL TRACERS_CORRECTION_STEP(myTime, myIter, myThid)
710            CALL TIMER_STOP ('TRC_CORRECTION_STEP [FORWARD_STEP]',myThid)
711    
712    #ifdef ALLOW_GCHEM
713    C     Add separate timestepping of chemical/biological/forcing
714    C     of ptracers here in GCHEM_FORCING_SEP
715            IF ( useGCHEM ) THEN
716    #ifdef ALLOW_DEBUG
717             IF ( debugLevel .GE. debLevB )
718         &        CALL DEBUG_CALL('GCHEM_FORCING_SEP',myThid)
719    #endif /* ALLOW_DEBUG */
720             CALL TIMER_START('GCHEM_FORCING_SEP  [FORWARD_STEP]',myThid)
721             CALL GCHEM_FORCING_SEP( myTime,myIter,myThid )
722             CALL TIMER_STOP ('GCHEM_FORCING_SEP  [FORWARD_STEP]',myThid)
723            ENDIF  
724    #endif /* ALLOW_GCHEM */
725    
726  C--   Do "blocking" sends and receives for tendency "overlap" terms  C--   Do "blocking" sends and receives for tendency "overlap" terms
727  c     CALL TIMER_START('BLOCKING_EXCHANGES  [THE_MAIN_LOOP]',myThid)  c     CALL TIMER_START('BLOCKING_EXCHANGES  [FORWARD_STEP]',myThid)
728  c     CALL DO_GTERM_BLOCKING_EXCHANGES( myThid )  c     CALL DO_GTERM_BLOCKING_EXCHANGES( myThid )
729  c     CALL TIMER_STOP ('BLOCKING_EXCHANGES  [THE_MAIN_LOOP]',myThid)  c     CALL TIMER_STOP ('BLOCKING_EXCHANGES  [FORWARD_STEP]',myThid)
730    
731  C--   Do "blocking" sends and receives for field "overlap" terms  C--   Do "blocking" sends and receives for field "overlap" terms
732        CALL TIMER_START('BLOCKING_EXCHANGES  [THE_MAIN_LOOP]',myThid)        CALL TIMER_START('BLOCKING_EXCHANGES  [FORWARD_STEP]',myThid)
733        CALL DO_FIELDS_BLOCKING_EXCHANGES( myThid )        CALL DO_FIELDS_BLOCKING_EXCHANGES( myThid )
734        CALL TIMER_STOP ('BLOCKING_EXCHANGES  [THE_MAIN_LOOP]',myThid)        CALL TIMER_STOP ('BLOCKING_EXCHANGES  [FORWARD_STEP]',myThid)
735    
736    #ifdef ALLOW_DIAGNOSTICS
737          IF ( useDiagnostics ) THEN
738           CALL TIMER_START('DO_STATEVARS_DIAGS  [FORWARD_STEP]',myThid)
739           CALL DO_STATEVARS_DIAGS( myTime, 2, myIter, myThid )
740           CALL TIMER_STOP ('DO_STATEVARS_DIAGS  [FORWARD_STEP]',myThid)
741          ENDIF
742    #endif
743    
744    C AMM
745    #ifdef ALLOW_GRIDALT
746            if (useGRIDALT) then
747             CALL GRIDALT_UPDATE(myThid)
748            endif
749    #endif
750    C AMM
751    
752    C AMM
753    #ifdef ALLOW_FIZHI
754            if( useFIZHI) then
755             CALL TIMER_START('FIZHI               [FORWARD_STEP]',mythid)
756             CALL STEP_FIZHI_CORR ( myTime, myIter, myThid, dTtracerLev(1) )
757             CALL TIMER_STOP('FIZHI               [FORWARD_STEP]',mythid)
758            endif
759    #endif
760    C AMM
761    
762  #ifdef ALLOW_FLT  #ifdef ALLOW_FLT
763  C--   Calculate float trajectories  C--   Calculate float trajectories
764        IF (useFLT) THEN        IF (useFLT) THEN
765          CALL TIMER_START('FLOATS            [THE_MAIN_LOOP]',myThid)          CALL TIMER_START('FLOATS            [FORWARD_STEP]',myThid)
766          CALL FLT_MAIN(myIter,myTime, myThid)          CALL FLT_MAIN(myIter,myTime, myThid)
767          CALL TIMER_STOP ('FLOATS            [THE_MAIN_LOOP]',myThid)          CALL TIMER_STOP ('FLOATS            [FORWARD_STEP]',myThid)
768        ENDIF        ENDIF
769  #endif  #endif
770    
771  #ifndef EXCLUDE_MONITOR  #ifdef ALLOW_TIMEAVE
772    C--   State-variables time-averaging
773          CALL TIMER_START('DO_STATEVARS_TAVE   [FORWARD_STEP]',myThid)
774          CALL DO_STATEVARS_TAVE( myTime, myIter, myThid )
775          CALL TIMER_STOP ('DO_STATEVARS_TAVE   [FORWARD_STEP]',myThid)
776    #endif
777    
778    #ifdef ALLOW_MONITOR
779          IF ( .NOT.useOffLine ) THEN
780  C--   Check status of solution (statistics, cfl, etc...)  C--   Check status of solution (statistics, cfl, etc...)
781        CALL MONITOR( myIter, myTime, myThid )          CALL TIMER_START('MONITOR             [FORWARD_STEP]',myThid)
782  #endif /* EXCLUDE_MONITOR */          CALL MONITOR( myIter, myTime, myThid )
783            CALL TIMER_STOP ('MONITOR             [FORWARD_STEP]',myThid)
784          ENDIF
785    #endif /* ALLOW_MONITOR */
786    
787    #ifdef ALLOW_COST
788    C--     compare model with data and compute cost function
789    C--     this is done after exchanges to allow interpolation
790          CALL TIMER_START('COST_TILE           [FORWARD_STEP]',myThid)
791          CALL COST_TILE  ( mytime, myiter, myThid )
792          CALL TIMER_STOP ('COST_TILE           [FORWARD_STEP]',myThid)
793    #endif
794    
 #ifndef ALLOW_AUTODIFF_TAMC  
795  C--   Do IO if needed.  C--   Do IO if needed.
796        CALL TIMER_START('DO_THE_MODEL_IO     [THE_MAIN_LOOP]',myThid)        CALL TIMER_START('DO_THE_MODEL_IO     [FORWARD_STEP]',myThid)
797        CALL DO_THE_MODEL_IO( myTime, myIter, myThid )        CALL DO_THE_MODEL_IO( myTime, myIter, myThid )
798        CALL TIMER_STOP ('DO_THE_MODEL_IO     [THE_MAIN_LOOP]',myThid)        CALL TIMER_STOP ('DO_THE_MODEL_IO     [FORWARD_STEP]',myThid)
799    
800    #ifdef HAVE_SIGREG
801          IF ( useSIGREG ) THEN
802            IF ( i_got_signal .GT. 0 ) THEN
803              CALL PACKAGES_WRITE_PICKUP(
804         I         .TRUE., myTime, myIter, myThid )
805              CALL WRITE_CHECKPOINT(
806         I         .TRUE., myTime, myIter, myThid )
807              STOP 'Checkpoint completed -- killed by signal handler'
808            ENDIF
809          ENDIF
810    #endif /* HAVE_SIGREG */
811    
812  C--   Save state for restarts  C--   Save state for restarts
813  C     Note:    (jmc: is it still the case after ckp35 ?)        CALL TIMER_START('WRITE_CHECKPOINT    [FORWARD_STEP]',myThid)
814  C     =====        CALL PACKAGES_WRITE_PICKUP(
815  C     Because of the ordering of the timestepping code and       I               .FALSE., myTime, myIter, myThid )
 C     tendency term code at end of loop model arrays hold  
 C     U,V,T,S  at "time-level" N but gu, gv, gs, gt, guNM1,...  
 C     at "time-level" N+1/2 (guNM1 at "time-level" N+1/2 is  
 C     gu at "time-level" N-1/2) and etaN at "time-level" N+1/2.  
 C      where N = I+timeLevBase-1  
 C     Thus a checkpoint contains U.0000000000, GU.0000000001 and  
 C     etaN.0000000001 in the indexing scheme used for the model  
 C     "state" files. This example is referred to as a checkpoint  
 C     at time level 1  
       CALL TIMER_START('WRITE_CHECKPOINT    [THE_MAIN_LOOP]',myThid)  
816        CALL WRITE_CHECKPOINT(        CALL WRITE_CHECKPOINT(
817       &        .FALSE., myTime, myIter, myThid )       I               .FALSE., myTime, myIter, myThid )
818        CALL TIMER_STOP ('WRITE_CHECKPOINT    [THE_MAIN_LOOP]',myThid)        CALL TIMER_STOP ('WRITE_CHECKPOINT    [FORWARD_STEP]',myThid)
819    
820  #endif /* ALLOW_AUTODIFF_TAMC */  #ifdef ALLOW_DEBUG
821          IF ( debugLevel .GE. debLevB )
822         &    CALL DEBUG_LEAVE('FORWARD_STEP',myThid)
823    #endif
824    
825          RETURN
826        END        END
Legend:
Removed from v.1.32  
changed lines
  Added in v.1.135
  ViewVC Help
Powered by ViewVC 1.1.22