/[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.3 by jmc, Fri May 17 20:57:12 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
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
# Line 93  chkRange, forwdCount Line 96  chkRange, forwdCount
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    !!    !!
# Line 183  CONTAINS Line 186  CONTAINS
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
# Line 204  CONTAINS Line 207  CONTAINS
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
# Line 218  CONTAINS Line 221  CONTAINS
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
# 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
273      INTEGER, INTENT(IN) :: level      INTEGER, INTENT(IN) :: level
274      ourVerbosity=level      ourVerbosity=level
275    END SUBROUTINE rvVerbose    END SUBROUTINE rvVerbose
276    
# Line 273  CONTAINS Line 291  CONTAINS
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
# Line 285  CONTAINS Line 303  CONTAINS
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
# Line 305  CONTAINS Line 325  CONTAINS
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
# Line 317  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(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
# Line 366  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 403  CONTAINS Line 423  CONTAINS
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
# Line 524  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.3  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22