/[MITgcm]/MITgcm/pkg/ecco/the_main_loop.F
ViewVC logotype

Annotation of /MITgcm/pkg/ecco/the_main_loop.F

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


Revision 1.69 - (hide annotations) (download)
Mon Apr 21 15:19:58 2008 UTC (16 years, 2 months ago) by heimbach
Branch: MAIN
Changes since 1.68: +4 -1 lines
One more store for NLFS

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

  ViewVC Help
Powered by ViewVC 1.1.22