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

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

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


Revision 1.3 - (hide annotations) (download)
Fri Jan 6 04:29:08 2006 UTC (20 years, 10 months ago) by utke
Branch: MAIN
Changes since 1.2: +3 -32 lines
fix independent set after Patrick's code change

1 utke 1.3 C $Header: /u/gcmpack/MITgcm_contrib/heimbach/OpenAD/code_shallow_openad/the_main_loop.F,v 1.2 2006/01/03 19:18:18 utke Exp $
2 heimbach 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 utke 1.2 logical haveRemainder, allStepsCovered
119 heimbach 1.1 integer uCheckLev1, uCheckLev2, uCheckLev3,uCheckLev4
120 utke 1.2
121     integer ilev_4
122     integer theCurrentStep
123    
124 heimbach 1.1 CEOP
125    
126     uCheckLev1=0
127     uCheckLev2=0
128     uCheckLev3=0
129     uCheckLev4=0
130 utke 1.2 theCurrentStep=0
131 heimbach 1.1
132     #ifdef ALLOW_DEBUG
133     IF (debugMode) CALL DEBUG_ENTER('THE_MAIN_LOOP',myThid)
134     #endif
135    
136     nIter0 = NINT( (startTime-baseTime)/deltaTClock )
137     ikey_dynamics = 1
138    
139     CALL TIMER_START('ADJOINT SPIN-UP', mythid)
140    
141     #ifdef ALLOW_DEBUG
142     IF (debugMode) CALL DEBUG_CALL('INITIALISE_VARIA',myThid)
143     #endif
144    
145     C-- Set initial conditions (variable arrays)
146     CALL TIMER_START('INITIALISE_VARIA [THE_MAIN_LOOP]', mythid)
147     CALL INITIALISE_VARIA( mythid )
148     CALL TIMER_STOP ('INITIALISE_VARIA [THE_MAIN_LOOP]', mythid)
149    
150     #ifdef ALLOW_MONITOR
151     #ifdef ALLOW_DEBUG
152     IF (debugMode) CALL DEBUG_CALL('MONITOR',myThid)
153     #endif
154     C-- Check status of solution (statistics, cfl, etc...)
155     CALL TIMER_START('MONITOR [THE_MAIN_LOOP]', mythid)
156     CALL MONITOR( myIter, myTime, myThid )
157     CALL TIMER_STOP ('MONITOR [THE_MAIN_LOOP]', mythid)
158     #endif /* ALLOW_MONITOR */
159    
160     C-- Do IO if needed (Dump for start state).
161     #ifdef ALLOW_DEBUG
162     IF (debugMode) CALL DEBUG_CALL('DO_THE_MODEL_IO',myThid)
163     #endif
164    
165     #ifdef ALLOW_OFFLINE
166     CALL TIMER_START('OFFLINE_MODEL_IO [FORWARD_STEP]',myThid)
167     CALL OFFLINE_MODEL_IO( myTime, myIter, myThid )
168     CALL TIMER_STOP ('OFFLINE_MODEL_IO [FORWARD_STEP]',myThid)
169     #else
170     CALL TIMER_START('DO_THE_MODEL_IO [THE_MAIN_LOOP]', mythid)
171     CALL DO_THE_MODEL_IO( myTime, myIter, mythid )
172     CALL TIMER_STOP ('DO_THE_MODEL_IO [THE_MAIN_LOOP]', mythid)
173     #endif
174    
175    
176     #ifdef ALLOW_AUTODIFF_TAMC
177     CALL TIMER_STOP ('ADJOINT SPIN-UP', mythid)
178     _BARRIER
179     #endif
180    
181     c-- Do the model integration.
182     CALL TIMER_START('MAIN LOOP [THE_MAIN_LOOP]', mythid)
183    
184     c >>>>>>>>>>>>>>>>>>>>>>>>>>> LOOP <<<<<<<<<<<<<<<<<<<<<<<<<<<<
185     c >>>>>>>>>>>>>>>>>>>>>>>>>>> STARTS <<<<<<<<<<<<<<<<<<<<<<<<<<<<
186    
187    
188     c**************************************
189 utke 1.3 c$openad INDEPENDENT(xx_theta)
190     c$openad INDEPENDENT(xx_salt)
191 heimbach 1.1
192     #ifndef ALLOW_TAMC_CHECKPOINTING
193     #error "not set up for undefined ALLOW_TAMC_CHECKPOINTING "
194     #endif
195    
196     #ifndef ALLOW_AUTODIFF_TAMC
197     #error "not set up for undefined ALLOW_AUTODIFF_TAMC "
198     #endif
199    
200 utke 1.2 write(*,'(A,I4,A,I4,A,I4,A,I8)')
201     +'JU: main_loop checkpoints allowed 1st:' ,nchkLev_1,
202     +', 2nd:', nchklev_2,
203     +', 3rd:', nchklev_3,
204     +', 4th:', nchklev_4
205    
206     cju in this current scheme
207     cju there is no point in specifying 1 as the number of checkpoints
208     cju because for now don't avoid the incidental store of
209     cju the same checkpoint across multiple levels.
210     if (nchklev_4 .eq. 1 ) then
211     uCheckLev4=0
212     write(*,'(A)') 'JU: NOTE: resetting level 4 to 0'
213     else
214     uCheckLev4=nchklev_4
215     end if
216     if (nchklev_3 .eq. 1 ) then
217     uCheckLev3=0
218     write(*,'(A)') 'JU: NOTE: resetting level 3 to 0'
219 heimbach 1.1 else
220 utke 1.2 uCheckLev3=nchklev_3
221 heimbach 1.1 end if
222 utke 1.2 if (nchklev_2 .eq. 1 ) then
223     uCheckLev2=0
224     write(*,'(A)') 'JU: NOTE: resetting level 2 to 0'
225 heimbach 1.1 else
226 utke 1.2 uCheckLev2=nchklev_2
227 heimbach 1.1 end if
228 utke 1.2 if (nchklev_1 .eq. 1 ) then
229     uCheckLev1=0
230     write(*,'(A)') 'JU: NOTE: resetting level 1 to 0'
231 heimbach 1.1 else
232 utke 1.2 uCheckLev1=nchklev_1
233     end if
234     cju check sanity
235     if (uCheckLev4 .gt. 0 ) then
236     if ( uCheckLev3*uCheckLev2*uCheckLev1 .eq. 0) then
237     print *, 'JU: ERROR: uCheckLev4 > 0 implies ',
238     +'all lower levels must be nonzero too.'
239     end if
240     end if
241     if (uCheckLev3 .gt. 0 ) then
242     if ( uCheckLev2*uCheckLev1 .eq. 0) then
243     print *, 'JU: ERROR: uCheckLev3 > 0 implies ',
244     +'all lower levels must be nonzero too.'
245     end if
246     end if
247     if (uCheckLev2 .gt. 0 ) then
248     if ( uCheckLev1 .eq. 0) then
249     print *, 'JU: ERROR: uCheckLev2 > 0 implies ',
250     +'all lower levels must be nonzero too.'
251     end if
252     end if
253     if (uCheckLev1 .eq. 0 ) then
254     print *, 'JU: ERROR: uCheckLev1 must be nonzero '
255     end if
256    
257     cju uCheckLev1
258     allStepsCovered = .false.
259     if (nTimeSteps .lt. uCheckLev1 ) then
260     uCheckLev1=nTimeSteps
261     allStepsCovered =.true.
262 heimbach 1.1 end if
263    
264 utke 1.2 cju uCheckLev2
265     if (.NOT. allStepsCovered ) then
266     if (MOD(nTimeSteps,uCheckLev1).gt.0) then
267     if((nTimeSteps/uCheckLev1)+1 .le. uCheckLev2 ) then
268     uCheckLev2=(nTimeSteps/uCheckLev1)+1
269     allStepsCovered =.true.
270     end if
271     else
272     if((nTimeSteps/uCheckLev1) .le. uCheckLev2 ) then
273     uCheckLev2=(nTimeSteps/uCheckLev1)
274     allStepsCovered =.true.
275     end if
276     end if
277 heimbach 1.1 else
278 utke 1.2 uCheckLev2 = 0
279 heimbach 1.1 end if
280 utke 1.2
281     cju uCheckLev3
282     if (.NOT. allStepsCovered ) then
283     if (MOD(nTimeSteps,uCheckLev1*uCheckLev2).gt.0) then
284     if((nTimeSteps/(uCheckLev1*uCheckLev2))+1
285     + .le. uCheckLev3 ) then
286     uCheckLev3=(nTimeSteps/(uCheckLev1*uCheckLev2))+1
287     allStepsCovered =.true.
288     end if
289     else
290     if((nTimeSteps/(uCheckLev1*uCheckLev2)) .le. uCheckLev3 ) then
291     uCheckLev3=(nTimeSteps/(uCheckLev1*uCheckLev2))
292     allStepsCovered =.true.
293     end if
294     end if
295 heimbach 1.1 else
296 utke 1.2 uCheckLev3 = 0
297 heimbach 1.1 end if
298    
299 utke 1.2 cju uCheckLev4
300     if (.NOT. allStepsCovered ) then
301     if (MOD(nTimeSteps,uCheckLev1*uCheckLev2*uCheckLev3)
302     + .gt.0) then
303     if((nTimeSteps/(uCheckLev1*uCheckLev2*uCheckLev3))+1
304     + .le. uCheckLev4 ) then
305     uCheckLev4=
306     + (nTimeSteps/(uCheckLev1*uCheckLev2*uCheckLev3))+1
307     allStepsCovered =.true.
308     end if
309     else
310     if((nTimeSteps/(uCheckLev1*uCheckLev2*uCheckLev3))
311     + .le. uCheckLev4 ) then
312     uCheckLev4=
313     + (nTimeSteps/(uCheckLev1*uCheckLev2*uCheckLev3))
314     allStepsCovered =.true.
315     end if
316     end if
317 heimbach 1.1 else
318 utke 1.2 uCheckLev4 = 0
319 heimbach 1.1 end if
320 utke 1.2
321     if (.NOT. allStepsCovered) then
322     print *, 'JU: ERROR: not enough checkpoints allowed'
323 heimbach 1.1 end if
324    
325 utke 1.2 write(*,'(A,I6)') 'JU: main_loop timesteps required:',ntimesteps
326     write(*,'(A,I4,A,I4,A,I4,A,I4)')
327     +'JU: main_loop checkpoints used 1st:',uCheckLev1,
328     +', 2nd:', uCheckLev2,
329     +', 3rd:', uCheckLev3,
330     +', 4th:', uCheckLev4
331 heimbach 1.1
332     if (uCheckLev4 .gt. 0 ) then
333 utke 1.2 do ilev_4 = 1, uCheckLev4
334 heimbach 1.1
335     c-- >>> Loop body start <<<
336    
337 utke 1.2 cju in case of restart determine the timestep we start with:
338 heimbach 1.1 nIter0 = NINT( (startTime-baseTime)/deltaTClock )
339    
340     #ifdef ALLOW_DEBUG
341 utke 1.2 IF (debugMode) CALL DEBUG_CALL('THE_FOURTH_LEVEL_LOOP',myThid)
342 heimbach 1.1 #endif
343    
344     CALL THE_FOURTH_LEVEL_LOOP( ilev_4,
345     +uCheckLev1, uCheckLev2, uCheckLev3,uCheckLev4,
346 utke 1.2 +theCurrentStep,
347 heimbach 1.1 +myTime, myIter, myThid )
348    
349     #ifdef ALLOW_RUNCLOCK
350     IF (useRunClock) THEN
351     RC_CONT=RUNCLOCK_CONTINUE( myThid )
352     IF (.NOT.RC_CONT) RETURN
353     ENDIF
354     #endif /* ALLOW_RUNCLOCK */
355    
356     c-- >>> Loop body end <<<
357    
358     end do
359     else
360     c-- >>> Loop body start <<
361 utke 1.2 cju in case of restart determine the timestep we start with:
362 heimbach 1.1 nIter0 = NINT( (startTime-baseTime)/deltaTClock )
363    
364     #ifdef ALLOW_DEBUG
365 utke 1.2 IF (debugMode) CALL DEBUG_CALL('THE_FOURTH_LEVEL_PLAIN',myThid)
366 heimbach 1.1 #endif
367    
368     CALL THE_FOURTH_LEVEL_PLAIN(
369     +uCheckLev1, uCheckLev2, uCheckLev3,uCheckLev4,
370 utke 1.2 +theCurrentStep,
371 heimbach 1.1 +myTime, myIter, myThid )
372    
373     #ifdef ALLOW_RUNCLOCK
374     IF (useRunClock) THEN
375     RC_CONT=RUNCLOCK_CONTINUE( myThid )
376     IF (.NOT.RC_CONT) RETURN
377     ENDIF
378     #endif /* ALLOW_RUNCLOCK */
379    
380     c-- >>> Loop body end <<<
381    
382     end if
383    
384     #ifdef ALLOW_COST
385     c-- Sum all cost function contributions.
386     call TIMER_START('COST_FINAL [ADJOINT SPIN-DOWN]', mythid)
387     call COST_FINAL ( mythid )
388     call TIMER_STOP ('COST_FINAL [ADJOINT SPIN-DOWN]', mythid)
389     #endif
390    
391     c$openad DEPENDENT(fc)
392    
393     _BARRIER
394     CALL TIMER_STOP ('MAIN LOOP [THE_MAIN_LOOP]', mythid)
395    
396     #ifdef ALLOW_DEBUG
397     IF (debugMode) CALL DEBUG_LEAVE('THE_MAIN_LOOP',myThid)
398     #endif
399    
400     END
401    

  ViewVC Help
Powered by ViewVC 1.1.22