/// <param name="Y">
/// = Vector containing predicted values on entry.
///</param>
/// <param name="YH">
/// = The Nordsieck array, an LDYH by LMAX array, input.
///</param>
/// <param name="LDYH">
/// = A constant .ge. N, the first dimension of YH, input.
///</param>
/// <param name="EWT">
/// = An error weight vector of length N.
///</param>
/// <param name="SAVF">
/// = Array containing f evaluated at predicted y, input.
///</param>
/// <param name="WM">
/// = Real work space for matrices. In the output, it containS
/// the inverse diagonal matrix if MITER = 3 and the LU
/// decomposition of P if MITER is 1, 2 , 4, or 5.
/// Storage of matrix elements starts at WM(3).
/// Storage of the saved Jacobian starts at WM(LOCJS).
/// WM also contains the following matrix-related data:
/// WM(1) = SQRT(UROUND), used in numerical Jacobian step.
/// WM(2) = H*RL1, saved for later use if MITER = 3.
///</param>
/// <param name="IWM">
/// = Integer work space containing pivot information,
/// starting at IWM(31), if MITER is 1, 2, 4, or 5.
/// IWM also contains band parameters ML = IWM(1) and
/// MU = IWM(2) if MITER is 4 or 5.
///</param>
/// <param name="F">
/// = Dummy name for the user supplied subroutine for f.
///</param>
/// <param name="JAC">
/// = Dummy name for the user supplied Jacobian subroutine.
///</param>
/// <param name="IERPJ">
/// = Output error flag, = 0 if no trouble, 1 if the P
/// matrix is found to be singular.
///</param>
public void Run(ref double[] Y, int offset_y, double[] YH, int offset_yh, int LDYH, double[] EWT, int offset_ewt, ref double[] FTEM, int offset_ftem, double[] SAVF, int offset_savf
, ref double[] WM, int offset_wm, ref int[] IWM, int offset_iwm, IFEX F, IJEX JAC, ref int IERPJ, double[] RPAR, int offset_rpar
, int[] IPAR, int offset_ipar)
{
#region Variables
double CON = 0; double DI = 0; double FAC = 0; double HRL1 = 0; double R = 0; double R0 = 0; double SRUR = 0;
double YI = 0; double YJ = 0; double YJJ = 0; int I = 0; int I1 = 0; int I2 = 0; int IER = 0; int II = 0; int J = 0;
int J1 = 0; int JJ = 0; int JOK = 0; int LENP = 0; int MBA = 0; int MBAND = 0; int MEB1 = 0; int MEBAND = 0;
int ML = 0; int ML3 = 0; int MU = 0; int NP1 = 0;
#endregion Variables
#region Implicit Variables
int YH_2 = 0; int YH_1 = 0;
#endregion Implicit Variables
#region Array Index Correction
int o_y = -1 + offset_y; int o_yh = -1 - LDYH + offset_yh; int o_ewt = -1 + offset_ewt;
int o_ftem = -1 + offset_ftem; int o_savf = -1 + offset_savf; int o_wm = -1 + offset_wm;
int o_iwm = -1 + offset_iwm; int o_rpar = -1 + offset_rpar; int o_ipar = -1 + offset_ipar;
#endregion Array Index Correction
#region Prolog
// C-----------------------------------------------------------------------
// C Call sequence input -- Y, YH, LDYH, EWT, FTEM, SAVF, WM, IWM,
// C F, JAC, RPAR, IPAR
// C Call sequence output -- WM, IWM, IERPJ
// C COMMON block variables accessed:
// C /DVOD01/ CCMXJ, DRC, H, RL1, TN, UROUND, ICF, JCUR, LOCJS,
// C MITER, MSBJ, N, NSLJ
// C /DVOD02/ NFE, NST, NJE, NLU
// C
// C Subroutines called by DVJAC: F, JAC, DACOPY, DCOPY, DGBFA, DGEFA,
// C DSCAL
// C Function routines called by DVJAC: DVNORM
// C-----------------------------------------------------------------------
// C DVJAC is called by DVNLSD to compute and process the matrix
// C P = I - h*rl1*J , where J is an approximation to the Jacobian.
// C Here J is computed by the user-supplied routine JAC if
// C MITER = 1 or 4, or by finite differencing if MITER = 2, 3, or 5.
// C If MITER = 3, a diagonal approximation to J is used.
// C If JSV = -1, J is computed from scratch in all cases.
// C If JSV = 1 and MITER = 1, 2, 4, or 5, and if the saved value of J is
// C considered acceptable, then P is constructed from the saved J.
// C J is stored in wm and replaced by P. If MITER .ne. 3, P is then
// C subjected to LU decomposition in preparation for later solution
// C of linear systems with P as coefficient matrix. This is done
// C by DGEFA if MITER = 1 or 2, and by DGBFA if MITER = 4 or 5.
// C
// C Communication with DVJAC is done with the following variables. (For
// C more details, please see the comments in the driver subroutine.)
// C Y = Vector containing predicted values on entry.
// C YH = The Nordsieck array, an LDYH by LMAX array, input.
// C LDYH = A constant .ge. N, the first dimension of YH, input.
// C EWT = An error weight vector of length N.
// C SAVF = Array containing f evaluated at predicted y, input.
// C WM = Real work space for matrices. In the output, it containS
// C the inverse diagonal matrix if MITER = 3 and the LU
// C decomposition of P if MITER is 1, 2 , 4, or 5.
// C Storage of matrix elements starts at WM(3).
// C Storage of the saved Jacobian starts at WM(LOCJS).
// C WM also contains the following matrix-related data:
// C WM(1) = SQRT(UROUND), used in numerical Jacobian step.
// C WM(2) = H*RL1, saved for later use if MITER = 3.
// C IWM = Integer work space containing pivot information,
// C starting at IWM(31), if MITER is 1, 2, 4, or 5.
// C IWM also contains band parameters ML = IWM(1) and
// C MU = IWM(2) if MITER is 4 or 5.
// C F = Dummy name for the user supplied subroutine for f.
// C JAC = Dummy name for the user supplied Jacobian subroutine.
// C RPAR, IPAR = Dummy names for user's real and integer work arrays.
// C RL1 = 1/EL(2) (input).
// C IERPJ = Output error flag, = 0 if no trouble, 1 if the P
// C matrix is found to be singular.
// C JCUR = Output flag to indicate whether the Jacobian matrix
// C (or approximation) is now current.
// C JCUR = 0 means J is not current.
// C JCUR = 1 means J is current.
// C-----------------------------------------------------------------------
// C
// C Type declarations for labeled COMMON block DVOD01 --------------------
// C
// C
// C Type declarations for labeled COMMON block DVOD02 --------------------
// C
// C
// C Type declarations for local variables --------------------------------
// C
// C
// C Type declaration for function subroutines called ---------------------
// C
// C-----------------------------------------------------------------------
// C The following Fortran-77 declaration is to cause the values of the
// C listed (local) variables to be saved between calls to this subroutine.
// C-----------------------------------------------------------------------
// C-----------------------------------------------------------------------
// C
// C
#endregion Prolog
#region Body
IERPJ = 0;
HRL1 = H.v * RL1.v;
// C See whether J should be evaluated (JOK = -1) or not (JOK = 1). -------
JOK = JSV.v;
if (JSV.v == 1)
{
if (NST.v == 0 || NST.v > NSLJ.v + MSBJ.v) JOK = -1;
if (ICF.v == 1 && DRC.v < CCMXJ.v) JOK = -1;
if (ICF.v == 2) JOK = -1;
}
// C End of setting JOK. --------------------------------------------------
// C
if (JOK == -1 && MITER.v == 1)
{
// C If JOK = -1 and MITER = 1, call JAC to evaluate Jacobian. ------------
NJE.v += 1;
NSLJ.v = NST.v;
JCUR.v = 1;
LENP = N.v * N.v;
for (I = 1; I <= LENP; I++)
{
WM[I + 2 + o_wm] = ZERO;
}
JAC.Run(N.v, TN.v, Y, offset_y, 0, 0, ref WM, 3 + o_wm
, N.v, RPAR[1 + o_rpar], IPAR[1 + o_ipar]);
if (JSV.v == 1) this._dcopy.Run(LENP, WM, 3 + o_wm, 1, ref WM, LOCJS.v + o_wm, 1);
}
// C
if (JOK == -1 && MITER.v == 2)
{
// C If MITER = 2, make N calls to F to approximate the Jacobian. ---------
NJE.v += 1;
NSLJ.v = NST.v;
JCUR.v = 1;
FAC = this._dvnorm.Run(N.v, SAVF, offset_savf, EWT, offset_ewt);
R0 = THOU * Math.Abs(H.v) * UROUND.v * Convert.ToSingle(N.v) * FAC;
if (R0 == ZERO) R0 = ONE;
SRUR = WM[1 + o_wm];
J1 = 2;
for (J = 1; J <= N.v; J++)
{
YJ = Y[J + o_y];
R = Math.Max(SRUR * Math.Abs(YJ), R0 / EWT[J + o_ewt]);
Y[J + o_y] += R;
FAC = ONE / R;
F.Run(N.v, TN.v, Y, offset_y, ref FTEM, offset_ftem, RPAR[1 + o_rpar], IPAR[1 + o_ipar]);
for (I = 1; I <= N.v; I++)
{
WM[I + J1 + o_wm] = (FTEM[I + o_ftem] - SAVF[I + o_savf]) * FAC;
}
Y[J + o_y] = YJ;
J1 += N.v;
}
NFE.v += N.v;
LENP = N.v * N.v;
if (JSV.v == 1) this._dcopy.Run(LENP, WM, 3 + o_wm, 1, ref WM, LOCJS.v + o_wm, 1);
}
// C
if (JOK == 1 && (MITER.v == 1 || MITER.v == 2))
{
JCUR.v = 0;
LENP = N.v * N.v;
this._dcopy.Run(LENP, WM, LOCJS.v + o_wm, 1, ref WM, 3 + o_wm, 1);
}
// C
if (MITER.v == 1 || MITER.v == 2)
{
// C Multiply Jacobian by scalar, add identity, and do LU decomposition. --
CON = -HRL1;
this._dscal.Run(LENP, CON, ref WM, 3 + o_wm, 1);
J = 3;
NP1 = N.v + 1;
for (I = 1; I <= N.v; I++)
{
WM[J + o_wm] += ONE;
J += NP1;
}
NLU.v += 1;
this._dgefa.Run(ref WM, 3 + o_wm, N.v, N.v, ref IWM, 31 + o_iwm, ref IER);
if (IER != 0) IERPJ = 1;
return;
}
// C End of code block for MITER = 1 or 2. --------------------------------
// C
if (MITER.v == 3)
{
// C If MITER = 3, construct a diagonal approximation to J and P. ---------
NJE.v += 1;
JCUR.v = 1;
WM[2 + o_wm] = HRL1;
R = RL1.v * PT1;
for (I = 1; I <= N.v; I++)
{
Y[I + o_y] += R * (H.v * SAVF[I + o_savf] - YH[I + 2 * LDYH + o_yh]);
}
F.Run(N.v, TN.v, Y, offset_y, ref WM, 3 + o_wm, RPAR[1 + o_rpar], IPAR[1 + o_ipar]);
NFE.v += 1;
YH_2 = 2 * LDYH + o_yh;
for (I = 1; I <= N.v; I++)
{
R0 = H.v * SAVF[I + o_savf] - YH[I + YH_2];
DI = PT1 * R0 - H.v * (WM[I + 2 + o_wm] - SAVF[I + o_savf]);
WM[I + 2 + o_wm] = ONE;
if (Math.Abs(R0) < UROUND.v / EWT[I + o_ewt]) goto LABEL320;
if (Math.Abs(DI) == ZERO) goto LABEL330;
WM[I + 2 + o_wm] = PT1 * R0 / DI;
LABEL320:;
}
return;
LABEL330: IERPJ = 1;
return;
}
// C End of code block for MITER = 3. -------------------------------------
// C
// C Set constants for MITER = 4 or 5. ------------------------------------
ML = IWM[1 + o_iwm];
MU = IWM[2 + o_iwm];
ML3 = ML + 3;
MBAND = ML + MU + 1;
MEBAND = MBAND + ML;
LENP = MEBAND * N.v;
// C
if (JOK == -1 && MITER.v == 4)
{
// C If JOK = -1 and MITER = 4, call JAC to evaluate Jacobian. ------------
NJE.v += 1;
NSLJ.v = NST.v;
JCUR.v = 1;
for (I = 1; I <= LENP; I++)
{
WM[I + 2 + o_wm] = ZERO;
}
JAC.Run(N.v, TN.v, Y, offset_y, ML, MU, ref WM, ML3 + o_wm
, MEBAND, RPAR[1 + o_rpar], IPAR[1 + o_ipar]);
if (JSV.v == 1) this._dacopy.Run(MBAND, N.v, WM, ML3 + o_wm, MEBAND, ref WM, LOCJS.v + o_wm, MBAND);
}
// C
if (JOK == -1 && MITER.v == 5)
{
// C If MITER = 5, make ML+MU+1 calls to F to approximate the Jacobian. ---
NJE.v += 1;
NSLJ.v = NST.v;
JCUR.v = 1;
MBA = Math.Min(MBAND, N.v);
MEB1 = MEBAND - 1;
SRUR = WM[1 + o_wm];
FAC = this._dvnorm.Run(N.v, SAVF, offset_savf, EWT, offset_ewt);
R0 = THOU * Math.Abs(H.v) * UROUND.v * Convert.ToSingle(N.v) * FAC;
if (R0 == ZERO) R0 = ONE;
for (J = 1; J <= MBA; J++)
{
for (I = J; (MBAND >= 0) ? (I <= N.v) : (I >= N.v); I += MBAND)
{
YI = Y[I + o_y];
R = Math.Max(SRUR * Math.Abs(YI), R0 / EWT[I + o_ewt]);
Y[I + o_y] += R;
}
F.Run(N.v, TN.v, Y, offset_y, ref FTEM, offset_ftem, RPAR[1 + o_rpar], IPAR[1 + o_ipar]);
YH_1 = 1 * LDYH + o_yh;
for (JJ = J; (MBAND >= 0) ? (JJ <= N.v) : (JJ >= N.v); JJ += MBAND)
{
Y[JJ + o_y] = YH[JJ + YH_1];
YJJ = Y[JJ + o_y];
R = Math.Max(SRUR * Math.Abs(YJJ), R0 / EWT[JJ + o_ewt]);
FAC = ONE / R;
I1 = Math.Max(JJ - MU, 1);
I2 = Math.Min(JJ + ML, N.v);
II = JJ * MEB1 - ML + 2;
for (I = I1; I <= I2; I++)
{
WM[II + I + o_wm] = (FTEM[I + o_ftem] - SAVF[I + o_savf]) * FAC;
}
}
}
NFE.v += MBA;
if (JSV.v == 1) this._dacopy.Run(MBAND, N.v, WM, ML3 + o_wm, MEBAND, ref WM, LOCJS.v + o_wm, MBAND);
}
// C
if (JOK == 1)
{
JCUR.v = 0;
this._dacopy.Run(MBAND, N.v, WM, LOCJS.v + o_wm, MBAND, ref WM, ML3 + o_wm, MEBAND);
}
// C
// C Multiply Jacobian by scalar, add identity, and do LU decomposition.
CON = -HRL1;
this._dscal.Run(LENP, CON, ref WM, 3 + o_wm, 1);
II = MBAND + 2;
for (I = 1; I <= N.v; I++)
{
WM[II + o_wm] += ONE;
II += MEBAND;
}
NLU.v += 1;
this._dgbfa.Run(ref WM, 3 + o_wm, MEBAND, N.v, ML, MU, ref IWM, 31 + o_iwm
, ref IER);
if (IER != 0) IERPJ = 1;
return;
// C End of code block for MITER = 4 or 5. --------------------------------
// C
// C----------------------- End of Subroutine DVJAC -----------------------
#endregion Body
}
