/[MITgcm]/MITgcm_contrib/SOSE/code_ad/the_main_loop.F
ViewVC logotype

Annotation of /MITgcm_contrib/SOSE/code_ad/the_main_loop.F

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

Revision 1.1 - (hide annotations) (download)
Fri Apr 23 19:55:13 2010 UTC (15 years, 3 months ago) by mmazloff
Branch: MAIN
CVS Tags: HEAD 
original files
1 mmazloff 1.1 C $Header: /u/gcmpack/MITgcm/pkg/ecco/the_main_loop.F,v 1.90 2010/01/13 02:05:32 jmc Exp $
2     C $Name: $
3    
4     #include "PACKAGES_CONFIG.h"
5     #include "CPP_OPTIONS.h"
6    
7     #ifdef ALLOW_OBCS
8     # include "OBCS_OPTIONS.h"
9     #endif
10     #ifdef ALLOW_SEAICE
11     # include "SEAICE_OPTIONS.h"
12     #endif
13     #ifdef ALLOW_GMREDI
14     # include "GMREDI_OPTIONS.h"
15     #endif
16    
17     subroutine the_main_loop( myTime, myIter, mythid )
18    
19     c ==================================================================
20     c SUBROUTINE the_main_loop
21     c ==================================================================
22     c
23     c o Run the ocean model and evaluate the specified cost function.
24     c
25     c *the_main_loop* is the top-level 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*. In order to do a so called
31     c checkpointing during the adjoint calculation and to account for the
32     c typical data involved in oceanographic applications a call tree
33     c that is divided into yearly, monthly, daily, and step parts can
34     c be used.
35     c
36     c This routine is to be used in conjuction with the MITgcmuv release
37     c checkpoint 24.
38     c
39     c started: Christian Eckert eckert@mit.edu 30-Jun-1999
40     c
41     c changed: Christian Eckert eckert@mit.edu 14-Jul-1999
42     c
43     c - The call to mapping was moved to initialise_varia,
44     c since this routine has to be called before
45     c ini_predictor.
46     c
47     c Christian Eckert eckert@mit.edu 11-Feb-2000
48     c
49     c - Restructured the code in order to create a package
50     c for the MITgcmUV.
51     c
52     c Patrick Heimbach heimbach@mit.edu 3-Jun-2000
53     c - corrected computation of ikey_dynamics and
54     c added computation of ikey_dynamics for the case
55     c undef ALLOW_TAMC_CHECKPOINTING
56     c
57     c Patrick Heimbach heimbach@mit.edu 6-Jun-2000
58     c - corrected initialisation of comlev1 common blocks
59     c
60     c Dimitris Menemenlis menemenlis@jpl.nasa.gov 26-Feb-2003
61     c - modifications for pkg/seaice
62     c
63     c ==================================================================
64     c SUBROUTINE the_main_loop
65     c ==================================================================
66    
67     implicit none
68    
69     c == global variables ==
70    
71     #include "SIZE.h"
72     #include "EEPARAMS.h"
73     #include "PARAMS.h"
74     #include "DYNVARS.h"
75    
76     #ifdef ALLOW_MNC
77     #include "MNC_PARAMS.h"
78     EXTERNAL DIFFERENT_MULTIPLE
79     LOGICAL DIFFERENT_MULTIPLE
80     #endif
81    
82     #ifdef HAVE_SIGREG
83     #include "SIGREG.h"
84     #endif
85    
86     #ifdef ALLOW_SHAP_FILT
87     # include "SHAP_FILT.h"
88     #endif
89     #ifdef ALLOW_ZONAL_FILT
90     # include "ZONAL_FILT.h"
91     #endif
92     #ifdef COMPONENT_MODULE
93     # include "CPL_PARAMS.h"
94     #endif
95    
96     c**************************************
97     #ifdef ALLOW_AUTODIFF_TAMC
98    
99     c These includes are needed for
100     c AD-checkpointing.
101     c They provide the fields to be stored.
102    
103     # include "GRID.h"
104     # include "SURFACE.h"
105     # include "FFIELDS.h"
106     # include "EOS.h"
107     # include "AUTODIFF.h"
108    
109     # ifdef ALLOW_GENERIC_ADVDIFF
110     # include "GAD.h"
111     # endif
112     # ifdef ALLOW_CD_CODE
113     # include "CD_CODE_VARS.h"
114     # endif
115     # ifdef ALLOW_PTRACERS
116     # include "PTRACERS_SIZE.h"
117     # include "PTRACERS_FIELDS.h"
118     # endif
119     # ifdef ALLOW_GCHEM
120     # include "GCHEM_FIELDS.h"
121     # endif
122     # ifdef ALLOW_CFC
123     # include "CFC.h"
124     # endif
125     # ifdef ALLOW_DIC
126     # include "DIC_VARS.h"
127     # include "DIC_LOAD.h"
128     # include "DIC_ATMOS.h"
129     # endif
130     # ifdef ALLOW_NONHYDROSTATIC
131     # include "CG3D.h"
132     # endif
133     # ifdef ALLOW_OBCS
134     # include "OBCS.h"
135     # ifdef ALLOW_PTRACERS
136     # include "OBCS_PTRACERS.h"
137     # endif
138     # endif
139     # ifdef ALLOW_EXF
140     # include "EXF_FIELDS.h"
141     # ifdef ALLOW_BULKFORMULAE
142     # include "EXF_CONSTANTS.h"
143     # endif
144     # endif /* ALLOW_EXF */
145     # ifdef ALLOW_SEAICE
146     # include "SEAICE.h"
147     # include "SEAICE_PARAMS.h"
148     # include "SEAICE_COST.h"
149     # endif
150     # ifdef ALLOW_SALT_PLUME
151     # include "SALT_PLUME.h"
152     # endif
153     # ifdef ALLOW_THSICE
154     # include "THSICE_SIZE.h"
155     # include "THSICE_PARAMS.h"
156     # include "THSICE_VARS.h"
157     # endif
158     # ifdef ALLOW_KPP
159     # include "KPP.h"
160     # endif
161     # ifdef ALLOW_GMREDI
162     # include "GMREDI.h"
163     # endif
164     # ifdef ALLOW_RBCS
165     # include "RBCS.h"
166     # endif
167     # ifdef ALLOW_PROFILES
168     # include "profiles.h"
169     # endif
170     # ifdef ALLOW_DIVIDED_ADJOINT_MPI
171     # include "mpif.h"
172     # endif
173    
174     # include "tamc.h"
175     # include "ctrl.h"
176     # include "ctrl_dummy.h"
177     # include "cost.h"
178     # include "ecco_cost.h"
179    
180     #endif /* ALLOW_AUTODIFF_TAMC */
181     c**************************************
182    
183     c == routine arguments ==
184     c note: under the multi-threaded model myiter and
185     c mytime are local variables passed around as routine
186     c arguments. Although this is fiddly it saves the need to
187     c impose additional synchronisation points when they are
188     c updated.
189     c myiter - iteration counter for this thread
190     c mytime - time counter for this thread
191     c mythid - thread number for this instance of the routine.
192     integer mythid
193     integer myiter
194     _RL mytime
195    
196     c == local variables ==
197    
198     integer bi,bj
199     integer iloop
200     integer mydate(4)
201     #ifdef ALLOW_SNAPSHOTS
202     character yprefix*3
203     #endif
204    
205     c-- == end of interface ==
206    
207     #ifndef DISABLE_DEBUGMODE
208     IF ( debugLevel .GE. debLevB )
209     & CALL DEBUG_ENTER('THE_MAIN_LOOP',myThid)
210     #endif
211    
212     #ifdef ALLOW_AUTODIFF_TAMC
213     c-- Initialize storage for the initialisations.
214     CADJ INIT tapelev_ini_bibj_k = USER
215     CADJ INIT tapelev_init = USER
216     c
217     #if (defined (AUTODIFF_2_LEVEL_CHECKPOINT))
218     CADJ INIT tapelev2 = USER
219     #elif (defined (AUTODIFF_4_LEVEL_CHECKPOINT))
220     CADJ INIT tapelev4 = USER
221     #else
222     CADJ INIT tapelev3 = USER
223     #endif
224     c
225     CADJ INIT onetape = user
226     cphCADJ INIT onetape = common, 1
227     cph We want to avoid common blocks except in the inner loop.
228     cph Reason: the active write and consecutive read may occur
229     cph in separate model executions for which the info
230     cph in common blocks are lost.
231     cph Thus, we can only store real values (no integers)
232     cph because we only have active file handling to real available.
233     # ifdef ALLOW_TAMC_CHECKPOINTING
234     ikey_dynamics = 1
235     # endif
236     CADJ STORE mytime = onetape
237     #endif /* ALLOW_AUTODIFF_TAMC */
238    
239     CALL TIMER_START('ECCO SPIN-UP', mythid)
240    
241     #ifdef ALLOW_CAL
242     c-- Get the current date.
243     call CAL_TIMESTAMP( myiter, mytime, mydate, mythid )
244     #endif
245    
246     #ifdef ALLOW_AUTODIFF_TAMC
247     # ifdef NONLIN_FRSURF
248     CADJ STORE hFacC = tapelev_init, key=1
249     # endif
250     #endif
251    
252     C-- Set initial conditions (variable arrays)
253     #ifndef DISABLE_DEBUGMODE
254     IF ( debugLevel .GE. debLevB )
255     & CALL DEBUG_CALL('INITIALISE_VARIA',myThid)
256     #endif
257     CALL TIMER_START('INITIALISE_VARIA [THE_MAIN_LOOP]', mythid)
258     CALL INITIALISE_VARIA( mythid )
259     CALL TIMER_STOP ('INITIALISE_VARIA [THE_MAIN_LOOP]', mythid)
260    
261     call timer_stop ('ECCO SPIN-UP', mythid)
262     _BARRIER
263    
264     #ifdef ALLOW_SHOWFLOPS
265     CALL TIMER_START('SHOWFLOPS_INIT [THE_MAIN_LOOP]', mythid)
266     CALL SHOWFLOPS_INIT( myThid )
267     CALL TIMER_STOP('SHOWFLOPS_INIT [THE_MAIN_LOOP]', mythid)
268     #endif
269    
270     c-- Do the model integration.
271     call timer_start('ECCO MAIN LOOP',mythid)
272    
273     c >>>>>>>>>>>>>>>>>>>>>>>>>>> LOOP <<<<<<<<<<<<<<<<<<<<<<<<<<<<
274     c >>>>>>>>>>>>>>>>>>>>>>>>>>> STARTS <<<<<<<<<<<<<<<<<<<<<<<<<<<<
275    
276     #ifdef ALLOW_AUTODIFF_TAMC
277     #ifdef ALLOW_TAMC_CHECKPOINTING
278    
279     max_lev4=nTimeSteps/(nchklev_1*nchklev_2*nchklev_3)+1
280     max_lev3=nTimeSteps/(nchklev_1*nchklev_2)+1
281     max_lev2=nTimeSteps/nchklev_1+1
282    
283     c**************************************
284     #ifdef ALLOW_DIVIDED_ADJOINT
285     CADJ loop = divided
286     #endif
287     c**************************************
288    
289     #ifdef AUTODIFF_4_LEVEL_CHECKPOINT
290     do ilev_4 = 1,nchklev_4
291     if(ilev_4.le.max_lev4) then
292     c**************************************
293     CALL AUTODIFF_STORE( myThid )
294     #include "checkpoint_lev4_directives.h"
295     CALL AUTODIFF_RESTORE( myThid )
296     c**************************************
297     c-- Initialise storage for the middle loop.
298     CADJ INIT tapelev3 = USER
299     #endif /* AUTODIFF_4_LEVEL_CHECKPOINT */
300    
301     #ifndef AUTODIFF_2_LEVEL_CHECKPOINT
302     do ilev_3 = 1,nchklev_3
303     if(ilev_3.le.max_lev3) then
304     c**************************************
305     CALL AUTODIFF_STORE( myThid )
306     #include "checkpoint_lev3_directives.h"
307     CALL AUTODIFF_RESTORE( myThid )
308     c**************************************
309     c-- Initialise storage for the middle loop.
310     CADJ INIT tapelev2 = USER
311     #endif /* AUTODIFF_2_LEVEL_CHECKPOINT */
312    
313     do ilev_2 = 1,nchklev_2
314     if(ilev_2.le.max_lev2) then
315     c**************************************
316     CALL AUTODIFF_STORE( myThid )
317     #include "checkpoint_lev2_directives.h"
318     CALL AUTODIFF_RESTORE( myThid )
319     c**************************************
320    
321     c**************************************
322     #ifdef ALLOW_AUTODIFF_TAMC
323     c-- Initialize storage for the innermost loop.
324     c-- Always check common block sizes for the checkpointing!
325     c--
326     CADJ INIT comlev1 = COMMON,nchklev_1
327     CADJ INIT comlev1_bibj = COMMON,nchklev_1*nsx*nsy*nthreads_chkpt
328     CADJ INIT comlev1_bibj_k = COMMON,nchklev_1*nsx*nsy*nr*nthreads_chkpt
329     c--
330     # ifdef ALLOW_KPP
331     CADJ INIT comlev1_kpp = COMMON,nchklev_1*nsx*nsy
332     CADJ INIT comlev1_kpp_k = COMMON,nchklev_1*nsx*nsy*nr
333     # endif /* ALLOW_KPP */
334     c--
335     # ifdef ALLOW_GMREDI
336     CADJ INIT comlev1_gmredi_k_gad
337     CADJ & = COMMON,nchklev_1*nsx*nsy*nr*nthreads_chkpt*maxpass
338     # endif /* ALLOW_GMREDI */
339     c--
340     # ifdef ALLOW_PTRACERS
341     CADJ INIT comlev1_bibj_ptracers = COMMON,
342     CADJ & nchklev_1*nsx*nsy*nthreads_chkpt*PTRACERS_num
343     CADJ INIT comlev1_bibj_k_ptracers = COMMON,
344     CADJ & nchklev_1*nsx*nsy*nthreads_chkpt*PTRACERS_num*nr
345     # endif /* ALLOW_PTRACERS */
346     c--
347     cph Now also needed by seaice
348     cph# ifndef DISABLE_MULTIDIM_ADVECTION
349     CADJ INIT comlev1_bibj_k_gad
350     CADJ & = COMMON,nchklev_1*nsx*nsy*nr*nthreads_chkpt*maxpass
351     CADJ INIT comlev1_bibj_k_gad_pass
352     CADJ & = COMMON,nchklev_1*nsx*nsy*nr*nthreads_chkpt*maxpass*maxpass
353     cph# endif /* DISABLE_MULTIDIM_ADVECTION */
354     c--
355     # ifdef ALLOW_MOM_COMMON
356     # ifndef AUTODIFF_DISABLE_LEITH
357     CADJ INIT comlev1_mom_ijk_loop
358     CADJ & = COMMON,nchklev_1*
359     CADJ & (snx+2*olx)*nsx*(sny+2*oly)*nsy*nr*nthreads_chkpt
360     # endif /* AUTODIFF_DISABLE_LEITH */
361     # endif /* ALLOW_MOM_COMMON */
362     c--
363     # if (defined (ALLOW_EXF) && defined (ALLOW_BULKFORMULAE))
364     CADJ INIT comlev1_exf_1
365     CADJ & = COMMON,nchklev_1*snx*nsx*sny*nsy*nthreads_chkpt
366     CADJ INIT comlev1_exf_2
367     CADJ & = COMMON,niter_bulk*nchklev_1*snx*nsx*sny*nsy*nthreads_chkpt
368     # endif
369     c--
370     # ifdef ALLOW_SEAICE
371     # ifdef SEAICE_ALLOW_DYNAMICS
372     cphCADJ INIT comlev1_lsr = COMMON,nchklev_1*2
373     CADJ INIT comlev1_dynsol = COMMON,nchklev_1*MPSEUDOTIMESTEPS
374     # endif
375     # ifdef SEAICE_ALLOW_EVP
376     CADJ INIT comlev1_evp = COMMON,nEVPstepMax*nchklev_1
377     # endif
378     # ifdef SEAICE_MULTICATEGORY
379     CADJ INIT comlev1_multdim
380     CADJ & = COMMON,nchklev_1*nsx*nsy*nthreads_chkpt*multdim
381     # endif
382     # endif /* ALLOW_SEAICE */
383     c--
384     #ifdef ALLOW_THSICE
385     CADJ INIT comlev1_thsice_1
386     CADJ & = COMMON,nchklev_1*snx*nsx*sny*nsy*nthreads_chkpt
387     CADJ INIT comlev1_thsice_2
388     CADJ & = COMMON,nchklev_1*snx*nsx*sny*nsy*nlyr*nthreads_chkpt
389     CADJ INIT comlev1_thsice_3
390     CADJ & = COMMON,nchklev_1*snx*nsx*sny*nsy*MaxTsf*nthreads_chkpt
391     CADJ INIT comlev1_thsice_4
392     CADJ & = COMMON,nchklev_1*nsx*nsy*maxpass*nthreads_chkpt
393     #endif /* ALLOW_THSICE */
394     c--
395     #endif /* ALLOW_AUTODIFF_TAMC */
396     c**************************************
397    
398     do ilev_1 = 1,nchklev_1
399    
400     c-- The if-statement below introduces a some flexibility in the
401     c-- choice of the 3-tupel ( nchklev_1, nchklev_2, nchklev_3 ).
402     c--
403     c-- Requirement: nchklev_1*nchklev_2*nchklev_3 .ge. nTimeSteps .
404    
405     iloop = (ilev_2 - 1)*nchklev_1 + ilev_1
406     #ifndef AUTODIFF_2_LEVEL_CHECKPOINT
407     & + (ilev_3 - 1)*nchklev_2*nchklev_1
408     #endif
409     #ifdef AUTODIFF_4_LEVEL_CHECKPOINT
410     & + (ilev_4 - 1)*nchklev_3*nchklev_2*nchklev_1
411     #endif
412    
413     if ( iloop .le. nTimeSteps ) then
414    
415     #else /* ALLOW_TAMC_CHECKPOINTING undefined */
416     c-- Initialise storage for the reference trajectory without TAMC check-
417     c-- pointing.
418     CADJ INIT history = USER
419     CADJ INIT comlev1_bibj = COMMON,nchklev_0*nsx*nsy*nthreads_chkpt
420     CADJ INIT comlev1_bibj_k = COMMON,nchklev_0*nsx*nsy*nr*nthreads_chkpt
421     CADJ INIT comlev1_kpp = COMMON,nchklev_0*nsx*nsy
422    
423     c-- Check the choice of the checkpointing parameters in relation
424     c-- to nTimeSteps: (nchklev_0 .ge. nTimeSteps)
425     if (nchklev_0 .lt. nTimeSteps) then
426     print*
427     print*, ' the_main_loop: ',
428     & 'TAMC checkpointing parameter nchklev_0 = ',
429     & nchklev_0
430     print*, ' is not consistent with nTimeSteps = ',
431     & nTimeSteps
432     stop ' ... stopped in the_main_loop.'
433     endif
434    
435     do iloop = 1, nTimeSteps
436    
437     #endif /* ALLOW_TAMC_CHECKPOINTING */
438    
439     #else /* ALLOW_AUTODIFF_TAMC undefined */
440     c-- Start the main loop of ecco_Objfunc. Automatic differentiation is
441     c-- NOT enabled.
442     do iloop = 1, nTimeSteps
443     #endif /* ALLOW_AUTODIFF_TAMC */
444    
445     #ifdef ALLOW_TAMC_CHECKPOINTING
446     nIter0 = NINT( (startTime-baseTime)/deltaTClock )
447     ikey_dynamics = ilev_1
448     #endif
449    
450     c-- Set the model iteration counter and the model time.
451     myiter = nIter0 + (iloop-1)
452     mytime = startTime + float(iloop-1)*deltaTclock
453    
454     #ifdef ALLOW_AUTODIFF_TAMC
455     CALL AUTODIFF_INADMODE_UNSET( myThid )
456     #endif
457    
458     #ifdef ALLOW_DIAGNOSTICS
459     C-- State-variables diagnostics
460     IF ( useDiagnostics ) THEN
461     #ifdef ALLOW_DEBUG
462     IF ( debugLevel .GE. debLevB )
463     & CALL DEBUG_CALL('DO_STATEVARS_DIAGS',myThid)
464     #endif
465     C-- Switch on/off diagnostics for snap-shot output:
466     CALL DIAGNOSTICS_SWITCH_ONOFF( myTime, myIter, myThid )
467     CALL TIMER_START('DO_STATEVARS_DIAGS [FORWARD_STEP]',myThid)
468     CALL DO_STATEVARS_DIAGS( myTime, 0, myIter, myThid )
469     CALL TIMER_STOP ('DO_STATEVARS_DIAGS [FORWARD_STEP]',myThid)
470     ENDIF
471     #endif
472    
473     #ifdef ALLOW_PROFILES
474     c-- Accumulate in-situ time averages of temperature, salinity, and SSH.
475     #ifdef ALLOW_DEBUG
476     IF ( debugLevel .GE. debLevB )
477     & CALL DEBUG_CALL('profiles_inloop',myThid)
478     #endif
479     call timer_start('PROFILES_INLOOP [ECCO MAIN]', mythid)
480     call profiles_inloop( mytime, mythid )
481     call timer_stop ('PROFILES_INLOOP [ECCO MAIN]', mythid)
482     #endif
483    
484     #ifdef ALLOW_COST
485    
486     CMM(
487     #ifdef ALLOW_DRIFTW_COST_CONTRIBUTION
488     CADJ STORE wVel = comlev1, key=ikey_dynamics, kind=isbyte
489     # endif
490     CMM)
491    
492     #ifdef ALLOW_DEBUG
493     IF ( debugLevel .GE. debLevB )
494     & CALL DEBUG_CALL('cost_averagesfields',myThid)
495     #endif
496     c-- Accumulate time averages of temperature, salinity
497     call timer_start('COST_AVERAGESFIELDS [ECCO MAIN]', mythid)
498     call cost_averagesfields( mytime, mythid )
499     call timer_stop ('COST_AVERAGESFIELDS [ECCO MAIN]', mythid)
500    
501    
502     #ifdef ALLOW_COST_ATLANTIC
503     CADJ STORE theta = comlev1, key=ikey_dynamics, kind=isbyte
504     CADJ STORE vVel = comlev1, key=ikey_dynamics, kind=isbyte
505     # ifdef NONLIN_FRSURF
506     CADJ STORE hFacS = comlev1, key=ikey_dynamics, kind=isbyte
507     # endif
508     c-- Compute meridional heat transport
509     call timer_start('cost_atlantic [ECCO MAIN]', mythid)
510     call cost_atlantic( mytime, myiter,mythid )
511     call timer_stop ('cost_atlantic [ECCO MAIN]', mythid)
512     #endif
513     #endif /* ALLOW_COST */
514    
515     #ifdef ALLOW_AUTODIFF_TAMC
516     c**************************************
517     #include "checkpoint_lev1_directives.h"
518     #include "checkpoint_lev1_template.h"
519     c**************************************
520     #endif
521    
522     C-- Call driver to load external forcing fields from file
523     #ifdef ALLOW_DEBUG
524     IF ( debugLevel .GE. debLevB )
525     & CALL DEBUG_CALL('LOAD_FIELDS_DRIVER',myThid)
526     #endif
527     #ifdef ALLOW_AUTODIFF_TAMC
528     cph Important STORE that avoids hidden recomp. of load_fields_driver
529     CADJ STORE theta = comlev1, key=ikey_dynamics, kind=isbyte
530     CADJ STORE uvel,vvel = comlev1, key=ikey_dynamics, kind=isbyte
531     #endif
532     CALL TIMER_START('LOAD_FIELDS_DRIVER [FORWARD_STEP]',myThid)
533     CALL LOAD_FIELDS_DRIVER( myTime, myIter, myThid )
534     CALL TIMER_STOP ('LOAD_FIELDS_DRIVER [FORWARD_STEP]',myThid)
535    
536     #ifdef ALLOW_AUTODIFF_TAMC
537     # if (defined (ALLOW_AUTODIFF_MONITOR))
538     CALL DUMMY_IN_STEPPING( myTime, myIter, myThid )
539     # endif
540     #endif
541    
542     #ifdef ALLOW_AUTODIFF_TAMC
543     # ifdef ALLOW_PTRACERS
544     cph this replaces _bibj storing of ptracer within thermodynamics
545     CADJ STORE ptracer = comlev1, key=ikey_dynamics, kind=isbyte
546     # endif
547     #endif
548    
549     #ifdef ALLOW_EBM
550     IF ( useEBM ) THEN
551     # ifdef ALLOW_DEBUG
552     IF ( debugLevel .GE. debLevB )
553     & CALL DEBUG_CALL('EBM',myThid)
554     # endif
555     CALL TIMER_START('EBM [FORWARD_STEP]',mythid)
556     CALL EBM_DRIVER ( myTime, myIter, myThid )
557     CALL TIMER_STOP ('EBM [FORWARD_STEP]',mythid)
558     ENDIF
559     #endif
560    
561     C-- Step forward fields and calculate time tendency terms.
562    
563     #ifdef ALLOW_DEBUG
564     IF ( debugLevel .GE. debLevB )
565     & CALL DEBUG_CALL('DO_ATMOSPHERIC_PHYS',myThid)
566     #endif
567     CALL TIMER_START('DO_ATMOSPHERIC_PHYS [FORWARD_STEP]',mythid)
568     CALL DO_ATMOSPHERIC_PHYS( myTime, myIter, myThid )
569     CALL TIMER_STOP ('DO_ATMOSPHERIC_PHYS [FORWARD_STEP]',mythid)
570    
571     #ifdef ALLOW_AUTODIFF_TAMC
572     CADJ STORE surfaceforcingtice = comlev1, key=ikey_dynamics, kind=isbyte
573     # ifdef ALLOW_OBCS
574     CMM CADJ STORE salt = comlev1, key=ikey_dynamics, kind=isbyte
575     CMM CADJ STORE totphihyd = comlev1, key=ikey_dynamics, kind=isbyte
576     # ifdef EXACT_CONSERV
577     CADJ STORE empmr = comlev1, key=ikey_dynamics, kind=isbyte
578     CADJ STORE pmepr = comlev1, key=ikey_dynamics, kind=isbyte
579     # endif
580     # endif
581     # ifdef ALLOW_PTRACERS
582     CADJ STORE ptracer = comlev1, key=ikey_dynamics, kind=isbyte
583     # endif
584     # ifdef NONLIN_FRSURF
585     CADJ STORE hFacC = comlev1, key=ikey_dynamics, kind=isbyte
586     # endif
587     #endif /* ALLOW_AUTODIFF_TAMC */
588    
589     #ifndef ALLOW_OFFLINE
590     # ifdef ALLOW_DEBUG
591     IF ( debugLevel .GE. debLevB )
592     & CALL DEBUG_CALL('DO_OCEANIC_PHYS',myThid)
593     # endif
594     CALL TIMER_START('DO_OCEANIC_PHYS [FORWARD_STEP]',mythid)
595     CALL DO_OCEANIC_PHYS( myTime, myIter, myThid )
596     CALL TIMER_STOP ('DO_OCEANIC_PHYS [FORWARD_STEP]',mythid)
597     # ifdef ALLOW_AUTODIFF_TAMC
598     CADJ STORE EmPmR = comlev1, key=ikey_dynamics, kind=isbyte
599     CADJ STORE qsw = comlev1, key=ikey_dynamics, kind=isbyte
600     # ifdef EXACT_CONSERV
601     CADJ STORE pmepr = comlev1, key=ikey_dynamics, kind=isbyte
602     # endif
603     # endif
604     #endif
605    
606     #ifdef ALLOW_AUTODIFF_TAMC
607     # ifdef NONLIN_FRSURF
608     cph-test
609     CADJ STORE hFac_surfC = comlev1, key=ikey_dynamics, kind=isbyte
610     CADJ STORE hfac_surfs = comlev1, key=ikey_dynamics, kind=isbyte
611     CADJ STORE hfac_surfw = comlev1, key=ikey_dynamics, kind=isbyte
612     CADJ STORE hFacC, hFacS, hFacW
613     CADJ & = comlev1, key=ikey_dynamics, kind=isbyte
614     CADJ STORE recip_hFacC, recip_hFacS, recip_hFacW
615     CADJ & = comlev1, key=ikey_dynamics, kind=isbyte
616     c
617     CADJ STORE surfaceforcingu = comlev1, key=ikey_dynamics, kind=isbyte
618     CADJ STORE surfaceforcingv = comlev1, key=ikey_dynamics, kind=isbyte
619     # endif
620     #endif /* ALLOW_AUTODIFF_TAMC */
621    
622     #ifdef ALLOW_GCHEM
623     # ifdef ALLOW_AUTODIFF_TAMC
624     CADJ STORE ptracer = comlev1, key=ikey_dynamics, kind=isbyte
625     CADJ STORE theta = comlev1, key=ikey_dynamics, kind=isbyte
626     CADJ STORE salt = comlev1, key=ikey_dynamics, kind=isbyte
627     # endif
628     IF ( useGCHEM ) THEN
629     #ifdef ALLOW_DEBUG
630     IF ( debugLevel .GE. debLevB )
631     & CALL DEBUG_CALL('GCHEM_CALC_TENDENCY',myThid)
632     #endif
633     CALL TIMER_START('GCHEM_CALC_TENDENCY [FORWARD_STEP]',myThid)
634     CALL GCHEM_CALC_TENDENCY( myTime, myIter, myThid )
635     CALL TIMER_STOP ('GCHEM_CALC_TENDENCY [FORWARD_STEP]',myThid)
636     ENDIF
637     #endif /* ALLOW_GCHEM */
638    
639     #ifdef ALLOW_AUTODIFF_TAMC
640     cph needed to be moved here from do_oceanic_physics
641     cph to be visible down the road
642     c
643     CADJ STORE rhoInSitu = comlev1, key=ikey_dynamics, kind=isbyte
644     CADJ STORE surfaceForcingS = comlev1, key=ikey_dynamics, kind=isbyte
645     CADJ STORE surfaceForcingT = comlev1, key=ikey_dynamics, kind=isbyte
646     CADJ STORE surfaceForcingTice = comlev1, key=ikey_dynamics, kind=isbyte
647     ctest(
648     CADJ STORE IVDConvCount = comlev1, key=ikey_dynamics, kind=isbyte
649     ctest)
650     # ifdef ALLOW_PTRACERS
651     CADJ STORE surfaceForcingPTr = comlev1, key=ikey_dynamics, kind=isbyte
652     # endif
653     c
654     # ifdef ALLOW_GMREDI
655     CADJ STORE Kwx = comlev1, key=ikey_dynamics, kind=isbyte
656     CADJ STORE Kwy = comlev1, key=ikey_dynamics, kind=isbyte
657     CADJ STORE Kwz = comlev1, key=ikey_dynamics, kind=isbyte
658     # ifdef GM_BOLUS_ADVEC
659     CADJ STORE GM_PsiX = comlev1, key=ikey_dynamics, kind=isbyte
660     CADJ STORE GM_PsiY = comlev1, key=ikey_dynamics, kind=isbyte
661     # endif
662     # endif
663     c
664     # ifdef ALLOW_KPP
665     CADJ STORE KPPghat = comlev1, key=ikey_dynamics, kind=isbyte
666     CADJ STORE KPPfrac = comlev1, key=ikey_dynamics, kind=isbyte
667     CADJ STORE KPPdiffKzS = comlev1, key=ikey_dynamics, kind=isbyte
668     CADJ STORE KPPdiffKzT = comlev1, key=ikey_dynamics, kind=isbyte
669     # endif
670     #endif /* ALLOW_AUTODIFF_TAMC */
671    
672     #ifdef ALLOW_AUTODIFF_TAMC
673     # ifdef NONLIN_FRSURF
674     CADJ STORE etaH = comlev1, key=ikey_dynamics, kind=isbyte
675     # ifdef ALLOW_CD_CODE
676     CADJ STORE etanm1 = comlev1, key=ikey_dynamics, kind=isbyte
677     # endif
678     # endif
679     #endif /* ALLOW_AUTODIFF_TAMC */
680    
681     IF ( .NOT.staggerTimeStep ) THEN
682     #ifdef ALLOW_DEBUG
683     IF ( debugLevel .GE. debLevB )
684     & CALL DEBUG_CALL('THERMODYNAMICS',myThid)
685     #endif
686     CALL TIMER_START('THERMODYNAMICS [FORWARD_STEP]',mythid)
687     CALL THERMODYNAMICS( myTime, myIter, myThid )
688     CALL TIMER_STOP ('THERMODYNAMICS [FORWARD_STEP]',mythid)
689     C-- if not staggerTimeStep: end
690     ENDIF
691    
692     #ifdef ALLOW_AUTODIFF_TAMC
693     # ifdef NONLIN_FRSURF
694     CADJ STORE hFacC = comlev1, key=ikey_dynamics, kind=isbyte
695     CADJ STORE hFacS = comlev1, key=ikey_dynamics, kind=isbyte
696     CADJ STORE hFacW = comlev1, key=ikey_dynamics, kind=isbyte
697     CADJ STORE recip_hFacC = comlev1, key=ikey_dynamics, kind=isbyte
698     CADJ STORE recip_hFacS = comlev1, key=ikey_dynamics, kind=isbyte
699     CADJ STORE recip_hFacW = comlev1, key=ikey_dynamics, kind=isbyte
700     CADJ STORE etaN = comlev1, key=ikey_dynamics, kind=isbyte
701     # endif
702     #endif
703    
704     C-- Step forward fields and calculate time tendency terms.
705     #ifndef ALLOW_OFFLINE
706     #ifndef ALLOW_AUTODIFF_TAMC
707     IF ( momStepping ) THEN
708     #endif
709     #ifdef ALLOW_DEBUG
710     IF ( debugLevel .GE. debLevB )
711     & CALL DEBUG_CALL('DYNAMICS',myThid)
712     #endif
713     CALL TIMER_START('DYNAMICS [FORWARD_STEP]',mythid)
714     CALL DYNAMICS( myTime, myIter, myThid )
715     CALL TIMER_STOP ('DYNAMICS [FORWARD_STEP]',mythid)
716     #ifndef ALLOW_AUTODIFF_TAMC
717     ENDIF
718     #endif
719     #endif
720    
721     #ifdef ALLOW_AUTODIFF_TAMC
722     # ifdef NONLIN_FRSURF
723     cph-test
724     CADJ STORE gU, gV = comlev1, key=ikey_dynamics, kind=isbyte
725     # endif
726     #endif
727    
728     C-- Update time-counter
729     myIter = nIter0 + iLoop
730     myTime = startTime + deltaTClock * float(iLoop)
731    
732     #ifdef ALLOW_MNC
733     C Update the default next iter for MNC
734     IF ( useMNC ) THEN
735     CALL MNC_CW_CITER_SETG( 1, 1, -1, myIter , myThid )
736    
737     C TODO: Logic should be added here so that users can specify, on
738     C a per-citer-group basis, when it is time to update the
739     C "current" (and not just the "next") iteration
740    
741     C TODO: the following is just a temporary band-aid (mostly, for
742     C Baylor) until someone writes a routine that better handles time
743     C boundaries such as weeks, months, years, etc.
744     IF ( mnc_filefreq .GT. 0 ) THEN
745     IF (DIFFERENT_MULTIPLE(mnc_filefreq,myTime,deltaTClock))
746     & THEN
747     CALL MNC_CW_CITER_SETG( 1, 1, myIter, -1 , myThid )
748     ENDIF
749     ENDIF
750     ENDIF
751     #endif
752    
753     C-- Update geometric factors:
754     #ifdef NONLIN_FRSURF
755     C- update hfacC,W,S and recip_hFac according to etaH(n+1) :
756     IF ( nonlinFreeSurf.GT.0) THEN
757     IF ( select_rStar.GT.0 ) THEN
758     # ifndef DISABLE_RSTAR_CODE
759     # ifdef ALLOW_AUTODIFF_TAMC
760     cph-test
761     CADJ STORE hFacC = comlev1, key=ikey_dynamics, kind=isbyte
762     CADJ STORE hFacS = comlev1, key=ikey_dynamics, kind=isbyte
763     CADJ STORE hFacW = comlev1, key=ikey_dynamics, kind=isbyte
764     CADJ STORE recip_hFacC = comlev1, key=ikey_dynamics, kind=isbyte
765     CADJ STORE recip_hFacS = comlev1, key=ikey_dynamics, kind=isbyte
766     CADJ STORE recip_hFacW = comlev1, key=ikey_dynamics, kind=isbyte
767     # endif
768     CALL TIMER_START('UPDATE_R_STAR [FORWARD_STEP]',myThid)
769     CALL UPDATE_R_STAR( myTime, myIter, myThid )
770     CALL TIMER_STOP ('UPDATE_R_STAR [FORWARD_STEP]',myThid)
771     # ifdef ALLOW_AUTODIFF_TAMC
772     cph-test
773     CADJ STORE hFacC = comlev1, key=ikey_dynamics, kind=isbyte
774     CADJ STORE hFacS = comlev1, key=ikey_dynamics, kind=isbyte
775     CADJ STORE hFacW = comlev1, key=ikey_dynamics, kind=isbyte
776     CADJ STORE recip_hFacC = comlev1, key=ikey_dynamics, kind=isbyte
777     CADJ STORE recip_hFacS = comlev1, key=ikey_dynamics, kind=isbyte
778     CADJ STORE recip_hFacW = comlev1, key=ikey_dynamics, kind=isbyte
779     # endif
780     # endif /* DISABLE_RSTAR_CODE */
781     ELSE
782     #ifdef ALLOW_AUTODIFF_TAMC
783     CADJ STORE hFac_surfC, hFac_surfS, hFac_surfW
784     CADJ & = comlev1, key=ikey_dynamics, kind=isbyte
785     #endif
786     CALL TIMER_START('UPDATE_SURF_DR [FORWARD_STEP]',myThid)
787     CALL UPDATE_SURF_DR( myTime, myIter, myThid )
788     CALL TIMER_STOP ('UPDATE_SURF_DR [FORWARD_STEP]',myThid)
789     ENDIF
790     ENDIF
791     # ifdef ALLOW_AUTODIFF_TAMC
792     cph-test
793     CADJ STORE hFacC = comlev1, key=ikey_dynamics, kind=isbyte
794     CADJ STORE hFacS = comlev1, key=ikey_dynamics, kind=isbyte
795     CADJ STORE hFacW = comlev1, key=ikey_dynamics, kind=isbyte
796     CADJ STORE recip_hFacC = comlev1, key=ikey_dynamics, kind=isbyte
797     CADJ STORE recip_hFacS = comlev1, key=ikey_dynamics, kind=isbyte
798     CADJ STORE recip_hFacW = comlev1, key=ikey_dynamics, kind=isbyte
799     # endif
800     C- update also CG2D matrix (and preconditioner)
801     IF ( momStepping .AND. nonlinFreeSurf.GT.2 ) THEN
802     CALL TIMER_START('UPDATE_CG2D [FORWARD_STEP]',myThid)
803     CALL UPDATE_CG2D( myTime, myIter, myThid )
804     CALL TIMER_STOP ('UPDATE_CG2D [FORWARD_STEP]',myThid)
805     ENDIF
806     #endif /* NONLIN_FRSURF */
807    
808     C-- Apply Filters to u*,v* before SOLVE_FOR_PRESSURE
809     #ifdef ALLOW_SHAP_FILT
810     IF (useSHAP_FILT .AND. shap_filt_uvStar) THEN
811     CALL TIMER_START('SHAP_FILT [FORWARD_STEP]',myThid)
812     IF (implicDiv2Dflow.LT.1.) THEN
813     C-- Explicit+Implicit part of the Barotropic Flow Divergence
814     C => Filtering of uVel,vVel is necessary
815     CALL SHAP_FILT_APPLY_UV( uVel,vVel,
816     & myTime, myIter, myThid )
817     ENDIF
818     CALL SHAP_FILT_APPLY_UV( gU,gV,myTime,myIter,myThid)
819     CALL TIMER_STOP ('SHAP_FILT [FORWARD_STEP]',myThid)
820     ENDIF
821     #endif
822     #ifdef ALLOW_ZONAL_FILT
823     IF (useZONAL_FILT .AND. zonal_filt_uvStar) THEN
824     CALL TIMER_START('ZONAL_FILT_APPLY [FORWARD_STEP]',myThid)
825     IF (implicDiv2Dflow.LT.1.) THEN
826     C-- Explicit+Implicit part of the Barotropic Flow Divergence
827     C => Filtering of uVel,vVel is necessary
828     CALL ZONAL_FILT_APPLY_UV( uVel, vVel, myThid )
829     ENDIF
830     CALL ZONAL_FILT_APPLY_UV( gU, gV, myThid )
831     CALL TIMER_STOP ('ZONAL_FILT_APPLY [FORWARD_STEP]',myThid)
832     ENDIF
833     #endif
834    
835     C-- Solve elliptic equation(s).
836     C Two-dimensional only for conventional hydrostatic or
837     C three-dimensional for non-hydrostatic and/or IGW scheme.
838     #ifndef ALLOW_OFFLINE
839     IF ( momStepping ) THEN
840     #ifdef ALLOW_AUTODIFF_TAMC
841     # ifdef NONLIN_FRSURF
842     CADJ STORE uvel, vvel
843     CADJ & = comlev1, key=ikey_dynamics, kind=isbyte
844     CADJ STORE empmr,hfacs,hfacw
845     CADJ & = comlev1, key=ikey_dynamics, kind=isbyte
846     # endif
847     #endif
848     #ifdef ALLOW_DEBUG
849     IF ( debugLevel .GE. debLevB )
850     & CALL DEBUG_CALL('SOLVE_FOR_PRESSURE',myThid)
851     #endif
852     CALL TIMER_START('SOLVE_FOR_PRESSURE [FORWARD_STEP]',myThid)
853     CALL SOLVE_FOR_PRESSURE(myTime, myIter, myThid)
854     CALL TIMER_STOP ('SOLVE_FOR_PRESSURE [FORWARD_STEP]',myThid)
855     ENDIF
856     #endif
857    
858     C-- Correct divergence in flow field and cycle time-stepping momentum
859     c IF ( momStepping ) THEN
860     #ifndef ALLOW_OFFLINE
861     #ifdef ALLOW_DEBUG
862     IF ( debugLevel .GE. debLevB )
863     & CALL DEBUG_CALL('MOMENTUM_CORRECTION_STEP',myThid)
864     #endif
865     CALL TIMER_START('UV_CORRECTION_STEP [FORWARD_STEP]',myThid)
866     CALL MOMENTUM_CORRECTION_STEP(myTime, myIter, myThid)
867     CALL TIMER_STOP ('UV_CORRECTION_STEP [FORWARD_STEP]',myThid)
868     #endif
869     c ENDIF
870    
871     #ifdef EXACT_CONSERV
872     IF (exactConserv) THEN
873     #ifdef ALLOW_AUTODIFF_TAMC
874     cph-test
875     cphCADJ STORE etaH = comlev1, key=ikey_dynamics, kind=isbyte
876     #endif
877     #ifdef ALLOW_DEBUG
878     IF ( debugLevel .GE. debLevB )
879     & CALL DEBUG_CALL('UPDATE_ETAH',myThid)
880     #endif
881     C-- Update etaH(n+1) :
882     CALL TIMER_START('UPDATE_ETAH [FORWARD_STEP]',mythid)
883     CALL UPDATE_ETAH( myTime, myIter, myThid )
884     CALL TIMER_STOP ('UPDATE_ETAH [FORWARD_STEP]',mythid)
885     ENDIF
886     #endif /* EXACT_CONSERV */
887    
888     #ifdef NONLIN_FRSURF
889     IF ( select_rStar.NE.0 ) THEN
890     # ifndef DISABLE_RSTAR_CODE
891     C-- r* : compute the future level thickness according to etaH(n+1)
892     CALL TIMER_START('CALC_R_STAR [FORWARD_STEP]',mythid)
893     CALL CALC_R_STAR(etaH, myTime, myIter, myThid )
894     CALL TIMER_STOP ('CALC_R_STAR [FORWARD_STEP]',mythid)
895     # endif /* DISABLE_RSTAR_CODE */
896     ELSEIF ( nonlinFreeSurf.GT.0) THEN
897     C-- compute the future surface level thickness according to etaH(n+1)
898     # ifdef ALLOW_AUTODIFF_TAMC
899     CADJ STORE etaH = comlev1, key=ikey_dynamics, kind=isbyte
900     # endif
901     CALL TIMER_START('CALC_SURF_DR [FORWARD_STEP]',mythid)
902     CALL CALC_SURF_DR(etaH, myTime, myIter, myThid )
903     CALL TIMER_STOP ('CALC_SURF_DR [FORWARD_STEP]',mythid)
904     ENDIF
905     # ifdef ALLOW_AUTODIFF_TAMC
906     cph-test
907     CADJ STORE hFac_surfC = comlev1, key=ikey_dynamics, kind=isbyte
908     CADJ STORE surfaceforcingtice = comlev1, key=ikey_dynamics, kind=isbyte
909     CADJ STORE theta, salt = comlev1, key=ikey_dynamics, kind=isbyte
910     # endif
911     #endif /* NONLIN_FRSURF */
912    
913     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
914     IF ( staggerTimeStep ) THEN
915     C-- do exchanges of U,V (needed for multiDim) when using stagger time-step :
916     #ifdef ALLOW_DEBUG
917     IF ( debugLevel .GE. debLevB )
918     & CALL DEBUG_CALL('DO_STAGGER_FIELDS_EXCH.',myThid)
919     #endif
920     CALL TIMER_START('BLOCKING_EXCHANGES [FORWARD_STEP]',myThid)
921     CALL DO_STAGGER_FIELDS_EXCHANGES( myTime, myIter, myThid )
922     CALL TIMER_STOP ('BLOCKING_EXCHANGES [FORWARD_STEP]',myThid)
923    
924     #ifdef ALLOW_DIAGNOSTICS
925     C-- State-variables diagnostics
926     IF ( usediagnostics ) THEN
927     CALL TIMER_START('DO_STATEVARS_DIAGS [FORWARD_STEP]',myThid)
928     CALL DO_STATEVARS_DIAGS( myTime, 1, myIter, myThid )
929     CALL TIMER_STOP ('DO_STATEVARS_DIAGS [FORWARD_STEP]',myThid)
930     ENDIF
931     #endif
932    
933     #ifdef ALLOW_DEBUG
934     IF ( debugLevel .GE. debLevB )
935     & CALL DEBUG_CALL('THERMODYNAMICS',myThid)
936     #endif
937     CALL TIMER_START('THERMODYNAMICS [FORWARD_STEP]',mythid)
938     CALL THERMODYNAMICS( myTime, myIter, myThid )
939     CALL TIMER_STOP ('THERMODYNAMICS [FORWARD_STEP]',mythid)
940    
941     C-- if staggerTimeStep: end
942     ENDIF
943     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
944    
945     #ifdef ALLOW_AUTODIFF_TAMC
946     cph This is needed because convective_adjustment calls
947     cph find_rho which may use pressure()
948     CADJ STORE totphihyd = comlev1, key=ikey_dynamics, kind=isbyte
949     #endif
950     #ifdef ALLOW_DEBUG
951     IF ( debugLevel .GE. debLevB )
952     & CALL DEBUG_CALL('TRACERS_CORRECTION_STEP',myThid)
953     #endif
954     C-- Cycle time-stepping Tracers arrays (T,S,+pTracers)
955     CALL TIMER_START('TS_CORRECTION_STEP [FORWARD_STEP]',myThid)
956     CALL TRACERS_CORRECTION_STEP(myTime, myIter, myThid)
957     CALL TIMER_STOP ('TS_CORRECTION_STEP [FORWARD_STEP]',myThid)
958    
959     #ifdef ALLOW_GCHEM
960     C Add separate timestepping of chemical/biological/forcing
961     C of ptracers here in GCHEM_FORCING_SEP
962     #ifdef ALLOW_AUTODIFF_TAMC
963     CADJ STORE ptracer = comlev1, key=ikey_dynamics, kind=isbyte
964     CADJ STORE theta = comlev1, key=ikey_dynamics, kind=isbyte
965     CADJ STORE salt = comlev1, key=ikey_dynamics, kind=isbyte
966     #endif
967     IF ( useGCHEM ) THEN
968     #ifdef ALLOW_DEBUG
969     IF ( debugLevel .GE. debLevB )
970     & CALL DEBUG_CALL('GCHEM_FORCING_SEP',myThid)
971     #endif /* ALLOW_DEBUG */
972     CALL TIMER_START('GCHEM_FORCING_SEP [FORWARD_STEP]',myThid)
973     CALL GCHEM_FORCING_SEP( myTime,myIter,myThid )
974     CALL TIMER_STOP ('GCHEM_FORCING_SEP [FORWARD_STEP]',myThid)
975     ENDIF
976     #endif /* ALLOW_GCHEM */
977    
978     C-- Do "blocking" sends and receives for tendency "overlap" terms
979     c CALL TIMER_START('BLOCKING_EXCHANGES [FORWARD_STEP]',myThid)
980     c CALL DO_GTERM_BLOCKING_EXCHANGES( myThid )
981     c CALL TIMER_STOP ('BLOCKING_EXCHANGES [FORWARD_STEP]',myThid)
982    
983     #ifdef ALLOW_DEBUG
984     IF ( debugLevel .GE. debLevB )
985     & CALL DEBUG_CALL('DO_FIELDS_BLOCKING_EXCHANGES',myThid)
986     #endif /* ALLOW_DEBUG */
987     C-- Do "blocking" sends and receives for field "overlap" terms
988     CALL TIMER_START('BLOCKING_EXCHANGES [FORWARD_STEP]',myThid)
989     CALL DO_FIELDS_BLOCKING_EXCHANGES( myThid )
990     CALL TIMER_STOP ('BLOCKING_EXCHANGES [FORWARD_STEP]',myThid)
991    
992     #ifdef ALLOW_DIAGNOSTICS
993     IF ( useDiagnostics ) THEN
994     #ifdef ALLOW_DEBUG
995     IF ( debugLevel .GE. debLevB )
996     & CALL DEBUG_CALL('DO_STATEVARS_DIAGS',myThid)
997     #endif /* ALLOW_DEBUG */
998     CALL TIMER_START('DO_STATEVARS_DIAGS [FORWARD_STEP]',myThid)
999     CALL DO_STATEVARS_DIAGS( myTime, 2, myIter, myThid )
1000     CALL TIMER_STOP ('DO_STATEVARS_DIAGS [FORWARD_STEP]',myThid)
1001     ENDIF
1002     #endif
1003    
1004     #ifdef ALLOW_FLT
1005     C-- Calculate float trajectories
1006     IF (useFLT) THEN
1007     CALL TIMER_START('FLOATS [FORWARD_STEP]',myThid)
1008     CALL FLT_MAIN(myIter,myTime, myThid)
1009     CALL TIMER_STOP ('FLOATS [FORWARD_STEP]',myThid)
1010     ENDIF
1011     #endif
1012    
1013     #ifdef ALLOW_AUTODIFF_TAMC
1014     CALL AUTODIFF_INADMODE_SET( myThid )
1015     #endif
1016    
1017     #ifdef ALLOW_TIMEAVE
1018     #ifdef ALLOW_DEBUG
1019     IF ( debugLevel .GE. debLevB )
1020     & CALL DEBUG_CALL('DO_STATEVARS_TAVE',myThid)
1021     #endif /* ALLOW_DEBUG */
1022     C-- State-variables time-averaging
1023     CALL TIMER_START('DO_STATEVARS_TAVE [FORWARD_STEP]',myThid)
1024     CALL DO_STATEVARS_TAVE( myTime, myIter, myThid )
1025     CALL TIMER_STOP ('DO_STATEVARS_TAVE [FORWARD_STEP]',myThid)
1026     #endif
1027    
1028     #ifndef ALLOW_OFFLINE
1029     #ifdef ALLOW_MONITOR
1030     #ifdef ALLOW_DEBUG
1031     IF ( debugLevel .GE. debLevB )
1032     & CALL DEBUG_CALL('MONITOR',myThid)
1033     #endif /* ALLOW_DEBUG */
1034     C-- Check status of solution (statistics, cfl, etc...)
1035     CALL TIMER_START('MONITOR [FORWARD_STEP]',myThid)
1036     CALL MONITOR( myTime, myIter, myThid )
1037     CALL TIMER_STOP ('MONITOR [FORWARD_STEP]',myThid)
1038     #endif /* ALLOW_MONITOR */
1039     #endif
1040    
1041     #ifdef ALLOW_DEBUG
1042     IF ( debugLevel .GE. debLevB )
1043     & CALL DEBUG_CALL('DO_THE_MODEL_IO',myThid)
1044     #endif /* ALLOW_DEBUG */
1045     C-- Do IO if needed.
1046     CALL TIMER_START('DO_THE_MODEL_IO [FORWARD_STEP]',myThid)
1047     CALL DO_THE_MODEL_IO( .FALSE., myTime, myIter, myThid )
1048     CALL TIMER_STOP ('DO_THE_MODEL_IO [FORWARD_STEP]',myThid)
1049    
1050     #ifndef ALLOW_DIVIDED_ADJOINT
1051     # ifdef HAVE_SIGREG
1052     IF ( useSIGREG ) THEN
1053     IF ( i_got_signal .GT. 0 ) THEN
1054     #ifdef ALLOW_DEBUG
1055     IF ( debugLevel .GE. debLevB )
1056     & CALL DEBUG_CALL('DO_WRITE_PICKUP',myThid)
1057     #endif /* ALLOW_DEBUG */
1058     CALL DO_WRITE_PICKUP(
1059     I .TRUE., myTime, myIter, myThid )
1060     STOP 'Checkpoint completed -- killed by signal handler'
1061     ENDIF
1062     ENDIF
1063     # endif /* HAVE_SIGREG */
1064     C-- Save state for restarts
1065     #ifdef ALLOW_DEBUG
1066     IF ( debugLevel .GE. debLevB )
1067     & CALL DEBUG_CALL('DO_WRITE_PICKUP',myThid)
1068     #endif /* ALLOW_DEBUG */
1069     CALL TIMER_START('DO_WRITE_PICKUP [FORWARD_STEP]',myThid)
1070     CALL DO_WRITE_PICKUP(
1071     I .FALSE., myTime, myIter, myThid )
1072     CALL TIMER_STOP ('DO_WRITE_PICKUP [FORWARD_STEP]',myThid)
1073     #endif /* ALLOW_DIVIDED_ADJOINT */
1074    
1075     #ifdef ALLOW_SHOWFLOPS
1076     CALL TIMER_START('SHOWFLOPS_INLOOP [THE_MAIN_LOOP]', mythid)
1077     CALL SHOWFLOPS_INLOOP( iloop, mythid )
1078     CALL TIMER_STOP ('SHOWFLOPS_INLOOP [THE_MAIN_LOOP]', mythid)
1079     #endif
1080    
1081     #ifdef ALLOW_DEBUG
1082     IF ( debugLevel .GE. debLevB )
1083     & CALL DEBUG_CALL('END OF TIMESTEP',myThid)
1084     #endif /* ALLOW_DEBUG */
1085    
1086     #ifdef ALLOW_AUTODIFF_TAMC
1087     #ifdef ALLOW_TAMC_CHECKPOINTING
1088     endif
1089     enddo
1090     endif
1091     enddo
1092     #ifndef AUTODIFF_2_LEVEL_CHECKPOINT
1093     endif
1094     enddo
1095     #endif
1096     #ifdef AUTODIFF_4_LEVEL_CHECKPOINT
1097     endif
1098     enddo
1099     #endif
1100     c
1101     #else /* ndef ALLOW_TAMC_CHECKPOINTING */
1102     enddo
1103     #endif /* ALLOW_TAMC_CHECKPOINTING */
1104    
1105     #else /* ndef ALLOW_AUTODIFF_TAMC */
1106     enddo
1107     #endif /* ALLOW_AUTODIFF_TAMC */
1108    
1109     _BARRIER
1110     call timer_stop ('ECCO MAIN LOOP', mythid)
1111    
1112     call timer_start('ECCO SPIN-DOWN', mythid)
1113    
1114     #ifdef ALLOW_PROFILES
1115     #ifndef ALLOW_DIVIDED_ADJOINT
1116     c-- Accumulate in-situ time averages of temperature, salinity, and SSH.
1117     call timer_start('PROFILES_INLOOP [ECCO SPIN-DOWN]', mythid)
1118     call profiles_inloop( mytime, mythid )
1119     call timer_stop ('PROFILES_INLOOP [ECCO SPIN-DOWN]', mythid)
1120     #endif
1121     #endif
1122    
1123     #ifdef ALLOW_COST
1124    
1125     #ifdef ALLOW_DIVIDED_ADJOINT
1126     CADJ STORE mytime = onetape
1127     #endif
1128     c-- Accumulate time averages of temperature, salinity, and SSH.
1129     #ifndef DISABLE_DEBUGMODE
1130     IF ( debugLevel .GE. debLevB )
1131     & CALL DEBUG_CALL('cost_averagesfields',myThid)
1132     #endif
1133     call timer_start('cost_averagesfields [ECCO SPIN-DOWN]', mythid)
1134     call cost_averagesfields( mytime, mythid )
1135     call timer_stop ('cost_averagesfields [ECCO SPIN-DOWN]', mythid)
1136     #ifdef ALLOW_DIVIDED_ADJOINT
1137     c**************************************
1138     #include "cost_averages_bar_directives.h"
1139     c**************************************
1140     #endif
1141    
1142     #ifdef ALLOW_COST_ATLANTIC
1143     c-- Compute meridional heat transport
1144     #ifndef DISABLE_DEBUGMODE
1145     IF ( debugLevel .GE. debLevB )
1146     & CALL DEBUG_CALL('cost_atlantic',myThid)
1147     #endif
1148     call timer_start('cost_atlantic [ECCO SPIN-DOWN]', mythid)
1149     call cost_atlantic( mytime, myiter,mythid )
1150     call timer_stop ('cost_atlantic [ECCO SPIN-DOWN]', mythid)
1151     #endif
1152    
1153     c-- Compute the cost function contribution of the boundary forcing,
1154     c-- i.e. heat flux, salt flux, zonal and meridional wind stress.
1155     #ifndef DISABLE_DEBUGMODE
1156     IF ( debugLevel .GE. debLevB )
1157     & CALL DEBUG_CALL('cost_forcing',myThid)
1158     #endif
1159     call timer_start('cost_forcing [ECCO SPIN-DOWN]', mythid)
1160     call cost_forcing( myiter, mytime, mythid )
1161     call timer_stop ('cost_forcing [ECCO SPIN-DOWN]', mythid)
1162     cph(
1163     c-- Compute cost function contribution of wind stress observations.
1164     #ifdef ALLOW_MEAN_HFLUX_COST_CONTRIBUTION
1165     call cost_mean_heatflux( myiter, mytime, mythid )
1166     # ifdef ALLOW_AUTODIFF_TAMC
1167     CADJ STORE objf_hfluxmm = tapelev_init, key=1
1168     # endif
1169     #endif
1170    
1171     c-- Compute cost function contribution of wind stress observations.
1172     #ifdef ALLOW_MEAN_SFLUX_COST_CONTRIBUTION
1173     call cost_mean_saltflux( myiter, mytime, mythid )
1174     # ifdef ALLOW_AUTODIFF_TAMC
1175     CADJ STORE objf_sfluxmm = tapelev_init, key=1
1176     # endif
1177     #endif
1178     cph)
1179    
1180     c-- Compute cost function contribution of SSH.
1181     #ifdef ALLOW_SSH_COST_CONTRIBUTION
1182     # ifndef DISABLE_DEBUGMODE
1183     IF ( debugLevel .GE. debLevB )
1184     & CALL DEBUG_CALL('cost_ssh',myThid)
1185     # endif
1186     # if (defined(ALLOW_SSHV4_COST))
1187     call timer_start('cost_sshv4 [ECCO SPIN-DOWN]', mythid)
1188     call cost_sshv4( myiter, mytime, mythid )
1189     call timer_stop ('cost_sshv4 [ECCO SPIN-DOWN]', mythid)
1190     # elif (defined(ALLOW_NEW_SSH_COST))
1191     call timer_start('cost_ssh_new [ECCO SPIN-DOWN]', mythid)
1192     call cost_ssh_new( myiter, mytime, mythid )
1193     call timer_stop ('cost_ssh_new [ECCO SPIN-DOWN]', mythid)
1194     # else
1195     call timer_start('cost_ssh [ECCO SPIN-DOWN]', mythid)
1196     call cost_ssh( myiter, mytime, mythid )
1197     call timer_stop ('cost_ssh [ECCO SPIN-DOWN]', mythid)
1198     # endif
1199     # ifdef ALLOW_AUTODIFF_TAMC
1200     # ifdef ALLOW_PROFILES
1201     CADJ STORE prof_etan_mean = tapelev_init, key=1
1202     # endif
1203     # endif
1204     #endif
1205    
1206     #ifdef ALLOW_BP_COST_CONTRIBUTION
1207     c-- Compute bottom pressure cost
1208     call timer_start('cost_bp [ECCO SPIN-DOWN]', mythid)
1209     call cost_bp( myiter, mytime, mythid )
1210     call timer_stop ('cost_bp [ECCO SPIN-DOWN]', mythid)
1211     #endif
1212    
1213     c-- Compute cost function contribution of Temperature and Salinity.
1214     #ifndef DISABLE_DEBUGMODE
1215     IF ( debugLevel .GE. debLevB )
1216     & CALL DEBUG_CALL('cost_hyd',myThid)
1217     #endif
1218     call timer_start('cost_hyd [ECCO SPIN-DOWN]', mythid)
1219     call cost_hyd( myiter, mytime, mythid )
1220     call timer_stop ('cost_hyd [ECCO SPIN-DOWN]', mythid)
1221    
1222     #ifdef ALLOW_SEAICE
1223     #ifndef DISABLE_DEBUGMODE
1224     IF ( debugLevel .GE. debLevB )
1225     & CALL DEBUG_CALL('seaice_cost_driver',myThid)
1226     #endif
1227     IF ( useSeaice) THEN
1228     call timer_start('seaice_cost_driver [ECCO SPIN-DOWN]', mythid)
1229     call seaice_cost_driver( myiter, mytime, mythid )
1230     call timer_stop ('seaice_cost_driver [ECCO SPIN-DOWN]', mythid)
1231     ENDIF
1232     #endif
1233    
1234     #ifdef ALLOW_OBCS_COST_CONTRIBUTION
1235     #ifndef DISABLE_DEBUGMODE
1236     IF ( debugLevel .GE. debLevB )
1237     & CALL DEBUG_CALL('cost_obcs',myThid)
1238     #endif
1239     call timer_start('cost_obcs [ECCO SPIN-DOWN]', mythid)
1240     call cost_obcs( myiter, mytime, mythid )
1241     call timer_stop ('cost_obcs [ECCO SPIN-DOWN]', mythid)
1242     #endif
1243    
1244     #ifdef ALLOW_CURMTR_COST_CONTRIBUTION
1245     #ifndef DISABLE_DEBUGMODE
1246     IF ( debugLevel .GE. debLevB )
1247     & CALL DEBUG_CALL('cost_curmtr',myThid)
1248     #endif
1249     call timer_start('cost_curmtr [ECCO SPIN-DOWN]', mythid)
1250     call cost_curmtr( myiter, mytime, mythid )
1251     call timer_stop ('cost_curmtr [ECCO SPIN-DOWN]', mythid)
1252     #endif
1253    
1254     c-- Compute cost function contribution of drifter's velocities.
1255     #ifdef ALLOW_DRIFTER_COST_CONTRIBUTION
1256     #ifndef DISABLE_DEBUGMODE
1257     IF ( debugLevel .GE. debLevB )
1258     & CALL DEBUG_CALL('cost_drifter',myThid)
1259     #endif
1260     call timer_start('cost_drifter [ECCO SPIN-DOWN]', mythid)
1261     call cost_drifter( myiter, mytime, mythid )
1262     call timer_stop ('cost_drifter [ECCO SPIN-DOWN]', mythid)
1263     #endif
1264    
1265     c-- Compute cost function contribution of wind stress observations.
1266     #if (defined (ALLOW_SCAT_COST_CONTRIBUTION) || \
1267     defined (ALLOW_DAILYSCAT_COST_CONTRIBUTION) )
1268     #ifndef DISABLE_DEBUGMODE
1269     IF ( debugLevel .GE. debLevB )
1270     & CALL DEBUG_CALL('cost_scat',myThid)
1271     #endif
1272     call timer_start('cost_scat [ECCO SPIN-DOWN]', mythid)
1273     call cost_scat( myiter, mytime, mythid )
1274     call timer_stop ('cost_scat [ECCO SPIN-DOWN]', mythid)
1275     #endif
1276    
1277     c-- Compute cost function contribution of drift between the first
1278     c and the last year.
1279     #ifdef ALLOW_DRIFT_COST_CONTRIBUTION
1280     #ifndef DISABLE_DEBUGMODE
1281     IF ( debugLevel .GE. debLevB )
1282     & CALL DEBUG_CALL('cost_drift',myThid)
1283     #endif
1284     call timer_start('cost_drift [ECCO SPIN-DOWN]', mythid)
1285     call cost_drift( myiter, mytime, mythid )
1286     call timer_stop ('cost_drift [ECCO SPIN-DOWN]', mythid)
1287     #endif
1288     #ifdef ALLOW_DRIFTW_COST_CONTRIBUTION
1289     #ifndef DISABLE_DEBUGMODE
1290     IF ( debugLevel .GE. debLevB )
1291     & CALL DEBUG_CALL('cost_driftw',myThid)
1292     #endif
1293     call timer_start('cost_driftw [ECCO SPIN-DOWN]', mythid)
1294     call cost_driftw( myiter, mytime, mythid )
1295     call timer_stop ('cost_driftw [ECCO SPIN-DOWN]', mythid)
1296     #endif
1297     _BARRIER
1298    
1299     c-- Compute initial vs. final T/S deviation
1300     #ifdef ALLOW_COST_INI_FIN
1301     call timer_start('cost_ini_fin [ECCO SPIN-DOWN]', mythid)
1302     call cost_theta_ini_fin( myiter, mytime, mythid )
1303     call cost_salt_ini_fin( myiter, mytime, mythid )
1304     call timer_stop ('cost_ini_fin [ECCO SPIN-DOWN]', mythid)
1305     #endif
1306     _BARRIER
1307    
1308     c-- Internal Parameter controls cost terms:
1309     call timer_start('cost_internal_params [ECCO SPIN-DOWN]', mythid)
1310     call cost_internal_params( myiter, mytime, mythid )
1311     call timer_stop ('cost_internal_params [ECCO SPIN-DOWN]', mythid)
1312     _BARRIER
1313    
1314     c-- Compute user defined cost function contributions
1315     call timer_start('cost_gencost_all [ECCO SPIN-DOWN]', mythid)
1316     call cost_gencost_all( myiter, mytime, mythid )
1317     call timer_stop ('cost_gencost_all [ECCO SPIN-DOWN]', mythid)
1318    
1319     c-- Sum all cost function contributions.
1320     #ifndef DISABLE_DEBUGMODE
1321     IF ( debugLevel .GE. debLevB )
1322     & CALL DEBUG_CALL('cost_final',myThid)
1323     #endif
1324     call timer_start('COST_FINAL [ECCO SPIN-DOWN]', mythid)
1325     call cost_final( mythid )
1326     call timer_stop ('COST_FINAL [ECCO SPIN-DOWN]', mythid)
1327    
1328     #endif /* ALLOW_COST */
1329    
1330     call timer_stop ('ECCO SPIN-DOWN', mythid)
1331    
1332     #ifndef DISABLE_DEBUGMODE
1333     IF ( debugLevel .GE. debLevB )
1334     & CALL DEBUG_LEAVE('THE_MAIN_LOOP',myThid)
1335     #endif
1336    
1337     return
1338     end
1339    
  ViewVC Help
Powered by ViewVC 1.1.22