static int Precond(realtype tn, N_Vector y, N_Vector fy, booleantype jok, booleantype *jcurPtr, realtype gamma, void *P_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 P_data, and of pointer to y's data */ data = (UserData) P_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++) dencopy(Jbd[jx][jz], P[jx][jz], 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; dencopy(j, a, NUM_SPECIES); } } *jcurPtr = TRUE; } /* Scale by -gamma */ for (jz=0; jz < MZ; jz++) for (jx=0; jx < MX; jx++) denscale(-gamma, P[jx][jz], 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++) { denaddI(P[jx][jz], NUM_SPECIES); ier = gefa(P[jx][jz], NUM_SPECIES, pivot[jx][jz]); if (ier != 0) return(1); } } return(0); }
/* Preconditioner setup routine. Generate and preprocess P. */ static int Precond(realtype tn, N_Vector u, N_Vector fu, booleantype jok, booleantype *jcurPtr, realtype gamma, void *P_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]; long int nvmxsub, *(*pivot)[MYSUB], ier, offset; int lx, ly, jx, jy, isubx, isuby; realtype *udata, **a, **j; PreconData predata; UserData data; /* Make local copies of pointers in P_data, pointer to u's data, and PE index pair */ predata = (PreconData) P_data; data = (UserData) (predata->f_data); P = predata->P; Jbd = predata->Jbd; pivot = predata->pivot; udata = NV_DATA_P(u); isubx = data->isubx; isuby = data->isuby; nvmxsub = data->nvmxsub; if (jok) { /* jok = TRUE: Copy Jbd to P */ for (ly = 0; ly < MYSUB; ly++) for (lx = 0; lx < MXSUB; lx++) dencopy(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 computed 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*EXP(RCONST(0.2)*ydn); cyup = verdco*EXP(RCONST(0.2)*yup); diag = -(cydn + cyup + RCONST(2.0)*hordco); for (lx = 0; lx < MXSUB; lx++) { jx = lx + isubx*MXSUB; 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; dencopy(j, a, NVARS, NVARS); } } *jcurPtr = TRUE; } /* Scale by -gamma */ for (ly = 0; ly < MYSUB; ly++) for (lx = 0; lx < MXSUB; lx++) denscale(-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++) { denaddI(P[lx][ly], NVARS); ier = denGETRF(P[lx][ly], NVARS, NVARS, pivot[lx][ly]); 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 *P_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 P_data, and of pointer to u's data */ data = (UserData) P_data; P = data->P; Jbd = data->Jbd; pivot = data->pivot; udata = NV_DATA_S(u); if (jok) { /* jok = TRUE: Copy Jbd to P */ for (jy=0; jy < MY; jy++) for (jx=0; jx < MX; jx++) dencopy(Jbd[jx][jy], P[jx][jy], 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*exp(RCONST(0.2)*ydn); cyup = verdco*exp(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; dencopy(j, a, NUM_SPECIES); } } *jcurPtr = TRUE; } /* Scale by -gamma */ for (jy=0; jy < MY; jy++) for (jx=0; jx < MX; jx++) denscale(-gamma, P[jx][jy], 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++) { denaddI(P[jx][jy], NUM_SPECIES); ier = gefa(P[jx][jy], NUM_SPECIES, pivot[jx][jy]); if (ier != 0) return(1); } } return(0); }
void DenseScale(real c, DenseMat A) { denscale(c, A->data, A->size); }