17 |
MODULE revolve |
MODULE revolve |
18 |
IMPLICIT NONE |
IMPLICIT NONE |
19 |
|
|
20 |
PUBLIC :: rvInit, rvVerbose, rvNextAction, rvGuess, rvFactor, & |
PUBLIC :: rvInit, rvVerbose, rvNextAction, & |
21 |
rvStore, rvRestore, rvForward, rvFirstUTurn, rvUTurn, rvDone, rvError |
rvGuess, rvFactor, & |
22 |
|
rvStore, rvRestore, & |
23 |
|
rvForward, rvFirstUTurn, rvUTurn, rvDone, & |
24 |
|
rvError, rvAdjust |
25 |
|
|
26 |
PRIVATE :: & |
PRIVATE :: & |
27 |
ourSteps, ourACP, ourCStart, ourCEnd, ourVerbosity, & |
ourSteps, ourACP, ourCStart, ourCEnd, ourVerbosity, & |
28 |
ourNumFwd , ourNumInv, ourNumStore, ourRWCP, ourPrevCEnd, ourFirstUTurned, & |
ourNumFwd , ourNumInv, ourNumStore, ourRWCP, ourPrevCEnd, & |
29 |
chkRange, forwdCount |
ourFirstUTurned, chkRange, forwdCount |
30 |
|
|
31 |
!> store a checkpoint now |
!> store a checkpoint now |
32 |
!! equivalent to TAKESHOT in Alg. 799 |
!! equivalent to TAKESHOT in Alg. 799 |
33 |
INTEGER, PARAMETER :: rvStore =1 |
INTEGER, PARAMETER :: rvStore =1 |
34 |
|
|
35 |
!> restore a checkpoint now |
!> restore a checkpoint now |
36 |
!! equivalent to RESTORE in Alg. 799 |
!! equivalent to RESTORE in Alg. 799 |
96 |
!> if an error has occurred `actionFlag` will be set to `rvError` and this will contain an error message |
!> if an error has occurred `actionFlag` will be set to `rvError` and this will contain an error message |
97 |
CHARACTER(80) :: errorMsg |
CHARACTER(80) :: errorMsg |
98 |
END TYPE rvAction |
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; |
!> 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]; |
!! note that the iterations are expected to range in [0, ourSteps-1]; |
102 |
!! |
!! |
186 |
CHARACTER(*), INTENT(OUT) :: errorMsg |
CHARACTER(*), INTENT(OUT) :: errorMsg |
187 |
type(rvAction), optional :: anActionInstance |
type(rvAction), optional :: anActionInstance |
188 |
INTEGER, INTENT(IN), optional :: bundle |
INTEGER, INTENT(IN), optional :: bundle |
189 |
INTEGER :: predFwdCnt ! predicted forward count |
INTEGER :: predFwdCnt ! predicted forward count |
190 |
rvInit = .TRUE. |
rvInit = .TRUE. |
191 |
errorMsg ='none' |
errorMsg ='none' |
192 |
IF (present(anActionInstance)) THEN |
IF (present(anActionInstance)) THEN |
207 |
ELSEIF (checkpoints<0) THEN |
ELSEIF (checkpoints<0) THEN |
208 |
rvInit=.FALSE. |
rvInit=.FALSE. |
209 |
errorMsg = 'revolve::rvInit: negative checkpoints' |
errorMsg = 'revolve::rvInit: negative checkpoints' |
210 |
ELSE |
ELSE |
211 |
ourCStart = 0 |
ourCStart = 0 |
212 |
ourSteps = steps |
ourSteps = steps |
213 |
IF (ourBundle .gt. 1) THEN |
IF (ourBundle .gt. 1) THEN |
221 |
END IF |
END IF |
222 |
ourCEnd = ourSteps |
ourCEnd = ourSteps |
223 |
ourACP = checkpoints |
ourACP = checkpoints |
224 |
ourNumFwd = 0 |
ourNumFwd = 0 |
225 |
ourNumInv = 0 |
ourNumInv = 0 |
226 |
ourNumStore = 0 |
ourNumStore = 0 |
227 |
ourRWCP = -1 |
ourRWCP = -1 |
228 |
ourPrevCEnd = 0 |
ourPrevCEnd = 0 |
229 |
ourFirstUTurned = .FALSE. |
ourFirstUTurned = .FALSE. |
230 |
|
|
231 |
IF (ALLOCATED(ourStepOf)) THEN |
IF (ALLOCATED(ourStepOf)) THEN |
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` |
!> method to set the verbosity to a level in [0-3] as described for `ourVerbosity` |
271 |
SUBROUTINE rvVerbose(level) |
SUBROUTINE rvVerbose(level) |
272 |
IMPLICIT NONE |
IMPLICIT NONE |
273 |
INTEGER, INTENT(IN) :: level |
INTEGER, INTENT(IN) :: level |
274 |
ourVerbosity=level |
ourVerbosity=level |
275 |
END SUBROUTINE rvVerbose |
END SUBROUTINE rvVerbose |
276 |
|
|
291 |
|
|
292 |
INTEGER :: range |
INTEGER :: range |
293 |
INTEGER :: reps |
INTEGER :: reps |
294 |
INTEGER :: i |
INTEGER :: i |
295 |
INTEGER :: ourRWCPinBd |
LOGICAL :: rwcpTest |
296 |
type(rvAction) :: rvNextAction |
type(rvAction) :: rvNextAction |
297 |
IF (ourNumInv==0) THEN |
IF (ourNumInv==0) THEN |
298 |
! first invocation |
! first invocation |
303 |
END IF |
END IF |
304 |
prevCStart = ourCStart |
prevCStart = ourCStart |
305 |
ourNumInv = ourNumInv + 1 |
ourNumInv = ourNumInv + 1 |
306 |
! make sure ourRWCPinBd stay within bounds of array ourStepOf: |
rwcpTest=(ourRWCP==(-1)) |
307 |
ourRWCPinBd = MIN( MAX( ourRWCP, 0 ), ourACP ) |
IF (.not. rwcpTest) THEN |
308 |
|
rwcpTest=(ourStepOf(ourRWCP)/=ourCStart) |
309 |
|
END IF |
310 |
IF ((ourCEnd-ourCStart)==0) THEN |
IF ((ourCEnd-ourCStart)==0) THEN |
311 |
! nothing in current subrange |
! nothing in current subrange |
312 |
IF ((ourRWCP==(-1)) .OR. (ourCStart==ourStepOf(0))) THEN |
IF ((ourRWCP==(-1)) .OR. (ourCStart==ourStepOf(0))) THEN |
325 |
ELSE |
ELSE |
326 |
ourCStart = ourStepOf(ourRWCP) |
ourCStart = ourStepOf(ourRWCP) |
327 |
ourPrevCEnd = ourCEnd |
ourPrevCEnd = ourCEnd |
328 |
rvNextAction%actionFlag = rvRestore |
rvNextAction%actionFlag = rvRestore |
329 |
END IF |
END IF |
330 |
ELSE IF ((ourCEnd-ourCStart)==1) THEN |
ELSE IF ((ourCEnd-ourCStart)==1) THEN |
331 |
ourCEnd = ourCEnd - 1 |
ourCEnd = ourCEnd - 1 |
337 |
ELSE |
ELSE |
338 |
rvNextAction%actionFlag = rvUTurn |
rvNextAction%actionFlag = rvUTurn |
339 |
END IF |
END IF |
340 |
ELSE IF ((ourRWCP==(-1)) .OR. (ourStepOf(ourRWCPinBd)/=ourCStart)) THEN |
ELSE IF (rwcpTest) THEN |
341 |
ourRWCP = ourRWCP + 1 |
ourRWCP = ourRWCP + 1 |
342 |
IF (ourRWCP+1>ourACP) THEN |
IF (ourRWCP+1>ourACP) THEN |
343 |
rvNextAction%actionFlag = rvError |
rvNextAction%actionFlag = rvError |
386 |
bino5 = 1 |
bino5 = 1 |
387 |
END IF |
END IF |
388 |
IF (ourCEnd-ourCStart<=bino1+bino3) THEN |
IF (ourCEnd-ourCStart<=bino1+bino3) THEN |
389 |
ourCStart = ourCStart + bino4 |
ourCStart = int(ourCStart + bino4) |
390 |
ELSE IF (ourCEnd-ourCStart>=range-bino5) THEN |
ELSE IF (ourCEnd-ourCStart>=range-bino5) THEN |
391 |
ourCStart = ourCStart + bino1 |
ourCStart = int(ourCStart + bino1) |
392 |
ELSE |
ELSE |
393 |
ourCStart = ourCEnd - bino2 - bino3 |
ourCStart = int(ourCEnd - bino2 - bino3) |
394 |
END IF |
END IF |
395 |
IF (ourCStart==prevCStart) THEN |
IF (ourCStart==prevCStart) THEN |
396 |
ourCStart = prevCStart + 1 |
ourCStart = prevCStart + 1 |
423 |
CASE (rvFirstUTurn) |
CASE (rvFirstUTurn) |
424 |
WRITE (*,FMT='(A,I8,A,I8,A)') ' 1st uturn for iterations [',& |
WRITE (*,FMT='(A,I8,A,I8,A)') ' 1st uturn for iterations [',& |
425 |
rvNextAction%startIteration, ',', rvNextAction%iteration-1,']' |
rvNextAction%startIteration, ',', rvNextAction%iteration-1,']' |
426 |
CASE(rvUTurn) |
CASE(rvUTurn) |
427 |
WRITE (*,FMT='(A,I8,A,I8,A)') ' uturn for iterations [',& |
WRITE (*,FMT='(A,I8,A,I8,A)') ' uturn for iterations [',& |
428 |
rvNextAction%startIteration, ',', rvNextAction%iteration-1,']' |
rvNextAction%startIteration, ',', rvNextAction%iteration-1,']' |
429 |
END SELECT |
END SELECT |
544 |
DO i = 1, tt |
DO i = 1, tt |
545 |
res = res*(ss+i) |
res = res*(ss+i) |
546 |
res = res/i |
res = res/i |
547 |
IF (res>=2.0D0**31) EXIT |
IF (res>huge(chkrange)) EXIT |
548 |
END DO |
END DO |
549 |
IF (res<2.0D0**31-2) THEN |
IF (res<huge(chkrange)) THEN |
550 |
chkRange = res |
chkRange = int(res) |
551 |
ELSE |
ELSE |
552 |
chkRange = 2.0D0**31 - 3 |
chkRange = huge(chkrange) |
553 |
WRITE (*,fmt=*) 'revolve::chkRange: warning: returning maximal integer ',& |
WRITE (*,fmt=*) 'revolve::chkRange: warning: returning maximal integer ',& |
554 |
chkRange |
chkRange |
555 |
END IF |
END IF |