/[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.2 by utke, Sat Mar 9 17:17:39 2013 UTC revision 1.4 by utke, Tue May 21 17:22:58 2013 UTC
# Line 17  Line 17 
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
# Line 249  CONTAINS Line 252  CONTAINS
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
# Line 274  CONTAINS Line 292  CONTAINS
292      INTEGER :: range      INTEGER :: range
293      INTEGER :: reps      INTEGER :: reps
294      INTEGER :: i      INTEGER :: i
295        LOGICAL :: rwcpTest
296      type(rvAction) :: rvNextAction      type(rvAction) :: rvNextAction
297      IF (ourNumInv==0) THEN      IF (ourNumInv==0) THEN
298         ! first invocation         ! first invocation
# Line 284  CONTAINS Line 303  CONTAINS
303      END IF      END IF
304      prevCStart = ourCStart      prevCStart = ourCStart
305      ourNumInv = ourNumInv + 1      ourNumInv = ourNumInv + 1
306        rwcpTest=(ourRWCP==(-1))
307        IF (.not. rwcpTest) THEN
308           rwcpTest=(ourStepOf(ourRWCP)/=ourCStart)
309        END IF
310      IF ((ourCEnd-ourCStart)==0) THEN      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
# Line 314  CONTAINS Line 337  CONTAINS
337          ELSE          ELSE
338             rvNextAction%actionFlag = rvUTurn             rvNextAction%actionFlag = rvUTurn
339          END IF          END IF
340       ELSE IF ((ourRWCP==(-1)) .OR. (ourStepOf(ourRWCP)/=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
# Line 363  CONTAINS Line 386  CONTAINS
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
# Line 521  CONTAINS Line 544  CONTAINS
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
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22