sdriv1.f 17 KB

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