/[MITgcm]/MITgcm/tools/OAD_support/revolve.F90
ViewVC logotype

Contents of /MITgcm/tools/OAD_support/revolve.F90

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


Revision 1.4 - (show annotations) (download)
Tue May 21 17:22:58 2013 UTC (10 years, 10 months ago) by utke
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64o, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint64n, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint65, checkpoint64j, checkpoint64m, checkpoint64l, HEAD
Changes since 1.3: +49 -29 lines
sync with reference

1 !> \mainpage
2 !! This is a Fortran9X adaptation of the functionality of Revolve; see Alg. 799 published as \cite Griewank2000ARA .
3 !! The interface of the routines differs from the cited revolve implementation
4 !! found in Adol-C and has been designed to be more in line with the
5 !! Fortran 9X language features. A minor extension is the optional `bundle` parameter that allows to treat as many loop
6 !! iterations in one tape/adjoint sweep. If `bundle` is 1, the default, then the behavior is that of Alg. 799.
7 !!
8 !! The implementation (written by J. Utke) is contained in revolve.f90, the use is illustrated in the `Examples` directory.
9 !!
10 !! The mercurial repository with the latest version can be found at:
11 !! <a href="http://mercurial.mcs.anl.gov/ad/RevolveF9X">http://mercurial.mcs.anl.gov/ad/RevolveF9X</a>
12 !!
13
14
15 !> the module containing the revolve implementation
16 !!
17 MODULE revolve
18 IMPLICIT NONE
19
20 PUBLIC :: rvInit, rvVerbose, rvNextAction, &
21 rvGuess, rvFactor, &
22 rvStore, rvRestore, &
23 rvForward, rvFirstUTurn, rvUTurn, rvDone, &
24 rvError, rvAdjust
25
26 PRIVATE :: &
27 ourSteps, ourACP, ourCStart, ourCEnd, ourVerbosity, &
28 ourNumFwd , ourNumInv, ourNumStore, ourRWCP, ourPrevCEnd, &
29 ourFirstUTurned, chkRange, forwdCount
30
31 !> store a checkpoint now
32 !! equivalent to TAKESHOT in Alg. 799
33 INTEGER, PARAMETER :: rvStore =1
34
35 !> restore a checkpoint now
36 !! equivalent to RESTORE in Alg. 799
37 INTEGER, PARAMETER :: rvRestore =2
38
39 !> execute iteration(s) forward
40 !! equivalent to ADVANCE in Alg. 799
41 INTEGER, PARAMETER :: rvForward =3
42
43 !> tape iteration(s); optionally leave to return later; and (upon return) do the adjoint(s)
44 !! equivalent to FIRSTTURN in Alg. 799
45 INTEGER, PARAMETER :: rvFirstUTurn =4
46
47 !> tape iteration(s) and do the adjoint(s)
48 !! equivalent to YOUTURN in Alg. 799
49 INTEGER, PARAMETER :: rvUTurn =5
50
51 !> we are done with adjoining the loop
52 !! equivalent to the `terminate` enum value in Alg. 799
53 INTEGER, PARAMETER :: rvDone =6
54
55 !> an error has occurred
56 !! equivalent to the `error` enum value in Alg. 799;
57 !! see also `errorMsg` in \ref rvAction
58 INTEGER, PARAMETER :: rvError =7
59
60 !> this encapsulates all the information needed to perfrom the correct action
61 !! an instance is returned from \ref rvNextAction
62 TYPE rvAction
63 !> the action that is to be implemented, termination, or error;
64 !! the value must be one of:
65 !! `rvStore`, `rvRestore`, `rvForward`,
66 !! `rvFirstUTurn`, `rvUTurn`, `rvDone`, `rvError`
67 INTEGER :: actionFlag = 0
68
69 !> assumptions:
70 !! - the loop iterations are numbered in range [0,`ourSteps`-1]
71 !! - the model state is the input to the iteration numbered `startIteration`
72 !!
73 !! the interpretation is as follows based on the value of `actionFlag`:
74 !! - `rvForward`: execute iterations as the loop: `do currentIteration=startIteration, iteration-1`
75 !! - `rvRestore`: restores model state at `iteration` (here it has the same value as `startIteration`)
76 !! - `rvFirstUTurn`/`rvUTurn`: tape iterations in loop: do currentIteration=startIteration, iteration-1`
77 !! followed by adjoint sweep over iterations in loop: do currentIteration=iteration-1,startIteration,-1
78 !!
79 !! for all other values of `actionFlag` the value of `iteration` is meaningless
80 INTEGER :: iteration = 0
81
82 !> assuming the loop iterations are in [0,ourSteps-1] and `currentIteration` variable is maintained,
83 !! the interpretation is as follows based on the value of `actionFlag`:
84 !! - `rvForward`: execute iterations as the loop: `do currentIteration, iteration-1`
85 !! - `rvRestore`: set `currentIteration=iteration`
86 !!
87 !! for all other values of `actionFlag` the value of `iteration` is meaningless
88 INTEGER :: startIteration = 0
89
90 !> the checkpoint number to be stored to restored
91 !! the value is meaninfull only if `actionFlag` is set to `rvStore` or `rvRestore`;
92 !!
93 !! This is approximately equivalent to `checks` in Alg. 799.
94 INTEGER :: cpNum = 0
95
96 !> if an error has occurred `actionFlag` will be set to `rvError` and this will contain an error message
97 CHARACTER(80) :: errorMsg
98 END TYPE rvAction
99
100 !> the number of iteration steps; set by calling \ref rvInit; not supposed to be set/used directly by the user;
101 !! note that the iterations are expected to range in [0, ourSteps-1];
102 !!
103 !! equivalent to `steps` in Alg. 799
104 INTEGER :: ourSteps = 0 ! number of steps
105
106 !> the number of iterations that may be bundled for a taping/adjoining sweep;
107 !! set by calling \ref rvInit; not supposed to be set/used directly by the user;
108 !!
109 !! the default is 1 loop iteration which makes it equivalent to Alg. 799
110 INTEGER :: ourBundle = 1
111
112 !> the number of iterations in the last bundle
113 !! set by calling \ref rvInit; not supposed to be set/used directly by the user;
114 !!
115 !! the default is 1 (for `ourBundle` = 1) which makes it equivalent to Alg. 799
116 INTEGER :: ourTail = 1
117
118 !> the number of checkpoints (ACP=AllowedCheckPoints) that can be stored at any time during the loop execution
119 !! set by calling \ref rvInit; not supposed to be set/used directly by the user
120 !!
121 !! equivalent to `snaps` in Alg. 799
122 INTEGER :: ourACP = 0
123
124 !> current subrange start;
125 !! not to be set/referemced directly by the user
126 !!
127 !! approximately equivalent to `capo` in Alg. 799
128 INTEGER :: ourCStart = 0
129
130 !> current subrange end;
131 !! not to be set/referemced directly by the user
132 !!
133 !! approximately equivalent to `fine` in Alg. 799
134 INTEGER :: ourCEnd = 0
135
136 !> count of the forward steps; diagnostic only
137 INTEGER :: ourNumFwd = 0
138
139 !> count of invocations to \ref rvNextAction ; diagnostic only
140 INTEGER :: ourNumInv = 0
141
142 !> count of checkpoint stores; diagnostic only
143 INTEGER :: ourNumStore = 0
144
145 !> checkpoint currently (re)stored - the first checkpoint is numbered 0;
146 !! not to be set/referemced directly by the user
147 INTEGER :: ourRWCP = -1
148
149 !> previous subrange end;
150 !! not to be set/referemced directly by the user
151 INTEGER :: ourPrevCEnd = 0
152
153 !> have we first uturned already?;
154 !! not to be set/referemced directly by the user
155 LOGICAL :: ourFirstUturned = .FALSE.
156
157 !> vector of step numbers indexed by checkpoint;
158 !! not to be set/referemced directly by the user
159 INTEGER, DIMENSION(:), ALLOCATABLE :: ourStepOf
160
161 !> for debugging purposes; values imply:
162 !! - 0 includes errors
163 !! - 1 includes summary info
164 !! - 2 includes iterations with checkpoints stored
165 !! - 3 includes all action results
166 !!
167 !! set via \ref rvVerbose
168 INTEGER :: ourVerbosity = 0
169
170 CONTAINS
171
172 !--------------------------------------------------------------------*
173
174 !> method to initialize the internal state; must be called before any call to \ref rvNextAction
175 !! @param steps the total number of steps in the iteration; equivalent to `steps` in Alg. 799
176 !! @param checkpoints the total number of checkpoints allowed to be stored at any time; equivalent to `snaps` in Alg. 799
177 !! @param errorMsg set when an error condition occurs; else set to `"none"`
178 !! @param anActionInstance if supplied initializes its contents
179 !! @param bundle if supplied initializes `ourBundle`
180 !! @return `.true.` if successfull, else `.false.` ansd `errorMsg` will be set
181 FUNCTION rvInit(steps,checkpoints,errorMsg,anActionInstance,bundle)
182 IMPLICIT NONE
183 LOGICAL :: rvInit
184 INTEGER, INTENT(IN) :: steps
185 INTEGER, INTENT(IN) :: checkpoints
186 CHARACTER(*), INTENT(OUT) :: errorMsg
187 type(rvAction), optional :: anActionInstance
188 INTEGER, INTENT(IN), optional :: bundle
189 INTEGER :: predFwdCnt ! predicted forward count
190 rvInit = .TRUE.
191 errorMsg ='none'
192 IF (present(anActionInstance)) THEN
193 ! same as default init above
194 anActionInstance%actionFlag = 0
195 anActionInstance%iteration = 0
196 anActionInstance%cpNum = 0
197 END IF
198 IF (present(bundle)) THEN
199 ourBundle = bundle
200 END IF
201 IF (ourBundle<1 .OR. ourBundle>steps) THEN
202 rvInit=.FALSE.
203 errorMsg = "revolve::rvInit: bundle parameter out of range [1,steps]"
204 ELSEIF (steps<0) THEN
205 rvInit=.FALSE.
206 errorMsg = 'revolve::rvInit: negative steps'
207 ELSEIF (checkpoints<0) THEN
208 rvInit=.FALSE.
209 errorMsg = 'revolve::rvInit: negative checkpoints'
210 ELSE
211 ourCStart = 0
212 ourSteps = steps
213 IF (ourBundle .gt. 1) THEN
214 ourTail=modulo(ourSteps,ourBundle)
215 ourSteps=ourSteps/ourBundle
216 IF (ourTail>0) THEN
217 ourSteps=ourSteps+1
218 ELSE
219 ourTail=ourBundle
220 END IF
221 END IF
222 ourCEnd = ourSteps
223 ourACP = checkpoints
224 ourNumFwd = 0
225 ourNumInv = 0
226 ourNumStore = 0
227 ourRWCP = -1
228 ourPrevCEnd = 0
229 ourFirstUTurned = .FALSE.
230
231 IF (ALLOCATED(ourStepOf)) THEN
232 DEALLOCATE(ourStepOf)
233 END IF
234 IF(.NOT.ALLOCATED(ourStepOf)) THEN
235 ALLOCATE(ourStepOf(0:ourACP))
236 END IF
237
238 IF (ourVerbosity>0) THEN
239 predFwdCnt = forwdCount(steps,ourACP,ourBundle)
240 IF (predFwdCnt==-1) THEN
241 errorMsg='revolve::rvInit: error returned by revolve::forwdCount'
242 rvInit=.FALSE.
243 RETURN
244 ELSE
245 WRITE (*,'(A)') 'prediction:'
246 WRITE (*,'(A,I7)') ' overhead forward steps : ', predFwdCnt
247 WRITE (*,'(A,F8.4)') ' overhead factor : ', dble(predFwdCnt)/(steps)
248 END IF
249 END IF
250 END IF
251 END FUNCTION rvInit
252
253 !--------------------------------------------------------------------*
254
255 !> method to change the internal state for the total number of steps/checkpoints; must be called after \ref rvInit
256 !! @param steps the total number of steps in the iteration; equivalent to `steps` in Alg. 799
257 !! @param errorMsg set when an error condition occurs; else set to `"none"`
258 !! @return `.true.` if successfull, else `.false.` ansd `errorMsg` will be set
259 FUNCTION rvAdjust(steps,checkpoints,errorMsg)
260 IMPLICIT NONE
261 LOGICAL :: rvAdjust
262 INTEGER, INTENT(IN) :: steps
263 INTEGER, INTENT(IN) :: checkpoints
264 CHARACTER(*), INTENT(OUT) :: errorMsg
265 rvAdjust=.false.
266 END FUNCTION
267
268 !--------------------------------------------------------------------*
269
270 !> method to set the verbosity to a level in [0-3] as described for `ourVerbosity`
271 SUBROUTINE rvVerbose(level)
272 IMPLICIT NONE
273 INTEGER, INTENT(IN) :: level
274 ourVerbosity=level
275 END SUBROUTINE rvVerbose
276
277 !--------------------------------------------------------------------*
278 !> the method to determine the next action; to be called in an unbound loop after \ref rvInit
279 !! @return an instance of `rvAction` set to describe the next action (see the member documentation);
280 !!
281 !! this method modifies the internal state; it is approximately equivalent to the method `revolve` in Alg. 799
282 FUNCTION rvNextAction()
283 IMPLICIT NONE
284 REAL :: bino1, bino2, bino3, bino4, bino5
285
286 !> available checkpoint slots
287 INTEGER :: availCP
288
289 !> local copy of previous subrange start
290 INTEGER :: prevCStart
291
292 INTEGER :: range
293 INTEGER :: reps
294 INTEGER :: i
295 LOGICAL :: rwcpTest
296 type(rvAction) :: rvNextAction
297 IF (ourNumInv==0) THEN
298 ! first invocation
299 DO i = 0, ourACP
300 ourStepOf(i) = 0
301 END DO
302 ourStepOf(0) = ourCStart - 1
303 END IF
304 prevCStart = ourCStart
305 ourNumInv = ourNumInv + 1
306 rwcpTest=(ourRWCP==(-1))
307 IF (.not. rwcpTest) THEN
308 rwcpTest=(ourStepOf(ourRWCP)/=ourCStart)
309 END IF
310 IF ((ourCEnd-ourCStart)==0) THEN
311 ! nothing in current subrange
312 IF ((ourRWCP==(-1)) .OR. (ourCStart==ourStepOf(0))) THEN
313 ! we are done
314 ourRWCP = ourRWCP - 1
315 IF (ourVerbosity>2) THEN
316 WRITE (*,FMT='(A)') ' done'
317 END IF
318 IF (ourVerbosity>0) THEN
319 WRITE (*,'(A)') 'summary:'
320 WRITE (*,'(A,I8)') ' overhead forward steps:', ourNumFwd
321 WRITE (*,'(A,I8)') ' CP stores :', ourNumStore
322 WRITE (*,'(A,I8)') ' rvNextAction calls :', ourNumInv
323 END IF
324 rvNextAction%actionFlag = rvDone
325 ELSE
326 ourCStart = ourStepOf(ourRWCP)
327 ourPrevCEnd = ourCEnd
328 rvNextAction%actionFlag = rvRestore
329 END IF
330 ELSE IF ((ourCEnd-ourCStart)==1) THEN
331 ourCEnd = ourCEnd - 1
332 ourPrevCEnd = ourCEnd
333 IF ((ourRWCP>=0) .AND. (ourStepOf(ourRWCP)==ourCStart)) ourRWCP = ourRWCP - 1
334 IF (.NOT.ourFirstUTurned) THEN
335 rvNextAction%actionFlag = rvFirstUTurn
336 ourFirstUTurned = .TRUE.
337 ELSE
338 rvNextAction%actionFlag = rvUTurn
339 END IF
340 ELSE IF (rwcpTest) THEN
341 ourRWCP = ourRWCP + 1
342 IF (ourRWCP+1>ourACP) THEN
343 rvNextAction%actionFlag = rvError
344 rvNextAction%errorMsg='revolve::rvNextAction: insufficient allowed checkpoints'
345 RETURN
346 ELSE
347 ourStepOf(ourRWCP) = ourCStart
348 ourNumStore = ourNumStore + 1
349 ourPrevCEnd = ourCEnd
350 rvNextAction%actionFlag = rvStore
351 END IF
352 ELSE IF ((ourPrevCEnd<ourCEnd) .AND. (ourACP==ourRWCP+1)) THEN
353 rvNextAction%actionFlag = rvError
354 rvNextAction%errorMsg='revolve::rvNextAction: insufficient allowed checkpoints'
355 ELSE
356 availCP = ourACP - ourRWCP
357 IF (availCP<1) THEN
358 rvNextAction%actionFlag = rvError
359 rvNextAction%errorMsg='revolve::rvNextAction: insufficient allowed checkpoints'
360 ELSE
361 reps = 0
362 range = 1
363 DO WHILE (range<ourCEnd-ourCStart)
364 reps = reps + 1
365 range = range*(reps+availCP)/reps
366 END DO
367 bino1 = range*reps/(availCP+reps)
368 IF (availCP>1) THEN
369 bino2 = bino1*availCP/(availCP+reps-1)
370 ELSE
371 bino2 = 1
372 END IF
373 IF (availCP==1) THEN
374 bino3 = 0
375 ELSE IF (availCP>2) THEN
376 bino3 = bino2*(availCP-1)/(availCP+reps-2)
377 ELSE
378 bino3 = 1
379 END IF
380 bino4 = bino2*(reps-1)/availCP
381 IF (availCP<3) THEN
382 bino5 = 0
383 ELSE IF (availCP>3) THEN
384 bino5 = bino3*(availCP-1)/reps
385 ELSE
386 bino5 = 1
387 END IF
388 IF (ourCEnd-ourCStart<=bino1+bino3) THEN
389 ourCStart = int(ourCStart + bino4)
390 ELSE IF (ourCEnd-ourCStart>=range-bino5) THEN
391 ourCStart = int(ourCStart + bino1)
392 ELSE
393 ourCStart = int(ourCEnd - bino2 - bino3)
394 END IF
395 IF (ourCStart==prevCStart) THEN
396 ourCStart = prevCStart + 1
397 END IF
398 IF (ourCStart==ourSteps) THEN
399 ourNumFwd = ourNumFwd + ((ourCStart-1) - prevCStart)*ourBundle + ourTail
400 ELSE
401 ourNumFwd = ourNumFwd + (ourCStart - prevCStart)*ourBundle
402 END IF
403 rvNextAction%actionFlag = rvForward
404 END IF
405 END IF
406 rvNextAction%startIteration=prevCStart*ourBundle
407 IF (rvNextAction%actionFlag==rvFirstUTurn) THEN
408 rvNextAction%iteration=(ourCStart)*ourBundle+ourTail
409 ELSE IF (rvNextAction%actionFlag==rvUTurn) THEN
410 rvNextAction%iteration=(ourCStart+1)*ourBundle
411 ELSE
412 rvNextAction%iteration=(ourCStart)*ourBundle
413 END IF
414 IF (rvNextAction%actionFlag /= rvError) THEN
415 IF (ourVerbosity>2) THEN
416 SELECT CASE( rvNextAction%actionFlag)
417 CASE (rvForward)
418 WRITE (*,FMT='(A,I8,A,I8,A)') ' run forward iterations [', &
419 rvNextAction%startIteration, ',', rvNextAction%iteration-1,']'
420 CASE (rvRestore)
421 WRITE (*,FMT='(A,I8)') ' restore input of iteration ',&
422 rvNextAction%iteration
423 CASE (rvFirstUTurn)
424 WRITE (*,FMT='(A,I8,A,I8,A)') ' 1st uturn for iterations [',&
425 rvNextAction%startIteration, ',', rvNextAction%iteration-1,']'
426 CASE(rvUTurn)
427 WRITE (*,FMT='(A,I8,A,I8,A)') ' uturn for iterations [',&
428 rvNextAction%startIteration, ',', rvNextAction%iteration-1,']'
429 END SELECT
430 END IF
431 IF ((ourVerbosity>1) .AND. (rvNextAction%actionFlag == rvStore)) THEN
432 WRITE (*,FMT='(A,I8)') ' store input of iteration ',&
433 rvNextAction%iteration
434 END IF
435 END IF
436 rvNextAction%cpNum=ourRWCP
437 END FUNCTION rvNextAction
438
439 !--------------------------------------------------------------------*
440 !> estimates the number of checkpoints required; equivalent to `adjust` in Alg. 799
441 !! @param steps is the number of iterations
442 !! @param bundle is optional; detaults to 1, if specified indicates the number of iterations bundled in one tape/adjoint sweep
443 !! @return the number of checkpoints such that the growth in spatial complexity is balanced with the growth in temporal complexity
444 !!
445 !! this method does not change the internal state and does not require \ref rvInit
446 FUNCTION rvGuess(steps,bundle)
447 IMPLICIT NONE
448 INTEGER, INTENT(IN) :: steps, bundle
449 OPTIONAL :: bundle
450 INTEGER :: reps, s, checkpoints, b, tail, bSteps
451 INTEGER :: rvGuess
452 b=1
453 bSteps=steps
454 IF (present(bundle)) THEN
455 b=bundle
456 END IF
457 IF (steps<1) THEN
458 WRITE (*,fmt=*) 'revolve::rvGuess: error: steps < 1'
459 rvGuess = -1
460 ELSE IF (b<1) THEN
461 WRITE (*,fmt=*) 'revolve::rvGuess: error: bundle < 1'
462 rvGuess = -1
463 ELSE
464 IF (b .gt. 1) THEN
465 tail=modulo(bSteps,b)
466 bSteps=bSteps/b
467 IF (tail>0) THEN
468 bSteps=bSteps+1
469 END IF
470 END IF
471 IF (bSteps==1) THEN
472 rvGuess=0
473 ELSE
474 checkpoints = 1
475 reps = 1
476 s = 0
477 DO WHILE (chkRange(checkpoints+s,reps+s)>bSteps)
478 s = s - 1
479 END DO
480 DO WHILE (chkRange(checkpoints+s,reps+s)<bSteps)
481 s = s + 1
482 END DO
483 checkpoints = checkpoints + s
484 reps = reps + s
485 s = -1
486 DO WHILE (chkRange(checkpoints,reps)>=bSteps)
487 IF (checkpoints>reps) THEN
488 checkpoints = checkpoints - 1
489 s = 0
490 ELSE
491 reps = reps - 1
492 s = 1
493 END IF
494 END DO
495 IF (s==0) THEN
496 checkpoints = checkpoints + 1
497 END IF
498 IF (s==1) reps = reps + 1
499 rvGuess = checkpoints
500 END IF
501 END IF
502 END FUNCTION rvGuess
503
504 !--------------------------------------------------------------------*
505 !> computes the run time overhead factor; equivalent to `expense` in Alg. 799
506 !! @param steps is the number of iterations
507 !! @param checkpoints is the number of allowed checkpoints
508 !! @param bundle is optional; detaults to 1, if specified indicates the number of iterations bundled in one tape/adjoint sweep
509 !! @return the estimated runtime overhead factor (does not account for the time needed to write checkpoints)
510 !!
511 !! this method does not change the internal state and does not require \ref rvInit
512 FUNCTION rvFactor(steps,checkpoints,bundle)
513 IMPLICIT NONE
514 INTEGER, INTENT(IN) :: checkpoints, steps, bundle
515 OPTIONAL :: bundle
516 INTEGER :: b, f
517 DOUBLE PRECISION :: rvFactor
518 b=1
519 IF (present(bundle)) THEN
520 b=bundle
521 END IF
522 f=forwdCount(steps,checkpoints,b)
523 IF (f==-1) THEN
524 WRITE (*,fmt=*) 'revolve::rvFactor: error returned by revolve::forwdCount'
525 rvFactor=-1
526 ELSE
527 rvFactor = dble(f)/steps
528 END IF
529 END FUNCTION rvFactor
530
531 !--------------------------------------------------------------------*
532 !> internal method not to be referenced by the user
533 FUNCTION chkRange(ss,tt)
534 IMPLICIT NONE
535 INTEGER :: ss, tt
536 DOUBLE PRECISION :: res
537 INTEGER :: i
538 INTEGER :: chkRange
539 res = 1.
540 IF (tt<0 .OR. ss<0) THEN
541 WRITE (*,fmt=*) 'revolve::chkRange: error: negative parameter '
542 chkRange = -1
543 ELSE
544 DO i = 1, tt
545 res = res*(ss+i)
546 res = res/i
547 IF (res>huge(chkrange)) EXIT
548 END DO
549 IF (res<huge(chkrange)) THEN
550 chkRange = int(res)
551 ELSE
552 chkRange = huge(chkrange)
553 WRITE (*,fmt=*) 'revolve::chkRange: warning: returning maximal integer ',&
554 chkRange
555 END IF
556 END IF
557 END FUNCTION chkRange
558
559 !--------------------------------------------------------------------*
560
561 !> internal method not to be referenced by the user;
562 !> predicts the number of recomputation-from-checkpoint forwards steps (overhead)
563 FUNCTION forwdCount(steps,checkpoints,bundle)
564 IMPLICIT NONE
565 INTEGER, INTENT(IN) :: checkpoints, steps, bundle
566 INTEGER :: range, reps,s,tail
567 INTEGER :: forwdCount
568 IF (checkpoints<0) THEN
569 WRITE (*,fmt=*) 'revolve::forwdCount: error: checkpoints < 0'
570 forwdCount = -1
571 ELSE IF (steps<1) THEN
572 WRITE (*,fmt=*) 'revolve::forwdCount: error: steps < 1'
573 forwdCount = -1
574 ELSE IF (bundle<1) THEN
575 WRITE (*,fmt=*) 'revolve::forwdCount: error: bundle < 1'
576 forwdCount = -1
577 ELSE
578 s=steps
579 IF (bundle .gt. 1) THEN
580 tail=modulo(s,bundle)
581 s=s/bundle
582 IF (tail>0) THEN
583 s=s+1
584 END IF
585 END IF
586 IF (s==1) THEN
587 forwdCount = 0
588 ELSE IF (checkpoints==0) THEN
589 WRITE (*,fmt=*) &
590 'revolve::forwdCount: error: given inputs require checkpoints>0'
591 forwdCount = -1
592 ELSE
593 reps = 0
594 range = 1
595 DO WHILE (range<s)
596 reps = reps + 1
597 range = range*(reps+checkpoints)/reps
598 END DO
599 forwdCount = (reps*s - range*reps/(checkpoints+1))*bundle
600 END IF
601 END IF
602 END FUNCTION forwdCount
603
604 !--------------------------------------------------------------------*
605
606 END MODULE revolve

  ViewVC Help
Powered by ViewVC 1.1.22