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

Annotation 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 - (hide 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 snarayan 1.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