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 }
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 }
/// <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 }
/// <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 }