Beispiel #1
0
		public void Run(int N, IFAREN FCN, ref double X, ref double[] Y, int offset_y, double XEND, ref double HMAX
										 , ref double H, double[] RTOL, int offset_rtol, double[] ATOL, int offset_atol, int ITOL, int IPRINT, ISOLOUT SOLOUT
										 , int IOUT, ref int IDID, int NMAX, double UROUND, int METH, int NSTIFF
										 , double SAFE, double BETA, double FAC1, double FAC2, ref double[] Y1, int offset_y1, ref double[] K1, int offset_k1
										 , ref double[] K2, int offset_k2, ref double[] K3, int offset_k3, ref double[] K4, int offset_k4, ref double[] K5, int offset_k5, ref double[] K6, int offset_k6, ref double[] YSTI, int offset_ysti
										 , ref double[] CONT, int offset_cont, int[] ICOMP, int offset_icomp, int NRD, double[] RPAR, int offset_rpar, int[] IPAR, int offset_ipar, ref int NFCN
										 , ref int NSTEP, ref int NACCPT, ref int NREJCT)
		{
			#region Variables

			bool REJECT = false; bool LAST = false;

			#endregion Variables

			#region Implicit Variables

			double FACOLD = 0; double EXPO1 = 0; double FACC1 = 0; double FACC2 = 0; double POSNEG = 0; double ATOLI = 0;
			double RTOLI = 0; double HLAMB = 0; int IASTI = 0; int IORD = 0; int IRTRN = 0; int I = 0; double A21 = 0;
			double A31 = 0; double A32 = 0; double A41 = 0; double A42 = 0; double A43 = 0; double A51 = 0; double A52 = 0;
			double A53 = 0; double A54 = 0; double A61 = 0; double A62 = 0; double A63 = 0; double A64 = 0; double A65 = 0;
			double XPH = 0; double A71 = 0; double A73 = 0; double A74 = 0; double A75 = 0; double A76 = 0; int J = 0;
			double D1 = 0; double D3 = 0; double D4 = 0; double D5 = 0; double D6 = 0; double D7 = 0; double E1 = 0; double E3 = 0;
			double E4 = 0; double E5 = 0; double E6 = 0; double E7 = 0; double ERR = 0; double SK = 0; double FAC11 = 0;
			double FAC = 0; double HNEW = 0; double STNUM = 0; double STDEN = 0; int NONSTI = 0; double YD0 = 0; double YDIFF = 0;
			double BSPL = 0; double C2 = 0; double C3 = 0; double C4 = 0; double C5 = 0;

			#endregion Implicit 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_y1 = -1 + offset_y1;
			int o_k1 = -1 + offset_k1; int o_k2 = -1 + offset_k2; int o_k3 = -1 + offset_k3; int o_k4 = -1 + offset_k4;
			int o_k5 = -1 + offset_k5; int o_k6 = -1 + offset_k6; int o_ysti = -1 + offset_ysti; int o_cont = -1 + offset_cont;
			int o_icomp = -1 + offset_icomp; int o_rpar = -1 + offset_rpar; int o_ipar = -1 + offset_ipar;

			#endregion Array Index Correction

			// C ----------------------------------------------------------
			// C     CORE INTEGRATOR FOR DOPRI5
			// C     PARAMETERS SAME AS IN DOPRI5 WITH WORKSPACE ADDED
			// C ----------------------------------------------------------
			// C         DECLARATIONS
			// C ----------------------------------------------------------
			// C *** *** *** *** *** *** ***
			// C  INITIALISATIONS
			// C *** *** *** *** *** *** ***

			#region Body

			if (METH == 1)
			{
				this._cdopri.Run(ref C2, ref C3, ref C4, ref C5, ref E1, ref E3
												 , ref E4, ref E5, ref E6, ref E7, ref A21, ref A31
												 , ref A32, ref A41, ref A42, ref A43, ref A51, ref A52
												 , ref A53, ref A54, ref A61, ref A62, ref A63, ref A64
												 , ref A65, ref A71, ref A73, ref A74, ref A75, ref A76
												 , ref D1, ref D3, ref D4, ref D5, ref D6, ref D7);
			}
			FACOLD = 1.0E-4;
			EXPO1 = 0.2E0 - BETA * 0.75E0;
			FACC1 = 1.0E0 / FAC1;
			FACC2 = 1.0E0 / FAC2;
			POSNEG = FortranLib.Sign(1.0E0, XEND - X);
			// C --- INITIAL PREPARATIONS
			ATOLI = ATOL[1 + o_atol];
			RTOLI = RTOL[1 + o_rtol];
			LAST = false;
			HLAMB = 0.0E0;
			IASTI = 0;
			FCN.Run(N, X, Y, offset_y, ref K1, offset_k1, RPAR, offset_rpar, IPAR[1 + o_ipar]);
			HMAX = Math.Abs(HMAX);
			IORD = 5;
			if (H == 0.0E0) H = this._hinit.Run(N, FCN, X, Y, offset_y, XEND, POSNEG, K1, offset_k1, ref K2, offset_k2, ref K3, offset_k3, IORD, HMAX, ATOL, offset_atol, RTOL, offset_rtol, ITOL, RPAR, offset_rpar, IPAR, offset_ipar);
			NFCN += 2;
			REJECT = false;
			XOLD.v = X;
			if (IOUT != 0)
			{
				IRTRN = 1;
				HOUT.v = H;
				SOLOUT.Run(NACCPT + 1, XOLD.v, X, Y, offset_y, N, CONT, offset_cont
									 , ICOMP, offset_icomp, NRD, RPAR, offset_rpar, IPAR[1 + o_ipar], IRTRN);
				if (IRTRN < 0) goto LABEL79;
			}
			else
			{
				IRTRN = 0;
			}
		// C --- BASIC INTEGRATION STEP
		LABEL1:;
			if (NSTEP > NMAX) goto LABEL78;
			if (0.1E0 * Math.Abs(H) <= Math.Abs(X) * UROUND) goto LABEL77;
			if ((X + 1.01E0 * H - XEND) * POSNEG > 0.0E0)
			{
				H = XEND - X;
				LAST = true;
			}
			NSTEP += 1;
			// C --- THE FIRST 6 STAGES
			if (IRTRN >= 2)
			{
				FCN.Run(N, X, Y, offset_y, ref K1, offset_k1, RPAR, offset_rpar, IPAR[1 + o_ipar]);
			}
			for (I = 1; I <= N; I++)
			{
				Y1[I + o_y1] = Y[I + o_y] + H * A21 * K1[I + o_k1];
			}
			FCN.Run(N, X + C2 * H, Y1, offset_y1, ref K2, offset_k2, RPAR, offset_rpar, IPAR[1 + o_ipar]);
			for (I = 1; I <= N; I++)
			{
				Y1[I + o_y1] = Y[I + o_y] + H * (A31 * K1[I + o_k1] + A32 * K2[I + o_k2]);
			}
			FCN.Run(N, X + C3 * H, Y1, offset_y1, ref K3, offset_k3, RPAR, offset_rpar, IPAR[1 + o_ipar]);
			for (I = 1; I <= N; I++)
			{
				Y1[I + o_y1] = Y[I + o_y] + H * (A41 * K1[I + o_k1] + A42 * K2[I + o_k2] + A43 * K3[I + o_k3]);
			}
			FCN.Run(N, X + C4 * H, Y1, offset_y1, ref K4, offset_k4, RPAR, offset_rpar, IPAR[1 + o_ipar]);
			for (I = 1; I <= N; I++)
			{
				Y1[I + o_y1] = Y[I + o_y] + H * (A51 * K1[I + o_k1] + A52 * K2[I + o_k2] + A53 * K3[I + o_k3] + A54 * K4[I + o_k4]);
			}
			FCN.Run(N, X + C5 * H, Y1, offset_y1, ref K5, offset_k5, RPAR, offset_rpar, IPAR[1 + o_ipar]);
			for (I = 1; I <= N; I++)
			{
				YSTI[I + o_ysti] = Y[I + o_y] + H * (A61 * K1[I + o_k1] + A62 * K2[I + o_k2] + A63 * K3[I + o_k3] + A64 * K4[I + o_k4] + A65 * K5[I + o_k5]);
			}
			XPH = X + H;
			FCN.Run(N, XPH, YSTI, offset_ysti, ref K6, offset_k6, RPAR, offset_rpar, IPAR[1 + o_ipar]);
			for (I = 1; I <= N; I++)
			{
				Y1[I + o_y1] = Y[I + o_y] + H * (A71 * K1[I + o_k1] + A73 * K3[I + o_k3] + A74 * K4[I + o_k4] + A75 * K5[I + o_k5] + A76 * K6[I + o_k6]);
			}
			FCN.Run(N, XPH, Y1, offset_y1, ref K2, offset_k2, RPAR, offset_rpar, IPAR[1 + o_ipar]);
			if (IOUT >= 2)
			{
				for (J = 1; J <= NRD; J++)
				{
					I = ICOMP[J + o_icomp];
					CONT[4 * NRD + J + o_cont] = H * (D1 * K1[I + o_k1] + D3 * K3[I + o_k3] + D4 * K4[I + o_k4] + D5 * K5[I + o_k5] + D6 * K6[I + o_k6] + D7 * K2[I + o_k2]);
				}
			}
			for (I = 1; I <= N; I++)
			{
				K4[I + o_k4] = (E1 * K1[I + o_k1] + E3 * K3[I + o_k3] + E4 * K4[I + o_k4] + E5 * K5[I + o_k5] + E6 * K6[I + o_k6] + E7 * K2[I + o_k2]) * H;
			}
			NFCN += 6;
			// C --- ERROR ESTIMATION
			ERR = 0.0E0;
			if (ITOL == 0)
			{
				for (I = 1; I <= N; I++)
				{
					SK = ATOLI + RTOLI * Math.Max(Math.Abs(Y[I + o_y]), Math.Abs(Y1[I + o_y1]));
					ERR += Math.Pow(K4[I + o_k4] / SK, 2);
				}
			}
			else
			{
				for (I = 1; I <= N; I++)
				{
					SK = ATOL[I + o_atol] + RTOL[I + o_rtol] * Math.Max(Math.Abs(Y[I + o_y]), Math.Abs(Y1[I + o_y1]));
					ERR += Math.Pow(K4[I + o_k4] / SK, 2);
				}
			}
			ERR = Math.Sqrt(ERR / N);
			// C --- COMPUTATION OF HNEW
			FAC11 = Math.Pow(ERR, EXPO1);
			// C --- LUND-STABILIZATION
			FAC = FAC11 / Math.Pow(FACOLD, BETA);
			// C --- WE REQUIRE  FAC1 <= HNEW/H <= FAC2
			FAC = Math.Max(FACC2, Math.Min(FACC1, FAC / SAFE));
			HNEW = H / FAC;
			if (ERR <= 1.0E0)
			{
				// C --- STEP IS ACCEPTED
				FACOLD = Math.Max(ERR, 1.0E-4);
				NACCPT += 1;
				// C ------- STIFFNESS DETECTION
				if (FortranLib.Mod(NACCPT, NSTIFF) == 0 || IASTI > 0)
				{
					STNUM = 0.0E0;
					STDEN = 0.0E0;
					for (I = 1; I <= N; I++)
					{
						STNUM += Math.Pow(K2[I + o_k2] - K6[I + o_k6], 2);
						STDEN += Math.Pow(Y1[I + o_y1] - YSTI[I + o_ysti], 2);
					}
					if (STDEN > 0.0E0) HLAMB = H * Math.Sqrt(STNUM / STDEN);
					if (HLAMB > 3.25E0)
					{
						NONSTI = 0;
						IASTI += 1;
						if (IASTI == 15)
						{
							if (IPRINT > 0) ;//ERROR-ERRORWRITE(IPRINT,*)' THE PROBLEM SEEMS TO BECOME STIFF AT X = ',X
							if (IPRINT <= 0) goto LABEL76;
						}
					}
					else
					{
						NONSTI += 1;
						if (NONSTI == 6) IASTI = 0;
					}
				}
				if (IOUT >= 2)
				{
					for (J = 1; J <= NRD; J++)
					{
						I = ICOMP[J + o_icomp];
						YD0 = Y[I + o_y];
						YDIFF = Y1[I + o_y1] - YD0;
						BSPL = H * K1[I + o_k1] - YDIFF;
						CONT[J + o_cont] = Y[I + o_y];
						CONT[NRD + J + o_cont] = YDIFF;
						CONT[2 * NRD + J + o_cont] = BSPL;
						CONT[3 * NRD + J + o_cont] = -H * K2[I + o_k2] + YDIFF - BSPL;
					}
				}
				for (I = 1; I <= N; I++)
				{
					K1[I + o_k1] = K2[I + o_k2];
					Y[I + o_y] = Y1[I + o_y1];
				}
				XOLD.v = X;
				X = XPH;
				if (IOUT != 0)
				{
					HOUT.v = H;
					SOLOUT.Run(NACCPT + 1, XOLD.v, X, Y, offset_y, N, CONT, offset_cont
										 , ICOMP, offset_icomp, NRD, RPAR, offset_rpar, IPAR[1 + o_ipar], IRTRN);
					if (IRTRN < 0) goto LABEL79;
				}
				// C ------- NORMAL EXIT
				if (LAST)
				{
					H = HNEW;
					IDID = 1;
					return;
				}
				if (Math.Abs(HNEW) > HMAX) HNEW = POSNEG * HMAX;
				if (REJECT) HNEW = POSNEG * Math.Min(Math.Abs(HNEW), Math.Abs(H));
				REJECT = false;
			}
			else
			{
				// C --- STEP IS REJECTED
				HNEW = H / Math.Min(FACC1, FAC11 / SAFE);
				REJECT = true;
				if (NACCPT >= 1) NREJCT += 1;
				LAST = false;
			}
			H = HNEW;
			goto LABEL1;
		// C --- FAIL EXIT
		LABEL76:;
			IDID = -4;
			return;
		LABEL77:;
			if (IPRINT > 0) ;//ERROR-ERRORWRITE(IPRINT,979)X
			if (IPRINT > 0) ;//ERROR-ERRORWRITE(IPRINT,*)' STEP SIZE T0O SMALL, H=',H
			IDID = -3;
			return;
		LABEL78:;
			if (IPRINT > 0) ;//ERROR-ERRORWRITE(IPRINT,979)X
			if (IPRINT > 0) ;//ERROR-ERRORWRITE(IPRINT,*)' MORE THAN NMAX =',NMAX,'STEPS ARE NEEDED'
			IDID = -2;
			return;
		LABEL79:;
			if (IPRINT > 0) ;//ERROR-ERRORWRITE(IPRINT,979)X
			IDID = 2;
			return;

			#endregion Body
		}
Beispiel #2
0
        public void Run(int N, IFAREN FCN, ref double X, ref double[] Y, int offset_y, double XEND, ref double HMAX
                        , ref double H, double[] RTOL, int offset_rtol, double[] ATOL, int offset_atol, int ITOL, int IPRINT, ISOLOUT SOLOUT
                        , int IOUT, ref int IDID, int NMAX, double UROUND, int METH, int NSTIFF
                        , double SAFE, double BETA, double FAC1, double FAC2, ref double[] Y1, int offset_y1, ref double[] K1, int offset_k1
                        , ref double[] K2, int offset_k2, ref double[] K3, int offset_k3, ref double[] K4, int offset_k4, ref double[] K5, int offset_k5, ref double[] K6, int offset_k6, ref double[] YSTI, int offset_ysti
                        , ref double[] CONT, int offset_cont, int[] ICOMP, int offset_icomp, int NRD, double[] RPAR, int offset_rpar, int[] IPAR, int offset_ipar, ref int NFCN
                        , ref int NSTEP, ref int NACCPT, ref int NREJCT)
        {
            #region Variables

            bool REJECT = false; bool LAST = false;
            #endregion
            #region Implicit Variables

            double FACOLD = 0; double EXPO1 = 0; double FACC1 = 0; double FACC2 = 0; double POSNEG = 0; double ATOLI = 0;
            double RTOLI = 0; double HLAMB = 0; int IASTI = 0; int IORD = 0; int IRTRN = 0; int I = 0; double A21 = 0;
            double A31 = 0; double A32 = 0; double A41 = 0; double A42 = 0; double A43 = 0; double A51 = 0; double A52 = 0;
            double A53 = 0; double A54 = 0; double A61 = 0; double A62 = 0; double A63 = 0; double A64 = 0; double A65 = 0;
            double XPH = 0; double A71 = 0; double A73 = 0; double A74 = 0; double A75 = 0; double A76 = 0; int J = 0;
            double D1 = 0; double D3 = 0; double D4 = 0; double D5 = 0; double D6 = 0; double D7 = 0; double E1 = 0; double E3 = 0;
            double E4 = 0; double E5 = 0; double E6 = 0; double E7 = 0; double ERR = 0; double SK = 0; double FAC11 = 0;
            double FAC = 0; double HNEW = 0; double STNUM = 0; double STDEN = 0; int NONSTI = 0; double YD0 = 0; double YDIFF = 0;
            double BSPL = 0; double C2 = 0; double C3 = 0; double C4 = 0; double C5 = 0;
            #endregion
            #region Array Index Correction

            int o_y = -1 + offset_y;  int o_rtol = -1 + offset_rtol;  int o_atol = -1 + offset_atol;  int o_y1 = -1 + offset_y1;
            int o_k1 = -1 + offset_k1; int o_k2 = -1 + offset_k2;  int o_k3 = -1 + offset_k3;  int o_k4 = -1 + offset_k4;
            int o_k5 = -1 + offset_k5; int o_k6 = -1 + offset_k6;  int o_ysti = -1 + offset_ysti;  int o_cont = -1 + offset_cont;
            int o_icomp = -1 + offset_icomp; int o_rpar = -1 + offset_rpar;  int o_ipar = -1 + offset_ipar;
            #endregion
            // C ----------------------------------------------------------
            // C     CORE INTEGRATOR FOR DOPRI5
            // C     PARAMETERS SAME AS IN DOPRI5 WITH WORKSPACE ADDED
            // C ----------------------------------------------------------
            // C         DECLARATIONS
            // C ----------------------------------------------------------
            // C *** *** *** *** *** *** ***
            // C  INITIALISATIONS
            // C *** *** *** *** *** *** ***
            #region Body

            if (METH == 1)
            {
                this._cdopri.Run(ref C2, ref C3, ref C4, ref C5, ref E1, ref E3
                                 , ref E4, ref E5, ref E6, ref E7, ref A21, ref A31
                                 , ref A32, ref A41, ref A42, ref A43, ref A51, ref A52
                                 , ref A53, ref A54, ref A61, ref A62, ref A63, ref A64
                                 , ref A65, ref A71, ref A73, ref A74, ref A75, ref A76
                                 , ref D1, ref D3, ref D4, ref D5, ref D6, ref D7);
            }
            FACOLD = 1.0E-4;
            EXPO1  = 0.2E0 - BETA * 0.75E0;
            FACC1  = 1.0E0 / FAC1;
            FACC2  = 1.0E0 / FAC2;
            POSNEG = FortranLib.Sign(1.0E0, XEND - X);
            // C --- INITIAL PREPARATIONS
            ATOLI = ATOL[1 + o_atol];
            RTOLI = RTOL[1 + o_rtol];
            LAST  = false;
            HLAMB = 0.0E0;
            IASTI = 0;
            FCN.Run(N, X, Y, offset_y, ref K1, offset_k1, RPAR, offset_rpar, IPAR[1 + o_ipar]);
            HMAX = Math.Abs(HMAX);
            IORD = 5;
            if (H == 0.0E0)
            {
                H = this._hinit.Run(N, FCN, X, Y, offset_y, XEND, POSNEG, K1, offset_k1, ref K2, offset_k2, ref K3, offset_k3, IORD, HMAX, ATOL, offset_atol, RTOL, offset_rtol, ITOL, RPAR, offset_rpar, IPAR, offset_ipar);
            }
            NFCN  += 2;
            REJECT = false;
            XOLD.v = X;
            if (IOUT != 0)
            {
                IRTRN  = 1;
                HOUT.v = H;
                SOLOUT.Run(NACCPT + 1, XOLD.v, X, Y, offset_y, N, CONT, offset_cont
                           , ICOMP, offset_icomp, NRD, RPAR, offset_rpar, IPAR[1 + o_ipar], IRTRN);
                if (IRTRN < 0)
                {
                    goto LABEL79;
                }
            }
            else
            {
                IRTRN = 0;
            }
            // C --- BASIC INTEGRATION STEP
            LABEL1 :;
            if (NSTEP > NMAX)
            {
                goto LABEL78;
            }
            if (0.1E0 * Math.Abs(H) <= Math.Abs(X) * UROUND)
            {
                goto LABEL77;
            }
            if ((X + 1.01E0 * H - XEND) * POSNEG > 0.0E0)
            {
                H    = XEND - X;
                LAST = true;
            }
            NSTEP += 1;
            // C --- THE FIRST 6 STAGES
            if (IRTRN >= 2)
            {
                FCN.Run(N, X, Y, offset_y, ref K1, offset_k1, RPAR, offset_rpar, IPAR[1 + o_ipar]);
            }
            for (I = 1; I <= N; I++)
            {
                Y1[I + o_y1] = Y[I + o_y] + H * A21 * K1[I + o_k1];
            }
            FCN.Run(N, X + C2 * H, Y1, offset_y1, ref K2, offset_k2, RPAR, offset_rpar, IPAR[1 + o_ipar]);
            for (I = 1; I <= N; I++)
            {
                Y1[I + o_y1] = Y[I + o_y] + H * (A31 * K1[I + o_k1] + A32 * K2[I + o_k2]);
            }
            FCN.Run(N, X + C3 * H, Y1, offset_y1, ref K3, offset_k3, RPAR, offset_rpar, IPAR[1 + o_ipar]);
            for (I = 1; I <= N; I++)
            {
                Y1[I + o_y1] = Y[I + o_y] + H * (A41 * K1[I + o_k1] + A42 * K2[I + o_k2] + A43 * K3[I + o_k3]);
            }
            FCN.Run(N, X + C4 * H, Y1, offset_y1, ref K4, offset_k4, RPAR, offset_rpar, IPAR[1 + o_ipar]);
            for (I = 1; I <= N; I++)
            {
                Y1[I + o_y1] = Y[I + o_y] + H * (A51 * K1[I + o_k1] + A52 * K2[I + o_k2] + A53 * K3[I + o_k3] + A54 * K4[I + o_k4]);
            }
            FCN.Run(N, X + C5 * H, Y1, offset_y1, ref K5, offset_k5, RPAR, offset_rpar, IPAR[1 + o_ipar]);
            for (I = 1; I <= N; I++)
            {
                YSTI[I + o_ysti] = Y[I + o_y] + H * (A61 * K1[I + o_k1] + A62 * K2[I + o_k2] + A63 * K3[I + o_k3] + A64 * K4[I + o_k4] + A65 * K5[I + o_k5]);
            }
            XPH = X + H;
            FCN.Run(N, XPH, YSTI, offset_ysti, ref K6, offset_k6, RPAR, offset_rpar, IPAR[1 + o_ipar]);
            for (I = 1; I <= N; I++)
            {
                Y1[I + o_y1] = Y[I + o_y] + H * (A71 * K1[I + o_k1] + A73 * K3[I + o_k3] + A74 * K4[I + o_k4] + A75 * K5[I + o_k5] + A76 * K6[I + o_k6]);
            }
            FCN.Run(N, XPH, Y1, offset_y1, ref K2, offset_k2, RPAR, offset_rpar, IPAR[1 + o_ipar]);
            if (IOUT >= 2)
            {
                for (J = 1; J <= NRD; J++)
                {
                    I = ICOMP[J + o_icomp];
                    CONT[4 * NRD + J + o_cont] = H * (D1 * K1[I + o_k1] + D3 * K3[I + o_k3] + D4 * K4[I + o_k4] + D5 * K5[I + o_k5] + D6 * K6[I + o_k6] + D7 * K2[I + o_k2]);
                }
            }
            for (I = 1; I <= N; I++)
            {
                K4[I + o_k4] = (E1 * K1[I + o_k1] + E3 * K3[I + o_k3] + E4 * K4[I + o_k4] + E5 * K5[I + o_k5] + E6 * K6[I + o_k6] + E7 * K2[I + o_k2]) * H;
            }
            NFCN += 6;
            // C --- ERROR ESTIMATION
            ERR = 0.0E0;
            if (ITOL == 0)
            {
                for (I = 1; I <= N; I++)
                {
                    SK   = ATOLI + RTOLI * Math.Max(Math.Abs(Y[I + o_y]), Math.Abs(Y1[I + o_y1]));
                    ERR += Math.Pow(K4[I + o_k4] / SK, 2);
                }
            }
            else
            {
                for (I = 1; I <= N; I++)
                {
                    SK   = ATOL[I + o_atol] + RTOL[I + o_rtol] * Math.Max(Math.Abs(Y[I + o_y]), Math.Abs(Y1[I + o_y1]));
                    ERR += Math.Pow(K4[I + o_k4] / SK, 2);
                }
            }
            ERR = Math.Sqrt(ERR / N);
            // C --- COMPUTATION OF HNEW
            FAC11 = Math.Pow(ERR, EXPO1);
            // C --- LUND-STABILIZATION
            FAC = FAC11 / Math.Pow(FACOLD, BETA);
            // C --- WE REQUIRE  FAC1 <= HNEW/H <= FAC2
            FAC  = Math.Max(FACC2, Math.Min(FACC1, FAC / SAFE));
            HNEW = H / FAC;
            if (ERR <= 1.0E0)
            {
                // C --- STEP IS ACCEPTED
                FACOLD  = Math.Max(ERR, 1.0E-4);
                NACCPT += 1;
                // C ------- STIFFNESS DETECTION
                if (FortranLib.Mod(NACCPT, NSTIFF) == 0 || IASTI > 0)
                {
                    STNUM = 0.0E0;
                    STDEN = 0.0E0;
                    for (I = 1; I <= N; I++)
                    {
                        STNUM += Math.Pow(K2[I + o_k2] - K6[I + o_k6], 2);
                        STDEN += Math.Pow(Y1[I + o_y1] - YSTI[I + o_ysti], 2);
                    }
                    if (STDEN > 0.0E0)
                    {
                        HLAMB = H * Math.Sqrt(STNUM / STDEN);
                    }
                    if (HLAMB > 3.25E0)
                    {
                        NONSTI = 0;
                        IASTI += 1;
                        if (IASTI == 15)
                        {
                            if (IPRINT > 0)
                            {
                                ;            //ERROR-ERRORWRITE(IPRINT,*)' THE PROBLEM SEEMS TO BECOME STIFF AT X = ',X
                            }
                            if (IPRINT <= 0)
                            {
                                goto LABEL76;
                            }
                        }
                    }
                    else
                    {
                        NONSTI += 1;
                        if (NONSTI == 6)
                        {
                            IASTI = 0;
                        }
                    }
                }
                if (IOUT >= 2)
                {
                    for (J = 1; J <= NRD; J++)
                    {
                        I                          = ICOMP[J + o_icomp];
                        YD0                        = Y[I + o_y];
                        YDIFF                      = Y1[I + o_y1] - YD0;
                        BSPL                       = H * K1[I + o_k1] - YDIFF;
                        CONT[J + o_cont]           = Y[I + o_y];
                        CONT[NRD + J + o_cont]     = YDIFF;
                        CONT[2 * NRD + J + o_cont] = BSPL;
                        CONT[3 * NRD + J + o_cont] = -H * K2[I + o_k2] + YDIFF - BSPL;
                    }
                }
                for (I = 1; I <= N; I++)
                {
                    K1[I + o_k1] = K2[I + o_k2];
                    Y[I + o_y]   = Y1[I + o_y1];
                }
                XOLD.v = X;
                X      = XPH;
                if (IOUT != 0)
                {
                    HOUT.v = H;
                    SOLOUT.Run(NACCPT + 1, XOLD.v, X, Y, offset_y, N, CONT, offset_cont
                               , ICOMP, offset_icomp, NRD, RPAR, offset_rpar, IPAR[1 + o_ipar], IRTRN);
                    if (IRTRN < 0)
                    {
                        goto LABEL79;
                    }
                }
                // C ------- NORMAL EXIT
                if (LAST)
                {
                    H    = HNEW;
                    IDID = 1;
                    return;
                }
                if (Math.Abs(HNEW) > HMAX)
                {
                    HNEW = POSNEG * HMAX;
                }
                if (REJECT)
                {
                    HNEW = POSNEG * Math.Min(Math.Abs(HNEW), Math.Abs(H));
                }
                REJECT = false;
            }
            else
            {
                // C --- STEP IS REJECTED
                HNEW   = H / Math.Min(FACC1, FAC11 / SAFE);
                REJECT = true;
                if (NACCPT >= 1)
                {
                    NREJCT += 1;
                }
                LAST = false;
            }
            H = HNEW;
            goto LABEL1;
            // C --- FAIL EXIT
            LABEL76 :;
            IDID = -4;
            return;

            LABEL77 :;
            if (IPRINT > 0)
            {
                ;            //ERROR-ERRORWRITE(IPRINT,979)X
            }
            if (IPRINT > 0)
            {
                ;            //ERROR-ERRORWRITE(IPRINT,*)' STEP SIZE T0O SMALL, H=',H
            }
            IDID = -3;
            return;

            LABEL78 :;
            if (IPRINT > 0)
            {
                ;            //ERROR-ERRORWRITE(IPRINT,979)X
            }
            if (IPRINT > 0)
            {
                ;            //ERROR-ERRORWRITE(IPRINT,*)' MORE THAN NMAX =',NMAX,'STEPS ARE NEEDED'
            }
            IDID = -2;
            return;

            LABEL79 :;
            if (IPRINT > 0)
            {
                ;            //ERROR-ERRORWRITE(IPRINT,979)X
            }
            IDID = 2;
            return;

            #endregion
        }
Beispiel #3
0
		/// <param name="N">
		/// DIMENSION OF THE SYSTEM
		///</param>
		/// <param name="FCN">
		/// NAME (EXTERNAL) OF SUBROUTINE COMPUTING THE
		/// VALUE OF F(X,Y):
		/// SUBROUTINE FCN(N,X,Y,F,RPAR,IPAR)
		/// DOUBLE PRECISION X,Y(N),F(N)
		/// F(1)=...   ETC.
		///</param>
		/// <param name="X">
		/// INITIAL X-VALUE
		///</param>
		/// <param name="XEND">
		/// FINAL X-VALUE (XEND-X MAY BE POSITIVE OR NEGATIVE)
		///</param>
		/// <param name="ITOL">
		/// SWITCH FOR RTOL AND ATOL:
		/// ITOL=0: BOTH RTOL AND ATOL ARE SCALARS.
		/// THE CODE KEEPS, ROUGHLY, THE LOCAL ERROR OF
		/// Y(I) BELOW RTOL*ABS(Y(I))+ATOL
		/// ITOL=1: BOTH RTOL AND ATOL ARE VECTORS.
		/// THE CODE KEEPS THE LOCAL ERROR OF Y(I) BELOW
		/// RTOL(I)*ABS(Y(I))+ATOL(I).
		///</param>
		/// <param name="SOLOUT">
		/// NAME (EXTERNAL) OF SUBROUTINE PROVIDING THE
		/// NUMERICAL SOLUTION DURING INTEGRATION.
		/// IF IOUT.GE.1, IT IS CALLED AFTER EVERY SUCCESSFUL STEP.
		/// SUPPLY A DUMMY SUBROUTINE IF IOUT=0.
		/// IT MUST HAVE THE FORM
		/// SUBROUTINE SOLOUT (NR,XOLD,X,Y,N,CON,ICOMP,ND,
		/// RPAR,IPAR,IRTRN)
		/// DIMENSION Y(N),CON(5*ND),ICOMP(ND)
		/// ....
		/// SOLOUT FURNISHES THE SOLUTION "Y" AT THE NR-TH
		/// GRID-POINT "X" (THEREBY THE INITIAL VALUE IS
		/// THE FIRST GRID-POINT).
		/// "XOLD" IS THE PRECEEDING GRID-POINT.
		/// "IRTRN" SERVES TO INTERRUPT THE INTEGRATION. IF IRTRN
		/// IS SET .LT.0, DOPRI5 WILL RETURN TO THE CALLING PROGRAM.
		/// IF THE NUMERICAL SOLUTION IS ALTERED IN SOLOUT,
		/// SET  IRTRN = 2
		///
		/// -----  CONTINUOUS OUTPUT: -----
		/// DURING CALLS TO "SOLOUT", A CONTINUOUS SOLUTION
		/// FOR THE INTERVAL [XOLD,X] IS AVAILABLE THROUGH
		/// THE FUNCTION
		/// .GT..GT..GT.   CONTD5(I,S,CON,ICOMP,ND)   .LT..LT..LT.
		/// WHICH PROVIDES AN APPROXIMATION TO THE I-TH
		/// COMPONENT OF THE SOLUTION AT THE POINT S. THE VALUE
		/// S SHOULD LIE IN THE INTERVAL [XOLD,X].
		///</param>
		/// <param name="IOUT">
		/// SWITCH FOR CALLING THE SUBROUTINE SOLOUT:
		/// IOUT=0: SUBROUTINE IS NEVER CALLED
		/// IOUT=1: SUBROUTINE IS USED FOR OUTPUT.
		/// IOUT=2: DENSE OUTPUT IS PERFORMED IN SOLOUT
		/// (IN THIS CASE WORK(5) MUST BE SPECIFIED)
		///</param>
		/// <param name="WORK">
		/// ARRAY OF WORKING SPACE OF LENGTH "LWORK".
		/// WORK(1),...,WORK(20) SERVE AS PARAMETERS FOR THE CODE.
		/// FOR STANDARD USE, SET THEM TO ZERO BEFORE CALLING.
		/// "LWORK" MUST BE AT LEAST  8*N+5*NRDENS+21
		/// WHERE  NRDENS = IWORK(5)
		///</param>
		/// <param name="LWORK">
		/// DECLARED LENGHT OF ARRAY "WORK".
		///</param>
		/// <param name="IWORK">
		/// INTEGER WORKING SPACE OF LENGHT "LIWORK".
		/// IWORK(1),...,IWORK(20) SERVE AS PARAMETERS FOR THE CODE.
		/// FOR STANDARD USE, SET THEM TO ZERO BEFORE CALLING.
		/// "LIWORK" MUST BE AT LEAST NRDENS+21 .
		///</param>
		/// <param name="LIWORK">
		/// DECLARED LENGHT OF ARRAY "IWORK".
		///</param>
		/// <param name="IDID">
		/// REPORTS ON SUCCESSFULNESS UPON RETURN:
		/// IDID= 1  COMPUTATION SUCCESSFUL,
		/// IDID= 2  COMPUT. SUCCESSFUL (INTERRUPTED BY SOLOUT)
		/// IDID=-1  INPUT IS NOT CONSISTENT,
		/// IDID=-2  LARGER NMAX IS NEEDED,
		/// IDID=-3  STEP SIZE BECOMES TOO SMALL.
		/// IDID=-4  PROBLEM IS PROBABLY STIFF (INTERRUPTED).
		///</param>
		public void Run(int N, IFAREN FCN, ref double X, ref double[] Y, int offset_y, double XEND, double[] RTOL, int offset_rtol
										 , double[] ATOL, int offset_atol, int ITOL, ISOLOUT SOLOUT, int IOUT, ref double[] WORK, int offset_work, int LWORK
										 , ref int[] IWORK, int offset_iwork, int LIWORK, double[] RPAR, int offset_rpar, int[] IPAR, int offset_ipar, ref int IDID)
		{
			#region Variables

			bool ARRET = false;

			#endregion Variables

			#region Implicit Variables

			int NFCN = 0; int NSTEP = 0; int NACCPT = 0; int NREJCT = 0; int IPRINT = 0; int NMAX = 0; int METH = 0;
			int NSTIFF = 0; int NRDENS = 0; int I = 0; double UROUND = 0; double SAFE = 0; double FAC1 = 0; double FAC2 = 0;
			double BETA = 0; double HMAX = 0; double H = 0; int IEY1 = 0; int IEK1 = 0; int IEK2 = 0; int IEK3 = 0; int IEK4 = 0;
			int IEK5 = 0; int IEK6 = 0; int IEYS = 0; int IECO = 0; int ISTORE = 0; int ICOMP = 0;

			#endregion Implicit 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_work = -1 + offset_work; 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     NUMERICAL SOLUTION OF A SYSTEM OF FIRST 0RDER
			// C     ORDINARY DIFFERENTIAL EQUATIONS  Y'=F(X,Y).
			// C     THIS IS AN EXPLICIT RUNGE-KUTTA METHOD OF ORDER (4)5
			// C     DUE TO DORMAND & PRINCE (WITH STEPSIZE CONTROL AND
			// C     DENSE OUTPUT).
			// C
			// C     AUTHORS: E. HAIRER AND G. WANNER
			// C              UNIVERSITE DE GENEVE, DEPT. DE MATHEMATIQUES
			// C              CH-1211 GENEVE 24, SWITZERLAND
			// C              E-MAIL:  [email protected]
			// C                       [email protected]
			// C
			// C     THIS CODE IS DESCRIBED IN:
			// C         E. HAIRER, S.P. NORSETT AND G. WANNER, SOLVING ORDINARY
			// C         DIFFERENTIAL EQUATIONS I. NONSTIFF PROBLEMS. 2ND EDITION.
			// C         SPRINGER SERIES IN COMPUTATIONAL MATHEMATICS,
			// C         SPRINGER-VERLAG (1993)
			// C
			// C     VERSION OF APRIL 25, 1996
			// C     (latest correction of a small bug: August 8, 2005)
			// C
			// C     INPUT PARAMETERS
			// C     ----------------
			// C     N           DIMENSION OF THE SYSTEM
			// C
			// C     FCN         NAME (EXTERNAL) OF SUBROUTINE COMPUTING THE
			// C                 VALUE OF F(X,Y):
			// C                    SUBROUTINE FCN(N,X,Y,F,RPAR,IPAR)
			// C                    DOUBLE PRECISION X,Y(N),F(N)
			// C                    F(1)=...   ETC.
			// C
			// C     X           INITIAL X-VALUE
			// C
			// C     Y(N)        INITIAL VALUES FOR Y
			// C
			// C     XEND        FINAL X-VALUE (XEND-X MAY BE POSITIVE OR NEGATIVE)
			// C
			// C     RTOL,ATOL   RELATIVE AND ABSOLUTE ERROR TOLERANCES. THEY
			// C                 CAN BE BOTH SCALARS OR ELSE BOTH VECTORS OF LENGTH N.
			// C
			// C     ITOL        SWITCH FOR RTOL AND ATOL:
			// C                   ITOL=0: BOTH RTOL AND ATOL ARE SCALARS.
			// C                     THE CODE KEEPS, ROUGHLY, THE LOCAL ERROR OF
			// C                     Y(I) BELOW RTOL*ABS(Y(I))+ATOL
			// C                   ITOL=1: BOTH RTOL AND ATOL ARE VECTORS.
			// C                     THE CODE KEEPS THE LOCAL ERROR OF Y(I) BELOW
			// C                     RTOL(I)*ABS(Y(I))+ATOL(I).
			// C
			// C     SOLOUT      NAME (EXTERNAL) OF SUBROUTINE PROVIDING THE
			// C                 NUMERICAL SOLUTION DURING INTEGRATION.
			// C                 IF IOUT.GE.1, IT IS CALLED AFTER EVERY SUCCESSFUL STEP.
			// C                 SUPPLY A DUMMY SUBROUTINE IF IOUT=0.
			// C                 IT MUST HAVE THE FORM
			// C                    SUBROUTINE SOLOUT (NR,XOLD,X,Y,N,CON,ICOMP,ND,
			// C                                       RPAR,IPAR,IRTRN)
			// C                    DIMENSION Y(N),CON(5*ND),ICOMP(ND)
			// C                    ....
			// C                 SOLOUT FURNISHES THE SOLUTION "Y" AT THE NR-TH
			// C                    GRID-POINT "X" (THEREBY THE INITIAL VALUE IS
			// C                    THE FIRST GRID-POINT).
			// C                 "XOLD" IS THE PRECEEDING GRID-POINT.
			// C                 "IRTRN" SERVES TO INTERRUPT THE INTEGRATION. IF IRTRN
			// C                    IS SET <0, DOPRI5 WILL RETURN TO THE CALLING PROGRAM.
			// C                    IF THE NUMERICAL SOLUTION IS ALTERED IN SOLOUT,
			// C                    SET  IRTRN = 2
			// C
			// C          -----  CONTINUOUS OUTPUT: -----
			// C                 DURING CALLS TO "SOLOUT", A CONTINUOUS SOLUTION
			// C                 FOR THE INTERVAL [XOLD,X] IS AVAILABLE THROUGH
			// C                 THE FUNCTION
			// C                        >>>   CONTD5(I,S,CON,ICOMP,ND)   <<<
			// C                 WHICH PROVIDES AN APPROXIMATION TO THE I-TH
			// C                 COMPONENT OF THE SOLUTION AT THE POINT S. THE VALUE
			// C                 S SHOULD LIE IN THE INTERVAL [XOLD,X].
			// C
			// C     IOUT        SWITCH FOR CALLING THE SUBROUTINE SOLOUT:
			// C                    IOUT=0: SUBROUTINE IS NEVER CALLED
			// C                    IOUT=1: SUBROUTINE IS USED FOR OUTPUT.
			// C                    IOUT=2: DENSE OUTPUT IS PERFORMED IN SOLOUT
			// C                            (IN THIS CASE WORK(5) MUST BE SPECIFIED)
			// C
			// C     WORK        ARRAY OF WORKING SPACE OF LENGTH "LWORK".
			// C                 WORK(1),...,WORK(20) SERVE AS PARAMETERS FOR THE CODE.
			// C                 FOR STANDARD USE, SET THEM TO ZERO BEFORE CALLING.
			// C                 "LWORK" MUST BE AT LEAST  8*N+5*NRDENS+21
			// C                 WHERE  NRDENS = IWORK(5)
			// C
			// C     LWORK       DECLARED LENGHT OF ARRAY "WORK".
			// C
			// C     IWORK       INTEGER WORKING SPACE OF LENGHT "LIWORK".
			// C                 IWORK(1),...,IWORK(20) SERVE AS PARAMETERS FOR THE CODE.
			// C                 FOR STANDARD USE, SET THEM TO ZERO BEFORE CALLING.
			// C                 "LIWORK" MUST BE AT LEAST NRDENS+21 .
			// C
			// C     LIWORK      DECLARED LENGHT OF ARRAY "IWORK".
			// C
			// C     RPAR, IPAR  REAL AND INTEGER PARAMETERS (OR PARAMETER ARRAYS) WHICH
			// C                 CAN BE USED FOR COMMUNICATION BETWEEN YOUR CALLING
			// C                 PROGRAM AND THE FCN, JAC, MAS, SOLOUT SUBROUTINES.
			// C
			// C-----------------------------------------------------------------------
			// C
			// C     SOPHISTICATED SETTING OF PARAMETERS
			// C     -----------------------------------
			// C              SEVERAL PARAMETERS (WORK(1),...,IWORK(1),...) ALLOW
			// C              TO ADAPT THE CODE TO THE PROBLEM AND TO THE NEEDS OF
			// C              THE USER. FOR ZERO INPUT, THE CODE CHOOSES DEFAULT VALUES.
			// C
			// C    WORK(1)   UROUND, THE ROUNDING UNIT, DEFAULT 2.3D-16.
			// C
			// C    WORK(2)   THE SAFETY FACTOR IN STEP SIZE PREDICTION,
			// C              DEFAULT 0.9D0.
			// C
			// C    WORK(3), WORK(4)   PARAMETERS FOR STEP SIZE SELECTION
			// C              THE NEW STEP SIZE IS CHOSEN SUBJECT TO THE RESTRICTION
			// C                 WORK(3) <= HNEW/HOLD <= WORK(4)
			// C              DEFAULT VALUES: WORK(3)=0.2D0, WORK(4)=10.D0
			// C
			// C    WORK(5)   IS THE "BETA" FOR STABILIZED STEP SIZE CONTROL
			// C              (SEE SECTION IV.2). LARGER VALUES OF BETA ( <= 0.1 )
			// C              MAKE THE STEP SIZE CONTROL MORE STABLE. DOPRI5 NEEDS
			// C              A LARGER BETA THAN HIGHAM & HALL. NEGATIVE WORK(5)
			// C              PROVOKE BETA=0.
			// C              DEFAULT 0.04D0.
			// C
			// C    WORK(6)   MAXIMAL STEP SIZE, DEFAULT XEND-X.
			// C
			// C    WORK(7)   INITIAL STEP SIZE, FOR WORK(7)=0.D0 AN INITIAL GUESS
			// C              IS COMPUTED WITH HELP OF THE FUNCTION HINIT
			// C
			// C    IWORK(1)  THIS IS THE MAXIMAL NUMBER OF ALLOWED STEPS.
			// C              THE DEFAULT VALUE (FOR IWORK(1)=0) IS 100000.
			// C
			// C    IWORK(2)  SWITCH FOR THE CHOICE OF THE COEFFICIENTS
			// C              IF IWORK(2).EQ.1  METHOD DOPRI5 OF DORMAND AND PRINCE
			// C              (TABLE 5.2 OF SECTION II.5).
			// C              AT THE MOMENT THIS IS THE ONLY POSSIBLE CHOICE.
			// C              THE DEFAULT VALUE (FOR IWORK(2)=0) IS IWORK(2)=1.
			// C
			// C    IWORK(3)  SWITCH FOR PRINTING ERROR MESSAGES
			// C              IF IWORK(3).LT.0 NO MESSAGES ARE BEING PRINTED
			// C              IF IWORK(3).GT.0 MESSAGES ARE PRINTED WITH
			// C              WRITE (IWORK(3),*) ...
			// C              DEFAULT VALUE (FOR IWORK(3)=0) IS IWORK(3)=6
			// C
			// C    IWORK(4)  TEST FOR STIFFNESS IS ACTIVATED AFTER STEP NUMBER
			// C              J*IWORK(4) (J INTEGER), PROVIDED IWORK(4).GT.0.
			// C              FOR NEGATIVE IWORK(4) THE STIFFNESS TEST IS
			// C              NEVER ACTIVATED; DEFAULT VALUE IS IWORK(4)=1000
			// C
			// C    IWORK(5)  = NRDENS = NUMBER OF COMPONENTS, FOR WHICH DENSE OUTPUT
			// C              IS REQUIRED; DEFAULT VALUE IS IWORK(5)=0;
			// C              FOR   0 < NRDENS < N   THE COMPONENTS (FOR WHICH DENSE
			// C              OUTPUT IS REQUIRED) HAVE TO BE SPECIFIED IN
			// C              IWORK(21),...,IWORK(NRDENS+20);
			// C              FOR  NRDENS=N  THIS IS DONE BY THE CODE.
			// C
			// C----------------------------------------------------------------------
			// C
			// C     OUTPUT PARAMETERS
			// C     -----------------
			// C     X           X-VALUE FOR WHICH THE SOLUTION HAS BEEN COMPUTED
			// C                 (AFTER SUCCESSFUL RETURN X=XEND).
			// C
			// C     Y(N)        NUMERICAL SOLUTION AT X
			// C
			// C     H           PREDICTED STEP SIZE OF THE LAST ACCEPTED STEP
			// C
			// C     IDID        REPORTS ON SUCCESSFULNESS UPON RETURN:
			// C                   IDID= 1  COMPUTATION SUCCESSFUL,
			// C                   IDID= 2  COMPUT. SUCCESSFUL (INTERRUPTED BY SOLOUT)
			// C                   IDID=-1  INPUT IS NOT CONSISTENT,
			// C                   IDID=-2  LARGER NMAX IS NEEDED,
			// C                   IDID=-3  STEP SIZE BECOMES TOO SMALL.
			// C                   IDID=-4  PROBLEM IS PROBABLY STIFF (INTERRUPTED).
			// C
			// C   IWORK(17)  NFCN    NUMBER OF FUNCTION EVALUATIONS
			// C   IWORK(18)  NSTEP   NUMBER OF COMPUTED STEPS
			// C   IWORK(19)  NACCPT  NUMBER OF ACCEPTED STEPS
			// C   IWORK(20)  NREJCT  NUMBER OF REJECTED STEPS (DUE TO ERROR TEST),
			// C                      (STEP REJECTIONS IN THE FIRST STEP ARE NOT COUNTED)
			// C-----------------------------------------------------------------------
			// C *** *** *** *** *** *** *** *** *** *** *** *** ***
			// C          DECLARATIONS
			// C *** *** *** *** *** *** *** *** *** *** *** *** ***
			// C *** *** *** *** *** *** ***
			// C        SETTING THE PARAMETERS
			// C *** *** *** *** *** *** ***

			#endregion Prolog

			#region Body

			NFCN = 0;
			NSTEP = 0;
			NACCPT = 0;
			NREJCT = 0;
			ARRET = false;
			// C -------- IPRINT FOR MONITORING THE PRINTING
			if (IWORK[3 + o_iwork] == 0)
			{
				IPRINT = 6;
			}
			else
			{
				IPRINT = IWORK[3 + o_iwork];
			}
			// C -------- NMAX , THE MAXIMAL NUMBER OF STEPS -----
			if (IWORK[1 + o_iwork] == 0)
			{
				NMAX = 100000;
			}
			else
			{
				NMAX = IWORK[1 + o_iwork];
				if (NMAX <= 0)
				{
					if (IPRINT > 0) ;//ERROR-ERRORWRITE(IPRINT,*)' WRONG INPUT IWORK(1)=',IWORK(1)
					ARRET = true;
				}
			}
			// C -------- METH   COEFFICIENTS OF THE METHOD
			if (IWORK[2 + o_iwork] == 0)
			{
				METH = 1;
			}
			else
			{
				METH = IWORK[2 + o_iwork];
				if (METH <= 0 || METH >= 4)
				{
					if (IPRINT > 0) ;//ERROR-ERRORWRITE(IPRINT,*)' CURIOUS INPUT IWORK(2)=',IWORK(2)
					ARRET = true;
				}
			}
			// C -------- NSTIFF   PARAMETER FOR STIFFNESS DETECTION
			NSTIFF = IWORK[4 + o_iwork];
			if (NSTIFF == 0) NSTIFF = 1000;
			if (NSTIFF < 0) NSTIFF = NMAX + 10;
			// C -------- NRDENS   NUMBER OF DENSE OUTPUT COMPONENTS
			NRDENS = IWORK[5 + o_iwork];
			if (NRDENS < 0 || NRDENS > N)
			{
				if (IPRINT > 0) ;//ERROR-ERRORWRITE(IPRINT,*)' CURIOUS INPUT IWORK(5)=',IWORK(5)
				ARRET = true;
			}
			else
			{
				if (NRDENS > 0 && IOUT < 2)
				{
					if (IPRINT > 0) ;//ERROR-ERRORWRITE(IPRINT,*)' WARNING: PUT IOUT=2 FOR DENSE OUTPUT '
				}
				if (NRDENS == N)
				{
					for (I = 1; I <= NRDENS; I++)
					{
						IWORK[20 + I + o_iwork] = I;
					}
				}
			}
			// C -------- UROUND   SMALLEST NUMBER SATISFYING 1.D0+UROUND>1.D0
			if (WORK[1 + o_work] == 0.0E0)
			{
				UROUND = 2.3E-16;
			}
			else
			{
				UROUND = WORK[1 + o_work];
				if (UROUND <= 1.0E-35 || UROUND >= 1.0E0)
				{
					if (IPRINT > 0) ;//ERROR-ERRORWRITE(IPRINT,*)' WHICH MACHINE DO YOU HAVE? YOUR UROUND WAS:',WORK(1)
					ARRET = true;
				}
			}
			// C -------  SAFETY FACTOR -------------
			if (WORK[2 + o_work] == 0.0E0)
			{
				SAFE = 0.9E0;
			}
			else
			{
				SAFE = WORK[2 + o_work];
				if (SAFE >= 1.0E0 || SAFE <= 1.0E-4)
				{
					if (IPRINT > 0) ;//ERROR-ERRORWRITE(IPRINT,*)' CURIOUS INPUT FOR SAFETY FACTOR WORK(2)=',WORK(2)
					ARRET = true;
				}
			}
			// C -------  FAC1,FAC2     PARAMETERS FOR STEP SIZE SELECTION
			if (WORK[3 + o_work] == 0.0E0)
			{
				FAC1 = 0.2E0;
			}
			else
			{
				FAC1 = WORK[3 + o_work];
			}
			if (WORK[4 + o_work] == 0.0E0)
			{
				FAC2 = 10.0E0;
			}
			else
			{
				FAC2 = WORK[4 + o_work];
			}
			// C --------- BETA FOR STEP CONTROL STABILIZATION -----------
			if (WORK[5 + o_work] == 0.0E0)
			{
				BETA = 0.04E0;
			}
			else
			{
				if (WORK[5 + o_work] < 0.0E0)
				{
					BETA = 0.0E0;
				}
				else
				{
					BETA = WORK[5 + o_work];
					if (BETA > 0.2E0)
					{
						if (IPRINT > 0) ;//ERROR-ERRORWRITE(IPRINT,*)' CURIOUS INPUT FOR BETA: WORK(5)=',WORK(5)
						ARRET = true;
					}
				}
			}
			// C -------- MAXIMAL STEP SIZE
			if (WORK[6 + o_work] == 0.0E0)
			{
				HMAX = XEND - X;
			}
			else
			{
				HMAX = WORK[6 + o_work];
			}
			// C -------- INITIAL STEP SIZE
			H = WORK[7 + o_work];
			// C ------- PREPARE THE ENTRY-POINTS FOR THE ARRAYS IN WORK -----
			IEY1 = 21;
			IEK1 = IEY1 + N;
			IEK2 = IEK1 + N;
			IEK3 = IEK2 + N;
			IEK4 = IEK3 + N;
			IEK5 = IEK4 + N;
			IEK6 = IEK5 + N;
			IEYS = IEK6 + N;
			IECO = IEYS + N;
			// C ------ TOTAL STORAGE REQUIREMENT -----------
			ISTORE = IEYS + 5 * NRDENS - 1;
			if (ISTORE > LWORK)
			{
				if (IPRINT > 0) ;//ERROR-ERRORWRITE(IPRINT,*)' INSUFFICIENT STORAGE FOR WORK, MIN. LWORK=',ISTORE
				ARRET = true;
			}
			ICOMP = 21;
			ISTORE = ICOMP + NRDENS - 1;
			if (ISTORE > LIWORK)
			{
				if (IPRINT > 0) ;//ERROR-ERRORWRITE(IPRINT,*)' INSUFFICIENT STORAGE FOR IWORK, MIN. LIWORK=',ISTORE
				ARRET = true;
			}
			// C ------ WHEN A FAIL HAS OCCURED, WE RETURN WITH IDID=-1
			if (ARRET)
			{
				IDID = -1;
				return;
			}
			// C -------- CALL TO CORE INTEGRATOR ------------
			this._dopcor.Run(N, FCN, ref X, ref Y, offset_y, XEND, ref HMAX
											 , ref H, RTOL, offset_rtol, ATOL, offset_atol, ITOL, IPRINT, SOLOUT
											 , IOUT, ref IDID, NMAX, UROUND, METH, NSTIFF
											 , SAFE, BETA, FAC1, FAC2, ref WORK, IEY1 + o_work, ref WORK, IEK1 + o_work
											 , ref WORK, IEK2 + o_work, ref WORK, IEK3 + o_work, ref WORK, IEK4 + o_work, ref WORK, IEK5 + o_work, ref WORK, IEK6 + o_work, ref WORK, IEYS + o_work
											 , ref WORK, IECO + o_work, IWORK, ICOMP + o_iwork, NRDENS, RPAR, offset_rpar, IPAR, offset_ipar, ref NFCN
											 , ref NSTEP, ref NACCPT, ref NREJCT);
			WORK[7 + o_work] = H;
			IWORK[17 + o_iwork] = NFCN;
			IWORK[18 + o_iwork] = NSTEP;
			IWORK[19 + o_iwork] = NACCPT;
			IWORK[20 + o_iwork] = NREJCT;
			// C ----------- RETURN -----------
			return;

			#endregion Body
		}
Beispiel #4
0
        /// <param name="N">
        /// DIMENSION OF THE SYSTEM
        ///</param>
        /// <param name="FCN">
        /// NAME (EXTERNAL) OF SUBROUTINE COMPUTING THE
        /// VALUE OF F(X,Y):
        /// SUBROUTINE FCN(N,X,Y,F,RPAR,IPAR)
        /// DOUBLE PRECISION X,Y(N),F(N)
        /// F(1)=...   ETC.
        ///</param>
        /// <param name="X">
        /// INITIAL X-VALUE
        ///</param>
        /// <param name="XEND">
        /// FINAL X-VALUE (XEND-X MAY BE POSITIVE OR NEGATIVE)
        ///</param>
        /// <param name="ITOL">
        /// SWITCH FOR RTOL AND ATOL:
        /// ITOL=0: BOTH RTOL AND ATOL ARE SCALARS.
        /// THE CODE KEEPS, ROUGHLY, THE LOCAL ERROR OF
        /// Y(I) BELOW RTOL*ABS(Y(I))+ATOL
        /// ITOL=1: BOTH RTOL AND ATOL ARE VECTORS.
        /// THE CODE KEEPS THE LOCAL ERROR OF Y(I) BELOW
        /// RTOL(I)*ABS(Y(I))+ATOL(I).
        ///</param>
        /// <param name="SOLOUT">
        /// NAME (EXTERNAL) OF SUBROUTINE PROVIDING THE
        /// NUMERICAL SOLUTION DURING INTEGRATION.
        /// IF IOUT.GE.1, IT IS CALLED AFTER EVERY SUCCESSFUL STEP.
        /// SUPPLY A DUMMY SUBROUTINE IF IOUT=0.
        /// IT MUST HAVE THE FORM
        /// SUBROUTINE SOLOUT (NR,XOLD,X,Y,N,CON,ICOMP,ND,
        /// RPAR,IPAR,IRTRN)
        /// DIMENSION Y(N),CON(5*ND),ICOMP(ND)
        /// ....
        /// SOLOUT FURNISHES THE SOLUTION "Y" AT THE NR-TH
        /// GRID-POINT "X" (THEREBY THE INITIAL VALUE IS
        /// THE FIRST GRID-POINT).
        /// "XOLD" IS THE PRECEEDING GRID-POINT.
        /// "IRTRN" SERVES TO INTERRUPT THE INTEGRATION. IF IRTRN
        /// IS SET .LT.0, DOPRI5 WILL RETURN TO THE CALLING PROGRAM.
        /// IF THE NUMERICAL SOLUTION IS ALTERED IN SOLOUT,
        /// SET  IRTRN = 2
        ///
        /// -----  CONTINUOUS OUTPUT: -----
        /// DURING CALLS TO "SOLOUT", A CONTINUOUS SOLUTION
        /// FOR THE INTERVAL [XOLD,X] IS AVAILABLE THROUGH
        /// THE FUNCTION
        /// .GT..GT..GT.   CONTD5(I,S,CON,ICOMP,ND)   .LT..LT..LT.
        /// WHICH PROVIDES AN APPROXIMATION TO THE I-TH
        /// COMPONENT OF THE SOLUTION AT THE POINT S. THE VALUE
        /// S SHOULD LIE IN THE INTERVAL [XOLD,X].
        ///</param>
        /// <param name="IOUT">
        /// SWITCH FOR CALLING THE SUBROUTINE SOLOUT:
        /// IOUT=0: SUBROUTINE IS NEVER CALLED
        /// IOUT=1: SUBROUTINE IS USED FOR OUTPUT.
        /// IOUT=2: DENSE OUTPUT IS PERFORMED IN SOLOUT
        /// (IN THIS CASE WORK(5) MUST BE SPECIFIED)
        ///</param>
        /// <param name="WORK">
        /// ARRAY OF WORKING SPACE OF LENGTH "LWORK".
        /// WORK(1),...,WORK(20) SERVE AS PARAMETERS FOR THE CODE.
        /// FOR STANDARD USE, SET THEM TO ZERO BEFORE CALLING.
        /// "LWORK" MUST BE AT LEAST  8*N+5*NRDENS+21
        /// WHERE  NRDENS = IWORK(5)
        ///</param>
        /// <param name="LWORK">
        /// DECLARED LENGHT OF ARRAY "WORK".
        ///</param>
        /// <param name="IWORK">
        /// INTEGER WORKING SPACE OF LENGHT "LIWORK".
        /// IWORK(1),...,IWORK(20) SERVE AS PARAMETERS FOR THE CODE.
        /// FOR STANDARD USE, SET THEM TO ZERO BEFORE CALLING.
        /// "LIWORK" MUST BE AT LEAST NRDENS+21 .
        ///</param>
        /// <param name="LIWORK">
        /// DECLARED LENGHT OF ARRAY "IWORK".
        ///</param>
        /// <param name="IDID">
        /// REPORTS ON SUCCESSFULNESS UPON RETURN:
        /// IDID= 1  COMPUTATION SUCCESSFUL,
        /// IDID= 2  COMPUT. SUCCESSFUL (INTERRUPTED BY SOLOUT)
        /// IDID=-1  INPUT IS NOT CONSISTENT,
        /// IDID=-2  LARGER NMAX IS NEEDED,
        /// IDID=-3  STEP SIZE BECOMES TOO SMALL.
        /// IDID=-4  PROBLEM IS PROBABLY STIFF (INTERRUPTED).
        ///</param>
        public void Run(int N, IFAREN FCN, ref double X, ref double[] Y, int offset_y, double XEND, double[] RTOL, int offset_rtol
                        , double[] ATOL, int offset_atol, int ITOL, ISOLOUT SOLOUT, int IOUT, ref double[] WORK, int offset_work, int LWORK
                        , ref int[] IWORK, int offset_iwork, int LIWORK, double[] RPAR, int offset_rpar, int[] IPAR, int offset_ipar, ref int IDID)
        {
            #region Variables

            bool ARRET = false;
            #endregion
            #region Implicit Variables

            int    NFCN = 0; int NSTEP = 0; int NACCPT = 0; int NREJCT = 0; int IPRINT = 0; int NMAX = 0; int METH = 0;
            int    NSTIFF = 0; int NRDENS = 0; int I = 0; double UROUND = 0; double SAFE = 0; double FAC1 = 0; double FAC2 = 0;
            double BETA = 0; double HMAX = 0; double H = 0; int IEY1 = 0; int IEK1 = 0; int IEK2 = 0; int IEK3 = 0; int IEK4 = 0;
            int    IEK5 = 0; int IEK6 = 0; int IEYS = 0; int IECO = 0; int ISTORE = 0; int ICOMP = 0;
            #endregion
            #region Array Index Correction

            int o_y = -1 + offset_y;  int o_rtol = -1 + offset_rtol;  int o_atol = -1 + offset_atol;
            int o_work = -1 + offset_work; int o_iwork = -1 + offset_iwork;  int o_rpar = -1 + offset_rpar;
            int o_ipar = -1 + offset_ipar;
            #endregion
            #region Prolog

            // C ----------------------------------------------------------
            // C     NUMERICAL SOLUTION OF A SYSTEM OF FIRST 0RDER
            // C     ORDINARY DIFFERENTIAL EQUATIONS  Y'=F(X,Y).
            // C     THIS IS AN EXPLICIT RUNGE-KUTTA METHOD OF ORDER (4)5
            // C     DUE TO DORMAND & PRINCE (WITH STEPSIZE CONTROL AND
            // C     DENSE OUTPUT).
            // C
            // C     AUTHORS: E. HAIRER AND G. WANNER
            // C              UNIVERSITE DE GENEVE, DEPT. DE MATHEMATIQUES
            // C              CH-1211 GENEVE 24, SWITZERLAND
            // C              E-MAIL:  [email protected]
            // C                       [email protected]
            // C
            // C     THIS CODE IS DESCRIBED IN:
            // C         E. HAIRER, S.P. NORSETT AND G. WANNER, SOLVING ORDINARY
            // C         DIFFERENTIAL EQUATIONS I. NONSTIFF PROBLEMS. 2ND EDITION.
            // C         SPRINGER SERIES IN COMPUTATIONAL MATHEMATICS,
            // C         SPRINGER-VERLAG (1993)
            // C
            // C     VERSION OF APRIL 25, 1996
            // C     (latest correction of a small bug: August 8, 2005)
            // C
            // C     INPUT PARAMETERS
            // C     ----------------
            // C     N           DIMENSION OF THE SYSTEM
            // C
            // C     FCN         NAME (EXTERNAL) OF SUBROUTINE COMPUTING THE
            // C                 VALUE OF F(X,Y):
            // C                    SUBROUTINE FCN(N,X,Y,F,RPAR,IPAR)
            // C                    DOUBLE PRECISION X,Y(N),F(N)
            // C                    F(1)=...   ETC.
            // C
            // C     X           INITIAL X-VALUE
            // C
            // C     Y(N)        INITIAL VALUES FOR Y
            // C
            // C     XEND        FINAL X-VALUE (XEND-X MAY BE POSITIVE OR NEGATIVE)
            // C
            // C     RTOL,ATOL   RELATIVE AND ABSOLUTE ERROR TOLERANCES. THEY
            // C                 CAN BE BOTH SCALARS OR ELSE BOTH VECTORS OF LENGTH N.
            // C
            // C     ITOL        SWITCH FOR RTOL AND ATOL:
            // C                   ITOL=0: BOTH RTOL AND ATOL ARE SCALARS.
            // C                     THE CODE KEEPS, ROUGHLY, THE LOCAL ERROR OF
            // C                     Y(I) BELOW RTOL*ABS(Y(I))+ATOL
            // C                   ITOL=1: BOTH RTOL AND ATOL ARE VECTORS.
            // C                     THE CODE KEEPS THE LOCAL ERROR OF Y(I) BELOW
            // C                     RTOL(I)*ABS(Y(I))+ATOL(I).
            // C
            // C     SOLOUT      NAME (EXTERNAL) OF SUBROUTINE PROVIDING THE
            // C                 NUMERICAL SOLUTION DURING INTEGRATION.
            // C                 IF IOUT.GE.1, IT IS CALLED AFTER EVERY SUCCESSFUL STEP.
            // C                 SUPPLY A DUMMY SUBROUTINE IF IOUT=0.
            // C                 IT MUST HAVE THE FORM
            // C                    SUBROUTINE SOLOUT (NR,XOLD,X,Y,N,CON,ICOMP,ND,
            // C                                       RPAR,IPAR,IRTRN)
            // C                    DIMENSION Y(N),CON(5*ND),ICOMP(ND)
            // C                    ....
            // C                 SOLOUT FURNISHES THE SOLUTION "Y" AT THE NR-TH
            // C                    GRID-POINT "X" (THEREBY THE INITIAL VALUE IS
            // C                    THE FIRST GRID-POINT).
            // C                 "XOLD" IS THE PRECEEDING GRID-POINT.
            // C                 "IRTRN" SERVES TO INTERRUPT THE INTEGRATION. IF IRTRN
            // C                    IS SET <0, DOPRI5 WILL RETURN TO THE CALLING PROGRAM.
            // C                    IF THE NUMERICAL SOLUTION IS ALTERED IN SOLOUT,
            // C                    SET  IRTRN = 2
            // C
            // C          -----  CONTINUOUS OUTPUT: -----
            // C                 DURING CALLS TO "SOLOUT", A CONTINUOUS SOLUTION
            // C                 FOR THE INTERVAL [XOLD,X] IS AVAILABLE THROUGH
            // C                 THE FUNCTION
            // C                        >>>   CONTD5(I,S,CON,ICOMP,ND)   <<<
            // C                 WHICH PROVIDES AN APPROXIMATION TO THE I-TH
            // C                 COMPONENT OF THE SOLUTION AT THE POINT S. THE VALUE
            // C                 S SHOULD LIE IN THE INTERVAL [XOLD,X].
            // C
            // C     IOUT        SWITCH FOR CALLING THE SUBROUTINE SOLOUT:
            // C                    IOUT=0: SUBROUTINE IS NEVER CALLED
            // C                    IOUT=1: SUBROUTINE IS USED FOR OUTPUT.
            // C                    IOUT=2: DENSE OUTPUT IS PERFORMED IN SOLOUT
            // C                            (IN THIS CASE WORK(5) MUST BE SPECIFIED)
            // C
            // C     WORK        ARRAY OF WORKING SPACE OF LENGTH "LWORK".
            // C                 WORK(1),...,WORK(20) SERVE AS PARAMETERS FOR THE CODE.
            // C                 FOR STANDARD USE, SET THEM TO ZERO BEFORE CALLING.
            // C                 "LWORK" MUST BE AT LEAST  8*N+5*NRDENS+21
            // C                 WHERE  NRDENS = IWORK(5)
            // C
            // C     LWORK       DECLARED LENGHT OF ARRAY "WORK".
            // C
            // C     IWORK       INTEGER WORKING SPACE OF LENGHT "LIWORK".
            // C                 IWORK(1),...,IWORK(20) SERVE AS PARAMETERS FOR THE CODE.
            // C                 FOR STANDARD USE, SET THEM TO ZERO BEFORE CALLING.
            // C                 "LIWORK" MUST BE AT LEAST NRDENS+21 .
            // C
            // C     LIWORK      DECLARED LENGHT OF ARRAY "IWORK".
            // C
            // C     RPAR, IPAR  REAL AND INTEGER PARAMETERS (OR PARAMETER ARRAYS) WHICH
            // C                 CAN BE USED FOR COMMUNICATION BETWEEN YOUR CALLING
            // C                 PROGRAM AND THE FCN, JAC, MAS, SOLOUT SUBROUTINES.
            // C
            // C-----------------------------------------------------------------------
            // C
            // C     SOPHISTICATED SETTING OF PARAMETERS
            // C     -----------------------------------
            // C              SEVERAL PARAMETERS (WORK(1),...,IWORK(1),...) ALLOW
            // C              TO ADAPT THE CODE TO THE PROBLEM AND TO THE NEEDS OF
            // C              THE USER. FOR ZERO INPUT, THE CODE CHOOSES DEFAULT VALUES.
            // C
            // C    WORK(1)   UROUND, THE ROUNDING UNIT, DEFAULT 2.3D-16.
            // C
            // C    WORK(2)   THE SAFETY FACTOR IN STEP SIZE PREDICTION,
            // C              DEFAULT 0.9D0.
            // C
            // C    WORK(3), WORK(4)   PARAMETERS FOR STEP SIZE SELECTION
            // C              THE NEW STEP SIZE IS CHOSEN SUBJECT TO THE RESTRICTION
            // C                 WORK(3) <= HNEW/HOLD <= WORK(4)
            // C              DEFAULT VALUES: WORK(3)=0.2D0, WORK(4)=10.D0
            // C
            // C    WORK(5)   IS THE "BETA" FOR STABILIZED STEP SIZE CONTROL
            // C              (SEE SECTION IV.2). LARGER VALUES OF BETA ( <= 0.1 )
            // C              MAKE THE STEP SIZE CONTROL MORE STABLE. DOPRI5 NEEDS
            // C              A LARGER BETA THAN HIGHAM & HALL. NEGATIVE WORK(5)
            // C              PROVOKE BETA=0.
            // C              DEFAULT 0.04D0.
            // C
            // C    WORK(6)   MAXIMAL STEP SIZE, DEFAULT XEND-X.
            // C
            // C    WORK(7)   INITIAL STEP SIZE, FOR WORK(7)=0.D0 AN INITIAL GUESS
            // C              IS COMPUTED WITH HELP OF THE FUNCTION HINIT
            // C
            // C    IWORK(1)  THIS IS THE MAXIMAL NUMBER OF ALLOWED STEPS.
            // C              THE DEFAULT VALUE (FOR IWORK(1)=0) IS 100000.
            // C
            // C    IWORK(2)  SWITCH FOR THE CHOICE OF THE COEFFICIENTS
            // C              IF IWORK(2).EQ.1  METHOD DOPRI5 OF DORMAND AND PRINCE
            // C              (TABLE 5.2 OF SECTION II.5).
            // C              AT THE MOMENT THIS IS THE ONLY POSSIBLE CHOICE.
            // C              THE DEFAULT VALUE (FOR IWORK(2)=0) IS IWORK(2)=1.
            // C
            // C    IWORK(3)  SWITCH FOR PRINTING ERROR MESSAGES
            // C              IF IWORK(3).LT.0 NO MESSAGES ARE BEING PRINTED
            // C              IF IWORK(3).GT.0 MESSAGES ARE PRINTED WITH
            // C              WRITE (IWORK(3),*) ...
            // C              DEFAULT VALUE (FOR IWORK(3)=0) IS IWORK(3)=6
            // C
            // C    IWORK(4)  TEST FOR STIFFNESS IS ACTIVATED AFTER STEP NUMBER
            // C              J*IWORK(4) (J INTEGER), PROVIDED IWORK(4).GT.0.
            // C              FOR NEGATIVE IWORK(4) THE STIFFNESS TEST IS
            // C              NEVER ACTIVATED; DEFAULT VALUE IS IWORK(4)=1000
            // C
            // C    IWORK(5)  = NRDENS = NUMBER OF COMPONENTS, FOR WHICH DENSE OUTPUT
            // C              IS REQUIRED; DEFAULT VALUE IS IWORK(5)=0;
            // C              FOR   0 < NRDENS < N   THE COMPONENTS (FOR WHICH DENSE
            // C              OUTPUT IS REQUIRED) HAVE TO BE SPECIFIED IN
            // C              IWORK(21),...,IWORK(NRDENS+20);
            // C              FOR  NRDENS=N  THIS IS DONE BY THE CODE.
            // C
            // C----------------------------------------------------------------------
            // C
            // C     OUTPUT PARAMETERS
            // C     -----------------
            // C     X           X-VALUE FOR WHICH THE SOLUTION HAS BEEN COMPUTED
            // C                 (AFTER SUCCESSFUL RETURN X=XEND).
            // C
            // C     Y(N)        NUMERICAL SOLUTION AT X
            // C
            // C     H           PREDICTED STEP SIZE OF THE LAST ACCEPTED STEP
            // C
            // C     IDID        REPORTS ON SUCCESSFULNESS UPON RETURN:
            // C                   IDID= 1  COMPUTATION SUCCESSFUL,
            // C                   IDID= 2  COMPUT. SUCCESSFUL (INTERRUPTED BY SOLOUT)
            // C                   IDID=-1  INPUT IS NOT CONSISTENT,
            // C                   IDID=-2  LARGER NMAX IS NEEDED,
            // C                   IDID=-3  STEP SIZE BECOMES TOO SMALL.
            // C                   IDID=-4  PROBLEM IS PROBABLY STIFF (INTERRUPTED).
            // C
            // C   IWORK(17)  NFCN    NUMBER OF FUNCTION EVALUATIONS
            // C   IWORK(18)  NSTEP   NUMBER OF COMPUTED STEPS
            // C   IWORK(19)  NACCPT  NUMBER OF ACCEPTED STEPS
            // C   IWORK(20)  NREJCT  NUMBER OF REJECTED STEPS (DUE TO ERROR TEST),
            // C                      (STEP REJECTIONS IN THE FIRST STEP ARE NOT COUNTED)
            // C-----------------------------------------------------------------------
            // C *** *** *** *** *** *** *** *** *** *** *** *** ***
            // C          DECLARATIONS
            // C *** *** *** *** *** *** *** *** *** *** *** *** ***
            // C *** *** *** *** *** *** ***
            // C        SETTING THE PARAMETERS
            // C *** *** *** *** *** *** ***
            #endregion
            #region Body

            NFCN   = 0;
            NSTEP  = 0;
            NACCPT = 0;
            NREJCT = 0;
            ARRET  = false;
            // C -------- IPRINT FOR MONITORING THE PRINTING
            if (IWORK[3 + o_iwork] == 0)
            {
                IPRINT = 6;
            }
            else
            {
                IPRINT = IWORK[3 + o_iwork];
            }
            // C -------- NMAX , THE MAXIMAL NUMBER OF STEPS -----
            if (IWORK[1 + o_iwork] == 0)
            {
                NMAX = 100000;
            }
            else
            {
                NMAX = IWORK[1 + o_iwork];
                if (NMAX <= 0)
                {
                    if (IPRINT > 0)
                    {
                        ;            //ERROR-ERRORWRITE(IPRINT,*)' WRONG INPUT IWORK(1)=',IWORK(1)
                    }
                    ARRET = true;
                }
            }
            // C -------- METH   COEFFICIENTS OF THE METHOD
            if (IWORK[2 + o_iwork] == 0)
            {
                METH = 1;
            }
            else
            {
                METH = IWORK[2 + o_iwork];
                if (METH <= 0 || METH >= 4)
                {
                    if (IPRINT > 0)
                    {
                        ;            //ERROR-ERRORWRITE(IPRINT,*)' CURIOUS INPUT IWORK(2)=',IWORK(2)
                    }
                    ARRET = true;
                }
            }
            // C -------- NSTIFF   PARAMETER FOR STIFFNESS DETECTION
            NSTIFF = IWORK[4 + o_iwork];
            if (NSTIFF == 0)
            {
                NSTIFF = 1000;
            }
            if (NSTIFF < 0)
            {
                NSTIFF = NMAX + 10;
            }
            // C -------- NRDENS   NUMBER OF DENSE OUTPUT COMPONENTS
            NRDENS = IWORK[5 + o_iwork];
            if (NRDENS < 0 || NRDENS > N)
            {
                if (IPRINT > 0)
                {
                    ;            //ERROR-ERRORWRITE(IPRINT,*)' CURIOUS INPUT IWORK(5)=',IWORK(5)
                }
                ARRET = true;
            }
            else
            {
                if (NRDENS > 0 && IOUT < 2)
                {
                    if (IPRINT > 0)
                    {
                        ;            //ERROR-ERRORWRITE(IPRINT,*)' WARNING: PUT IOUT=2 FOR DENSE OUTPUT '
                    }
                }
                if (NRDENS == N)
                {
                    for (I = 1; I <= NRDENS; I++)
                    {
                        IWORK[20 + I + o_iwork] = I;
                    }
                }
            }
            // C -------- UROUND   SMALLEST NUMBER SATISFYING 1.D0+UROUND>1.D0
            if (WORK[1 + o_work] == 0.0E0)
            {
                UROUND = 2.3E-16;
            }
            else
            {
                UROUND = WORK[1 + o_work];
                if (UROUND <= 1.0E-35 || UROUND >= 1.0E0)
                {
                    if (IPRINT > 0)
                    {
                        ;            //ERROR-ERRORWRITE(IPRINT,*)' WHICH MACHINE DO YOU HAVE? YOUR UROUND WAS:',WORK(1)
                    }
                    ARRET = true;
                }
            }
            // C -------  SAFETY FACTOR -------------
            if (WORK[2 + o_work] == 0.0E0)
            {
                SAFE = 0.9E0;
            }
            else
            {
                SAFE = WORK[2 + o_work];
                if (SAFE >= 1.0E0 || SAFE <= 1.0E-4)
                {
                    if (IPRINT > 0)
                    {
                        ;            //ERROR-ERRORWRITE(IPRINT,*)' CURIOUS INPUT FOR SAFETY FACTOR WORK(2)=',WORK(2)
                    }
                    ARRET = true;
                }
            }
            // C -------  FAC1,FAC2     PARAMETERS FOR STEP SIZE SELECTION
            if (WORK[3 + o_work] == 0.0E0)
            {
                FAC1 = 0.2E0;
            }
            else
            {
                FAC1 = WORK[3 + o_work];
            }
            if (WORK[4 + o_work] == 0.0E0)
            {
                FAC2 = 10.0E0;
            }
            else
            {
                FAC2 = WORK[4 + o_work];
            }
            // C --------- BETA FOR STEP CONTROL STABILIZATION -----------
            if (WORK[5 + o_work] == 0.0E0)
            {
                BETA = 0.04E0;
            }
            else
            {
                if (WORK[5 + o_work] < 0.0E0)
                {
                    BETA = 0.0E0;
                }
                else
                {
                    BETA = WORK[5 + o_work];
                    if (BETA > 0.2E0)
                    {
                        if (IPRINT > 0)
                        {
                            ;            //ERROR-ERRORWRITE(IPRINT,*)' CURIOUS INPUT FOR BETA: WORK(5)=',WORK(5)
                        }
                        ARRET = true;
                    }
                }
            }
            // C -------- MAXIMAL STEP SIZE
            if (WORK[6 + o_work] == 0.0E0)
            {
                HMAX = XEND - X;
            }
            else
            {
                HMAX = WORK[6 + o_work];
            }
            // C -------- INITIAL STEP SIZE
            H = WORK[7 + o_work];
            // C ------- PREPARE THE ENTRY-POINTS FOR THE ARRAYS IN WORK -----
            IEY1 = 21;
            IEK1 = IEY1 + N;
            IEK2 = IEK1 + N;
            IEK3 = IEK2 + N;
            IEK4 = IEK3 + N;
            IEK5 = IEK4 + N;
            IEK6 = IEK5 + N;
            IEYS = IEK6 + N;
            IECO = IEYS + N;
            // C ------ TOTAL STORAGE REQUIREMENT -----------
            ISTORE = IEYS + 5 * NRDENS - 1;
            if (ISTORE > LWORK)
            {
                if (IPRINT > 0)
                {
                    ;            //ERROR-ERRORWRITE(IPRINT,*)' INSUFFICIENT STORAGE FOR WORK, MIN. LWORK=',ISTORE
                }
                ARRET = true;
            }
            ICOMP  = 21;
            ISTORE = ICOMP + NRDENS - 1;
            if (ISTORE > LIWORK)
            {
                if (IPRINT > 0)
                {
                    ;            //ERROR-ERRORWRITE(IPRINT,*)' INSUFFICIENT STORAGE FOR IWORK, MIN. LIWORK=',ISTORE
                }
                ARRET = true;
            }
            // C ------ WHEN A FAIL HAS OCCURED, WE RETURN WITH IDID=-1
            if (ARRET)
            {
                IDID = -1;
                return;
            }
            // C -------- CALL TO CORE INTEGRATOR ------------
            this._dopcor.Run(N, FCN, ref X, ref Y, offset_y, XEND, ref HMAX
                             , ref H, RTOL, offset_rtol, ATOL, offset_atol, ITOL, IPRINT, SOLOUT
                             , IOUT, ref IDID, NMAX, UROUND, METH, NSTIFF
                             , SAFE, BETA, FAC1, FAC2, ref WORK, IEY1 + o_work, ref WORK, IEK1 + o_work
                             , ref WORK, IEK2 + o_work, ref WORK, IEK3 + o_work, ref WORK, IEK4 + o_work, ref WORK, IEK5 + o_work, ref WORK, IEK6 + o_work, ref WORK, IEYS + o_work
                             , ref WORK, IECO + o_work, IWORK, ICOMP + o_iwork, NRDENS, RPAR, offset_rpar, IPAR, offset_ipar, ref NFCN
                             , ref NSTEP, ref NACCPT, ref NREJCT);
            WORK[7 + o_work]    = H;
            IWORK[17 + o_iwork] = NFCN;
            IWORK[18 + o_iwork] = NSTEP;
            IWORK[19 + o_iwork] = NACCPT;
            IWORK[20 + o_iwork] = NREJCT;
            // C ----------- RETURN -----------
            return;

            #endregion
        }