| 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, rvGuess, rvFactor, & |
| 21 |
rvStore, rvRestore, rvForward, rvFirstUTurn, rvUTurn, rvDone, rvError |
| 22 |
|
| 23 |
PRIVATE :: & |
| 24 |
ourSteps, ourACP, ourCStart, ourCEnd, ourVerbosity, & |
| 25 |
ourNumFwd , ourNumInv, ourNumStore, ourRWCP, ourPrevCEnd, ourFirstUTurned, & |
| 26 |
chkRange, forwdCount |
| 27 |
|
| 28 |
!> store a checkpoint now |
| 29 |
!! equivalent to TAKESHOT in Alg. 799 |
| 30 |
INTEGER, PARAMETER :: rvStore =1 |
| 31 |
|
| 32 |
!> restore a checkpoint now |
| 33 |
!! equivalent to RESTORE in Alg. 799 |
| 34 |
INTEGER, PARAMETER :: rvRestore =2 |
| 35 |
|
| 36 |
!> execute iteration(s) forward |
| 37 |
!! equivalent to ADVANCE in Alg. 799 |
| 38 |
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 |
| 43 |
|
| 44 |
!> tape iteration(s) and do the adjoint(s) |
| 45 |
!! equivalent to YOUTURN in Alg. 799 |
| 46 |
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 |
| 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 |
| 56 |
|
| 57 |
!> this encapsulates all the information needed to perfrom the correct action |
| 58 |
!! an instance is returned from \ref rvNextAction |
| 59 |
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 |
| 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 |
| 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 |
| 92 |
|
| 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 |
| 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 |
| 102 |
|
| 103 |
!> the number of iterations that may be bundled for a taping/adjoining sweep; |
| 104 |
!! set by calling \ref rvInit; not supposed to be set/used directly by the user; |
| 105 |
!! |
| 106 |
!! the default is 1 loop iteration which makes it equivalent to Alg. 799 |
| 107 |
INTEGER :: ourBundle = 1 |
| 108 |
|
| 109 |
!> the number of iterations in the last bundle |
| 110 |
!! set by calling \ref rvInit; not supposed to be set/used directly by the user; |
| 111 |
!! |
| 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 |
| 157 |
|
| 158 |
!> for debugging purposes; values imply: |
| 159 |
!! - 0 includes errors |
| 160 |
!! - 1 includes summary info |
| 161 |
!! - 2 includes iterations with checkpoints stored |
| 162 |
!! - 3 includes all action results |
| 163 |
!! |
| 164 |
!! set via \ref rvVerbose |
| 165 |
INTEGER :: ourVerbosity = 0 |
| 166 |
|
| 167 |
CONTAINS |
| 168 |
|
| 169 |
!--------------------------------------------------------------------* |
| 170 |
|
| 171 |
!> 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 |
| 180 |
LOGICAL :: rvInit |
| 181 |
INTEGER, INTENT(IN) :: steps |
| 182 |
INTEGER, INTENT(IN) :: checkpoints |
| 183 |
CHARACTER(*), INTENT(OUT) :: errorMsg |
| 184 |
type(rvAction), optional :: anActionInstance |
| 185 |
INTEGER, INTENT(IN), optional :: bundle |
| 186 |
INTEGER :: predFwdCnt ! predicted forward count |
| 187 |
rvInit = .TRUE. |
| 188 |
errorMsg ='none' |
| 189 |
IF (present(anActionInstance)) THEN |
| 190 |
! same as default init above |
| 191 |
anActionInstance%actionFlag = 0 |
| 192 |
anActionInstance%iteration = 0 |
| 193 |
anActionInstance%cpNum = 0 |
| 194 |
END IF |
| 195 |
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. |
| 203 |
errorMsg = 'revolve::rvInit: negative steps' |
| 204 |
ELSEIF (checkpoints<0) THEN |
| 205 |
rvInit=.FALSE. |
| 206 |
errorMsg = 'revolve::rvInit: negative checkpoints' |
| 207 |
ELSE |
| 208 |
ourCStart = 0 |
| 209 |
ourSteps = steps |
| 210 |
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 |
| 221 |
ourNumFwd = 0 |
| 222 |
ourNumInv = 0 |
| 223 |
ourNumStore = 0 |
| 224 |
ourRWCP = -1 |
| 225 |
ourPrevCEnd = 0 |
| 226 |
ourFirstUTurned = .FALSE. |
| 227 |
|
| 228 |
IF (ALLOCATED(ourStepOf)) THEN |
| 229 |
DEALLOCATE(ourStepOf) |
| 230 |
END IF |
| 231 |
IF(.NOT.ALLOCATED(ourStepOf)) THEN |
| 232 |
ALLOCATE(ourStepOf(0:ourACP)) |
| 233 |
END IF |
| 234 |
|
| 235 |
IF (ourVerbosity>0) THEN |
| 236 |
predFwdCnt = forwdCount(steps,ourACP,ourBundle) |
| 237 |
IF (predFwdCnt==-1) THEN |
| 238 |
errorMsg='revolve::rvInit: error returned by revolve::forwdCount' |
| 239 |
rvInit=.FALSE. |
| 240 |
RETURN |
| 241 |
ELSE |
| 242 |
WRITE (*,'(A)') 'prediction:' |
| 243 |
WRITE (*,'(A,I7)') ' overhead forward steps : ', predFwdCnt |
| 244 |
WRITE (*,'(A,F8.4)') ' overhead factor : ', dble(predFwdCnt)/(steps) |
| 245 |
END IF |
| 246 |
END IF |
| 247 |
END IF |
| 248 |
END FUNCTION rvInit |
| 249 |
|
| 250 |
!--------------------------------------------------------------------* |
| 251 |
|
| 252 |
!> method to set the verbosity to a level in [0-3] as described for `ourVerbosity` |
| 253 |
SUBROUTINE rvVerbose(level) |
| 254 |
IMPLICIT NONE |
| 255 |
INTEGER, INTENT(IN) :: level |
| 256 |
ourVerbosity=level |
| 257 |
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() |
| 265 |
IMPLICIT NONE |
| 266 |
REAL :: bino1, bino2, bino3, bino4, bino5 |
| 267 |
|
| 268 |
!> available checkpoint slots |
| 269 |
INTEGER :: availCP |
| 270 |
|
| 271 |
!> local copy of previous subrange start |
| 272 |
INTEGER :: prevCStart |
| 273 |
|
| 274 |
INTEGER :: range |
| 275 |
INTEGER :: reps |
| 276 |
INTEGER :: i |
| 277 |
INTEGER :: ourRWCPinBd |
| 278 |
type(rvAction) :: rvNextAction |
| 279 |
IF (ourNumInv==0) THEN |
| 280 |
! first invocation |
| 281 |
DO i = 0, ourACP |
| 282 |
ourStepOf(i) = 0 |
| 283 |
END DO |
| 284 |
ourStepOf(0) = ourCStart - 1 |
| 285 |
END IF |
| 286 |
prevCStart = ourCStart |
| 287 |
ourNumInv = ourNumInv + 1 |
| 288 |
! make sure ourRWCPinBd stay within bounds of array ourStepOf: |
| 289 |
ourRWCPinBd = MIN( MAX( ourRWCP, 0 ), ourACP ) |
| 290 |
IF ((ourCEnd-ourCStart)==0) THEN |
| 291 |
! nothing in current subrange |
| 292 |
IF ((ourRWCP==(-1)) .OR. (ourCStart==ourStepOf(0))) THEN |
| 293 |
! we are done |
| 294 |
ourRWCP = ourRWCP - 1 |
| 295 |
IF (ourVerbosity>2) THEN |
| 296 |
WRITE (*,FMT='(A)') ' done' |
| 297 |
END IF |
| 298 |
IF (ourVerbosity>0) THEN |
| 299 |
WRITE (*,'(A)') 'summary:' |
| 300 |
WRITE (*,'(A,I8)') ' overhead forward steps:', ourNumFwd |
| 301 |
WRITE (*,'(A,I8)') ' CP stores :', ourNumStore |
| 302 |
WRITE (*,'(A,I8)') ' rvNextAction calls :', ourNumInv |
| 303 |
END IF |
| 304 |
rvNextAction%actionFlag = rvDone |
| 305 |
ELSE |
| 306 |
ourCStart = ourStepOf(ourRWCP) |
| 307 |
ourPrevCEnd = ourCEnd |
| 308 |
rvNextAction%actionFlag = rvRestore |
| 309 |
END IF |
| 310 |
ELSE IF ((ourCEnd-ourCStart)==1) THEN |
| 311 |
ourCEnd = ourCEnd - 1 |
| 312 |
ourPrevCEnd = ourCEnd |
| 313 |
IF ((ourRWCP>=0) .AND. (ourStepOf(ourRWCP)==ourCStart)) ourRWCP = ourRWCP - 1 |
| 314 |
IF (.NOT.ourFirstUTurned) THEN |
| 315 |
rvNextAction%actionFlag = rvFirstUTurn |
| 316 |
ourFirstUTurned = .TRUE. |
| 317 |
ELSE |
| 318 |
rvNextAction%actionFlag = rvUTurn |
| 319 |
END IF |
| 320 |
ELSE IF ((ourRWCP==(-1)) .OR. (ourStepOf(ourRWCPinBd)/=ourCStart)) THEN |
| 321 |
ourRWCP = ourRWCP + 1 |
| 322 |
IF (ourRWCP+1>ourACP) THEN |
| 323 |
rvNextAction%actionFlag = rvError |
| 324 |
rvNextAction%errorMsg='revolve::rvNextAction: insufficient allowed checkpoints' |
| 325 |
RETURN |
| 326 |
ELSE |
| 327 |
ourStepOf(ourRWCP) = ourCStart |
| 328 |
ourNumStore = ourNumStore + 1 |
| 329 |
ourPrevCEnd = ourCEnd |
| 330 |
rvNextAction%actionFlag = rvStore |
| 331 |
END IF |
| 332 |
ELSE IF ((ourPrevCEnd<ourCEnd) .AND. (ourACP==ourRWCP+1)) THEN |
| 333 |
rvNextAction%actionFlag = rvError |
| 334 |
rvNextAction%errorMsg='revolve::rvNextAction: insufficient allowed checkpoints' |
| 335 |
ELSE |
| 336 |
availCP = ourACP - ourRWCP |
| 337 |
IF (availCP<1) THEN |
| 338 |
rvNextAction%actionFlag = rvError |
| 339 |
rvNextAction%errorMsg='revolve::rvNextAction: insufficient allowed checkpoints' |
| 340 |
ELSE |
| 341 |
reps = 0 |
| 342 |
range = 1 |
| 343 |
DO WHILE (range<ourCEnd-ourCStart) |
| 344 |
reps = reps + 1 |
| 345 |
range = range*(reps+availCP)/reps |
| 346 |
END DO |
| 347 |
bino1 = range*reps/(availCP+reps) |
| 348 |
IF (availCP>1) THEN |
| 349 |
bino2 = bino1*availCP/(availCP+reps-1) |
| 350 |
ELSE |
| 351 |
bino2 = 1 |
| 352 |
END IF |
| 353 |
IF (availCP==1) THEN |
| 354 |
bino3 = 0 |
| 355 |
ELSE IF (availCP>2) THEN |
| 356 |
bino3 = bino2*(availCP-1)/(availCP+reps-2) |
| 357 |
ELSE |
| 358 |
bino3 = 1 |
| 359 |
END IF |
| 360 |
bino4 = bino2*(reps-1)/availCP |
| 361 |
IF (availCP<3) THEN |
| 362 |
bino5 = 0 |
| 363 |
ELSE IF (availCP>3) THEN |
| 364 |
bino5 = bino3*(availCP-1)/reps |
| 365 |
ELSE |
| 366 |
bino5 = 1 |
| 367 |
END IF |
| 368 |
IF (ourCEnd-ourCStart<=bino1+bino3) THEN |
| 369 |
ourCStart = ourCStart + bino4 |
| 370 |
ELSE IF (ourCEnd-ourCStart>=range-bino5) THEN |
| 371 |
ourCStart = ourCStart + bino1 |
| 372 |
ELSE |
| 373 |
ourCStart = ourCEnd - bino2 - bino3 |
| 374 |
END IF |
| 375 |
IF (ourCStart==prevCStart) THEN |
| 376 |
ourCStart = prevCStart + 1 |
| 377 |
END IF |
| 378 |
IF (ourCStart==ourSteps) THEN |
| 379 |
ourNumFwd = ourNumFwd + ((ourCStart-1) - prevCStart)*ourBundle + ourTail |
| 380 |
ELSE |
| 381 |
ourNumFwd = ourNumFwd + (ourCStart - prevCStart)*ourBundle |
| 382 |
END IF |
| 383 |
rvNextAction%actionFlag = rvForward |
| 384 |
END IF |
| 385 |
END IF |
| 386 |
rvNextAction%startIteration=prevCStart*ourBundle |
| 387 |
IF (rvNextAction%actionFlag==rvFirstUTurn) THEN |
| 388 |
rvNextAction%iteration=(ourCStart)*ourBundle+ourTail |
| 389 |
ELSE IF (rvNextAction%actionFlag==rvUTurn) THEN |
| 390 |
rvNextAction%iteration=(ourCStart+1)*ourBundle |
| 391 |
ELSE |
| 392 |
rvNextAction%iteration=(ourCStart)*ourBundle |
| 393 |
END IF |
| 394 |
IF (rvNextAction%actionFlag /= rvError) THEN |
| 395 |
IF (ourVerbosity>2) THEN |
| 396 |
SELECT CASE( rvNextAction%actionFlag) |
| 397 |
CASE (rvForward) |
| 398 |
WRITE (*,FMT='(A,I8,A,I8,A)') ' run forward iterations [', & |
| 399 |
rvNextAction%startIteration, ',', rvNextAction%iteration-1,']' |
| 400 |
CASE (rvRestore) |
| 401 |
WRITE (*,FMT='(A,I8)') ' restore input of iteration ',& |
| 402 |
rvNextAction%iteration |
| 403 |
CASE (rvFirstUTurn) |
| 404 |
WRITE (*,FMT='(A,I8,A,I8,A)') ' 1st uturn for iterations [',& |
| 405 |
rvNextAction%startIteration, ',', rvNextAction%iteration-1,']' |
| 406 |
CASE(rvUTurn) |
| 407 |
WRITE (*,FMT='(A,I8,A,I8,A)') ' uturn for iterations [',& |
| 408 |
rvNextAction%startIteration, ',', rvNextAction%iteration-1,']' |
| 409 |
END SELECT |
| 410 |
END IF |
| 411 |
IF ((ourVerbosity>1) .AND. (rvNextAction%actionFlag == rvStore)) THEN |
| 412 |
WRITE (*,FMT='(A,I8)') ' store input of iteration ',& |
| 413 |
rvNextAction%iteration |
| 414 |
END IF |
| 415 |
END IF |
| 416 |
rvNextAction%cpNum=ourRWCP |
| 417 |
END FUNCTION rvNextAction |
| 418 |
|
| 419 |
!--------------------------------------------------------------------* |
| 420 |
!> estimates the number of checkpoints required; equivalent to `adjust` in Alg. 799 |
| 421 |
!! @param steps is the number of iterations |
| 422 |
!! @param bundle is optional; detaults to 1, if specified indicates the number of iterations bundled in one tape/adjoint sweep |
| 423 |
!! @return the number of checkpoints such that the growth in spatial complexity is balanced with the growth in temporal complexity |
| 424 |
!! |
| 425 |
!! this method does not change the internal state and does not require \ref rvInit |
| 426 |
FUNCTION rvGuess(steps,bundle) |
| 427 |
IMPLICIT NONE |
| 428 |
INTEGER, INTENT(IN) :: steps, bundle |
| 429 |
OPTIONAL :: bundle |
| 430 |
INTEGER :: reps, s, checkpoints, b, tail, bSteps |
| 431 |
INTEGER :: rvGuess |
| 432 |
b=1 |
| 433 |
bSteps=steps |
| 434 |
IF (present(bundle)) THEN |
| 435 |
b=bundle |
| 436 |
END IF |
| 437 |
IF (steps<1) THEN |
| 438 |
WRITE (*,fmt=*) 'revolve::rvGuess: error: steps < 1' |
| 439 |
rvGuess = -1 |
| 440 |
ELSE IF (b<1) THEN |
| 441 |
WRITE (*,fmt=*) 'revolve::rvGuess: error: bundle < 1' |
| 442 |
rvGuess = -1 |
| 443 |
ELSE |
| 444 |
IF (b .gt. 1) THEN |
| 445 |
tail=modulo(bSteps,b) |
| 446 |
bSteps=bSteps/b |
| 447 |
IF (tail>0) THEN |
| 448 |
bSteps=bSteps+1 |
| 449 |
END IF |
| 450 |
END IF |
| 451 |
IF (bSteps==1) THEN |
| 452 |
rvGuess=0 |
| 453 |
ELSE |
| 454 |
checkpoints = 1 |
| 455 |
reps = 1 |
| 456 |
s = 0 |
| 457 |
DO WHILE (chkRange(checkpoints+s,reps+s)>bSteps) |
| 458 |
s = s - 1 |
| 459 |
END DO |
| 460 |
DO WHILE (chkRange(checkpoints+s,reps+s)<bSteps) |
| 461 |
s = s + 1 |
| 462 |
END DO |
| 463 |
checkpoints = checkpoints + s |
| 464 |
reps = reps + s |
| 465 |
s = -1 |
| 466 |
DO WHILE (chkRange(checkpoints,reps)>=bSteps) |
| 467 |
IF (checkpoints>reps) THEN |
| 468 |
checkpoints = checkpoints - 1 |
| 469 |
s = 0 |
| 470 |
ELSE |
| 471 |
reps = reps - 1 |
| 472 |
s = 1 |
| 473 |
END IF |
| 474 |
END DO |
| 475 |
IF (s==0) THEN |
| 476 |
checkpoints = checkpoints + 1 |
| 477 |
END IF |
| 478 |
IF (s==1) reps = reps + 1 |
| 479 |
rvGuess = checkpoints |
| 480 |
END IF |
| 481 |
END IF |
| 482 |
END FUNCTION rvGuess |
| 483 |
|
| 484 |
!--------------------------------------------------------------------* |
| 485 |
!> computes the run time overhead factor; equivalent to `expense` in Alg. 799 |
| 486 |
!! @param steps is the number of iterations |
| 487 |
!! @param checkpoints is the number of allowed checkpoints |
| 488 |
!! @param bundle is optional; detaults to 1, if specified indicates the number of iterations bundled in one tape/adjoint sweep |
| 489 |
!! @return the estimated runtime overhead factor (does not account for the time needed to write checkpoints) |
| 490 |
!! |
| 491 |
!! this method does not change the internal state and does not require \ref rvInit |
| 492 |
FUNCTION rvFactor(steps,checkpoints,bundle) |
| 493 |
IMPLICIT NONE |
| 494 |
INTEGER, INTENT(IN) :: checkpoints, steps, bundle |
| 495 |
OPTIONAL :: bundle |
| 496 |
INTEGER :: b, f |
| 497 |
DOUBLE PRECISION :: rvFactor |
| 498 |
b=1 |
| 499 |
IF (present(bundle)) THEN |
| 500 |
b=bundle |
| 501 |
END IF |
| 502 |
f=forwdCount(steps,checkpoints,b) |
| 503 |
IF (f==-1) THEN |
| 504 |
WRITE (*,fmt=*) 'revolve::rvFactor: error returned by revolve::forwdCount' |
| 505 |
rvFactor=-1 |
| 506 |
ELSE |
| 507 |
rvFactor = dble(f)/steps |
| 508 |
END IF |
| 509 |
END FUNCTION rvFactor |
| 510 |
|
| 511 |
!--------------------------------------------------------------------* |
| 512 |
!> internal method not to be referenced by the user |
| 513 |
FUNCTION chkRange(ss,tt) |
| 514 |
IMPLICIT NONE |
| 515 |
INTEGER :: ss, tt |
| 516 |
DOUBLE PRECISION :: res |
| 517 |
INTEGER :: i |
| 518 |
INTEGER :: chkRange |
| 519 |
res = 1. |
| 520 |
IF (tt<0 .OR. ss<0) THEN |
| 521 |
WRITE (*,fmt=*) 'revolve::chkRange: error: negative parameter ' |
| 522 |
chkRange = -1 |
| 523 |
ELSE |
| 524 |
DO i = 1, tt |
| 525 |
res = res*(ss+i) |
| 526 |
res = res/i |
| 527 |
IF (res>=2.0D0**31) EXIT |
| 528 |
END DO |
| 529 |
IF (res<2.0D0**31-2) THEN |
| 530 |
chkRange = res |
| 531 |
ELSE |
| 532 |
chkRange = 2.0D0**31 - 3 |
| 533 |
WRITE (*,fmt=*) 'revolve::chkRange: warning: returning maximal integer ',& |
| 534 |
chkRange |
| 535 |
END IF |
| 536 |
END IF |
| 537 |
END FUNCTION chkRange |
| 538 |
|
| 539 |
!--------------------------------------------------------------------* |
| 540 |
|
| 541 |
!> internal method not to be referenced by the user; |
| 542 |
!> predicts the number of recomputation-from-checkpoint forwards steps (overhead) |
| 543 |
FUNCTION forwdCount(steps,checkpoints,bundle) |
| 544 |
IMPLICIT NONE |
| 545 |
INTEGER, INTENT(IN) :: checkpoints, steps, bundle |
| 546 |
INTEGER :: range, reps,s,tail |
| 547 |
INTEGER :: forwdCount |
| 548 |
IF (checkpoints<0) THEN |
| 549 |
WRITE (*,fmt=*) 'revolve::forwdCount: error: checkpoints < 0' |
| 550 |
forwdCount = -1 |
| 551 |
ELSE IF (steps<1) THEN |
| 552 |
WRITE (*,fmt=*) 'revolve::forwdCount: error: steps < 1' |
| 553 |
forwdCount = -1 |
| 554 |
ELSE IF (bundle<1) THEN |
| 555 |
WRITE (*,fmt=*) 'revolve::forwdCount: error: bundle < 1' |
| 556 |
forwdCount = -1 |
| 557 |
ELSE |
| 558 |
s=steps |
| 559 |
IF (bundle .gt. 1) THEN |
| 560 |
tail=modulo(s,bundle) |
| 561 |
s=s/bundle |
| 562 |
IF (tail>0) THEN |
| 563 |
s=s+1 |
| 564 |
END IF |
| 565 |
END IF |
| 566 |
IF (s==1) THEN |
| 567 |
forwdCount = 0 |
| 568 |
ELSE IF (checkpoints==0) THEN |
| 569 |
WRITE (*,fmt=*) & |
| 570 |
'revolve::forwdCount: error: given inputs require checkpoints>0' |
| 571 |
forwdCount = -1 |
| 572 |
ELSE |
| 573 |
reps = 0 |
| 574 |
range = 1 |
| 575 |
DO WHILE (range<s) |
| 576 |
reps = reps + 1 |
| 577 |
range = range*(reps+checkpoints)/reps |
| 578 |
END DO |
| 579 |
forwdCount = (reps*s - range*reps/(checkpoints+1))*bundle |
| 580 |
END IF |
| 581 |
END IF |
| 582 |
END FUNCTION forwdCount |
| 583 |
|
| 584 |
!--------------------------------------------------------------------* |
| 585 |
|
| 586 |
END MODULE revolve |
Parent Directory
| 
Revision Log
| 
Revision Graph