public void Run(int N, IFVPOL FCN, ref double X, ref double[] Y, int offset_y, double XEND, double HMAX , ref double H, double[] RTOL, int offset_rtol, double[] ATOL, int offset_atol, int ITOL, IJVPOL JAC, int IJAC , int MLJAC, int MUJAC, IBBAMPL MAS, int MLMAS, int MUMAS, ISOLOUTR SOLOUT , int IOUT, ref int IDID, int NMAX, double UROUND, double SAFE, double THET , double FNEWT, double QUOT1, double QUOT2, int NIT, ref int IJOB, bool STARTN , int NIND1, int NIND2, int NIND3, bool PRED, double FACL, double FACR , int M1, int M2, int NM1, bool IMPLCT, bool BANDED, int LDJAC , int LDE1, int LDMAS, ref double[] Z1, int offset_z1, ref double[] Z2, int offset_z2, ref double[] Z3, int offset_z3, ref double[] Y0, int offset_y0 , ref double[] SCAL, int offset_scal, ref double[] F1, int offset_f1, ref double[] F2, int offset_f2, ref double[] F3, int offset_f3, ref double[] FJAC, int offset_fjac, ref double[] E1, int offset_e1 , ref double[] E2R, int offset_e2r, ref double[] E2I, int offset_e2i, ref double[] FMAS, int offset_fmas, ref int[] IP1, int offset_ip1, ref int[] IP2, int offset_ip2, ref int[] IPHES, int offset_iphes , ref double[] CONT, int offset_cont, ref int NFCN, ref int NJAC, ref int NSTEP, ref int NACCPT, ref int NREJCT , ref int NDEC, ref int NSOL, double[] RPAR, int offset_rpar, int[] IPAR, int offset_ipar) { #region Variables bool REJECT = false; bool FIRST = false; bool CALJAC = false; bool CALHES = false; bool INDEX1 = false; bool INDEX2 = false; bool INDEX3 = false; bool LAST = false; #endregion Variables #region Implicit Variables int LRC = 0; double SQ6 = 0; double C1 = 0; double C2 = 0; double C1MC2 = 0; double DD1 = 0; double DD2 = 0; double DD3 = 0; double U1 = 0; double ALPH = 0; double BETA = 0; double CNO = 0; double T11 = 0; double T12 = 0; double T13 = 0; double T21 = 0; double T22 = 0; double T23 = 0; double T31 = 0; double TI11 = 0; double TI12 = 0; double TI13 = 0; double TI21 = 0; double TI22 = 0; double TI23 = 0; double TI31 = 0; double TI32 = 0; double TI33 = 0; double POSNEG = 0; double HMAXN = 0; double HOLD = 0; double HOPT = 0; double FACCON = 0; double CFAC = 0; int NSING = 0; double XOLD = 0; int IRTRN = 0; int NRSOL = 0; double XOSOL = 0; int I = 0; int NSOLU = 0; int N2 = 0; int N3 = 0; double HHFAC = 0; int MUJACP = 0; int MD = 0; int J = 0; int K = 0; int MM = 0; int J1 = 0; int LBEG = 0; int LEND = 0; int MUJACJ = 0; int L = 0; int FJAC_J = 0; double YSAFE = 0; double DELT = 0; int FJAC_I = 0; double FAC1 = 0; double ALPHN = 0; double BETAN = 0; int IER = 0; double XPH = 0; double C3Q = 0; double C1Q = 0; double C2Q = 0; double AK1 = 0; double AK2 = 0; double AK3 = 0; double Z1I = 0; double Z2I = 0; double Z3I = 0; int NEWT = 0; double THETA = 0; double A1 = 0; double A2 = 0; double A3 = 0; double DYNO = 0; double DENOM = 0; double THQ = 0; double DYNOLD = 0; double THQOLD = 0; double DYTH = 0; double QNEWT = 0; double F1I = 0; double F2I = 0; double F3I = 0; double FAC = 0; double QUOT = 0; double ERR = 0; double HNEW = 0; double FACGUS = 0; double HACC = 0; double ERRACC = 0; double AK = 0; double ACONT3 = 0; double QT = 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_z1 = -1 + offset_z1; int o_z2 = -1 + offset_z2; int o_z3 = -1 + offset_z3; int o_y0 = -1 + offset_y0; int o_scal = -1 + offset_scal; int o_f1 = -1 + offset_f1; int o_f2 = -1 + offset_f2; int o_f3 = -1 + offset_f3; int o_fjac = -1 - LDJAC + offset_fjac; int o_e1 = -1 - LDE1 + offset_e1; int o_e2r = -1 - LDE1 + offset_e2r; int o_e2i = -1 - LDE1 + offset_e2i; int o_fmas = -1 - LDMAS + offset_fmas; int o_ip1 = -1 + offset_ip1; int o_ip2 = -1 + offset_ip2; int o_iphes = -1 + offset_iphes; int o_cont = -1 + offset_cont; int o_rpar = -1 + offset_rpar; int o_ipar = -1 + offset_ipar; #endregion Array Index Correction // C ---------------------------------------------------------- // C CORE INTEGRATOR FOR RADAU5 // C PARAMETERS SAME AS IN RADAU5 WITH WORKSPACE ADDED // C ---------------------------------------------------------- // C DECLARATIONS // C ---------------------------------------------------------- // C *** *** *** *** *** *** *** // C INITIALISATIONS // C *** *** *** *** *** *** *** // C --------- DUPLIFY N FOR COMMON BLOCK CONT ----- #region Body NN.v = N; NN2.v = 2 * N; NN3.v = 3 * N; LRC = 4 * N; // C -------- CHECK THE INDEX OF THE PROBLEM ----- INDEX1 = NIND1 != 0; INDEX2 = NIND2 != 0; INDEX3 = NIND3 != 0; // C ------- COMPUTE MASS MATRIX FOR IMPLICIT CASE ---------- if (IMPLCT) MAS.Run(NM1, ref FMAS, offset_fmas, LDMAS, RPAR, offset_rpar, IPAR[1 + o_ipar]); // C ---------- CONSTANTS --------- SQ6 = Math.Sqrt(6.0E0); C1 = (4.0E0 - SQ6) / 10.0E0; C2 = (4.0E0 + SQ6) / 10.0E0; C1M1.v = C1 - 1.0E0; C2M1.v = C2 - 1.0E0; C1MC2 = C1 - C2; DD1 = -(13.0E0 + 7.0E0 * SQ6) / 3.0E0; DD2 = (-13.0E0 + 7.0E0 * SQ6) / 3.0E0; DD3 = -1.0E0 / 3.0E0; U1 = (6.0E0 + Math.Pow(81.0E0, 1.0E0 / 3.0E0) - Math.Pow(9.0E0, 1.0E0 / 3.0E0)) / 30.0E0; ALPH = (12.0E0 - Math.Pow(81.0E0, 1.0E0 / 3.0E0) + Math.Pow(9.0E0, 1.0E0 / 3.0E0)) / 60.0E0; BETA = (Math.Pow(81.0E0, 1.0E0 / 3.0E0) + Math.Pow(9.0E0, 1.0E0 / 3.0E0)) * Math.Sqrt(3.0E0) / 60.0E0; CNO = Math.Pow(ALPH, 2) + Math.Pow(BETA, 2); U1 = 1.0E0 / U1; ALPH /= CNO; BETA /= CNO; T11 = 9.1232394870892942792E-02; T12 = -0.14125529502095420843E0; T13 = -3.0029194105147424492E-02; T21 = 0.24171793270710701896E0; T22 = 0.20412935229379993199E0; T23 = 0.38294211275726193779E0; T31 = 0.96604818261509293619E0; TI11 = 4.3255798900631553510E0; TI12 = 0.33919925181580986954E0; TI13 = 0.54177053993587487119E0; TI21 = -4.1787185915519047273E0; TI22 = -0.32768282076106238708E0; TI23 = 0.47662355450055045196E0; TI31 = -0.50287263494578687595E0; TI32 = 2.5719269498556054292E0; TI33 = -0.59603920482822492497E0; if (M1 > 0) IJOB += 10; POSNEG = FortranLib.Sign(1.0E0, XEND - X); HMAXN = Math.Min(Math.Abs(HMAX), Math.Abs(XEND - X)); if (Math.Abs(H) <= 10.0E0 * UROUND) H = 1.0E-6; H = Math.Min(Math.Abs(H), HMAXN); H = FortranLib.Sign(H, POSNEG); HOLD = H; REJECT = false; FIRST = true; LAST = false; if ((X + H * 1.0001E0 - XEND) * POSNEG >= 0.0E0) { H = XEND - X; LAST = true; } HOPT = H; FACCON = 1.0E0; CFAC = SAFE * (1 + 2 * NIT); NSING = 0; XOLD = X; if (IOUT != 0) { IRTRN = 1; NRSOL = 1; XOSOL = XOLD; XSOL.v = X; for (I = 1; I <= N; I++) { CONT[I + o_cont] = Y[I + o_y]; } NSOLU = N; HSOL.v = HOLD; SOLOUT.Run(NRSOL, XOSOL, XSOL.v, Y, offset_y, CONT, offset_cont, LRC , NSOLU, RPAR[1 + o_rpar], IPAR[1 + o_ipar], IRTRN); if (IRTRN < 0) goto LABEL179; } MLE.v = MLJAC; MUE.v = MUJAC; MBJAC.v = MLJAC + MUJAC + 1; MBB.v = MLMAS + MUMAS + 1; MDIAG.v = MLE.v + MUE.v + 1; MDIFF.v = MLE.v + MUE.v - MUMAS; MBDIAG.v = MUMAS + 1; N2 = 2 * N; N3 = 3 * N; if (ITOL == 0) { for (I = 1; I <= N; I++) { SCAL[I + o_scal] = ATOL[1 + o_atol] + RTOL[1 + o_rtol] * Math.Abs(Y[I + o_y]); } } else { for (I = 1; I <= N; I++) { SCAL[I + o_scal] = ATOL[I + o_atol] + RTOL[I + o_rtol] * Math.Abs(Y[I + o_y]); } } HHFAC = H; FCN.Run(N, X, Y, offset_y, ref Y0, offset_y0, RPAR[1 + o_rpar], IPAR[1 + o_ipar]); NFCN += 1; // C --- BASIC INTEGRATION STEP LABEL10:; // C *** *** *** *** *** *** *** // C COMPUTATION OF THE JACOBIAN // C *** *** *** *** *** *** *** NJAC += 1; if (IJAC == 0) { // C --- COMPUTE JACOBIAN MATRIX NUMERICALLY if (BANDED) { // C --- JACOBIAN IS BANDED MUJACP = MUJAC + 1; MD = Math.Min(MBJAC.v, M2); for (MM = 1; MM <= M1 / M2 + 1; MM++) { for (K = 1; K <= MD; K++) { J = K + (MM - 1) * M2; LABEL12: F1[J + o_f1] = Y[J + o_y]; F2[J + o_f2] = Math.Sqrt(UROUND * Math.Max(1.0E-5, Math.Abs(Y[J + o_y]))); Y[J + o_y] += F2[J + o_f2]; J += MD; if (J <= MM * M2) goto LABEL12; FCN.Run(N, X, Y, offset_y, ref CONT, offset_cont, RPAR[1 + o_rpar], IPAR[1 + o_ipar]); J = K + (MM - 1) * M2; J1 = K; LBEG = Math.Max(1, J1 - MUJAC) + M1; LABEL14: LEND = Math.Min(M2, J1 + MLJAC) + M1; Y[J + o_y] = F1[J + o_f1]; MUJACJ = MUJACP - J1 - M1; FJAC_J = J * LDJAC + o_fjac; for (L = LBEG; L <= LEND; L++) { FJAC[L + MUJACJ + FJAC_J] = (CONT[L + o_cont] - Y0[L + o_y0]) / F2[J + o_f2]; } J += MD; J1 += MD; LBEG = LEND + 1; if (J <= MM * M2) goto LABEL14; } } } else { // C --- JACOBIAN IS FULL for (I = 1; I <= N; I++) { YSAFE = Y[I + o_y]; DELT = Math.Sqrt(UROUND * Math.Max(1.0E-5, Math.Abs(YSAFE))); Y[I + o_y] = YSAFE + DELT; FCN.Run(N, X, Y, offset_y, ref CONT, offset_cont, RPAR[1 + o_rpar], IPAR[1 + o_ipar]); FJAC_I = I * LDJAC + o_fjac; for (J = M1 + 1; J <= N; J++) { FJAC[J - M1 + FJAC_I] = (CONT[J + o_cont] - Y0[J + o_y0]) / DELT; } Y[I + o_y] = YSAFE; } } } else { // C --- COMPUTE JACOBIAN MATRIX ANALYTICALLY JAC.Run(N, X, Y, offset_y, ref FJAC, offset_fjac, LDJAC, RPAR[1 + o_rpar] , IPAR[1 + o_ipar]); } CALJAC = true; CALHES = true; LABEL20:; // C --- COMPUTE THE MATRICES E1 AND E2 AND THEIR DECOMPOSITIONS FAC1 = U1 / H; ALPHN = ALPH / H; BETAN = BETA / H; this._decomr.Run(N, ref FJAC, offset_fjac, LDJAC, FMAS, offset_fmas, LDMAS, MLMAS , MUMAS, M1, M2, NM1, FAC1, ref E1, offset_e1 , LDE1, ref IP1, offset_ip1, ref IER, IJOB, ref CALHES, ref IPHES, offset_iphes); if (IER != 0) goto LABEL78; this._decomc.Run(N, FJAC, offset_fjac, LDJAC, FMAS, offset_fmas, LDMAS, MLMAS , MUMAS, M1, M2, NM1, ALPHN, BETAN , ref E2R, offset_e2r, ref E2I, offset_e2i, LDE1, ref IP2, offset_ip2, ref IER, IJOB); if (IER != 0) goto LABEL78; NDEC += 1; LABEL30:; NSTEP += 1; if (NSTEP > NMAX) goto LABEL178; if (0.1E0 * Math.Abs(H) <= Math.Abs(X) * UROUND) goto LABEL177; if (INDEX2) { for (I = NIND1 + 1; I <= NIND1 + NIND2; I++) { SCAL[I + o_scal] /= HHFAC; } } if (INDEX3) { for (I = NIND1 + NIND2 + 1; I <= NIND1 + NIND2 + NIND3; I++) { SCAL[I + o_scal] = SCAL[I + o_scal] / (HHFAC * HHFAC); } } XPH = X + H; // C *** *** *** *** *** *** *** // C STARTING VALUES FOR NEWTON ITERATION // C *** *** *** *** *** *** *** if (FIRST || STARTN) { for (I = 1; I <= N; I++) { Z1[I + o_z1] = 0.0E0; Z2[I + o_z2] = 0.0E0; Z3[I + o_z3] = 0.0E0; F1[I + o_f1] = 0.0E0; F2[I + o_f2] = 0.0E0; F3[I + o_f3] = 0.0E0; } } else { C3Q = H / HOLD; C1Q = C1 * C3Q; C2Q = C2 * C3Q; for (I = 1; I <= N; I++) { AK1 = CONT[I + N + o_cont]; AK2 = CONT[I + N2 + o_cont]; AK3 = CONT[I + N3 + o_cont]; Z1I = C1Q * (AK1 + (C1Q - C2M1.v) * (AK2 + (C1Q - C1M1.v) * AK3)); Z2I = C2Q * (AK1 + (C2Q - C2M1.v) * (AK2 + (C2Q - C1M1.v) * AK3)); Z3I = C3Q * (AK1 + (C3Q - C2M1.v) * (AK2 + (C3Q - C1M1.v) * AK3)); Z1[I + o_z1] = Z1I; Z2[I + o_z2] = Z2I; Z3[I + o_z3] = Z3I; F1[I + o_f1] = TI11 * Z1I + TI12 * Z2I + TI13 * Z3I; F2[I + o_f2] = TI21 * Z1I + TI22 * Z2I + TI23 * Z3I; F3[I + o_f3] = TI31 * Z1I + TI32 * Z2I + TI33 * Z3I; } } // C *** *** *** *** *** *** *** // C LOOP FOR THE SIMPLIFIED NEWTON ITERATION // C *** *** *** *** *** *** *** NEWT = 0; FACCON = Math.Pow(Math.Max(FACCON, UROUND), 0.8E0); THETA = Math.Abs(THET); LABEL40:; if (NEWT >= NIT) goto LABEL78; // C --- COMPUTE THE RIGHT-HAND SIDE for (I = 1; I <= N; I++) { CONT[I + o_cont] = Y[I + o_y] + Z1[I + o_z1]; } FCN.Run(N, X + C1 * H, CONT, offset_cont, ref Z1, offset_z1, RPAR[1 + o_rpar], IPAR[1 + o_ipar]); for (I = 1; I <= N; I++) { CONT[I + o_cont] = Y[I + o_y] + Z2[I + o_z2]; } FCN.Run(N, X + C2 * H, CONT, offset_cont, ref Z2, offset_z2, RPAR[1 + o_rpar], IPAR[1 + o_ipar]); for (I = 1; I <= N; I++) { CONT[I + o_cont] = Y[I + o_y] + Z3[I + o_z3]; } FCN.Run(N, XPH, CONT, offset_cont, ref Z3, offset_z3, RPAR[1 + o_rpar], IPAR[1 + o_ipar]); NFCN += 3; // C --- SOLVE THE LINEAR SYSTEMS for (I = 1; I <= N; I++) { A1 = Z1[I + o_z1]; A2 = Z2[I + o_z2]; A3 = Z3[I + o_z3]; Z1[I + o_z1] = TI11 * A1 + TI12 * A2 + TI13 * A3; Z2[I + o_z2] = TI21 * A1 + TI22 * A2 + TI23 * A3; Z3[I + o_z3] = TI31 * A1 + TI32 * A2 + TI33 * A3; } this._slvrad.Run(N, FJAC, offset_fjac, LDJAC, MLJAC, MUJAC, FMAS, offset_fmas , LDMAS, MLMAS, MUMAS, M1, M2, NM1 , FAC1, ALPHN, BETAN, E1, offset_e1, E2R, offset_e2r, E2I, offset_e2i , LDE1, ref Z1, offset_z1, ref Z2, offset_z2, ref Z3, offset_z3, F1, offset_f1, F2, offset_f2 , F3, offset_f3, CONT[1 + o_cont], IP1, offset_ip1, IP2, offset_ip2, IPHES, offset_iphes, IER , IJOB); NSOL += 1; NEWT += 1; DYNO = 0.0E0; for (I = 1; I <= N; I++) { DENOM = SCAL[I + o_scal]; DYNO += Math.Pow(Z1[I + o_z1] / DENOM, 2) + Math.Pow(Z2[I + o_z2] / DENOM, 2) + Math.Pow(Z3[I + o_z3] / DENOM, 2); } DYNO = Math.Sqrt(DYNO / N3); // C --- BAD CONVERGENCE OR NUMBER OF ITERATIONS TO LARGE if (NEWT > 1 && NEWT < NIT) { THQ = DYNO / DYNOLD; if (NEWT == 2) { THETA = THQ; } else { THETA = Math.Sqrt(THQ * THQOLD); } THQOLD = THQ; if (THETA < 0.99E0) { FACCON = THETA / (1.0E0 - THETA); DYTH = FACCON * DYNO * Math.Pow(THETA, NIT - 1 - NEWT) / FNEWT; if (DYTH >= 1.0E0) { QNEWT = Math.Max(1.0E-4, Math.Min(20.0E0, DYTH)); HHFAC = .8E0 * Math.Pow(QNEWT, -1.0E0 / (4.0E0 + NIT - 1 - NEWT)); H *= HHFAC; REJECT = true; LAST = false; if (CALJAC) goto LABEL20; goto LABEL10; } } else { goto LABEL78; } } DYNOLD = Math.Max(DYNO, UROUND); for (I = 1; I <= N; I++) { F1I = F1[I + o_f1] + Z1[I + o_z1]; F2I = F2[I + o_f2] + Z2[I + o_z2]; F3I = F3[I + o_f3] + Z3[I + o_z3]; F1[I + o_f1] = F1I; F2[I + o_f2] = F2I; F3[I + o_f3] = F3I; Z1[I + o_z1] = T11 * F1I + T12 * F2I + T13 * F3I; Z2[I + o_z2] = T21 * F1I + T22 * F2I + T23 * F3I; Z3[I + o_z3] = T31 * F1I + F2I; } if (FACCON * DYNO > FNEWT) goto LABEL40; // C --- ERROR ESTIMATION this._estrad.Run(N, FJAC, offset_fjac, LDJAC, MLJAC, MUJAC, FMAS, offset_fmas , LDMAS, MLMAS, MUMAS, H, DD1, DD2 , DD3, FCN, ref NFCN, Y0, offset_y0, Y, offset_y, IJOB , X, M1, M2, NM1, E1, offset_e1, LDE1 , Z1, offset_z1, Z2, offset_z2, Z3, offset_z3, ref CONT, offset_cont, ref F1, offset_f1, ref F2, offset_f2 , IP1, offset_ip1, IPHES, offset_iphes, SCAL, offset_scal, ref ERR, FIRST, REJECT , FAC1, RPAR, offset_rpar, IPAR, offset_ipar); // C --- COMPUTATION OF HNEW // C --- WE REQUIRE .2<=HNEW/H<=8. FAC = Math.Min(SAFE, CFAC / (NEWT + 2 * NIT)); QUOT = Math.Max(FACR, Math.Min(FACL, Math.Pow(ERR, .25E0) / FAC)); HNEW = H / QUOT; // C *** *** *** *** *** *** *** // C IS THE ERROR SMALL ENOUGH ? // C *** *** *** *** *** *** *** if (ERR < 1.0E0) { // C --- STEP IS ACCEPTED FIRST = false; NACCPT += 1; if (PRED) { // C --- PREDICTIVE CONTROLLER OF GUSTAFSSON if (NACCPT > 1) { FACGUS = (HACC / H) * Math.Pow(Math.Pow(ERR, 2) / ERRACC, 0.25E0) / SAFE; FACGUS = Math.Max(FACR, Math.Min(FACL, FACGUS)); QUOT = Math.Max(QUOT, FACGUS); HNEW = H / QUOT; } HACC = H; ERRACC = Math.Max(1.0E-2, ERR); } XOLD = X; HOLD = H; X = XPH; for (I = 1; I <= N; I++) { Y[I + o_y] += Z3[I + o_z3]; Z2I = Z2[I + o_z2]; Z1I = Z1[I + o_z1]; CONT[I + N + o_cont] = (Z2I - Z3[I + o_z3]) / C2M1.v; AK = (Z1I - Z2I) / C1MC2; ACONT3 = Z1I / C1; ACONT3 = (AK - ACONT3) / C2; CONT[I + N2 + o_cont] = (AK - CONT[I + N + o_cont]) / C1M1.v; CONT[I + N3 + o_cont] = CONT[I + N2 + o_cont] - ACONT3; } if (ITOL == 0) { for (I = 1; I <= N; I++) { SCAL[I + o_scal] = ATOL[1 + o_atol] + RTOL[1 + o_rtol] * Math.Abs(Y[I + o_y]); } } else { for (I = 1; I <= N; I++) { SCAL[I + o_scal] = ATOL[I + o_atol] + RTOL[I + o_rtol] * Math.Abs(Y[I + o_y]); } } if (IOUT != 0) { NRSOL = NACCPT + 1; XSOL.v = X; XOSOL = XOLD; for (I = 1; I <= N; I++) { CONT[I + o_cont] = Y[I + o_y]; } NSOLU = N; HSOL.v = HOLD; SOLOUT.Run(NRSOL, XOSOL, XSOL.v, Y, offset_y, CONT, offset_cont, LRC , NSOLU, RPAR[1 + o_rpar], IPAR[1 + o_ipar], IRTRN); if (IRTRN < 0) goto LABEL179; } CALJAC = false; if (LAST) { H = HOPT; IDID = 1; return; } FCN.Run(N, X, Y, offset_y, ref Y0, offset_y0, RPAR[1 + o_rpar], IPAR[1 + o_ipar]); NFCN += 1; HNEW = POSNEG * Math.Min(Math.Abs(HNEW), HMAXN); HOPT = HNEW; HOPT = Math.Min(H, HNEW); if (REJECT) HNEW = POSNEG * Math.Min(Math.Abs(HNEW), Math.Abs(H)); REJECT = false; if ((X + HNEW / QUOT1 - XEND) * POSNEG >= 0.0E0) { H = XEND - X; LAST = true; } else { QT = HNEW / H; HHFAC = H; if (THETA <= THET && QT >= QUOT1 && QT <= QUOT2) goto LABEL30; H = HNEW; } HHFAC = H; if (THETA <= THET) goto LABEL20; goto LABEL10; } else { // C --- STEP IS REJECTED REJECT = true; LAST = false; if (FIRST) { H *= 0.1E0; HHFAC = 0.1E0; } else { HHFAC = HNEW / H; H = HNEW; } if (NACCPT >= 1) NREJCT += 1; if (CALJAC) goto LABEL20; goto LABEL10; } // C --- UNEXPECTED STEP-REJECTION LABEL78:; if (IER != 0) { NSING += 1; if (NSING >= 5) goto LABEL176; } H *= 0.5E0; HHFAC = 0.5E0; REJECT = true; LAST = false; if (CALJAC) goto LABEL20; goto LABEL10; // C --- FAIL EXIT LABEL176:; //ERROR-ERROR WRITE(6,979)X ; //ERROR-ERROR WRITE(6,*) ' MATRIX IS REPEATEDLY SINGULAR, IER=',IER; IDID = -4; return; LABEL177:; //ERROR-ERROR WRITE(6,979)X ; //ERROR-ERROR WRITE(6,*) ' STEP SIZE T0O SMALL, H=',H; IDID = -3; return; LABEL178:; //ERROR-ERROR WRITE(6,979)X ; //ERROR-ERROR WRITE(6,*) ' MORE THAN NMAX =',NMAX,'STEPS ARE NEEDED' ; IDID = -2; return; // C --- EXIT CAUSED BY SOLOUT LABEL179:; //ERROR-ERROR WRITE(6,979)X; IDID = 2; return; #endregion Body }
public void Run(int N, double[] FJAC, int offset_fjac, int LDJAC, int MLJAC, int MUJAC, double[] FMAS, int offset_fmas , int LDMAS, int MLMAS, int MUMAS, double H, double[] DD, int offset_dd, IFVPOL FCN , ref int NFCN, double[] Y0, int offset_y0, double[] Y, int offset_y, int IJOB, double X, int M1 , int M2, int NM1, int NS, int NNS, double[] E1, int offset_e1, int LDE1 , double[] ZZ, int offset_zz, ref double[] CONT, int offset_cont, ref double[] FF, int offset_ff, int[] IP1, int offset_ip1, int[] IPHES, int offset_iphes, double[] SCAL, int offset_scal , ref double ERR, bool FIRST, bool REJECT, double FAC1, double[] RPAR, int offset_rpar, int[] IPAR, int offset_ipar) { #region Implicit Variables double SUM = 0; int K = 0; int I = 0; int MM = 0; double SUM1 = 0; int J = 0; int IM1 = 0; int FJAC_0 = 0; int FJAC_1 = 0; int MP = 0; double ZSAFE = 0; int FJAC_2 = 0; int FJAC_3 = 0; int FJAC_4 = 0; int FJAC_5 = 0; int FJAC_6 = 0; int FJAC_7 = 0; #endregion Implicit Variables #region Array Index Correction int o_fjac = -1 - LDJAC + offset_fjac; int o_fmas = -1 - LDMAS + offset_fmas; int o_dd = -1 + offset_dd; int o_y0 = -1 + offset_y0; int o_y = -1 + offset_y; int o_e1 = -1 - LDE1 + offset_e1; int o_zz = -1 + offset_zz; int o_cont = -1 + offset_cont; int o_ff = -1 + offset_ff; int o_ip1 = -1 + offset_ip1; int o_iphes = -1 + offset_iphes; int o_scal = -1 + offset_scal; int o_rpar = -1 + offset_rpar; int o_ipar = -1 + offset_ipar; #endregion Array Index Correction #region Body switch (IJOB) { case 1: goto LABEL1; case 2: goto LABEL2; case 3: goto LABEL3; case 4: goto LABEL4; case 5: goto LABEL5; case 6: goto LABEL6; case 7: goto LABEL7; case 8: goto LABEL55; case 9: goto LABEL55; case 10: goto LABEL55; case 11: goto LABEL11; case 12: goto LABEL12; case 13: goto LABEL13; case 14: goto LABEL14; case 15: goto LABEL15; } // C LABEL1:; // C ------ B=IDENTITY, JACOBIAN A FULL MATRIX for (I = 1; I <= N; I++) { SUM = 0.0E0; for (K = 1; K <= NS; K++) { SUM += DD[K + o_dd] * ZZ[I + (K - 1) * N + o_zz]; } FF[I + N + o_ff] = SUM / H; CONT[I + o_cont] = FF[I + N + o_ff] + Y0[I + o_y0]; } this._sol.Run(N, LDE1, E1, offset_e1, ref CONT, offset_cont, IP1, offset_ip1); goto LABEL77; // C LABEL11:; // C ------ B=IDENTITY, JACOBIAN A FULL MATRIX, SECOND ORDER for (I = 1; I <= N; I++) { SUM = 0.0E0; for (K = 1; K <= NS; K++) { SUM += DD[K + o_dd] * ZZ[I + (K - 1) * N + o_zz]; } FF[I + N + o_ff] = SUM / H; CONT[I + o_cont] = FF[I + N + o_ff] + Y0[I + o_y0]; } LABEL48: MM = M1 / M2; for (J = 1; J <= M2; J++) { SUM1 = 0.0E0; for (K = MM - 1; K >= 0; K += -1) { SUM1 = (CONT[J + K * M2 + o_cont] + SUM1) / FAC1; FJAC_0 = (J + K * M2) * LDJAC + o_fjac; for (I = 1; I <= NM1; I++) { IM1 = I + M1; CONT[IM1 + o_cont] += FJAC[I + FJAC_0] * SUM1; } } } this._sol.Run(NM1, LDE1, E1, offset_e1, ref CONT, M1 + 1 + o_cont, IP1, offset_ip1); for (I = M1; I >= 1; I += -1) { CONT[I + o_cont] = (CONT[I + o_cont] + CONT[M2 + I + o_cont]) / FAC1; } goto LABEL77; // C LABEL2:; // C ------ B=IDENTITY, JACOBIAN A BANDED MATRIX for (I = 1; I <= N; I++) { SUM = 0.0E0; for (K = 1; K <= NS; K++) { SUM += DD[K + o_dd] * ZZ[I + (K - 1) * N + o_zz]; } FF[I + N + o_ff] = SUM / H; CONT[I + o_cont] = FF[I + N + o_ff] + Y0[I + o_y0]; } this._solb.Run(N, LDE1, E1, offset_e1, MLE.v, MUE.v, ref CONT, offset_cont , IP1, offset_ip1); goto LABEL77; // C LABEL12:; // C ------ B=IDENTITY, JACOBIAN A BANDED MATRIX, SECOND ORDER for (I = 1; I <= N; I++) { SUM = 0.0E0; for (K = 1; K <= NS; K++) { SUM += DD[K + o_dd] * ZZ[I + (K - 1) * N + o_zz]; } FF[I + N + o_ff] = SUM / H; CONT[I + o_cont] = FF[I + N + o_ff] + Y0[I + o_y0]; } LABEL45: MM = M1 / M2; for (J = 1; J <= M2; J++) { SUM1 = 0.0E0; for (K = MM - 1; K >= 0; K += -1) { SUM1 = (CONT[J + K * M2 + o_cont] + SUM1) / FAC1; FJAC_1 = (J + K * M2) * LDJAC + o_fjac; for (I = Math.Max(1, J - MUJAC); I <= Math.Min(NM1, J + MLJAC); I++) { IM1 = I + M1; CONT[IM1 + o_cont] += FJAC[I + MUJAC + 1 - J + FJAC_1] * SUM1; } } } this._solb.Run(NM1, LDE1, E1, offset_e1, MLE.v, MUE.v, ref CONT, M1 + 1 + o_cont , IP1, offset_ip1); for (I = M1; I >= 1; I += -1) { CONT[I + o_cont] = (CONT[I + o_cont] + CONT[M2 + I + o_cont]) / FAC1; } goto LABEL77; // C LABEL3:; // C ------ B IS A BANDED MATRIX, JACOBIAN A FULL MATRIX for (I = 1; I <= N; I++) { SUM = 0.0E0; for (K = 1; K <= NS; K++) { SUM += DD[K + o_dd] * ZZ[I + (K - 1) * N + o_zz]; } FF[I + o_ff] = SUM / H; } for (I = 1; I <= N; I++) { SUM = 0.0E0; for (J = Math.Max(1, I - MLMAS); J <= Math.Min(N, I + MUMAS); J++) { SUM += FMAS[I - J + MBDIAG.v + J * LDMAS + o_fmas] * FF[J + o_ff]; } FF[I + N + o_ff] = SUM; CONT[I + o_cont] = SUM + Y0[I + o_y0]; } this._sol.Run(N, LDE1, E1, offset_e1, ref CONT, offset_cont, IP1, offset_ip1); goto LABEL77; // C LABEL13:; // C ------ B IS A BANDED MATRIX, JACOBIAN A FULL MATRIX, SECOND ORDER for (I = 1; I <= M1; I++) { SUM = 0.0E0; for (K = 1; K <= NS; K++) { SUM += DD[K + o_dd] * ZZ[I + (K - 1) * N + o_zz]; } FF[I + N + o_ff] = SUM / H; CONT[I + o_cont] = FF[I + N + o_ff] + Y0[I + o_y0]; } for (I = M1 + 1; I <= N; I++) { SUM = 0.0E0; for (K = 1; K <= NS; K++) { SUM += DD[K + o_dd] * ZZ[I + (K - 1) * N + o_zz]; } FF[I + o_ff] = SUM / H; } for (I = 1; I <= NM1; I++) { SUM = 0.0E0; for (J = Math.Max(1, I - MLMAS); J <= Math.Min(NM1, I + MUMAS); J++) { SUM += FMAS[I - J + MBDIAG.v + J * LDMAS + o_fmas] * FF[J + M1 + o_ff]; } IM1 = I + M1; FF[IM1 + N + o_ff] = SUM; CONT[IM1 + o_cont] = SUM + Y0[IM1 + o_y0]; } goto LABEL48; // C LABEL4:; // C ------ B IS A BANDED MATRIX, JACOBIAN A BANDED MATRIX for (I = 1; I <= N; I++) { SUM = 0.0E0; for (K = 1; K <= NS; K++) { SUM += DD[K + o_dd] * ZZ[I + (K - 1) * N + o_zz]; } FF[I + o_ff] = SUM / H; } for (I = 1; I <= N; I++) { SUM = 0.0E0; for (J = Math.Max(1, I - MLMAS); J <= Math.Min(N, I + MUMAS); J++) { SUM += FMAS[I - J + MBDIAG.v + J * LDMAS + o_fmas] * FF[J + o_ff]; } FF[I + N + o_ff] = SUM; CONT[I + o_cont] = SUM + Y0[I + o_y0]; } this._solb.Run(N, LDE1, E1, offset_e1, MLE.v, MUE.v, ref CONT, offset_cont , IP1, offset_ip1); goto LABEL77; // C LABEL14:; // C ------ B IS A BANDED MATRIX, JACOBIAN A BANDED MATRIX, SECOND ORDER for (I = 1; I <= M1; I++) { SUM = 0.0E0; for (K = 1; K <= NS; K++) { SUM += DD[K + o_dd] * ZZ[I + (K - 1) * N + o_zz]; } FF[I + N + o_ff] = SUM / H; CONT[I + o_cont] = FF[I + N + o_ff] + Y0[I + o_y0]; } for (I = M1 + 1; I <= N; I++) { SUM = 0.0E0; for (K = 1; K <= NS; K++) { SUM += DD[K + o_dd] * ZZ[I + (K - 1) * N + o_zz]; } FF[I + o_ff] = SUM / H; } for (I = 1; I <= NM1; I++) { SUM = 0.0E0; for (J = Math.Max(1, I - MLMAS); J <= Math.Min(NM1, I + MUMAS); J++) { SUM += FMAS[I - J + MBDIAG.v + J * LDMAS + o_fmas] * FF[J + M1 + o_ff]; } IM1 = I + M1; FF[IM1 + N + o_ff] = SUM; CONT[IM1 + o_cont] = SUM + Y0[IM1 + o_y0]; } goto LABEL45; // C LABEL5:; // C ------ B IS A FULL MATRIX, JACOBIAN A FULL MATRIX for (I = 1; I <= N; I++) { SUM = 0.0E0; for (K = 1; K <= NS; K++) { SUM += DD[K + o_dd] * ZZ[I + (K - 1) * N + o_zz]; } FF[I + o_ff] = SUM / H; } for (I = 1; I <= N; I++) { SUM = 0.0E0; for (J = 1; J <= N; J++) { SUM += FMAS[I + J * LDMAS + o_fmas] * FF[J + o_ff]; } FF[I + N + o_ff] = SUM; CONT[I + o_cont] = SUM + Y0[I + o_y0]; } this._sol.Run(N, LDE1, E1, offset_e1, ref CONT, offset_cont, IP1, offset_ip1); goto LABEL77; // C LABEL15:; // C ------ B IS A BANDED MATRIX, JACOBIAN A FULL MATRIX, SECOND ORDER for (I = 1; I <= M1; I++) { SUM = 0.0E0; for (K = 1; K <= NS; K++) { SUM += DD[K + o_dd] * ZZ[I + (K - 1) * N + o_zz]; } FF[I + N + o_ff] = SUM / H; CONT[I + o_cont] = FF[I + N + o_ff] + Y0[I + o_y0]; } for (I = M1 + 1; I <= N; I++) { SUM = 0.0E0; for (K = 1; K <= NS; K++) { SUM += DD[K + o_dd] * ZZ[I + (K - 1) * N + o_zz]; } FF[I + o_ff] = SUM / H; } for (I = 1; I <= NM1; I++) { SUM = 0.0E0; for (J = 1; J <= NM1; J++) { SUM += FMAS[I + J * LDMAS + o_fmas] * FF[J + M1 + o_ff]; } IM1 = I + M1; FF[IM1 + N + o_ff] = SUM; CONT[IM1 + o_cont] = SUM + Y0[IM1 + o_y0]; } goto LABEL48; // C LABEL6:; // C ------ B IS A FULL MATRIX, JACOBIAN A BANDED MATRIX // C ------ THIS OPTION IS NOT PROVIDED return; // C LABEL7:; // C ------ B=IDENTITY, JACOBIAN A FULL MATRIX, HESSENBERG-OPTION for (I = 1; I <= N; I++) { SUM = 0.0E0; for (K = 1; K <= NS; K++) { SUM += DD[K + o_dd] * ZZ[I + (K - 1) * N + o_zz]; } FF[I + N + o_ff] = SUM / H; CONT[I + o_cont] = FF[I + N + o_ff] + Y0[I + o_y0]; } for (MM = N - 2; MM >= 1; MM += -1) { MP = N - MM; I = IPHES[MP + o_iphes]; if (I == MP) goto LABEL310; ZSAFE = CONT[MP + o_cont]; CONT[MP + o_cont] = CONT[I + o_cont]; CONT[I + o_cont] = ZSAFE; LABEL310:; FJAC_2 = (MP - 1) * LDJAC + o_fjac; for (I = MP + 1; I <= N; I++) { CONT[I + o_cont] += -FJAC[I + FJAC_2] * CONT[MP + o_cont]; } } this._solh.Run(N, LDE1, E1, offset_e1, 1, ref CONT, offset_cont, IP1, offset_ip1); for (MM = 1; MM <= N - 2; MM++) { MP = N - MM; FJAC_3 = (MP - 1) * LDJAC + o_fjac; for (I = MP + 1; I <= N; I++) { CONT[I + o_cont] += FJAC[I + FJAC_3] * CONT[MP + o_cont]; } I = IPHES[MP + o_iphes]; if (I == MP) goto LABEL440; ZSAFE = CONT[MP + o_cont]; CONT[MP + o_cont] = CONT[I + o_cont]; CONT[I + o_cont] = ZSAFE; LABEL440:; } // C // C -------------------------------------- // C LABEL77:; ERR = 0.0E0; for (I = 1; I <= N; I++) { ERR += Math.Pow(CONT[I + o_cont] / SCAL[I + o_scal], 2); } ERR = Math.Max(Math.Sqrt(ERR / N), 1.0E-10); // C if (ERR < 1.0E0) return; if (FIRST || REJECT) { for (I = 1; I <= N; I++) { CONT[I + o_cont] += Y[I + o_y]; } FCN.Run(N, X, CONT, offset_cont, ref FF, offset_ff, RPAR[1 + o_rpar], IPAR[1 + o_ipar]); NFCN += 1; for (I = 1; I <= N; I++) { CONT[I + o_cont] = FF[I + o_ff] + FF[I + N + o_ff]; } switch (IJOB) { case 1: goto LABEL31; case 2: goto LABEL32; case 3: goto LABEL31; case 4: goto LABEL32; case 5: goto LABEL31; case 6: goto LABEL32; case 7: goto LABEL33; case 8: goto LABEL55; case 9: goto LABEL55; case 10: goto LABEL55; case 11: goto LABEL41; case 12: goto LABEL42; case 13: goto LABEL41; case 14: goto LABEL42; case 15: goto LABEL41; } // C ------ FULL MATRIX OPTION LABEL31:; this._sol.Run(N, LDE1, E1, offset_e1, ref CONT, offset_cont, IP1, offset_ip1); goto LABEL88; // C ------ FULL MATRIX OPTION, SECOND ORDER LABEL41:; for (J = 1; J <= M2; J++) { SUM1 = 0.0E0; for (K = MM - 1; K >= 0; K += -1) { SUM1 = (CONT[J + K * M2 + o_cont] + SUM1) / FAC1; FJAC_4 = (J + K * M2) * LDJAC + o_fjac; for (I = 1; I <= NM1; I++) { IM1 = I + M1; CONT[IM1 + o_cont] += FJAC[I + FJAC_4] * SUM1; } } } this._sol.Run(NM1, LDE1, E1, offset_e1, ref CONT, M1 + 1 + o_cont, IP1, offset_ip1); for (I = M1; I >= 1; I += -1) { CONT[I + o_cont] = (CONT[I + o_cont] + CONT[M2 + I + o_cont]) / FAC1; } goto LABEL88; // C ------ BANDED MATRIX OPTION LABEL32:; this._solb.Run(N, LDE1, E1, offset_e1, MLE.v, MUE.v, ref CONT, offset_cont , IP1, offset_ip1); goto LABEL88; // C ------ BANDED MATRIX OPTION, SECOND ORDER LABEL42:; for (J = 1; J <= M2; J++) { SUM1 = 0.0E0; for (K = MM - 1; K >= 0; K += -1) { SUM1 = (CONT[J + K * M2 + o_cont] + SUM1) / FAC1; FJAC_5 = (J + K * M2) * LDJAC + o_fjac; for (I = Math.Max(1, J - MUJAC); I <= Math.Min(NM1, J + MLJAC); I++) { IM1 = I + M1; CONT[IM1 + o_cont] += FJAC[I + MUJAC + 1 - J + FJAC_5] * SUM1; } } } this._solb.Run(NM1, LDE1, E1, offset_e1, MLE.v, MUE.v, ref CONT, M1 + 1 + o_cont , IP1, offset_ip1); for (I = M1; I >= 1; I += -1) { CONT[I + o_cont] = (CONT[I + o_cont] + CONT[M2 + I + o_cont]) / FAC1; } goto LABEL88; // C ------ HESSENBERG MATRIX OPTION LABEL33:; for (MM = N - 2; MM >= 1; MM += -1) { MP = N - MM; I = IPHES[MP + o_iphes]; if (I == MP) goto LABEL510; ZSAFE = CONT[MP + o_cont]; CONT[MP + o_cont] = CONT[I + o_cont]; CONT[I + o_cont] = ZSAFE; LABEL510:; FJAC_6 = (MP - 1) * LDJAC + o_fjac; for (I = MP + 1; I <= N; I++) { CONT[I + o_cont] += -FJAC[I + FJAC_6] * CONT[MP + o_cont]; } } this._solh.Run(N, LDE1, E1, offset_e1, 1, ref CONT, offset_cont, IP1, offset_ip1); for (MM = 1; MM <= N - 2; MM++) { MP = N - MM; FJAC_7 = (MP - 1) * LDJAC + o_fjac; for (I = MP + 1; I <= N; I++) { CONT[I + o_cont] += FJAC[I + FJAC_7] * CONT[MP + o_cont]; } I = IPHES[MP + o_iphes]; if (I == MP) goto LABEL640; ZSAFE = CONT[MP + o_cont]; CONT[MP + o_cont] = CONT[I + o_cont]; CONT[I + o_cont] = ZSAFE; LABEL640:; } // C ----------------------------------- LABEL88:; ERR = 0.0E0; for (I = 1; I <= N; I++) { ERR += Math.Pow(CONT[I + o_cont] / SCAL[I + o_scal], 2); } ERR = Math.Max(Math.Sqrt(ERR / N), 1.0E-10); } return; // C // C ----------------------------------------------------------- // C LABEL55:; return; #endregion Body }