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

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

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


Revision 1.67 - (show annotations) (download)
Fri Apr 18 22:57:54 2008 UTC (16 years, 5 months ago) by heimbach
Branch: MAIN
Changes since 1.66: +3 -1 lines
Modify few stores.

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

  ViewVC Help
Powered by ViewVC 1.1.22