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

Contents 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 - (show 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 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