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
}