ddriv1.f 17 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365
  1. *DECK DDRIV1
  2. SUBROUTINE DDRIV1 (N, T, Y, F, TOUT, MSTATE, EPS, WORK, LENW,
  3. 8 IERFLG)
  4. C***BEGIN PROLOGUE DDRIV1
  5. C***PURPOSE The function of DDRIV1 is to solve N (200 or fewer)
  6. C ordinary differential equations of the form
  7. C dY(I)/dT = F(Y(I),T), given the initial conditions
  8. C Y(I) = YI. DDRIV1 uses double precision arithmetic.
  9. C***LIBRARY SLATEC (SDRIVE)
  10. C***CATEGORY I1A2, I1A1B
  11. C***TYPE DOUBLE PRECISION (SDRIV1-S, DDRIV1-D, CDRIV1-C)
  12. C***KEYWORDS DOUBLE PRECISION, GEAR'S METHOD, INITIAL VALUE PROBLEMS,
  13. C ODE, ORDINARY DIFFERENTIAL EQUATIONS, SDRIVE, STIFF
  14. C***AUTHOR Kahaner, D. K., (NIST)
  15. C National Institute of Standards and Technology
  16. C Gaithersburg, MD 20899
  17. C Sutherland, C. D., (LANL)
  18. C Mail Stop D466
  19. C Los Alamos National Laboratory
  20. C Los Alamos, NM 87545
  21. C***DESCRIPTION
  22. C
  23. C Version 92.1
  24. C
  25. C I. CHOOSING THE CORRECT ROUTINE ...................................
  26. C
  27. C SDRIV
  28. C DDRIV
  29. C CDRIV
  30. C These are the generic names for three packages for solving
  31. C initial value problems for ordinary differential equations.
  32. C SDRIV uses single precision arithmetic. DDRIV uses double
  33. C precision arithmetic. CDRIV allows complex-valued
  34. C differential equations, integrated with respect to a single,
  35. C real, independent variable.
  36. C
  37. C As an aid in selecting the proper program, the following is a
  38. C discussion of the important options or restrictions associated with
  39. C each program:
  40. C
  41. C A. DDRIV1 should be tried first for those routine problems with
  42. C no more than 200 differential equations (DDRIV2 and DDRIV3
  43. C have no such restriction.) Internally this routine has two
  44. C important technical defaults:
  45. C 1. Numerical approximation of the Jacobian matrix of the
  46. C right hand side is used.
  47. C 2. The stiff solver option is used.
  48. C Most users of DDRIV1 should not have to concern themselves
  49. C with these details.
  50. C
  51. C B. DDRIV2 should be considered for those problems for which
  52. C DDRIV1 is inadequate. For example, DDRIV1 may have difficulty
  53. C with problems having zero initial conditions and zero
  54. C derivatives. In this case DDRIV2, with an appropriate value
  55. C of the parameter EWT, should perform more efficiently. DDRIV2
  56. C provides three important additional options:
  57. C 1. The nonstiff equation solver (as well as the stiff
  58. C solver) is available.
  59. C 2. The root-finding option is available.
  60. C 3. The program can dynamically select either the non-stiff
  61. C or the stiff methods.
  62. C Internally this routine also defaults to the numerical
  63. C approximation of the Jacobian matrix of the right hand side.
  64. C
  65. C C. DDRIV3 is the most flexible, and hence the most complex, of
  66. C the programs. Its important additional features include:
  67. C 1. The ability to exploit band structure in the Jacobian
  68. C matrix.
  69. C 2. The ability to solve some implicit differential
  70. C equations, i.e., those having the form:
  71. C A(Y,T)*dY/dT = F(Y,T).
  72. C 3. The option of integrating in the one step mode.
  73. C 4. The option of allowing the user to provide a routine
  74. C which computes the analytic Jacobian matrix of the right
  75. C hand side.
  76. C 5. The option of allowing the user to provide a routine
  77. C which does all the matrix algebra associated with
  78. C corrections to the solution components.
  79. C
  80. C II. PARAMETERS ....................................................
  81. C
  82. C (REMEMBER--To run DDRIV1 correctly in double precision, ALL
  83. C non-integer arguments in the call sequence, including
  84. C arrays, MUST be declared double precision.)
  85. C
  86. C The user should use parameter names in the call sequence of DDRIV1
  87. C for those quantities whose value may be altered by DDRIV1. The
  88. C parameters in the call sequence are:
  89. C
  90. C N = (Input) The number of differential equations, N .LE. 200
  91. C
  92. C T = The independent variable. On input for the first call, T
  93. C is the initial point. On output, T is the point at which
  94. C the solution is given.
  95. C
  96. C Y = The vector of dependent variables. Y is used as input on
  97. C the first call, to set the initial values. On output, Y
  98. C is the computed solution vector. This array Y is passed
  99. C in the call sequence of the user-provided routine F. Thus
  100. C parameters required by F can be stored in this array in
  101. C components N+1 and above. (Note: Changes by the user to
  102. C the first N components of this array will take effect only
  103. C after a restart, i.e., after setting MSTATE to +1(-1).)
  104. C
  105. C F = A subroutine supplied by the user. The name must be
  106. C declared EXTERNAL in the user's calling program. This
  107. C subroutine is of the form:
  108. C SUBROUTINE F (N, T, Y, YDOT)
  109. C DOUBLE PRECISION Y(*), YDOT(*)
  110. C .
  111. C .
  112. C YDOT(1) = ...
  113. C .
  114. C .
  115. C YDOT(N) = ...
  116. C END (Sample)
  117. C This computes YDOT = F(Y,T), the right hand side of the
  118. C differential equations. Here Y is a vector of length at
  119. C least N. The actual length of Y is determined by the
  120. C user's declaration in the program which calls DDRIV1.
  121. C Thus the dimensioning of Y in F, while required by FORTRAN
  122. C convention, does not actually allocate any storage. When
  123. C this subroutine is called, the first N components of Y are
  124. C intermediate approximations to the solution components.
  125. C The user should not alter these values. Here YDOT is a
  126. C vector of length N. The user should only compute YDOT(I)
  127. C for I from 1 to N. Normally a return from F passes
  128. C control back to DDRIV1. However, if the user would like
  129. C to abort the calculation, i.e., return control to the
  130. C program which calls DDRIV1, he should set N to zero.
  131. C DDRIV1 will signal this by returning a value of MSTATE
  132. C equal to +5(-5). Altering the value of N in F has no
  133. C effect on the value of N in the call sequence of DDRIV1.
  134. C
  135. C TOUT = (Input) The point at which the solution is desired.
  136. C
  137. C MSTATE = An integer describing the status of integration. The user
  138. C must initialize MSTATE to +1 or -1. If MSTATE is
  139. C positive, the routine will integrate past TOUT and
  140. C interpolate the solution. This is the most efficient
  141. C mode. If MSTATE is negative, the routine will adjust its
  142. C internal step to reach TOUT exactly (useful if a
  143. C singularity exists beyond TOUT.) The meaning of the
  144. C magnitude of MSTATE:
  145. C 1 (Input) Means the first call to the routine. This
  146. C value must be set by the user. On all subsequent
  147. C calls the value of MSTATE should be tested by the
  148. C user. Unless DDRIV1 is to be reinitialized, only the
  149. C sign of MSTATE may be changed by the user. (As a
  150. C convenience to the user who may wish to put out the
  151. C initial conditions, DDRIV1 can be called with
  152. C MSTATE=+1(-1), and TOUT=T. In this case the program
  153. C will return with MSTATE unchanged, i.e.,
  154. C MSTATE=+1(-1).)
  155. C 2 (Output) Means a successful integration. If a normal
  156. C continuation is desired (i.e., a further integration
  157. C in the same direction), simply advance TOUT and call
  158. C again. All other parameters are automatically set.
  159. C 3 (Output)(Unsuccessful) Means the integrator has taken
  160. C 1000 steps without reaching TOUT. The user can
  161. C continue the integration by simply calling DDRIV1
  162. C again.
  163. C 4 (Output)(Unsuccessful) Means too much accuracy has
  164. C been requested. EPS has been increased to a value
  165. C the program estimates is appropriate. The user can
  166. C continue the integration by simply calling DDRIV1
  167. C again.
  168. C 5 (Output)(Unsuccessful) N has been set to zero in
  169. C SUBROUTINE F.
  170. C 6 (Output)(Successful) For MSTATE negative, T is beyond
  171. C TOUT. The solution was obtained by interpolation.
  172. C The user can continue the integration by simply
  173. C advancing TOUT and calling DDRIV1 again.
  174. C 7 (Output)(Unsuccessful) The solution could not be
  175. C obtained. The value of IERFLG (see description
  176. C below) for a "Recoverable" situation indicates the
  177. C type of difficulty encountered: either an illegal
  178. C value for a parameter or an inability to continue the
  179. C solution. For this condition the user should take
  180. C corrective action and reset MSTATE to +1(-1) before
  181. C calling DDRIV1 again. Otherwise the program will
  182. C terminate the run.
  183. C
  184. C EPS = On input, the requested relative accuracy in all solution
  185. C components. On output, the adjusted relative accuracy if
  186. C the input value was too small. The value of EPS should be
  187. C set as large as is reasonable, because the amount of work
  188. C done by DDRIV1 increases as EPS decreases.
  189. C
  190. C WORK
  191. C LENW = (Input)
  192. C WORK is an array of LENW double precision words used
  193. C internally for temporary storage. The user must allocate
  194. C space for this array in the calling program by a statement
  195. C such as
  196. C DOUBLE PRECISION WORK(...)
  197. C The length of WORK should be at least N*N + 11*N + 300
  198. C and LENW should be set to the value used. The contents of
  199. C WORK should not be disturbed between calls to DDRIV1.
  200. C
  201. C IERFLG = An error flag. The error number associated with a
  202. C diagnostic message (see Section IV-A below) is the same as
  203. C the corresponding value of IERFLG. The meaning of IERFLG:
  204. C 0 The routine completed successfully. (No message is
  205. C issued.)
  206. C 3 (Warning) The number of steps required to reach TOUT
  207. C exceeds 1000 .
  208. C 4 (Warning) The value of EPS is too small.
  209. C 11 (Warning) For MSTATE negative, T is beyond TOUT.
  210. C The solution was obtained by interpolation.
  211. C 15 (Warning) The integration step size is below the
  212. C roundoff level of T. (The program issues this
  213. C message as a warning but does not return control to
  214. C the user.)
  215. C 21 (Recoverable) N is greater than 200 .
  216. C 22 (Recoverable) N is not positive.
  217. C 26 (Recoverable) The magnitude of MSTATE is either 0 or
  218. C greater than 7 .
  219. C 27 (Recoverable) EPS is less than zero.
  220. C 32 (Recoverable) Insufficient storage has been allocated
  221. C for the WORK array.
  222. C 41 (Recoverable) The integration step size has gone
  223. C to zero.
  224. C 42 (Recoverable) The integration step size has been
  225. C reduced about 50 times without advancing the
  226. C solution. The problem setup may not be correct.
  227. C 999 (Fatal) The magnitude of MSTATE is 7 .
  228. C
  229. C III. USAGE ........................................................
  230. C
  231. C PROGRAM SAMPLE
  232. C EXTERNAL F
  233. C DOUBLE PRECISION ALFA, EPS, T, TOUT
  234. C C N is the number of equations
  235. C PARAMETER(ALFA = 1.D0, N = 3, LENW = N*N + 11*N + 300)
  236. C DOUBLE PRECISION WORK(LENW), Y(N+1)
  237. C C Initial point
  238. C T = 0.00001D0
  239. C C Set initial conditions
  240. C Y(1) = 10.D0
  241. C Y(2) = 0.D0
  242. C Y(3) = 10.D0
  243. C C Pass parameter
  244. C Y(4) = ALFA
  245. C TOUT = T
  246. C MSTATE = 1
  247. C EPS = .001D0
  248. C 10 CALL DDRIV1 (N, T, Y, F, TOUT, MSTATE, EPS, WORK, LENW,
  249. C 8 IERFLG)
  250. C IF (MSTATE .GT. 2) STOP
  251. C WRITE(*, '(4E12.3)') TOUT, (Y(I), I=1,3)
  252. C TOUT = 10.D0*TOUT
  253. C IF (TOUT .LT. 50.D0) GO TO 10
  254. C END
  255. C
  256. C SUBROUTINE F (N, T, Y, YDOT)
  257. C DOUBLE PRECISION ALFA, T, Y(*), YDOT(*)
  258. C ALFA = Y(N+1)
  259. C YDOT(1) = 1.D0 + ALFA*(Y(2) - Y(1)) - Y(1)*Y(3)
  260. C YDOT(2) = ALFA*(Y(1) - Y(2)) - Y(2)*Y(3)
  261. C YDOT(3) = 1.D0 - Y(3)*(Y(1) + Y(2))
  262. C END
  263. C
  264. C IV. OTHER COMMUNICATION TO THE USER ...............................
  265. C
  266. C A. The solver communicates to the user through the parameters
  267. C above. In addition it writes diagnostic messages through the
  268. C standard error handling program XERMSG. A complete description
  269. C of XERMSG is given in "Guide to the SLATEC Common Mathematical
  270. C Library" by Kirby W. Fong et al.. At installations which do not
  271. C have this error handling package the short but serviceable
  272. C routine, XERMSG, available with this package, can be used. That
  273. C program uses the file named OUTPUT to transmit messages.
  274. C
  275. C B. The number of evaluations of the right hand side can be found
  276. C in the WORK array in the location determined by:
  277. C LENW - (N + 50) + 4
  278. C
  279. C V. REMARKS ........................................................
  280. C
  281. C For other information, see Section IV of the writeup for DDRIV3.
  282. C
  283. C***REFERENCES C. W. Gear, Numerical Initial Value Problems in
  284. C Ordinary Differential Equations, Prentice-Hall, 1971.
  285. C***ROUTINES CALLED DDRIV3, XERMSG
  286. C***REVISION HISTORY (YYMMDD)
  287. C 790601 DATE WRITTEN
  288. C 900329 Initial submission to SLATEC.
  289. C***END PROLOGUE DDRIV1
  290. EXTERNAL F
  291. DOUBLE PRECISION EPS, EWTCOM(1), HMAX, T, TOUT, WORK(*), Y(*)
  292. INTEGER I, IDLIW, IERFLG, IERROR, IMPL, LENIW, LENW, LENWCM,
  293. 8 LNWCHK, MINT, MITER, ML, MSTATE, MU, MXN, MXORD, MXSTEP,
  294. 8 N, NDE, NROOT, NSTATE, NTASK
  295. PARAMETER(MXN = 200, IDLIW = 50)
  296. INTEGER IWORK(IDLIW+MXN)
  297. CHARACTER INTGR1*8
  298. PARAMETER(NROOT = 0, IERROR = 2, MINT = 2, MITER = 2, IMPL = 0,
  299. 8 MXORD = 5, MXSTEP = 1000)
  300. DATA EWTCOM(1) /1.D0/
  301. C***FIRST EXECUTABLE STATEMENT DDRIV1
  302. IF (ABS(MSTATE) .EQ. 0 .OR. ABS(MSTATE) .GT. 7) THEN
  303. WRITE(INTGR1, '(I8)') MSTATE
  304. IERFLG = 26
  305. CALL XERMSG('SLATEC', 'DDRIV1',
  306. 8 'Illegal input. The magnitude of MSTATE, '//INTGR1//
  307. 8 ', is not in the range 1 to 6 .', IERFLG, 1)
  308. MSTATE = SIGN(7, MSTATE)
  309. RETURN
  310. ELSE IF (ABS(MSTATE) .EQ. 7) THEN
  311. IERFLG = 999
  312. CALL XERMSG('SLATEC', 'DDRIV1',
  313. 8 'Illegal input. The magnitude of MSTATE is 7 .', IERFLG, 2)
  314. RETURN
  315. END IF
  316. IF (N .GT. MXN) THEN
  317. WRITE(INTGR1, '(I8)') N
  318. IERFLG = 21
  319. CALL XERMSG('SLATEC', 'DDRIV1',
  320. 8 'Illegal input. The number of equations, '//INTGR1//
  321. 8 ', is greater than the maximum allowed: 200 .', IERFLG, 1)
  322. MSTATE = SIGN(7, MSTATE)
  323. RETURN
  324. END IF
  325. IF (MSTATE .GT. 0) THEN
  326. NSTATE = MSTATE
  327. NTASK = 1
  328. ELSE
  329. NSTATE = - MSTATE
  330. NTASK = 3
  331. END IF
  332. HMAX = 2.D0*ABS(TOUT - T)
  333. LENIW = N + IDLIW
  334. LENWCM = LENW - LENIW
  335. IF (LENWCM .LT. (N*N + 10*N + 250)) THEN
  336. LNWCHK = N*N + 10*N + 250 + LENIW
  337. WRITE(INTGR1, '(I8)') LNWCHK
  338. IERFLG = 32
  339. CALL XERMSG('SLATEC', 'DDRIV1',
  340. 8 'Insufficient storage allocated for the work array. '//
  341. 8 'The required storage is at least '//INTGR1//' .', IERFLG, 1)
  342. MSTATE = SIGN(7, MSTATE)
  343. RETURN
  344. END IF
  345. IF (NSTATE .NE. 1) THEN
  346. DO 20 I = 1,LENIW
  347. 20 IWORK(I) = WORK(I+LENWCM)
  348. END IF
  349. CALL DDRIV3 (N, T, Y, F, NSTATE, TOUT, NTASK, NROOT, EPS, EWTCOM,
  350. 8 IERROR, MINT, MITER, IMPL, ML, MU, MXORD, HMAX, WORK,
  351. 8 LENWCM, IWORK, LENIW, F, F, NDE, MXSTEP, F, F,
  352. 8 IERFLG)
  353. DO 40 I = 1,LENIW
  354. 40 WORK(I+LENWCM) = IWORK(I)
  355. IF (NSTATE .LE. 4) THEN
  356. MSTATE = SIGN(NSTATE, MSTATE)
  357. ELSE IF (NSTATE .EQ. 6) THEN
  358. MSTATE = SIGN(5, MSTATE)
  359. ELSE IF (IERFLG .EQ. 11) THEN
  360. MSTATE = SIGN(6, MSTATE)
  361. ELSE IF (IERFLG .GT. 11) THEN
  362. MSTATE = SIGN(7, MSTATE)
  363. END IF
  364. RETURN
  365. END