/[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.2 - (hide annotations) (download)
Tue Jan 3 19:18:18 2006 UTC (20 years, 10 months ago) by utke
Branch: MAIN
Changes since 1.1: +159 -42 lines
reorganized checkpointing and added independents according to the makefiles list of independents

1 utke 1.2 C $Header: /u/gcmpack/MITgcm_contrib/heimbach/OpenAD/code_shallow_openad/the_main_loop.F,v 1.1 2005/12/13 15:15:32 heimbach 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     c$openad INDEPENDENT(xx_theta_dummy)
190 utke 1.2 c$openad INDEPENDENT(xx_salt_dummy)
191     c$openad INDEPENDENT(xx_tr1_dummy )
192     c$openad INDEPENDENT(xx_hflux_dummy )
193     c$openad INDEPENDENT(xx_sflux_dummy )
194     c$openad INDEPENDENT(xx_tauu_dummy )
195     c$openad INDEPENDENT(xx_tauv_dummy )
196     c$openad INDEPENDENT(xx_atemp_dummy )
197     c$openad INDEPENDENT(xx_aqh_dummy )
198     c$openad INDEPENDENT(xx_precip_dummy )
199     c$openad INDEPENDENT(xx_swflux_dummy )
200     c$openad INDEPENDENT(xx_swdown_dummy )
201     c$openad INDEPENDENT(xx_uwind_dummy )
202     c$openad INDEPENDENT(xx_vwind_dummy )
203     c$openad INDEPENDENT(xx_obcsn_dummy )
204     c$openad INDEPENDENT(xx_obcss_dummy )
205     c$openad INDEPENDENT(xx_obcsw_dummy )
206     c$openad INDEPENDENT(xx_obcse_dummy )
207     c$openad INDEPENDENT(xx_sst_dummy )
208     c$openad INDEPENDENT(xx_sss_dummy )
209     c$openad INDEPENDENT(xx_diffkr_dummy )
210     c$openad INDEPENDENT(xx_kapgm_dummy )
211     c$openad INDEPENDENT(xx_efluxy_dummy )
212     c$openad INDEPENDENT(xx_efluxp_dummy )
213     c$openad INDEPENDENT(xx_edtaux_dummy )
214     c$openad INDEPENDENT(xx_edtauy_dummy )
215     c$openad INDEPENDENT(xx_uvel_dummy )
216     c$openad INDEPENDENT(xx_vvel_dummy )
217     c$openad INDEPENDENT(xx_etan_dummy )
218     c$openad INDEPENDENT(xx_relaxsst_dummy )
219     c$openad INDEPENDENT(xx_relaxsss_dummy)
220 heimbach 1.1
221     #ifndef ALLOW_TAMC_CHECKPOINTING
222     #error "not set up for undefined ALLOW_TAMC_CHECKPOINTING "
223     #endif
224    
225     #ifndef ALLOW_AUTODIFF_TAMC
226     #error "not set up for undefined ALLOW_AUTODIFF_TAMC "
227     #endif
228    
229 utke 1.2 write(*,'(A,I4,A,I4,A,I4,A,I8)')
230     +'JU: main_loop checkpoints allowed 1st:' ,nchkLev_1,
231     +', 2nd:', nchklev_2,
232     +', 3rd:', nchklev_3,
233     +', 4th:', nchklev_4
234    
235     cju in this current scheme
236     cju there is no point in specifying 1 as the number of checkpoints
237     cju because for now don't avoid the incidental store of
238     cju the same checkpoint across multiple levels.
239     if (nchklev_4 .eq. 1 ) then
240     uCheckLev4=0
241     write(*,'(A)') 'JU: NOTE: resetting level 4 to 0'
242     else
243     uCheckLev4=nchklev_4
244     end if
245     if (nchklev_3 .eq. 1 ) then
246     uCheckLev3=0
247     write(*,'(A)') 'JU: NOTE: resetting level 3 to 0'
248 heimbach 1.1 else
249 utke 1.2 uCheckLev3=nchklev_3
250 heimbach 1.1 end if
251 utke 1.2 if (nchklev_2 .eq. 1 ) then
252     uCheckLev2=0
253     write(*,'(A)') 'JU: NOTE: resetting level 2 to 0'
254 heimbach 1.1 else
255 utke 1.2 uCheckLev2=nchklev_2
256 heimbach 1.1 end if
257 utke 1.2 if (nchklev_1 .eq. 1 ) then
258     uCheckLev1=0
259     write(*,'(A)') 'JU: NOTE: resetting level 1 to 0'
260 heimbach 1.1 else
261 utke 1.2 uCheckLev1=nchklev_1
262     end if
263     cju check sanity
264     if (uCheckLev4 .gt. 0 ) then
265     if ( uCheckLev3*uCheckLev2*uCheckLev1 .eq. 0) then
266     print *, 'JU: ERROR: uCheckLev4 > 0 implies ',
267     +'all lower levels must be nonzero too.'
268     end if
269     end if
270     if (uCheckLev3 .gt. 0 ) then
271     if ( uCheckLev2*uCheckLev1 .eq. 0) then
272     print *, 'JU: ERROR: uCheckLev3 > 0 implies ',
273     +'all lower levels must be nonzero too.'
274     end if
275     end if
276     if (uCheckLev2 .gt. 0 ) then
277     if ( uCheckLev1 .eq. 0) then
278     print *, 'JU: ERROR: uCheckLev2 > 0 implies ',
279     +'all lower levels must be nonzero too.'
280     end if
281     end if
282     if (uCheckLev1 .eq. 0 ) then
283     print *, 'JU: ERROR: uCheckLev1 must be nonzero '
284     end if
285    
286     cju uCheckLev1
287     allStepsCovered = .false.
288     if (nTimeSteps .lt. uCheckLev1 ) then
289     uCheckLev1=nTimeSteps
290     allStepsCovered =.true.
291 heimbach 1.1 end if
292    
293 utke 1.2 cju uCheckLev2
294     if (.NOT. allStepsCovered ) then
295     if (MOD(nTimeSteps,uCheckLev1).gt.0) then
296     if((nTimeSteps/uCheckLev1)+1 .le. uCheckLev2 ) then
297     uCheckLev2=(nTimeSteps/uCheckLev1)+1
298     allStepsCovered =.true.
299     end if
300     else
301     if((nTimeSteps/uCheckLev1) .le. uCheckLev2 ) then
302     uCheckLev2=(nTimeSteps/uCheckLev1)
303     allStepsCovered =.true.
304     end if
305     end if
306 heimbach 1.1 else
307 utke 1.2 uCheckLev2 = 0
308 heimbach 1.1 end if
309 utke 1.2
310     cju uCheckLev3
311     if (.NOT. allStepsCovered ) then
312     if (MOD(nTimeSteps,uCheckLev1*uCheckLev2).gt.0) then
313     if((nTimeSteps/(uCheckLev1*uCheckLev2))+1
314     + .le. uCheckLev3 ) then
315     uCheckLev3=(nTimeSteps/(uCheckLev1*uCheckLev2))+1
316     allStepsCovered =.true.
317     end if
318     else
319     if((nTimeSteps/(uCheckLev1*uCheckLev2)) .le. uCheckLev3 ) then
320     uCheckLev3=(nTimeSteps/(uCheckLev1*uCheckLev2))
321     allStepsCovered =.true.
322     end if
323     end if
324 heimbach 1.1 else
325 utke 1.2 uCheckLev3 = 0
326 heimbach 1.1 end if
327    
328 utke 1.2 cju uCheckLev4
329     if (.NOT. allStepsCovered ) then
330     if (MOD(nTimeSteps,uCheckLev1*uCheckLev2*uCheckLev3)
331     + .gt.0) then
332     if((nTimeSteps/(uCheckLev1*uCheckLev2*uCheckLev3))+1
333     + .le. uCheckLev4 ) then
334     uCheckLev4=
335     + (nTimeSteps/(uCheckLev1*uCheckLev2*uCheckLev3))+1
336     allStepsCovered =.true.
337     end if
338     else
339     if((nTimeSteps/(uCheckLev1*uCheckLev2*uCheckLev3))
340     + .le. uCheckLev4 ) then
341     uCheckLev4=
342     + (nTimeSteps/(uCheckLev1*uCheckLev2*uCheckLev3))
343     allStepsCovered =.true.
344     end if
345     end if
346 heimbach 1.1 else
347 utke 1.2 uCheckLev4 = 0
348 heimbach 1.1 end if
349 utke 1.2
350     if (.NOT. allStepsCovered) then
351     print *, 'JU: ERROR: not enough checkpoints allowed'
352 heimbach 1.1 end if
353    
354 utke 1.2 write(*,'(A,I6)') 'JU: main_loop timesteps required:',ntimesteps
355     write(*,'(A,I4,A,I4,A,I4,A,I4)')
356     +'JU: main_loop checkpoints used 1st:',uCheckLev1,
357     +', 2nd:', uCheckLev2,
358     +', 3rd:', uCheckLev3,
359     +', 4th:', uCheckLev4
360 heimbach 1.1
361     if (uCheckLev4 .gt. 0 ) then
362 utke 1.2 do ilev_4 = 1, uCheckLev4
363 heimbach 1.1
364     c-- >>> Loop body start <<<
365    
366 utke 1.2 cju in case of restart determine the timestep we start with:
367 heimbach 1.1 nIter0 = NINT( (startTime-baseTime)/deltaTClock )
368    
369     #ifdef ALLOW_DEBUG
370 utke 1.2 IF (debugMode) CALL DEBUG_CALL('THE_FOURTH_LEVEL_LOOP',myThid)
371 heimbach 1.1 #endif
372    
373     CALL THE_FOURTH_LEVEL_LOOP( ilev_4,
374     +uCheckLev1, uCheckLev2, uCheckLev3,uCheckLev4,
375 utke 1.2 +theCurrentStep,
376 heimbach 1.1 +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 do
388     else
389     c-- >>> Loop body start <<
390 utke 1.2 cju in case of restart determine the timestep we start with:
391 heimbach 1.1 nIter0 = NINT( (startTime-baseTime)/deltaTClock )
392    
393     #ifdef ALLOW_DEBUG
394 utke 1.2 IF (debugMode) CALL DEBUG_CALL('THE_FOURTH_LEVEL_PLAIN',myThid)
395 heimbach 1.1 #endif
396    
397     CALL THE_FOURTH_LEVEL_PLAIN(
398     +uCheckLev1, uCheckLev2, uCheckLev3,uCheckLev4,
399 utke 1.2 +theCurrentStep,
400 heimbach 1.1 +myTime, myIter, myThid )
401    
402     #ifdef ALLOW_RUNCLOCK
403     IF (useRunClock) THEN
404     RC_CONT=RUNCLOCK_CONTINUE( myThid )
405     IF (.NOT.RC_CONT) RETURN
406     ENDIF
407     #endif /* ALLOW_RUNCLOCK */
408    
409     c-- >>> Loop body end <<<
410    
411     end if
412    
413     #ifdef ALLOW_COST
414     c-- Sum all cost function contributions.
415     call TIMER_START('COST_FINAL [ADJOINT SPIN-DOWN]', mythid)
416     call COST_FINAL ( mythid )
417     call TIMER_STOP ('COST_FINAL [ADJOINT SPIN-DOWN]', mythid)
418     #endif
419    
420     c$openad DEPENDENT(fc)
421    
422     _BARRIER
423     CALL TIMER_STOP ('MAIN LOOP [THE_MAIN_LOOP]', mythid)
424    
425     #ifdef ALLOW_DEBUG
426     IF (debugMode) CALL DEBUG_LEAVE('THE_MAIN_LOOP',myThid)
427     #endif
428    
429     END
430    

  ViewVC Help
Powered by ViewVC 1.1.22