/[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.1 by utke, Sat Feb 23 04:24:42 2013 UTC revision 1.4 by utke, Tue May 21 17:22:58 2013 UTC
# Line 1  Line 1 
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  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    ! possible actions    !> store a checkpoint now
32      !! equivalent to TAKESHOT in Alg. 799
33    INTEGER, PARAMETER :: rvStore      =1    INTEGER, PARAMETER :: rvStore      =1
34    
35      !> restore a checkpoint now
36      !! equivalent to RESTORE in Alg. 799
37    INTEGER, PARAMETER :: rvRestore    =2    INTEGER, PARAMETER :: rvRestore    =2
38    
39      !> execute iteration(s) forward
40      !! equivalent to ADVANCE in Alg. 799
41    INTEGER, PARAMETER :: rvForward    =3    INTEGER, PARAMETER :: rvForward    =3
42    
43      !> tape iteration(s); optionally leave to return later;  and (upon return) do the adjoint(s)
44      !! equivalent to FIRSTTURN in Alg. 799
45    INTEGER, PARAMETER :: rvFirstUTurn =4    INTEGER, PARAMETER :: rvFirstUTurn =4
46    
47      !> tape iteration(s) and do the adjoint(s)
48      !! equivalent to YOUTURN in Alg. 799
49    INTEGER, PARAMETER :: rvUTurn      =5    INTEGER, PARAMETER :: rvUTurn      =5
50    
51      !> we are done with adjoining the loop
52      !! equivalent to the `terminate` enum value in Alg. 799
53    INTEGER, PARAMETER :: rvDone       =6    INTEGER, PARAMETER :: rvDone       =6
54    
55      !> an error has occurred
56      !! equivalent to the `error` enum value in Alg. 799;
57      !! see also `errorMsg` in \ref rvAction
58    INTEGER, PARAMETER :: rvError      =7    INTEGER, PARAMETER :: rvError      =7
59    
60      !> this encapsulates all the information needed to perfrom the correct action
61      !! an instance is returned from \ref rvNextAction
62    TYPE rvAction    TYPE rvAction
63         !> the action that is to be implemented, termination, or error;
64         !! the value must be one of:
65         !! `rvStore`, `rvRestore`, `rvForward`,
66         !! `rvFirstUTurn`, `rvUTurn`, `rvDone`, `rvError`
67       INTEGER :: actionFlag = 0       INTEGER :: actionFlag = 0
68    
69         !> assumptions:
70         !! - the loop iterations are numbered in range [0,`ourSteps`-1]
71         !! - the model state is the input to the iteration numbered `startIteration`
72         !!
73         !! the interpretation is as follows based on the value of `actionFlag`:
74         !! - `rvForward`: execute iterations as the loop: `do currentIteration=startIteration, iteration-1`
75         !! - `rvRestore`: restores model state at `iteration` (here it has the same value as `startIteration`)
76         !! - `rvFirstUTurn`/`rvUTurn`: tape iterations in loop: do currentIteration=startIteration, iteration-1`
77         !!    followed by adjoint sweep over iterations in loop: do currentIteration=iteration-1,startIteration,-1
78         !!
79         !! for all other values of `actionFlag` the value of `iteration` is meaningless
80       INTEGER :: iteration  = 0       INTEGER :: iteration  = 0
81    
82         !> assuming the loop iterations are in [0,ourSteps-1] and `currentIteration` variable is maintained,
83         !! the interpretation is as follows based on the value of `actionFlag`:
84         !! - `rvForward`: execute iterations as the loop: `do currentIteration, iteration-1`
85         !! - `rvRestore`: set `currentIteration=iteration`
86         !!
87         !! for all other values of `actionFlag` the value of `iteration` is meaningless
88         INTEGER :: startIteration = 0
89    
90         !> the checkpoint number to be stored to restored
91         !! the value is meaninfull only if `actionFlag` is set to `rvStore` or `rvRestore`;
92         !!
93         !! This is approximately equivalent to `checks` in Alg. 799.
94       INTEGER :: cpNum      = 0       INTEGER :: cpNum      = 0
95       CHARACTER, dimension(80) :: errorMsg  
96         !> if an error has occurred `actionFlag` will be set to `rvError` and this will contain an error message
97         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;
101      !! note that the iterations are expected to range in [0, ourSteps-1];
102      !!
103      !! equivalent to `steps` in Alg. 799
104    INTEGER :: ourSteps    = 0 ! number of steps    INTEGER :: ourSteps    = 0 ! number of steps
105    INTEGER :: ourACP      = 0 ! allowed number of checkpoints  
106    INTEGER :: ourCStart   = 0 ! current subrange start    !> the number of iterations that may be bundled for a taping/adjoining sweep;
107    INTEGER :: ourCEnd     = 0 ! current subrange end    !! set by calling \ref rvInit; not supposed to be set/used directly by the user;
108    INTEGER :: ourNumFwd   = 0 ! count of forward steps    !!
109    INTEGER :: ourNumInv   = 0 ! count of invocations of rvNextAction    !! the default is 1 loop iteration which makes it equivalent to Alg. 799
110    INTEGER :: ourNumStore = 0 ! number of stored checkpoints    INTEGER :: ourBundle   = 1
111    INTEGER :: ourRWCP     = -1! checkpoint currently (re)stored (first checkpoint is 0)  
112    INTEGER :: ourPrevCEnd = 0 ! previous subrange end    !> the number of iterations in the last bundle
113    LOGICAL :: ourFirstUturned = .FALSE. ! have we first for the first time    !! set by calling \ref rvInit; not supposed to be set/used directly by the user;
114    ! vector of step numbers indexed by checkpoint    !!
115      !! the default is 1 (for `ourBundle` = 1)  which makes it equivalent to Alg. 799
116      INTEGER :: ourTail   = 1
117    
118      !> the number of checkpoints (ACP=AllowedCheckPoints) that can be stored at any time during the loop execution
119      !! set by calling \ref rvInit; not supposed to be set/used directly by the user
120      !!
121      !! equivalent to `snaps` in Alg. 799
122      INTEGER :: ourACP      = 0
123    
124      !> current subrange start;
125      !! not to be set/referemced directly by the user
126      !!
127      !! approximately equivalent to `capo` in Alg. 799
128      INTEGER :: ourCStart   = 0
129    
130      !> current subrange end;
131      !! not to be set/referemced directly by the user
132      !!
133      !! approximately equivalent to `fine` in Alg. 799
134      INTEGER :: ourCEnd     = 0
135    
136      !> count of the forward steps; diagnostic only
137      INTEGER :: ourNumFwd   = 0
138    
139      !> count of invocations to \ref rvNextAction ;  diagnostic only
140      INTEGER :: ourNumInv   = 0
141    
142      !> count of checkpoint stores; diagnostic only
143      INTEGER :: ourNumStore = 0
144    
145      !> checkpoint currently (re)stored - the first checkpoint is numbered 0;
146      !! not to be set/referemced directly by the user
147      INTEGER :: ourRWCP     = -1
148    
149      !> previous subrange end;
150      !! not to be set/referemced directly by the user
151      INTEGER :: ourPrevCEnd = 0
152    
153      !> have we first uturned already?;
154      !! not to be set/referemced directly by the user
155      LOGICAL :: ourFirstUturned = .FALSE.
156    
157      !> vector of step numbers indexed by checkpoint;
158      !! not to be set/referemced directly by the user
159    INTEGER, DIMENSION(:), ALLOCATABLE :: ourStepOf    INTEGER, DIMENSION(:), ALLOCATABLE :: ourStepOf
160    
161    ! for debugging purposes:    !> for debugging purposes; values imply:
162    ! 0 includes errors    !! - 0 includes errors
163    ! 1 includes summary info    !! - 1 includes summary info
164    ! 2 includes iterations with checkpoints stored    !! - 2 includes iterations with checkpoints stored
165    ! 3 includes all action results    !! - 3 includes all action results
166      !!
167      !! set via \ref rvVerbose
168    INTEGER :: ourVerbosity = 0    INTEGER :: ourVerbosity = 0
169    
170  CONTAINS  CONTAINS
171    
172  !--------------------------------------------------------------------*  !--------------------------------------------------------------------*
173    
174    FUNCTION rvInit(steps,checkpoints,errorMsg,anActionInstance)    !> method to initialize the internal state; must be called before any call to \ref rvNextAction
175      !! @param steps  the total number of steps in the iteration; equivalent to `steps` in Alg. 799
176      !! @param checkpoints the total number of checkpoints allowed to be stored at any time; equivalent to `snaps` in Alg. 799
177      !! @param errorMsg set when an error condition occurs; else set to `"none"`
178      !! @param anActionInstance  if supplied initializes its contents
179      !! @param bundle if supplied initializes `ourBundle`
180      !! @return `.true.` if successfull, else `.false.` ansd `errorMsg` will be set
181      FUNCTION rvInit(steps,checkpoints,errorMsg,anActionInstance,bundle)
182      IMPLICIT NONE      IMPLICIT NONE
183      LOGICAL :: rvInit      LOGICAL :: rvInit
184      INTEGER, INTENT(IN) :: steps      INTEGER, INTENT(IN) :: steps
185      INTEGER, INTENT(IN) :: checkpoints      INTEGER, INTENT(IN) :: checkpoints
186      CHARACTER ,dimension(:), INTENT(OUT) :: errorMsg      CHARACTER(*), INTENT(OUT) :: errorMsg
187      type(rvAction), optional :: anActionInstance      type(rvAction), optional :: anActionInstance
188        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'
# Line 65  CONTAINS Line 195  CONTAINS
195         anActionInstance%iteration  = 0         anActionInstance%iteration  = 0
196         anActionInstance%cpNum      = 0         anActionInstance%cpNum      = 0
197      END IF      END IF
198      IF (steps<0 .OR. checkpoints<0) THEN      IF (present(bundle)) THEN
199           ourBundle = bundle
200        END IF
201        IF (ourBundle<1 .OR. ourBundle>steps) THEN
202         rvInit=.FALSE.         rvInit=.FALSE.
203         errorMsg = 'revolve::rvInit: negative steps or checkpoints'         errorMsg = "revolve::rvInit: bundle parameter out of range [1,steps]"
204        ELSEIF (steps<0) THEN
205           rvInit=.FALSE.
206           errorMsg = 'revolve::rvInit: negative steps'
207        ELSEIF (checkpoints<0) THEN
208           rvInit=.FALSE.
209           errorMsg = 'revolve::rvInit: negative checkpoints'
210      ELSE      ELSE
211         ourCStart       = 0         ourCStart       = 0
212         ourSteps        = steps         ourSteps        = steps
213         ourCEnd         = steps         IF (ourBundle .gt. 1) THEN
214              ourTail=modulo(ourSteps,ourBundle)
215              ourSteps=ourSteps/ourBundle
216              IF (ourTail>0) THEN
217                 ourSteps=ourSteps+1
218              ELSE
219                 ourTail=ourBundle
220              END IF
221           END IF
222           ourCEnd         = ourSteps
223         ourACP          = checkpoints         ourACP          = checkpoints
224         ourNumFwd       = 0         ourNumFwd       = 0
225         ourNumInv       = 0         ourNumInv       = 0
# Line 88  CONTAINS Line 236  CONTAINS
236         END IF         END IF
237    
238         IF (ourVerbosity>0) THEN         IF (ourVerbosity>0) THEN
239            predFwdCnt = forwdCount(ourCEnd-ourCStart,ourACP)            predFwdCnt = forwdCount(steps,ourACP,ourBundle)
240            IF (predFwdCnt==-1) THEN            IF (predFwdCnt==-1) THEN
241               errorMsg='error in forwdCount'               errorMsg='revolve::rvInit: error returned by  revolve::forwdCount'
242                 rvInit=.FALSE.
243               RETURN               RETURN
244            ELSE            ELSE
245               WRITE (*,'(A)') 'prediction:'               WRITE (*,'(A)') 'prediction:'
246               WRITE (*,'(A,I7)') ' needed forward steps: ', predFwdCnt               WRITE (*,'(A,I7)')   ' overhead forward steps : ', predFwdCnt
247               WRITE (*,'(A,F8.4)') ' slowdown factor     : ', dble(predFwdCnt)/(ourCEnd-ourCStart)               WRITE (*,'(A,F8.4)') ' overhead factor        : ', dble(predFwdCnt)/(steps)
248            END IF            END IF
249         END IF         END IF
250      END IF      END IF
# Line 103  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`
271    SUBROUTINE rvVerbose(level)    SUBROUTINE rvVerbose(level)
272      IMPLICIT NONE      IMPLICIT NONE
273      INTEGER, INTENT(IN) :: level      INTEGER, INTENT(IN) :: level
# Line 110  CONTAINS Line 275  CONTAINS
275    END SUBROUTINE rvVerbose    END SUBROUTINE rvVerbose
276    
277  !--------------------------------------------------------------------*  !--------------------------------------------------------------------*
278      !> the method to determine the next action; to be called in an unbound loop after \ref rvInit
279      !! @return an instance of `rvAction` set to describe the next action (see the member documentation);
280      !!
281      !! this method modifies the internal state; it is approximately equivalent to the method `revolve` in Alg. 799
282    FUNCTION rvNextAction()    FUNCTION rvNextAction()
283      IMPLICIT NONE      IMPLICIT NONE
284      REAL :: bino1, bino2, bino3, bino4, bino5      REAL :: bino1, bino2, bino3, bino4, bino5
285      INTEGER :: availCP    ! available checkpoint slots  
286      INTEGER :: prevCStart ! previous subrange start      !> available checkpoint slots
287      INTEGER :: range      !      INTEGER :: availCP
288    
289        !> local copy of previous subrange start
290        INTEGER :: prevCStart
291    
292        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 127  CONTAINS Line 301  CONTAINS
301         END DO         END DO
302         ourStepOf(0) = ourCStart - 1         ourStepOf(0) = ourCStart - 1
303      END IF      END IF
304        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
313            ! we are done            ! we are done
314            ourRWCP = ourRWCP - 1            ourRWCP = ourRWCP - 1
315              IF (ourVerbosity>2) THEN
316                 WRITE (*,FMT='(A)') ' done'
317              END IF
318            IF (ourVerbosity>0) THEN            IF (ourVerbosity>0) THEN
319               WRITE (*,'(A)') 'summary:'               WRITE (*,'(A)') 'summary:'
320               WRITE (*,'(A,I8)') ' forward steps:', ourNumFwd               WRITE (*,'(A,I8)') ' overhead forward steps:', ourNumFwd
321               WRITE (*,'(A,I8)') ' CP stores    :', ourNumStore               WRITE (*,'(A,I8)') ' CP stores             :', ourNumStore
322               WRITE (*,'(A,I8)') ' invocations  :', ourNumInv               WRITE (*,'(A,I8)') ' rvNextAction calls    :', ourNumInv
323            END IF            END IF
324            rvNextAction%actionFlag = rvDone            rvNextAction%actionFlag = rvDone
325          ELSE          ELSE
# Line 155  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
344             rvNextAction%errorMsg='insufficient allowed checkpoints'             rvNextAction%errorMsg='revolve::rvNextAction: insufficient allowed checkpoints'
345             RETURN             RETURN
346          ELSE          ELSE
347             ourStepOf(ourRWCP) = ourCStart             ourStepOf(ourRWCP) = ourCStart
# Line 169  CONTAINS Line 351  CONTAINS
351          END IF          END IF
352       ELSE IF ((ourPrevCEnd<ourCEnd) .AND. (ourACP==ourRWCP+1)) THEN       ELSE IF ((ourPrevCEnd<ourCEnd) .AND. (ourACP==ourRWCP+1)) THEN
353          rvNextAction%actionFlag = rvError          rvNextAction%actionFlag = rvError
354          rvNextAction%errorMsg='insufficient allowed checkpoints'          rvNextAction%errorMsg='revolve::rvNextAction: insufficient allowed checkpoints'
355       ELSE       ELSE
         prevCStart = ourCStart  
356          availCP = ourACP - ourRWCP          availCP = ourACP - ourRWCP
357          IF (availCP<1) THEN          IF (availCP<1) THEN
358             rvNextAction%actionFlag = rvError             rvNextAction%actionFlag = rvError
359             rvNextAction%errorMsg='insufficient allowed checkpoints'             rvNextAction%errorMsg='revolve::rvNextAction: insufficient allowed checkpoints'
360          ELSE          ELSE
361             reps = 0             reps = 0
362             range = 1             range = 1
# Line 205  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
397            END IF            END IF
398            ourNumFwd = ourNumFwd + ourCStart - prevCStart            IF (ourCStart==ourSteps) THEN
399                 ourNumFwd = ourNumFwd + ((ourCStart-1) - prevCStart)*ourBundle + ourTail
400              ELSE
401                 ourNumFwd = ourNumFwd + (ourCStart - prevCStart)*ourBundle
402              END IF
403            rvNextAction%actionFlag = rvForward            rvNextAction%actionFlag = rvForward
404          END IF          END IF
405        END IF        END IF
406        rvNextAction%iteration=ourCStart        rvNextAction%startIteration=prevCStart*ourBundle
407        IF (rvNextAction%actionFlag /= rvError .AND. rvNextAction%actionFlag /= rvDone) THEN        IF (rvNextAction%actionFlag==rvFirstUTurn) THEN
408             rvNextAction%iteration=(ourCStart)*ourBundle+ourTail
409          ELSE IF (rvNextAction%actionFlag==rvUTurn) THEN
410             rvNextAction%iteration=(ourCStart+1)*ourBundle
411          ELSE
412             rvNextAction%iteration=(ourCStart)*ourBundle
413          END IF
414          IF (rvNextAction%actionFlag /= rvError) THEN
415           IF (ourVerbosity>2) THEN           IF (ourVerbosity>2) THEN
416              SELECT CASE( rvNextAction%actionFlag)              SELECT CASE( rvNextAction%actionFlag)
417              CASE (rvForward)              CASE (rvForward)
418                 WRITE (*,FMT='(A)',ADVANCE='NO') ' forward to  :'                 WRITE (*,FMT='(A,I8,A,I8,A)') ' run forward iterations    [', &
419                   rvNextAction%startIteration, ',', rvNextAction%iteration-1,']'
420              CASE (rvRestore)              CASE (rvRestore)
421                 WRITE (*,FMT='(A)',ADVANCE='NO') ' restore at  :'                 WRITE (*,FMT='(A,I8)')        ' restore input of iteration ',&
422                   rvNextAction%iteration
423              CASE (rvFirstUTurn)              CASE (rvFirstUTurn)
424                 WRITE (*,FMT='(A)',ADVANCE='NO') ' 1st uturn at:'                 WRITE (*,FMT='(A,I8,A,I8,A)') ' 1st uturn for iterations  [',&
425                   rvNextAction%startIteration, ',', rvNextAction%iteration-1,']'
426              CASE(rvUTurn)                    CASE(rvUTurn)      
427                 WRITE (*,FMT='(A)',ADVANCE='NO') ' uturn at    :'                 WRITE (*,FMT='(A,I8,A,I8,A)') ' uturn for iterations      [',&
428                   rvNextAction%startIteration, ',', rvNextAction%iteration-1,']'
429              END SELECT              END SELECT
430           END IF           END IF
431           IF (ourVerbosity>1) THEN           IF ((ourVerbosity>1) .AND. (rvNextAction%actionFlag == rvStore)) THEN
432              IF (rvNextAction%actionFlag == rvStore) THEN                  WRITE (*,FMT='(A,I8)')        ' store input of iteration   ',&
433                 WRITE (*,FMT='(A)',ADVANCE='NO') ' store at    :'                  rvNextAction%iteration
             END IF  
             WRITE (*,'(I8)') rvNextAction%iteration  
434           END IF           END IF
435        END IF        END IF
436        rvNextAction%cpNum=ourRWCP        rvNextAction%cpNum=ourRWCP
437      END FUNCTION rvNextAction      END FUNCTION rvNextAction
438    
439  !--------------------------------------------------------------------*  !--------------------------------------------------------------------*
440        !> estimates the number of checkpoints required; equivalent to `adjust` in Alg. 799
441      FUNCTION rvGuess(steps)      !! @param steps is the number of iterations
442        !! @param bundle is optional; detaults to 1, if specified indicates the number of iterations bundled in one tape/adjoint sweep
443        !! @return the number of checkpoints such that the growth in spatial complexity is balanced with the  growth in temporal complexity
444        !!
445        !! this method does not change the internal state and does not require \ref rvInit
446        FUNCTION rvGuess(steps,bundle)
447      IMPLICIT NONE      IMPLICIT NONE
448        INTEGER :: steps        INTEGER, INTENT(IN) :: steps, bundle
449        INTEGER :: reps, s, checkpoints        OPTIONAL :: bundle
450          INTEGER :: reps, s, checkpoints, b, tail, bSteps
451        INTEGER :: rvGuess        INTEGER :: rvGuess
452        checkpoints = 1        b=1
453        reps = 1        bSteps=steps
454        s = 0        IF (present(bundle)) THEN
455        DO WHILE (chkRange(checkpoints+s,reps+s)>steps)           b=bundle
456          s = s - 1        END IF
457        END DO        IF (steps<1) THEN
458        DO WHILE (chkRange(checkpoints+s,reps+s)<steps)          WRITE (*,fmt=*) 'revolve::rvGuess: error: steps < 1'
459          s = s + 1          rvGuess = -1
460        END DO        ELSE IF (b<1) THEN
461        checkpoints = checkpoints + s          WRITE (*,fmt=*) 'revolve::rvGuess: error: bundle < 1'
462        reps = reps + s          rvGuess = -1
463        s = -1        ELSE
464        DO WHILE (chkRange(checkpoints,reps)>=steps)          IF (b .gt. 1) THEN
465          IF (checkpoints>reps) THEN            tail=modulo(bSteps,b)
466            checkpoints = checkpoints - 1            bSteps=bSteps/b
467            s = 0            IF (tail>0) THEN
468                bSteps=bSteps+1
469              END IF
470            END IF
471            IF (bSteps==1) THEN
472              rvGuess=0
473          ELSE          ELSE
474            reps = reps - 1            checkpoints = 1
475            s = 1            reps = 1
476              s = 0
477              DO WHILE (chkRange(checkpoints+s,reps+s)>bSteps)
478                s = s - 1
479              END DO
480              DO WHILE (chkRange(checkpoints+s,reps+s)<bSteps)
481                s = s + 1
482              END DO
483              checkpoints = checkpoints + s
484              reps = reps + s
485              s = -1
486              DO WHILE (chkRange(checkpoints,reps)>=bSteps)
487                IF (checkpoints>reps) THEN
488                  checkpoints = checkpoints - 1
489                  s = 0
490                ELSE
491                  reps = reps - 1
492                  s = 1
493                END IF
494              END DO
495              IF (s==0) THEN
496                checkpoints = checkpoints + 1
497              END IF
498              IF (s==1) reps = reps + 1
499              rvGuess = checkpoints
500          END IF          END IF
       END DO  
       IF (s==0) THEN  
         checkpoints = checkpoints + 1  
501        END IF        END IF
       IF (s==1) reps = reps + 1  
       rvGuess = checkpoints  
502      END FUNCTION rvGuess      END FUNCTION rvGuess
503    
504  !--------------------------------------------------------------------*  !--------------------------------------------------------------------*
505        !> computes the run time overhead factor; equivalent to `expense` in Alg. 799
506      FUNCTION rvFactor(steps,checkpoints)      !! @param steps is the number of iterations
507        !! @param checkpoints is the number of allowed checkpoints
508        !! @param bundle is optional; detaults to 1, if specified indicates the number of iterations bundled in one tape/adjoint sweep
509        !! @return the estimated runtime overhead factor (does not account for the time needed to write checkpoints)
510        !!
511        !! this method does not change the internal state and does not require \ref rvInit
512        FUNCTION rvFactor(steps,checkpoints,bundle)
513      IMPLICIT NONE      IMPLICIT NONE
514        INTEGER :: checkpoints, steps        INTEGER, INTENT(IN) :: checkpoints, steps, bundle
515          OPTIONAL :: bundle
516          INTEGER :: b, f
517        DOUBLE PRECISION :: rvFactor        DOUBLE PRECISION :: rvFactor
518        IF (checkpoints<1) THEN        b=1
519          WRITE (*,fmt=*) 'error occurs in RVFACTOR: CHECKPOINTS < 1'        IF (present(bundle)) THEN
520          rvFactor = -1           b=bundle
521        ELSE IF (checkpoints<1) THEN        END IF
522          WRITE (*,fmt=*) 'error occurs in RVFACTOR: CHECKPOINTS < 1'        f=forwdCount(steps,checkpoints,b)
523          rvFactor = -1        IF (f==-1)  THEN
524            WRITE (*,fmt=*) 'revolve::rvFactor: error returned by  revolve::forwdCount'
525            rvFactor=-1
526        ELSE        ELSE
527          rvFactor = dble(forwdCount(steps,checkpoints))          rvFactor = dble(f)/steps
         IF (rvFactor/=-1) rvFactor = rvFactor/steps  
528        END IF        END IF
529      END FUNCTION rvFactor      END FUNCTION rvFactor
530    
531  !--------------------------------------------------------------------*  !--------------------------------------------------------------------*
532        !> internal method not to be referenced by the user
533      FUNCTION chkRange(ss,tt)      FUNCTION chkRange(ss,tt)
534      IMPLICIT NONE      IMPLICIT NONE
535        INTEGER :: ss, tt        INTEGER :: ss, tt
# Line 305  CONTAINS Line 538  CONTAINS
538        INTEGER :: chkRange        INTEGER :: chkRange
539        res = 1.        res = 1.
540        IF (tt<0 .OR. ss<0) THEN        IF (tt<0 .OR. ss<0) THEN
541          WRITE (*,fmt=*) 'error in MAXRANGE: negative parameter '          WRITE (*,fmt=*) 'revolve::chkRange: error: negative parameter '
542          chkRange = -1          chkRange = -1
543        ELSE        ELSE
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=*) 'warning from  MAXRANGE: returned maximal integer'            WRITE (*,fmt=*) 'revolve::chkRange: warning: returning maximal integer ',&
554            WRITE (*,fmt=*) chkRange            chkRange
555          END IF          END IF
556        END IF        END IF
557      END FUNCTION chkRange      END FUNCTION chkRange
558    
559  !--------------------------------------------------------------------*  !--------------------------------------------------------------------*
560    
561      FUNCTION forwdCount(steps,checkpoints)      !> internal method not to be referenced by the user;
562        !> predicts the  number of recomputation-from-checkpoint forwards steps (overhead)
563        FUNCTION forwdCount(steps,checkpoints,bundle)
564      IMPLICIT NONE      IMPLICIT NONE
565        INTEGER :: checkpoints, steps        INTEGER, INTENT(IN) :: checkpoints, steps, bundle
566        INTEGER :: range, reps        INTEGER :: range, reps,s,tail
567        INTEGER :: forwdCount        INTEGER :: forwdCount
568        IF (checkpoints<1) THEN        IF (checkpoints<0) THEN
569            WRITE (*,fmt=*) 'revolve::forwdCount: error: checkpoints < 0'
570            forwdCount = -1
571          ELSE IF (steps<1) THEN
572            WRITE (*,fmt=*) 'revolve::forwdCount: error: steps < 1'
573            forwdCount = -1
574          ELSE IF (bundle<1) THEN
575            WRITE (*,fmt=*) 'revolve::forwdCount: error: bundle < 1'
576          forwdCount = -1          forwdCount = -1
577        ELSE        ELSE
578          reps = 0          s=steps
579          range = 1          IF (bundle .gt. 1) THEN
580          DO WHILE (range<steps)            tail=modulo(s,bundle)
581            reps = reps + 1            s=s/bundle
582            range = range*(reps+checkpoints)/reps            IF (tail>0) THEN
583          END DO              s=s+1
584          forwdCount = reps*steps - range*reps/(checkpoints+1)            END IF
585            END IF
586            IF (s==1) THEN
587              forwdCount = 0
588            ELSE IF (checkpoints==0) THEN
589              WRITE (*,fmt=*) &
590              'revolve::forwdCount: error: given inputs require checkpoints>0'
591              forwdCount = -1
592            ELSE
593              reps = 0
594              range = 1
595              DO WHILE (range<s)
596                reps = reps + 1
597                range = range*(reps+checkpoints)/reps
598              END DO
599              forwdCount = (reps*s - range*reps/(checkpoints+1))*bundle
600            END IF
601        END IF        END IF
602      END FUNCTION forwdCount      END FUNCTION forwdCount
603    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22