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

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

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

revision 1.1 by utke, Sat Feb 23 04:24:42 2013 UTC revision 1.2 by utke, Sat Mar 9 17:17:39 2013 UTC
# Line 1  Line 1 
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  MODULE revolve
18    IMPLICIT NONE    IMPLICIT NONE
19    
# Line 9  ourSteps, ourACP, ourCStart, ourCEnd, ou Line 25  ourSteps, ourACP, ourCStart, ourCEnd, ou
25  ourNumFwd , ourNumInv, ourNumStore, ourRWCP, ourPrevCEnd, ourFirstUTurned, &    ourNumFwd , ourNumInv, ourNumStore, ourRWCP, ourPrevCEnd, ourFirstUTurned, &  
26  chkRange, forwdCount  chkRange, forwdCount
27    
28    ! possible actions    !> store a checkpoint now
29      !! equivalent to TAKESHOT in Alg. 799
30    INTEGER, PARAMETER :: rvStore      =1    INTEGER, PARAMETER :: rvStore      =1
31    
32      !> restore a checkpoint now
33      !! equivalent to RESTORE in Alg. 799
34    INTEGER, PARAMETER :: rvRestore    =2    INTEGER, PARAMETER :: rvRestore    =2
35    
36      !> execute iteration(s) forward
37      !! equivalent to ADVANCE in Alg. 799
38    INTEGER, PARAMETER :: rvForward    =3    INTEGER, PARAMETER :: rvForward    =3
39    
40      !> tape iteration(s); optionally leave to return later;  and (upon return) do the adjoint(s)
41      !! equivalent to FIRSTTURN in Alg. 799
42    INTEGER, PARAMETER :: rvFirstUTurn =4    INTEGER, PARAMETER :: rvFirstUTurn =4
43    
44      !> tape iteration(s) and do the adjoint(s)
45      !! equivalent to YOUTURN in Alg. 799
46    INTEGER, PARAMETER :: rvUTurn      =5    INTEGER, PARAMETER :: rvUTurn      =5
47    
48      !> we are done with adjoining the loop
49      !! equivalent to the `terminate` enum value in Alg. 799
50    INTEGER, PARAMETER :: rvDone       =6    INTEGER, PARAMETER :: rvDone       =6
51    
52      !> an error has occurred
53      !! equivalent to the `error` enum value in Alg. 799;
54      !! see also `errorMsg` in \ref rvAction
55    INTEGER, PARAMETER :: rvError      =7    INTEGER, PARAMETER :: rvError      =7
56    
57      !> this encapsulates all the information needed to perfrom the correct action
58      !! an instance is returned from \ref rvNextAction
59    TYPE rvAction    TYPE rvAction
60         !> the action that is to be implemented, termination, or error;
61         !! the value must be one of:
62         !! `rvStore`, `rvRestore`, `rvForward`,
63         !! `rvFirstUTurn`, `rvUTurn`, `rvDone`, `rvError`
64       INTEGER :: actionFlag = 0       INTEGER :: actionFlag = 0
65    
66         !> assumptions:
67         !! - the loop iterations are numbered in range [0,`ourSteps`-1]
68         !! - the model state is the input to the iteration numbered `startIteration`
69         !!
70         !! the interpretation is as follows based on the value of `actionFlag`:
71         !! - `rvForward`: execute iterations as the loop: `do currentIteration=startIteration, iteration-1`
72         !! - `rvRestore`: restores model state at `iteration` (here it has the same value as `startIteration`)
73         !! - `rvFirstUTurn`/`rvUTurn`: tape iterations in loop: do currentIteration=startIteration, iteration-1`
74         !!    followed by adjoint sweep over iterations in loop: do currentIteration=iteration-1,startIteration,-1
75         !!
76         !! for all other values of `actionFlag` the value of `iteration` is meaningless
77       INTEGER :: iteration  = 0       INTEGER :: iteration  = 0
78    
79         !> assuming the loop iterations are in [0,ourSteps-1] and `currentIteration` variable is maintained,
80         !! the interpretation is as follows based on the value of `actionFlag`:
81         !! - `rvForward`: execute iterations as the loop: `do currentIteration, iteration-1`
82         !! - `rvRestore`: set `currentIteration=iteration`
83         !!
84         !! for all other values of `actionFlag` the value of `iteration` is meaningless
85         INTEGER :: startIteration = 0
86    
87         !> the checkpoint number to be stored to restored
88         !! the value is meaninfull only if `actionFlag` is set to `rvStore` or `rvRestore`;
89         !!
90         !! This is approximately equivalent to `checks` in Alg. 799.
91       INTEGER :: cpNum      = 0       INTEGER :: cpNum      = 0
92       CHARACTER, dimension(80) :: errorMsg  
93         !> if an error has occurred `actionFlag` will be set to `rvError` and this will contain an error message
94         CHARACTER(80) :: errorMsg
95    END TYPE rvAction    END TYPE rvAction
96        
97      !> the number of iteration steps; set by calling \ref rvInit; not supposed to be set/used directly by the user;
98      !! note that the iterations are expected to range in [0, ourSteps-1];
99      !!
100      !! equivalent to `steps` in Alg. 799
101    INTEGER :: ourSteps    = 0 ! number of steps    INTEGER :: ourSteps    = 0 ! number of steps
102    INTEGER :: ourACP      = 0 ! allowed number of checkpoints  
103    INTEGER :: ourCStart   = 0 ! current subrange start    !> the number of iterations that may be bundled for a taping/adjoining sweep;
104    INTEGER :: ourCEnd     = 0 ! current subrange end    !! set by calling \ref rvInit; not supposed to be set/used directly by the user;
105    INTEGER :: ourNumFwd   = 0 ! count of forward steps    !!
106    INTEGER :: ourNumInv   = 0 ! count of invocations of rvNextAction    !! the default is 1 loop iteration which makes it equivalent to Alg. 799
107    INTEGER :: ourNumStore = 0 ! number of stored checkpoints    INTEGER :: ourBundle   = 1
108    INTEGER :: ourRWCP     = -1! checkpoint currently (re)stored (first checkpoint is 0)  
109    INTEGER :: ourPrevCEnd = 0 ! previous subrange end    !> the number of iterations in the last bundle
110    LOGICAL :: ourFirstUturned = .FALSE. ! have we first for the first time    !! set by calling \ref rvInit; not supposed to be set/used directly by the user;
111    ! vector of step numbers indexed by checkpoint    !!
112      !! the default is 1 (for `ourBundle` = 1)  which makes it equivalent to Alg. 799
113      INTEGER :: ourTail   = 1
114    
115      !> the number of checkpoints (ACP=AllowedCheckPoints) that can be stored at any time during the loop execution
116      !! set by calling \ref rvInit; not supposed to be set/used directly by the user
117      !!
118      !! equivalent to `snaps` in Alg. 799
119      INTEGER :: ourACP      = 0
120    
121      !> current subrange start;
122      !! not to be set/referemced directly by the user
123      !!
124      !! approximately equivalent to `capo` in Alg. 799
125      INTEGER :: ourCStart   = 0
126    
127      !> current subrange end;
128      !! not to be set/referemced directly by the user
129      !!
130      !! approximately equivalent to `fine` in Alg. 799
131      INTEGER :: ourCEnd     = 0
132    
133      !> count of the forward steps; diagnostic only
134      INTEGER :: ourNumFwd   = 0
135    
136      !> count of invocations to \ref rvNextAction ;  diagnostic only
137      INTEGER :: ourNumInv   = 0
138    
139      !> count of checkpoint stores; diagnostic only
140      INTEGER :: ourNumStore = 0
141    
142      !> checkpoint currently (re)stored - the first checkpoint is numbered 0;
143      !! not to be set/referemced directly by the user
144      INTEGER :: ourRWCP     = -1
145    
146      !> previous subrange end;
147      !! not to be set/referemced directly by the user
148      INTEGER :: ourPrevCEnd = 0
149    
150      !> have we first uturned already?;
151      !! not to be set/referemced directly by the user
152      LOGICAL :: ourFirstUturned = .FALSE.
153    
154      !> vector of step numbers indexed by checkpoint;
155      !! not to be set/referemced directly by the user
156    INTEGER, DIMENSION(:), ALLOCATABLE :: ourStepOf    INTEGER, DIMENSION(:), ALLOCATABLE :: ourStepOf
157    
158    ! for debugging purposes:    !> for debugging purposes; values imply:
159    ! 0 includes errors    !! - 0 includes errors
160    ! 1 includes summary info    !! - 1 includes summary info
161    ! 2 includes iterations with checkpoints stored    !! - 2 includes iterations with checkpoints stored
162    ! 3 includes all action results    !! - 3 includes all action results
163      !!
164      !! set via \ref rvVerbose
165    INTEGER :: ourVerbosity = 0    INTEGER :: ourVerbosity = 0
166    
167  CONTAINS  CONTAINS
168    
169  !--------------------------------------------------------------------*  !--------------------------------------------------------------------*
170    
171    FUNCTION rvInit(steps,checkpoints,errorMsg,anActionInstance)    !> method to initialize the internal state; must be called before any call to \ref rvNextAction
172      !! @param steps  the total number of steps in the iteration; equivalent to `steps` in Alg. 799
173      !! @param checkpoints the total number of checkpoints allowed to be stored at any time; equivalent to `snaps` in Alg. 799
174      !! @param errorMsg set when an error condition occurs; else set to `"none"`
175      !! @param anActionInstance  if supplied initializes its contents
176      !! @param bundle if supplied initializes `ourBundle`
177      !! @return `.true.` if successfull, else `.false.` ansd `errorMsg` will be set
178      FUNCTION rvInit(steps,checkpoints,errorMsg,anActionInstance,bundle)
179      IMPLICIT NONE      IMPLICIT NONE
180      LOGICAL :: rvInit      LOGICAL :: rvInit
181      INTEGER, INTENT(IN) :: steps      INTEGER, INTENT(IN) :: steps
182      INTEGER, INTENT(IN) :: checkpoints      INTEGER, INTENT(IN) :: checkpoints
183      CHARACTER ,dimension(:), INTENT(OUT) :: errorMsg      CHARACTER(*), INTENT(OUT) :: errorMsg
184      type(rvAction), optional :: anActionInstance      type(rvAction), optional :: anActionInstance
185        INTEGER, INTENT(IN), optional :: bundle
186      INTEGER :: predFwdCnt ! predicted forward count      INTEGER :: predFwdCnt ! predicted forward count
187      rvInit = .TRUE.      rvInit = .TRUE.
188      errorMsg ='none'      errorMsg ='none'
# Line 65  CONTAINS Line 192  CONTAINS
192         anActionInstance%iteration  = 0         anActionInstance%iteration  = 0
193         anActionInstance%cpNum      = 0         anActionInstance%cpNum      = 0
194      END IF      END IF
195      IF (steps<0 .OR. checkpoints<0) THEN      IF (present(bundle)) THEN
196           ourBundle = bundle
197        END IF
198        IF (ourBundle<1 .OR. ourBundle>steps) THEN
199           rvInit=.FALSE.
200           errorMsg = "revolve::rvInit: bundle parameter out of range [1,steps]"
201        ELSEIF (steps<0) THEN
202         rvInit=.FALSE.         rvInit=.FALSE.
203         errorMsg = 'revolve::rvInit: negative steps or checkpoints'         errorMsg = 'revolve::rvInit: negative steps'
204        ELSEIF (checkpoints<0) THEN
205           rvInit=.FALSE.
206           errorMsg = 'revolve::rvInit: negative checkpoints'
207      ELSE      ELSE
208         ourCStart       = 0         ourCStart       = 0
209         ourSteps        = steps         ourSteps        = steps
210         ourCEnd         = steps         IF (ourBundle .gt. 1) THEN
211              ourTail=modulo(ourSteps,ourBundle)
212              ourSteps=ourSteps/ourBundle
213              IF (ourTail>0) THEN
214                 ourSteps=ourSteps+1
215              ELSE
216                 ourTail=ourBundle
217              END IF
218           END IF
219           ourCEnd         = ourSteps
220         ourACP          = checkpoints         ourACP          = checkpoints
221         ourNumFwd       = 0         ourNumFwd       = 0
222         ourNumInv       = 0         ourNumInv       = 0
# Line 88  CONTAINS Line 233  CONTAINS
233         END IF         END IF
234    
235         IF (ourVerbosity>0) THEN         IF (ourVerbosity>0) THEN
236            predFwdCnt = forwdCount(ourCEnd-ourCStart,ourACP)            predFwdCnt = forwdCount(steps,ourACP,ourBundle)
237            IF (predFwdCnt==-1) THEN            IF (predFwdCnt==-1) THEN
238               errorMsg='error in forwdCount'               errorMsg='revolve::rvInit: error returned by  revolve::forwdCount'
239                 rvInit=.FALSE.
240               RETURN               RETURN
241            ELSE            ELSE
242               WRITE (*,'(A)') 'prediction:'               WRITE (*,'(A)') 'prediction:'
243               WRITE (*,'(A,I7)') ' needed forward steps: ', predFwdCnt               WRITE (*,'(A,I7)')   ' overhead forward steps : ', predFwdCnt
244               WRITE (*,'(A,F8.4)') ' slowdown factor     : ', dble(predFwdCnt)/(ourCEnd-ourCStart)               WRITE (*,'(A,F8.4)') ' overhead factor        : ', dble(predFwdCnt)/(steps)
245            END IF            END IF
246         END IF         END IF
247      END IF      END IF
# Line 103  CONTAINS Line 249  CONTAINS
249    
250  !--------------------------------------------------------------------*  !--------------------------------------------------------------------*
251    
252      !> method to set the verbosity to a level in [0-3] as described for `ourVerbosity`
253    SUBROUTINE rvVerbose(level)    SUBROUTINE rvVerbose(level)
254      IMPLICIT NONE      IMPLICIT NONE
255      INTEGER, INTENT(IN) :: level      INTEGER, INTENT(IN) :: level
# Line 110  CONTAINS Line 257  CONTAINS
257    END SUBROUTINE rvVerbose    END SUBROUTINE rvVerbose
258    
259  !--------------------------------------------------------------------*  !--------------------------------------------------------------------*
260      !> the method to determine the next action; to be called in an unbound loop after \ref rvInit
261      !! @return an instance of `rvAction` set to describe the next action (see the member documentation);
262      !!
263      !! this method modifies the internal state; it is approximately equivalent to the method `revolve` in Alg. 799
264    FUNCTION rvNextAction()    FUNCTION rvNextAction()
265      IMPLICIT NONE      IMPLICIT NONE
266      REAL :: bino1, bino2, bino3, bino4, bino5      REAL :: bino1, bino2, bino3, bino4, bino5
267      INTEGER :: availCP    ! available checkpoint slots  
268      INTEGER :: prevCStart ! previous subrange start      !> available checkpoint slots
269      INTEGER :: range      !      INTEGER :: availCP
270    
271        !> local copy of previous subrange start
272        INTEGER :: prevCStart
273    
274        INTEGER :: range
275      INTEGER :: reps      INTEGER :: reps
276      INTEGER :: i      INTEGER :: i
277      type(rvAction) :: rvNextAction      type(rvAction) :: rvNextAction
# Line 127  CONTAINS Line 282  CONTAINS
282         END DO         END DO
283         ourStepOf(0) = ourCStart - 1         ourStepOf(0) = ourCStart - 1
284      END IF      END IF
285        prevCStart = ourCStart
286      ourNumInv = ourNumInv + 1      ourNumInv = ourNumInv + 1
287      IF ((ourCEnd-ourCStart)==0) THEN      IF ((ourCEnd-ourCStart)==0) THEN
288         ! nothing in current subrange         ! nothing in current subrange
289         IF ((ourRWCP==(-1)) .OR. (ourCStart==ourStepOf(0))) THEN         IF ((ourRWCP==(-1)) .OR. (ourCStart==ourStepOf(0))) THEN
290            ! we are done            ! we are done
291            ourRWCP = ourRWCP - 1            ourRWCP = ourRWCP - 1
292              IF (ourVerbosity>2) THEN
293                 WRITE (*,FMT='(A)') ' done'
294              END IF
295            IF (ourVerbosity>0) THEN            IF (ourVerbosity>0) THEN
296               WRITE (*,'(A)') 'summary:'               WRITE (*,'(A)') 'summary:'
297               WRITE (*,'(A,I8)') ' forward steps:', ourNumFwd               WRITE (*,'(A,I8)') ' overhead forward steps:', ourNumFwd
298               WRITE (*,'(A,I8)') ' CP stores    :', ourNumStore               WRITE (*,'(A,I8)') ' CP stores             :', ourNumStore
299               WRITE (*,'(A,I8)') ' invocations  :', ourNumInv               WRITE (*,'(A,I8)') ' rvNextAction calls    :', ourNumInv
300            END IF            END IF
301            rvNextAction%actionFlag = rvDone            rvNextAction%actionFlag = rvDone
302          ELSE          ELSE
# Line 159  CONTAINS Line 318  CONTAINS
318          ourRWCP = ourRWCP + 1          ourRWCP = ourRWCP + 1
319          IF (ourRWCP+1>ourACP) THEN          IF (ourRWCP+1>ourACP) THEN
320             rvNextAction%actionFlag = rvError             rvNextAction%actionFlag = rvError
321             rvNextAction%errorMsg='insufficient allowed checkpoints'             rvNextAction%errorMsg='revolve::rvNextAction: insufficient allowed checkpoints'
322             RETURN             RETURN
323          ELSE          ELSE
324             ourStepOf(ourRWCP) = ourCStart             ourStepOf(ourRWCP) = ourCStart
# Line 169  CONTAINS Line 328  CONTAINS
328          END IF          END IF
329       ELSE IF ((ourPrevCEnd<ourCEnd) .AND. (ourACP==ourRWCP+1)) THEN       ELSE IF ((ourPrevCEnd<ourCEnd) .AND. (ourACP==ourRWCP+1)) THEN
330          rvNextAction%actionFlag = rvError          rvNextAction%actionFlag = rvError
331          rvNextAction%errorMsg='insufficient allowed checkpoints'          rvNextAction%errorMsg='revolve::rvNextAction: insufficient allowed checkpoints'
332       ELSE       ELSE
         prevCStart = ourCStart  
333          availCP = ourACP - ourRWCP          availCP = ourACP - ourRWCP
334          IF (availCP<1) THEN          IF (availCP<1) THEN
335             rvNextAction%actionFlag = rvError             rvNextAction%actionFlag = rvError
336             rvNextAction%errorMsg='insufficient allowed checkpoints'             rvNextAction%errorMsg='revolve::rvNextAction: insufficient allowed checkpoints'
337          ELSE          ELSE
338             reps = 0             reps = 0
339             range = 1             range = 1
# Line 214  CONTAINS Line 372  CONTAINS
372            IF (ourCStart==prevCStart) THEN            IF (ourCStart==prevCStart) THEN
373              ourCStart = prevCStart + 1              ourCStart = prevCStart + 1
374            END IF            END IF
375            ourNumFwd = ourNumFwd + ourCStart - prevCStart            IF (ourCStart==ourSteps) THEN
376                 ourNumFwd = ourNumFwd + ((ourCStart-1) - prevCStart)*ourBundle + ourTail
377              ELSE
378                 ourNumFwd = ourNumFwd + (ourCStart - prevCStart)*ourBundle
379              END IF
380            rvNextAction%actionFlag = rvForward            rvNextAction%actionFlag = rvForward
381          END IF          END IF
382        END IF        END IF
383        rvNextAction%iteration=ourCStart        rvNextAction%startIteration=prevCStart*ourBundle
384        IF (rvNextAction%actionFlag /= rvError .AND. rvNextAction%actionFlag /= rvDone) THEN        IF (rvNextAction%actionFlag==rvFirstUTurn) THEN
385             rvNextAction%iteration=(ourCStart)*ourBundle+ourTail
386          ELSE IF (rvNextAction%actionFlag==rvUTurn) THEN
387             rvNextAction%iteration=(ourCStart+1)*ourBundle
388          ELSE
389             rvNextAction%iteration=(ourCStart)*ourBundle
390          END IF
391          IF (rvNextAction%actionFlag /= rvError) THEN
392           IF (ourVerbosity>2) THEN           IF (ourVerbosity>2) THEN
393              SELECT CASE( rvNextAction%actionFlag)              SELECT CASE( rvNextAction%actionFlag)
394              CASE (rvForward)              CASE (rvForward)
395                 WRITE (*,FMT='(A)',ADVANCE='NO') ' forward to  :'                 WRITE (*,FMT='(A,I8,A,I8,A)') ' run forward iterations    [', &
396                   rvNextAction%startIteration, ',', rvNextAction%iteration-1,']'
397              CASE (rvRestore)              CASE (rvRestore)
398                 WRITE (*,FMT='(A)',ADVANCE='NO') ' restore at  :'                 WRITE (*,FMT='(A,I8)')        ' restore input of iteration ',&
399                   rvNextAction%iteration
400              CASE (rvFirstUTurn)              CASE (rvFirstUTurn)
401                 WRITE (*,FMT='(A)',ADVANCE='NO') ' 1st uturn at:'                 WRITE (*,FMT='(A,I8,A,I8,A)') ' 1st uturn for iterations  [',&
402                   rvNextAction%startIteration, ',', rvNextAction%iteration-1,']'
403              CASE(rvUTurn)                    CASE(rvUTurn)      
404                 WRITE (*,FMT='(A)',ADVANCE='NO') ' uturn at    :'                 WRITE (*,FMT='(A,I8,A,I8,A)') ' uturn for iterations      [',&
405                   rvNextAction%startIteration, ',', rvNextAction%iteration-1,']'
406              END SELECT              END SELECT
407           END IF           END IF
408           IF (ourVerbosity>1) THEN           IF ((ourVerbosity>1) .AND. (rvNextAction%actionFlag == rvStore)) THEN
409              IF (rvNextAction%actionFlag == rvStore) THEN                  WRITE (*,FMT='(A,I8)')        ' store input of iteration   ',&
410                 WRITE (*,FMT='(A)',ADVANCE='NO') ' store at    :'                  rvNextAction%iteration
             END IF  
             WRITE (*,'(I8)') rvNextAction%iteration  
411           END IF           END IF
412        END IF        END IF
413        rvNextAction%cpNum=ourRWCP        rvNextAction%cpNum=ourRWCP
414      END FUNCTION rvNextAction      END FUNCTION rvNextAction
415    
416  !--------------------------------------------------------------------*  !--------------------------------------------------------------------*
417        !> estimates the number of checkpoints required; equivalent to `adjust` in Alg. 799
418      FUNCTION rvGuess(steps)      !! @param steps is the number of iterations
419        !! @param bundle is optional; detaults to 1, if specified indicates the number of iterations bundled in one tape/adjoint sweep
420        !! @return the number of checkpoints such that the growth in spatial complexity is balanced with the  growth in temporal complexity
421        !!
422        !! this method does not change the internal state and does not require \ref rvInit
423        FUNCTION rvGuess(steps,bundle)
424      IMPLICIT NONE      IMPLICIT NONE
425        INTEGER :: steps        INTEGER, INTENT(IN) :: steps, bundle
426        INTEGER :: reps, s, checkpoints        OPTIONAL :: bundle
427          INTEGER :: reps, s, checkpoints, b, tail, bSteps
428        INTEGER :: rvGuess        INTEGER :: rvGuess
429        checkpoints = 1        b=1
430        reps = 1        bSteps=steps
431        s = 0        IF (present(bundle)) THEN
432        DO WHILE (chkRange(checkpoints+s,reps+s)>steps)           b=bundle
433          s = s - 1        END IF
434        END DO        IF (steps<1) THEN
435        DO WHILE (chkRange(checkpoints+s,reps+s)<steps)          WRITE (*,fmt=*) 'revolve::rvGuess: error: steps < 1'
436          s = s + 1          rvGuess = -1
437        END DO        ELSE IF (b<1) THEN
438        checkpoints = checkpoints + s          WRITE (*,fmt=*) 'revolve::rvGuess: error: bundle < 1'
439        reps = reps + s          rvGuess = -1
440        s = -1        ELSE
441        DO WHILE (chkRange(checkpoints,reps)>=steps)          IF (b .gt. 1) THEN
442          IF (checkpoints>reps) THEN            tail=modulo(bSteps,b)
443            checkpoints = checkpoints - 1            bSteps=bSteps/b
444            s = 0            IF (tail>0) THEN
445                bSteps=bSteps+1
446              END IF
447            END IF
448            IF (bSteps==1) THEN
449              rvGuess=0
450          ELSE          ELSE
451            reps = reps - 1            checkpoints = 1
452            s = 1            reps = 1
453              s = 0
454              DO WHILE (chkRange(checkpoints+s,reps+s)>bSteps)
455                s = s - 1
456              END DO
457              DO WHILE (chkRange(checkpoints+s,reps+s)<bSteps)
458                s = s + 1
459              END DO
460              checkpoints = checkpoints + s
461              reps = reps + s
462              s = -1
463              DO WHILE (chkRange(checkpoints,reps)>=bSteps)
464                IF (checkpoints>reps) THEN
465                  checkpoints = checkpoints - 1
466                  s = 0
467                ELSE
468                  reps = reps - 1
469                  s = 1
470                END IF
471              END DO
472              IF (s==0) THEN
473                checkpoints = checkpoints + 1
474              END IF
475              IF (s==1) reps = reps + 1
476              rvGuess = checkpoints
477          END IF          END IF
       END DO  
       IF (s==0) THEN  
         checkpoints = checkpoints + 1  
478        END IF        END IF
       IF (s==1) reps = reps + 1  
       rvGuess = checkpoints  
479      END FUNCTION rvGuess      END FUNCTION rvGuess
480    
481  !--------------------------------------------------------------------*  !--------------------------------------------------------------------*
482        !> computes the run time overhead factor; equivalent to `expense` in Alg. 799
483      FUNCTION rvFactor(steps,checkpoints)      !! @param steps is the number of iterations
484        !! @param checkpoints is the number of allowed checkpoints
485        !! @param bundle is optional; detaults to 1, if specified indicates the number of iterations bundled in one tape/adjoint sweep
486        !! @return the estimated runtime overhead factor (does not account for the time needed to write checkpoints)
487        !!
488        !! this method does not change the internal state and does not require \ref rvInit
489        FUNCTION rvFactor(steps,checkpoints,bundle)
490      IMPLICIT NONE      IMPLICIT NONE
491        INTEGER :: checkpoints, steps        INTEGER, INTENT(IN) :: checkpoints, steps, bundle
492          OPTIONAL :: bundle
493          INTEGER :: b, f
494        DOUBLE PRECISION :: rvFactor        DOUBLE PRECISION :: rvFactor
495        IF (checkpoints<1) THEN        b=1
496          WRITE (*,fmt=*) 'error occurs in RVFACTOR: CHECKPOINTS < 1'        IF (present(bundle)) THEN
497          rvFactor = -1           b=bundle
498        ELSE IF (checkpoints<1) THEN        END IF
499          WRITE (*,fmt=*) 'error occurs in RVFACTOR: CHECKPOINTS < 1'        f=forwdCount(steps,checkpoints,b)
500          rvFactor = -1        IF (f==-1)  THEN
501            WRITE (*,fmt=*) 'revolve::rvFactor: error returned by  revolve::forwdCount'
502            rvFactor=-1
503        ELSE        ELSE
504          rvFactor = dble(forwdCount(steps,checkpoints))          rvFactor = dble(f)/steps
         IF (rvFactor/=-1) rvFactor = rvFactor/steps  
505        END IF        END IF
506      END FUNCTION rvFactor      END FUNCTION rvFactor
507    
508  !--------------------------------------------------------------------*  !--------------------------------------------------------------------*
509        !> internal method not to be referenced by the user
510      FUNCTION chkRange(ss,tt)      FUNCTION chkRange(ss,tt)
511      IMPLICIT NONE      IMPLICIT NONE
512        INTEGER :: ss, tt        INTEGER :: ss, tt
# Line 305  CONTAINS Line 515  CONTAINS
515        INTEGER :: chkRange        INTEGER :: chkRange
516        res = 1.        res = 1.
517        IF (tt<0 .OR. ss<0) THEN        IF (tt<0 .OR. ss<0) THEN
518          WRITE (*,fmt=*) 'error in MAXRANGE: negative parameter '          WRITE (*,fmt=*) 'revolve::chkRange: error: negative parameter '
519          chkRange = -1          chkRange = -1
520        ELSE        ELSE
521          DO i = 1, tt          DO i = 1, tt
# Line 317  CONTAINS Line 527  CONTAINS
527            chkRange = res            chkRange = res
528          ELSE          ELSE
529            chkRange = 2.0D0**31 - 3            chkRange = 2.0D0**31 - 3
530            WRITE (*,fmt=*) 'warning from  MAXRANGE: returned maximal integer'            WRITE (*,fmt=*) 'revolve::chkRange: warning: returning maximal integer ',&
531            WRITE (*,fmt=*) chkRange            chkRange
532          END IF          END IF
533        END IF        END IF
534      END FUNCTION chkRange      END FUNCTION chkRange
535    
536  !--------------------------------------------------------------------*  !--------------------------------------------------------------------*
537    
538      FUNCTION forwdCount(steps,checkpoints)      !> internal method not to be referenced by the user;
539        !> predicts the  number of recomputation-from-checkpoint forwards steps (overhead)
540        FUNCTION forwdCount(steps,checkpoints,bundle)
541      IMPLICIT NONE      IMPLICIT NONE
542        INTEGER :: checkpoints, steps        INTEGER, INTENT(IN) :: checkpoints, steps, bundle
543        INTEGER :: range, reps        INTEGER :: range, reps,s,tail
544        INTEGER :: forwdCount        INTEGER :: forwdCount
545        IF (checkpoints<1) THEN        IF (checkpoints<0) THEN
546            WRITE (*,fmt=*) 'revolve::forwdCount: error: checkpoints < 0'
547            forwdCount = -1
548          ELSE IF (steps<1) THEN
549            WRITE (*,fmt=*) 'revolve::forwdCount: error: steps < 1'
550            forwdCount = -1
551          ELSE IF (bundle<1) THEN
552            WRITE (*,fmt=*) 'revolve::forwdCount: error: bundle < 1'
553          forwdCount = -1          forwdCount = -1
554        ELSE        ELSE
555          reps = 0          s=steps
556          range = 1          IF (bundle .gt. 1) THEN
557          DO WHILE (range<steps)            tail=modulo(s,bundle)
558            reps = reps + 1            s=s/bundle
559            range = range*(reps+checkpoints)/reps            IF (tail>0) THEN
560          END DO              s=s+1
561          forwdCount = reps*steps - range*reps/(checkpoints+1)            END IF
562            END IF
563            IF (s==1) THEN
564              forwdCount = 0
565            ELSE IF (checkpoints==0) THEN
566              WRITE (*,fmt=*) &
567              'revolve::forwdCount: error: given inputs require checkpoints>0'
568              forwdCount = -1
569            ELSE
570              reps = 0
571              range = 1
572              DO WHILE (range<s)
573                reps = reps + 1
574                range = range*(reps+checkpoints)/reps
575              END DO
576              forwdCount = (reps*s - range*reps/(checkpoints+1))*bundle
577            END IF
578        END IF        END IF
579      END FUNCTION forwdCount      END FUNCTION forwdCount
580    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22