tools/OAD_support/revolve.F90

47a7f9d346 Jean*0001 !> \mainpage
                0002 !! This is a Fortran9X adaptation of the functionality of Revolve; see Alg. 799 published as \cite Griewank2000ARA .
                0003 !! The interface of the routines differs from the cited revolve implementation
                0004 !! found in Adol-C and has been designed to be more in line with the
                0005 !! Fortran 9X language features. A minor extension is the  optional `bundle` parameter that allows to treat as many loop
                0006 !! iterations in one tape/adjoint sweep. If `bundle` is 1, the default, then the behavior is that of Alg. 799.
                0007 !!
                0008 !! The implementation (written by J. Utke)  is contained in revolve.f90, the use is illustrated in the `Examples` directory.
                0009 !!
                0010 !! The mercurial repository with the latest version can be found at:
                0011 !! <a href="http://mercurial.mcs.anl.gov/ad/RevolveF9X">http://mercurial.mcs.anl.gov/ad/RevolveF9X</a>
                0012 !!
                0013
                0014
                0015 !> the module containing the revolve implementation
                0016 !!
b6f3d01b24 Jean*0017 MODULE revolve
                0018   IMPLICIT NONE
                0019
c287121d4e Jean*0020   PUBLIC :: rvInit, rvVerbose, rvNextAction, &
                0021 rvGuess, rvFactor, &
                0022 rvStore, rvRestore, &
                0023 rvForward, rvFirstUTurn, rvUTurn, rvDone, &
                0024 rvError, rvAdjust
b6f3d01b24 Jean*0025
c287121d4e Jean*0026   PRIVATE :: &
b6f3d01b24 Jean*0027 ourSteps, ourACP, ourCStart, ourCEnd, ourVerbosity, &
c287121d4e Jean*0028 ourNumFwd , ourNumInv, ourNumStore, ourRWCP, ourPrevCEnd, &
                0029 ourFirstUTurned, chkRange, forwdCount
b6f3d01b24 Jean*0030
47a7f9d346 Jean*0031   !> store a checkpoint now
                0032   !! equivalent to TAKESHOT in Alg. 799
c287121d4e Jean*0033   INTEGER, PARAMETER :: rvStore      =1
47a7f9d346 Jean*0034
                0035   !> restore a checkpoint now
                0036   !! equivalent to RESTORE in Alg. 799
b6f3d01b24 Jean*0037   INTEGER, PARAMETER :: rvRestore    =2
47a7f9d346 Jean*0038
                0039   !> execute iteration(s) forward
                0040   !! equivalent to ADVANCE in Alg. 799
b6f3d01b24 Jean*0041   INTEGER, PARAMETER :: rvForward    =3
47a7f9d346 Jean*0042
                0043   !> tape iteration(s); optionally leave to return later;  and (upon return) do the adjoint(s)
                0044   !! equivalent to FIRSTTURN in Alg. 799
b6f3d01b24 Jean*0045   INTEGER, PARAMETER :: rvFirstUTurn =4
47a7f9d346 Jean*0046
                0047   !> tape iteration(s) and do the adjoint(s)
                0048   !! equivalent to YOUTURN in Alg. 799
b6f3d01b24 Jean*0049   INTEGER, PARAMETER :: rvUTurn      =5
47a7f9d346 Jean*0050
                0051   !> we are done with adjoining the loop
                0052   !! equivalent to the `terminate` enum value in Alg. 799
b6f3d01b24 Jean*0053   INTEGER, PARAMETER :: rvDone       =6
47a7f9d346 Jean*0054
                0055   !> an error has occurred
                0056   !! equivalent to the `error` enum value in Alg. 799;
                0057   !! see also `errorMsg` in \ref rvAction
b6f3d01b24 Jean*0058   INTEGER, PARAMETER :: rvError      =7
                0059
47a7f9d346 Jean*0060   !> this encapsulates all the information needed to perfrom the correct action
                0061   !! an instance is returned from \ref rvNextAction
b6f3d01b24 Jean*0062   TYPE rvAction
47a7f9d346 Jean*0063      !> the action that is to be implemented, termination, or error;
                0064      !! the value must be one of:
                0065      !! `rvStore`, `rvRestore`, `rvForward`,
                0066      !! `rvFirstUTurn`, `rvUTurn`, `rvDone`, `rvError`
b6f3d01b24 Jean*0067      INTEGER :: actionFlag = 0
47a7f9d346 Jean*0068
                0069      !> assumptions:
                0070      !! - the loop iterations are numbered in range [0,`ourSteps`-1]
                0071      !! - the model state is the input to the iteration numbered `startIteration`
                0072      !!
                0073      !! the interpretation is as follows based on the value of `actionFlag`:
                0074      !! - `rvForward`: execute iterations as the loop: `do currentIteration=startIteration, iteration-1`
                0075      !! - `rvRestore`: restores model state at `iteration` (here it has the same value as `startIteration`)
                0076      !! - `rvFirstUTurn`/`rvUTurn`: tape iterations in loop: do currentIteration=startIteration, iteration-1`
                0077      !!    followed by adjoint sweep over iterations in loop: do currentIteration=iteration-1,startIteration,-1
                0078      !!
                0079      !! for all other values of `actionFlag` the value of `iteration` is meaningless
b6f3d01b24 Jean*0080      INTEGER :: iteration  = 0
47a7f9d346 Jean*0081
                0082      !> assuming the loop iterations are in [0,ourSteps-1] and `currentIteration` variable is maintained,
                0083      !! the interpretation is as follows based on the value of `actionFlag`:
                0084      !! - `rvForward`: execute iterations as the loop: `do currentIteration, iteration-1`
                0085      !! - `rvRestore`: set `currentIteration=iteration`
                0086      !!
                0087      !! for all other values of `actionFlag` the value of `iteration` is meaningless
                0088      INTEGER :: startIteration = 0
                0089
                0090      !> the checkpoint number to be stored to restored
                0091      !! the value is meaninfull only if `actionFlag` is set to `rvStore` or `rvRestore`;
                0092      !!
                0093      !! This is approximately equivalent to `checks` in Alg. 799.
b6f3d01b24 Jean*0094      INTEGER :: cpNum      = 0
47a7f9d346 Jean*0095
                0096      !> if an error has occurred `actionFlag` will be set to `rvError` and this will contain an error message
                0097      CHARACTER(80) :: errorMsg
b6f3d01b24 Jean*0098   END TYPE rvAction
c287121d4e Jean*0099
47a7f9d346 Jean*0100   !> the number of iteration steps; set by calling \ref rvInit; not supposed to be set/used directly by the user;
                0101   !! note that the iterations are expected to range in [0, ourSteps-1];
                0102   !!
                0103   !! equivalent to `steps` in Alg. 799
b6f3d01b24 Jean*0104   INTEGER :: ourSteps    = 0 ! number of steps
47a7f9d346 Jean*0105
                0106   !> the number of iterations that may be bundled for a taping/adjoining sweep;
                0107   !! set by calling \ref rvInit; not supposed to be set/used directly by the user;
                0108   !!
                0109   !! the default is 1 loop iteration which makes it equivalent to Alg. 799
                0110   INTEGER :: ourBundle   = 1
                0111
                0112   !> the number of iterations in the last bundle
                0113   !! set by calling \ref rvInit; not supposed to be set/used directly by the user;
                0114   !!
                0115   !! the default is 1 (for `ourBundle` = 1)  which makes it equivalent to Alg. 799
                0116   INTEGER :: ourTail   = 1
                0117
                0118   !> the number of checkpoints (ACP=AllowedCheckPoints) that can be stored at any time during the loop execution
                0119   !! set by calling \ref rvInit; not supposed to be set/used directly by the user
                0120   !!
                0121   !! equivalent to `snaps` in Alg. 799
                0122   INTEGER :: ourACP      = 0
                0123
                0124   !> current subrange start;
                0125   !! not to be set/referemced directly by the user
                0126   !!
                0127   !! approximately equivalent to `capo` in Alg. 799
                0128   INTEGER :: ourCStart   = 0
                0129
                0130   !> current subrange end;
                0131   !! not to be set/referemced directly by the user
                0132   !!
                0133   !! approximately equivalent to `fine` in Alg. 799
                0134   INTEGER :: ourCEnd     = 0
                0135
                0136   !> count of the forward steps; diagnostic only
                0137   INTEGER :: ourNumFwd   = 0
                0138
                0139   !> count of invocations to \ref rvNextAction ;  diagnostic only
                0140   INTEGER :: ourNumInv   = 0
                0141
                0142   !> count of checkpoint stores; diagnostic only
                0143   INTEGER :: ourNumStore = 0
                0144
                0145   !> checkpoint currently (re)stored - the first checkpoint is numbered 0;
                0146   !! not to be set/referemced directly by the user
                0147   INTEGER :: ourRWCP     = -1
                0148
                0149   !> previous subrange end;
                0150   !! not to be set/referemced directly by the user
                0151   INTEGER :: ourPrevCEnd = 0
                0152
                0153   !> have we first uturned already?;
                0154   !! not to be set/referemced directly by the user
                0155   LOGICAL :: ourFirstUturned = .FALSE.
                0156
                0157   !> vector of step numbers indexed by checkpoint;
                0158   !! not to be set/referemced directly by the user
b6f3d01b24 Jean*0159   INTEGER, DIMENSION(:), ALLOCATABLE :: ourStepOf
                0160
47a7f9d346 Jean*0161   !> for debugging purposes; values imply:
                0162   !! - 0 includes errors
                0163   !! - 1 includes summary info
                0164   !! - 2 includes iterations with checkpoints stored
                0165   !! - 3 includes all action results
                0166   !!
                0167   !! set via \ref rvVerbose
b6f3d01b24 Jean*0168   INTEGER :: ourVerbosity = 0
                0169
                0170 CONTAINS
                0171
                0172 !--------------------------------------------------------------------*
                0173
47a7f9d346 Jean*0174   !> method to initialize the internal state; must be called before any call to \ref rvNextAction
                0175   !! @param steps  the total number of steps in the iteration; equivalent to `steps` in Alg. 799
                0176   !! @param checkpoints the total number of checkpoints allowed to be stored at any time; equivalent to `snaps` in Alg. 799
                0177   !! @param errorMsg set when an error condition occurs; else set to `"none"`
                0178   !! @param anActionInstance  if supplied initializes its contents
                0179   !! @param bundle if supplied initializes `ourBundle`
                0180   !! @return `.true.` if successfull, else `.false.` ansd `errorMsg` will be set
                0181   FUNCTION rvInit(steps,checkpoints,errorMsg,anActionInstance,bundle)
b6f3d01b24 Jean*0182     IMPLICIT NONE
                0183     LOGICAL :: rvInit
                0184     INTEGER, INTENT(IN) :: steps
                0185     INTEGER, INTENT(IN) :: checkpoints
47a7f9d346 Jean*0186     CHARACTER(*), INTENT(OUT) :: errorMsg
b6f3d01b24 Jean*0187     type(rvAction), optional :: anActionInstance
47a7f9d346 Jean*0188     INTEGER, INTENT(IN), optional :: bundle
c287121d4e Jean*0189     INTEGER :: predFwdCnt ! predicted forward count
b6f3d01b24 Jean*0190     rvInit = .TRUE.
                0191     errorMsg ='none'
                0192     IF (present(anActionInstance)) THEN
                0193        ! same as default init above
                0194        anActionInstance%actionFlag = 0
                0195        anActionInstance%iteration  = 0
                0196        anActionInstance%cpNum      = 0
                0197     END IF
47a7f9d346 Jean*0198     IF (present(bundle)) THEN
                0199        ourBundle = bundle
                0200     END IF
                0201     IF (ourBundle<1 .OR. ourBundle>steps) THEN
                0202        rvInit=.FALSE.
                0203        errorMsg = "revolve::rvInit: bundle parameter out of range [1,steps]"
                0204     ELSEIF (steps<0) THEN
                0205        rvInit=.FALSE.
                0206        errorMsg = 'revolve::rvInit: negative steps'
                0207     ELSEIF (checkpoints<0) THEN
b6f3d01b24 Jean*0208        rvInit=.FALSE.
47a7f9d346 Jean*0209        errorMsg = 'revolve::rvInit: negative checkpoints'
c287121d4e Jean*0210     ELSE
b6f3d01b24 Jean*0211        ourCStart       = 0
                0212        ourSteps        = steps
47a7f9d346 Jean*0213        IF (ourBundle .gt. 1) THEN
                0214           ourTail=modulo(ourSteps,ourBundle)
                0215           ourSteps=ourSteps/ourBundle
                0216           IF (ourTail>0) THEN
                0217              ourSteps=ourSteps+1
                0218           ELSE
                0219              ourTail=ourBundle
                0220           END IF
                0221        END IF
                0222        ourCEnd         = ourSteps
b6f3d01b24 Jean*0223        ourACP          = checkpoints
c287121d4e Jean*0224        ourNumFwd       = 0
                0225        ourNumInv       = 0
                0226        ourNumStore     = 0
                0227        ourRWCP         = -1
                0228        ourPrevCEnd     = 0
b6f3d01b24 Jean*0229        ourFirstUTurned = .FALSE.
                0230
                0231        IF (ALLOCATED(ourStepOf)) THEN
                0232           DEALLOCATE(ourStepOf)
                0233        END IF
                0234        IF(.NOT.ALLOCATED(ourStepOf)) THEN
                0235           ALLOCATE(ourStepOf(0:ourACP))
                0236        END IF
                0237
                0238        IF (ourVerbosity>0) THEN
47a7f9d346 Jean*0239           predFwdCnt = forwdCount(steps,ourACP,ourBundle)
b6f3d01b24 Jean*0240           IF (predFwdCnt==-1) THEN
47a7f9d346 Jean*0241              errorMsg='revolve::rvInit: error returned by  revolve::forwdCount'
                0242              rvInit=.FALSE.
b6f3d01b24 Jean*0243              RETURN
                0244           ELSE
                0245              WRITE (*,'(A)') 'prediction:'
47a7f9d346 Jean*0246              WRITE (*,'(A,I7)')   ' overhead forward steps : ', predFwdCnt
                0247              WRITE (*,'(A,F8.4)') ' overhead factor        : ', dble(predFwdCnt)/(steps)
b6f3d01b24 Jean*0248           END IF
                0249        END IF
                0250     END IF
                0251   END FUNCTION rvInit
                0252
                0253 !--------------------------------------------------------------------*
                0254
c287121d4e Jean*0255   !> method to change the internal state for the total number of steps/checkpoints; must be called after \ref rvInit
                0256   !! @param steps  the total number of steps in the iteration; equivalent to `steps` in Alg. 799
                0257   !! @param errorMsg set when an error condition occurs; else set to `"none"`
                0258   !! @return `.true.` if successfull, else `.false.` ansd `errorMsg` will be set
                0259   FUNCTION rvAdjust(steps,checkpoints,errorMsg)
                0260     IMPLICIT NONE
                0261     LOGICAL :: rvAdjust
                0262     INTEGER, INTENT(IN) :: steps
                0263     INTEGER, INTENT(IN) :: checkpoints
                0264     CHARACTER(*), INTENT(OUT) :: errorMsg
                0265     rvAdjust=.false.
                0266   END FUNCTION
                0267
                0268 !--------------------------------------------------------------------*
                0269
47a7f9d346 Jean*0270   !> method to set the verbosity to a level in [0-3] as described for `ourVerbosity`
b6f3d01b24 Jean*0271   SUBROUTINE rvVerbose(level)
                0272     IMPLICIT NONE
c287121d4e Jean*0273     INTEGER, INTENT(IN) :: level
b6f3d01b24 Jean*0274     ourVerbosity=level
                0275   END SUBROUTINE rvVerbose
                0276
                0277 !--------------------------------------------------------------------*
47a7f9d346 Jean*0278   !> the method to determine the next action; to be called in an unbound loop after \ref rvInit
                0279   !! @return an instance of `rvAction` set to describe the next action (see the member documentation);
                0280   !!
                0281   !! this method modifies the internal state; it is approximately equivalent to the method `revolve` in Alg. 799
b6f3d01b24 Jean*0282   FUNCTION rvNextAction()
                0283     IMPLICIT NONE
                0284     REAL :: bino1, bino2, bino3, bino4, bino5
47a7f9d346 Jean*0285
                0286     !> available checkpoint slots
                0287     INTEGER :: availCP
                0288
                0289     !> local copy of previous subrange start
                0290     INTEGER :: prevCStart
                0291
                0292     INTEGER :: range
b6f3d01b24 Jean*0293     INTEGER :: reps
c287121d4e Jean*0294     INTEGER :: i
                0295     LOGICAL :: rwcpTest
b6f3d01b24 Jean*0296     type(rvAction) :: rvNextAction
                0297     IF (ourNumInv==0) THEN
                0298        ! first invocation
                0299        DO i = 0, ourACP
                0300           ourStepOf(i) = 0
                0301        END DO
                0302        ourStepOf(0) = ourCStart - 1
                0303     END IF
47a7f9d346 Jean*0304     prevCStart = ourCStart
b6f3d01b24 Jean*0305     ourNumInv = ourNumInv + 1
c287121d4e Jean*0306     rwcpTest=(ourRWCP==(-1))
                0307     IF (.not. rwcpTest) THEN
                0308        rwcpTest=(ourStepOf(ourRWCP)/=ourCStart)
                0309     END IF
b6f3d01b24 Jean*0310     IF ((ourCEnd-ourCStart)==0) THEN
                0311        ! nothing in current subrange
                0312        IF ((ourRWCP==(-1)) .OR. (ourCStart==ourStepOf(0))) THEN
                0313           ! we are done
                0314           ourRWCP = ourRWCP - 1
47a7f9d346 Jean*0315           IF (ourVerbosity>2) THEN
                0316              WRITE (*,FMT='(A)') ' done'
                0317           END IF
b6f3d01b24 Jean*0318           IF (ourVerbosity>0) THEN
                0319              WRITE (*,'(A)') 'summary:'
47a7f9d346 Jean*0320              WRITE (*,'(A,I8)') ' overhead forward steps:', ourNumFwd
                0321              WRITE (*,'(A,I8)') ' CP stores             :', ourNumStore
                0322              WRITE (*,'(A,I8)') ' rvNextAction calls    :', ourNumInv
b6f3d01b24 Jean*0323           END IF
                0324           rvNextAction%actionFlag = rvDone
                0325         ELSE
                0326            ourCStart = ourStepOf(ourRWCP)
                0327            ourPrevCEnd = ourCEnd
c287121d4e Jean*0328            rvNextAction%actionFlag = rvRestore
b6f3d01b24 Jean*0329         END IF
                0330      ELSE IF ((ourCEnd-ourCStart)==1) THEN
                0331         ourCEnd = ourCEnd - 1
                0332         ourPrevCEnd = ourCEnd
                0333         IF ((ourRWCP>=0) .AND. (ourStepOf(ourRWCP)==ourCStart)) ourRWCP = ourRWCP - 1
                0334         IF (.NOT.ourFirstUTurned) THEN
                0335            rvNextAction%actionFlag = rvFirstUTurn
                0336            ourFirstUTurned = .TRUE.
                0337         ELSE
                0338            rvNextAction%actionFlag = rvUTurn
                0339         END IF
c287121d4e Jean*0340      ELSE IF (rwcpTest) THEN
b6f3d01b24 Jean*0341         ourRWCP = ourRWCP + 1
                0342         IF (ourRWCP+1>ourACP) THEN
                0343            rvNextAction%actionFlag = rvError
47a7f9d346 Jean*0344            rvNextAction%errorMsg='revolve::rvNextAction: insufficient allowed checkpoints'
b6f3d01b24 Jean*0345            RETURN
                0346         ELSE
                0347            ourStepOf(ourRWCP) = ourCStart
                0348            ourNumStore = ourNumStore + 1
                0349            ourPrevCEnd = ourCEnd
                0350            rvNextAction%actionFlag = rvStore
                0351         END IF
                0352      ELSE IF ((ourPrevCEnd<ourCEnd) .AND. (ourACP==ourRWCP+1)) THEN
                0353         rvNextAction%actionFlag = rvError
47a7f9d346 Jean*0354         rvNextAction%errorMsg='revolve::rvNextAction: insufficient allowed checkpoints'
b6f3d01b24 Jean*0355      ELSE
                0356         availCP = ourACP - ourRWCP
                0357         IF (availCP<1) THEN
                0358            rvNextAction%actionFlag = rvError
47a7f9d346 Jean*0359            rvNextAction%errorMsg='revolve::rvNextAction: insufficient allowed checkpoints'
b6f3d01b24 Jean*0360         ELSE
                0361            reps = 0
                0362            range = 1
                0363            DO WHILE (range<ourCEnd-ourCStart)
                0364               reps = reps + 1
                0365               range = range*(reps+availCP)/reps
                0366            END DO
                0367            bino1 = range*reps/(availCP+reps)
                0368            IF (availCP>1) THEN
                0369             bino2 = bino1*availCP/(availCP+reps-1)
                0370           ELSE
                0371             bino2 = 1
                0372           END IF
                0373           IF (availCP==1) THEN
                0374             bino3 = 0
                0375           ELSE IF (availCP>2) THEN
                0376             bino3 = bino2*(availCP-1)/(availCP+reps-2)
                0377           ELSE
                0378             bino3 = 1
                0379           END IF
                0380           bino4 = bino2*(reps-1)/availCP
                0381           IF (availCP<3) THEN
                0382             bino5 = 0
                0383           ELSE IF (availCP>3) THEN
                0384             bino5 = bino3*(availCP-1)/reps
                0385           ELSE
                0386             bino5 = 1
                0387           END IF
                0388           IF (ourCEnd-ourCStart<=bino1+bino3) THEN
c287121d4e Jean*0389             ourCStart = int(ourCStart + bino4)
b6f3d01b24 Jean*0390           ELSE IF (ourCEnd-ourCStart>=range-bino5) THEN
c287121d4e Jean*0391             ourCStart = int(ourCStart + bino1)
b6f3d01b24 Jean*0392           ELSE
c287121d4e Jean*0393             ourCStart = int(ourCEnd - bino2 - bino3)
b6f3d01b24 Jean*0394           END IF
                0395           IF (ourCStart==prevCStart) THEN
                0396             ourCStart = prevCStart + 1
                0397           END IF
47a7f9d346 Jean*0398           IF (ourCStart==ourSteps) THEN
                0399              ourNumFwd = ourNumFwd + ((ourCStart-1) - prevCStart)*ourBundle + ourTail
                0400           ELSE
                0401              ourNumFwd = ourNumFwd + (ourCStart - prevCStart)*ourBundle
                0402           END IF
b6f3d01b24 Jean*0403           rvNextAction%actionFlag = rvForward
                0404         END IF
                0405       END IF
47a7f9d346 Jean*0406       rvNextAction%startIteration=prevCStart*ourBundle
                0407       IF (rvNextAction%actionFlag==rvFirstUTurn) THEN
                0408          rvNextAction%iteration=(ourCStart)*ourBundle+ourTail
                0409       ELSE IF (rvNextAction%actionFlag==rvUTurn) THEN
                0410          rvNextAction%iteration=(ourCStart+1)*ourBundle
                0411       ELSE
                0412          rvNextAction%iteration=(ourCStart)*ourBundle
                0413       END IF
                0414       IF (rvNextAction%actionFlag /= rvError) THEN
b6f3d01b24 Jean*0415          IF (ourVerbosity>2) THEN
                0416             SELECT CASE( rvNextAction%actionFlag)
                0417             CASE (rvForward)
47a7f9d346 Jean*0418                WRITE (*,FMT='(A,I8,A,I8,A)') ' run forward iterations    [', &
                0419                rvNextAction%startIteration, ',', rvNextAction%iteration-1,']'
b6f3d01b24 Jean*0420             CASE (rvRestore)
47a7f9d346 Jean*0421                WRITE (*,FMT='(A,I8)')        ' restore input of iteration ',&
                0422                rvNextAction%iteration
b6f3d01b24 Jean*0423             CASE (rvFirstUTurn)
47a7f9d346 Jean*0424                WRITE (*,FMT='(A,I8,A,I8,A)') ' 1st uturn for iterations  [',&
                0425                rvNextAction%startIteration, ',', rvNextAction%iteration-1,']'
c287121d4e Jean*0426             CASE(rvUTurn)
47a7f9d346 Jean*0427                WRITE (*,FMT='(A,I8,A,I8,A)') ' uturn for iterations      [',&
                0428                rvNextAction%startIteration, ',', rvNextAction%iteration-1,']'
b6f3d01b24 Jean*0429             END SELECT
                0430          END IF
47a7f9d346 Jean*0431          IF ((ourVerbosity>1) .AND. (rvNextAction%actionFlag == rvStore)) THEN
                0432                 WRITE (*,FMT='(A,I8)')        ' store input of iteration   ',&
                0433                 rvNextAction%iteration
b6f3d01b24 Jean*0434          END IF
                0435       END IF
                0436       rvNextAction%cpNum=ourRWCP
                0437     END FUNCTION rvNextAction
                0438
                0439 !--------------------------------------------------------------------*
47a7f9d346 Jean*0440     !> estimates the number of checkpoints required; equivalent to `adjust` in Alg. 799
                0441     !! @param steps is the number of iterations
                0442     !! @param bundle is optional; detaults to 1, if specified indicates the number of iterations bundled in one tape/adjoint sweep
                0443     !! @return the number of checkpoints such that the growth in spatial complexity is balanced with the  growth in temporal complexity
                0444     !!
                0445     !! this method does not change the internal state and does not require \ref rvInit
                0446     FUNCTION rvGuess(steps,bundle)
b6f3d01b24 Jean*0447     IMPLICIT NONE
47a7f9d346 Jean*0448       INTEGER, INTENT(IN) :: steps, bundle
                0449       OPTIONAL :: bundle
                0450       INTEGER :: reps, s, checkpoints, b, tail, bSteps
b6f3d01b24 Jean*0451       INTEGER :: rvGuess
47a7f9d346 Jean*0452       b=1
                0453       bSteps=steps
                0454       IF (present(bundle)) THEN
                0455          b=bundle
                0456       END IF
                0457       IF (steps<1) THEN
                0458         WRITE (*,fmt=*) 'revolve::rvGuess: error: steps < 1'
                0459         rvGuess = -1
                0460       ELSE IF (b<1) THEN
                0461         WRITE (*,fmt=*) 'revolve::rvGuess: error: bundle < 1'
                0462         rvGuess = -1
                0463       ELSE
                0464         IF (b .gt. 1) THEN
                0465           tail=modulo(bSteps,b)
                0466           bSteps=bSteps/b
                0467           IF (tail>0) THEN
                0468             bSteps=bSteps+1
                0469           END IF
                0470         END IF
                0471         IF (bSteps==1) THEN
                0472           rvGuess=0
b6f3d01b24 Jean*0473         ELSE
47a7f9d346 Jean*0474           checkpoints = 1
                0475           reps = 1
                0476           s = 0
                0477           DO WHILE (chkRange(checkpoints+s,reps+s)>bSteps)
                0478             s = s - 1
                0479           END DO
                0480           DO WHILE (chkRange(checkpoints+s,reps+s)<bSteps)
                0481             s = s + 1
                0482           END DO
                0483           checkpoints = checkpoints + s
                0484           reps = reps + s
                0485           s = -1
                0486           DO WHILE (chkRange(checkpoints,reps)>=bSteps)
                0487             IF (checkpoints>reps) THEN
                0488               checkpoints = checkpoints - 1
                0489               s = 0
                0490             ELSE
                0491               reps = reps - 1
                0492               s = 1
                0493             END IF
                0494           END DO
                0495           IF (s==0) THEN
                0496             checkpoints = checkpoints + 1
                0497           END IF
                0498           IF (s==1) reps = reps + 1
                0499           rvGuess = checkpoints
b6f3d01b24 Jean*0500         END IF
                0501       END IF
                0502     END FUNCTION rvGuess
                0503
                0504 !--------------------------------------------------------------------*
47a7f9d346 Jean*0505     !> computes the run time overhead factor; equivalent to `expense` in Alg. 799
                0506     !! @param steps is the number of iterations
                0507     !! @param checkpoints is the number of allowed checkpoints
                0508     !! @param bundle is optional; detaults to 1, if specified indicates the number of iterations bundled in one tape/adjoint sweep
                0509     !! @return the estimated runtime overhead factor (does not account for the time needed to write checkpoints)
                0510     !!
                0511     !! this method does not change the internal state and does not require \ref rvInit
                0512     FUNCTION rvFactor(steps,checkpoints,bundle)
b6f3d01b24 Jean*0513     IMPLICIT NONE
47a7f9d346 Jean*0514       INTEGER, INTENT(IN) :: checkpoints, steps, bundle
                0515       OPTIONAL :: bundle
                0516       INTEGER :: b, f
b6f3d01b24 Jean*0517       DOUBLE PRECISION :: rvFactor
47a7f9d346 Jean*0518       b=1
                0519       IF (present(bundle)) THEN
                0520          b=bundle
                0521       END IF
                0522       f=forwdCount(steps,checkpoints,b)
                0523       IF (f==-1)  THEN
                0524         WRITE (*,fmt=*) 'revolve::rvFactor: error returned by  revolve::forwdCount'
                0525         rvFactor=-1
b6f3d01b24 Jean*0526       ELSE
47a7f9d346 Jean*0527         rvFactor = dble(f)/steps
b6f3d01b24 Jean*0528       END IF
                0529     END FUNCTION rvFactor
                0530
                0531 !--------------------------------------------------------------------*
47a7f9d346 Jean*0532     !> internal method not to be referenced by the user
b6f3d01b24 Jean*0533     FUNCTION chkRange(ss,tt)
                0534     IMPLICIT NONE
                0535       INTEGER :: ss, tt
                0536       DOUBLE PRECISION :: res
                0537       INTEGER :: i
                0538       INTEGER :: chkRange
                0539       res = 1.
                0540       IF (tt<0 .OR. ss<0) THEN
47a7f9d346 Jean*0541         WRITE (*,fmt=*) 'revolve::chkRange: error: negative parameter '
b6f3d01b24 Jean*0542         chkRange = -1
                0543       ELSE
                0544         DO i = 1, tt
                0545           res = res*(ss+i)
                0546           res = res/i
c287121d4e Jean*0547           IF (res>huge(chkrange)) EXIT
b6f3d01b24 Jean*0548         END DO
c287121d4e Jean*0549         IF (res<huge(chkrange)) THEN
                0550           chkRange = int(res)
b6f3d01b24 Jean*0551         ELSE
c287121d4e Jean*0552           chkRange = huge(chkrange)
47a7f9d346 Jean*0553           WRITE (*,fmt=*) 'revolve::chkRange: warning: returning maximal integer ',&
                0554           chkRange
b6f3d01b24 Jean*0555         END IF
                0556       END IF
                0557     END FUNCTION chkRange
                0558
                0559 !--------------------------------------------------------------------*
                0560
47a7f9d346 Jean*0561     !> internal method not to be referenced by the user;
                0562     !> predicts the  number of recomputation-from-checkpoint forwards steps (overhead)
                0563     FUNCTION forwdCount(steps,checkpoints,bundle)
b6f3d01b24 Jean*0564     IMPLICIT NONE
47a7f9d346 Jean*0565       INTEGER, INTENT(IN) :: checkpoints, steps, bundle
                0566       INTEGER :: range, reps,s,tail
b6f3d01b24 Jean*0567       INTEGER :: forwdCount
47a7f9d346 Jean*0568       IF (checkpoints<0) THEN
                0569         WRITE (*,fmt=*) 'revolve::forwdCount: error: checkpoints < 0'
                0570         forwdCount = -1
                0571       ELSE IF (steps<1) THEN
                0572         WRITE (*,fmt=*) 'revolve::forwdCount: error: steps < 1'
                0573         forwdCount = -1
                0574       ELSE IF (bundle<1) THEN
                0575         WRITE (*,fmt=*) 'revolve::forwdCount: error: bundle < 1'
b6f3d01b24 Jean*0576         forwdCount = -1
                0577       ELSE
47a7f9d346 Jean*0578         s=steps
                0579         IF (bundle .gt. 1) THEN
                0580           tail=modulo(s,bundle)
                0581           s=s/bundle
                0582           IF (tail>0) THEN
                0583             s=s+1
                0584           END IF
                0585         END IF
                0586         IF (s==1) THEN
                0587           forwdCount = 0
                0588         ELSE IF (checkpoints==0) THEN
                0589           WRITE (*,fmt=*) &
                0590           'revolve::forwdCount: error: given inputs require checkpoints>0'
                0591           forwdCount = -1
                0592         ELSE
                0593           reps = 0
                0594           range = 1
                0595           DO WHILE (range<s)
                0596             reps = reps + 1
                0597             range = range*(reps+checkpoints)/reps
                0598           END DO
                0599           forwdCount = (reps*s - range*reps/(checkpoints+1))*bundle
                0600         END IF
b6f3d01b24 Jean*0601       END IF
                0602     END FUNCTION forwdCount
                0603
                0604 !--------------------------------------------------------------------*
                0605
                0606 END MODULE revolve