예제 #1
0
파일: dvode.cs 프로젝트: Altaxo/Altaxo
		/// <param name="F">
		/// = The name of the user-supplied subroutine defining the
		/// ODE system.  The system must be put in the first-order
		/// form dy/dt = f(t,y), where f is a vector-valued function
		/// of the scalar t and the vector y.  Subroutine F is to
		/// compute the function f.  It is to have the form
		/// SUBROUTINE F (NEQ, T, Y, YDOT, RPAR, IPAR)
		/// DOUBLE PRECISION T, Y(NEQ), YDOT(NEQ), RPAR
		/// where NEQ, T, and Y are input, and the array YDOT = f(t,y)
		/// is output.  Y and YDOT are arrays of length NEQ.
		/// Subroutine F should not alter Y(1),...,Y(NEQ).
		/// F must be declared EXTERNAL in the calling program.
		///
		/// Subroutine F may access user-defined real and integer
		/// work arrays RPAR and IPAR, which are to be dimensioned
		/// in the main program.
		///
		/// If quantities computed in the F routine are needed
		/// externally to DVODE, an extra call to F should be made
		/// for this purpose, for consistent and accurate results.
		/// If only the derivative dy/dt is needed, use DVINDY instead.
		///</param>
		/// <param name="NEQ">
		/// = The size of the ODE system (number of first order
		/// ordinary differential equations).  Used only for input.
		/// NEQ may not be increased during the problem, but
		/// can be decreased (with ISTATE = 3 in the input).
		///</param>
		/// <param name="Y">
		/// = A real array for the vector of dependent variables, of
		/// length NEQ or more.  Used for both input and output on the
		/// first call (ISTATE = 1), and only for output on other calls.
		/// On the first call, Y must contain the vector of initial
		/// values.  In the output, Y contains the computed solution
		/// evaluated at T.  If desired, the Y array may be used
		/// for other purposes between calls to the solver.
		///
		/// This array is passed as the Y argument in all calls to
		/// F and JAC.
		///</param>
		/// <param name="T">
		/// = The independent variable.  In the input, T is used only on
		/// the first call, as the initial point of the integration.
		/// In the output, after each call, T is the value at which a
		/// computed solution Y is evaluated (usually the same as TOUT).
		/// On an error return, T is the farthest point reached.
		///</param>
		/// <param name="TOUT">
		/// = The next value of t at which a computed solution is desired.
		/// Used only for input.
		///
		/// When starting the problem (ISTATE = 1), TOUT may be equal
		/// to T for one call, then should .ne. T for the next call.
		/// For the initial T, an input value of TOUT .ne. T is used
		/// in order to determine the direction of the integration
		/// (i.e. the algebraic sign of the step sizes) and the rough
		/// scale of the problem.  Integration in either direction
		/// (forward or backward in t) is permitted.
		///
		/// If ITASK = 2 or 5 (one-step modes), TOUT is ignored after
		/// the first call (i.e. the first call with TOUT .ne. T).
		/// Otherwise, TOUT is required on every call.
		///
		/// If ITASK = 1, 3, or 4, the values of TOUT need not be
		/// monotone, but a value of TOUT which backs up is limited
		/// to the current internal t interval, whose endpoints are
		/// TCUR - HU and TCUR.  (See optional output, below, for
		/// TCUR and HU.)
		///</param>
		/// <param name="ITOL">
		/// = An indicator for the type of error control.  See
		/// description below under ATOL.  Used only for input.
		///</param>
		/// <param name="RTOL">
		/// = A relative error tolerance parameter, either a scalar or
		/// an array of length NEQ.  See description below under ATOL.
		/// Input only.
		///</param>
		/// <param name="ATOL">
		/// = An absolute error tolerance parameter, either a scalar or
		/// an array of length NEQ.  Input only.
		///
		/// The input parameters ITOL, RTOL, and ATOL determine
		/// the error control performed by the solver.  The solver will
		/// control the vector e = (e(i)) of estimated local errors
		/// in Y, according to an inequality of the form
		/// rms-norm of ( e(i)/EWT(i) )   .le.   1,
		/// where       EWT(i) = RTOL(i)*abs(Y(i)) + ATOL(i),
		/// and the rms-norm (root-mean-square norm) here is
		/// rms-norm(v) = sqrt(sum v(i)**2 / NEQ).  Here EWT = (EWT(i))
		/// is a vector of weights which must always be positive, and
		/// the values of RTOL and ATOL should all be non-negative.
		/// The following table gives the types (scalar/array) of
		/// RTOL and ATOL, and the corresponding form of EWT(i).
		///
		/// ITOL    RTOL       ATOL          EWT(i)
		/// 1     scalar     scalar     RTOL*ABS(Y(i)) + ATOL
		/// 2     scalar     array      RTOL*ABS(Y(i)) + ATOL(i)
		/// 3     array      scalar     RTOL(i)*ABS(Y(i)) + ATOL
		/// 4     array      array      RTOL(i)*ABS(Y(i)) + ATOL(i)
		///
		/// When either of these parameters is a scalar, it need not
		/// be dimensioned in the user's calling program.
		///
		/// If none of the above choices (with ITOL, RTOL, and ATOL
		/// fixed throughout the problem) is suitable, more general
		/// error controls can be obtained by substituting
		/// user-supplied routines for the setting of EWT and/or for
		/// the norm calculation.  See Part iv below.
		///
		/// If global errors are to be estimated by making a repeated
		/// run on the same problem with smaller tolerances, then all
		/// components of RTOL and ATOL (i.e. of EWT) should be scaled
		/// down uniformly.
		///</param>
		/// <param name="ITASK">
		/// = An index specifying the task to be performed.
		/// Input only.  ITASK has the following values and meanings.
		/// 1  means normal computation of output values of y(t) at
		/// t = TOUT (by overshooting and interpolating).
		/// 2  means take one step only and return.
		/// 3  means stop at the first internal mesh point at or
		/// beyond t = TOUT and return.
		/// 4  means normal computation of output values of y(t) at
		/// t = TOUT but without overshooting t = TCRIT.
		/// TCRIT must be input as RWORK(1).  TCRIT may be equal to
		/// or beyond TOUT, but not behind it in the direction of
		/// integration.  This option is useful if the problem
		/// has a singularity at or beyond t = TCRIT.
		/// 5  means take one step, without passing TCRIT, and return.
		/// TCRIT must be input as RWORK(1).
		///
		/// Note:  If ITASK = 4 or 5 and the solver reaches TCRIT
		/// (within roundoff), it will return T = TCRIT (exactly) to
		/// indicate this (unless ITASK = 4 and TOUT comes before TCRIT,
		/// in which case answers at T = TOUT are returned first).
		///</param>
		/// <param name="ISTATE">
		/// = an index used for input and output to specify the
		/// the state of the calculation.
		///
		/// In the input, the values of ISTATE are as follows.
		/// 1  means this is the first call for the problem
		/// (initializations will be done).  See note below.
		/// 2  means this is not the first call, and the calculation
		/// is to continue normally, with no change in any input
		/// parameters except possibly TOUT and ITASK.
		/// (If ITOL, RTOL, and/or ATOL are changed between calls
		/// with ISTATE = 2, the new values will be used but not
		/// tested for legality.)
		/// 3  means this is not the first call, and the
		/// calculation is to continue normally, but with
		/// a change in input parameters other than
		/// TOUT and ITASK.  Changes are allowed in
		/// NEQ, ITOL, RTOL, ATOL, IOPT, LRW, LIW, MF, ML, MU,
		/// and any of the optional input except H0.
		/// (See IWORK description for ML and MU.)
		/// Note:  A preliminary call with TOUT = T is not counted
		/// as a first call here, as no initialization or checking of
		/// input is done.  (Such a call is sometimes useful to include
		/// the initial conditions in the output.)
		/// Thus the first call for which TOUT .ne. T requires
		/// ISTATE = 1 in the input.
		///
		/// In the output, ISTATE has the following values and meanings.
		/// 1  means nothing was done, as TOUT was equal to T with
		/// ISTATE = 1 in the input.
		/// 2  means the integration was performed successfully.
		/// -1  means an excessive amount of work (more than MXSTEP
		/// steps) was done on this call, before completing the
		/// requested task, but the integration was otherwise
		/// successful as far as T.  (MXSTEP is an optional input
		/// and is normally 500.)  To continue, the user may
		/// simply reset ISTATE to a value .gt. 1 and call again.
		/// (The excess work step counter will be reset to 0.)
		/// In addition, the user may increase MXSTEP to avoid
		/// this error return.  (See optional input below.)
		/// -2  means too much accuracy was requested for the precision
		/// of the machine being used.  This was detected before
		/// completing the requested task, but the integration
		/// was successful as far as T.  To continue, the tolerance
		/// parameters must be reset, and ISTATE must be set
		/// to 3.  The optional output TOLSF may be used for this
		/// purpose.  (Note: If this condition is detected before
		/// taking any steps, then an illegal input return
		/// (ISTATE = -3) occurs instead.)
		/// -3  means illegal input was detected, before taking any
		/// integration steps.  See written message for details.
		/// Note:  If the solver detects an infinite loop of calls
		/// to the solver with illegal input, it will cause
		/// the run to stop.
		/// -4  means there were repeated error test failures on
		/// one attempted step, before completing the requested
		/// task, but the integration was successful as far as T.
		/// The problem may have a singularity, or the input
		/// may be inappropriate.
		/// -5  means there were repeated convergence test failures on
		/// one attempted step, before completing the requested
		/// task, but the integration was successful as far as T.
		/// This may be caused by an inaccurate Jacobian matrix,
		/// if one is being used.
		/// -6  means EWT(i) became zero for some i during the
		/// integration.  Pure relative error control (ATOL(i)=0.0)
		/// was requested on a variable which has now vanished.
		/// The integration was successful as far as T.
		///
		/// Note:  Since the normal output value of ISTATE is 2,
		/// it does not need to be reset for normal continuation.
		/// Also, since a negative input value of ISTATE will be
		/// regarded as illegal, a negative output value requires the
		/// user to change it, and possibly other input, before
		/// calling the solver again.
		///</param>
		/// <param name="IOPT">
		/// = An integer flag to specify whether or not any optional
		/// input is being used on this call.  Input only.
		/// The optional input is listed separately below.
		/// IOPT = 0 means no optional input is being used.
		/// Default values will be used in all cases.
		/// IOPT = 1 means optional input is being used.
		///</param>
		/// <param name="RWORK">
		/// = A real working array (double precision).
		/// The length of RWORK must be at least
		/// 20 + NYH*(MAXORD + 1) + 3*NEQ + LWM    where
		/// NYH    = the initial value of NEQ,
		/// MAXORD = 12 (if METH = 1) or 5 (if METH = 2) (unless a
		/// smaller value is given as an optional input),
		/// LWM = length of work space for matrix-related data:
		/// LWM = 0             if MITER = 0,
		/// LWM = 2*NEQ**2 + 2  if MITER = 1 or 2, and MF.gt.0,
		/// LWM = NEQ**2 + 2    if MITER = 1 or 2, and MF.lt.0,
		/// LWM = NEQ + 2       if MITER = 3,
		/// LWM = (3*ML+2*MU+2)*NEQ + 2 if MITER = 4 or 5, and MF.gt.0,
		/// LWM = (2*ML+MU+1)*NEQ + 2   if MITER = 4 or 5, and MF.lt.0.
		/// (See the MF description for METH and MITER.)
		/// Thus if MAXORD has its default value and NEQ is constant,
		/// this length is:
		/// 20 + 16*NEQ                    for MF = 10,
		/// 22 + 16*NEQ + 2*NEQ**2         for MF = 11 or 12,
		/// 22 + 16*NEQ + NEQ**2           for MF = -11 or -12,
		/// 22 + 17*NEQ                    for MF = 13,
		/// 22 + 18*NEQ + (3*ML+2*MU)*NEQ  for MF = 14 or 15,
		/// 22 + 17*NEQ + (2*ML+MU)*NEQ    for MF = -14 or -15,
		/// 20 +  9*NEQ                    for MF = 20,
		/// 22 +  9*NEQ + 2*NEQ**2         for MF = 21 or 22,
		/// 22 +  9*NEQ + NEQ**2           for MF = -21 or -22,
		/// 22 + 10*NEQ                    for MF = 23,
		/// 22 + 11*NEQ + (3*ML+2*MU)*NEQ  for MF = 24 or 25.
		/// 22 + 10*NEQ + (2*ML+MU)*NEQ    for MF = -24 or -25.
		/// The first 20 words of RWORK are reserved for conditional
		/// and optional input and optional output.
		///
		/// The following word in RWORK is a conditional input:
		/// RWORK(1) = TCRIT = critical value of t which the solver
		/// is not to overshoot.  Required if ITASK is
		/// 4 or 5, and ignored otherwise.  (See ITASK.)
		///</param>
		/// <param name="LRW">
		/// = The length of the array RWORK, as declared by the user.
		/// (This will be checked by the solver.)
		///</param>
		/// <param name="IWORK">
		/// = An integer work array.  The length of IWORK must be at least
		/// 30        if MITER = 0 or 3 (MF = 10, 13, 20, 23), or
		/// 30 + NEQ  otherwise (abs(MF) = 11,12,14,15,21,22,24,25).
		/// The first 30 words of IWORK are reserved for conditional and
		/// optional input and optional output.
		///
		/// The following 2 words in IWORK are conditional input:
		/// IWORK(1) = ML     These are the lower and upper
		/// IWORK(2) = MU     half-bandwidths, respectively, of the
		/// banded Jacobian, excluding the main diagonal.
		/// The band is defined by the matrix locations
		/// (i,j) with i-ML .le. j .le. i+MU.  ML and MU
		/// must satisfy  0 .le.  ML,MU  .le. NEQ-1.
		/// These are required if MITER is 4 or 5, and
		/// ignored otherwise.  ML and MU may in fact be
		/// the band parameters for a matrix to which
		/// df/dy is only approximately equal.
		///</param>
		/// <param name="LIW">
		/// = the length of the array IWORK, as declared by the user.
		/// (This will be checked by the solver.)
		///</param>
		/// <param name="JAC">
		/// = The name of the user-supplied routine (MITER = 1 or 4) to
		/// compute the Jacobian matrix, df/dy, as a function of
		/// the scalar t and the vector y.  It is to have the form
		/// SUBROUTINE JAC (NEQ, T, Y, ML, MU, PD, NROWPD,
		/// RPAR, IPAR)
		/// DOUBLE PRECISION T, Y(NEQ), PD(NROWPD,NEQ), RPAR
		/// where NEQ, T, Y, ML, MU, and NROWPD are input and the array
		/// PD is to be loaded with partial derivatives (elements of the
		/// Jacobian matrix) in the output.  PD must be given a first
		/// dimension of NROWPD.  T and Y have the same meaning as in
		/// Subroutine F.
		/// In the full matrix case (MITER = 1), ML and MU are
		/// ignored, and the Jacobian is to be loaded into PD in
		/// columnwise manner, with df(i)/dy(j) loaded into PD(i,j).
		/// In the band matrix case (MITER = 4), the elements
		/// within the band are to be loaded into PD in columnwise
		/// manner, with diagonal lines of df/dy loaded into the rows
		/// of PD. Thus df(i)/dy(j) is to be loaded into PD(i-j+MU+1,j).
		/// ML and MU are the half-bandwidth parameters. (See IWORK).
		/// The locations in PD in the two triangular areas which
		/// correspond to nonexistent matrix elements can be ignored
		/// or loaded arbitrarily, as they are overwritten by DVODE.
		/// JAC need not provide df/dy exactly.  A crude
		/// approximation (possibly with a smaller bandwidth) will do.
		/// In either case, PD is preset to zero by the solver,
		/// so that only the nonzero elements need be loaded by JAC.
		/// Each call to JAC is preceded by a call to F with the same
		/// arguments NEQ, T, and Y.  Thus to gain some efficiency,
		/// intermediate quantities shared by both calculations may be
		/// saved in a user COMMON block by F and not recomputed by JAC,
		/// if desired.  Also, JAC may alter the Y array, if desired.
		/// JAC must be declared external in the calling program.
		/// Subroutine JAC may access user-defined real and integer
		/// work arrays, RPAR and IPAR, whose dimensions are set by the
		/// user in the main program.
		///</param>
		/// <param name="MF">
		/// = The method flag.  Used only for input.  The legal values of
		/// MF are 10, 11, 12, 13, 14, 15, 20, 21, 22, 23, 24, 25,
		/// -11, -12, -14, -15, -21, -22, -24, -25.
		/// MF is a signed two-digit integer, MF = JSV*(10*METH + MITER).
		/// JSV = SIGN(MF) indicates the Jacobian-saving strategy:
		/// JSV =  1 means a copy of the Jacobian is saved for reuse
		/// in the corrector iteration algorithm.
		/// JSV = -1 means a copy of the Jacobian is not saved
		/// (valid only for MITER = 1, 2, 4, or 5).
		/// METH indicates the basic linear multistep method:
		/// METH = 1 means the implicit Adams method.
		/// METH = 2 means the method based on backward
		/// differentiation formulas (BDF-s).
		/// MITER indicates the corrector iteration method:
		/// MITER = 0 means functional iteration (no Jacobian matrix
		/// is involved).
		/// MITER = 1 means chord iteration with a user-supplied
		/// full (NEQ by NEQ) Jacobian.
		/// MITER = 2 means chord iteration with an internally
		/// generated (difference quotient) full Jacobian
		/// (using NEQ extra calls to F per df/dy value).
		/// MITER = 3 means chord iteration with an internally
		/// generated diagonal Jacobian approximation
		/// (using 1 extra call to F per df/dy evaluation).
		/// MITER = 4 means chord iteration with a user-supplied
		/// banded Jacobian.
		/// MITER = 5 means chord iteration with an internally
		/// generated banded Jacobian (using ML+MU+1 extra
		/// calls to F per df/dy evaluation).
		/// If MITER = 1 or 4, the user must supply a subroutine JAC
		/// (the name is arbitrary) as described above under JAC.
		/// For other values of MITER, a dummy argument can be used.
		///</param>
		/// <param name="RPAR">
		/// User-specified array used to communicate real parameters
		/// to user-supplied subroutines.  If RPAR is a vector, then
		/// it must be dimensioned in the user's main program.  If it
		/// is unused or it is a scalar, then it need not be
		/// dimensioned.
		///</param>
		/// <param name="IPAR">
		/// User-specified array used to communicate integer parameter
		/// to user-supplied subroutines.  The comments on dimensioning
		/// RPAR apply to IPAR.
		///</param>
		public void Run(IFEX F, int NEQ, ref double[] Y, int offset_y, ref double T, double TOUT, int ITOL
										 , double[] RTOL, int offset_rtol, double[] ATOL, int offset_atol, int ITASK, ref int ISTATE, int IOPT, ref double[] RWORK, int offset_rwork
										 , int LRW, ref int[] IWORK, int offset_iwork, int LIW, IJEX JAC, int MF, double[] RPAR, int offset_rpar
										 , int[] IPAR, int offset_ipar)
		{
			#region Variables

			bool IHIT = false; double ATOLI = 0; double BIG = 0; double EWTI = 0; double H0 = 0; double HMAX = 0; double HMX = 0;
			double RH = 0; double RTOLI = 0; double SIZE = 0; double TCRIT = 0; double TNEXT = 0; double TOLSF = 0; double TP = 0;
			int I = 0; int IER = 0; int IFLAG = 0; int IMXER = 0; int JCO = 0; int KGO = 0; int LENIW = 0; int LENJ = 0;
			int LENP = 0; int LENRW = 0; int LENWM = 0; int LF0 = 0; int MBAND = 0; int MFA = 0; int ML = 0; int MU = 0;
			int NITER = 0; int NSLAST = 0; string MSG = new string(' ', 80);

			#endregion Variables

			#region Array Index Correction

			int o_y = -1 + offset_y; int o_rtol = -1 + offset_rtol; int o_atol = -1 + offset_atol;
			int o_rwork = -1 + offset_rwork; int o_iwork = -1 + offset_iwork; int o_rpar = -1 + offset_rpar;
			int o_ipar = -1 + offset_ipar;

			#endregion Array Index Correction

			#region Prolog

			// C-----------------------------------------------------------------------
			// C DVODE: Variable-coefficient Ordinary Differential Equation solver,
			// C with fixed-leading-coefficient implementation.
			// C This version is in double precision.
			// C
			// C DVODE solves the initial value problem for stiff or nonstiff
			// C systems of first order ODEs,
			// C     dy/dt = f(t,y) ,  or, in component form,
			// C     dy(i)/dt = f(i) = f(i,t,y(1),y(2),...,y(NEQ)) (i = 1,...,NEQ).
			// C DVODE is a package based on the EPISODE and EPISODEB packages, and
			// C on the ODEPACK user interface standard, with minor modifications.
			// C-----------------------------------------------------------------------
			// C Authors:
			// C               Peter N. Brown and Alan C. Hindmarsh
			// C               Center for Applied Scientific Computing, L-561
			// C               Lawrence Livermore National Laboratory
			// C               Livermore, CA 94551
			// C and
			// C               George D. Byrne
			// C               Illinois Institute of Technology
			// C               Chicago, IL 60616
			// C-----------------------------------------------------------------------
			// C References:
			// C
			// C 1. P. N. Brown, G. D. Byrne, and A. C. Hindmarsh, "VODE: A Variable
			// C    Coefficient ODE Solver," SIAM J. Sci. Stat. Comput., 10 (1989),
			// C    pp. 1038-1051.  Also, LLNL Report UCRL-98412, June 1988.
			// C 2. G. D. Byrne and A. C. Hindmarsh, "A Polyalgorithm for the
			// C    Numerical Solution of Ordinary Differential Equations,"
			// C    ACM Trans. Math. Software, 1 (1975), pp. 71-96.
			// C 3. A. C. Hindmarsh and G. D. Byrne, "EPISODE: An Effective Package
			// C    for the Integration of Systems of Ordinary Differential
			// C    Equations," LLNL Report UCID-30112, Rev. 1, April 1977.
			// C 4. G. D. Byrne and A. C. Hindmarsh, "EPISODEB: An Experimental
			// C    Package for the Integration of Systems of Ordinary Differential
			// C    Equations with Banded Jacobians," LLNL Report UCID-30132, April
			// C    1976.
			// C 5. A. C. Hindmarsh, "ODEPACK, a Systematized Collection of ODE
			// C    Solvers," in Scientific Computing, R. S. Stepleman et al., eds.,
			// C    North-Holland, Amsterdam, 1983, pp. 55-64.
			// C 6. K. R. Jackson and R. Sacks-Davis, "An Alternative Implementation
			// C    of Variable Step-Size Multistep Formulas for Stiff ODEs," ACM
			// C    Trans. Math. Software, 6 (1980), pp. 295-318.
			// C-----------------------------------------------------------------------
			// C Summary of usage.
			// C
			// C Communication between the user and the DVODE package, for normal
			// C situations, is summarized here.  This summary describes only a subset
			// C of the full set of options available.  See the full description for
			// C details, including optional communication, nonstandard options,
			// C and instructions for special situations.  See also the example
			// C problem (with program and output) following this summary.
			// C
			// C A. First provide a subroutine of the form:
			// C           SUBROUTINE F (NEQ, T, Y, YDOT, RPAR, IPAR)
			// C           DOUBLE PRECISION T, Y(NEQ), YDOT(NEQ), RPAR
			// C which supplies the vector function f by loading YDOT(i) with f(i).
			// C
			// C B. Next determine (or guess) whether or not the problem is stiff.
			// C Stiffness occurs when the Jacobian matrix df/dy has an eigenvalue
			// C whose real part is negative and large in magnitude, compared to the
			// C reciprocal of the t span of interest.  If the problem is nonstiff,
			// C use a method flag MF = 10.  If it is stiff, there are four standard
			// C choices for MF (21, 22, 24, 25), and DVODE requires the Jacobian
			// C matrix in some form.  In these cases (MF .gt. 0), DVODE will use a
			// C saved copy of the Jacobian matrix.  If this is undesirable because of
			// C storage limitations, set MF to the corresponding negative value
			// C (-21, -22, -24, -25).  (See full description of MF below.)
			// C The Jacobian matrix is regarded either as full (MF = 21 or 22),
			// C or banded (MF = 24 or 25).  In the banded case, DVODE requires two
			// C half-bandwidth parameters ML and MU.  These are, respectively, the
			// C widths of the lower and upper parts of the band, excluding the main
			// C diagonal.  Thus the band consists of the locations (i,j) with
			// C i-ML .le. j .le. i+MU, and the full bandwidth is ML+MU+1.
			// C
			// C C. If the problem is stiff, you are encouraged to supply the Jacobian
			// C directly (MF = 21 or 24), but if this is not feasible, DVODE will
			// C compute it internally by difference quotients (MF = 22 or 25).
			// C If you are supplying the Jacobian, provide a subroutine of the form:
			// C           SUBROUTINE JAC (NEQ, T, Y, ML, MU, PD, NROWPD, RPAR, IPAR)
			// C           DOUBLE PRECISION T, Y(NEQ), PD(NROWPD,NEQ), RPAR
			// C which supplies df/dy by loading PD as follows:
			// C     For a full Jacobian (MF = 21), load PD(i,j) with df(i)/dy(j),
			// C the partial derivative of f(i) with respect to y(j).  (Ignore the
			// C ML and MU arguments in this case.)
			// C     For a banded Jacobian (MF = 24), load PD(i-j+MU+1,j) with
			// C df(i)/dy(j), i.e. load the diagonal lines of df/dy into the rows of
			// C PD from the top down.
			// C     In either case, only nonzero elements need be loaded.
			// C
			// C D. Write a main program which calls subroutine DVODE once for
			// C each point at which answers are desired.  This should also provide
			// C for possible use of logical unit 6 for output of error messages
			// C by DVODE.  On the first call to DVODE, supply arguments as follows:
			// C F      = Name of subroutine for right-hand side vector f.
			// C          This name must be declared external in calling program.
			// C NEQ    = Number of first order ODEs.
			// C Y      = Array of initial values, of length NEQ.
			// C T      = The initial value of the independent variable.
			// C TOUT   = First point where output is desired (.ne. T).
			// C ITOL   = 1 or 2 according as ATOL (below) is a scalar or array.
			// C RTOL   = Relative tolerance parameter (scalar).
			// C ATOL   = Absolute tolerance parameter (scalar or array).
			// C          The estimated local error in Y(i) will be controlled so as
			// C          to be roughly less (in magnitude) than
			// C             EWT(i) = RTOL*abs(Y(i)) + ATOL     if ITOL = 1, or
			// C             EWT(i) = RTOL*abs(Y(i)) + ATOL(i)  if ITOL = 2.
			// C          Thus the local error test passes if, in each component,
			// C          either the absolute error is less than ATOL (or ATOL(i)),
			// C          or the relative error is less than RTOL.
			// C          Use RTOL = 0.0 for pure absolute error control, and
			// C          use ATOL = 0.0 (or ATOL(i) = 0.0) for pure relative error
			// C          control.  Caution: Actual (global) errors may exceed these
			// C          local tolerances, so choose them conservatively.
			// C ITASK  = 1 for normal computation of output values of Y at t = TOUT.
			// C ISTATE = Integer flag (input and output).  Set ISTATE = 1.
			// C IOPT   = 0 to indicate no optional input used.
			// C RWORK  = Real work array of length at least:
			// C             20 + 16*NEQ                      for MF = 10,
			// C             22 +  9*NEQ + 2*NEQ**2           for MF = 21 or 22,
			// C             22 + 11*NEQ + (3*ML + 2*MU)*NEQ  for MF = 24 or 25.
			// C LRW    = Declared length of RWORK (in user's DIMENSION statement).
			// C IWORK  = Integer work array of length at least:
			// C             30        for MF = 10,
			// C             30 + NEQ  for MF = 21, 22, 24, or 25.
			// C          If MF = 24 or 25, input in IWORK(1),IWORK(2) the lower
			// C          and upper half-bandwidths ML,MU.
			// C LIW    = Declared length of IWORK (in user's DIMENSION statement).
			// C JAC    = Name of subroutine for Jacobian matrix (MF = 21 or 24).
			// C          If used, this name must be declared external in calling
			// C          program.  If not used, pass a dummy name.
			// C MF     = Method flag.  Standard values are:
			// C          10 for nonstiff (Adams) method, no Jacobian used.
			// C          21 for stiff (BDF) method, user-supplied full Jacobian.
			// C          22 for stiff method, internally generated full Jacobian.
			// C          24 for stiff method, user-supplied banded Jacobian.
			// C          25 for stiff method, internally generated banded Jacobian.
			// C RPAR,IPAR = user-defined real and integer arrays passed to F and JAC.
			// C Note that the main program must declare arrays Y, RWORK, IWORK,
			// C and possibly ATOL, RPAR, and IPAR.
			// C
			// C E. The output from the first call (or any call) is:
			// C      Y = Array of computed values of y(t) vector.
			// C      T = Corresponding value of independent variable (normally TOUT).
			// C ISTATE = 2  if DVODE was successful, negative otherwise.
			// C          -1 means excess work done on this call. (Perhaps wrong MF.)
			// C          -2 means excess accuracy requested. (Tolerances too small.)
			// C          -3 means illegal input detected. (See printed message.)
			// C          -4 means repeated error test failures. (Check all input.)
			// C          -5 means repeated convergence failures. (Perhaps bad
			// C             Jacobian supplied or wrong choice of MF or tolerances.)
			// C          -6 means error weight became zero during problem. (Solution
			// C             component i vanished, and ATOL or ATOL(i) = 0.)
			// C
			// C F. To continue the integration after a successful return, simply
			// C reset TOUT and call DVODE again.  No other parameters need be reset.
			// C
			// C-----------------------------------------------------------------------
			// C EXAMPLE PROBLEM
			// C
			// C The following is a simple example problem, with the coding
			// C needed for its solution by DVODE.  The problem is from chemical
			// C kinetics, and consists of the following three rate equations:
			// C     dy1/dt = -.04*y1 + 1.e4*y2*y3
			// C     dy2/dt = .04*y1 - 1.e4*y2*y3 - 3.e7*y2**2
			// C     dy3/dt = 3.e7*y2**2
			// C on the interval from t = 0.0 to t = 4.e10, with initial conditions
			// C y1 = 1.0, y2 = y3 = 0.  The problem is stiff.
			// C
			// C The following coding solves this problem with DVODE, using MF = 21
			// C and printing results at t = .4, 4., ..., 4.e10.  It uses
			// C ITOL = 2 and ATOL much smaller for y2 than y1 or y3 because
			// C y2 has much smaller values.
			// C At the end of the run, statistical quantities of interest are
			// C printed. (See optional output in the full description below.)
			// C To generate Fortran source code, replace C in column 1 with a blank
			// C in the coding below.
			// C
			// C     EXTERNAL FEX, JEX
			// C     DOUBLE PRECISION ATOL, RPAR, RTOL, RWORK, T, TOUT, Y
			// C     DIMENSION Y(3), ATOL(3), RWORK(67), IWORK(33)
			// C     NEQ = 3
			// C     Y(1) = 1.0D0
			// C     Y(2) = 0.0D0
			// C     Y(3) = 0.0D0
			// C     T = 0.0D0
			// C     TOUT = 0.4D0
			// C     ITOL = 2
			// C     RTOL = 1.D-4
			// C     ATOL(1) = 1.D-8
			// C     ATOL(2) = 1.D-14
			// C     ATOL(3) = 1.D-6
			// C     ITASK = 1
			// C     ISTATE = 1
			// C     IOPT = 0
			// C     LRW = 67
			// C     LIW = 33
			// C     MF = 21
			// C     DO 40 IOUT = 1,12
			// C       CALL DVODE(FEX,NEQ,Y,T,TOUT,ITOL,RTOL,ATOL,ITASK,ISTATE,
			// C    1            IOPT,RWORK,LRW,IWORK,LIW,JEX,MF,RPAR,IPAR)
			// C       WRITE(6,20)T,Y(1),Y(2),Y(3)
			// C 20    FORMAT(' At t =',D12.4,'   y =',3D14.6)
			// C       IF (ISTATE .LT. 0) GO TO 80
			// C 40    TOUT = TOUT*10.
			// C     WRITE(6,60) IWORK(11),IWORK(12),IWORK(13),IWORK(19),
			// C    1            IWORK(20),IWORK(21),IWORK(22)
			// C 60  FORMAT(/' No. steps =',I4,'   No. f-s =',I4,
			// C    1       '   No. J-s =',I4,'   No. LU-s =',I4/
			// C    2       '  No. nonlinear iterations =',I4/
			// C    3       '  No. nonlinear convergence failures =',I4/
			// C    4       '  No. error test failures =',I4/)
			// C     STOP
			// C 80  WRITE(6,90)ISTATE
			// C 90  FORMAT(///' Error halt: ISTATE =',I3)
			// C     STOP
			// C     END
			// C
			// C     SUBROUTINE FEX (NEQ, T, Y, YDOT, RPAR, IPAR)
			// C     DOUBLE PRECISION RPAR, T, Y, YDOT
			// C     DIMENSION Y(NEQ), YDOT(NEQ)
			// C     YDOT(1) = -.04D0*Y(1) + 1.D4*Y(2)*Y(3)
			// C     YDOT(3) = 3.D7*Y(2)*Y(2)
			// C     YDOT(2) = -YDOT(1) - YDOT(3)
			// C     RETURN
			// C     END
			// C
			// C     SUBROUTINE JEX (NEQ, T, Y, ML, MU, PD, NRPD, RPAR, IPAR)
			// C     DOUBLE PRECISION PD, RPAR, T, Y
			// C     DIMENSION Y(NEQ), PD(NRPD,NEQ)
			// C     PD(1,1) = -.04D0
			// C     PD(1,2) = 1.D4*Y(3)
			// C     PD(1,3) = 1.D4*Y(2)
			// C     PD(2,1) = .04D0
			// C     PD(2,3) = -PD(1,3)
			// C     PD(3,2) = 6.D7*Y(2)
			// C     PD(2,2) = -PD(1,2) - PD(3,2)
			// C     RETURN
			// C     END
			// C
			// C The following output was obtained from the above program on a
			// C Cray-1 computer with the CFT compiler.
			// C
			// C At t =  4.0000e-01   y =  9.851680e-01  3.386314e-05  1.479817e-02
			// C At t =  4.0000e+00   y =  9.055255e-01  2.240539e-05  9.445214e-02
			// C At t =  4.0000e+01   y =  7.158108e-01  9.184883e-06  2.841800e-01
			// C At t =  4.0000e+02   y =  4.505032e-01  3.222940e-06  5.494936e-01
			// C At t =  4.0000e+03   y =  1.832053e-01  8.942690e-07  8.167938e-01
			// C At t =  4.0000e+04   y =  3.898560e-02  1.621875e-07  9.610142e-01
			// C At t =  4.0000e+05   y =  4.935882e-03  1.984013e-08  9.950641e-01
			// C At t =  4.0000e+06   y =  5.166183e-04  2.067528e-09  9.994834e-01
			// C At t =  4.0000e+07   y =  5.201214e-05  2.080593e-10  9.999480e-01
			// C At t =  4.0000e+08   y =  5.213149e-06  2.085271e-11  9.999948e-01
			// C At t =  4.0000e+09   y =  5.183495e-07  2.073399e-12  9.999995e-01
			// C At t =  4.0000e+10   y =  5.450996e-08  2.180399e-13  9.999999e-01
			// C
			// C No. steps = 595   No. f-s = 832   No. J-s =  13   No. LU-s = 112
			// C  No. nonlinear iterations = 831
			// C  No. nonlinear convergence failures =   0
			// C  No. error test failures =  22
			// C-----------------------------------------------------------------------
			// C Full description of user interface to DVODE.
			// C
			// C The user interface to DVODE consists of the following parts.
			// C
			// C i.   The call sequence to subroutine DVODE, which is a driver
			// C      routine for the solver.  This includes descriptions of both
			// C      the call sequence arguments and of user-supplied routines.
			// C      Following these descriptions is
			// C        * a description of optional input available through the
			// C          call sequence,
			// C        * a description of optional output (in the work arrays), and
			// C        * instructions for interrupting and restarting a solution.
			// C
			// C ii.  Descriptions of other routines in the DVODE package that may be
			// C      (optionally) called by the user.  These provide the ability to
			// C      alter error message handling, save and restore the internal
			// C      COMMON, and obtain specified derivatives of the solution y(t).
			// C
			// C iii. Descriptions of COMMON blocks to be declared in overlay
			// C      or similar environments.
			// C
			// C iv.  Description of two routines in the DVODE package, either of
			// C      which the user may replace with his own version, if desired.
			// C      these relate to the measurement of errors.
			// C
			// C-----------------------------------------------------------------------
			// C Part i.  Call Sequence.
			// C
			// C The call sequence parameters used for input only are
			// C     F, NEQ, TOUT, ITOL, RTOL, ATOL, ITASK, IOPT, LRW, LIW, JAC, MF,
			// C and those used for both input and output are
			// C     Y, T, ISTATE.
			// C The work arrays RWORK and IWORK are also used for conditional and
			// C optional input and optional output.  (The term output here refers
			// C to the return from subroutine DVODE to the user's calling program.)
			// C
			// C The legality of input parameters will be thoroughly checked on the
			// C initial call for the problem, but not checked thereafter unless a
			// C change in input parameters is flagged by ISTATE = 3 in the input.
			// C
			// C The descriptions of the call arguments are as follows.
			// C
			// C F      = The name of the user-supplied subroutine defining the
			// C          ODE system.  The system must be put in the first-order
			// C          form dy/dt = f(t,y), where f is a vector-valued function
			// C          of the scalar t and the vector y.  Subroutine F is to
			// C          compute the function f.  It is to have the form
			// C               SUBROUTINE F (NEQ, T, Y, YDOT, RPAR, IPAR)
			// C               DOUBLE PRECISION T, Y(NEQ), YDOT(NEQ), RPAR
			// C          where NEQ, T, and Y are input, and the array YDOT = f(t,y)
			// C          is output.  Y and YDOT are arrays of length NEQ.
			// C          Subroutine F should not alter Y(1),...,Y(NEQ).
			// C          F must be declared EXTERNAL in the calling program.
			// C
			// C          Subroutine F may access user-defined real and integer
			// C          work arrays RPAR and IPAR, which are to be dimensioned
			// C          in the main program.
			// C
			// C          If quantities computed in the F routine are needed
			// C          externally to DVODE, an extra call to F should be made
			// C          for this purpose, for consistent and accurate results.
			// C          If only the derivative dy/dt is needed, use DVINDY instead.
			// C
			// C NEQ    = The size of the ODE system (number of first order
			// C          ordinary differential equations).  Used only for input.
			// C          NEQ may not be increased during the problem, but
			// C          can be decreased (with ISTATE = 3 in the input).
			// C
			// C Y      = A real array for the vector of dependent variables, of
			// C          length NEQ or more.  Used for both input and output on the
			// C          first call (ISTATE = 1), and only for output on other calls.
			// C          On the first call, Y must contain the vector of initial
			// C          values.  In the output, Y contains the computed solution
			// C          evaluated at T.  If desired, the Y array may be used
			// C          for other purposes between calls to the solver.
			// C
			// C          This array is passed as the Y argument in all calls to
			// C          F and JAC.
			// C
			// C T      = The independent variable.  In the input, T is used only on
			// C          the first call, as the initial point of the integration.
			// C          In the output, after each call, T is the value at which a
			// C          computed solution Y is evaluated (usually the same as TOUT).
			// C          On an error return, T is the farthest point reached.
			// C
			// C TOUT   = The next value of t at which a computed solution is desired.
			// C          Used only for input.
			// C
			// C          When starting the problem (ISTATE = 1), TOUT may be equal
			// C          to T for one call, then should .ne. T for the next call.
			// C          For the initial T, an input value of TOUT .ne. T is used
			// C          in order to determine the direction of the integration
			// C          (i.e. the algebraic sign of the step sizes) and the rough
			// C          scale of the problem.  Integration in either direction
			// C          (forward or backward in t) is permitted.
			// C
			// C          If ITASK = 2 or 5 (one-step modes), TOUT is ignored after
			// C          the first call (i.e. the first call with TOUT .ne. T).
			// C          Otherwise, TOUT is required on every call.
			// C
			// C          If ITASK = 1, 3, or 4, the values of TOUT need not be
			// C          monotone, but a value of TOUT which backs up is limited
			// C          to the current internal t interval, whose endpoints are
			// C          TCUR - HU and TCUR.  (See optional output, below, for
			// C          TCUR and HU.)
			// C
			// C ITOL   = An indicator for the type of error control.  See
			// C          description below under ATOL.  Used only for input.
			// C
			// C RTOL   = A relative error tolerance parameter, either a scalar or
			// C          an array of length NEQ.  See description below under ATOL.
			// C          Input only.
			// C
			// C ATOL   = An absolute error tolerance parameter, either a scalar or
			// C          an array of length NEQ.  Input only.
			// C
			// C          The input parameters ITOL, RTOL, and ATOL determine
			// C          the error control performed by the solver.  The solver will
			// C          control the vector e = (e(i)) of estimated local errors
			// C          in Y, according to an inequality of the form
			// C                      rms-norm of ( e(i)/EWT(i) )   .le.   1,
			// C          where       EWT(i) = RTOL(i)*abs(Y(i)) + ATOL(i),
			// C          and the rms-norm (root-mean-square norm) here is
			// C          rms-norm(v) = sqrt(sum v(i)**2 / NEQ).  Here EWT = (EWT(i))
			// C          is a vector of weights which must always be positive, and
			// C          the values of RTOL and ATOL should all be non-negative.
			// C          The following table gives the types (scalar/array) of
			// C          RTOL and ATOL, and the corresponding form of EWT(i).
			// C
			// C             ITOL    RTOL       ATOL          EWT(i)
			// C              1     scalar     scalar     RTOL*ABS(Y(i)) + ATOL
			// C              2     scalar     array      RTOL*ABS(Y(i)) + ATOL(i)
			// C              3     array      scalar     RTOL(i)*ABS(Y(i)) + ATOL
			// C              4     array      array      RTOL(i)*ABS(Y(i)) + ATOL(i)
			// C
			// C          When either of these parameters is a scalar, it need not
			// C          be dimensioned in the user's calling program.
			// C
			// C          If none of the above choices (with ITOL, RTOL, and ATOL
			// C          fixed throughout the problem) is suitable, more general
			// C          error controls can be obtained by substituting
			// C          user-supplied routines for the setting of EWT and/or for
			// C          the norm calculation.  See Part iv below.
			// C
			// C          If global errors are to be estimated by making a repeated
			// C          run on the same problem with smaller tolerances, then all
			// C          components of RTOL and ATOL (i.e. of EWT) should be scaled
			// C          down uniformly.
			// C
			// C ITASK  = An index specifying the task to be performed.
			// C          Input only.  ITASK has the following values and meanings.
			// C          1  means normal computation of output values of y(t) at
			// C             t = TOUT (by overshooting and interpolating).
			// C          2  means take one step only and return.
			// C          3  means stop at the first internal mesh point at or
			// C             beyond t = TOUT and return.
			// C          4  means normal computation of output values of y(t) at
			// C             t = TOUT but without overshooting t = TCRIT.
			// C             TCRIT must be input as RWORK(1).  TCRIT may be equal to
			// C             or beyond TOUT, but not behind it in the direction of
			// C             integration.  This option is useful if the problem
			// C             has a singularity at or beyond t = TCRIT.
			// C          5  means take one step, without passing TCRIT, and return.
			// C             TCRIT must be input as RWORK(1).
			// C
			// C          Note:  If ITASK = 4 or 5 and the solver reaches TCRIT
			// C          (within roundoff), it will return T = TCRIT (exactly) to
			// C          indicate this (unless ITASK = 4 and TOUT comes before TCRIT,
			// C          in which case answers at T = TOUT are returned first).
			// C
			// C ISTATE = an index used for input and output to specify the
			// C          the state of the calculation.
			// C
			// C          In the input, the values of ISTATE are as follows.
			// C          1  means this is the first call for the problem
			// C             (initializations will be done).  See note below.
			// C          2  means this is not the first call, and the calculation
			// C             is to continue normally, with no change in any input
			// C             parameters except possibly TOUT and ITASK.
			// C             (If ITOL, RTOL, and/or ATOL are changed between calls
			// C             with ISTATE = 2, the new values will be used but not
			// C             tested for legality.)
			// C          3  means this is not the first call, and the
			// C             calculation is to continue normally, but with
			// C             a change in input parameters other than
			// C             TOUT and ITASK.  Changes are allowed in
			// C             NEQ, ITOL, RTOL, ATOL, IOPT, LRW, LIW, MF, ML, MU,
			// C             and any of the optional input except H0.
			// C             (See IWORK description for ML and MU.)
			// C          Note:  A preliminary call with TOUT = T is not counted
			// C          as a first call here, as no initialization or checking of
			// C          input is done.  (Such a call is sometimes useful to include
			// C          the initial conditions in the output.)
			// C          Thus the first call for which TOUT .ne. T requires
			// C          ISTATE = 1 in the input.
			// C
			// C          In the output, ISTATE has the following values and meanings.
			// C           1  means nothing was done, as TOUT was equal to T with
			// C              ISTATE = 1 in the input.
			// C           2  means the integration was performed successfully.
			// C          -1  means an excessive amount of work (more than MXSTEP
			// C              steps) was done on this call, before completing the
			// C              requested task, but the integration was otherwise
			// C              successful as far as T.  (MXSTEP is an optional input
			// C              and is normally 500.)  To continue, the user may
			// C              simply reset ISTATE to a value .gt. 1 and call again.
			// C              (The excess work step counter will be reset to 0.)
			// C              In addition, the user may increase MXSTEP to avoid
			// C              this error return.  (See optional input below.)
			// C          -2  means too much accuracy was requested for the precision
			// C              of the machine being used.  This was detected before
			// C              completing the requested task, but the integration
			// C              was successful as far as T.  To continue, the tolerance
			// C              parameters must be reset, and ISTATE must be set
			// C              to 3.  The optional output TOLSF may be used for this
			// C              purpose.  (Note: If this condition is detected before
			// C              taking any steps, then an illegal input return
			// C              (ISTATE = -3) occurs instead.)
			// C          -3  means illegal input was detected, before taking any
			// C              integration steps.  See written message for details.
			// C              Note:  If the solver detects an infinite loop of calls
			// C              to the solver with illegal input, it will cause
			// C              the run to stop.
			// C          -4  means there were repeated error test failures on
			// C              one attempted step, before completing the requested
			// C              task, but the integration was successful as far as T.
			// C              The problem may have a singularity, or the input
			// C              may be inappropriate.
			// C          -5  means there were repeated convergence test failures on
			// C              one attempted step, before completing the requested
			// C              task, but the integration was successful as far as T.
			// C              This may be caused by an inaccurate Jacobian matrix,
			// C              if one is being used.
			// C          -6  means EWT(i) became zero for some i during the
			// C              integration.  Pure relative error control (ATOL(i)=0.0)
			// C              was requested on a variable which has now vanished.
			// C              The integration was successful as far as T.
			// C
			// C          Note:  Since the normal output value of ISTATE is 2,
			// C          it does not need to be reset for normal continuation.
			// C          Also, since a negative input value of ISTATE will be
			// C          regarded as illegal, a negative output value requires the
			// C          user to change it, and possibly other input, before
			// C          calling the solver again.
			// C
			// C IOPT   = An integer flag to specify whether or not any optional
			// C          input is being used on this call.  Input only.
			// C          The optional input is listed separately below.
			// C          IOPT = 0 means no optional input is being used.
			// C                   Default values will be used in all cases.
			// C          IOPT = 1 means optional input is being used.
			// C
			// C RWORK  = A real working array (double precision).
			// C          The length of RWORK must be at least
			// C             20 + NYH*(MAXORD + 1) + 3*NEQ + LWM    where
			// C          NYH    = the initial value of NEQ,
			// C          MAXORD = 12 (if METH = 1) or 5 (if METH = 2) (unless a
			// C                   smaller value is given as an optional input),
			// C          LWM = length of work space for matrix-related data:
			// C          LWM = 0             if MITER = 0,
			// C          LWM = 2*NEQ**2 + 2  if MITER = 1 or 2, and MF.gt.0,
			// C          LWM = NEQ**2 + 2    if MITER = 1 or 2, and MF.lt.0,
			// C          LWM = NEQ + 2       if MITER = 3,
			// C          LWM = (3*ML+2*MU+2)*NEQ + 2 if MITER = 4 or 5, and MF.gt.0,
			// C          LWM = (2*ML+MU+1)*NEQ + 2   if MITER = 4 or 5, and MF.lt.0.
			// C          (See the MF description for METH and MITER.)
			// C          Thus if MAXORD has its default value and NEQ is constant,
			// C          this length is:
			// C             20 + 16*NEQ                    for MF = 10,
			// C             22 + 16*NEQ + 2*NEQ**2         for MF = 11 or 12,
			// C             22 + 16*NEQ + NEQ**2           for MF = -11 or -12,
			// C             22 + 17*NEQ                    for MF = 13,
			// C             22 + 18*NEQ + (3*ML+2*MU)*NEQ  for MF = 14 or 15,
			// C             22 + 17*NEQ + (2*ML+MU)*NEQ    for MF = -14 or -15,
			// C             20 +  9*NEQ                    for MF = 20,
			// C             22 +  9*NEQ + 2*NEQ**2         for MF = 21 or 22,
			// C             22 +  9*NEQ + NEQ**2           for MF = -21 or -22,
			// C             22 + 10*NEQ                    for MF = 23,
			// C             22 + 11*NEQ + (3*ML+2*MU)*NEQ  for MF = 24 or 25.
			// C             22 + 10*NEQ + (2*ML+MU)*NEQ    for MF = -24 or -25.
			// C          The first 20 words of RWORK are reserved for conditional
			// C          and optional input and optional output.
			// C
			// C          The following word in RWORK is a conditional input:
			// C            RWORK(1) = TCRIT = critical value of t which the solver
			// C                       is not to overshoot.  Required if ITASK is
			// C                       4 or 5, and ignored otherwise.  (See ITASK.)
			// C
			// C LRW    = The length of the array RWORK, as declared by the user.
			// C          (This will be checked by the solver.)
			// C
			// C IWORK  = An integer work array.  The length of IWORK must be at least
			// C             30        if MITER = 0 or 3 (MF = 10, 13, 20, 23), or
			// C             30 + NEQ  otherwise (abs(MF) = 11,12,14,15,21,22,24,25).
			// C          The first 30 words of IWORK are reserved for conditional and
			// C          optional input and optional output.
			// C
			// C          The following 2 words in IWORK are conditional input:
			// C            IWORK(1) = ML     These are the lower and upper
			// C            IWORK(2) = MU     half-bandwidths, respectively, of the
			// C                       banded Jacobian, excluding the main diagonal.
			// C                       The band is defined by the matrix locations
			// C                       (i,j) with i-ML .le. j .le. i+MU.  ML and MU
			// C                       must satisfy  0 .le.  ML,MU  .le. NEQ-1.
			// C                       These are required if MITER is 4 or 5, and
			// C                       ignored otherwise.  ML and MU may in fact be
			// C                       the band parameters for a matrix to which
			// C                       df/dy is only approximately equal.
			// C
			// C LIW    = the length of the array IWORK, as declared by the user.
			// C          (This will be checked by the solver.)
			// C
			// C Note:  The work arrays must not be altered between calls to DVODE
			// C for the same problem, except possibly for the conditional and
			// C optional input, and except for the last 3*NEQ words of RWORK.
			// C The latter space is used for internal scratch space, and so is
			// C available for use by the user outside DVODE between calls, if
			// C desired (but not for use by F or JAC).
			// C
			// C JAC    = The name of the user-supplied routine (MITER = 1 or 4) to
			// C          compute the Jacobian matrix, df/dy, as a function of
			// C          the scalar t and the vector y.  It is to have the form
			// C               SUBROUTINE JAC (NEQ, T, Y, ML, MU, PD, NROWPD,
			// C                               RPAR, IPAR)
			// C               DOUBLE PRECISION T, Y(NEQ), PD(NROWPD,NEQ), RPAR
			// C          where NEQ, T, Y, ML, MU, and NROWPD are input and the array
			// C          PD is to be loaded with partial derivatives (elements of the
			// C          Jacobian matrix) in the output.  PD must be given a first
			// C          dimension of NROWPD.  T and Y have the same meaning as in
			// C          Subroutine F.
			// C               In the full matrix case (MITER = 1), ML and MU are
			// C          ignored, and the Jacobian is to be loaded into PD in
			// C          columnwise manner, with df(i)/dy(j) loaded into PD(i,j).
			// C               In the band matrix case (MITER = 4), the elements
			// C          within the band are to be loaded into PD in columnwise
			// C          manner, with diagonal lines of df/dy loaded into the rows
			// C          of PD. Thus df(i)/dy(j) is to be loaded into PD(i-j+MU+1,j).
			// C          ML and MU are the half-bandwidth parameters. (See IWORK).
			// C          The locations in PD in the two triangular areas which
			// C          correspond to nonexistent matrix elements can be ignored
			// C          or loaded arbitrarily, as they are overwritten by DVODE.
			// C               JAC need not provide df/dy exactly.  A crude
			// C          approximation (possibly with a smaller bandwidth) will do.
			// C               In either case, PD is preset to zero by the solver,
			// C          so that only the nonzero elements need be loaded by JAC.
			// C          Each call to JAC is preceded by a call to F with the same
			// C          arguments NEQ, T, and Y.  Thus to gain some efficiency,
			// C          intermediate quantities shared by both calculations may be
			// C          saved in a user COMMON block by F and not recomputed by JAC,
			// C          if desired.  Also, JAC may alter the Y array, if desired.
			// C          JAC must be declared external in the calling program.
			// C               Subroutine JAC may access user-defined real and integer
			// C          work arrays, RPAR and IPAR, whose dimensions are set by the
			// C          user in the main program.
			// C
			// C MF     = The method flag.  Used only for input.  The legal values of
			// C          MF are 10, 11, 12, 13, 14, 15, 20, 21, 22, 23, 24, 25,
			// C          -11, -12, -14, -15, -21, -22, -24, -25.
			// C          MF is a signed two-digit integer, MF = JSV*(10*METH + MITER).
			// C          JSV = SIGN(MF) indicates the Jacobian-saving strategy:
			// C            JSV =  1 means a copy of the Jacobian is saved for reuse
			// C                     in the corrector iteration algorithm.
			// C            JSV = -1 means a copy of the Jacobian is not saved
			// C                     (valid only for MITER = 1, 2, 4, or 5).
			// C          METH indicates the basic linear multistep method:
			// C            METH = 1 means the implicit Adams method.
			// C            METH = 2 means the method based on backward
			// C                     differentiation formulas (BDF-s).
			// C          MITER indicates the corrector iteration method:
			// C            MITER = 0 means functional iteration (no Jacobian matrix
			// C                      is involved).
			// C            MITER = 1 means chord iteration with a user-supplied
			// C                      full (NEQ by NEQ) Jacobian.
			// C            MITER = 2 means chord iteration with an internally
			// C                      generated (difference quotient) full Jacobian
			// C                      (using NEQ extra calls to F per df/dy value).
			// C            MITER = 3 means chord iteration with an internally
			// C                      generated diagonal Jacobian approximation
			// C                      (using 1 extra call to F per df/dy evaluation).
			// C            MITER = 4 means chord iteration with a user-supplied
			// C                      banded Jacobian.
			// C            MITER = 5 means chord iteration with an internally
			// C                      generated banded Jacobian (using ML+MU+1 extra
			// C                      calls to F per df/dy evaluation).
			// C          If MITER = 1 or 4, the user must supply a subroutine JAC
			// C          (the name is arbitrary) as described above under JAC.
			// C          For other values of MITER, a dummy argument can be used.
			// C
			// C RPAR     User-specified array used to communicate real parameters
			// C          to user-supplied subroutines.  If RPAR is a vector, then
			// C          it must be dimensioned in the user's main program.  If it
			// C          is unused or it is a scalar, then it need not be
			// C          dimensioned.
			// C
			// C IPAR     User-specified array used to communicate integer parameter
			// C          to user-supplied subroutines.  The comments on dimensioning
			// C          RPAR apply to IPAR.
			// C-----------------------------------------------------------------------
			// C Optional Input.
			// C
			// C The following is a list of the optional input provided for in the
			// C call sequence.  (See also Part ii.)  For each such input variable,
			// C this table lists its name as used in this documentation, its
			// C location in the call sequence, its meaning, and the default value.
			// C The use of any of this input requires IOPT = 1, and in that
			// C case all of this input is examined.  A value of zero for any
			// C of these optional input variables will cause the default value to be
			// C used.  Thus to use a subset of the optional input, simply preload
			// C locations 5 to 10 in RWORK and IWORK to 0.0 and 0 respectively, and
			// C then set those of interest to nonzero values.
			// C
			// C NAME    LOCATION      MEANING AND DEFAULT VALUE
			// C
			// C H0      RWORK(5)  The step size to be attempted on the first step.
			// C                   The default value is determined by the solver.
			// C
			// C HMAX    RWORK(6)  The maximum absolute step size allowed.
			// C                   The default value is infinite.
			// C
			// C HMIN    RWORK(7)  The minimum absolute step size allowed.
			// C                   The default value is 0.  (This lower bound is not
			// C                   enforced on the final step before reaching TCRIT
			// C                   when ITASK = 4 or 5.)
			// C
			// C MAXORD  IWORK(5)  The maximum order to be allowed.  The default
			// C                   value is 12 if METH = 1, and 5 if METH = 2.
			// C                   If MAXORD exceeds the default value, it will
			// C                   be reduced to the default value.
			// C                   If MAXORD is changed during the problem, it may
			// C                   cause the current order to be reduced.
			// C
			// C MXSTEP  IWORK(6)  Maximum number of (internally defined) steps
			// C                   allowed during one call to the solver.
			// C                   The default value is 500.
			// C
			// C MXHNIL  IWORK(7)  Maximum number of messages printed (per problem)
			// C                   warning that T + H = T on a step (H = step size).
			// C                   This must be positive to result in a non-default
			// C                   value.  The default value is 10.
			// C
			// C-----------------------------------------------------------------------
			// C Optional Output.
			// C
			// C As optional additional output from DVODE, the variables listed
			// C below are quantities related to the performance of DVODE
			// C which are available to the user.  These are communicated by way of
			// C the work arrays, but also have internal mnemonic names as shown.
			// C Except where stated otherwise, all of this output is defined
			// C on any successful return from DVODE, and on any return with
			// C ISTATE = -1, -2, -4, -5, or -6.  On an illegal input return
			// C (ISTATE = -3), they will be unchanged from their existing values
			// C (if any), except possibly for TOLSF, LENRW, and LENIW.
			// C On any error return, output relevant to the error will be defined,
			// C as noted below.
			// C
			// C NAME    LOCATION      MEANING
			// C
			// C HU      RWORK(11) The step size in t last used (successfully).
			// C
			// C HCUR    RWORK(12) The step size to be attempted on the next step.
			// C
			// C TCUR    RWORK(13) The current value of the independent variable
			// C                   which the solver has actually reached, i.e. the
			// C                   current internal mesh point in t.  In the output,
			// C                   TCUR will always be at least as far from the
			// C                   initial value of t as the current argument T,
			// C                   but may be farther (if interpolation was done).
			// C
			// C TOLSF   RWORK(14) A tolerance scale factor, greater than 1.0,
			// C                   computed when a request for too much accuracy was
			// C                   detected (ISTATE = -3 if detected at the start of
			// C                   the problem, ISTATE = -2 otherwise).  If ITOL is
			// C                   left unaltered but RTOL and ATOL are uniformly
			// C                   scaled up by a factor of TOLSF for the next call,
			// C                   then the solver is deemed likely to succeed.
			// C                   (The user may also ignore TOLSF and alter the
			// C                   tolerance parameters in any other way appropriate.)
			// C
			// C NST     IWORK(11) The number of steps taken for the problem so far.
			// C
			// C NFE     IWORK(12) The number of f evaluations for the problem so far.
			// C
			// C NJE     IWORK(13) The number of Jacobian evaluations so far.
			// C
			// C NQU     IWORK(14) The method order last used (successfully).
			// C
			// C NQCUR   IWORK(15) The order to be attempted on the next step.
			// C
			// C IMXER   IWORK(16) The index of the component of largest magnitude in
			// C                   the weighted local error vector ( e(i)/EWT(i) ),
			// C                   on an error return with ISTATE = -4 or -5.
			// C
			// C LENRW   IWORK(17) The length of RWORK actually required.
			// C                   This is defined on normal returns and on an illegal
			// C                   input return for insufficient storage.
			// C
			// C LENIW   IWORK(18) The length of IWORK actually required.
			// C                   This is defined on normal returns and on an illegal
			// C                   input return for insufficient storage.
			// C
			// C NLU     IWORK(19) The number of matrix LU decompositions so far.
			// C
			// C NNI     IWORK(20) The number of nonlinear (Newton) iterations so far.
			// C
			// C NCFN    IWORK(21) The number of convergence failures of the nonlinear
			// C                   solver so far.
			// C
			// C NETF    IWORK(22) The number of error test failures of the integrator
			// C                   so far.
			// C
			// C The following two arrays are segments of the RWORK array which
			// C may also be of interest to the user as optional output.
			// C For each array, the table below gives its internal name,
			// C its base address in RWORK, and its description.
			// C
			// C NAME    BASE ADDRESS      DESCRIPTION
			// C
			// C YH      21             The Nordsieck history array, of size NYH by
			// C                        (NQCUR + 1), where NYH is the initial value
			// C                        of NEQ.  For j = 0,1,...,NQCUR, column j+1
			// C                        of YH contains HCUR**j/factorial(j) times
			// C                        the j-th derivative of the interpolating
			// C                        polynomial currently representing the
			// C                        solution, evaluated at t = TCUR.
			// C
			// C ACOR     LENRW-NEQ+1   Array of size NEQ used for the accumulated
			// C                        corrections on each step, scaled in the output
			// C                        to represent the estimated local error in Y
			// C                        on the last step.  This is the vector e in
			// C                        the description of the error control.  It is
			// C                        defined only on a successful return from DVODE.
			// C
			// C-----------------------------------------------------------------------
			// C Interrupting and Restarting
			// C
			// C If the integration of a given problem by DVODE is to be
			// C interrrupted and then later continued, such as when restarting
			// C an interrupted run or alternating between two or more ODE problems,
			// C the user should save, following the return from the last DVODE call
			// C prior to the interruption, the contents of the call sequence
			// C variables and internal COMMON blocks, and later restore these
			// C values before the next DVODE call for that problem.  To save
			// C and restore the COMMON blocks, use subroutine DVSRCO, as
			// C described below in part ii.
			// C
			// C In addition, if non-default values for either LUN or MFLAG are
			// C desired, an extra call to XSETUN and/or XSETF should be made just
			// C before continuing the integration.  See Part ii below for details.
			// C
			// C-----------------------------------------------------------------------
			// C Part ii.  Other Routines Callable.
			// C
			// C The following are optional calls which the user may make to
			// C gain additional capabilities in conjunction with DVODE.
			// C (The routines XSETUN and XSETF are designed to conform to the
			// C SLATEC error handling package.)
			// C
			// C     FORM OF CALL                  FUNCTION
			// C  CALL XSETUN(LUN)           Set the logical unit number, LUN, for
			// C                             output of messages from DVODE, if
			// C                             the default is not desired.
			// C                             The default value of LUN is 6.
			// C
			// C  CALL XSETF(MFLAG)          Set a flag to control the printing of
			// C                             messages by DVODE.
			// C                             MFLAG = 0 means do not print. (Danger:
			// C                             This risks losing valuable information.)
			// C                             MFLAG = 1 means print (the default).
			// C
			// C                             Either of the above calls may be made at
			// C                             any time and will take effect immediately.
			// C
			// C  CALL DVSRCO(RSAV,ISAV,JOB) Saves and restores the contents of
			// C                             the internal COMMON blocks used by
			// C                             DVODE. (See Part iii below.)
			// C                             RSAV must be a real array of length 49
			// C                             or more, and ISAV must be an integer
			// C                             array of length 40 or more.
			// C                             JOB=1 means save COMMON into RSAV/ISAV.
			// C                             JOB=2 means restore COMMON from RSAV/ISAV.
			// C                                DVSRCO is useful if one is
			// C                             interrupting a run and restarting
			// C                             later, or alternating between two or
			// C                             more problems solved with DVODE.
			// C
			// C  CALL DVINDY(,,,,,)         Provide derivatives of y, of various
			// C        (See below.)         orders, at a specified point T, if
			// C                             desired.  It may be called only after
			// C                             a successful return from DVODE.
			// C
			// C The detailed instructions for using DVINDY are as follows.
			// C The form of the call is:
			// C
			// C  CALL DVINDY (T, K, RWORK(21), NYH, DKY, IFLAG)
			// C
			// C The input parameters are:
			// C
			// C T         = Value of independent variable where answers are desired
			// C             (normally the same as the T last returned by DVODE).
			// C             For valid results, T must lie between TCUR - HU and TCUR.
			// C             (See optional output for TCUR and HU.)
			// C K         = Integer order of the derivative desired.  K must satisfy
			// C             0 .le. K .le. NQCUR, where NQCUR is the current order
			// C             (see optional output).  The capability corresponding
			// C             to K = 0, i.e. computing y(T), is already provided
			// C             by DVODE directly.  Since NQCUR .ge. 1, the first
			// C             derivative dy/dt is always available with DVINDY.
			// C RWORK(21) = The base address of the history array YH.
			// C NYH       = Column length of YH, equal to the initial value of NEQ.
			// C
			// C The output parameters are:
			// C
			// C DKY       = A real array of length NEQ containing the computed value
			// C             of the K-th derivative of y(t).
			// C IFLAG     = Integer flag, returned as 0 if K and T were legal,
			// C             -1 if K was illegal, and -2 if T was illegal.
			// C             On an error return, a message is also written.
			// C-----------------------------------------------------------------------
			// C Part iii.  COMMON Blocks.
			// C If DVODE is to be used in an overlay situation, the user
			// C must declare, in the primary overlay, the variables in:
			// C   (1) the call sequence to DVODE,
			// C   (2) the two internal COMMON blocks
			// C         /DVOD01/  of length  81  (48 double precision words
			// C                         followed by 33 integer words),
			// C         /DVOD02/  of length  9  (1 double precision word
			// C                         followed by 8 integer words),
			// C
			// C If DVODE is used on a system in which the contents of internal
			// C COMMON blocks are not preserved between calls, the user should
			// C declare the above two COMMON blocks in his main program to insure
			// C that their contents are preserved.
			// C
			// C-----------------------------------------------------------------------
			// C Part iv.  Optionally Replaceable Solver Routines.
			// C
			// C Below are descriptions of two routines in the DVODE package which
			// C relate to the measurement of errors.  Either routine can be
			// C replaced by a user-supplied version, if desired.  However, since such
			// C a replacement may have a major impact on performance, it should be
			// C done only when absolutely necessary, and only with great caution.
			// C (Note: The means by which the package version of a routine is
			// C superseded by the user's version may be system-dependent.)
			// C
			// C (a) DEWSET.
			// C The following subroutine is called just before each internal
			// C integration step, and sets the array of error weights, EWT, as
			// C described under ITOL/RTOL/ATOL above:
			// C     SUBROUTINE DEWSET (NEQ, ITOL, RTOL, ATOL, YCUR, EWT)
			// C where NEQ, ITOL, RTOL, and ATOL are as in the DVODE call sequence,
			// C YCUR contains the current dependent variable vector, and
			// C EWT is the array of weights set by DEWSET.
			// C
			// C If the user supplies this subroutine, it must return in EWT(i)
			// C (i = 1,...,NEQ) a positive quantity suitable for comparison with
			// C errors in Y(i).  The EWT array returned by DEWSET is passed to the
			// C DVNORM routine (See below.), and also used by DVODE in the computation
			// C of the optional output IMXER, the diagonal Jacobian approximation,
			// C and the increments for difference quotient Jacobians.
			// C
			// C In the user-supplied version of DEWSET, it may be desirable to use
			// C the current values of derivatives of y.  Derivatives up to order NQ
			// C are available from the history array YH, described above under
			// C Optional Output.  In DEWSET, YH is identical to the YCUR array,
			// C extended to NQ + 1 columns with a column length of NYH and scale
			// C factors of h**j/factorial(j).  On the first call for the problem,
			// C given by NST = 0, NQ is 1 and H is temporarily set to 1.0.
			// C NYH is the initial value of NEQ.  The quantities NQ, H, and NST
			// C can be obtained by including in DEWSET the statements:
			// C     DOUBLE PRECISION RVOD, H, HU
			// C     COMMON /DVOD01/ RVOD(48), IVOD(33)
			// C     COMMON /DVOD02/ HU, NCFN, NETF, NFE, NJE, NLU, NNI, NQU, NST
			// C     NQ = IVOD(28)
			// C     H = RVOD(21)
			// C Thus, for example, the current value of dy/dt can be obtained as
			// C YCUR(NYH+i)/H  (i=1,...,NEQ)  (and the division by H is
			// C unnecessary when NST = 0).
			// C
			// C (b) DVNORM.
			// C The following is a real function routine which computes the weighted
			// C root-mean-square norm of a vector v:
			// C     D = DVNORM (N, V, W)
			// C where:
			// C   N = the length of the vector,
			// C   V = real array of length N containing the vector,
			// C   W = real array of length N containing weights,
			// C   D = sqrt( (1/N) * sum(V(i)*W(i))**2 ).
			// C DVNORM is called with N = NEQ and with W(i) = 1.0/EWT(i), where
			// C EWT is as set by subroutine DEWSET.
			// C
			// C If the user supplies this function, it should return a non-negative
			// C value of DVNORM suitable for use in the error control in DVODE.
			// C None of the arguments should be altered by DVNORM.
			// C For example, a user-supplied DVNORM routine might:
			// C   -substitute a max-norm of (V(i)*W(i)) for the rms-norm, or
			// C   -ignore some components of V in the norm, with the effect of
			// C    suppressing the error control on those components of Y.
			// C-----------------------------------------------------------------------
			// C REVISION HISTORY (YYYYMMDD)
			// C  19890615  Date Written.  Initial release.
			// C  19890922  Added interrupt/restart ability, minor changes throughout.
			// C  19910228  Minor revisions in line format,  prologue, etc.
			// C  19920227  Modifications by D. Pang:
			// C            (1) Applied subgennam to get generic intrinsic names.
			// C            (2) Changed intrinsic names to generic in comments.
			// C            (3) Added *DECK lines before each routine.
			// C  19920721  Names of routines and labeled Common blocks changed, so as
			// C            to be unique in combined single/double precision code (ACH).
			// C  19920722  Minor revisions to prologue (ACH).
			// C  19920831  Conversion to double precision done (ACH).
			// C  19921106  Fixed minor bug: ETAQ,ETAQM1 in DVSTEP SAVE statement (ACH).
			// C  19921118  Changed LUNSAV/MFLGSV to IXSAV (ACH).
			// C  19941222  Removed MF overwrite; attached sign to H in estimated second
			// C            deriv. in DVHIN; misc. comment changes throughout (ACH).
			// C  19970515  Minor corrections to comments in prologue, DVJAC (ACH).
			// C  19981111  Corrected Block B by adding final line, GO TO 200 (ACH).
			// C  20020430  Various upgrades (ACH): Use ODEPACK error handler package.
			// C            Replaced D1MACH by DUMACH.  Various changes to main
			// C            prologue and other routine prologues.
			// C-----------------------------------------------------------------------
			// C Other Routines in the DVODE Package.
			// C
			// C In addition to subroutine DVODE, the DVODE package includes the
			// C following subroutines and function routines:
			// C  DVHIN     computes an approximate step size for the initial step.
			// C  DVINDY    computes an interpolated value of the y vector at t = TOUT.
			// C  DVSTEP    is the core integrator, which does one step of the
			// C            integration and the associated error control.
			// C  DVSET     sets all method coefficients and test constants.
			// C  DVNLSD    solves the underlying nonlinear system -- the corrector.
			// C  DVJAC     computes and preprocesses the Jacobian matrix J = df/dy
			// C            and the Newton iteration matrix P = I - (h/l1)*J.
			// C  DVSOL     manages solution of linear system in chord iteration.
			// C  DVJUST    adjusts the history array on a change of order.
			// C  DEWSET    sets the error weight vector EWT before each step.
			// C  DVNORM    computes the weighted r.m.s. norm of a vector.
			// C  DVSRCO    is a user-callable routine to save and restore
			// C            the contents of the internal COMMON blocks.
			// C  DACOPY    is a routine to copy one two-dimensional array to another.
			// C  DGEFA and DGESL   are routines from LINPACK for solving full
			// C            systems of linear algebraic equations.
			// C  DGBFA and DGBSL   are routines from LINPACK for solving banded
			// C            linear systems.
			// C  DAXPY, DSCAL, and DCOPY are basic linear algebra modules (BLAS).
			// C  DUMACH    sets the unit roundoff of the machine.
			// C  XERRWD, XSETUN, XSETF, IXSAV, and IUMACH handle the printing of all
			// C            error messages and warnings.  XERRWD is machine-dependent.
			// C Note:  DVNORM, DUMACH, IXSAV, and IUMACH are function routines.
			// C All the others are subroutines.
			// C
			// C-----------------------------------------------------------------------
			// C
			// C Type declarations for labeled COMMON block DVOD01 --------------------
			// C
			// C
			// C Type declarations for labeled COMMON block DVOD02 --------------------
			// C
			// C
			// C Type declarations for local variables --------------------------------
			// C
			// C
			// C Type declaration for function subroutines called ---------------------
			// C
			// C
			// C-----------------------------------------------------------------------
			// C The following Fortran-77 declaration is to cause the values of the
			// C listed (local) variables to be saved between calls to DVODE.
			// C-----------------------------------------------------------------------
			// C-----------------------------------------------------------------------
			// C The following internal COMMON blocks contain variables which are
			// C communicated between subroutines in the DVODE package, or which are
			// C to be saved between calls to DVODE.
			// C In each block, real variables precede integers.
			// C The block /DVOD01/ appears in subroutines DVODE, DVINDY, DVSTEP,
			// C DVSET, DVNLSD, DVJAC, DVSOL, DVJUST and DVSRCO.
			// C The block /DVOD02/ appears in subroutines DVODE, DVINDY, DVSTEP,
			// C DVNLSD, DVJAC, and DVSRCO.
			// C
			// C The variables stored in the internal COMMON blocks are as follows:
			// C
			// C ACNRM  = Weighted r.m.s. norm of accumulated correction vectors.
			// C CCMXJ  = Threshhold on DRC for updating the Jacobian. (See DRC.)
			// C CONP   = The saved value of TQ(5).
			// C CRATE  = Estimated corrector convergence rate constant.
			// C DRC    = Relative change in H*RL1 since last DVJAC call.
			// C EL     = Real array of integration coefficients.  See DVSET.
			// C ETA    = Saved tentative ratio of new to old H.
			// C ETAMAX = Saved maximum value of ETA to be allowed.
			// C H      = The step size.
			// C HMIN   = The minimum absolute value of the step size H to be used.
			// C HMXI   = Inverse of the maximum absolute value of H to be used.
			// C          HMXI = 0.0 is allowed and corresponds to an infinite HMAX.
			// C HNEW   = The step size to be attempted on the next step.
			// C HSCAL  = Stepsize in scaling of YH array.
			// C PRL1   = The saved value of RL1.
			// C RC     = Ratio of current H*RL1 to value on last DVJAC call.
			// C RL1    = The reciprocal of the coefficient EL(1).
			// C TAU    = Real vector of past NQ step sizes, length 13.
			// C TQ     = A real vector of length 5 in which DVSET stores constants
			// C          used for the convergence test, the error test, and the
			// C          selection of H at a new order.
			// C TN     = The independent variable, updated on each step taken.
			// C UROUND = The machine unit roundoff.  The smallest positive real number
			// C          such that  1.0 + UROUND .ne. 1.0
			// C ICF    = Integer flag for convergence failure in DVNLSD:
			// C            0 means no failures.
			// C            1 means convergence failure with out of date Jacobian
			// C                   (recoverable error).
			// C            2 means convergence failure with current Jacobian or
			// C                   singular matrix (unrecoverable error).
			// C INIT   = Saved integer flag indicating whether initialization of the
			// C          problem has been done (INIT = 1) or not.
			// C IPUP   = Saved flag to signal updating of Newton matrix.
			// C JCUR   = Output flag from DVJAC showing Jacobian status:
			// C            JCUR = 0 means J is not current.
			// C            JCUR = 1 means J is current.
			// C JSTART = Integer flag used as input to DVSTEP:
			// C            0  means perform the first step.
			// C            1  means take a new step continuing from the last.
			// C            -1 means take the next step with a new value of MAXORD,
			// C                  HMIN, HMXI, N, METH, MITER, and/or matrix parameters.
			// C          On return, DVSTEP sets JSTART = 1.
			// C JSV    = Integer flag for Jacobian saving, = sign(MF).
			// C KFLAG  = A completion code from DVSTEP with the following meanings:
			// C               0      the step was succesful.
			// C              -1      the requested error could not be achieved.
			// C              -2      corrector convergence could not be achieved.
			// C              -3, -4  fatal error in VNLS (can not occur here).
			// C KUTH   = Input flag to DVSTEP showing whether H was reduced by the
			// C          driver.  KUTH = 1 if H was reduced, = 0 otherwise.
			// C L      = Integer variable, NQ + 1, current order plus one.
			// C LMAX   = MAXORD + 1 (used for dimensioning).
			// C LOCJS  = A pointer to the saved Jacobian, whose storage starts at
			// C          WM(LOCJS), if JSV = 1.
			// C LYH, LEWT, LACOR, LSAVF, LWM, LIWM = Saved integer pointers
			// C          to segments of RWORK and IWORK.
			// C MAXORD = The maximum order of integration method to be allowed.
			// C METH/MITER = The method flags.  See MF.
			// C MSBJ   = The maximum number of steps between J evaluations, = 50.
			// C MXHNIL = Saved value of optional input MXHNIL.
			// C MXSTEP = Saved value of optional input MXSTEP.
			// C N      = The number of first-order ODEs, = NEQ.
			// C NEWH   = Saved integer to flag change of H.
			// C NEWQ   = The method order to be used on the next step.
			// C NHNIL  = Saved counter for occurrences of T + H = T.
			// C NQ     = Integer variable, the current integration method order.
			// C NQNYH  = Saved value of NQ*NYH.
			// C NQWAIT = A counter controlling the frequency of order changes.
			// C          An order change is about to be considered if NQWAIT = 1.
			// C NSLJ   = The number of steps taken as of the last Jacobian update.
			// C NSLP   = Saved value of NST as of last Newton matrix update.
			// C NYH    = Saved value of the initial value of NEQ.
			// C HU     = The step size in t last used.
			// C NCFN   = Number of nonlinear convergence failures so far.
			// C NETF   = The number of error test failures of the integrator so far.
			// C NFE    = The number of f evaluations for the problem so far.
			// C NJE    = The number of Jacobian evaluations so far.
			// C NLU    = The number of matrix LU decompositions so far.
			// C NNI    = Number of nonlinear iterations so far.
			// C NQU    = The method order last used.
			// C NST    = The number of steps taken for the problem so far.
			// C-----------------------------------------------------------------------
			// C
			// C-----------------------------------------------------------------------
			// C Block A.
			// C This code block is executed on every call.
			// C It tests ISTATE and ITASK for legality and branches appropriately.
			// C If ISTATE .gt. 1 but the flag INIT shows that initialization has
			// C not yet been done, an error return occurs.
			// C If ISTATE = 1 and TOUT = T, return immediately.
			// C-----------------------------------------------------------------------

			#endregion Prolog

			#region Body

			if (ISTATE < 1 || ISTATE > 3) goto LABEL601;
			if (ITASK < 1 || ITASK > 5) goto LABEL602;
			if (ISTATE == 1) goto LABEL10;
			if (INIT.v != 1) goto LABEL603;
			if (ISTATE == 2) goto LABEL200;
			goto LABEL20;
		LABEL10: INIT.v = 0;
			if (TOUT == T) return;
			// C-----------------------------------------------------------------------
			// C Block B.
			// C The next code block is executed for the initial call (ISTATE = 1),
			// C or for a continuation call with parameter changes (ISTATE = 3).
			// C It contains checking of all input and various initializations.
			// C
			// C First check legality of the non-optional input NEQ, ITOL, IOPT,
			// C MF, ML, and MU.
			// C-----------------------------------------------------------------------
			LABEL20:
			if (NEQ <= 0) goto LABEL604;
			if (ISTATE == 1) goto LABEL25;
			if (NEQ > N.v) goto LABEL605;
			LABEL25: N.v = NEQ;
			if (ITOL < 1 || ITOL > 4) goto LABEL606;
			if (IOPT < 0 || IOPT > 1) goto LABEL607;
			JSV.v = FortranLib.Sign(1, MF);
			MFA = Math.Abs(MF);
			METH.v = MFA / 10;
			MITER.v = MFA - 10 * METH.v;
			if (METH.v < 1 || METH.v > 2) goto LABEL608;
			if (MITER.v < 0 || MITER.v > 5) goto LABEL608;
			if (MITER.v <= 3) goto LABEL30;
			ML = IWORK[1 + o_iwork];
			MU = IWORK[2 + o_iwork];
			if (ML < 0 || ML >= N.v) goto LABEL609;
			if (MU < 0 || MU >= N.v) goto LABEL610;
			LABEL30:;
			// C Next process and check the optional input. ---------------------------
			if (IOPT == 1) goto LABEL40;
			MAXORD.v = MORD[METH.v + o_mord];
			MXSTEP.v = MXSTP0;
			MXHNIL.v = MXHNL0;
			if (ISTATE == 1) H0 = ZERO;
			HMXI.v = ZERO;
			HMIN.v = ZERO;
			goto LABEL60;
		LABEL40: MAXORD.v = IWORK[5 + o_iwork];
			if (MAXORD.v < 0) goto LABEL611;
			if (MAXORD.v == 0) MAXORD.v = 100;
			MAXORD.v = Math.Min(MAXORD.v, MORD[METH.v + o_mord]);
			MXSTEP.v = IWORK[6 + o_iwork];
			if (MXSTEP.v < 0) goto LABEL612;
			if (MXSTEP.v == 0) MXSTEP.v = MXSTP0;
			MXHNIL.v = IWORK[7 + o_iwork];
			if (MXHNIL.v < 0) goto LABEL613;
			if (MXHNIL.v == 0) MXHNIL.v = MXHNL0;
			if (ISTATE != 1) goto LABEL50;
			H0 = RWORK[5 + o_rwork];
			if ((TOUT - T) * H0 < ZERO) goto LABEL614;
			LABEL50: HMAX = RWORK[6 + o_rwork];
			if (HMAX < ZERO) goto LABEL615;
			HMXI.v = ZERO;
			if (HMAX > ZERO) HMXI.v = ONE / HMAX;
			HMIN.v = RWORK[7 + o_rwork];
			if (HMIN.v < ZERO) goto LABEL616;
			// C-----------------------------------------------------------------------
			// C Set work array pointers and check lengths LRW and LIW.
			// C Pointers to segments of RWORK and IWORK are named by prefixing L to
			// C the name of the segment.  E.g., the segment YH starts at RWORK(LYH).
			// C Segments of RWORK (in order) are denoted  YH, WM, EWT, SAVF, ACOR.
			// C Within WM, LOCJS is the location of the saved Jacobian (JSV .gt. 0).
			// C-----------------------------------------------------------------------
			LABEL60: LYH.v = 21;
			if (ISTATE == 1) NYH.v = N.v;
			LWM.v = LYH.v + (MAXORD.v + 1) * NYH.v;
			JCO = Math.Max(0, JSV.v);
			if (MITER.v == 0) LENWM = 0;
			if (MITER.v == 1 || MITER.v == 2)
			{
				LENWM = 2 + (1 + JCO) * N.v * N.v;
				LOCJS.v = N.v * N.v + 3;
			}
			if (MITER.v == 3) LENWM = 2 + N.v;
			if (MITER.v == 4 || MITER.v == 5)
			{
				MBAND = ML + MU + 1;
				LENP = (MBAND + ML) * N.v;
				LENJ = MBAND * N.v;
				LENWM = 2 + LENP + JCO * LENJ;
				LOCJS.v = LENP + 3;
			}
			LEWT.v = LWM.v + LENWM;
			LSAVF.v = LEWT.v + N.v;
			LACOR.v = LSAVF.v + N.v;
			LENRW = LACOR.v + N.v - 1;
			IWORK[17 + o_iwork] = LENRW;
			LIWM.v = 1;
			LENIW = 30 + N.v;
			if (MITER.v == 0 || MITER.v == 3) LENIW = 30;
			IWORK[18 + o_iwork] = LENIW;
			if (LENRW > LRW) goto LABEL617;
			if (LENIW > LIW) goto LABEL618;
			// C Check RTOL and ATOL for legality. ------------------------------------
			RTOLI = RTOL[1 + o_rtol];
			ATOLI = ATOL[1 + o_atol];
			for (I = 1; I <= N.v; I++)
			{
				if (ITOL >= 3) RTOLI = RTOL[I + o_rtol];
				if (ITOL == 2 || ITOL == 4) ATOLI = ATOL[I + o_atol];
				if (RTOLI < ZERO) goto LABEL619;
				if (ATOLI < ZERO) goto LABEL620;
			}
			if (ISTATE == 1) goto LABEL100;
			// C If ISTATE = 3, set flag to signal parameter changes to DVSTEP. -------
			JSTART.v = -1;
			if (NQ.v <= MAXORD.v) goto LABEL90;
			// C MAXORD was reduced below NQ.  Copy YH(*,MAXORD+2) into SAVF. ---------
			this._dcopy.Run(N.v, RWORK, LWM.v + o_rwork, 1, ref RWORK, LSAVF.v + o_rwork, 1);
		// C Reload WM(1) = RWORK(LWM), since LWM may have changed. ---------------
		LABEL90:
			if (MITER.v > 0) RWORK[LWM.v + o_rwork] = Math.Sqrt(UROUND.v);
			goto LABEL200;
		// C-----------------------------------------------------------------------
		// C Block C.
		// C The next block is for the initial call only (ISTATE = 1).
		// C It contains all remaining initializations, the initial call to F,
		// C and the calculation of the initial step size.
		// C The error weights in EWT are inverted after being loaded.
		// C-----------------------------------------------------------------------
		LABEL100: UROUND.v = this._dumach.Run();
			TN.v = T;
			if (ITASK != 4 && ITASK != 5) goto LABEL110;
			TCRIT = RWORK[1 + o_rwork];
			if ((TCRIT - TOUT) * (TOUT - T) < ZERO) goto LABEL625;
			if (H0 != ZERO && (T + H0 - TCRIT) * H0 > ZERO) H0 = TCRIT - T;
			LABEL110: JSTART.v = 0;
			if (MITER.v > 0) RWORK[LWM.v + o_rwork] = Math.Sqrt(UROUND.v);
			CCMXJ.v = PT2;
			MSBJ.v = 50;
			NHNIL.v = 0;
			NST.v = 0;
			NJE.v = 0;
			NNI.v = 0;
			NCFN.v = 0;
			NETF.v = 0;
			NLU.v = 0;
			NSLJ.v = 0;
			NSLAST = 0;
			HU.v = ZERO;
			NQU.v = 0;
			// C Initial call to F.  (LF0 points to YH(*,2).) -------------------------
			LF0 = LYH.v + NYH.v;
			F.Run(N.v, T, Y, offset_y, ref RWORK, LF0 + o_rwork, RPAR[1 + o_rpar], IPAR[1 + o_ipar]);
			NFE.v = 1;
			// C Load the initial value vector in YH. ---------------------------------
			this._dcopy.Run(N.v, Y, offset_y, 1, ref RWORK, LYH.v + o_rwork, 1);
			// C Load and invert the EWT array.  (H is temporarily set to 1.0.) -------
			NQ.v = 1;
			H.v = ONE;
			this._dewset.Run(N.v, ITOL, RTOL, offset_rtol, ATOL, offset_atol, RWORK, LYH.v + o_rwork, ref RWORK, LEWT.v + o_rwork);
			for (I = 1; I <= N.v; I++)
			{
				if (RWORK[I + LEWT.v - 1 + o_rwork] <= ZERO) goto LABEL621;
				RWORK[I + LEWT.v - 1 + o_rwork] = ONE / RWORK[I + LEWT.v - 1 + o_rwork];
			}
			if (H0 != ZERO) goto LABEL180;
			// C Call DVHIN to set initial step size H0 to be attempted. --------------
			this._dvhin.Run(N.v, T, RWORK, LYH.v + o_rwork, RWORK, LF0 + o_rwork, F, RPAR, offset_rpar
											, IPAR, offset_ipar, TOUT, UROUND.v, RWORK, LEWT.v + o_rwork, ITOL, ATOL, offset_atol
											, ref Y, offset_y, ref RWORK, LACOR.v + o_rwork, ref H0, ref NITER, ref IER);
			NFE.v += NITER;
			if (IER != 0) goto LABEL622;
			// C Adjust H0 if necessary to meet HMAX bound. ---------------------------
			LABEL180: RH = Math.Abs(H0) * HMXI.v;
			if (RH > ONE) H0 /= RH;
			// C Load H with H0 and scale YH(*,2) by H0. ------------------------------
			H.v = H0;
			this._dscal.Run(N.v, H0, ref RWORK, LF0 + o_rwork, 1);
			goto LABEL270;
		// C-----------------------------------------------------------------------
		// C Block D.
		// C The next code block is for continuation calls only (ISTATE = 2 or 3)
		// C and is to check stop conditions before taking a step.
		// C-----------------------------------------------------------------------
		LABEL200: NSLAST = NST.v;
			KUTH.v = 0;
			switch (ITASK)
			{
				case 1: goto LABEL210;
				case 2: goto LABEL250;
				case 3: goto LABEL220;
				case 4: goto LABEL230;
				case 5: goto LABEL240;
			}
		LABEL210:
			if ((TN.v - TOUT) * H.v < ZERO) goto LABEL250;
			this._dvindy.Run(TOUT, 0, RWORK, LYH.v + o_rwork, NYH.v, ref Y, offset_y, ref IFLAG);
			if (IFLAG != 0) goto LABEL627;
			T = TOUT;
			goto LABEL420;
		LABEL220: TP = TN.v - HU.v * (ONE + HUN * UROUND.v);
			if ((TP - TOUT) * H.v > ZERO) goto LABEL623;
			if ((TN.v - TOUT) * H.v < ZERO) goto LABEL250;
			goto LABEL400;
		LABEL230: TCRIT = RWORK[1 + o_rwork];
			if ((TN.v - TCRIT) * H.v > ZERO) goto LABEL624;
			if ((TCRIT - TOUT) * H.v < ZERO) goto LABEL625;
			if ((TN.v - TOUT) * H.v < ZERO) goto LABEL245;
			this._dvindy.Run(TOUT, 0, RWORK, LYH.v + o_rwork, NYH.v, ref Y, offset_y, ref IFLAG);
			if (IFLAG != 0) goto LABEL627;
			T = TOUT;
			goto LABEL420;
		LABEL240: TCRIT = RWORK[1 + o_rwork];
			if ((TN.v - TCRIT) * H.v > ZERO) goto LABEL624;
			LABEL245: HMX = Math.Abs(TN.v) + Math.Abs(H.v);
			IHIT = Math.Abs(TN.v - TCRIT) <= HUN * UROUND.v * HMX;
			if (IHIT) goto LABEL400;
			TNEXT = TN.v + HNEW.v * (ONE + FOUR * UROUND.v);
			if ((TNEXT - TCRIT) * H.v <= ZERO) goto LABEL250;
			H.v = (TCRIT - TN.v) * (ONE - FOUR * UROUND.v);
			KUTH.v = 1;
		// C-----------------------------------------------------------------------
		// C Block E.
		// C The next block is normally executed for all calls and contains
		// C the call to the one-step core integrator DVSTEP.
		// C
		// C This is a looping point for the integration steps.
		// C
		// C First check for too many steps being taken, update EWT (if not at
		// C start of problem), check for too much accuracy being requested, and
		// C check for H below the roundoff level in T.
		// C-----------------------------------------------------------------------
		LABEL250:;
			if ((NST.v - NSLAST) >= MXSTEP.v) goto LABEL500;
			this._dewset.Run(N.v, ITOL, RTOL, offset_rtol, ATOL, offset_atol, RWORK, LYH.v + o_rwork, ref RWORK, LEWT.v + o_rwork);
			for (I = 1; I <= N.v; I++)
			{
				if (RWORK[I + LEWT.v - 1 + o_rwork] <= ZERO) goto LABEL510;
				RWORK[I + LEWT.v - 1 + o_rwork] = ONE / RWORK[I + LEWT.v - 1 + o_rwork];
			}
		LABEL270: TOLSF = UROUND.v * this._dvnorm.Run(N.v, RWORK, LYH.v + o_rwork, RWORK, LEWT.v + o_rwork);
			if (TOLSF <= ONE) goto LABEL280;
			TOLSF *= TWO;
			if (NST.v == 0) goto LABEL626;
			goto LABEL520;
		LABEL280:
			if ((TN.v + H.v) != TN.v) goto LABEL290;
			NHNIL.v += 1;
			if (NHNIL.v > MXHNIL.v) goto LABEL290;
			FortranLib.Copy(ref MSG, "DVODE--  Warning: internal T (=R1) and H (=R2) are");
			this._xerrwd.Run(MSG, 50, 101, 1, 0, 0
											 , 0, 0, ZERO, ZERO);
			FortranLib.Copy(ref MSG, "      such that in the machine, T + H = T on the next step  ");
			this._xerrwd.Run(MSG, 60, 101, 1, 0, 0
											 , 0, 0, ZERO, ZERO);
			FortranLib.Copy(ref MSG, "      (H = step size). solver will continue anyway");
			this._xerrwd.Run(MSG, 50, 101, 1, 0, 0
											 , 0, 2, TN.v, H.v);
			if (NHNIL.v < MXHNIL.v) goto LABEL290;
			FortranLib.Copy(ref MSG, "DVODE--  Above warning has been issued I1 times.  ");
			this._xerrwd.Run(MSG, 50, 102, 1, 0, 0
											 , 0, 0, ZERO, ZERO);
			FortranLib.Copy(ref MSG, "      it will not be issued again for this problem");
			this._xerrwd.Run(MSG, 50, 102, 1, 1, MXHNIL.v
											 , 0, 0, ZERO, ZERO);
		LABEL290:;
			// C-----------------------------------------------------------------------
			// C CALL DVSTEP (Y, YH, NYH, YH, EWT, SAVF, VSAV, ACOR,
			// C              WM, IWM, F, JAC, F, DVNLSD, RPAR, IPAR)
			// C-----------------------------------------------------------------------
			this._dvstep.Run(ref Y, offset_y, ref RWORK, LYH.v + o_rwork, NYH.v, ref RWORK, LYH.v + o_rwork, RWORK, LEWT.v + o_rwork, ref RWORK, LSAVF.v + o_rwork
											 , Y, offset_y, ref RWORK, LACOR.v + o_rwork, ref RWORK, LWM.v + o_rwork, ref IWORK, LIWM.v + o_iwork, F, JAC
											 , F, this._dvnlsd, RPAR, offset_rpar, IPAR, offset_ipar);
			KGO = 1 - KFLAG.v;
			// C Branch on KFLAG.  Note: In this version, KFLAG can not be set to -3.
			// C  KFLAG .eq. 0,   -1,  -2
			switch (KGO)
			{
				case 1: goto LABEL300;
				case 2: goto LABEL530;
				case 3: goto LABEL540;
			}
		// C-----------------------------------------------------------------------
		// C Block F.
		// C The following block handles the case of a successful return from the
		// C core integrator (KFLAG = 0).  Test for stop conditions.
		// C-----------------------------------------------------------------------
		LABEL300: INIT.v = 1;
			KUTH.v = 0;
			switch (ITASK)
			{
				case 1: goto LABEL310;
				case 2: goto LABEL400;
				case 3: goto LABEL330;
				case 4: goto LABEL340;
				case 5: goto LABEL350;
			}
		// C ITASK = 1.  If TOUT has been reached, interpolate. -------------------
		LABEL310:
			if ((TN.v - TOUT) * H.v < ZERO) goto LABEL250;
			this._dvindy.Run(TOUT, 0, RWORK, LYH.v + o_rwork, NYH.v, ref Y, offset_y, ref IFLAG);
			T = TOUT;
			goto LABEL420;
		// C ITASK = 3.  Jump to exit if TOUT was reached. ------------------------
		LABEL330:
			if ((TN.v - TOUT) * H.v >= ZERO) goto LABEL400;
			goto LABEL250;
		// C ITASK = 4.  See if TOUT or TCRIT was reached.  Adjust H if necessary.
		LABEL340:
			if ((TN.v - TOUT) * H.v < ZERO) goto LABEL345;
			this._dvindy.Run(TOUT, 0, RWORK, LYH.v + o_rwork, NYH.v, ref Y, offset_y, ref IFLAG);
			T = TOUT;
			goto LABEL420;
		LABEL345: HMX = Math.Abs(TN.v) + Math.Abs(H.v);
			IHIT = Math.Abs(TN.v - TCRIT) <= HUN * UROUND.v * HMX;
			if (IHIT) goto LABEL400;
			TNEXT = TN.v + HNEW.v * (ONE + FOUR * UROUND.v);
			if ((TNEXT - TCRIT) * H.v <= ZERO) goto LABEL250;
			H.v = (TCRIT - TN.v) * (ONE - FOUR * UROUND.v);
			KUTH.v = 1;
			goto LABEL250;
		// C ITASK = 5.  See if TCRIT was reached and jump to exit. ---------------
		LABEL350: HMX = Math.Abs(TN.v) + Math.Abs(H.v);
			IHIT = Math.Abs(TN.v - TCRIT) <= HUN * UROUND.v * HMX;
		// C-----------------------------------------------------------------------
		// C Block G.
		// C The following block handles all successful returns from DVODE.
		// C If ITASK .ne. 1, Y is loaded from YH and T is set accordingly.
		// C ISTATE is set to 2, and the optional output is loaded into the work
		// C arrays before returning.
		// C-----------------------------------------------------------------------
		LABEL400:;
			this._dcopy.Run(N.v, RWORK, LYH.v + o_rwork, 1, ref Y, offset_y, 1);
			T = TN.v;
			if (ITASK != 4 && ITASK != 5) goto LABEL420;
			if (IHIT) T = TCRIT;
			LABEL420: ISTATE = 2;
			RWORK[11 + o_rwork] = HU.v;
			RWORK[12 + o_rwork] = HNEW.v;
			RWORK[13 + o_rwork] = TN.v;
			IWORK[11 + o_iwork] = NST.v;
			IWORK[12 + o_iwork] = NFE.v;
			IWORK[13 + o_iwork] = NJE.v;
			IWORK[14 + o_iwork] = NQU.v;
			IWORK[15 + o_iwork] = NEWQ.v;
			IWORK[19 + o_iwork] = NLU.v;
			IWORK[20 + o_iwork] = NNI.v;
			IWORK[21 + o_iwork] = NCFN.v;
			IWORK[22 + o_iwork] = NETF.v;
			return;
		// C-----------------------------------------------------------------------
		// C Block H.
		// C The following block handles all unsuccessful returns other than
		// C those for illegal input.  First the error message routine is called.
		// C if there was an error test or convergence test failure, IMXER is set.
		// C Then Y is loaded from YH, and T is set to TN.
		// C The optional output is loaded into the work arrays before returning.
		// C-----------------------------------------------------------------------
		// C The maximum number of steps was taken before reaching TOUT. ----------
		LABEL500: FortranLib.Copy(ref MSG, "DVODE--  At current T (=R1), MXSTEP (=I1) steps   ");
			this._xerrwd.Run(MSG, 50, 201, 1, 0, 0
											 , 0, 0, ZERO, ZERO);
			FortranLib.Copy(ref MSG, "      taken on this call before reaching TOUT     ");
			this._xerrwd.Run(MSG, 50, 201, 1, 1, MXSTEP.v
											 , 0, 1, TN.v, ZERO);
			ISTATE = -1;
			goto LABEL580;
		// C EWT(i) .le. 0.0 for some i (not at start of problem). ----------------
		LABEL510: EWTI = RWORK[LEWT.v + I - 1 + o_rwork];
			FortranLib.Copy(ref MSG, "DVODE--  At T (=R1), EWT(I1) has become R2 .le. 0.");
			this._xerrwd.Run(MSG, 50, 202, 1, 1, I
											 , 0, 2, TN.v, EWTI);
			ISTATE = -6;
			goto LABEL580;
		// C Too much accuracy requested for machine precision. -------------------
		LABEL520: FortranLib.Copy(ref MSG, "DVODE--  At T (=R1), too much accuracy requested  ");
			this._xerrwd.Run(MSG, 50, 203, 1, 0, 0
											 , 0, 0, ZERO, ZERO);
			FortranLib.Copy(ref MSG, "      for precision of machine:   see TOLSF (=R2) ");
			this._xerrwd.Run(MSG, 50, 203, 1, 0, 0
											 , 0, 2, TN.v, TOLSF);
			RWORK[14 + o_rwork] = TOLSF;
			ISTATE = -2;
			goto LABEL580;
		// C KFLAG = -1.  Error test failed repeatedly or with ABS(H) = HMIN. -----
		LABEL530: FortranLib.Copy(ref MSG, "DVODE--  At T(=R1) and step size H(=R2), the error");
			this._xerrwd.Run(MSG, 50, 204, 1, 0, 0
											 , 0, 0, ZERO, ZERO);
			FortranLib.Copy(ref MSG, "      test failed repeatedly or with abs(H) = HMIN");
			this._xerrwd.Run(MSG, 50, 204, 1, 0, 0
											 , 0, 2, TN.v, H.v);
			ISTATE = -4;
			goto LABEL560;
		// C KFLAG = -2.  Convergence failed repeatedly or with ABS(H) = HMIN. ----
		LABEL540: FortranLib.Copy(ref MSG, "DVODE--  At T (=R1) and step size H (=R2), the    ");
			this._xerrwd.Run(MSG, 50, 205, 1, 0, 0
											 , 0, 0, ZERO, ZERO);
			FortranLib.Copy(ref MSG, "      corrector convergence failed repeatedly     ");
			this._xerrwd.Run(MSG, 50, 205, 1, 0, 0
											 , 0, 0, ZERO, ZERO);
			FortranLib.Copy(ref MSG, "      or with abs(H) = HMIN   ");
			this._xerrwd.Run(MSG, 30, 205, 1, 0, 0
											 , 0, 2, TN.v, H.v);
			ISTATE = -5;
		// C Compute IMXER if relevant. -------------------------------------------
		LABEL560: BIG = ZERO;
			IMXER = 1;
			for (I = 1; I <= N.v; I++)
			{
				SIZE = Math.Abs(RWORK[I + LACOR.v - 1 + o_rwork] * RWORK[I + LEWT.v - 1 + o_rwork]);
				if (BIG >= SIZE) goto LABEL570;
				BIG = SIZE;
				IMXER = I;
			LABEL570:;
			}
			IWORK[16 + o_iwork] = IMXER;
		// C Set Y vector, T, and optional output. --------------------------------
		LABEL580:;
			this._dcopy.Run(N.v, RWORK, LYH.v + o_rwork, 1, ref Y, offset_y, 1);
			T = TN.v;
			RWORK[11 + o_rwork] = HU.v;
			RWORK[12 + o_rwork] = H.v;
			RWORK[13 + o_rwork] = TN.v;
			IWORK[11 + o_iwork] = NST.v;
			IWORK[12 + o_iwork] = NFE.v;
			IWORK[13 + o_iwork] = NJE.v;
			IWORK[14 + o_iwork] = NQU.v;
			IWORK[15 + o_iwork] = NQ.v;
			IWORK[19 + o_iwork] = NLU.v;
			IWORK[20 + o_iwork] = NNI.v;
			IWORK[21 + o_iwork] = NCFN.v;
			IWORK[22 + o_iwork] = NETF.v;
			return;
		// C-----------------------------------------------------------------------
		// C Block I.
		// C The following block handles all error returns due to illegal input
		// C (ISTATE = -3), as detected before calling the core integrator.
		// C First the error message routine is called.   If the illegal input
		// C is a negative ISTATE, the run is aborted (apparent infinite loop).
		// C-----------------------------------------------------------------------
		LABEL601: FortranLib.Copy(ref MSG, "DVODE--  ISTATE (=I1) illegal ");
			this._xerrwd.Run(MSG, 30, 1, 1, 1, ISTATE
											 , 0, 0, ZERO, ZERO);
			if (ISTATE < 0) goto LABEL800;
			goto LABEL700;
		LABEL602: FortranLib.Copy(ref MSG, "DVODE--  ITASK (=I1) illegal  ");
			this._xerrwd.Run(MSG, 30, 2, 1, 1, ITASK
											 , 0, 0, ZERO, ZERO);
			goto LABEL700;
		LABEL603: FortranLib.Copy(ref MSG, "DVODE--  ISTATE (=I1) .gt. 1 but DVODE not initialized      ");
			this._xerrwd.Run(MSG, 60, 3, 1, 1, ISTATE
											 , 0, 0, ZERO, ZERO);
			goto LABEL700;
		LABEL604: FortranLib.Copy(ref MSG, "DVODE--  NEQ (=I1) .lt. 1     ");
			this._xerrwd.Run(MSG, 30, 4, 1, 1, NEQ
											 , 0, 0, ZERO, ZERO);
			goto LABEL700;
		LABEL605: FortranLib.Copy(ref MSG, "DVODE--  ISTATE = 3 and NEQ increased (I1 to I2)  ");
			this._xerrwd.Run(MSG, 50, 5, 1, 2, N.v
											 , NEQ, 0, ZERO, ZERO);
			goto LABEL700;
		LABEL606: FortranLib.Copy(ref MSG, "DVODE--  ITOL (=I1) illegal   ");
			this._xerrwd.Run(MSG, 30, 6, 1, 1, ITOL
											 , 0, 0, ZERO, ZERO);
			goto LABEL700;
		LABEL607: FortranLib.Copy(ref MSG, "DVODE--  IOPT (=I1) illegal   ");
			this._xerrwd.Run(MSG, 30, 7, 1, 1, IOPT
											 , 0, 0, ZERO, ZERO);
			goto LABEL700;
		LABEL608: FortranLib.Copy(ref MSG, "DVODE--  MF (=I1) illegal     ");
			this._xerrwd.Run(MSG, 30, 8, 1, 1, MF
											 , 0, 0, ZERO, ZERO);
			goto LABEL700;
		LABEL609: FortranLib.Copy(ref MSG, "DVODE--  ML (=I1) illegal:  .lt.0 or .ge.NEQ (=I2)");
			this._xerrwd.Run(MSG, 50, 9, 1, 2, ML
											 , NEQ, 0, ZERO, ZERO);
			goto LABEL700;
		LABEL610: FortranLib.Copy(ref MSG, "DVODE--  MU (=I1) illegal:  .lt.0 or .ge.NEQ (=I2)");
			this._xerrwd.Run(MSG, 50, 10, 1, 2, MU
											 , NEQ, 0, ZERO, ZERO);
			goto LABEL700;
		LABEL611: FortranLib.Copy(ref MSG, "DVODE--  MAXORD (=I1) .lt. 0  ");
			this._xerrwd.Run(MSG, 30, 11, 1, 1, MAXORD.v
											 , 0, 0, ZERO, ZERO);
			goto LABEL700;
		LABEL612: FortranLib.Copy(ref MSG, "DVODE--  MXSTEP (=I1) .lt. 0  ");
			this._xerrwd.Run(MSG, 30, 12, 1, 1, MXSTEP.v
											 , 0, 0, ZERO, ZERO);
			goto LABEL700;
		LABEL613: FortranLib.Copy(ref MSG, "DVODE--  MXHNIL (=I1) .lt. 0  ");
			this._xerrwd.Run(MSG, 30, 13, 1, 1, MXHNIL.v
											 , 0, 0, ZERO, ZERO);
			goto LABEL700;
		LABEL614: FortranLib.Copy(ref MSG, "DVODE--  TOUT (=R1) behind T (=R2)      ");
			this._xerrwd.Run(MSG, 40, 14, 1, 0, 0
											 , 0, 2, TOUT, T);
			FortranLib.Copy(ref MSG, "      integration direction is given by H0 (=R1)  ");
			this._xerrwd.Run(MSG, 50, 14, 1, 0, 0
											 , 0, 1, H0, ZERO);
			goto LABEL700;
		LABEL615: FortranLib.Copy(ref MSG, "DVODE--  HMAX (=R1) .lt. 0.0  ");
			this._xerrwd.Run(MSG, 30, 15, 1, 0, 0
											 , 0, 1, HMAX, ZERO);
			goto LABEL700;
		LABEL616: FortranLib.Copy(ref MSG, "DVODE--  HMIN (=R1) .lt. 0.0  ");
			this._xerrwd.Run(MSG, 30, 16, 1, 0, 0
											 , 0, 1, HMIN.v, ZERO);
			goto LABEL700;
		LABEL617:;
			FortranLib.Copy(ref MSG, "DVODE--  RWORK length needed, LENRW (=I1), exceeds LRW (=I2)");
			this._xerrwd.Run(MSG, 60, 17, 1, 2, LENRW
											 , LRW, 0, ZERO, ZERO);
			goto LABEL700;
		LABEL618:;
			FortranLib.Copy(ref MSG, "DVODE--  IWORK length needed, LENIW (=I1), exceeds LIW (=I2)");
			this._xerrwd.Run(MSG, 60, 18, 1, 2, LENIW
											 , LIW, 0, ZERO, ZERO);
			goto LABEL700;
		LABEL619: FortranLib.Copy(ref MSG, "DVODE--  RTOL(I1) is R1 .lt. 0.0        ");
			this._xerrwd.Run(MSG, 40, 19, 1, 1, I
											 , 0, 1, RTOLI, ZERO);
			goto LABEL700;
		LABEL620: FortranLib.Copy(ref MSG, "DVODE--  ATOL(I1) is R1 .lt. 0.0        ");
			this._xerrwd.Run(MSG, 40, 20, 1, 1, I
											 , 0, 1, ATOLI, ZERO);
			goto LABEL700;
		LABEL621: EWTI = RWORK[LEWT.v + I - 1 + o_rwork];
			FortranLib.Copy(ref MSG, "DVODE--  EWT(I1) is R1 .le. 0.0         ");
			this._xerrwd.Run(MSG, 40, 21, 1, 1, I
											 , 0, 1, EWTI, ZERO);
			goto LABEL700;
		LABEL622:;
			FortranLib.Copy(ref MSG, "DVODE--  TOUT (=R1) too close to T(=R2) to start integration");
			this._xerrwd.Run(MSG, 60, 22, 1, 0, 0
											 , 0, 2, TOUT, T);
			goto LABEL700;
		LABEL623:;
			FortranLib.Copy(ref MSG, "DVODE--  ITASK = I1 and TOUT (=R1) behind TCUR - HU (= R2)  ");
			this._xerrwd.Run(MSG, 60, 23, 1, 1, ITASK
											 , 0, 2, TOUT, TP);
			goto LABEL700;
		LABEL624:;
			FortranLib.Copy(ref MSG, "DVODE--  ITASK = 4 or 5 and TCRIT (=R1) behind TCUR (=R2)   ");
			this._xerrwd.Run(MSG, 60, 24, 1, 0, 0
											 , 0, 2, TCRIT, TN.v);
			goto LABEL700;
		LABEL625:;
			FortranLib.Copy(ref MSG, "DVODE--  ITASK = 4 or 5 and TCRIT (=R1) behind TOUT (=R2)   ");
			this._xerrwd.Run(MSG, 60, 25, 1, 0, 0
											 , 0, 2, TCRIT, TOUT);
			goto LABEL700;
		LABEL626: FortranLib.Copy(ref MSG, "DVODE--  At start of problem, too much accuracy   ");
			this._xerrwd.Run(MSG, 50, 26, 1, 0, 0
											 , 0, 0, ZERO, ZERO);
			FortranLib.Copy(ref MSG, "      requested for precision of machine:   see TOLSF (=R1) ");
			this._xerrwd.Run(MSG, 60, 26, 1, 0, 0
											 , 0, 1, TOLSF, ZERO);
			RWORK[14 + o_rwork] = TOLSF;
			goto LABEL700;
		LABEL627: FortranLib.Copy(ref MSG, "DVODE--  Trouble from DVINDY.  ITASK = I1, TOUT = R1.       ");
			this._xerrwd.Run(MSG, 60, 27, 1, 1, ITASK
											 , 0, 1, TOUT, ZERO);
		// C
		LABEL700:;
			ISTATE = -3;
			return;
		// C
		LABEL800: FortranLib.Copy(ref MSG, "DVODE--  Run aborted:  apparent infinite loop     ");
			this._xerrwd.Run(MSG, 50, 303, 2, 0, 0
											 , 0, 0, ZERO, ZERO);
			return;
			// C----------------------- End of Subroutine DVODE -----------------------

			#endregion Body
		}
예제 #2
0
파일: dvode.cs 프로젝트: Altaxo/Altaxo
		/// <param name="Y">
		/// = Vector containing predicted values on entry.
		///</param>
		/// <param name="YH">
		/// = The Nordsieck array, an LDYH by LMAX array, input.
		///</param>
		/// <param name="LDYH">
		/// = A constant .ge. N, the first dimension of YH, input.
		///</param>
		/// <param name="EWT">
		/// = An error weight vector of length N.
		///</param>
		/// <param name="SAVF">
		/// = Array containing f evaluated at predicted y, input.
		///</param>
		/// <param name="WM">
		/// = Real work space for matrices.  In the output, it containS
		/// the inverse diagonal matrix if MITER = 3 and the LU
		/// decomposition of P if MITER is 1, 2 , 4, or 5.
		/// Storage of matrix elements starts at WM(3).
		/// Storage of the saved Jacobian starts at WM(LOCJS).
		/// WM also contains the following matrix-related data:
		/// WM(1) = SQRT(UROUND), used in numerical Jacobian step.
		/// WM(2) = H*RL1, saved for later use if MITER = 3.
		///</param>
		/// <param name="IWM">
		/// = Integer work space containing pivot information,
		/// starting at IWM(31), if MITER is 1, 2, 4, or 5.
		/// IWM also contains band parameters ML = IWM(1) and
		/// MU = IWM(2) if MITER is 4 or 5.
		///</param>
		/// <param name="F">
		/// = Dummy name for the user supplied subroutine for f.
		///</param>
		/// <param name="JAC">
		/// = Dummy name for the user supplied Jacobian subroutine.
		///</param>
		/// <param name="IERPJ">
		/// = Output error flag,  = 0 if no trouble, 1 if the P
		/// matrix is found to be singular.
		///</param>
		public void Run(ref double[] Y, int offset_y, double[] YH, int offset_yh, int LDYH, double[] EWT, int offset_ewt, ref double[] FTEM, int offset_ftem, double[] SAVF, int offset_savf
										 , ref double[] WM, int offset_wm, ref int[] IWM, int offset_iwm, IFEX F, IJEX JAC, ref int IERPJ, double[] RPAR, int offset_rpar
										 , int[] IPAR, int offset_ipar)
		{
			#region Variables

			double CON = 0; double DI = 0; double FAC = 0; double HRL1 = 0; double R = 0; double R0 = 0; double SRUR = 0;
			double YI = 0; double YJ = 0; double YJJ = 0; int I = 0; int I1 = 0; int I2 = 0; int IER = 0; int II = 0; int J = 0;
			int J1 = 0; int JJ = 0; int JOK = 0; int LENP = 0; int MBA = 0; int MBAND = 0; int MEB1 = 0; int MEBAND = 0;
			int ML = 0; int ML3 = 0; int MU = 0; int NP1 = 0;

			#endregion Variables

			#region Implicit Variables

			int YH_2 = 0; int YH_1 = 0;

			#endregion Implicit Variables

			#region Array Index Correction

			int o_y = -1 + offset_y; int o_yh = -1 - LDYH + offset_yh; int o_ewt = -1 + offset_ewt;
			int o_ftem = -1 + offset_ftem; int o_savf = -1 + offset_savf; int o_wm = -1 + offset_wm;
			int o_iwm = -1 + offset_iwm; int o_rpar = -1 + offset_rpar; int o_ipar = -1 + offset_ipar;

			#endregion Array Index Correction

			#region Prolog

			// C-----------------------------------------------------------------------
			// C Call sequence input -- Y, YH, LDYH, EWT, FTEM, SAVF, WM, IWM,
			// C                        F, JAC, RPAR, IPAR
			// C Call sequence output -- WM, IWM, IERPJ
			// C COMMON block variables accessed:
			// C     /DVOD01/  CCMXJ, DRC, H, RL1, TN, UROUND, ICF, JCUR, LOCJS,
			// C               MITER, MSBJ, N, NSLJ
			// C     /DVOD02/  NFE, NST, NJE, NLU
			// C
			// C Subroutines called by DVJAC: F, JAC, DACOPY, DCOPY, DGBFA, DGEFA,
			// C                              DSCAL
			// C Function routines called by DVJAC: DVNORM
			// C-----------------------------------------------------------------------
			// C DVJAC is called by DVNLSD to compute and process the matrix
			// C P = I - h*rl1*J , where J is an approximation to the Jacobian.
			// C Here J is computed by the user-supplied routine JAC if
			// C MITER = 1 or 4, or by finite differencing if MITER = 2, 3, or 5.
			// C If MITER = 3, a diagonal approximation to J is used.
			// C If JSV = -1, J is computed from scratch in all cases.
			// C If JSV = 1 and MITER = 1, 2, 4, or 5, and if the saved value of J is
			// C considered acceptable, then P is constructed from the saved J.
			// C J is stored in wm and replaced by P.  If MITER .ne. 3, P is then
			// C subjected to LU decomposition in preparation for later solution
			// C of linear systems with P as coefficient matrix. This is done
			// C by DGEFA if MITER = 1 or 2, and by DGBFA if MITER = 4 or 5.
			// C
			// C Communication with DVJAC is done with the following variables.  (For
			// C more details, please see the comments in the driver subroutine.)
			// C Y          = Vector containing predicted values on entry.
			// C YH         = The Nordsieck array, an LDYH by LMAX array, input.
			// C LDYH       = A constant .ge. N, the first dimension of YH, input.
			// C EWT        = An error weight vector of length N.
			// C SAVF       = Array containing f evaluated at predicted y, input.
			// C WM         = Real work space for matrices.  In the output, it containS
			// C              the inverse diagonal matrix if MITER = 3 and the LU
			// C              decomposition of P if MITER is 1, 2 , 4, or 5.
			// C              Storage of matrix elements starts at WM(3).
			// C              Storage of the saved Jacobian starts at WM(LOCJS).
			// C              WM also contains the following matrix-related data:
			// C              WM(1) = SQRT(UROUND), used in numerical Jacobian step.
			// C              WM(2) = H*RL1, saved for later use if MITER = 3.
			// C IWM        = Integer work space containing pivot information,
			// C              starting at IWM(31), if MITER is 1, 2, 4, or 5.
			// C              IWM also contains band parameters ML = IWM(1) and
			// C              MU = IWM(2) if MITER is 4 or 5.
			// C F          = Dummy name for the user supplied subroutine for f.
			// C JAC        = Dummy name for the user supplied Jacobian subroutine.
			// C RPAR, IPAR = Dummy names for user's real and integer work arrays.
			// C RL1        = 1/EL(2) (input).
			// C IERPJ      = Output error flag,  = 0 if no trouble, 1 if the P
			// C              matrix is found to be singular.
			// C JCUR       = Output flag to indicate whether the Jacobian matrix
			// C              (or approximation) is now current.
			// C              JCUR = 0 means J is not current.
			// C              JCUR = 1 means J is current.
			// C-----------------------------------------------------------------------
			// C
			// C Type declarations for labeled COMMON block DVOD01 --------------------
			// C
			// C
			// C Type declarations for labeled COMMON block DVOD02 --------------------
			// C
			// C
			// C Type declarations for local variables --------------------------------
			// C
			// C
			// C Type declaration for function subroutines called ---------------------
			// C
			// C-----------------------------------------------------------------------
			// C The following Fortran-77 declaration is to cause the values of the
			// C listed (local) variables to be saved between calls to this subroutine.
			// C-----------------------------------------------------------------------
			// C-----------------------------------------------------------------------
			// C
			// C

			#endregion Prolog

			#region Body

			IERPJ = 0;
			HRL1 = H.v * RL1.v;
			// C See whether J should be evaluated (JOK = -1) or not (JOK = 1). -------
			JOK = JSV.v;
			if (JSV.v == 1)
			{
				if (NST.v == 0 || NST.v > NSLJ.v + MSBJ.v) JOK = -1;
				if (ICF.v == 1 && DRC.v < CCMXJ.v) JOK = -1;
				if (ICF.v == 2) JOK = -1;
			}
			// C End of setting JOK. --------------------------------------------------
			// C
			if (JOK == -1 && MITER.v == 1)
			{
				// C If JOK = -1 and MITER = 1, call JAC to evaluate Jacobian. ------------
				NJE.v += 1;
				NSLJ.v = NST.v;
				JCUR.v = 1;
				LENP = N.v * N.v;
				for (I = 1; I <= LENP; I++)
				{
					WM[I + 2 + o_wm] = ZERO;
				}
				JAC.Run(N.v, TN.v, Y, offset_y, 0, 0, ref WM, 3 + o_wm
								, N.v, RPAR[1 + o_rpar], IPAR[1 + o_ipar]);
				if (JSV.v == 1) this._dcopy.Run(LENP, WM, 3 + o_wm, 1, ref WM, LOCJS.v + o_wm, 1);
			}
			// C
			if (JOK == -1 && MITER.v == 2)
			{
				// C If MITER = 2, make N calls to F to approximate the Jacobian. ---------
				NJE.v += 1;
				NSLJ.v = NST.v;
				JCUR.v = 1;
				FAC = this._dvnorm.Run(N.v, SAVF, offset_savf, EWT, offset_ewt);
				R0 = THOU * Math.Abs(H.v) * UROUND.v * Convert.ToSingle(N.v) * FAC;
				if (R0 == ZERO) R0 = ONE;
				SRUR = WM[1 + o_wm];
				J1 = 2;
				for (J = 1; J <= N.v; J++)
				{
					YJ = Y[J + o_y];
					R = Math.Max(SRUR * Math.Abs(YJ), R0 / EWT[J + o_ewt]);
					Y[J + o_y] += R;
					FAC = ONE / R;
					F.Run(N.v, TN.v, Y, offset_y, ref FTEM, offset_ftem, RPAR[1 + o_rpar], IPAR[1 + o_ipar]);
					for (I = 1; I <= N.v; I++)
					{
						WM[I + J1 + o_wm] = (FTEM[I + o_ftem] - SAVF[I + o_savf]) * FAC;
					}
					Y[J + o_y] = YJ;
					J1 += N.v;
				}
				NFE.v += N.v;
				LENP = N.v * N.v;
				if (JSV.v == 1) this._dcopy.Run(LENP, WM, 3 + o_wm, 1, ref WM, LOCJS.v + o_wm, 1);
			}
			// C
			if (JOK == 1 && (MITER.v == 1 || MITER.v == 2))
			{
				JCUR.v = 0;
				LENP = N.v * N.v;
				this._dcopy.Run(LENP, WM, LOCJS.v + o_wm, 1, ref WM, 3 + o_wm, 1);
			}
			// C
			if (MITER.v == 1 || MITER.v == 2)
			{
				// C Multiply Jacobian by scalar, add identity, and do LU decomposition. --
				CON = -HRL1;
				this._dscal.Run(LENP, CON, ref WM, 3 + o_wm, 1);
				J = 3;
				NP1 = N.v + 1;
				for (I = 1; I <= N.v; I++)
				{
					WM[J + o_wm] += ONE;
					J += NP1;
				}
				NLU.v += 1;
				this._dgefa.Run(ref WM, 3 + o_wm, N.v, N.v, ref IWM, 31 + o_iwm, ref IER);
				if (IER != 0) IERPJ = 1;
				return;
			}
			// C End of code block for MITER = 1 or 2. --------------------------------
			// C
			if (MITER.v == 3)
			{
				// C If MITER = 3, construct a diagonal approximation to J and P. ---------
				NJE.v += 1;
				JCUR.v = 1;
				WM[2 + o_wm] = HRL1;
				R = RL1.v * PT1;
				for (I = 1; I <= N.v; I++)
				{
					Y[I + o_y] += R * (H.v * SAVF[I + o_savf] - YH[I + 2 * LDYH + o_yh]);
				}
				F.Run(N.v, TN.v, Y, offset_y, ref WM, 3 + o_wm, RPAR[1 + o_rpar], IPAR[1 + o_ipar]);
				NFE.v += 1;
				YH_2 = 2 * LDYH + o_yh;
				for (I = 1; I <= N.v; I++)
				{
					R0 = H.v * SAVF[I + o_savf] - YH[I + YH_2];
					DI = PT1 * R0 - H.v * (WM[I + 2 + o_wm] - SAVF[I + o_savf]);
					WM[I + 2 + o_wm] = ONE;
					if (Math.Abs(R0) < UROUND.v / EWT[I + o_ewt]) goto LABEL320;
					if (Math.Abs(DI) == ZERO) goto LABEL330;
					WM[I + 2 + o_wm] = PT1 * R0 / DI;
				LABEL320:;
				}
				return;
			LABEL330: IERPJ = 1;
				return;
			}
			// C End of code block for MITER = 3. -------------------------------------
			// C
			// C Set constants for MITER = 4 or 5. ------------------------------------
			ML = IWM[1 + o_iwm];
			MU = IWM[2 + o_iwm];
			ML3 = ML + 3;
			MBAND = ML + MU + 1;
			MEBAND = MBAND + ML;
			LENP = MEBAND * N.v;
			// C
			if (JOK == -1 && MITER.v == 4)
			{
				// C If JOK = -1 and MITER = 4, call JAC to evaluate Jacobian. ------------
				NJE.v += 1;
				NSLJ.v = NST.v;
				JCUR.v = 1;
				for (I = 1; I <= LENP; I++)
				{
					WM[I + 2 + o_wm] = ZERO;
				}
				JAC.Run(N.v, TN.v, Y, offset_y, ML, MU, ref WM, ML3 + o_wm
								, MEBAND, RPAR[1 + o_rpar], IPAR[1 + o_ipar]);
				if (JSV.v == 1) this._dacopy.Run(MBAND, N.v, WM, ML3 + o_wm, MEBAND, ref WM, LOCJS.v + o_wm, MBAND);
			}
			// C
			if (JOK == -1 && MITER.v == 5)
			{
				// C If MITER = 5, make ML+MU+1 calls to F to approximate the Jacobian. ---
				NJE.v += 1;
				NSLJ.v = NST.v;
				JCUR.v = 1;
				MBA = Math.Min(MBAND, N.v);
				MEB1 = MEBAND - 1;
				SRUR = WM[1 + o_wm];
				FAC = this._dvnorm.Run(N.v, SAVF, offset_savf, EWT, offset_ewt);
				R0 = THOU * Math.Abs(H.v) * UROUND.v * Convert.ToSingle(N.v) * FAC;
				if (R0 == ZERO) R0 = ONE;
				for (J = 1; J <= MBA; J++)
				{
					for (I = J; (MBAND >= 0) ? (I <= N.v) : (I >= N.v); I += MBAND)
					{
						YI = Y[I + o_y];
						R = Math.Max(SRUR * Math.Abs(YI), R0 / EWT[I + o_ewt]);
						Y[I + o_y] += R;
					}
					F.Run(N.v, TN.v, Y, offset_y, ref FTEM, offset_ftem, RPAR[1 + o_rpar], IPAR[1 + o_ipar]);
					YH_1 = 1 * LDYH + o_yh;
					for (JJ = J; (MBAND >= 0) ? (JJ <= N.v) : (JJ >= N.v); JJ += MBAND)
					{
						Y[JJ + o_y] = YH[JJ + YH_1];
						YJJ = Y[JJ + o_y];
						R = Math.Max(SRUR * Math.Abs(YJJ), R0 / EWT[JJ + o_ewt]);
						FAC = ONE / R;
						I1 = Math.Max(JJ - MU, 1);
						I2 = Math.Min(JJ + ML, N.v);
						II = JJ * MEB1 - ML + 2;
						for (I = I1; I <= I2; I++)
						{
							WM[II + I + o_wm] = (FTEM[I + o_ftem] - SAVF[I + o_savf]) * FAC;
						}
					}
				}
				NFE.v += MBA;
				if (JSV.v == 1) this._dacopy.Run(MBAND, N.v, WM, ML3 + o_wm, MEBAND, ref WM, LOCJS.v + o_wm, MBAND);
			}
			// C
			if (JOK == 1)
			{
				JCUR.v = 0;
				this._dacopy.Run(MBAND, N.v, WM, LOCJS.v + o_wm, MBAND, ref WM, ML3 + o_wm, MEBAND);
			}
			// C
			// C Multiply Jacobian by scalar, add identity, and do LU decomposition.
			CON = -HRL1;
			this._dscal.Run(LENP, CON, ref WM, 3 + o_wm, 1);
			II = MBAND + 2;
			for (I = 1; I <= N.v; I++)
			{
				WM[II + o_wm] += ONE;
				II += MEBAND;
			}
			NLU.v += 1;
			this._dgbfa.Run(ref WM, 3 + o_wm, MEBAND, N.v, ML, MU, ref IWM, 31 + o_iwm
											, ref IER);
			if (IER != 0) IERPJ = 1;
			return;
			// C End of code block for MITER = 4 or 5. --------------------------------
			// C
			// C----------------------- End of Subroutine DVJAC -----------------------

			#endregion Body
		}
예제 #3
0
파일: dvode.cs 프로젝트: Altaxo/Altaxo
		/// <param name="Y">
		/// = An array of length N used for the dependent variable vector.
		///</param>
		/// <param name="YH">
		/// = An LDYH by LMAX array containing the dependent variables
		/// and their approximate scaled derivatives, where
		/// LMAX = MAXORD + 1.  YH(i,j+1) contains the approximate
		/// j-th derivative of y(i), scaled by H**j/factorial(j)
		/// (j = 0,1,...,NQ).  On entry for the first step, the first
		/// two columns of YH must be set from the initial values.
		///</param>
		/// <param name="LDYH">
		/// = A constant integer .ge. N, the first dimension of YH.
		/// N is the number of ODEs in the system.
		///</param>
		/// <param name="YH1">
		/// = A one-dimensional array occupying the same space as YH.
		///</param>
		/// <param name="EWT">
		/// = An array of length N containing multiplicative weights
		/// for local error measurements.  Local errors in y(i) are
		/// compared to 1.0/EWT(i) in various error tests.
		///</param>
		/// <param name="SAVF">
		/// = An array of working storage, of length N.
		/// also used for input of YH(*,MAXORD+2) when JSTART = -1
		/// and MAXORD .lt. the current order NQ.
		///</param>
		/// <param name="VSAV">
		/// = A work array of length N passed to subroutine VNLS.
		///</param>
		/// <param name="ACOR">
		/// = A work array of length N, used for the accumulated
		/// corrections.  On a successful return, ACOR(i) contains
		/// the estimated one-step local error in y(i).
		///</param>
		/// <param name="F">
		/// = Dummy name for the user supplied subroutine for f.
		///</param>
		/// <param name="JAC">
		/// = Dummy name for the user supplied Jacobian subroutine.
		///</param>
		/// <param name="PSOL">
		/// = Dummy name for the subroutine passed to VNLS, for
		/// possible use there.
		///</param>
		/// <param name="VNLS">
		/// = Dummy name for the nonlinear system solving subroutine,
		/// whose real name is dependent on the method used.
		///</param>
		public void Run(ref double[] Y, int offset_y, ref double[] YH, int offset_yh, int LDYH, ref double[] YH1, int offset_yh1, double[] EWT, int offset_ewt, ref double[] SAVF, int offset_savf
										 , double[] VSAV, int offset_vsav, ref double[] ACOR, int offset_acor, ref double[] WM, int offset_wm, ref int[] IWM, int offset_iwm, IFEX F, IJEX JAC
										 , IFEX PSOL, IDVNLSD VNLS, double[] RPAR, int offset_rpar, int[] IPAR, int offset_ipar)
		{
			#region Variables

			double CNQUOT = 0; double DDN = 0; double DSM = 0; double DUP = 0; double ETAQP1 = 0; double FLOTL = 0; double R = 0;
			double TOLD = 0; int I = 0; int I1 = 0; int I2 = 0; int IBACK = 0; int J = 0; int JB = 0; int NCF = 0; int NFLAG = 0;

			#endregion Variables

			#region Array Index Correction

			int o_y = -1 + offset_y; int o_yh = -1 - LDYH + offset_yh; int o_yh1 = -1 + offset_yh1;
			int o_ewt = -1 + offset_ewt; int o_savf = -1 + offset_savf; int o_vsav = -1 + offset_vsav;
			int o_acor = -1 + offset_acor; int o_wm = -1 + offset_wm; int o_iwm = -1 + offset_iwm;
			int o_rpar = -1 + offset_rpar; int o_ipar = -1 + offset_ipar;

			#endregion Array Index Correction

			#region Prolog

			// C-----------------------------------------------------------------------
			// C Call sequence input -- Y, YH, LDYH, YH1, EWT, SAVF, VSAV,
			// C                        ACOR, WM, IWM, F, JAC, PSOL, VNLS, RPAR, IPAR
			// C Call sequence output -- YH, ACOR, WM, IWM
			// C COMMON block variables accessed:
			// C     /DVOD01/  ACNRM, EL(13), H, HMIN, HMXI, HNEW, HSCAL, RC, TAU(13),
			// C               TQ(5), TN, JCUR, JSTART, KFLAG, KUTH,
			// C               L, LMAX, MAXORD, N, NEWQ, NQ, NQWAIT
			// C     /DVOD02/  HU, NCFN, NETF, NFE, NQU, NST
			// C
			// C Subroutines called by DVSTEP: F, DAXPY, DCOPY, DSCAL,
			// C                               DVJUST, VNLS, DVSET
			// C Function routines called by DVSTEP: DVNORM
			// C-----------------------------------------------------------------------
			// C DVSTEP performs one step of the integration of an initial value
			// C problem for a system of ordinary differential equations.
			// C DVSTEP calls subroutine VNLS for the solution of the nonlinear system
			// C arising in the time step.  Thus it is independent of the problem
			// C Jacobian structure and the type of nonlinear system solution method.
			// C DVSTEP returns a completion flag KFLAG (in COMMON).
			// C A return with KFLAG = -1 or -2 means either ABS(H) = HMIN or 10
			// C consecutive failures occurred.  On a return with KFLAG negative,
			// C the values of TN and the YH array are as of the beginning of the last
			// C step, and H is the last step size attempted.
			// C
			// C Communication with DVSTEP is done with the following variables:
			// C
			// C Y      = An array of length N used for the dependent variable vector.
			// C YH     = An LDYH by LMAX array containing the dependent variables
			// C          and their approximate scaled derivatives, where
			// C          LMAX = MAXORD + 1.  YH(i,j+1) contains the approximate
			// C          j-th derivative of y(i), scaled by H**j/factorial(j)
			// C          (j = 0,1,...,NQ).  On entry for the first step, the first
			// C          two columns of YH must be set from the initial values.
			// C LDYH   = A constant integer .ge. N, the first dimension of YH.
			// C          N is the number of ODEs in the system.
			// C YH1    = A one-dimensional array occupying the same space as YH.
			// C EWT    = An array of length N containing multiplicative weights
			// C          for local error measurements.  Local errors in y(i) are
			// C          compared to 1.0/EWT(i) in various error tests.
			// C SAVF   = An array of working storage, of length N.
			// C          also used for input of YH(*,MAXORD+2) when JSTART = -1
			// C          and MAXORD .lt. the current order NQ.
			// C VSAV   = A work array of length N passed to subroutine VNLS.
			// C ACOR   = A work array of length N, used for the accumulated
			// C          corrections.  On a successful return, ACOR(i) contains
			// C          the estimated one-step local error in y(i).
			// C WM,IWM = Real and integer work arrays associated with matrix
			// C          operations in VNLS.
			// C F      = Dummy name for the user supplied subroutine for f.
			// C JAC    = Dummy name for the user supplied Jacobian subroutine.
			// C PSOL   = Dummy name for the subroutine passed to VNLS, for
			// C          possible use there.
			// C VNLS   = Dummy name for the nonlinear system solving subroutine,
			// C          whose real name is dependent on the method used.
			// C RPAR, IPAR = Dummy names for user's real and integer work arrays.
			// C-----------------------------------------------------------------------
			// C
			// C Type declarations for labeled COMMON block DVOD01 --------------------
			// C
			// C
			// C Type declarations for labeled COMMON block DVOD02 --------------------
			// C
			// C
			// C Type declarations for local variables --------------------------------
			// C
			// C
			// C Type declaration for function subroutines called ---------------------
			// C
			// C-----------------------------------------------------------------------
			// C The following Fortran-77 declaration is to cause the values of the
			// C listed (local) variables to be saved between calls to this integrator.
			// C-----------------------------------------------------------------------
			// C-----------------------------------------------------------------------
			// C
			// C

			#endregion Prolog

			#region Body

			KFLAG.v = 0;
			TOLD = TN.v;
			NCF = 0;
			JCUR.v = 0;
			NFLAG = 0;
			if (JSTART.v > 0) goto LABEL20;
			if (JSTART.v == -1) goto LABEL100;
			// C-----------------------------------------------------------------------
			// C On the first call, the order is set to 1, and other variables are
			// C initialized.  ETAMAX is the maximum ratio by which H can be increased
			// C in a single step.  It is normally 10, but is larger during the
			// C first step to compensate for the small initial H.  If a failure
			// C occurs (in corrector convergence or error test), ETAMAX is set to 1
			// C for the next increase.
			// C-----------------------------------------------------------------------
			LMAX.v = MAXORD.v + 1;
			NQ.v = 1;
			L.v = 2;
			NQNYH.v = NQ.v * LDYH;
			TAU[1 + o_tau].v = H.v;
			PRL1.v = ONE;
			RC.v = ZERO;
			ETAMAX.v = ETAMX1;
			NQWAIT.v = 2;
			HSCAL.v = H.v;
			goto LABEL200;
		// C-----------------------------------------------------------------------
		// C Take preliminary actions on a normal continuation step (JSTART.GT.0).
		// C If the driver changed H, then ETA must be reset and NEWH set to 1.
		// C If a change of order was dictated on the previous step, then
		// C it is done here and appropriate adjustments in the history are made.
		// C On an order decrease, the history array is adjusted by DVJUST.
		// C On an order increase, the history array is augmented by a column.
		// C On a change of step size H, the history array YH is rescaled.
		// C-----------------------------------------------------------------------
		LABEL20:;
			if (KUTH.v == 1)
			{
				ETA.v = Math.Min(ETA.v, H.v / HSCAL.v);
				NEWH.v = 1;
			}
		LABEL50:
			if (NEWH.v == 0) goto LABEL200;
			if (NEWQ.v == NQ.v) goto LABEL150;
			if (NEWQ.v < NQ.v)
			{
				this._dvjust.Run(ref YH, offset_yh, LDYH, -1);
				NQ.v = NEWQ.v;
				L.v = NQ.v + 1;
				NQWAIT.v = L.v;
				goto LABEL150;
			}
			if (NEWQ.v > NQ.v)
			{
				this._dvjust.Run(ref YH, offset_yh, LDYH, 1);
				NQ.v = NEWQ.v;
				L.v = NQ.v + 1;
				NQWAIT.v = L.v;
				goto LABEL150;
			}
		// C-----------------------------------------------------------------------
		// C The following block handles preliminaries needed when JSTART = -1.
		// C If N was reduced, zero out part of YH to avoid undefined references.
		// C If MAXORD was reduced to a value less than the tentative order NEWQ,
		// C then NQ is set to MAXORD, and a new H ratio ETA is chosen.
		// C Otherwise, we take the same preliminary actions as for JSTART .gt. 0.
		// C In any case, NQWAIT is reset to L = NQ + 1 to prevent further
		// C changes in order for that many steps.
		// C The new H ratio ETA is limited by the input H if KUTH = 1,
		// C by HMIN if KUTH = 0, and by HMXI in any case.
		// C Finally, the history array YH is rescaled.
		// C-----------------------------------------------------------------------
		LABEL100:;
			LMAX.v = MAXORD.v + 1;
			if (N.v == LDYH) goto LABEL120;
			I1 = 1 + (NEWQ.v + 1) * LDYH;
			I2 = (MAXORD.v + 1) * LDYH;
			if (I1 > I2) goto LABEL120;
			for (I = I1; I <= I2; I++)
			{
				YH1[I + o_yh1] = ZERO;
			}
		LABEL120:
			if (NEWQ.v <= MAXORD.v) goto LABEL140;
			FLOTL = Convert.ToSingle(LMAX.v);
			if (MAXORD.v < NQ.v - 1)
			{
				DDN = this._dvnorm.Run(N.v, SAVF, offset_savf, EWT, offset_ewt) / TQ[1 + o_tq].v;
				ETA.v = ONE / (Math.Pow(BIAS1 * DDN, ONE / FLOTL) + ADDON);
			}
			if (MAXORD.v == NQ.v && NEWQ.v == NQ.v + 1) ETA.v = ETAQ;
			if (MAXORD.v == NQ.v - 1 && NEWQ.v == NQ.v + 1)
			{
				ETA.v = ETAQM1;
				this._dvjust.Run(ref YH, offset_yh, LDYH, -1);
			}
			if (MAXORD.v == NQ.v - 1 && NEWQ.v == NQ.v)
			{
				DDN = this._dvnorm.Run(N.v, SAVF, offset_savf, EWT, offset_ewt) / TQ[1 + o_tq].v;
				ETA.v = ONE / (Math.Pow(BIAS1 * DDN, ONE / FLOTL) + ADDON);
				this._dvjust.Run(ref YH, offset_yh, LDYH, -1);
			}
			ETA.v = Math.Min(ETA.v, ONE);
			NQ.v = MAXORD.v;
			L.v = LMAX.v;
		LABEL140:
			if (KUTH.v == 1) ETA.v = Math.Min(ETA.v, Math.Abs(H.v / HSCAL.v));
			if (KUTH.v == 0) ETA.v = Math.Max(ETA.v, HMIN.v / Math.Abs(HSCAL.v));
			ETA.v /= Math.Max(ONE, Math.Abs(HSCAL.v) * HMXI.v * ETA.v);
			NEWH.v = 1;
			NQWAIT.v = L.v;
			if (NEWQ.v <= MAXORD.v) goto LABEL50;
			// C Rescale the history array for a change in H by a factor of ETA. ------
			LABEL150: R = ONE;
			for (J = 2; J <= L.v; J++)
			{
				R *= ETA.v;
				this._dscal.Run(N.v, R, ref YH, 1 + J * LDYH + o_yh, 1);
			}
			H.v = HSCAL.v * ETA.v;
			HSCAL.v = H.v;
			RC.v *= ETA.v;
			NQNYH.v = NQ.v * LDYH;
		// C-----------------------------------------------------------------------
		// C This section computes the predicted values by effectively
		// C multiplying the YH array by the Pascal triangle matrix.
		// C DVSET is called to calculate all integration coefficients.
		// C RC is the ratio of new to old values of the coefficient H/EL(2)=h/l1.
		// C-----------------------------------------------------------------------
		LABEL200: TN.v += H.v;
			I1 = NQNYH.v + 1;
			for (JB = 1; JB <= NQ.v; JB++)
			{
				I1 -= LDYH;
				for (I = I1; I <= NQNYH.v; I++)
				{
					YH1[I + o_yh1] += YH1[I + LDYH + o_yh1];
				}
			}
			this._dvset.Run();
			RL1.v = ONE / EL[2 + o_el].v;
			RC.v = RC.v * (RL1.v / PRL1.v);
			PRL1.v = RL1.v;
			// C
			// C Call the nonlinear system solver. ------------------------------------
			// C
			VNLS.Run(ref Y, offset_y, YH, offset_yh, LDYH, VSAV, offset_vsav, ref SAVF, offset_savf, EWT, offset_ewt
							 , ref ACOR, offset_acor, ref IWM, offset_iwm, ref WM, offset_wm, F, JAC, PSOL
							 , ref NFLAG, RPAR, offset_rpar, IPAR, offset_ipar);
			// C
			if (NFLAG == 0) goto LABEL450;
			// C-----------------------------------------------------------------------
			// C The VNLS routine failed to achieve convergence (NFLAG .NE. 0).
			// C The YH array is retracted to its values before prediction.
			// C The step size H is reduced and the step is retried, if possible.
			// C Otherwise, an error exit is taken.
			// C-----------------------------------------------------------------------
			NCF += 1;
			NCFN.v += 1;
			ETAMAX.v = ONE;
			TN.v = TOLD;
			I1 = NQNYH.v + 1;
			for (JB = 1; JB <= NQ.v; JB++)
			{
				I1 -= LDYH;
				for (I = I1; I <= NQNYH.v; I++)
				{
					YH1[I + o_yh1] -= YH1[I + LDYH + o_yh1];
				}
			}
			if (NFLAG < -1) goto LABEL680;
			if (Math.Abs(H.v) <= HMIN.v * ONEPSM) goto LABEL670;
			if (NCF == MXNCF) goto LABEL670;
			ETA.v = ETACF;
			ETA.v = Math.Max(ETA.v, HMIN.v / Math.Abs(H.v));
			NFLAG = -1;
			goto LABEL150;
		// C-----------------------------------------------------------------------
		// C The corrector has converged (NFLAG = 0).  The local error test is
		// C made and control passes to statement 500 if it fails.
		// C-----------------------------------------------------------------------
		LABEL450:;
			DSM = ACNRM.v / TQ[2 + o_tq].v;
			if (DSM > ONE) goto LABEL500;
			// C-----------------------------------------------------------------------
			// C After a successful step, update the YH and TAU arrays and decrement
			// C NQWAIT.  If NQWAIT is then 1 and NQ .lt. MAXORD, then ACOR is saved
			// C for use in a possible order increase on the next step.
			// C If ETAMAX = 1 (a failure occurred this step), keep NQWAIT .ge. 2.
			// C-----------------------------------------------------------------------
			KFLAG.v = 0;
			NST.v += 1;
			HU.v = H.v;
			NQU.v = NQ.v;
			for (IBACK = 1; IBACK <= NQ.v; IBACK++)
			{
				I = L.v - IBACK;
				TAU[I + 1 + o_tau].v = TAU[I + o_tau].v;
			}
			TAU[1 + o_tau].v = H.v;
			for (J = 1; J <= L.v; J++)
			{
				this._daxpy.Run(N.v, EL[J + o_el].v, ACOR, offset_acor, 1, ref YH, 1 + J * LDYH + o_yh, 1);
			}
			NQWAIT.v -= 1;
			if ((L.v == LMAX.v) || (NQWAIT.v != 1)) goto LABEL490;
			this._dcopy.Run(N.v, ACOR, offset_acor, 1, ref YH, 1 + LMAX.v * LDYH + o_yh, 1);
			CONP.v = TQ[5 + o_tq].v;
		LABEL490:
			if (ETAMAX.v != ONE) goto LABEL560;
			if (NQWAIT.v < 2) NQWAIT.v = 2;
			NEWQ.v = NQ.v;
			NEWH.v = 0;
			ETA.v = ONE;
			HNEW.v = H.v;
			goto LABEL690;
		// C-----------------------------------------------------------------------
		// C The error test failed.  KFLAG keeps track of multiple failures.
		// C Restore TN and the YH array to their previous values, and prepare
		// C to try the step again.  Compute the optimum step size for the
		// C same order.  After repeated failures, H is forced to decrease
		// C more rapidly.
		// C-----------------------------------------------------------------------
		LABEL500: KFLAG.v -= 1;
			NETF.v += 1;
			NFLAG = -2;
			TN.v = TOLD;
			I1 = NQNYH.v + 1;
			for (JB = 1; JB <= NQ.v; JB++)
			{
				I1 -= LDYH;
				for (I = I1; I <= NQNYH.v; I++)
				{
					YH1[I + o_yh1] -= YH1[I + LDYH + o_yh1];
				}
			}
			if (Math.Abs(H.v) <= HMIN.v * ONEPSM) goto LABEL660;
			ETAMAX.v = ONE;
			if (KFLAG.v <= KFC) goto LABEL530;
			// C Compute ratio of new H to current H at the current order. ------------
			FLOTL = Convert.ToSingle(L.v);
			ETA.v = ONE / (Math.Pow(BIAS2 * DSM, ONE / FLOTL) + ADDON);
			ETA.v = Math.Max(ETA.v, Math.Max(HMIN.v / Math.Abs(H.v), ETAMIN));
			if ((KFLAG.v <= -2) && (ETA.v > ETAMXF)) ETA.v = ETAMXF;
			goto LABEL150;
		// C-----------------------------------------------------------------------
		// C Control reaches this section if 3 or more consecutive failures
		// C have occurred.  It is assumed that the elements of the YH array
		// C have accumulated errors of the wrong order.  The order is reduced
		// C by one, if possible.  Then H is reduced by a factor of 0.1 and
		// C the step is retried.  After a total of 7 consecutive failures,
		// C an exit is taken with KFLAG = -1.
		// C-----------------------------------------------------------------------
		LABEL530:
			if (KFLAG.v == KFH) goto LABEL660;
			if (NQ.v == 1) goto LABEL540;
			ETA.v = Math.Max(ETAMIN, HMIN.v / Math.Abs(H.v));
			this._dvjust.Run(ref YH, offset_yh, LDYH, -1);
			L.v = NQ.v;
			NQ.v -= 1;
			NQWAIT.v = L.v;
			goto LABEL150;
		LABEL540: ETA.v = Math.Max(ETAMIN, HMIN.v / Math.Abs(H.v));
			H.v *= ETA.v;
			HSCAL.v = H.v;
			TAU[1 + o_tau].v = H.v;
			F.Run(N.v, TN.v, Y, offset_y, ref SAVF, offset_savf, RPAR[1 + o_rpar], IPAR[1 + o_ipar]);
			NFE.v += 1;
			for (I = 1; I <= N.v; I++)
			{
				YH[I + 2 * LDYH + o_yh] = H.v * SAVF[I + o_savf];
			}
			NQWAIT.v = 10;
			goto LABEL200;
		// C-----------------------------------------------------------------------
		// C If NQWAIT = 0, an increase or decrease in order by one is considered.
		// C Factors ETAQ, ETAQM1, ETAQP1 are computed by which H could
		// C be multiplied at order q, q-1, or q+1, respectively.
		// C The largest of these is determined, and the new order and
		// C step size set accordingly.
		// C A change of H or NQ is made only if H increases by at least a
		// C factor of THRESH.  If an order change is considered and rejected,
		// C then NQWAIT is set to 2 (reconsider it after 2 steps).
		// C-----------------------------------------------------------------------
		// C Compute ratio of new H to current H at the current order. ------------
		LABEL560: FLOTL = Convert.ToSingle(L.v);
			ETAQ = ONE / (Math.Pow(BIAS2 * DSM, ONE / FLOTL) + ADDON);
			if (NQWAIT.v != 0) goto LABEL600;
			NQWAIT.v = 2;
			ETAQM1 = ZERO;
			if (NQ.v == 1) goto LABEL570;
			// C Compute ratio of new H to current H at the current order less one. ---
			DDN = this._dvnorm.Run(N.v, YH, 1 + L.v * LDYH + o_yh, EWT, offset_ewt) / TQ[1 + o_tq].v;
			ETAQM1 = ONE / (Math.Pow(BIAS1 * DDN, ONE / (FLOTL - ONE)) + ADDON);
		LABEL570: ETAQP1 = ZERO;
			if (L.v == LMAX.v) goto LABEL580;
			// C Compute ratio of new H to current H at current order plus one. -------
			CNQUOT = (TQ[5 + o_tq].v / CONP.v) * Math.Pow(H.v / TAU[2 + o_tau].v, L.v);
			for (I = 1; I <= N.v; I++)
			{
				SAVF[I + o_savf] = ACOR[I + o_acor] - CNQUOT * YH[I + LMAX.v * LDYH + o_yh];
			}
			DUP = this._dvnorm.Run(N.v, SAVF, offset_savf, EWT, offset_ewt) / TQ[3 + o_tq].v;
			ETAQP1 = ONE / (Math.Pow(BIAS3 * DUP, ONE / (FLOTL + ONE)) + ADDON);
		LABEL580:
			if (ETAQ >= ETAQP1) goto LABEL590;
			if (ETAQP1 > ETAQM1) goto LABEL620;
			goto LABEL610;
		LABEL590:
			if (ETAQ < ETAQM1) goto LABEL610;
			LABEL600: ETA.v = ETAQ;
			NEWQ.v = NQ.v;
			goto LABEL630;
		LABEL610: ETA.v = ETAQM1;
			NEWQ.v = NQ.v - 1;
			goto LABEL630;
		LABEL620: ETA.v = ETAQP1;
			NEWQ.v = NQ.v + 1;
			this._dcopy.Run(N.v, ACOR, offset_acor, 1, ref YH, 1 + LMAX.v * LDYH + o_yh, 1);
		// C Test tentative new H against THRESH, ETAMAX, and HMXI, then exit. ----
		LABEL630:
			if (ETA.v < THRESH || ETAMAX.v == ONE) goto LABEL640;
			ETA.v = Math.Min(ETA.v, ETAMAX.v);
			ETA.v /= Math.Max(ONE, Math.Abs(H.v) * HMXI.v * ETA.v);
			NEWH.v = 1;
			HNEW.v = H.v * ETA.v;
			goto LABEL690;
		LABEL640: NEWQ.v = NQ.v;
			NEWH.v = 0;
			ETA.v = ONE;
			HNEW.v = H.v;
			goto LABEL690;
		// C-----------------------------------------------------------------------
		// C All returns are made through this section.
		// C On a successful return, ETAMAX is reset and ACOR is scaled.
		// C-----------------------------------------------------------------------
		LABEL660: KFLAG.v = -1;
			goto LABEL720;
		LABEL670: KFLAG.v = -2;
			goto LABEL720;
		LABEL680:
			if (NFLAG == -2) KFLAG.v = -3;
			if (NFLAG == -3) KFLAG.v = -4;
			goto LABEL720;
		LABEL690: ETAMAX.v = ETAMX3;
			if (NST.v <= 10) ETAMAX.v = ETAMX2;
			R = ONE / TQ[2 + o_tq].v;
			this._dscal.Run(N.v, R, ref ACOR, offset_acor, 1);
		LABEL720: JSTART.v = 1;
			return;
			// C----------------------- End of Subroutine DVSTEP ----------------------

			#endregion Body
		}
예제 #4
0
파일: dvode.cs 프로젝트: Altaxo/Altaxo
		/// <param name="Y">
		/// = The dependent variable, a vector of length N, input.
		///</param>
		/// <param name="YH">
		/// = The Nordsieck (Taylor) array, LDYH by LMAX, input
		/// and output.  On input, it contains predicted values.
		///</param>
		/// <param name="LDYH">
		/// = A constant .ge. N, the first dimension of YH, input.
		///</param>
		/// <param name="VSAV">
		/// = Unused work array.
		///</param>
		/// <param name="SAVF">
		/// = A work array of length N.
		///</param>
		/// <param name="EWT">
		/// = An error weight vector of length N, input.
		///</param>
		/// <param name="ACOR">
		/// = A work array of length N, used for the accumulated
		/// corrections to the predicted y vector.
		///</param>
		/// <param name="F">
		/// = Dummy name for user supplied routine for f.
		///</param>
		/// <param name="JAC">
		/// = Dummy name for user supplied Jacobian routine.
		///</param>
		/// <param name="PDUM">
		/// = Unused dummy subroutine name.  Included for uniformity
		/// over collection of integrators.
		///</param>
		/// <param name="NFLAG">
		/// = Input/output flag, with values and meanings as follows:
		/// INPUT
		/// 0 first call for this time step.
		/// -1 convergence failure in previous call to DVNLSD.
		/// -2 error test failure in DVSTEP.
		/// OUTPUT
		/// 0 successful completion of nonlinear solver.
		/// -1 convergence failure or singular matrix.
		/// -2 unrecoverable error in matrix preprocessing
		/// (cannot occur here).
		/// -3 unrecoverable error in solution (cannot occur
		/// here).
		///</param>
		public void Run(ref double[] Y, int offset_y, double[] YH, int offset_yh, int LDYH, double[] VSAV, int offset_vsav, ref double[] SAVF, int offset_savf, double[] EWT, int offset_ewt
										 , ref double[] ACOR, int offset_acor, ref int[] IWM, int offset_iwm, ref double[] WM, int offset_wm, IFEX F, IJEX JAC, IFEX PDUM
										 , ref int NFLAG, double[] RPAR, int offset_rpar, int[] IPAR, int offset_ipar)
		{
			#region Variables

			double CSCALE = 0; double DCON = 0; double DEL = 0; double DELP = 0; int I = 0; int IERPJ = 0; int IERSL = 0;
			int M = 0;

			#endregion Variables

			#region Array Index Correction

			int o_y = -1 + offset_y; int o_yh = -1 - LDYH + offset_yh; int o_vsav = -1 + offset_vsav;
			int o_savf = -1 + offset_savf; int o_ewt = -1 + offset_ewt; int o_acor = -1 + offset_acor;
			int o_iwm = -1 + offset_iwm; int o_wm = -1 + offset_wm; int o_rpar = -1 + offset_rpar;
			int o_ipar = -1 + offset_ipar;

			#endregion Array Index Correction

			#region Prolog

			// C-----------------------------------------------------------------------
			// C Call sequence input -- Y, YH, LDYH, SAVF, EWT, ACOR, IWM, WM,
			// C                        F, JAC, NFLAG, RPAR, IPAR
			// C Call sequence output -- YH, ACOR, WM, IWM, NFLAG
			// C COMMON block variables accessed:
			// C     /DVOD01/ ACNRM, CRATE, DRC, H, RC, RL1, TQ(5), TN, ICF,
			// C                JCUR, METH, MITER, N, NSLP
			// C     /DVOD02/ HU, NCFN, NETF, NFE, NJE, NLU, NNI, NQU, NST
			// C
			// C Subroutines called by DVNLSD: F, DAXPY, DCOPY, DSCAL, DVJAC, DVSOL
			// C Function routines called by DVNLSD: DVNORM
			// C-----------------------------------------------------------------------
			// C Subroutine DVNLSD is a nonlinear system solver, which uses functional
			// C iteration or a chord (modified Newton) method.  For the chord method
			// C direct linear algebraic system solvers are used.  Subroutine DVNLSD
			// C then handles the corrector phase of this integration package.
			// C
			// C Communication with DVNLSD is done with the following variables. (For
			// C more details, please see the comments in the driver subroutine.)
			// C
			// C Y          = The dependent variable, a vector of length N, input.
			// C YH         = The Nordsieck (Taylor) array, LDYH by LMAX, input
			// C              and output.  On input, it contains predicted values.
			// C LDYH       = A constant .ge. N, the first dimension of YH, input.
			// C VSAV       = Unused work array.
			// C SAVF       = A work array of length N.
			// C EWT        = An error weight vector of length N, input.
			// C ACOR       = A work array of length N, used for the accumulated
			// C              corrections to the predicted y vector.
			// C WM,IWM     = Real and integer work arrays associated with matrix
			// C              operations in chord iteration (MITER .ne. 0).
			// C F          = Dummy name for user supplied routine for f.
			// C JAC        = Dummy name for user supplied Jacobian routine.
			// C PDUM       = Unused dummy subroutine name.  Included for uniformity
			// C              over collection of integrators.
			// C NFLAG      = Input/output flag, with values and meanings as follows:
			// C              INPUT
			// C                  0 first call for this time step.
			// C                 -1 convergence failure in previous call to DVNLSD.
			// C                 -2 error test failure in DVSTEP.
			// C              OUTPUT
			// C                  0 successful completion of nonlinear solver.
			// C                 -1 convergence failure or singular matrix.
			// C                 -2 unrecoverable error in matrix preprocessing
			// C                    (cannot occur here).
			// C                 -3 unrecoverable error in solution (cannot occur
			// C                    here).
			// C RPAR, IPAR = Dummy names for user's real and integer work arrays.
			// C
			// C IPUP       = Own variable flag with values and meanings as follows:
			// C              0,            do not update the Newton matrix.
			// C              MITER .ne. 0, update Newton matrix, because it is the
			// C                            initial step, order was changed, the error
			// C                            test failed, or an update is indicated by
			// C                            the scalar RC or step counter NST.
			// C
			// C For more details, see comments in driver subroutine.
			// C-----------------------------------------------------------------------
			// C Type declarations for labeled COMMON block DVOD01 --------------------
			// C
			// C
			// C Type declarations for labeled COMMON block DVOD02 --------------------
			// C
			// C
			// C Type declarations for local variables --------------------------------
			// C
			// C
			// C Type declaration for function subroutines called ---------------------
			// C
			// C-----------------------------------------------------------------------
			// C The following Fortran-77 declaration is to cause the values of the
			// C listed (local) variables to be saved between calls to this integrator.
			// C-----------------------------------------------------------------------
			// C
			// C
			// C-----------------------------------------------------------------------
			// C On the first step, on a change of method order, or after a
			// C nonlinear convergence failure with NFLAG = -2, set IPUP = MITER
			// C to force a Jacobian update when MITER .ne. 0.
			// C-----------------------------------------------------------------------

			#endregion Prolog

			#region Body

			if (JSTART.v == 0) NSLP.v = 0;
			if (NFLAG == 0) ICF.v = 0;
			if (NFLAG == -2) IPUP.v = MITER.v;
			if ((JSTART.v == 0) || (JSTART.v == -1)) IPUP.v = MITER.v;
			// C If this is functional iteration, set CRATE .eq. 1 and drop to 220
			if (MITER.v == 0)
			{
				CRATE.v = ONE;
				goto LABEL220;
			}
			// C-----------------------------------------------------------------------
			// C RC is the ratio of new to old values of the coefficient H/EL(2)=h/l1.
			// C When RC differs from 1 by more than CCMAX, IPUP is set to MITER
			// C to force DVJAC to be called, if a Jacobian is involved.
			// C In any case, DVJAC is called at least every MSBP steps.
			// C-----------------------------------------------------------------------
			DRC.v = Math.Abs(RC.v - ONE);
			if (DRC.v > CCMAX || NST.v >= NSLP.v + MSBP) IPUP.v = MITER.v;
			// C-----------------------------------------------------------------------
			// C Up to MAXCOR corrector iterations are taken.  A convergence test is
			// C made on the r.m.s. norm of each correction, weighted by the error
			// C weight vector EWT.  The sum of the corrections is accumulated in the
			// C vector ACOR(i).  The YH array is not altered in the corrector loop.
			// C-----------------------------------------------------------------------
			LABEL220: M = 0;
			DELP = ZERO;
			this._dcopy.Run(N.v, YH, 1 + 1 * LDYH + o_yh, 1, ref Y, offset_y, 1);
			F.Run(N.v, TN.v, Y, offset_y, ref SAVF, offset_savf, RPAR[1 + o_rpar], IPAR[1 + o_ipar]);
			NFE.v += 1;
			if (IPUP.v <= 0) goto LABEL250;
			// C-----------------------------------------------------------------------
			// C If indicated, the matrix P = I - h*rl1*J is reevaluated and
			// C preprocessed before starting the corrector iteration.  IPUP is set
			// C to 0 as an indicator that this has been done.
			// C-----------------------------------------------------------------------
			this._dvjac.Run(ref Y, offset_y, YH, offset_yh, LDYH, EWT, offset_ewt, ref ACOR, offset_acor, SAVF, offset_savf
											, ref WM, offset_wm, ref IWM, offset_iwm, F, JAC, ref IERPJ, RPAR, offset_rpar
											, IPAR, offset_ipar);
			IPUP.v = 0;
			RC.v = ONE;
			DRC.v = ZERO;
			CRATE.v = ONE;
			NSLP.v = NST.v;
			// C If matrix is singular, take error return to force cut in step size. --
			if (IERPJ != 0) goto LABEL430;
			LABEL250:
			for (I = 1; I <= N.v; I++)
			{
				ACOR[I + o_acor] = ZERO;
			}
		// C This is a looping point for the corrector iteration. -----------------
		LABEL270:
			if (MITER.v != 0) goto LABEL350;
			// C-----------------------------------------------------------------------
			// C In the case of functional iteration, update Y directly from
			// C the result of the last function evaluation.
			// C-----------------------------------------------------------------------
			for (I = 1; I <= N.v; I++)
			{
				SAVF[I + o_savf] = RL1.v * (H.v * SAVF[I + o_savf] - YH[I + 2 * LDYH + o_yh]);
			}
			for (I = 1; I <= N.v; I++)
			{
				Y[I + o_y] = SAVF[I + o_savf] - ACOR[I + o_acor];
			}
			DEL = this._dvnorm.Run(N.v, Y, offset_y, EWT, offset_ewt);
			for (I = 1; I <= N.v; I++)
			{
				Y[I + o_y] = YH[I + 1 * LDYH + o_yh] + SAVF[I + o_savf];
			}
			this._dcopy.Run(N.v, SAVF, offset_savf, 1, ref ACOR, offset_acor, 1);
			goto LABEL400;
		// C-----------------------------------------------------------------------
		// C In the case of the chord method, compute the corrector error,
		// C and solve the linear system with that as right-hand side and
		// C P as coefficient matrix.  The correction is scaled by the factor
		// C 2/(1+RC) to account for changes in h*rl1 since the last DVJAC call.
		// C-----------------------------------------------------------------------
		LABEL350:
			for (I = 1; I <= N.v; I++)
			{
				Y[I + o_y] = (RL1.v * H.v) * SAVF[I + o_savf] - (RL1.v * YH[I + 2 * LDYH + o_yh] + ACOR[I + o_acor]);
			}
			this._dvsol.Run(ref WM, offset_wm, IWM, offset_iwm, ref Y, offset_y, ref IERSL);
			NNI.v += 1;
			if (IERSL > 0) goto LABEL410;
			if (METH.v == 2 && RC.v != ONE)
			{
				CSCALE = TWO / (ONE + RC.v);
				this._dscal.Run(N.v, CSCALE, ref Y, offset_y, 1);
			}
			DEL = this._dvnorm.Run(N.v, Y, offset_y, EWT, offset_ewt);
			this._daxpy.Run(N.v, ONE, Y, offset_y, 1, ref ACOR, offset_acor, 1);
			for (I = 1; I <= N.v; I++)
			{
				Y[I + o_y] = YH[I + 1 * LDYH + o_yh] + ACOR[I + o_acor];
			}
		// C-----------------------------------------------------------------------
		// C Test for convergence.  If M .gt. 0, an estimate of the convergence
		// C rate constant is stored in CRATE, and this is used in the test.
		// C-----------------------------------------------------------------------
		LABEL400:
			if (M != 0) CRATE.v = Math.Max(CRDOWN * CRATE.v, DEL / DELP);
			DCON = DEL * Math.Min(ONE, CRATE.v) / TQ[4 + o_tq].v;
			if (DCON <= ONE) goto LABEL450;
			M += 1;
			if (M == MAXCOR) goto LABEL410;
			if (M >= 2 && DEL > RDIV * DELP) goto LABEL410;
			DELP = DEL;
			F.Run(N.v, TN.v, Y, offset_y, ref SAVF, offset_savf, RPAR[1 + o_rpar], IPAR[1 + o_ipar]);
			NFE.v += 1;
			goto LABEL270;
		// C
		LABEL410:
			if (MITER.v == 0 || JCUR.v == 1) goto LABEL430;
			ICF.v = 1;
			IPUP.v = MITER.v;
			goto LABEL220;
		// C
		LABEL430:;
			NFLAG = -1;
			ICF.v = 2;
			IPUP.v = MITER.v;
			return;
		// C
		// C Return for successful step. ------------------------------------------
		LABEL450: NFLAG = 0;
			JCUR.v = 0;
			ICF.v = 0;
			if (M == 0) ACNRM.v = DEL;
			if (M > 0) ACNRM.v = this._dvnorm.Run(N.v, ACOR, offset_acor, EWT, offset_ewt);
			return;
			// C----------------------- End of Subroutine DVNLSD ----------------------

			#endregion Body
		}
예제 #5
0
파일: dvode.cs 프로젝트: Altaxo/Altaxo
		/// <param name="N">
		/// = Size of ODE system, input.
		///</param>
		/// <param name="T0">
		/// = Initial value of independent variable, input.
		///</param>
		/// <param name="Y0">
		/// = Vector of initial conditions, input.
		///</param>
		/// <param name="YDOT">
		/// = Vector of initial first derivatives, input.
		///</param>
		/// <param name="F">
		/// = Name of subroutine for right-hand side f(t,y), input.
		///</param>
		/// <param name="TOUT">
		/// = First output value of independent variable
		///</param>
		/// <param name="UROUND">
		/// = Machine unit roundoff
		///</param>
		/// <param name="H0">
		/// = Step size to be attempted, output.
		///</param>
		/// <param name="NITER">
		/// = Number of iterations (and of f evaluations) to compute H0,
		/// output.
		///</param>
		/// <param name="IER">
		/// = The error flag, returned with the value
		/// IER = 0  if no trouble occurred, or
		/// IER = -1 if TOUT and T0 are considered too close to proceed.
		///</param>
		public void Run(int N, double T0, double[] Y0, int offset_y0, double[] YDOT, int offset_ydot, IFEX F, double[] RPAR, int offset_rpar
										 , int[] IPAR, int offset_ipar, double TOUT, double UROUND, double[] EWT, int offset_ewt, int ITOL, double[] ATOL, int offset_atol
										 , ref double[] Y, int offset_y, ref double[] TEMP, int offset_temp, ref double H0, ref int NITER, ref int IER)
		{
			#region Variables

			double AFI = 0; double ATOLI = 0; double DELYI = 0; double H = 0; double HG = 0; double HLB = 0; double HNEW = 0;
			double HRAT = 0; double HUB = 0; double T1 = 0; double TDIST = 0; double TROUND = 0; double YDDNRM = 0; int I = 0;
			int ITER = 0;

			#endregion Variables

			#region Array Index Correction

			int o_y0 = -1 + offset_y0; int o_ydot = -1 + offset_ydot; int o_rpar = -1 + offset_rpar;
			int o_ipar = -1 + offset_ipar; int o_ewt = -1 + offset_ewt; int o_atol = -1 + offset_atol; int o_y = -1 + offset_y;
			int o_temp = -1 + offset_temp;

			#endregion Array Index Correction

			#region Prolog

			// C-----------------------------------------------------------------------
			// C Call sequence input -- N, T0, Y0, YDOT, F, RPAR, IPAR, TOUT, UROUND,
			// C                        EWT, ITOL, ATOL, Y, TEMP
			// C Call sequence output -- H0, NITER, IER
			// C COMMON block variables accessed -- None
			// C
			// C Subroutines called by DVHIN:  F
			// C Function routines called by DVHI: DVNORM
			// C-----------------------------------------------------------------------
			// C This routine computes the step size, H0, to be attempted on the
			// C first step, when the user has not supplied a value for this.
			// C
			// C First we check that TOUT - T0 differs significantly from zero.  Then
			// C an iteration is done to approximate the initial second derivative
			// C and this is used to define h from w.r.m.s.norm(h**2 * yddot / 2) = 1.
			// C A bias factor of 1/2 is applied to the resulting h.
			// C The sign of H0 is inferred from the initial values of TOUT and T0.
			// C
			// C Communication with DVHIN is done with the following variables:
			// C
			// C N      = Size of ODE system, input.
			// C T0     = Initial value of independent variable, input.
			// C Y0     = Vector of initial conditions, input.
			// C YDOT   = Vector of initial first derivatives, input.
			// C F      = Name of subroutine for right-hand side f(t,y), input.
			// C RPAR, IPAR = Dummy names for user's real and integer work arrays.
			// C TOUT   = First output value of independent variable
			// C UROUND = Machine unit roundoff
			// C EWT, ITOL, ATOL = Error weights and tolerance parameters
			// C                   as described in the driver routine, input.
			// C Y, TEMP = Work arrays of length N.
			// C H0     = Step size to be attempted, output.
			// C NITER  = Number of iterations (and of f evaluations) to compute H0,
			// C          output.
			// C IER    = The error flag, returned with the value
			// C          IER = 0  if no trouble occurred, or
			// C          IER = -1 if TOUT and T0 are considered too close to proceed.
			// C-----------------------------------------------------------------------
			// C
			// C Type declarations for local variables --------------------------------
			// C
			// C
			// C Type declaration for function subroutines called ---------------------
			// C
			// C-----------------------------------------------------------------------
			// C The following Fortran-77 declaration is to cause the values of the
			// C listed (local) variables to be saved between calls to this integrator.
			// C-----------------------------------------------------------------------
			// C

			#endregion Prolog

			#region Body

			NITER = 0;
			TDIST = Math.Abs(TOUT - T0);
			TROUND = UROUND * Math.Max(Math.Abs(T0), Math.Abs(TOUT));
			if (TDIST < TWO * TROUND) goto LABEL100;
			// C
			// C Set a lower bound on h based on the roundoff level in T0 and TOUT. ---
			HLB = HUN * TROUND;
			// C Set an upper bound on h based on TOUT-T0 and the initial Y and YDOT. -
			HUB = PT1 * TDIST;
			ATOLI = ATOL[1 + o_atol];
			for (I = 1; I <= N; I++)
			{
				if (ITOL == 2 || ITOL == 4) ATOLI = ATOL[I + o_atol];
				DELYI = PT1 * Math.Abs(Y0[I + o_y0]) + ATOLI;
				AFI = Math.Abs(YDOT[I + o_ydot]);
				if (AFI * HUB > DELYI) HUB = DELYI / AFI;
			}
			// C
			// C Set initial guess for h as geometric mean of upper and lower bounds. -
			ITER = 0;
			HG = Math.Sqrt(HLB * HUB);
			// C If the bounds have crossed, exit with the mean value. ----------------
			if (HUB < HLB)
			{
				H0 = HG;
				goto LABEL90;
			}
		// C
		// C Looping point for iteration. -----------------------------------------
		LABEL50:;
			// C Estimate the second derivative as a difference quotient in f. --------
			H = FortranLib.Sign(HG, TOUT - T0);
			T1 = T0 + H;
			for (I = 1; I <= N; I++)
			{
				Y[I + o_y] = Y0[I + o_y0] + H * YDOT[I + o_ydot];
			}
			F.Run(N, T1, Y, offset_y, ref TEMP, offset_temp, RPAR[1 + o_rpar], IPAR[1 + o_ipar]);
			for (I = 1; I <= N; I++)
			{
				TEMP[I + o_temp] = (TEMP[I + o_temp] - YDOT[I + o_ydot]) / H;
			}
			YDDNRM = this._dvnorm.Run(N, TEMP, offset_temp, EWT, offset_ewt);
			// C Get the corresponding new value of h. --------------------------------
			if (YDDNRM * HUB * HUB > TWO)
			{
				HNEW = Math.Sqrt(TWO / YDDNRM);
			}
			else
			{
				HNEW = Math.Sqrt(HG * HUB);
			}
			ITER += 1;
			// C-----------------------------------------------------------------------
			// C Test the stopping conditions.
			// C Stop if the new and previous h values differ by a factor of .lt. 2.
			// C Stop if four iterations have been done.  Also, stop with previous h
			// C if HNEW/HG .gt. 2 after first iteration, as this probably means that
			// C the second derivative value is bad because of cancellation error.
			// C-----------------------------------------------------------------------
			if (ITER >= 4) goto LABEL80;
			HRAT = HNEW / HG;
			if ((HRAT > HALF) && (HRAT < TWO)) goto LABEL80;
			if ((ITER >= 2) && (HNEW > TWO * HG))
			{
				HNEW = HG;
				goto LABEL80;
			}
			HG = HNEW;
			goto LABEL50;
		// C
		// C Iteration done.  Apply bounds, bias factor, and sign.  Then exit. ----
		LABEL80: H0 = HNEW * HALF;
			if (H0 < HLB) H0 = HLB;
			if (H0 > HUB) H0 = HUB;
			LABEL90: H0 = FortranLib.Sign(H0, TOUT - T0);
			NITER = ITER;
			IER = 0;
			return;
		// C Error return for TOUT - T0 too small. --------------------------------
		LABEL100: IER = -1;
			return;
			// C----------------------- End of Subroutine DVHIN -----------------------

			#endregion Body
		}