1 |
utke |
1.2 |
!> \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 |
utke |
1.1 |
MODULE revolve |
18 |
|
|
IMPLICIT NONE |
19 |
|
|
|
20 |
utke |
1.4 |
PUBLIC :: rvInit, rvVerbose, rvNextAction, & |
21 |
|
|
rvGuess, rvFactor, & |
22 |
|
|
rvStore, rvRestore, & |
23 |
|
|
rvForward, rvFirstUTurn, rvUTurn, rvDone, & |
24 |
|
|
rvError, rvAdjust |
25 |
utke |
1.1 |
|
26 |
utke |
1.4 |
PRIVATE :: & |
27 |
utke |
1.1 |
ourSteps, ourACP, ourCStart, ourCEnd, ourVerbosity, & |
28 |
utke |
1.4 |
ourNumFwd , ourNumInv, ourNumStore, ourRWCP, ourPrevCEnd, & |
29 |
|
|
ourFirstUTurned, chkRange, forwdCount |
30 |
utke |
1.1 |
|
31 |
utke |
1.2 |
!> store a checkpoint now |
32 |
|
|
!! equivalent to TAKESHOT in Alg. 799 |
33 |
utke |
1.4 |
INTEGER, PARAMETER :: rvStore =1 |
34 |
utke |
1.2 |
|
35 |
|
|
!> restore a checkpoint now |
36 |
|
|
!! equivalent to RESTORE in Alg. 799 |
37 |
utke |
1.1 |
INTEGER, PARAMETER :: rvRestore =2 |
38 |
utke |
1.2 |
|
39 |
|
|
!> execute iteration(s) forward |
40 |
|
|
!! equivalent to ADVANCE in Alg. 799 |
41 |
utke |
1.1 |
INTEGER, PARAMETER :: rvForward =3 |
42 |
utke |
1.2 |
|
43 |
|
|
!> tape iteration(s); optionally leave to return later; and (upon return) do the adjoint(s) |
44 |
|
|
!! equivalent to FIRSTTURN in Alg. 799 |
45 |
utke |
1.1 |
INTEGER, PARAMETER :: rvFirstUTurn =4 |
46 |
utke |
1.2 |
|
47 |
|
|
!> tape iteration(s) and do the adjoint(s) |
48 |
|
|
!! equivalent to YOUTURN in Alg. 799 |
49 |
utke |
1.1 |
INTEGER, PARAMETER :: rvUTurn =5 |
50 |
utke |
1.2 |
|
51 |
|
|
!> we are done with adjoining the loop |
52 |
|
|
!! equivalent to the `terminate` enum value in Alg. 799 |
53 |
utke |
1.1 |
INTEGER, PARAMETER :: rvDone =6 |
54 |
utke |
1.2 |
|
55 |
|
|
!> an error has occurred |
56 |
|
|
!! equivalent to the `error` enum value in Alg. 799; |
57 |
|
|
!! see also `errorMsg` in \ref rvAction |
58 |
utke |
1.1 |
INTEGER, PARAMETER :: rvError =7 |
59 |
|
|
|
60 |
utke |
1.2 |
!> this encapsulates all the information needed to perfrom the correct action |
61 |
|
|
!! an instance is returned from \ref rvNextAction |
62 |
utke |
1.1 |
TYPE rvAction |
63 |
utke |
1.2 |
!> 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 |
utke |
1.1 |
INTEGER :: actionFlag = 0 |
68 |
utke |
1.2 |
|
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 |
utke |
1.1 |
INTEGER :: iteration = 0 |
81 |
utke |
1.2 |
|
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 |
utke |
1.1 |
INTEGER :: cpNum = 0 |
95 |
utke |
1.2 |
|
96 |
|
|
!> if an error has occurred `actionFlag` will be set to `rvError` and this will contain an error message |
97 |
|
|
CHARACTER(80) :: errorMsg |
98 |
utke |
1.1 |
END TYPE rvAction |
99 |
utke |
1.4 |
|
100 |
utke |
1.2 |
!> 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 |
utke |
1.1 |
INTEGER :: ourSteps = 0 ! number of steps |
105 |
utke |
1.2 |
|
106 |
|
|
!> the number of iterations that may be bundled for a taping/adjoining sweep; |
107 |
|
|
!! set by calling \ref rvInit; not supposed to be set/used directly by the user; |
108 |
|
|
!! |
109 |
|
|
!! the default is 1 loop iteration which makes it equivalent to Alg. 799 |
110 |
|
|
INTEGER :: ourBundle = 1 |
111 |
|
|
|
112 |
|
|
!> the number of iterations in the last bundle |
113 |
|
|
!! set by calling \ref rvInit; not supposed to be set/used directly by the user; |
114 |
|
|
!! |
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 |
utke |
1.1 |
INTEGER, DIMENSION(:), ALLOCATABLE :: ourStepOf |
160 |
|
|
|
161 |
utke |
1.2 |
!> for debugging purposes; values imply: |
162 |
|
|
!! - 0 includes errors |
163 |
|
|
!! - 1 includes summary info |
164 |
|
|
!! - 2 includes iterations with checkpoints stored |
165 |
|
|
!! - 3 includes all action results |
166 |
|
|
!! |
167 |
|
|
!! set via \ref rvVerbose |
168 |
utke |
1.1 |
INTEGER :: ourVerbosity = 0 |
169 |
|
|
|
170 |
|
|
CONTAINS |
171 |
|
|
|
172 |
|
|
!--------------------------------------------------------------------* |
173 |
|
|
|
174 |
utke |
1.2 |
!> 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 |
utke |
1.1 |
IMPLICIT NONE |
183 |
|
|
LOGICAL :: rvInit |
184 |
|
|
INTEGER, INTENT(IN) :: steps |
185 |
|
|
INTEGER, INTENT(IN) :: checkpoints |
186 |
utke |
1.2 |
CHARACTER(*), INTENT(OUT) :: errorMsg |
187 |
utke |
1.1 |
type(rvAction), optional :: anActionInstance |
188 |
utke |
1.2 |
INTEGER, INTENT(IN), optional :: bundle |
189 |
utke |
1.4 |
INTEGER :: predFwdCnt ! predicted forward count |
190 |
utke |
1.1 |
rvInit = .TRUE. |
191 |
|
|
errorMsg ='none' |
192 |
|
|
IF (present(anActionInstance)) THEN |
193 |
|
|
! same as default init above |
194 |
|
|
anActionInstance%actionFlag = 0 |
195 |
|
|
anActionInstance%iteration = 0 |
196 |
|
|
anActionInstance%cpNum = 0 |
197 |
|
|
END IF |
198 |
utke |
1.2 |
IF (present(bundle)) THEN |
199 |
|
|
ourBundle = bundle |
200 |
|
|
END IF |
201 |
|
|
IF (ourBundle<1 .OR. ourBundle>steps) THEN |
202 |
|
|
rvInit=.FALSE. |
203 |
|
|
errorMsg = "revolve::rvInit: bundle parameter out of range [1,steps]" |
204 |
|
|
ELSEIF (steps<0) THEN |
205 |
utke |
1.1 |
rvInit=.FALSE. |
206 |
utke |
1.2 |
errorMsg = 'revolve::rvInit: negative steps' |
207 |
|
|
ELSEIF (checkpoints<0) THEN |
208 |
|
|
rvInit=.FALSE. |
209 |
|
|
errorMsg = 'revolve::rvInit: negative checkpoints' |
210 |
utke |
1.4 |
ELSE |
211 |
utke |
1.1 |
ourCStart = 0 |
212 |
|
|
ourSteps = steps |
213 |
utke |
1.2 |
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 |
utke |
1.1 |
ourACP = checkpoints |
224 |
utke |
1.4 |
ourNumFwd = 0 |
225 |
|
|
ourNumInv = 0 |
226 |
|
|
ourNumStore = 0 |
227 |
|
|
ourRWCP = -1 |
228 |
|
|
ourPrevCEnd = 0 |
229 |
utke |
1.1 |
ourFirstUTurned = .FALSE. |
230 |
|
|
|
231 |
|
|
IF (ALLOCATED(ourStepOf)) THEN |
232 |
|
|
DEALLOCATE(ourStepOf) |
233 |
|
|
END IF |
234 |
|
|
IF(.NOT.ALLOCATED(ourStepOf)) THEN |
235 |
|
|
ALLOCATE(ourStepOf(0:ourACP)) |
236 |
|
|
END IF |
237 |
|
|
|
238 |
|
|
IF (ourVerbosity>0) THEN |
239 |
utke |
1.2 |
predFwdCnt = forwdCount(steps,ourACP,ourBundle) |
240 |
utke |
1.1 |
IF (predFwdCnt==-1) THEN |
241 |
utke |
1.2 |
errorMsg='revolve::rvInit: error returned by revolve::forwdCount' |
242 |
|
|
rvInit=.FALSE. |
243 |
utke |
1.1 |
RETURN |
244 |
|
|
ELSE |
245 |
|
|
WRITE (*,'(A)') 'prediction:' |
246 |
utke |
1.2 |
WRITE (*,'(A,I7)') ' overhead forward steps : ', predFwdCnt |
247 |
|
|
WRITE (*,'(A,F8.4)') ' overhead factor : ', dble(predFwdCnt)/(steps) |
248 |
utke |
1.1 |
END IF |
249 |
|
|
END IF |
250 |
|
|
END IF |
251 |
|
|
END FUNCTION rvInit |
252 |
|
|
|
253 |
|
|
!--------------------------------------------------------------------* |
254 |
|
|
|
255 |
utke |
1.4 |
!> 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 |
utke |
1.2 |
!> method to set the verbosity to a level in [0-3] as described for `ourVerbosity` |
271 |
utke |
1.1 |
SUBROUTINE rvVerbose(level) |
272 |
|
|
IMPLICIT NONE |
273 |
utke |
1.4 |
INTEGER, INTENT(IN) :: level |
274 |
utke |
1.1 |
ourVerbosity=level |
275 |
|
|
END SUBROUTINE rvVerbose |
276 |
|
|
|
277 |
|
|
!--------------------------------------------------------------------* |
278 |
utke |
1.2 |
!> 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 |
utke |
1.1 |
FUNCTION rvNextAction() |
283 |
|
|
IMPLICIT NONE |
284 |
|
|
REAL :: bino1, bino2, bino3, bino4, bino5 |
285 |
utke |
1.2 |
|
286 |
|
|
!> available checkpoint slots |
287 |
|
|
INTEGER :: availCP |
288 |
|
|
|
289 |
|
|
!> local copy of previous subrange start |
290 |
|
|
INTEGER :: prevCStart |
291 |
|
|
|
292 |
|
|
INTEGER :: range |
293 |
utke |
1.1 |
INTEGER :: reps |
294 |
utke |
1.4 |
INTEGER :: i |
295 |
|
|
LOGICAL :: rwcpTest |
296 |
utke |
1.1 |
type(rvAction) :: rvNextAction |
297 |
|
|
IF (ourNumInv==0) THEN |
298 |
|
|
! first invocation |
299 |
|
|
DO i = 0, ourACP |
300 |
|
|
ourStepOf(i) = 0 |
301 |
|
|
END DO |
302 |
|
|
ourStepOf(0) = ourCStart - 1 |
303 |
|
|
END IF |
304 |
utke |
1.2 |
prevCStart = ourCStart |
305 |
utke |
1.1 |
ourNumInv = ourNumInv + 1 |
306 |
utke |
1.4 |
rwcpTest=(ourRWCP==(-1)) |
307 |
|
|
IF (.not. rwcpTest) THEN |
308 |
|
|
rwcpTest=(ourStepOf(ourRWCP)/=ourCStart) |
309 |
|
|
END IF |
310 |
utke |
1.1 |
IF ((ourCEnd-ourCStart)==0) THEN |
311 |
|
|
! nothing in current subrange |
312 |
|
|
IF ((ourRWCP==(-1)) .OR. (ourCStart==ourStepOf(0))) THEN |
313 |
|
|
! we are done |
314 |
|
|
ourRWCP = ourRWCP - 1 |
315 |
utke |
1.2 |
IF (ourVerbosity>2) THEN |
316 |
|
|
WRITE (*,FMT='(A)') ' done' |
317 |
|
|
END IF |
318 |
utke |
1.1 |
IF (ourVerbosity>0) THEN |
319 |
|
|
WRITE (*,'(A)') 'summary:' |
320 |
utke |
1.2 |
WRITE (*,'(A,I8)') ' overhead forward steps:', ourNumFwd |
321 |
|
|
WRITE (*,'(A,I8)') ' CP stores :', ourNumStore |
322 |
|
|
WRITE (*,'(A,I8)') ' rvNextAction calls :', ourNumInv |
323 |
utke |
1.1 |
END IF |
324 |
|
|
rvNextAction%actionFlag = rvDone |
325 |
|
|
ELSE |
326 |
|
|
ourCStart = ourStepOf(ourRWCP) |
327 |
|
|
ourPrevCEnd = ourCEnd |
328 |
utke |
1.4 |
rvNextAction%actionFlag = rvRestore |
329 |
utke |
1.1 |
END IF |
330 |
|
|
ELSE IF ((ourCEnd-ourCStart)==1) THEN |
331 |
|
|
ourCEnd = ourCEnd - 1 |
332 |
|
|
ourPrevCEnd = ourCEnd |
333 |
|
|
IF ((ourRWCP>=0) .AND. (ourStepOf(ourRWCP)==ourCStart)) ourRWCP = ourRWCP - 1 |
334 |
|
|
IF (.NOT.ourFirstUTurned) THEN |
335 |
|
|
rvNextAction%actionFlag = rvFirstUTurn |
336 |
|
|
ourFirstUTurned = .TRUE. |
337 |
|
|
ELSE |
338 |
|
|
rvNextAction%actionFlag = rvUTurn |
339 |
|
|
END IF |
340 |
utke |
1.4 |
ELSE IF (rwcpTest) THEN |
341 |
utke |
1.1 |
ourRWCP = ourRWCP + 1 |
342 |
|
|
IF (ourRWCP+1>ourACP) THEN |
343 |
|
|
rvNextAction%actionFlag = rvError |
344 |
utke |
1.2 |
rvNextAction%errorMsg='revolve::rvNextAction: insufficient allowed checkpoints' |
345 |
utke |
1.1 |
RETURN |
346 |
|
|
ELSE |
347 |
|
|
ourStepOf(ourRWCP) = ourCStart |
348 |
|
|
ourNumStore = ourNumStore + 1 |
349 |
|
|
ourPrevCEnd = ourCEnd |
350 |
|
|
rvNextAction%actionFlag = rvStore |
351 |
|
|
END IF |
352 |
|
|
ELSE IF ((ourPrevCEnd<ourCEnd) .AND. (ourACP==ourRWCP+1)) THEN |
353 |
|
|
rvNextAction%actionFlag = rvError |
354 |
utke |
1.2 |
rvNextAction%errorMsg='revolve::rvNextAction: insufficient allowed checkpoints' |
355 |
utke |
1.1 |
ELSE |
356 |
|
|
availCP = ourACP - ourRWCP |
357 |
|
|
IF (availCP<1) THEN |
358 |
|
|
rvNextAction%actionFlag = rvError |
359 |
utke |
1.2 |
rvNextAction%errorMsg='revolve::rvNextAction: insufficient allowed checkpoints' |
360 |
utke |
1.1 |
ELSE |
361 |
|
|
reps = 0 |
362 |
|
|
range = 1 |
363 |
|
|
DO WHILE (range<ourCEnd-ourCStart) |
364 |
|
|
reps = reps + 1 |
365 |
|
|
range = range*(reps+availCP)/reps |
366 |
|
|
END DO |
367 |
|
|
bino1 = range*reps/(availCP+reps) |
368 |
|
|
IF (availCP>1) THEN |
369 |
|
|
bino2 = bino1*availCP/(availCP+reps-1) |
370 |
|
|
ELSE |
371 |
|
|
bino2 = 1 |
372 |
|
|
END IF |
373 |
|
|
IF (availCP==1) THEN |
374 |
|
|
bino3 = 0 |
375 |
|
|
ELSE IF (availCP>2) THEN |
376 |
|
|
bino3 = bino2*(availCP-1)/(availCP+reps-2) |
377 |
|
|
ELSE |
378 |
|
|
bino3 = 1 |
379 |
|
|
END IF |
380 |
|
|
bino4 = bino2*(reps-1)/availCP |
381 |
|
|
IF (availCP<3) THEN |
382 |
|
|
bino5 = 0 |
383 |
|
|
ELSE IF (availCP>3) THEN |
384 |
|
|
bino5 = bino3*(availCP-1)/reps |
385 |
|
|
ELSE |
386 |
|
|
bino5 = 1 |
387 |
|
|
END IF |
388 |
|
|
IF (ourCEnd-ourCStart<=bino1+bino3) THEN |
389 |
utke |
1.4 |
ourCStart = int(ourCStart + bino4) |
390 |
utke |
1.1 |
ELSE IF (ourCEnd-ourCStart>=range-bino5) THEN |
391 |
utke |
1.4 |
ourCStart = int(ourCStart + bino1) |
392 |
utke |
1.1 |
ELSE |
393 |
utke |
1.4 |
ourCStart = int(ourCEnd - bino2 - bino3) |
394 |
utke |
1.1 |
END IF |
395 |
|
|
IF (ourCStart==prevCStart) THEN |
396 |
|
|
ourCStart = prevCStart + 1 |
397 |
|
|
END IF |
398 |
utke |
1.2 |
IF (ourCStart==ourSteps) THEN |
399 |
|
|
ourNumFwd = ourNumFwd + ((ourCStart-1) - prevCStart)*ourBundle + ourTail |
400 |
|
|
ELSE |
401 |
|
|
ourNumFwd = ourNumFwd + (ourCStart - prevCStart)*ourBundle |
402 |
|
|
END IF |
403 |
utke |
1.1 |
rvNextAction%actionFlag = rvForward |
404 |
|
|
END IF |
405 |
|
|
END IF |
406 |
utke |
1.2 |
rvNextAction%startIteration=prevCStart*ourBundle |
407 |
|
|
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 |
utke |
1.1 |
IF (ourVerbosity>2) THEN |
416 |
|
|
SELECT CASE( rvNextAction%actionFlag) |
417 |
|
|
CASE (rvForward) |
418 |
utke |
1.2 |
WRITE (*,FMT='(A,I8,A,I8,A)') ' run forward iterations [', & |
419 |
|
|
rvNextAction%startIteration, ',', rvNextAction%iteration-1,']' |
420 |
utke |
1.1 |
CASE (rvRestore) |
421 |
utke |
1.2 |
WRITE (*,FMT='(A,I8)') ' restore input of iteration ',& |
422 |
|
|
rvNextAction%iteration |
423 |
utke |
1.1 |
CASE (rvFirstUTurn) |
424 |
utke |
1.2 |
WRITE (*,FMT='(A,I8,A,I8,A)') ' 1st uturn for iterations [',& |
425 |
|
|
rvNextAction%startIteration, ',', rvNextAction%iteration-1,']' |
426 |
utke |
1.4 |
CASE(rvUTurn) |
427 |
utke |
1.2 |
WRITE (*,FMT='(A,I8,A,I8,A)') ' uturn for iterations [',& |
428 |
|
|
rvNextAction%startIteration, ',', rvNextAction%iteration-1,']' |
429 |
utke |
1.1 |
END SELECT |
430 |
|
|
END IF |
431 |
utke |
1.2 |
IF ((ourVerbosity>1) .AND. (rvNextAction%actionFlag == rvStore)) THEN |
432 |
|
|
WRITE (*,FMT='(A,I8)') ' store input of iteration ',& |
433 |
|
|
rvNextAction%iteration |
434 |
utke |
1.1 |
END IF |
435 |
|
|
END IF |
436 |
|
|
rvNextAction%cpNum=ourRWCP |
437 |
|
|
END FUNCTION rvNextAction |
438 |
|
|
|
439 |
|
|
!--------------------------------------------------------------------* |
440 |
utke |
1.2 |
!> estimates the number of checkpoints required; equivalent to `adjust` in Alg. 799 |
441 |
|
|
!! @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 |
utke |
1.1 |
IMPLICIT NONE |
448 |
utke |
1.2 |
INTEGER, INTENT(IN) :: steps, bundle |
449 |
|
|
OPTIONAL :: bundle |
450 |
|
|
INTEGER :: reps, s, checkpoints, b, tail, bSteps |
451 |
utke |
1.1 |
INTEGER :: rvGuess |
452 |
utke |
1.2 |
b=1 |
453 |
|
|
bSteps=steps |
454 |
|
|
IF (present(bundle)) THEN |
455 |
|
|
b=bundle |
456 |
|
|
END IF |
457 |
|
|
IF (steps<1) THEN |
458 |
|
|
WRITE (*,fmt=*) 'revolve::rvGuess: error: steps < 1' |
459 |
|
|
rvGuess = -1 |
460 |
|
|
ELSE IF (b<1) THEN |
461 |
|
|
WRITE (*,fmt=*) 'revolve::rvGuess: error: bundle < 1' |
462 |
|
|
rvGuess = -1 |
463 |
|
|
ELSE |
464 |
|
|
IF (b .gt. 1) THEN |
465 |
|
|
tail=modulo(bSteps,b) |
466 |
|
|
bSteps=bSteps/b |
467 |
|
|
IF (tail>0) THEN |
468 |
|
|
bSteps=bSteps+1 |
469 |
|
|
END IF |
470 |
|
|
END IF |
471 |
|
|
IF (bSteps==1) THEN |
472 |
|
|
rvGuess=0 |
473 |
|
|
ELSE |
474 |
|
|
checkpoints = 1 |
475 |
|
|
reps = 1 |
476 |
utke |
1.1 |
s = 0 |
477 |
utke |
1.2 |
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 |
utke |
1.1 |
END IF |
501 |
|
|
END IF |
502 |
|
|
END FUNCTION rvGuess |
503 |
|
|
|
504 |
|
|
!--------------------------------------------------------------------* |
505 |
utke |
1.2 |
!> computes the run time overhead factor; equivalent to `expense` in Alg. 799 |
506 |
|
|
!! @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 |
utke |
1.1 |
IMPLICIT NONE |
514 |
utke |
1.2 |
INTEGER, INTENT(IN) :: checkpoints, steps, bundle |
515 |
|
|
OPTIONAL :: bundle |
516 |
|
|
INTEGER :: b, f |
517 |
utke |
1.1 |
DOUBLE PRECISION :: rvFactor |
518 |
utke |
1.2 |
b=1 |
519 |
|
|
IF (present(bundle)) THEN |
520 |
|
|
b=bundle |
521 |
|
|
END IF |
522 |
|
|
f=forwdCount(steps,checkpoints,b) |
523 |
|
|
IF (f==-1) THEN |
524 |
|
|
WRITE (*,fmt=*) 'revolve::rvFactor: error returned by revolve::forwdCount' |
525 |
|
|
rvFactor=-1 |
526 |
utke |
1.1 |
ELSE |
527 |
utke |
1.2 |
rvFactor = dble(f)/steps |
528 |
utke |
1.1 |
END IF |
529 |
|
|
END FUNCTION rvFactor |
530 |
|
|
|
531 |
|
|
!--------------------------------------------------------------------* |
532 |
utke |
1.2 |
!> internal method not to be referenced by the user |
533 |
utke |
1.1 |
FUNCTION chkRange(ss,tt) |
534 |
|
|
IMPLICIT NONE |
535 |
|
|
INTEGER :: ss, tt |
536 |
|
|
DOUBLE PRECISION :: res |
537 |
|
|
INTEGER :: i |
538 |
|
|
INTEGER :: chkRange |
539 |
|
|
res = 1. |
540 |
|
|
IF (tt<0 .OR. ss<0) THEN |
541 |
utke |
1.2 |
WRITE (*,fmt=*) 'revolve::chkRange: error: negative parameter ' |
542 |
utke |
1.1 |
chkRange = -1 |
543 |
|
|
ELSE |
544 |
|
|
DO i = 1, tt |
545 |
|
|
res = res*(ss+i) |
546 |
|
|
res = res/i |
547 |
utke |
1.4 |
IF (res>huge(chkrange)) EXIT |
548 |
utke |
1.1 |
END DO |
549 |
utke |
1.4 |
IF (res<huge(chkrange)) THEN |
550 |
|
|
chkRange = int(res) |
551 |
utke |
1.1 |
ELSE |
552 |
utke |
1.4 |
chkRange = huge(chkrange) |
553 |
utke |
1.2 |
WRITE (*,fmt=*) 'revolve::chkRange: warning: returning maximal integer ',& |
554 |
|
|
chkRange |
555 |
utke |
1.1 |
END IF |
556 |
|
|
END IF |
557 |
|
|
END FUNCTION chkRange |
558 |
|
|
|
559 |
|
|
!--------------------------------------------------------------------* |
560 |
|
|
|
561 |
utke |
1.2 |
!> 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 |
utke |
1.1 |
IMPLICIT NONE |
565 |
utke |
1.2 |
INTEGER, INTENT(IN) :: checkpoints, steps, bundle |
566 |
|
|
INTEGER :: range, reps,s,tail |
567 |
utke |
1.1 |
INTEGER :: forwdCount |
568 |
utke |
1.2 |
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 |
utke |
1.1 |
forwdCount = -1 |
577 |
|
|
ELSE |
578 |
utke |
1.2 |
s=steps |
579 |
|
|
IF (bundle .gt. 1) THEN |
580 |
|
|
tail=modulo(s,bundle) |
581 |
|
|
s=s/bundle |
582 |
|
|
IF (tail>0) THEN |
583 |
|
|
s=s+1 |
584 |
|
|
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 |
utke |
1.1 |
END IF |
602 |
|
|
END FUNCTION forwdCount |
603 |
|
|
|
604 |
|
|
!--------------------------------------------------------------------* |
605 |
|
|
|
606 |
|
|
END MODULE revolve |