/[MITgcm]/MITgcm_contrib/heimbach/OpenAD/code_shallow_openad3/the_main_loop.F
ViewVC logotype

Annotation of /MITgcm_contrib/heimbach/OpenAD/code_shallow_openad3/the_main_loop.F

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


Revision 1.2 - (hide annotations) (download)
Fri Feb 2 04:10:30 2007 UTC (19 years, 9 months ago) by utke
Branch: MAIN
Changes since 1.1: +19 -14 lines
control checkpointing levels by file and fix current step computation for remainder parts

1 utke 1.2 C $Header: /u/gcmpack/MITgcm_contrib/heimbach/OpenAD/code_shallow_openad3/the_main_loop.F,v 1.1 2006/08/01 15:44:29 utke Exp $
2 utke 1.1 C $Name: $
3    
4     #include "PACKAGES_CONFIG.h"
5     #include "CPP_OPTIONS.h"
6     #ifdef ALLOW_OBCS
7     # include "OBCS_OPTIONS.h"
8     #endif
9     #ifdef ALLOW_SEAICE
10     # include "SEAICE_OPTIONS.h"
11     #endif
12     #ifdef ALLOW_GMREDI
13     # include "GMREDI_OPTIONS.h"
14     #endif
15    
16     CBOP
17     C !ROUTINE: THE_MAIN_LOOP
18     C !INTERFACE:
19     SUBROUTINE THE_MAIN_LOOP( myTime, myIter, myThid )
20    
21     C !DESCRIPTION: \bv
22     C *================================================================*
23     C | SUBROUTINE the_main_loop
24     C | o Run the ocean model and evaluate the specified cost function.
25     C *================================================================*
26     C |
27     C | THE_MAIN_LOOP is the toplevel routine for the Tangent Linear and
28     C | Adjoint Model Compiler (TAMC). For this purpose the initialization
29     C | of the model was split into two parts. Those parameters that do
30     C | not depend on a specific model run are set in INITIALISE_FIXED,
31     C | whereas those that do depend on the specific realization are
32     C | initialized in INITIALISE_VARIA.
33     C | This routine is to be used in conjuction with the MITgcmuv
34     C | checkpoint 37.
35     C *================================================================*
36     C \ev
37    
38     C !USES:
39     IMPLICIT NONE
40     C == Global variables ==
41     #include "SIZE.h"
42     #include "EEPARAMS.h"
43     #include "PARAMS.h"
44    
45     c**************************************
46     #ifdef ALLOW_AUTODIFF_TAMC
47    
48     c These includes are needed for
49     c AD-checkpointing.
50     c They provide the fields to be stored.
51    
52     # include "GRID.h"
53     # include "DYNVARS.h"
54     # include "FFIELDS.h"
55     # include "EOS.h"
56     # include "GAD.h"
57     # ifdef ALLOW_CD_CODE
58     # include "CD_CODE_VARS.h"
59     # endif
60     # ifdef ALLOW_PTRACERS
61     # include "PTRACERS_SIZE.h"
62     # include "PTRACERS.h"
63     # endif
64     # ifdef EXACT_CONSERV
65     # include "SURFACE.h"
66     # endif
67     # ifdef ALLOW_OBCS
68     # include "OBCS.h"
69     # endif
70     # ifdef ALLOW_EXF
71     # include "exf_fields.h"
72     # include "exf_clim_fields.h"
73     # ifdef ALLOW_BULKFORMULAE
74     # include "exf_constants.h"
75     # endif
76     # endif /* ALLOW_EXF */
77     # ifdef ALLOW_SEAICE
78     # include "SEAICE.h"
79     # endif
80     # ifdef ALLOW_EBM
81     # include "EBM.h"
82     # endif
83     # ifdef ALLOW_DIVIDED_ADJOINT_MPI
84     # include "mpif.h"
85     # endif
86    
87     # include "tamc.h"
88     # include "ctrl.h"
89     # include "ctrl_dummy.h"
90     # include "cost.h"
91    
92     #endif /* ALLOW_AUTODIFF_TAMC */
93     c**************************************
94    
95     C !INPUT/OUTPUT PARAMETERS:
96     C == Routine arguments ==
97     C note: under the multi-threaded model myiter and
98     C mytime are local variables passed around as routine
99     C arguments. Although this is fiddly it saves the need to
100     C impose additional synchronisation points when they are
101     C updated.
102     C myIter - iteration counter for this thread
103     C myTime - time counter for this thread
104     C myThid - thread number for this instance of the routine.
105     INTEGER myThid
106     INTEGER myIter
107     _RL myTime
108    
109     C !FUNCTIONS:
110     C == Functions ==
111     #ifdef ALLOW_RUNCLOCK
112     LOGICAL RUNCLOCK_CONTINUE
113     LOGICAL RC_CONT
114     #endif
115    
116     C !LOCAL VARIABLES:
117     C == Local variables ==
118     logical haveRemainder, allStepsCovered
119     integer uCheckLev1, uCheckLev2, uCheckLev3,uCheckLev4
120 utke 1.2 integer nCheckLev1, nCheckLev2, nCheckLev3,nCheckLev4
121 utke 1.1
122     integer ilev_4
123     integer theCurrentStep
124    
125     CEOP
126    
127     uCheckLev1=0
128     uCheckLev2=0
129     uCheckLev3=0
130     uCheckLev4=0
131     theCurrentStep=0
132    
133     #ifdef ALLOW_DEBUG
134     IF (debugMode) CALL DEBUG_ENTER('THE_MAIN_LOOP',myThid)
135     #endif
136    
137     nIter0 = NINT( (startTime-baseTime)/deltaTClock )
138     ikey_dynamics = 1
139    
140     CALL TIMER_START('ADJOINT SPIN-UP', mythid)
141    
142     #ifdef ALLOW_DEBUG
143     IF (debugMode) CALL DEBUG_CALL('INITIALISE_VARIA',myThid)
144     #endif
145    
146     C-- Set initial conditions (variable arrays)
147     CALL TIMER_START('INITIALISE_VARIA [THE_MAIN_LOOP]', mythid)
148     CALL INITIALISE_VARIA( mythid )
149     CALL TIMER_STOP ('INITIALISE_VARIA [THE_MAIN_LOOP]', mythid)
150    
151     #ifdef ALLOW_MONITOR
152     #ifdef ALLOW_DEBUG
153     IF (debugMode) CALL DEBUG_CALL('MONITOR',myThid)
154     #endif
155     C-- Check status of solution (statistics, cfl, etc...)
156     CALL TIMER_START('MONITOR [THE_MAIN_LOOP]', mythid)
157     CALL MONITOR( myIter, myTime, myThid )
158     CALL TIMER_STOP ('MONITOR [THE_MAIN_LOOP]', mythid)
159     #endif /* ALLOW_MONITOR */
160    
161     C-- Do IO if needed (Dump for start state).
162     #ifdef ALLOW_DEBUG
163     IF (debugMode) CALL DEBUG_CALL('DO_THE_MODEL_IO',myThid)
164     #endif
165    
166     #ifdef ALLOW_OFFLINE
167     CALL TIMER_START('OFFLINE_MODEL_IO [FORWARD_STEP]',myThid)
168     CALL OFFLINE_MODEL_IO( myTime, myIter, myThid )
169     CALL TIMER_STOP ('OFFLINE_MODEL_IO [FORWARD_STEP]',myThid)
170     #else
171     CALL TIMER_START('DO_THE_MODEL_IO [THE_MAIN_LOOP]', mythid)
172     CALL DO_THE_MODEL_IO( myTime, myIter, mythid )
173     CALL TIMER_STOP ('DO_THE_MODEL_IO [THE_MAIN_LOOP]', mythid)
174     #endif
175    
176    
177     #ifdef ALLOW_AUTODIFF_TAMC
178     CALL TIMER_STOP ('ADJOINT SPIN-UP', mythid)
179     _BARRIER
180     #endif
181    
182     c-- Do the model integration.
183     CALL TIMER_START('MAIN LOOP [THE_MAIN_LOOP]', mythid)
184    
185     c >>>>>>>>>>>>>>>>>>>>>>>>>>> LOOP <<<<<<<<<<<<<<<<<<<<<<<<<<<<
186     c >>>>>>>>>>>>>>>>>>>>>>>>>>> STARTS <<<<<<<<<<<<<<<<<<<<<<<<<<<<
187    
188    
189     c**************************************
190     c$openad INDEPENDENT(xx_theta)
191     c$openad INDEPENDENT(xx_salt)
192    
193     #ifndef ALLOW_TAMC_CHECKPOINTING
194     #error "not set up for undefined ALLOW_TAMC_CHECKPOINTING "
195     #endif
196    
197     #ifndef ALLOW_AUTODIFF_TAMC
198     #error "not set up for undefined ALLOW_AUTODIFF_TAMC "
199     #endif
200 utke 1.2 open(2,action='read',file='ncheckLev.conf')
201     read(2,'(I5,/,I5,/I5,/I5)') nCheckLev1, nCheckLev2, nCheckLev3,
202     +nCheckLev4
203     close(2)
204    
205 utke 1.1 write(*,'(A,I4,A,I4,A,I4,A,I8)')
206 utke 1.2 +'JU: main_loop checkpoints allowed 1st:' ,nCheckLev1,
207     +', 2nd:', nCheckLev2,
208     +', 3rd:', nCheckLev3,
209     +', 4th:', nCheckLev4
210 utke 1.1
211     cju in this current scheme
212     cju there is no point in specifying 1 as the number of checkpoints
213     cju because for now don't avoid the incidental store of
214     cju the same checkpoint across multiple levels.
215 utke 1.2 if (nCheckLev4 .eq. 1 ) then
216 utke 1.1 uCheckLev4=0
217     write(*,'(A)') 'JU: NOTE: resetting level 4 to 0'
218     else
219 utke 1.2 uCheckLev4=nCheckLev4
220 utke 1.1 end if
221 utke 1.2 if (nCheckLev3 .eq. 1 ) then
222 utke 1.1 uCheckLev3=0
223     write(*,'(A)') 'JU: NOTE: resetting level 3 to 0'
224     else
225 utke 1.2 uCheckLev3=nCheckLev3
226 utke 1.1 end if
227 utke 1.2 if (nCheckLev2 .eq. 1 ) then
228 utke 1.1 uCheckLev2=0
229     write(*,'(A)') 'JU: NOTE: resetting level 2 to 0'
230     else
231 utke 1.2 uCheckLev2=nCheckLev2
232 utke 1.1 end if
233 utke 1.2 if (nCheckLev1 .eq. 1 ) then
234 utke 1.1 uCheckLev1=0
235     write(*,'(A)') 'JU: NOTE: resetting level 1 to 0'
236     else
237 utke 1.2 uCheckLev1=nCheckLev1
238 utke 1.1 end if
239     cju check sanity
240     if (uCheckLev4 .gt. 0 ) then
241     if ( uCheckLev3*uCheckLev2*uCheckLev1 .eq. 0) then
242     print *, 'JU: ERROR: uCheckLev4 > 0 implies ',
243     +'all lower levels must be nonzero too.'
244     end if
245     end if
246     if (uCheckLev3 .gt. 0 ) then
247     if ( uCheckLev2*uCheckLev1 .eq. 0) then
248     print *, 'JU: ERROR: uCheckLev3 > 0 implies ',
249     +'all lower levels must be nonzero too.'
250     end if
251     end if
252     if (uCheckLev2 .gt. 0 ) then
253     if ( uCheckLev1 .eq. 0) then
254     print *, 'JU: ERROR: uCheckLev2 > 0 implies ',
255     +'all lower levels must be nonzero too.'
256     end if
257     end if
258     if (uCheckLev1 .eq. 0 ) then
259     print *, 'JU: ERROR: uCheckLev1 must be nonzero '
260     end if
261    
262     cju uCheckLev1
263     allStepsCovered = .false.
264     if (nTimeSteps .lt. uCheckLev1 ) then
265     uCheckLev1=nTimeSteps
266     allStepsCovered =.true.
267     end if
268    
269     cju uCheckLev2
270     if (.NOT. allStepsCovered ) then
271     if (MOD(nTimeSteps,uCheckLev1).gt.0) then
272     if((nTimeSteps/uCheckLev1)+1 .le. uCheckLev2 ) then
273     uCheckLev2=(nTimeSteps/uCheckLev1)+1
274     allStepsCovered =.true.
275     end if
276     else
277     if((nTimeSteps/uCheckLev1) .le. uCheckLev2 ) then
278     uCheckLev2=(nTimeSteps/uCheckLev1)
279     allStepsCovered =.true.
280     end if
281     end if
282     else
283     uCheckLev2 = 0
284     end if
285    
286     cju uCheckLev3
287     if (.NOT. allStepsCovered ) then
288     if (MOD(nTimeSteps,uCheckLev1*uCheckLev2).gt.0) then
289     if((nTimeSteps/(uCheckLev1*uCheckLev2))+1
290     + .le. uCheckLev3 ) then
291     uCheckLev3=(nTimeSteps/(uCheckLev1*uCheckLev2))+1
292     allStepsCovered =.true.
293     end if
294     else
295     if((nTimeSteps/(uCheckLev1*uCheckLev2)) .le. uCheckLev3 ) then
296     uCheckLev3=(nTimeSteps/(uCheckLev1*uCheckLev2))
297     allStepsCovered =.true.
298     end if
299     end if
300     else
301     uCheckLev3 = 0
302     end if
303    
304     cju uCheckLev4
305     if (.NOT. allStepsCovered ) then
306     if (MOD(nTimeSteps,uCheckLev1*uCheckLev2*uCheckLev3)
307     + .gt.0) then
308     if((nTimeSteps/(uCheckLev1*uCheckLev2*uCheckLev3))+1
309     + .le. uCheckLev4 ) then
310     uCheckLev4=
311     + (nTimeSteps/(uCheckLev1*uCheckLev2*uCheckLev3))+1
312     allStepsCovered =.true.
313     end if
314     else
315     if((nTimeSteps/(uCheckLev1*uCheckLev2*uCheckLev3))
316     + .le. uCheckLev4 ) then
317     uCheckLev4=
318     + (nTimeSteps/(uCheckLev1*uCheckLev2*uCheckLev3))
319     allStepsCovered =.true.
320     end if
321     end if
322     else
323     uCheckLev4 = 0
324     end if
325    
326     if (.NOT. allStepsCovered) then
327     print *, 'JU: ERROR: not enough checkpoints allowed'
328     end if
329    
330     write(*,'(A,I6)') 'JU: main_loop timesteps required:',ntimesteps
331     write(*,'(A,I4,A,I4,A,I4,A,I4)')
332     +'JU: main_loop checkpoints used 1st:',uCheckLev1,
333     +', 2nd:', uCheckLev2,
334     +', 3rd:', uCheckLev3,
335     +', 4th:', uCheckLev4
336    
337     if (uCheckLev4 .gt. 0 ) then
338     do ilev_4 = 1, uCheckLev4
339    
340     c-- >>> Loop body start <<<
341    
342     cju in case of restart determine the timestep we start with:
343     nIter0 = NINT( (startTime-baseTime)/deltaTClock )
344    
345     #ifdef ALLOW_DEBUG
346     IF (debugMode) CALL DEBUG_CALL('THE_FOURTH_LEVEL_LOOP',myThid)
347     #endif
348    
349     CALL THE_FOURTH_LEVEL_LOOP( ilev_4,
350     +uCheckLev1, uCheckLev2, uCheckLev3,uCheckLev4,
351     +theCurrentStep,
352     +myTime, myIter, myThid )
353    
354     #ifdef ALLOW_RUNCLOCK
355     IF (useRunClock) THEN
356     RC_CONT=RUNCLOCK_CONTINUE( myThid )
357     IF (.NOT.RC_CONT) RETURN
358     ENDIF
359     #endif /* ALLOW_RUNCLOCK */
360    
361     c-- >>> Loop body end <<<
362    
363     end do
364     else
365     c-- >>> Loop body start <<
366     cju in case of restart determine the timestep we start with:
367     nIter0 = NINT( (startTime-baseTime)/deltaTClock )
368    
369     #ifdef ALLOW_DEBUG
370     IF (debugMode) CALL DEBUG_CALL('THE_FOURTH_LEVEL_PLAIN',myThid)
371     #endif
372    
373     CALL THE_FOURTH_LEVEL_PLAIN(
374     +uCheckLev1, uCheckLev2, uCheckLev3,uCheckLev4,
375     +theCurrentStep,
376     +myTime, myIter, myThid )
377    
378     #ifdef ALLOW_RUNCLOCK
379     IF (useRunClock) THEN
380     RC_CONT=RUNCLOCK_CONTINUE( myThid )
381     IF (.NOT.RC_CONT) RETURN
382     ENDIF
383     #endif /* ALLOW_RUNCLOCK */
384    
385     c-- >>> Loop body end <<<
386    
387     end if
388    
389     #ifdef ALLOW_COST
390     c-- Sum all cost function contributions.
391     call TIMER_START('COST_FINAL [ADJOINT SPIN-DOWN]', mythid)
392     call COST_FINAL ( mythid )
393     call TIMER_STOP ('COST_FINAL [ADJOINT SPIN-DOWN]', mythid)
394     #endif
395    
396     c$openad DEPENDENT(fc)
397    
398     _BARRIER
399     CALL TIMER_STOP ('MAIN LOOP [THE_MAIN_LOOP]', mythid)
400    
401     #ifdef ALLOW_DEBUG
402     IF (debugMode) CALL DEBUG_LEAVE('THE_MAIN_LOOP',myThid)
403     #endif
404    
405     END
406    

  ViewVC Help
Powered by ViewVC 1.1.22