/[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.11 - (hide annotations) (download)
Wed Oct 13 07:05:51 2004 UTC (19 years, 8 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint55e_post, checkpoint55f_post
Changes since 1.10: +34 -1 lines 
o some delicate re-shuffle of store directives to avoid one
  extra call of do_oceanic_physics
o NB: this may break global_ocean adjoint temporarily,
  but it is clear how to fix it. Will do later, need this now.
1 heimbach 1.11 C $Header: /u/gcmpack/MITgcm/pkg/ecco/the_main_loop.F,v 1.10 2004/10/12 15:14:16 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     c**************************************
76     #ifdef ALLOW_AUTODIFF_TAMC
77    
78     c These includes are needed for
79     c AD-checkpointing.
80     c They provide the fields to be stored.
81    
82     # include "GRID.h"
83     # include "DYNVARS.h"
84     # include "FFIELDS.h"
85     # include "EOS.h"
86     # include "GAD.h"
87    
88     # ifdef ALLOW_CD_CODE
89     # include "CD_CODE_VARS.h"
90     # endif
91     # ifdef ALLOW_PTRACERS
92 jmc 1.7 # include "PTRACERS_SIZE.h"
93 heimbach 1.1 # include "PTRACERS.h"
94     # endif
95     # ifdef ALLOW_NONHYDROSTATIC
96     # include "CG3D.h"
97     # endif
98     # ifdef EXACT_CONSERV
99     # include "SURFACE.h"
100     # endif
101     # ifdef ALLOW_OBCS
102     # include "OBCS.h"
103     # endif
104     # ifdef ALLOW_EXF
105     # include "exf_fields.h"
106     # include "exf_clim_fields.h"
107     # ifdef ALLOW_BULKFORMULAE
108     # include "exf_constants.h"
109     # endif
110     # endif /* ALLOW_EXF */
111     # ifdef ALLOW_SEAICE
112     # include "SEAICE.h"
113     # endif
114 heimbach 1.11 # ifdef ALLOW_KPP
115     # include "KPP.h"
116     # endif
117     # ifdef ALLOW_GMREDI
118     # include "GMREDI.h"
119     # endif
120 heimbach 1.1 # ifdef ALLOW_DIVIDED_ADJOINT_MPI
121     # include "mpif.h"
122     # endif
123    
124     # include "tamc.h"
125     # include "ctrl.h"
126     # include "ctrl_dummy.h"
127     # include "cost.h"
128 heimbach 1.3 # include "ecco_cost.h"
129 heimbach 1.1
130     #endif /* ALLOW_AUTODIFF_TAMC */
131     c**************************************
132    
133     c == routine arguments ==
134     c note: under the multi-threaded model myiter and
135     c mytime are local variables passed around as routine
136     c arguments. Although this is fiddly it saves the need to
137     c impose additional synchronisation points when they are
138     c updated.
139     c myiter - iteration counter for this thread
140     c mytime - time counter for this thread
141     c mythid - thread number for this instance of the routine.
142     integer mythid
143     integer myiter
144     _RL mytime
145    
146     c == local variables ==
147    
148     integer bi,bj
149     integer iloop
150     integer mydate(4)
151     #ifdef ALLOW_SNAPSHOTS
152     character yprefix*3
153     #endif
154    
155     #ifdef ALLOW_TAMC_CHECKPOINTING
156     integer ilev_1
157     integer ilev_2
158     integer ilev_3
159     integer max_lev2
160     integer max_lev3
161     #endif
162    
163     c-- == end of interface ==
164    
165     #ifndef DISABLE_DEBUGMODE
166     IF ( debugLevel .GE. debLevB )
167     & CALL DEBUG_ENTER('THE_MAIN_LOOP',myThid)
168     #endif
169    
170     #ifdef ALLOW_AUTODIFF_TAMC
171     c-- Initialize storage for the initialisations.
172     CADJ INIT tapelev3 = USER
173     c-- Some more initialisations to please TAMC
174     CADJ INIT tapelev_ini_bibj_k = USER
175 heimbach 1.10 CADJ INIT tapelev_init = USER
176 heimbach 1.1 # ifdef ALLOW_DIVIDED_ADJOINT
177     CADJ INIT onetape = user
178     cphCADJ INIT onetape = common, 1
179     cph We want to avoid common blocks except in the inner loop.
180     cph Reason: the active write and consecutive read may occur
181     cph in separate model executions for which the info
182     cph in common blocks are lost.
183     cph Thus, we can only store real values (no integers)
184     cph because we only have active file handling to real available.
185     # endif
186     # ifdef ALLOW_TAMC_CHECKPOINTING
187     ikey_dynamics = 1
188     # endif
189     #endif /* ALLOW_AUTODIFF_TAMC */
190    
191     CALL TIMER_START('ECCO SPIN-UP', mythid)
192    
193     c-- Get the current date.
194     call CAL_TIMESTAMP( myiter, mytime, mydate, mythid )
195    
196     C-- Set initial conditions (variable arrays)
197     #ifndef DISABLE_DEBUGMODE
198     IF ( debugLevel .GE. debLevB )
199     & CALL DEBUG_CALL('INITIALISE_VARIA',myThid)
200     #endif
201     CALL TIMER_START('INITIALISE_VARIA [THE_MAIN_LOOP]', mythid)
202     CALL INITIALISE_VARIA( mythid )
203     CALL TIMER_STOP ('INITIALISE_VARIA [THE_MAIN_LOOP]', mythid)
204    
205 heimbach 1.8 #ifdef ALLOW_MONITOR
206     #ifdef ALLOW_DEBUG
207     IF (debugMode) CALL DEBUG_CALL('MONITOR',myThid)
208 heimbach 1.1 #endif
209     C-- Check status of solution (statistics, cfl, etc...)
210     CALL TIMER_START('MONITOR [THE_MAIN_LOOP]', mythid)
211     CALL MONITOR( myIter, myTime, myThid )
212     CALL TIMER_STOP ('MONITOR [THE_MAIN_LOOP]', mythid)
213     #endif /* ALLOW_MONITOR */
214 heimbach 1.4
215 heimbach 1.8 C-- Do IO if needed (Dump for start state).
216 heimbach 1.4 #ifdef ALLOW_DEBUG
217     IF (debugMode) CALL DEBUG_CALL('DO_THE_MODEL_IO',myThid)
218     #endif
219 heimbach 1.8
220     #ifdef ALLOW_OFFLINE
221     CALL TIMER_START('OFFLINE_MODEL_IO [FORWARD_STEP]',myThid)
222     CALL OFFLINE_MODEL_IO( myTime, myIter, myThid )
223     CALL TIMER_STOP ('OFFLINE_MODEL_IO [FORWARD_STEP]',myThid)
224     #else
225 heimbach 1.4 CALL TIMER_START('DO_THE_MODEL_IO [THE_MAIN_LOOP]', mythid)
226     CALL DO_THE_MODEL_IO( myTime, myIter, mythid )
227     CALL TIMER_STOP ('DO_THE_MODEL_IO [THE_MAIN_LOOP]', mythid)
228 heimbach 1.8 #endif
229 heimbach 1.1
230     call timer_stop ('ECCO SPIN-UP', mythid)
231     _BARRIER
232    
233     c-- Do the model integration.
234     call timer_start('ECCO MAIN LOOP',mythid)
235    
236     c >>>>>>>>>>>>>>>>>>>>>>>>>>> LOOP <<<<<<<<<<<<<<<<<<<<<<<<<<<<
237     c >>>>>>>>>>>>>>>>>>>>>>>>>>> STARTS <<<<<<<<<<<<<<<<<<<<<<<<<<<<
238    
239     #ifdef ALLOW_AUTODIFF_TAMC
240     #ifdef ALLOW_TAMC_CHECKPOINTING
241     c-- Implement a three level checkpointing. For a two level
242     c-- checkpointing delete the middle loop; for n levels (n > 3)
243     c-- insert more loops.
244    
245     c-- Check the choice of the checkpointing parameters in relation
246     c-- to nTimeSteps: (nchklev_1*nchklev_2*nchklev_3 .ge. nTimeSteps)
247     if (nchklev_1*nchklev_2*nchklev_3 .lt. nTimeSteps) then
248     print*
249     print*, ' the_main_loop: TAMC checkpointing parameters'
250     print*, ' nchklev_1*nchklev_2*nchklev_3 = ',
251     & nchklev_1*nchklev_2*nchklev_3
252     print*, ' are not consistent with nTimeSteps = ',
253     & nTimeSteps
254     stop ' ... stopped in the_main_loop.'
255     endif
256     max_lev3=nTimeSteps/(nchklev_1*nchklev_2)+1
257     max_lev2=nTimeSteps/nchklev_1+1
258    
259     c**************************************
260     #ifdef ALLOW_DIVIDED_ADJOINT
261     CADJ loop = divided
262     #endif
263     c**************************************
264    
265     do ilev_3 = 1,nchklev_3
266     if(ilev_3.le.max_lev3) then
267     c**************************************
268     #include "checkpoint_lev3_directives.h"
269     c**************************************
270    
271     c-- Initialise storage for the middle loop.
272     CADJ INIT tapelev2 = USER
273    
274     do ilev_2 = 1,nchklev_2
275     if(ilev_2.le.max_lev2) then
276     c**************************************
277     #include "checkpoint_lev2_directives.h"
278     c**************************************
279    
280    
281     c**************************************
282     #ifdef ALLOW_AUTODIFF_TAMC
283     c-- Initialize storage for the innermost loop.
284     c-- Always check common block sizes for the checkpointing!
285     c--
286     CADJ INIT comlev1 = COMMON,nchklev_1
287     CADJ INIT comlev1_bibj = COMMON,nchklev_1*nsx*nsy*nthreads_chkpt
288     CADJ INIT comlev1_bibj_k = COMMON,nchklev_1*nsx*nsy*nr*nthreads_chkpt
289     c--
290     # ifdef ALLOW_KPP
291     CADJ INIT comlev1_kpp = COMMON,nchklev_1*nsx*nsy
292 heimbach 1.6 CADJ INIT comlev1_kpp_k = COMMON,nchklev_1*nsx*nsy*nr
293 heimbach 1.1 # endif /* ALLOW_KPP */
294     c--
295     # ifdef ALLOW_GMREDI
296     CADJ INIT comlev1_gmredi_k_gad
297     CADJ & = COMMON,nchklev_1*nsx*nsy*nr*nthreads_chkpt*maxpass
298     # endif /* ALLOW_GMREDI */
299     c--
300     # ifdef ALLOW_PTRACERS
301     CADJ INIT comlev1_bibj_ptracers = COMMON,
302 jmc 1.7 CADJ & nchklev_1*nsx*nsy*nthreads_chkpt*PTRACERS_num
303 heimbach 1.1 # endif /* ALLOW_PTRACERS */
304     c--
305     # ifndef DISABLE_MULTIDIM_ADVECTION
306     CADJ INIT comlev1_bibj_k_gad
307     CADJ & = COMMON,nchklev_1*nsx*nsy*nr*nthreads_chkpt*maxpass
308     CADJ INIT comlev1_bibj_k_gad_pass
309     CADJ & = COMMON,nchklev_1*nsx*nsy*nr*nthreads_chkpt*maxpass*maxcube
310     # endif /* DISABLE_MULTIDIM_ADVECTION */
311     c--
312     # if (defined (ALLOW_EXF) && defined (ALLOW_BULKFORMULAE))
313     CADJ INIT comlev1_exf_1
314     CADJ & = COMMON,nchklev_1*snx*nsx*sny*nsy*nthreads_chkpt
315     CADJ INIT comlev1_exf_2
316     CADJ & = COMMON,niter_bulk*nchklev_1*snx*nsx*sny*nsy*nthreads_chkpt
317     # endif
318     c--
319     # ifdef ALLOW_SEAICE
320     # ifdef SEAICE_ALLOW_DYNAMICS
321     CADJ INIT comlev1_lsr = COMMON,nchklev_1*2
322     # endif
323     # ifdef SEAICE_MULTILEVEL
324     CADJ INIT comlev1_multdim
325     CADJ & = COMMON,nchklev_1*nsx*nsy*nthreads_chkpt*multdim
326     # endif
327     # endif /* ALLOW_SEAICE */
328     c--
329     #endif /* ALLOW_AUTODIFF_TAMC */
330     c**************************************
331    
332     do ilev_1 = 1,nchklev_1
333    
334     c-- The if-statement below introduces a some flexibility in the
335     c-- choice of the 3-tupel ( nchklev_1, nchklev_2, nchklev_3 ).
336     c--
337     c-- Requirement: nchklev_1*nchklev_2*nchklev_3 .ge. nTimeSteps .
338    
339     iloop = (ilev_3 - 1)*nchklev_2*nchklev_1 +
340     & (ilev_2 - 1)*nchklev_1 + ilev_1
341    
342     if ( iloop .le. nTimeSteps ) then
343    
344     #else /* ALLOW_TAMC_CHECKPOINTING undefined */
345     c-- Initialise storage for the reference trajectory without TAMC check-
346     c-- pointing.
347     CADJ INIT history = USER
348     CADJ INIT comlev1_bibj = COMMON,nchklev_0*nsx*nsy*nthreads_chkpt
349     CADJ INIT comlev1_bibj_k = COMMON,nchklev_0*nsx*nsy*nr*nthreads_chkpt
350     CADJ INIT comlev1_kpp = COMMON,nchklev_0*nsx*nsy
351    
352     c-- Check the choice of the checkpointing parameters in relation
353     c-- to nTimeSteps: (nchklev_0 .ge. nTimeSteps)
354     if (nchklev_0 .lt. nTimeSteps) then
355     print*
356     print*, ' the_main_loop: ',
357     & 'TAMC checkpointing parameter nchklev_0 = ',
358     & nchklev_0
359     print*, ' is not consistent with nTimeSteps = ',
360     & nTimeSteps
361     stop ' ... stopped in the_main_loop.'
362     endif
363    
364     do iloop = 1, nTimeSteps
365    
366     #endif /* ALLOW_TAMC_CHECKPOINTING */
367    
368     #else /* ALLOW_AUTODIFF_TAMC undefined */
369     c-- Start the main loop of ecco_Objfunc. Automatic differentiation is
370     c-- NOT enabled.
371     do iloop = 1, nTimeSteps
372     #endif /* ALLOW_AUTODIFF_TAMC */
373    
374     #ifdef ALLOW_TAMC_CHECKPOINTING
375     nIter0 = INT( startTime/deltaTClock )
376     ikey_dynamics = ilev_1
377     #endif
378    
379     c-- Set the model iteration counter and the model time.
380     myiter = nIter0 + (iloop-1)
381     mytime = startTime + float(iloop-1)*deltaTclock
382    
383     #ifdef ALLOW_COST
384    
385     c-- Accumulate time averages of temperature, salinity, and SSH.
386     call timer_start('COST_AVERAGESFIELDS [ECCO MAIN]', mythid)
387     call cost_averagesFields( mytime, mythid )
388     call timer_stop ('COST_AVERAGESFIELDS [ECCO MAIN]', mythid)
389     #ifdef ALLOW_COST_ATLANTIC
390     c-- Compute meridional heat transport
391     call timer_start('cost_atlantic [ECCO MAIN]', mythid)
392     call cost_atlantic( mytime, myiter,mythid )
393     call timer_stop ('cost_atlantic [ECCO MAIN]', mythid)
394     #endif
395     #endif /* ALLOW_COST */
396    
397     #ifdef ALLOW_AUTODIFF_TAMC
398     c**************************************
399     #include "checkpoint_lev1_directives.h"
400     c**************************************
401     #endif
402    
403     #ifndef DISABLE_DEBUGMODE
404     IF ( debugLevel .GE. debLevB )
405     & CALL DEBUG_CALL('EXF_GETFORCING',myThid)
406     #endif
407     CALL TIMER_START('EXF_GETFORCING [FORWARD_STEP]',mythid)
408     CALL EXF_GETFORCING( mytime, myiter, mythid )
409     CALL TIMER_STOP ('EXF_GETFORCING [FORWARD_STEP]',mythid)
410    
411     #ifdef ALLOW_SEAICE
412     cph this simple runtime flag causes a lot of recomp.
413     cph IF ( useSEAICE ) THEN
414     #ifndef DISABLE_DEBUGMODE
415     IF ( debugLevel .GE. debLevB )
416     & CALL DEBUG_CALL('SEAICE_MODEL',myThid)
417     #endif
418     CALL TIMER_START('SEAICE_MODEL [FORWARD_STEP]',myThid)
419     CALL SEAICE_MODEL( myTime, myIter, myThid )
420     CALL TIMER_STOP ('SEAICE_MODEL [FORWARD_STEP]',myThid)
421     #ifdef ALLOW_COST_ICE
422     CALL COST_ICE ( myTime, myIter, myThid )
423     #endif
424     cph ENDIF
425     #endif /* ALLOW_SEAICE */
426    
427 heimbach 1.11 #ifdef ALLOW_AUTODIFF_TAMC
428     # ifdef ALLOW_PTRACERS
429     cph this replaces _bibj storing of ptracer within thermodynamics
430     CADJ STORE ptracer = comlev1, key = ikey_dynamics
431     # endif
432     #endif
433    
434 heimbach 1.1 #if (defined (ALLOW_AUTODIFF_TAMC) && \
435     defined (ALLOW_AUTODIFF_MONITOR))
436     C Include call to a dummy routine. Its adjoint will be
437     C called at the proper place in the adjoint code.
438     C The adjoint routine will print out adjoint values
439     C if requested. The location of the call is important,
440     C it has to be after the adjoint of the exchanges
441     C (DO_GTERM_BLOCKING_EXCHANGES).
442     CALL DUMMY_IN_STEPPING( myTime, myIter, myThid )
443     #endif
444    
445 heimbach 1.8 #ifdef ALLOW_EBM
446     IF ( useEBM ) THEN
447     # ifdef ALLOW_DEBUG
448     IF ( debugLevel .GE. debLevB )
449     & CALL DEBUG_CALL('EBM',myThid)
450     # endif
451     CALL TIMER_START('EBM [FORWARD_STEP]',mythid)
452     CALL EBM_DRIVER ( myTime, myIter, myThid )
453     CALL TIMER_STOP ('EBM [FORWARD_STEP]',mythid)
454     ENDIF
455 heimbach 1.1 #endif
456    
457     C-- Step forward fields and calculate time tendency terms.
458    
459 heimbach 1.8 #ifdef ALLOW_DEBUG
460     IF ( debugLevel .GE. debLevB )
461     & CALL DEBUG_CALL('DO_ATMOSPHERIC_PHYS',myThid)
462 heimbach 1.1 #endif
463 heimbach 1.8 CALL TIMER_START('DO_ATMOSPHERIC_PHYS [FORWARD_STEP]',mythid)
464     CALL DO_ATMOSPHERIC_PHYS( myTime, myIter, myThid )
465     CALL TIMER_STOP ('DO_ATMOSPHERIC_PHYS [FORWARD_STEP]',mythid)
466 heimbach 1.1
467 heimbach 1.8 #ifndef ALLOW_OFFLINE
468     #ifdef ALLOW_DEBUG
469     IF ( debugLevel .GE. debLevB )
470     & CALL DEBUG_CALL('DO_OCEANIC_PHYS',myThid)
471 heimbach 1.1 #endif
472 heimbach 1.8 CALL TIMER_START('DO_OCEANIC_PHYS [FORWARD_STEP]',mythid)
473     CALL DO_OCEANIC_PHYS( myTime, myIter, myThid )
474     CALL TIMER_STOP ('DO_OCEANIC_PHYS [FORWARD_STEP]',mythid)
475 heimbach 1.1 #endif
476    
477 heimbach 1.11 #ifdef ALLOW_AUTODIFF_TAMC
478     cph needed to be moved here from do_oceanic_physics
479     cph to be visible down the road
480     c
481     CADJ STORE surfaceForcingS = comlev1, key = ikey_dynamics
482     CADJ STORE surfaceForcingT = comlev1, key = ikey_dynamics
483     CADJ STORE surfaceForcingTice = comlev1, key = ikey_dynamics
484     c
485     CADJ STORE Kwx = comlev1, key = ikey_dynamics
486     CADJ STORE Kwy = comlev1, key = ikey_dynamics
487     CADJ STORE Kwz = comlev1, key = ikey_dynamics
488     c
489     CADJ STORE KPPghat = comlev1, key = ikey_dynamics
490     CADJ STORE KPPfrac = comlev1, key = ikey_dynamics
491     #endif /* ALLOW_AUTODIFF_TAMC */
492    
493    
494 heimbach 1.8 IF ( .NOT.staggerTimeStep ) THEN
495     #ifdef ALLOW_DEBUG
496 heimbach 1.1 IF ( debugLevel .GE. debLevB )
497 heimbach 1.8 & CALL DEBUG_CALL('THERMODYNAMICS',myThid)
498 heimbach 1.1 #endif
499 heimbach 1.8 CALL TIMER_START('THERMODYNAMICS [FORWARD_STEP]',mythid)
500     CALL THERMODYNAMICS( myTime, myIter, myThid )
501     CALL TIMER_STOP ('THERMODYNAMICS [FORWARD_STEP]',mythid)
502     C-- if not staggerTimeStep: end
503 heimbach 1.1 ENDIF
504    
505     C-- Step forward fields and calculate time tendency terms.
506 heimbach 1.8 #ifndef ALLOW_OFFLINE
507 heimbach 1.1 #ifndef ALLOW_AUTODIFF_TAMC
508     IF ( momStepping ) THEN
509     #endif
510 heimbach 1.8 #ifdef ALLOW_DEBUG
511 heimbach 1.1 IF ( debugLevel .GE. debLevB )
512     & CALL DEBUG_CALL('DYNAMICS',myThid)
513     #endif
514     CALL TIMER_START('DYNAMICS [FORWARD_STEP]',mythid)
515     CALL DYNAMICS( myTime, myIter, myThid )
516     CALL TIMER_STOP ('DYNAMICS [FORWARD_STEP]',mythid)
517     #ifndef ALLOW_AUTODIFF_TAMC
518     ENDIF
519     #endif
520 heimbach 1.8 #endif
521 heimbach 1.1
522     #ifdef ALLOW_NONHYDROSTATIC
523     C-- Step forward W field in N-H algorithm
524     IF ( momStepping .AND. nonHydrostatic ) THEN
525 heimbach 1.8 #ifdef ALLOW_DEBUG
526     IF ( debugLevel .GE. debLevB )
527     & CALL DEBUG_CALL('CALC_GW',myThid)
528 heimbach 1.1 #endif
529     CALL TIMER_START('CALC_GW [FORWARD_STEP]',myThid)
530     CALL CALC_GW(myThid)
531     CALL TIMER_STOP ('CALC_GW [FORWARD_STEP]',myThid)
532     ENDIF
533     #endif
534    
535 heimbach 1.8 C-- Update time-counter
536     myIter = nIter0 + iLoop
537     myTime = startTime + deltaTClock * float(iLoop)
538    
539     C-- Update geometric factors:
540 heimbach 1.1 #ifdef NONLIN_FRSURF
541 heimbach 1.8 C- update hfacC,W,S and recip_hFac according to etaH(n+1) :
542 heimbach 1.1 IF ( nonlinFreeSurf.GT.0) THEN
543     IF ( select_rStar.GT.0 ) THEN
544     CALL TIMER_START('UPDATE_R_STAR [FORWARD_STEP]',myThid)
545     CALL UPDATE_R_STAR( myTime, myIter, myThid )
546     CALL TIMER_STOP ('UPDATE_R_STAR [FORWARD_STEP]',myThid)
547     ELSE
548     CALL TIMER_START('UPDATE_SURF_DR [FORWARD_STEP]',myThid)
549     CALL UPDATE_SURF_DR( myTime, myIter, myThid )
550     CALL TIMER_STOP ('UPDATE_SURF_DR [FORWARD_STEP]',myThid)
551     ENDIF
552     ENDIF
553     C- update also CG2D matrix (and preconditioner)
554     IF ( momStepping .AND. nonlinFreeSurf.GT.2 ) THEN
555     CALL TIMER_START('UPDATE_CG2D [FORWARD_STEP]',myThid)
556     CALL UPDATE_CG2D( myTime, myIter, myThid )
557     CALL TIMER_STOP ('UPDATE_CG2D [FORWARD_STEP]',myThid)
558     ENDIF
559     #endif
560    
561     C-- Apply Filters to u*,v* before SOLVE_FOR_PRESSURE
562     #ifdef ALLOW_SHAP_FILT
563     IF (useSHAP_FILT .AND. shap_filt_uvStar) THEN
564     CALL TIMER_START('SHAP_FILT [FORWARD_STEP]',myThid)
565     IF (implicDiv2Dflow.LT.1.) THEN
566     C-- Explicit+Implicit part of the Barotropic Flow Divergence
567     C => Filtering of uVel,vVel is necessary
568     CALL SHAP_FILT_APPLY_UV( uVel,vVel,
569 heimbach 1.8 & myTime, myIter, myThid )
570 heimbach 1.1 ENDIF
571 heimbach 1.8 CALL SHAP_FILT_APPLY_UV( gU,gV,myTime,myIter,myThid)
572 heimbach 1.1 CALL TIMER_STOP ('SHAP_FILT [FORWARD_STEP]',myThid)
573     ENDIF
574     #endif
575     #ifdef ALLOW_ZONAL_FILT
576     IF (useZONAL_FILT .AND. zonal_filt_uvStar) THEN
577     CALL TIMER_START('ZONAL_FILT_APPLY [FORWARD_STEP]',myThid)
578     IF (implicDiv2Dflow.LT.1.) THEN
579     C-- Explicit+Implicit part of the Barotropic Flow Divergence
580     C => Filtering of uVel,vVel is necessary
581     CALL ZONAL_FILT_APPLY_UV( uVel, vVel, myThid )
582     ENDIF
583     CALL ZONAL_FILT_APPLY_UV( gU, gV, myThid )
584     CALL TIMER_STOP ('ZONAL_FILT_APPLY [FORWARD_STEP]',myThid)
585     ENDIF
586     #endif
587    
588     C-- Solve elliptic equation(s).
589     C Two-dimensional only for conventional hydrostatic or
590     C three-dimensional for non-hydrostatic and/or IGW scheme.
591 heimbach 1.8 #ifndef ALLOW_OFFLINE
592 heimbach 1.1 IF ( momStepping ) THEN
593 heimbach 1.8 CALL TIMER_START('SOLVE_FOR_PRESSURE [FORWARD_STEP]',myThid)
594     CALL SOLVE_FOR_PRESSURE(myTime, myIter, myThid)
595     CALL TIMER_STOP ('SOLVE_FOR_PRESSURE [FORWARD_STEP]',myThid)
596 heimbach 1.1 ENDIF
597 heimbach 1.8 #endif
598    
599     C-- Correct divergence in flow field and cycle time-stepping momentum
600     c IF ( momStepping ) THEN
601     #ifndef ALLOW_OFFLINE
602     CALL TIMER_START('UV_CORRECTION_STEP [FORWARD_STEP]',myThid)
603     CALL MOMENTUM_CORRECTION_STEP(myTime, myIter, myThid)
604     CALL TIMER_STOP ('UV_CORRECTION_STEP [FORWARD_STEP]',myThid)
605     #endif
606     c ENDIF
607    
608     #ifdef EXACT_CONSERV
609     IF (exactConserv) THEN
610     C-- Update etaH(n+1) :
611     CALL TIMER_START('UPDATE_ETAH [FORWARD_STEP]',mythid)
612     CALL UPDATE_ETAH( myTime, myIter, myThid )
613     CALL TIMER_STOP ('UPDATE_ETAH [FORWARD_STEP]',mythid)
614     ENDIF
615     #endif /* EXACT_CONSERV */
616    
617     #ifdef NONLIN_FRSURF
618     IF ( select_rStar.NE.0 ) THEN
619     C-- r* : compute the future level thickness according to etaH(n+1)
620     CALL TIMER_START('CALC_R_STAR [FORWARD_STEP]',mythid)
621     CALL CALC_R_STAR(etaH, myTime, myIter, myThid )
622     CALL TIMER_STOP ('CALC_R_STAR [FORWARD_STEP]',mythid)
623     ELSEIF ( nonlinFreeSurf.GT.0) THEN
624     C-- compute the future surface level thickness according to etaH(n+1)
625     CALL TIMER_START('CALC_SURF_DR [FORWARD_STEP]',mythid)
626     CALL CALC_SURF_DR(etaH, myTime, myIter, myThid )
627     CALL TIMER_STOP ('CALC_SURF_DR [FORWARD_STEP]',mythid)
628     ENDIF
629     #endif /* NONLIN_FRSURF */
630    
631     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
632     IF ( staggerTimeStep ) THEN
633     C-- do exchanges of U,V (needed for multiDim) when using stagger time-step :
634     #ifdef ALLOW_DEBUG
635     IF ( debugLevel .GE. debLevB )
636     & CALL DEBUG_CALL('DO_STAGGER_FIELDS_EXCH.',myThid)
637     #endif
638     CALL TIMER_START('BLOCKING_EXCHANGES [FORWARD_STEP]',myThid)
639     CALL DO_STAGGER_FIELDS_EXCHANGES( myTime, myIter, myThid )
640     CALL TIMER_STOP ('BLOCKING_EXCHANGES [FORWARD_STEP]',myThid)
641    
642     #ifdef ALLOW_DEBUG
643     IF ( debugLevel .GE. debLevB )
644     & CALL DEBUG_CALL('THERMODYNAMICS',myThid)
645     #endif
646     CALL TIMER_START('THERMODYNAMICS [FORWARD_STEP]',mythid)
647     CALL THERMODYNAMICS( myTime, myIter, myThid )
648     CALL TIMER_STOP ('THERMODYNAMICS [FORWARD_STEP]',mythid)
649    
650     C-- if staggerTimeStep: end
651     ENDIF
652     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
653 heimbach 1.1
654     #ifdef ALLOW_AUTODIFF_TAMC
655     cph This is needed because convective_adjustment calls
656     cph find_rho which may use pressure()
657     CADJ STORE totphihyd = comlev1, key = ikey_dynamics
658     #endif
659 heimbach 1.8 C-- Cycle time-stepping Tracers arrays (T,S,+pTracers)
660     CALL TIMER_START('TS_CORRECTION_STEP [FORWARD_STEP]',myThid)
661     CALL TRACERS_CORRECTION_STEP(myTime, myIter, myThid)
662     CALL TIMER_STOP ('TS_CORRECTION_STEP [FORWARD_STEP]',myThid)
663 heimbach 1.1
664     C-- Do "blocking" sends and receives for tendency "overlap" terms
665     c CALL TIMER_START('BLOCKING_EXCHANGES [FORWARD_STEP]',myThid)
666     c CALL DO_GTERM_BLOCKING_EXCHANGES( myThid )
667     c CALL TIMER_STOP ('BLOCKING_EXCHANGES [FORWARD_STEP]',myThid)
668    
669     C-- Do "blocking" sends and receives for field "overlap" terms
670     CALL TIMER_START('BLOCKING_EXCHANGES [FORWARD_STEP]',myThid)
671     CALL DO_FIELDS_BLOCKING_EXCHANGES( myThid )
672     CALL TIMER_STOP ('BLOCKING_EXCHANGES [FORWARD_STEP]',myThid)
673    
674     #ifdef ALLOW_FLT
675     C-- Calculate float trajectories
676     IF (useFLT) THEN
677     CALL TIMER_START('FLOATS [FORWARD_STEP]',myThid)
678     CALL FLT_MAIN(myIter,myTime, myThid)
679     CALL TIMER_STOP ('FLOATS [FORWARD_STEP]',myThid)
680     ENDIF
681     #endif
682    
683 heimbach 1.8 C-- State-variables statistics (time-aver, diagnostics ...)
684     CALL TIMER_START('DO_STATEVARS_DIAGS [FORWARD_STEP]',myThid)
685     CALL DO_STATEVARS_DIAGS( myTime, myIter, myThid )
686     CALL TIMER_STOP ('DO_STATEVARS_DIAGS [FORWARD_STEP]',myThid)
687    
688     #ifndef ALLOW_OFFLINE
689 heimbach 1.1 #ifdef ALLOW_MONITOR
690     C-- Check status of solution (statistics, cfl, etc...)
691     CALL TIMER_START('MONITOR [FORWARD_STEP]',myThid)
692     CALL MONITOR( myIter, myTime, myThid )
693     CALL TIMER_STOP ('MONITOR [FORWARD_STEP]',myThid)
694     #endif /* ALLOW_MONITOR */
695 heimbach 1.8 #endif
696 heimbach 1.1
697     C-- Do IO if needed.
698 heimbach 1.8 #ifdef ALLOW_OFFLINE
699     CALL TIMER_START('OFFLINE_MODEL_IO [FORWARD_STEP]',myThid)
700     CALL OFFLINE_MODEL_IO( myTime, myIter, myThid )
701     CALL TIMER_STOP ('OFFLINE_MODEL_IO [FORWARD_STEP]',myThid)
702     #else
703 heimbach 1.1 CALL TIMER_START('DO_THE_MODEL_IO [FORWARD_STEP]',myThid)
704     CALL DO_THE_MODEL_IO( myTime, myIter, myThid )
705     CALL TIMER_STOP ('DO_THE_MODEL_IO [FORWARD_STEP]',myThid)
706 heimbach 1.8 #endif
707 heimbach 1.1
708     C-- Save state for restarts
709     CALL TIMER_START('WRITE_CHECKPOINT [FORWARD_STEP]',myThid)
710 heimbach 1.5 CALL PACKAGES_WRITE_PICKUP(
711 heimbach 1.8 I .FALSE., myTime, myIter, myThid )
712     #ifndef ALLOW_OFFLINE
713 heimbach 1.1 CALL WRITE_CHECKPOINT(
714 heimbach 1.8 I .FALSE., myTime, myIter, myThid )
715     #endif
716     CALL TIMER_STOP ('WRITE_CHECKPOINT [FORWARD_STEP]',myThid)
717 heimbach 1.1
718     #ifdef ALLOW_AUTODIFF_TAMC
719     #ifdef ALLOW_TAMC_CHECKPOINTING
720     endif
721     enddo
722     endif
723     enddo
724     endif
725     enddo
726     #else
727     enddo
728     #endif
729    
730     #else
731     enddo
732     #endif /* ALLOW_AUTODIFF_TAMC */
733    
734     _BARRIER
735     call timer_stop ('ECCO MAIN LOOP', mythid)
736    
737     call timer_start('ECCO SPIN-DOWN', mythid)
738    
739     #ifdef ALLOW_COST
740    
741     #ifdef ALLOW_DIVIDED_ADJOINT
742     CADJ STORE mytime = onetape
743     #endif
744     c-- Accumulate time averages of temperature, salinity, and SSH.
745     #ifndef DISABLE_DEBUGMODE
746     IF ( debugLevel .GE. debLevB )
747     & CALL DEBUG_CALL('cost_averagesfields',myThid)
748     #endif
749     call timer_start('cost_averagesfields [ECCO SPIN-DOWN]', mythid)
750     call cost_averagesfields( mytime, mythid )
751     call timer_stop ('cost_averagesfields [ECCO SPIN-DOWN]', mythid)
752     #ifdef ALLOW_DIVIDED_ADJOINT
753     c**************************************
754 heimbach 1.2 #include "cost_averages_bar_directives.h"
755 heimbach 1.1 c**************************************
756     #endif
757    
758     #ifdef ALLOW_COST_ATLANTIC
759     c-- Compute meridional heat transport
760     #ifndef DISABLE_DEBUGMODE
761     IF ( debugLevel .GE. debLevB )
762     & CALL DEBUG_CALL('cost_atlantic',myThid)
763     #endif
764     call timer_start('cost_atlantic [ECCO SPIN-DOWN]', mythid)
765     call cost_atlantic( mytime, myiter,mythid )
766     call timer_stop ('cost_atlantic [ECCO SPIN-DOWN]', mythid)
767     #endif
768    
769 heimbach 1.8 c-- Compute the cost function contribution of the boundary forcing,
770     c-- i.e. heat flux, salt flux, zonal and meridional wind stress.
771 heimbach 1.9 #ifndef DISABLE_DEBUGMODE
772     IF ( debugLevel .GE. debLevB )
773     & CALL DEBUG_CALL('cost_forcing',myThid)
774     #endif
775     call timer_start('cost_forcing [ECCO SPIN-DOWN]', mythid)
776 heimbach 1.8 call cost_forcing( myiter, mytime, mythid )
777 heimbach 1.9 call timer_stop ('cost_forcing [ECCO SPIN-DOWN]', mythid)
778 heimbach 1.8
779 heimbach 1.1 c-- Compute cost function contribution of Temperature and Salinity.
780     #ifndef DISABLE_DEBUGMODE
781     IF ( debugLevel .GE. debLevB )
782     & CALL DEBUG_CALL('cost_hyd',myThid)
783     #endif
784     call timer_start('cost_hyd [ECCO SPIN-DOWN]', mythid)
785     call cost_hyd( myiter, mytime, mythid )
786     call timer_stop ('cost_hyd [ECCO SPIN-DOWN]', mythid)
787    
788 heimbach 1.9 #ifdef ALLOW_OBCS_COST_CONTRIBUTION
789     #ifndef DISABLE_DEBUGMODE
790     IF ( debugLevel .GE. debLevB )
791     & CALL DEBUG_CALL('cost_obcs',myThid)
792     #endif
793     call timer_start('cost_obcs [ECCO SPIN-DOWN]', mythid)
794     call cost_obcs( myiter, mytime, mythid )
795     call timer_stop ('cost_obcs [ECCO SPIN-DOWN]', mythid)
796     #endif
797    
798 heimbach 1.1 #ifdef ALLOW_CURMTR_COST_CONTRIBUTION
799     #ifndef DISABLE_DEBUGMODE
800     IF ( debugLevel .GE. debLevB )
801     & CALL DEBUG_CALL('cost_curmtr',myThid)
802     #endif
803     call timer_start('cost_curmtr [ECCO SPIN-DOWN]', mythid)
804     call cost_curmtr( myiter, mytime, mythid )
805     call timer_stop ('cost_curmtr [ECCO SPIN-DOWN]', mythid)
806     #endif
807    
808     c-- Compute cost function contribution of SSH.
809     #ifdef ALLOW_SSH_COST_CONTRIBUTION
810     #ifndef DISABLE_DEBUGMODE
811     IF ( debugLevel .GE. debLevB )
812     & CALL DEBUG_CALL('cost_ssh',myThid)
813     #endif
814     call timer_start('cost_ssh [ECCO SPIN-DOWN]', mythid)
815     call cost_ssh( myiter, mytime, mythid )
816     call timer_stop ('cost_ssh [ECCO SPIN-DOWN]', mythid)
817     #endif
818    
819     c-- Compute cost function contribution of drifter's velocities.
820     #ifdef ALLOW_DRIFTER_COST_CONTRIBUTION
821     #ifndef DISABLE_DEBUGMODE
822     IF ( debugLevel .GE. debLevB )
823     & CALL DEBUG_CALL('cost_drifter',myThid)
824     #endif
825     call timer_start('cost_drifter [ECCO SPIN-DOWN]', mythid)
826     call cost_drifter( myiter, mytime, mythid )
827     call timer_stop ('cost_drifter [ECCO SPIN-DOWN]', mythid)
828     #endif
829    
830     c-- Compute cost function contribution of wind stress observations.
831     #ifdef ALLOW_SCAT_COST_CONTRIBUTION
832     #ifndef DISABLE_DEBUGMODE
833     IF ( debugLevel .GE. debLevB )
834     & CALL DEBUG_CALL('cost_scat',myThid)
835     #endif
836     call timer_start('cost_scat [ECCO SPIN-DOWN]', mythid)
837     call cost_scat( myiter, mytime, mythid )
838     call timer_stop ('cost_scat [ECCO SPIN-DOWN]', mythid)
839     #endif
840    
841     c-- Compute cost function contribution of wind stress observations.
842     #ifdef ALLOW_MEAN_HFLUX_COST_CONTRIBUTION
843     call timer_start('cost_mean_heatflux [ECCO SPIN-DOWN]', mythid)
844     call cost_mean_heatflux( myiter, mytime, mythid )
845     call timer_stop ('cost_mean_heatflux [ECCO SPIN-DOWN]', mythid)
846     #endif
847    
848     c-- Compute cost function contribution of wind stress observations.
849     #ifdef ALLOW_MEAN_SFLUX_COST_CONTRIBUTION
850     call timer_start('cost_mean_saltflux [ECCO SPIN-DOWN]', mythid)
851     call cost_mean_saltflux( myiter, mytime, mythid )
852     call timer_stop ('cost_mean_saltflux [ECCO SPIN-DOWN]', mythid)
853     #endif
854    
855     c-- Compute cost function contribution of drift between the first
856     c and the last year.
857     #ifdef ALLOW_DRIFT_COST_CONTRIBUTION
858     #ifndef DISABLE_DEBUGMODE
859     IF ( debugLevel .GE. debLevB )
860     & CALL DEBUG_CALL('cost_drift',myThid)
861     #endif
862     call timer_start('cost_drift [ECCO SPIN-DOWN]', mythid)
863     call cost_drift( myiter, mytime, mythid )
864     call timer_stop ('cost_drift [ECCO SPIN-DOWN]', mythid)
865     #endif
866     #ifdef ALLOW_DRIFTW_COST_CONTRIBUTION
867     #ifndef DISABLE_DEBUGMODE
868     IF ( debugLevel .GE. debLevB )
869     & CALL DEBUG_CALL('cost_driftw',myThid)
870     #endif
871     call timer_start('cost_driftw [ECCO SPIN-DOWN]', mythid)
872     call cost_driftw( myiter, mytime, mythid )
873     call timer_stop ('cost_driftw [ECCO SPIN-DOWN]', mythid)
874     #endif
875     _BARRIER
876    
877     c-- Compute initial vs. final T/S deviation
878     #ifdef ALLOW_COST_INI_FIN
879     call timer_start('cost_ini_fin [ECCO SPIN-DOWN]', mythid)
880     call cost_theta_ini_fin( myiter, mytime, mythid )
881     call cost_salt_ini_fin( myiter, mytime, mythid )
882     call timer_stop ('cost_ini_fin [ECCO SPIN-DOWN]', mythid)
883     #endif
884     _BARRIER
885    
886     c-- Sum all cost function contributions.
887     #ifndef DISABLE_DEBUGMODE
888     IF ( debugLevel .GE. debLevB )
889     & CALL DEBUG_CALL('cost_final',myThid)
890     #endif
891     call timer_start('COST_FINAL [ECCO SPIN-DOWN]', mythid)
892 heimbach 1.9 call ecco_cost_final( mythid )
893 heimbach 1.1 call timer_stop ('COST_FINAL [ECCO SPIN-DOWN]', mythid)
894    
895     #endif /* ALLOW_COST */
896    
897     call timer_stop ('ECCO SPIN-DOWN', mythid)
898    
899     #ifndef DISABLE_DEBUGMODE
900     IF ( debugLevel .GE. debLevB )
901     & CALL DEBUG_LEAVE('THE_MAIN_LOOP',myThid)
902     #endif
903    
904     return
905     end
906    
  ViewVC Help
Powered by ViewVC 1.1.22