cdriv1.f 17 KB

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