int main(int argc, char** argv)
{
realtype **a = newDenseMat(NROWS, NCOLS);
realtype **b = newDenseMat(NROWS, NCOLS);
sundials_ml_index p[NROWS] = { 0.0 };
realtype s[NROWS] = { 5.0, 18.0, 6.0 };
int i, j;
for (i=0; i < NROWS; ++i) {
for (j=0; j < NCOLS; ++j) {
a[j][i] = a_init[i][j];
}
}
printf("initially: a=\n");
print_mat(a, NROWS, NCOLS);
printf("\n");
#if SUNDIALS_LIB_VERSION >= 260
{
realtype x[NCOLS] = { 1.0, 2.0, 3.0 };
realtype y[NROWS] = { 0.0 };
printf("matvec: y=\n");
denseMatvec(a, x, y, NROWS, NCOLS);
print_vec(y, NROWS);
printf("\n");
}
#endif
denseCopy(a, b, NROWS, NCOLS);
denseScale(2.0, b, NROWS, NCOLS);
printf("scale copy x2: b=\n");
print_mat(b, NROWS, NCOLS);
printf("\n");
denseAddIdentity(b, NROWS);
printf("add identity: b=\n");
print_mat(b, NROWS, NCOLS);
printf("\n");
denseGETRF(a, NROWS, NCOLS, p);
printf("getrf: a=\n");
print_mat(a, NROWS, NCOLS);
printf("\n p=\n");
print_pivots(p, NROWS);
printf("\n");
denseGETRS(a, NROWS, p, s);
printf("getrs: s=\n");
print_vec(s, NROWS);
destroyMat(a);
destroyMat(b);
return 0;
}
CAMLprim value c_arraydensematrix_scale(value vc, value va)
{
CAMLparam2(vc, va);
struct caml_ba_array *ba = ARRAY2_DATA(va);
intnat m = ba->dim[1];
intnat n = ba->dim[0];
denseScale(Double_val(vc), ARRAY2_ACOLS(va), m, n);
CAMLreturn (Val_unit);
}
void DenseScale(realtype c, DlsMat A)
{
denseScale(c, A->cols, A->M, A->N);
}
static int Precond(realtype tn, N_Vector u, N_Vector fu,
booleantype jok, booleantype *jcurPtr, realtype gamma,
void *user_data, N_Vector vtemp1, N_Vector vtemp2,
N_Vector vtemp3)
{
realtype c1, c2, cydn, cyup, diag, ydn, yup, q4coef, dely, verdco, hordco;
realtype **(*P)[MY], **(*Jbd)[MY];
long int *(*pivot)[MY], ier;
int jx, jy;
realtype *udata, **a, **j;
UserData data;
/* Make local copies of pointers in user_data, and of pointer to u's data */
data = (UserData) user_data;
P = data->P;
Jbd = data->Jbd;
pivot = data->pivot;
udata = N_VGetArrayPointer_Serial(u);
if (jok) {
/* jok = TRUE: Copy Jbd to P */
for (jy=0; jy < MY; jy++)
for (jx=0; jx < MX; jx++)
denseCopy(Jbd[jx][jy], P[jx][jy], NUM_SPECIES, NUM_SPECIES);
*jcurPtr = FALSE;
}
else {
/* jok = FALSE: Generate Jbd from scratch and copy to P */
/* Make local copies of problem variables, for efficiency. */
q4coef = data->q4;
dely = data->dy;
verdco = data->vdco;
hordco = data->hdco;
/* Compute 2x2 diagonal Jacobian blocks (using q4 values
computed on the last f call). Load into P. */
for (jy=0; jy < MY; jy++) {
ydn = YMIN + (jy - RCONST(0.5))*dely;
yup = ydn + dely;
cydn = verdco*SUNRexp(RCONST(0.2)*ydn);
cyup = verdco*SUNRexp(RCONST(0.2)*yup);
diag = -(cydn + cyup + TWO*hordco);
for (jx=0; jx < MX; jx++) {
c1 = IJKth(udata,1,jx,jy);
c2 = IJKth(udata,2,jx,jy);
j = Jbd[jx][jy];
a = P[jx][jy];
IJth(j,1,1) = (-Q1*C3 - Q2*c2) + diag;
IJth(j,1,2) = -Q2*c1 + q4coef;
IJth(j,2,1) = Q1*C3 - Q2*c2;
IJth(j,2,2) = (-Q2*c1 - q4coef) + diag;
denseCopy(j, a, NUM_SPECIES, NUM_SPECIES);
}
}
*jcurPtr = TRUE;
}
/* Scale by -gamma */
for (jy=0; jy < MY; jy++)
for (jx=0; jx < MX; jx++)
denseScale(-gamma, P[jx][jy], NUM_SPECIES, NUM_SPECIES);
/* Add identity matrix and do LU decompositions on blocks in place. */
for (jx=0; jx < MX; jx++) {
for (jy=0; jy < MY; jy++) {
denseAddIdentity(P[jx][jy], NUM_SPECIES);
ier = denseGETRF(P[jx][jy], NUM_SPECIES, NUM_SPECIES, pivot[jx][jy]);
if (ier != 0) return(1);
}
}
return(0);
}
static int Precond(realtype tn, N_Vector u, N_Vector fu,
booleantype jok, booleantype *jcurPtr,
realtype gamma, void *user_data,
N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3)
{
realtype c1, c2, cydn, cyup, diag, ydn, yup, q4coef, dely, verdco, hordco;
realtype **(*P)[MYSUB], **(*Jbd)[MYSUB];
int nvmxsub, ier, offset;
long int *(*pivot)[MYSUB];
int lx, ly, jy, isuby;
realtype *udata, **a, **j;
HYPRE_ParVector uhyp;
UserData data;
/* Make local copies of pointers in user_data, pointer to u's data,
and PE index pair */
data = (UserData) user_data;
P = data->P;
Jbd = data->Jbd;
pivot = data->pivot;
isuby = data->isuby;
nvmxsub = data->nvmxsub;
uhyp = N_VGetVector_ParHyp(u);
udata = hypre_VectorData(hypre_ParVectorLocalVector(uhyp));
if (jok) {
/* jok = TRUE: Copy Jbd to P */
for (ly = 0; ly < MYSUB; ly++)
for (lx = 0; lx < MXSUB; lx++)
denseCopy(Jbd[lx][ly], P[lx][ly], NVARS, NVARS);
*jcurPtr = FALSE;
}
else {
/* jok = FALSE: Generate Jbd from scratch and copy to P */
/* Make local copies of problem variables, for efficiency */
q4coef = data->q4;
dely = data->dy;
verdco = data->vdco;
hordco = data->hdco;
/* Compute 2x2 diagonal Jacobian blocks (using q4 values
c*omputed on the last f call). Load into P. */
for (ly = 0; ly < MYSUB; ly++) {
jy = ly + isuby*MYSUB;
ydn = YMIN + (jy - RCONST(0.5))*dely;
yup = ydn + dely;
cydn = verdco*SUNRexp(RCONST(0.2)*ydn);
cyup = verdco*SUNRexp(RCONST(0.2)*yup);
diag = -(cydn + cyup + RCONST(2.0)*hordco);
for (lx = 0; lx < MXSUB; lx++) {
offset = lx*NVARS + ly*nvmxsub;
c1 = udata[offset];
c2 = udata[offset+1];
j = Jbd[lx][ly];
a = P[lx][ly];
IJth(j,1,1) = (-Q1*C3 - Q2*c2) + diag;
IJth(j,1,2) = -Q2*c1 + q4coef;
IJth(j,2,1) = Q1*C3 - Q2*c2;
IJth(j,2,2) = (-Q2*c1 - q4coef) + diag;
denseCopy(j, a, NVARS, NVARS);
}
}
*jcurPtr = TRUE;
}
/* Scale by -gamma */
for (ly = 0; ly < MYSUB; ly++)
for (lx = 0; lx < MXSUB; lx++)
denseScale(-gamma, P[lx][ly], NVARS, NVARS);
/* Add identity matrix and do LU decompositions on blocks in place */
for (lx = 0; lx < MXSUB; lx++) {
for (ly = 0; ly < MYSUB; ly++) {
denseAddIdentity(P[lx][ly], NVARS);
ier = denseGETRF(P[lx][ly], NVARS, NVARS, pivot[lx][ly]);
if (ier != 0) return(1);
}
}
return(0);
}
static int Precond(realtype tn, N_Vector y, N_Vector fy, booleantype jok,
booleantype *jcurPtr, realtype gamma, void *user_data,
N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3)
{
realtype c1, c2, czdn, czup, diag, zdn, zup, q4coef, delz, verdco, hordco;
realtype **(*P)[MZ], **(*Jbd)[MZ];
long int *(*pivot)[MZ];
int ier, jx, jz;
realtype *ydata, **a, **j;
UserData data;
realtype Q1, Q2, C3, A3, A4, KH, VEL, KV0;
/* Make local copies of pointers in user_data, and of pointer to y's data */
data = (UserData) user_data;
P = data->P;
Jbd = data->Jbd;
pivot = data->pivot;
ydata = NV_DATA_S(y);
/* Load problem coefficients and parameters */
Q1 = data->p[0];
Q2 = data->p[1];
C3 = data->p[2];
A3 = data->p[3];
A4 = data->p[4];
KH = data->p[5];
VEL = data->p[6];
KV0 = data->p[7];
if (jok) {
/* jok = TRUE: Copy Jbd to P */
for (jz=0; jz < MZ; jz++)
for (jx=0; jx < MX; jx++)
denseCopy(Jbd[jx][jz], P[jx][jz], NUM_SPECIES, NUM_SPECIES);
*jcurPtr = FALSE;
}
else {
/* jok = FALSE: Generate Jbd from scratch and copy to P */
/* Make local copies of problem variables, for efficiency. */
q4coef = data->q4;
delz = data->dz;
verdco = data->vdco;
hordco = data->hdco;
/* Compute 2x2 diagonal Jacobian blocks (using q4 values
computed on the last f call). Load into P. */
for (jz=0; jz < MZ; jz++) {
zdn = ZMIN + (jz - RCONST(0.5))*delz;
zup = zdn + delz;
czdn = verdco*EXP(RCONST(0.2)*zdn);
czup = verdco*EXP(RCONST(0.2)*zup);
diag = -(czdn + czup + RCONST(2.0)*hordco);
for (jx=0; jx < MX; jx++) {
c1 = IJKth(ydata,1,jx,jz);
c2 = IJKth(ydata,2,jx,jz);
j = Jbd[jx][jz];
a = P[jx][jz];
IJth(j,1,1) = (-Q1*C3 - Q2*c2) + diag;
IJth(j,1,2) = -Q2*c1 + q4coef;
IJth(j,2,1) = Q1*C3 - Q2*c2;
IJth(j,2,2) = (-Q2*c1 - q4coef) + diag;
denseCopy(j, a, NUM_SPECIES, NUM_SPECIES);
}
}
*jcurPtr = TRUE;
}
/* Scale by -gamma */
for (jz=0; jz < MZ; jz++)
for (jx=0; jx < MX; jx++)
denseScale(-gamma, P[jx][jz], NUM_SPECIES, NUM_SPECIES);
/* Add identity matrix and do LU decompositions on blocks in place. */
for (jx=0; jx < MX; jx++) {
for (jz=0; jz < MZ; jz++) {
denseAddIdentity(P[jx][jz], NUM_SPECIES);
ier = denseGETRF(P[jx][jz], NUM_SPECIES, NUM_SPECIES, pivot[jx][jz]);
if (ier != 0) return(1);
}
}
return(0);
}
