/[MITgcm]/MITgcm_contrib/snarayan/divided_adjoint/pkg/openad/the_model_main.F
ViewVC logotype

Contents of /MITgcm_contrib/snarayan/divided_adjoint/pkg/openad/the_model_main.F

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


Revision 1.1 - (show annotations) (download)
Sun Jul 26 20:25:36 2015 UTC (10 years ago) by snarayan
Branch: MAIN
CVS Tags: HEAD
Changes for restarting the adjoint model with OpenAD DIVA.

1 C $Header: /u/gcmpack/MITgcm/pkg/openad/the_model_main.F,v 1.17 2015/02/22 23:50:22 heimbach Exp $
2 C $Name: $
3
4 CBOI
5 C
6 C !TITLE: MITGCM KERNEL CODE SYNOPSIS
7 C !AUTHORS: mitgcm developers ( support@mitgcm.org )
8 C !AFFILIATION: Massachussetts Institute of Technology
9 C !DATE:
10 C !INTRODUCTION: Kernel dynamical routines
11 C This document summarises MITgcm code under the model/ subdirectory.
12 C The code under model/ ( src/ and inc/ ) contains most of
13 C the driver routines for the baseline forms of the kernel equations in the
14 C MITgcm algorithm. Numerical code for much of the baseline forms of
15 C these equations is also under the model/ directory. Other numerical code
16 C used for the kernel equations is contained in packages in the pkg/
17 C directory tree.
18 C Code for auxiliary equations and alternate discretizations of the kernel
19 C equations and algorithm can also be found in the pkg/ directory tree.
20 C
21 C \subsection{Getting Help and Reporting Errors and Problems}
22 C If you have questions please subscribe and e-mail support@mitgcm.org.
23 C We also welcome reports of errors and inconsistencies in the code or
24 C in the accompanying documentation. Please feel free to send these
25 C to support@mitgcm.org. For further information and to review
26 C problems reported to support@mitgcm.org please visit http://mitgcm.org.
27 C
28 C \subsection{MITgcm Kernel Code Calling Sequence}
29 C \bv
30 C
31 C Invocation from WRAPPER level...
32 C
33 C |
34 C |-THE_MODEL_MAIN :: Primary driver for the MITgcm algorithm
35 C | :: Called from WRAPPER level numerical
36 C | :: code invocation routine. On entry
37 C | :: to THE_MODEL_MAIN separate thread and
38 C | :: separate processes will have been established.
39 C | :: Each thread and process will have a unique ID
40 C | :: but as yet it will not be associated with a
41 C | :: specific region in decomposed discrete space.
42 C |
43 C |-INITIALISE_FIXED :: Set fixed model arrays such as topography,
44 C | | :: grid, solver matrices etc..
45 C | |
46 C | |-INI_PARMS :: Routine to set kernel model parameters.
47 C | | :: Kernel parameters are read from file "data"
48 C | | :: in directory in which code executes.
49 C | |
50 C | |-PACAKGES_BOOT :: Start up the optional package environment.
51 C | | :: Runtime selection of active packages.
52 C | |-PACKAGES_READPARMS :: read all packages input parameter file
53 C | | |- ${PKG}_READPARMS
54 C | |
55 C | |-INI_MODEL_IO :: Initialise Input/Ouput setting
56 C | |
57 C | |-INI_GRID :: Control grid array (vert. and hori.) initialisation.
58 C | | :: Grid arrays are held and described in GRID.h.
59 C | |
60 C | |-INI_DEPTHS :: Read (from "bathyFile") or set bathymetry/orography.
61 C | |-INI_MASKS_ETC :: Derive horizontal and vertical cell fractions and
62 C | | :: land masking for solid-fluid boundaries.
63 C | |
64 C | |-PACKAGES_INIT_FIXED :: do all packages fixed-initialisation setting
65 C | | |- ${PKG}_INIT_FIXED
66 C | |
67 C | |-CONFIG_SUMMARY :: Provide synopsis of kernel setup. Includes
68 C | | :: annotated table of kernel parameter settings.
69 C | |
70 C | |-PACKAGES_CHECK :: call each package configuration checking S/R
71 C | | |- ${PKG}_CHECK
72 C | |
73 C | |-CONFIG_CHECK :: Check config and parameter consistency.
74 C |
75 C |-CTRL_UNPACK :: Control vector support package. see pkg/ctrl
76 C |
77 C |-ADTHE_MAIN_LOOP :: Derivative evaluating form of main time stepping loop
78 C ! :: Automatically generated by TAMC/TAF.
79 C |
80 C |-THE_MAIN_LOOP :: Main timestepping loop routine.
81 C | |
82 C | |-INITIALISE_VARIA :: Set the initial conditions for time evolving
83 C | | |-INI_DYNVARS :: set common block variable to zero
84 C | | |-INI_NH_VARS :: set common block variable to zero
85 C | | |
86 C | | |-INI_FIELDS :: Control initialising model fields to non-zero
87 C | | | |-INI_VEL,_THETA,_SALT,_PSURF, ...
88 C | | | |-READ_PICKUP
89 C | | |
90 C | | |-INI_FORCING :: initialise forcing fields
91 C | | |
92 C | | |-PACKAGES_INIT_VARIABLES :: Does initialisation of time evolving
93 C | | | | ${PKG}_INIT_VARIA :: package data.
94 C | | |
95 C | | |-MONITOR :: Monitor state (see pkg/monitor)
96 C | | |-STATE_SUMMARY :: Summarise model prognostic variables.
97 C | | |-DO_THE_MODEL_IO :: Standard diagnostic I/O.
98 C | |
99 C====|>| ****************************
100 C====|>| BEGIN MAIN TIMESTEPPING LOOP
101 C====|>| ****************************
102 C | |-COST_AVERAGESFIELDS :: time-averaged Cost function terms (see pkg/cost)
103 C | |
104 C/\ | |-FORWARD_STEP :: Step forward a time-step ( AT LAST !!! )
105 C/\ | | |
106 C/\ | | |-LOAD_FIELDS_DRIVER :: control loading of input fields from files
107 C/\ | | |
108 C/\ | | |-CPL_EXPORT_MY_DATA :: Send coupling fields to coupler
109 C/\ | | |-CPL_IMPORT_EXTERNAL_DATA :: Receive coupling fields from coupler
110 C/\ | | |
111 C/\ | | |-DO_ATMOSPHERIC_PHYS :: Atmospheric physics computation
112 C/\ | | |
113 C/\ | | |-DO_OCEANIC_PHYS :: Oceanic (& seaice) physics computation
114 C/\ | | | |-OBCS_CALC :: Open boundary. package (see pkg/obcs).
115 C/\ | | |
116 C/\ | | |-GCHEM_CALC_TENDENCY :: geochemistry driver routine (see pkg/gchem)
117 C/\ | | |
118 C/\ | | |-THERMODYNAMICS :: (synchronous time-stepping)
119 C/\ | | | theta, salt + tracer equations driver.
120 C/\ | | | |-EXTERNAL_FORCING_SURF:: Accumulates appropriately dimensioned
121 C/\ | | | | :: forcing terms.
122 C/\ | | | |-GAD_ADVECTION :: Generalised advection driver (multi-dim
123 C/\ | | | | advection case) (see pkg/gad).
124 C/\ | | | |-CALC_GT :: Calculate the temperature tendency terms
125 C/\ | | | |-TIMESTEP_TRACER :: Step tracer field forward in time
126 C/\ | | | |-CALC_GS :: Calculate the salinity tendency terms
127 C/\ | | | |-TIMESTEP_TRACER :: Step tracer field forward in time
128 C/\ | | | |-PTRACERS_INTEGRATE :: Integrate other tracer(s) (see pkg/ptracers).
129 C/\ | | | |-IMPLDIFF :: Solve vertical implicit diffusion equation.
130 C/\ | | | |-OBCS_APPLY_TS :: Open boundary package (see pkg/obcs ).
131 C/\ | | |
132 C/\ | | |-DYNAMICS :: Momentum equations driver.
133 C/\ | | | |
134 C/\ | | | |-CALC_GRAD_PHI_SURF :: Calculate the gradient of the surface
135 C/\ | | | | Potential anomaly.
136 C/\ | | | |-CALC_VISCOSITY :: Calculate net vertical viscosity
137 C/\ | | | |-CALC_PHI_HYD :: Integrate the hydrostatic relation.
138 C/\ | | | |-MOM_FLUXFORM :: Flux form mom eqn. package (pkg/mom_fluxform)
139 C/\ | | | |-MOM_VECINV :: Vector invariant form mom eqn (pkg/mom_vecinv)
140 C/\ | | | |-TIMESTEP :: Step momentum fields forward in time
141 C/\ | | | |-OBCS_APPLY_UV :: Open boundary package (see pkg/obcs).
142 C/\ | | | |-IMPLDIFF :: Solve vertical implicit diffusion equation.
143 C/\ | | | |-CALC_GW :: vert. momentum tendency terms (Non-Hydrostatic)
144 C/\ | | |
145 C/\ | | |-UPDATE_SURF_DR :: Update the surface-level thickness fraction.
146 C/\ | | |-UPDATE_R_STAR :: Update the level thickness fraction.
147 C/\ | | |-UPDATE_CG2D :: Update 2d conjugate grad. for Free-Surf.
148 C/\ | | |
149 C/\ | | |-SOLVE_FOR_PRESSURE :: Find surface pressure.
150 C/\ | | | |-CG2D :: Two-dim pre-con. conjugate-gradient.
151 C/\ | | | |-CG3D :: Three-dim pre-con. conjugate-gradient solver.
152 C/\ | | |
153 C/\ | | |-MOMENTUM_CORRECTION_STEP :: Finalise momentum stepping
154 C/\ | | | |-CALC_GRAD_PHI_SURF :: Return DDx and DDy of surface pressure
155 C/\ | | | |-CORRECTION_STEP :: Pressure correction to momentum
156 C/\ | | | |-OBCS_APPLY_UV :: Open boundary package (see pkg/obcs).
157 C/\ | | |
158 C/\ | | |-INTEGR_CONTINUITY :: Integrate continuity equation
159 C/\ | | |
160 C/\ | | |-THERMODYNAMICS :: (staggered time-stepping)
161 C/\ | | | theta, salt + tracer equations driver.
162 C/\ | | |
163 C/\ | | |-TRACERS_CORRECTION_STEP :: Finalise tracer stepping
164 C/\ | | |
165 C/\ | | |-GCHEM_FORCING_SEP :: tracer forcing for gchem pkg (if tracer
166 C/\ | | | dependent tendencies calculated separately)
167 C/\ | | |
168 C/\ | | |-DO_FIELDS_BLOCKING_EXCHANGES :: Sync up overlap regions.
169 C/\ | | |
170 C/\ | | |-MONITOR :: Monitor package (pkg/monitor).
171 C/\ | | |-DO_THE_MODEL_IO :: Standard diagnostic I/O.
172 C/\ | | |
173 C/\ | | |-DO_WRITE_PICKUP :: Write restart files.
174 C | |
175 C<===|=| **************************
176 C<===|=| END MAIN TIMESTEPPING LOOP
177 C<===|=| **************************
178 C | |
179 C | |-COST_AVERAGESFIELDS :: time-averaged Cost function terms (see pkg/cost)
180 C | |-COST_FINAL :: Cost function package. (see pkg/cost)
181 C |
182 C |-CTRL_PACK :: Control vector support package. see pkg/ctrl
183 C |
184 C |-GRDCHK_MAIN :: Gradient check package. see pkg/grdchk
185 C |
186 C |-TIMER_PRINTALL :: Computational timing summary
187 C |
188 C |-COMM_STATS :: Summarise inter-proc and inter-thread communication
189 C :: events.
190 C \ev
191 C
192 CEOI
193
194 #include "PACKAGES_CONFIG.h"
195 #include "CPP_OPTIONS.h"
196 #include "AD_CONFIG.h"
197 #ifdef ALLOW_OPENAD
198 # include "OPENAD_OPTIONS.h"
199 #endif
200 #ifdef ALLOW_AUTODIFF
201 # include "AUTODIFF_OPTIONS.h"
202 #endif
203 #ifdef ALLOW_CTRL
204 # include "CTRL_OPTIONS.h"
205 #endif
206 #ifdef ALLOW_STREAMICE
207 # include "STREAMICE_OPTIONS.h"
208 #endif
209
210 CBOP
211 C !ROUTINE: THE_MODEL_MAIN
212
213 C !INTERFACE:
214 SUBROUTINE THE_MODEL_MAIN(myThid)
215
216 C !DESCRIPTION: \bv
217 C *==========================================================*
218 C | SUBROUTINE THE_MODEL_MAIN
219 C | o Master controlling routine for model using the MITgcm
220 C | UV parallel wrapper.
221 C *==========================================================*
222 C | THE_MODEL_MAIN is invoked by the MITgcm UV parallel
223 C | wrapper with a single integer argument "myThid". This
224 C | variable identifies the thread number of an instance of
225 C | THE_MODEL_MAIN. Each instance of THE_MODEL_MAIN works
226 C | on a particular region of the models domain and
227 C | synchronises with other instances as necessary. The
228 C | routine has to "understand" the MITgcm parallel
229 C | environment and the numerical algorithm. Editing this
230 C | routine is best done with some knowledge of both aspects.
231 C | Notes
232 C | =====
233 C | C*P* comments indicating place holders for which code is
234 C | presently being developed.
235 C *==========================================================*
236 C \ev
237
238 C !CALLING SEQUENCE:
239 C THE_MODEL_MAIN()
240 C |
241 C |
242 C |--INITIALISE_FIXED
243 C | o Set model configuration (fixed arrays)
244 C | Topography, hydrography, timestep, grid, etc..
245 C |
246 C |--CTRL_UNPACK o Derivative mode. Unpack control vector.
247 C |
248 C |--ADTHE_MAIN_LOOP o Main timestepping loop for combined
249 C | prognostic and reverse mode integration.
250 C |
251 C |--THE_MAIN_LOOP o Main timestepping loop for pure prognostic
252 C | integration.
253 C |
254 C |--CTRL_PACK o Derivative mode. Unpack control vector.
255 C |
256 C |--GRDCHK_MAIN o Gradient check control routine.
257 C |
258 C |--TIMER_PRINTALL o Print out timing statistics.
259 C |
260 C |--COMM_STATS o Print out communication statistics.
261
262 C !USES:
263 IMPLICIT NONE
264
265 C == Global variables ===
266 C -->> OpenAD
267 use OAD_active
268 use OAD_rev
269 use OAD_tape
270 #ifdef ALLOW_OPENAD_DIVA
271 use OAD_regular_cp
272 #else
273 use OAD_cp
274 #endif
275 #include "cost.h"
276 C <<-- OpenAD
277 #include "SIZE.h"
278 #include "EEPARAMS.h"
279 #include "PARAMS.h"
280 #include "DYNVARS.h"
281 #include "FFIELDS.h"
282
283 #ifdef ALLOW_AUTODIFF_TAMC
284 # include "tamc.h"
285 #endif
286 #ifdef ALLOW_CTRL
287 # include "ctrl.h"
288 # include "optim.h"
289 # include "CTRL_GENARR.h"
290 #endif
291
292 C !INPUT/OUTPUT PARAMETERS:
293 C == Routine arguments ==
294 C myThid :: Thread number for this instance of the routine.
295 INTEGER myThid
296
297 C !LOCAL VARIABLES:
298 C == Local variables ==
299 C Note: Under the multi-threaded model myIter and myTime are local
300 C variables passed around as routine arguments.
301 C Although this is fiddly it saves the need to impose
302 C additional synchronisation points when they are updated.
303 C myTime :: Time counter for this thread
304 C myIter :: Iteration counter for this thread
305 INTEGER myIter
306 _RL myTime
307 LOGICAL exst
308 LOGICAL lastdiva
309 C -->> OpenAD
310 LOGICAL fwddone
311 integer currcp, curradjointcp, maxfwditer, maxadjiter
312 _RL foo(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy)
313 _RL foo2D(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
314 CHARACTER*(10) suff
315 CHARACTER*(MAX_LEN_FNAM) fname
316 C Temprarily change precision to agree with ctrlprec
317 INTEGER tmpprec
318 INTEGER ik, il
319 #ifdef OAD_DEBUG
320 INTEGER i1, i2, i3, i4, i5
321 #endif
322 C <<-- OpenAD
323
324 C !EXTERNAL VARIABLES:
325 c == external ==
326 integer ilnblnk
327 external ilnblnk
328
329 CEOP
330
331 C-- set default:
332 exst = .TRUE.
333 lastdiva = .TRUE.
334 C -->> OpenAD
335 C- Set the execution mode
336 our_rev_mode%arg_store=.FALSE.
337 our_rev_mode%arg_restore=.FALSE.
338 our_rev_mode%res_store=.FALSE.
339 our_rev_mode%res_restore=.FALSE.
340 our_rev_mode%plain=.TRUE.
341 our_rev_mode%tape=.FALSE.
342 our_rev_mode%adjoint=.FALSE.
343 our_rev_mode%switchedToCheckpoint=.FALSE.
344 C- Initialize the tape
345 call oad_tape_init()
346 C- Initialize the checkpoint areas
347 call cp_init()
348 C <<-- OpenAD
349
350 #ifdef ALLOW_PETSC
351 call streamice_initialize_petsc
352 #endif
353
354 #ifdef ALLOW_DEBUG
355 IF (debugMode) CALL DEBUG_ENTER('THE_MODEL_MAIN',myThid)
356 #endif
357
358 #if defined(USE_PAPI) || defined(USE_PCL_FLOPS_SFP) || defined(USE_PCL_FLOPS) || defined(USE_PCL)
359 CALL TIMER_CONTROL('','INIT','THE_MODEL_MAIN',myThid)
360 #endif
361 C-- This timer encompasses the whole code
362 CALL TIMER_START('ALL [THE_MODEL_MAIN]',myThid)
363
364 #ifdef ALLOW_DEBUG
365 IF (debugMode) CALL DEBUG_CALL('INITIALISE_FIXED',myThid)
366 #endif
367 C-- Set model configuration (fixed arrays)
368 CALL TIMER_START('INITIALISE_FIXED [THE_MODEL_MAIN]',myThid)
369 C -->> OpenAD
370 c CALL INITIALISE_FIXED( myThid )
371 CALL OpenAD_INITIALISE_FIXED( myThid )
372 C <<-- OpenAD
373 CALL TIMER_STOP ('INITIALISE_FIXED [THE_MODEL_MAIN]',myThid)
374
375 myTime = startTime
376 myIter = nIter0
377
378 #if ( defined (ALLOW_ADMTLM) )
379
380 STOP 'should never get here; ADMTLM_DSVD calls ADMTLM_DRIVER'
381
382 #elif ( defined (ALLOW_AUTODIFF))
383
384 # ifdef ALLOW_CTRL
385 # ifndef EXCLUDE_CTRL_PACK
386 IF (useCTRL) THEN
387 inquire( file='costfinal', exist=exst )
388 IF ( .NOT. exst ) THEN
389 IF ( (optimcycle.NE.0 .OR. .NOT.doinitxx)
390 & .AND. doMainUnpack ) THEN
391 CALL TIMER_START('CTRL_UNPACK [THE_MODEL_MAIN]',myThid)
392 CALL CTRL_UNPACK( .TRUE. , myThid )
393 CALL TIMER_STOP ('CTRL_UNPACK [THE_MODEL_MAIN]',myThid)
394 ENDIF
395 ENDIF
396 ENDIF
397 # endif /* EXCLUDE_CTRL_PACK */
398 # endif /* ALLOW_CTRL */
399
400 # ifdef ALLOW_COST
401 CALL COST_DEPENDENT_INIT ( myThid )
402 # endif
403
404 # if ( defined (ALLOW_TANGENTLINEAR_RUN) )
405
406 # ifdef ALLOW_DEBUG
407 IF (debugMode) CALL DEBUG_CALL('G_THE_MAIN_LOOP',myThid)
408 # endif
409 CALL TIMER_START('G_THE_MAIN_LOOP [TANGENT RUN]',myThid)
410 CALL G_THE_MAIN_LOOP ( myTime, myIter, myThid )
411 CALL TIMER_STOP ('G_THE_MAIN_LOOP [TANGENT RUN]',myThid)
412
413 # elif ( defined (ALLOW_ADJOINT_RUN) || \
414 defined (ALLOW_ECCO_OPTIMIZATION) )
415
416 # ifdef ALLOW_DIVIDED_ADJOINT
417 C-- The following assumes the TAF option '-pure'
418 inquire( file='costfinal', exist=exst )
419 IF ( .NOT. exst) THEN
420 # ifdef ALLOW_DEBUG
421 IF (debugMode) CALL DEBUG_CALL('MDTHE_MAIN_LOOP',myThid)
422 # endif
423 CALL TIMER_START('MDTHE_MAIN_LOOP [MD RUN]', myThid)
424 CALL MDTHE_MAIN_LOOP ( myTime, myIter, myThid )
425 CALL TIMER_STOP ('MDTHE_MAIN_LOOP [MD RUN]', myThid)
426 CALL COST_FINAL_STORE ( myThid, lastdiva )
427 ELSE
428 # ifdef ALLOW_DEBUG
429 IF (debugMode) CALL DEBUG_CALL('ADTHE_MAIN_LOOP',myThid)
430 # endif
431 CALL TIMER_START('ADTHE_MAIN_LOOP [ADJOINT RUN]', myThid)
432 CALL ADTHE_MAIN_LOOP ( myThid )
433 CALL TIMER_STOP ('ADTHE_MAIN_LOOP [ADJOINT RUN]', myThid)
434 CALL COST_FINAL_RESTORE ( myThid, lastdiva )
435 ENDIF
436
437 # else /* ALLOW_DIVIDED_ADJOINT undef */
438 # ifndef ALLOW_OPENAD
439 # ifdef ALLOW_DEBUG
440 IF (debugMode) CALL DEBUG_CALL('ADTHE_MAIN_LOOP',myThid)
441 # endif
442 CALL TIMER_START('ADTHE_MAIN_LOOP [ADJOINT RUN]', myThid)
443 CALL ADTHE_MAIN_LOOP ( myThid )
444 CALL TIMER_STOP ('ADTHE_MAIN_LOOP [ADJOINT RUN]', myThid)
445 # else /* ALLOW_OPENAD defined */
446 C -->> OpenAD
447 # ifdef ALLOW_DEBUG
448 IF (debugMode) CALL DEBUG_CALL('THE_MAIN_LOOP',myThid)
449 # endif
450 CALL TIMER_START('THE_MAIN_LOOP (F) [THE_MODEL_MAIN]',myThid)
451 #ifdef ALLOW_OPENAD_DIVA
452 exst =.false.
453 inquire(file='costfinal',exist=exst)
454 if (exst.eqv..true.) then
455 open(unit=76,file='costfinal',form='formatted')
456 read(unit=76,fmt=*) fc%v
457 read(unit=76,fmt=*) fc%d
458 close(unit=76)
459 print *, 'DIVA found costfinal', fc%v, fc%d
460 end if
461 call cp_read_state(currcp, curradjointcp, maxfwditer, maxadjiter,
462 +myIter)
463 fwddone = .true.
464 if (curradjointcp .eq. -1 .and. currcp.ne. nTimeSteps_l2) then
465 fwddone = .false.
466 end if
467 print *, 'DIVA myIter is', myIter , nIter0
468 IF (debugMode) CALL DEBUG_CALL('THE_MAIN_LOOP',myThid)
469 CALL TIMER_START('THE_MAIN_LOOP (F) [THE_MODEL_MAIN]',myThid)
470 C#ifdef ALLOW_OPENAD
471 C-- Set initial conditions (variable arrays)
472 C CALL TIMER_START('INITIALISE_VARIA [THE_MAIN_LOOP]', myThid)
473 C CALL INITIALISE_VARIA( myThid )
474 C CALL TIMER_STOP ('INITIALISE_VARIA [THE_MAIN_LOOP]', myThid)
475 C#endif
476 #endif
477 our_rev_mode%plain=.FALSE.
478 our_rev_mode%tape=.TRUE.
479 call timeratio()
480 #ifdef ALLOW_OPENAD_DIVA
481 if((curradjointcp.eq.-1).and.(currcp.ne.nTimeSteps_l2)) then
482 do while(currcp.ne.nTimeSteps_l2)
483 #endif
484 CALL OpenAD_THE_MAIN_LOOP( myTime, myIter, myThid )
485 #ifdef ALLOW_OPENAD_DIVA
486 call cp_read_state(currcp, curradjointcp, maxfwditer, maxadjit
487 +er, myIter)
488 end do
489 end if
490 #endif
491 CALL TIMER_STOP ('THE_MAIN_LOOP (F) [THE_MODEL_MAIN]',myThid)
492 CALL TIMER_START('THE_MAIN_LOOP (A) [THE_MODEL_MAIN]',myThid)
493 #ifdef ALLOW_OPENAD_DIVA
494 if (fwddone .eqv. .false.) then
495 open(unit=76,file='costfinal')
496 write(76,*) fc%v
497 write(76,*) fc%d
498 close(76)
499 end if
500 call cp_read_state(currcp, curradjointcp, maxfwditer, maxadjiter,
501 +myIter)
502 if (fwddone .eqv. .false.) then
503 if(curradjointcp .eq. -1 .and. currcp.eq. nTimeSteps_l2) then
504 stop 'DIVA FINISHED FORWARD'
505 else
506 stop 'DIVA SUSPEND FORWARD'
507 end if
508 end if
509 #endif
510 our_rev_mode%arg_store=.FALSE.
511 our_rev_mode%arg_restore=.FALSE.
512 our_rev_mode%plain=.FALSE.
513 our_rev_mode%tape=.FALSE.
514 our_rev_mode%adjoint=.TRUE.
515 IF (myProcID .EQ. 0) THEN
516 #ifdef ALLOW_OPENAD_DIVA
517 exst =.false.
518 inquire(file='costfinalad',exist=exst)
519 if (exst.eqv..true.) then
520 open(unit=76,file='costfinalad')
521 read(76,*) fc%v
522 read(76,*) fc%d
523 close(76)
524 else
525 #endif
526 fc%d=1.0
527 #ifdef ALLOW_OPENAD_DIVA
528 end if
529 #endif
530 ENDIF
531 call timeratio()
532 #ifdef ALLOW_OPENAD_DIVA
533 print *, 'DIVA reverse found costfinal', fc%v, fc%d
534 print *, 'DIVA Before adjoint, myiter is ', myiter
535 #endif
536 CALL OpenAD_THE_MAIN_LOOP( myTime, myIter, myThid )
537 call timeratio()
538 #ifdef ALLOW_OPENAD_DIVA
539 call cp_read_state(currcp, curradjointcp, maxfwditer, maxadjiter,
540 +myIter)
541 if(curradjointcp.eq.0) then
542 open(unit=76,file='costfinal',form='formatted')
543 read(unit=76,fmt=*) fc%v
544 close(unit=76)
545 end if
546 open(unit=76,file='costfinalad')
547 write(76,*) fc%v
548 write(76,*) fc%d
549 close(76)
550 call cp_read_state(currcp, curradjointcp, maxfwditer, maxadjiter,
551 +myIter)
552 if(curradjointcp.ne.0) then
553 stop 'DIVA SUSPEND ADJOINT'
554 end if
555 #endif
556 our_rev_mode%arg_store=.FALSE.
557 our_rev_mode%arg_restore=.FALSE.
558 our_rev_mode%plain=.TRUE.
559 our_rev_mode%tape=.FALSE.
560 our_rev_mode%adjoint=.FALSE.
561 # ifdef OAD_DEBUG
562 # if (defined (ALLOW_THETA0_CONTROL) && defined (ALLOW_SALT0_CONTROL))
563 do i1=1-olx,snx+olx
564 do i2=1-oly,sny+oly
565 do i3=1,nr
566 do i4=1,nsx
567 do i5=1,nsy
568 write (standardmessageunit,
569 +'(A,5(I3,A),E25.17E3,A,E25.17E3)')
570 +'OAD: (',
571 +i1,',',i2,',',i3,',',i4,',',i5,') salt/theta ',
572 +xx_salt(i1,i2,i3,i4,i5)%d,'/',xx_theta(i1,i2,i3,i4,i5)%d
573 end do
574 end do
575 end do
576 end do
577 end do
578 # endif
579 # endif /* OAD_DEBUG */
580 C Temporarily change setting of writeBinaryPrec
581 tmpprec = writeBinaryPrec
582 writeBinaryPrec = ctrlprec
583 WRITE(suff,'(I10.10)') optimcycle
584 # ifndef ALLOW_OPENAD_ACTIVE_READ_XYZ
585 # ifdef ALLOW_THETA0_CONTROL
586 foo=xx_theta%d
587 il=ilnblnk( xx_theta_file )
588 write(fname(1:MAX_LEN_FNAM),'(3a)')
589 & 'ad',xx_theta_file(1:il),'.'
590 call write_fld_xyz_rl(fname,suff,foo,myIter,1)
591 # endif
592 # ifdef ALLOW_SALT0_CONTROL
593 foo=xx_salt%d
594 il=ilnblnk( xx_salt_file )
595 write(fname(1:MAX_LEN_FNAM),'(3a)')
596 & 'ad',xx_salt_file(1:il),'.'
597 call write_fld_xyz_rl(fname,suff,foo,myIter,1)
598 # endif
599 # ifdef ALLOW_DIFFKR_CONTROL
600 foo=diffkr%d
601 il=ilnblnk( xx_diffkr_file )
602 write(fname(1:MAX_LEN_FNAM),'(3a)')
603 & 'ad',xx_diffkr_file(1:il),'.'
604 call write_fld_xyz_rl(fname,suff,foo,myIter,1)
605 # endif
606 # endif /* ALLOW_OPENAD_ACTIVE_READ_XYZ */
607
608 # ifdef ALLOW_TAUU0_CONTROL
609 foo2D=fu%d
610 il=ilnblnk( xx_tauu_file )
611 write(fname(1:MAX_LEN_FNAM),'(3a)')
612 & 'ad',xx_tauu_file(1:il),'.'
613 call write_fld_xy_rl(fname,suff,foo2D,myIter,1)
614 # endif
615 # ifdef ALLOW_TAUV0_CONTROL
616 foo2D=fv%d
617 il=ilnblnk( xx_tauv_file )
618 write(fname(1:MAX_LEN_FNAM),'(3a)')
619 & 'ad',xx_tauv_file(1:il),'.'
620 call write_fld_xy_rl(fname,suff,foo2D,myIter,1)
621 # endif
622 # ifdef ALLOW_HFLUX0_CONTROL
623 foo2D=qnet%d
624 il=ilnblnk( xx_hflux_file )
625 write(fname(1:MAX_LEN_FNAM),'(3a)')
626 & 'ad',xx_hflux_file(1:il),'.'
627 call write_fld_xy_rl(fname,suff,foo2D,myIter,1)
628 # endif
629 # ifdef ALLOW_SFLUX0_CONTROL
630 foo2D=empmr%d
631 il=ilnblnk( xx_sflux_file )
632 write(fname(1:MAX_LEN_FNAM),'(3a)')
633 & 'ad',xx_sflux_file(1:il),'.'
634 call write_fld_xy_rl(fname,suff,foo2D,myIter,1)
635 # endif
636 # ifdef ALLOW_HFLUXM_CONTROL
637 foo2D=xx_hfluxm%d
638 il=ilnblnk( xx_hfluxm_file )
639 write(fname(1:MAX_LEN_FNAM),'(3a)')
640 & 'ad',xx_hfluxm_file(1:il),'.'
641 call write_fld_xy_rl(fname,suff,foo2D,myIter,1)
642 # endif
643 # ifdef ALLOW_ETAN0_CONTROL
644 foo2D=etan%d
645 il=ilnblnk( xx_etan_file )
646 write(fname(1:MAX_LEN_FNAM),'(3a)')
647 & 'ad',xx_etan_file(1:il),'.'
648 call write_fld_xy_rl(fname,suff,foo2D,myIter,1)
649 # endif
650 cc# ifdef ALLOW_GENARR2D_CONTROL
651 cc do ik = 1, maxCtrlArr2D
652 cc foo2d=xx_genarr2d(:,:,:,:,ik)%d
653 cc write(fname,'(A,I2.2,A)') 'adxx_genarr2d_',ik,'.'
654 cc call write_fld_xy_rl(fname,suff,foo2D,myIter,1)
655 cc enddo
656 cc# endif
657 cc# ifdef ALLOW_GENTIM2D_CONTROL
658 cc do ik = 1, maxCtrlTim2D
659 cc foo2d=xx_gentim2d(:,:,:,:,ik)%d
660 cc write(fname,'(A,I2.2,A)') 'adxx_gentim2d_',ik,'.'
661 cc call write_fld_xy_rl(fname,suff,foo2D,myIter,1)
662 cc enddo
663 cc# endif
664 cc# ifdef ALLOW_GENARR3D_CONTROL
665 cc do ik = 1, maxCtrlArr3D
666 cc foo=xx_genarr3d(:,:,:,:,:,ik)%d
667 cc write(fname,'(A,I2.2,A)') 'adxx_genarr3d_',ik,'.'
668 cc call write_fld_xyz_rl(fname,suff,foo,myIter,1)
669 cc enddo
670 cc# endif
671 C Change back to original writeBinaryPrec
672 writeBinaryPrec = tmpprec
673 our_rev_mode%plain=.TRUE.
674 our_rev_mode%tape=.FALSE.
675 our_rev_mode%adjoint=.FALSE.
676 CALL TIMER_STOP ('THE_MAIN_LOOP (A) [THE_MODEL_MAIN]',myThid)
677
678 C <<-- OpenAD
679 # endif /* ALLOW_OPENAD */
680 # endif /* ALLOW_DIVIDED_ADJOINT */
681
682 # else /* forward run only within AD setting */
683
684 # ifdef ALLOW_DEBUG
685 IF (debugMode) CALL DEBUG_CALL('THE_MAIN_LOOP',myThid)
686 # endif
687 C-- Call time stepping loop of full model
688 CALL TIMER_START('THE_MAIN_LOOP [THE_MODEL_MAIN]',myThid)
689 CALL THE_MAIN_LOOP( myTime, myIter, myThid )
690 CALL TIMER_STOP ('THE_MAIN_LOOP [THE_MODEL_MAIN]',myThid)
691
692 # endif /* forward run only within AD setting */
693
694 # ifdef ALLOW_CTRL
695 # ifndef EXCLUDE_CTRL_PACK
696 # ifdef ALLOW_OPENAD
697 cph-- ad hoc fix for OpenAD time stepping counter lagging one step
698 cph-- after final adjoint step
699 myIter=nIter0
700 # endif
701 IF (useCTRL) THEN
702 IF ( lastdiva .AND. doMainPack ) THEN
703 CALL TIMER_START('CTRL_PACK [THE_MODEL_MAIN]',myThid)
704 CALL CTRL_PACK( .FALSE. , myThid )
705 CALL TIMER_STOP ('CTRL_PACK [THE_MODEL_MAIN]',myThid)
706 IF ( ( optimcycle.EQ.0 .OR. (.NOT. doMainUnpack) )
707 & .AND. myIter.EQ.nIter0 ) THEN
708 CALL TIMER_START('CTRL_PACK [THE_MODEL_MAIN]',myThid)
709 CALL CTRL_PACK( .TRUE. , myThid )
710 CALL TIMER_STOP ('CTRL_PACK [THE_MODEL_MAIN]',myThid)
711 ENDIF
712 ENDIF
713 ENDIF
714 # endif /* EXCLUDE_CTRL_PACK */
715 # endif /* ALLOW_CTRL */
716
717 # ifdef ALLOW_GRDCHK
718 IF ( useGrdchk .AND. lastdiva ) THEN
719 CALL TIMER_START('GRDCHK_MAIN [THE_MODEL_MAIN]',myThid)
720 CALL GRDCHK_MAIN( myThid )
721 CALL TIMER_STOP ('GRDCHK_MAIN [THE_MODEL_MAIN]',myThid)
722 ENDIF
723 # endif
724
725 #else /* ALL AD-related undef */
726
727 # ifdef ALLOW_DEBUG
728 IF (debugMode) CALL DEBUG_CALL('THE_MAIN_LOOP',myThid)
729 # endif
730 C-- Call time stepping loop of full model
731 CALL TIMER_START('THE_MAIN_LOOP [THE_MODEL_MAIN]',myThid)
732 CALL THE_MAIN_LOOP( myTime, myIter, myThid )
733 CALL TIMER_STOP ('THE_MAIN_LOOP [THE_MODEL_MAIN]',myThid)
734
735 #endif /* ALLOW_TANGENTLINEAR_RUN ALLOW_ADJOINT_RUN ALLOW_ADMTLM */
736
737 #ifdef ALLOW_PETSC
738 call streamice_finalize_petsc
739 #endif
740
741 #ifdef ALLOW_MNC
742 IF (useMNC) THEN
743 C Close all open NetCDF files
744 _BEGIN_MASTER( myThid )
745 CALL MNC_FILE_CLOSE_ALL( myThid )
746 _END_MASTER( myThid )
747 ENDIF
748 #endif
749
750 C-- This timer encompasses the whole code
751 CALL TIMER_STOP ('ALL [THE_MODEL_MAIN]',myThid)
752
753 C-- Write timer statistics
754 IF ( myThid .EQ. 1 ) THEN
755 CALL TIMER_PRINTALL( myThid )
756 CALL COMM_STATS
757 ENDIF
758
759 C-- Check threads synchronization :
760 CALL BAR_CHECK( 9, myThid )
761
762 #ifdef ALLOW_DEBUG
763 IF (debugMode) CALL DEBUG_LEAVE('THE_MODEL_MAIN',myThid)
764 #endif
765
766 RETURN
767 END

  ViewVC Help
Powered by ViewVC 1.1.22