static void Jac2(long int N, long int mu, long int ml, BandMat J, realtype tn, N_Vector y, N_Vector fy, void *jac_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { long int i, j, k; realtype *kthCol; /* The components of f(t,y) which depend on y are i,j f , f , and f : i,j i+1,j i,j+1 f = -2 y + alpha1 * y + alpha2 * y i,j i,j i-1,j i,j-1 f = -2 y + alpha1 * y + alpha2 * y i+1,j i+1,j i,j i+1,j-1 f = -2 y + alpha1 * y + alpha2 * y i,j+1 i,j+1 i-1,j+1 i,j */ for (j=0; j < P2_MESHY; j++) { for (i=0; i < P2_MESHX; i++) { k = i + j * P2_MESHX; kthCol = BAND_COL(J,k); BAND_COL_ELEM(kthCol,k,k) = -TWO; if (i != P2_MESHX-1) BAND_COL_ELEM(kthCol,k+1,k) = P2_ALPH1; if (j != P2_MESHY-1) BAND_COL_ELEM(kthCol,k+P2_MESHX,k) = P2_ALPH2; } } }
static void PVBBDDQJac(integer Nlocal, integer mudq, integer mldq, integer mukeep, integer mlkeep, real rely, PVLocalFn gloc, PVCommFn cfn, BandMat J, void *f_data, real t, N_Vector y, N_Vector ewt, real h, real uround, N_Vector gy, N_Vector gtemp, N_Vector ytemp) { real gnorm, minInc, inc, inc_inv; integer group, i, j, width, ngroups, i1, i2; real *y_data, *ewt_data, *gy_data, *gtemp_data, *ytemp_data, *col_j; /* Obtain pointers to the data for all vectors */ y_data = N_VDATA(y); ewt_data = N_VDATA(ewt); gy_data = N_VDATA(gy); gtemp_data = N_VDATA(gtemp); ytemp_data = N_VDATA(ytemp); /* Load ytemp with y = predicted solution vector */ N_VScale(ONE, y, ytemp); /* Call cfn and gloc to get base value of g(t,y) */ cfn (Nlocal, t, y, f_data); gloc(Nlocal, t, ytemp_data, gy_data, f_data); /* Set minimum increment based on uround and norm of g */ gnorm = N_VWrmsNorm(gy, ewt); minInc = (gnorm != ZERO) ? (MIN_INC_MULT * ABS(h) * uround * Nlocal * gnorm) : ONE; /* Set bandwidth and number of column groups for band differencing */ width = mldq + mudq + 1; ngroups = MIN(width, Nlocal); /* Loop over groups */ for (group=1; group <= ngroups; group++) { /* Increment all y_j in group */ for(j=group-1; j < Nlocal; j+=width) { inc = MAX(rely*ABS(y_data[j]), minInc/ewt_data[j]); ytemp_data[j] += inc; } /* Evaluate g with incremented y */ gloc(Nlocal, t, ytemp_data, gtemp_data, f_data); /* Restore ytemp, then form and load difference quotients */ for (j=group-1; j < Nlocal; j+=width) { ytemp_data[j] = y_data[j]; col_j = BAND_COL(J,j); inc = MAX(rely*ABS(y_data[j]), minInc/ewt_data[j]); inc_inv = ONE/inc; i1 = MAX(0, j-mukeep); i2 = MIN(j+mlkeep, Nlocal-1); for (i=i1; i <= i2; i++) BAND_COL_ELEM(col_j,i,j) = inc_inv * (gtemp_data[i] - gy_data[i]); } } }
static int jac(long int N, long int mu, long int ml, N_Vector u, N_Vector f, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2) { realtype dx, dy; realtype hdc, vdc; realtype *kthCol; int i, j, k; dx = ONE/(NX+1); dy = ONE/(NY+1); hdc = ONE/(dx*dx); vdc = ONE/(dy*dy); /* The components of f(t,u) which depend on u_{i,j} are f_{i,j}, f_{i-1,j}, f_{i+1,j}, f_{i,j+1}, and f_{i,j-1}. Thus, a column of the Jacobian will contain an entry from each of these equations exception the ones on the boundary. f_{i,j} = hdc*(u_{i-1,j} -2u_{i,j} +u_{i+1,j}) + vdc*(u_{i,j-1} -2u_{i,j} +u_{i,j+1}) f_{i-1,j} = hdc*(u_{i-2,j} -2u_{i-1,j}+u_{i,j}) + vdc*(u_{i-1,j-1}-2u_{i-1,j}+u_{i-1,j+1}) f_{i+1,j} = hdc*(u_{i,j} -2u_{i+1,j}+u_{i+2,j}) + vdc*(u_{i+1,j-1}-2u_{i+1,j}+u_{i+1,j+1}) f_{i,j-1} = hdc*(u_{i-1,j-1}-2u_{i,j-1}+u_{i+1,j-1}) + vdc*(u_{i,j-2} -2u_{i,j-1}+u_{i,j}) f_{i,j+1} = hdc*(u_{i-1,j+1}-2u_{i,j+1}+u_{i+1,j+1}) + vdc*(u_{i,j} -2u_{i,j+1}+u_{i,j+2}) */ for (j=0; j <= NY-1; j++) { for (i=0; i <= NX-1; i++) { /* Evaluate diffusion coefficients */ k = i + j*NX; kthCol = BAND_COL(J, k); BAND_COL_ELEM(kthCol,k,k) = -2.0*hdc - 2.0*vdc; if ( i != (NX-1) ) BAND_COL_ELEM(kthCol,k+1,k) = hdc; if ( i != 0 ) BAND_COL_ELEM(kthCol,k-1,k) = hdc; if ( j != (NY-1) ) BAND_COL_ELEM(kthCol,k+NX,k) = vdc; if ( j != 0 ) BAND_COL_ELEM(kthCol,k-NX,k) = vdc; } } return(0); }
static void CVBandPDQJac(CVBandPrecData pdata, realtype t, N_Vector y, N_Vector fy, N_Vector ftemp, N_Vector ytemp) { CVodeMem cv_mem; realtype fnorm, minInc, inc, inc_inv, srur; long int group, i, j, width, ngroups, i1, i2; realtype *col_j, *ewt_data, *fy_data, *ftemp_data, *y_data, *ytemp_data; cv_mem = (CVodeMem) pdata->cvode_mem; /* Obtain pointers to the data for ewt, fy, ftemp, y, ytemp. */ ewt_data = N_VGetArrayPointer(ewt); fy_data = N_VGetArrayPointer(fy); ftemp_data = N_VGetArrayPointer(ftemp); y_data = N_VGetArrayPointer(y); ytemp_data = N_VGetArrayPointer(ytemp); /* Load ytemp with y = predicted y vector. */ N_VScale(ONE, y, ytemp); /* Set minimum increment based on uround and norm of f. */ srur = RSqrt(uround); fnorm = N_VWrmsNorm(fy, ewt); minInc = (fnorm != ZERO) ? (MIN_INC_MULT * ABS(h) * uround * N * fnorm) : ONE; /* Set bandwidth and number of column groups for band differencing. */ width = ml + mu + 1; ngroups = MIN(width, N); for (group = 1; group <= ngroups; group++) { /* Increment all y_j in group. */ for(j = group-1; j < N; j += width) { inc = MAX(srur*ABS(y_data[j]), minInc/ewt_data[j]); ytemp_data[j] += inc; } /* Evaluate f with incremented y. */ f(t, ytemp, ftemp, f_data); nfeBP++; /* Restore ytemp, then form and load difference quotients. */ for (j = group-1; j < N; j += width) { ytemp_data[j] = y_data[j]; col_j = BAND_COL(savedJ,j); inc = MAX(srur*ABS(y_data[j]), minInc/ewt_data[j]); inc_inv = ONE/inc; i1 = MAX(0, j-mu); i2 = MIN(j+ml, N-1); for (i=i1; i <= i2; i++) BAND_COL_ELEM(col_j,i,j) = inc_inv * (ftemp_data[i] - fy_data[i]); } } }
static int Jac(long int N, long int mu, long int ml, realtype t, N_Vector u, N_Vector fu, DlsMat J, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { int i, j, k; realtype *kthCol, hordc, horac, verdc; UserData data; /* * The components of f = udot that depend on u(i,j) are * f(i,j), f(i-1,j), f(i+1,j), f(i,j-1), f(i,j+1), with * df(i,j)/du(i,j) = -2 (1/dx^2 + 1/dy^2) * df(i-1,j)/du(i,j) = 1/dx^2 + .25/dx (if i > 1) * df(i+1,j)/du(i,j) = 1/dx^2 - .25/dx (if i < MX) * df(i,j-1)/du(i,j) = 1/dy^2 (if j > 1) * df(i,j+1)/du(i,j) = 1/dy^2 (if j < MY) */ data = (UserData) user_data; hordc = data->hdcoef; horac = data->hacoef; verdc = data->vdcoef; /* set non-zero Jacobian entries */ for (j=1; j <= MY; j++) { for (i=1; i <= MX; i++) { k = j-1 + (i-1)*MY; kthCol = BAND_COL(J,k); /* set the kth column of J */ BAND_COL_ELEM(kthCol,k,k) = -TWO*(verdc+hordc); if (i != 1) BAND_COL_ELEM(kthCol,k-MY,k) = hordc + horac; if (i != MX) BAND_COL_ELEM(kthCol,k+MY,k) = hordc - horac; if (j != 1) BAND_COL_ELEM(kthCol,k-1,k) = verdc; if (j != MY) BAND_COL_ELEM(kthCol,k+1,k) = verdc; } } return(0); }
void KernelBand<NLSSystemObject>::CalculatesNormOfJacobianRows(Eigen::VectorXd& row_norms) { row_norms.setZero(); for (int group = 1; group <= ngroups_; group++) { for (int j = group - 1; j < static_cast<int>(this->ne_); j += width_) { double* col_j = BAND_COL(J_, j); int i1 = std::max(0, j - J_->nUpper()); int i2 = std::min(j + J_->nLower(), static_cast<int>(this->ne_ - 1)); for (int i = i1; i <= i2; i++) { const double J = BAND_COL_ELEM(col_j, i, j); row_norms(i) += J*J; } } } for (unsigned int i = 0; i < this->ne_; i++) row_norms(i) = std::sqrt(row_norms(i)); }
static int KBBDDQJac(KBBDPrecData pdata, N_Vector uu, N_Vector uscale, N_Vector gu, N_Vector gtemp, N_Vector utemp) { realtype inc, inc_inv; long int group, i, j, width, ngroups, i1, i2; KINMem kin_mem; realtype *udata, *uscdata, *gudata, *gtempdata, *utempdata, *col_j; int retval; kin_mem = (KINMem) pdata->kin_mem; /* set pointers to the data for all vectors */ udata = N_VGetArrayPointer(uu); uscdata = N_VGetArrayPointer(uscale); gudata = N_VGetArrayPointer(gu); gtempdata = N_VGetArrayPointer(gtemp); utempdata = N_VGetArrayPointer(utemp); /* load utemp with uu = predicted solution vector */ N_VScale(ONE, uu, utemp); /* call gcomm and gloc to get base value of g(uu) */ if (gcomm != NULL) { retval = gcomm(Nlocal, uu, user_data); if (retval != 0) return(retval); } retval = gloc(Nlocal, uu, gu, user_data); if (retval != 0) return(retval); /* set bandwidth and number of column groups for band differencing */ width = mldq + mudq + 1; ngroups = SUNMIN(width, Nlocal); /* loop over groups */ for (group = 1; group <= ngroups; group++) { /* increment all u_j in group */ for(j = group - 1; j < Nlocal; j += width) { inc = rel_uu * SUNMAX(SUNRabs(udata[j]), (ONE / uscdata[j])); utempdata[j] += inc; } /* evaluate g with incremented u */ retval = gloc(Nlocal, utemp, gtemp, user_data); if (retval != 0) return(retval); /* restore utemp, then form and load difference quotients */ for (j = group - 1; j < Nlocal; j += width) { utempdata[j] = udata[j]; col_j = BAND_COL(PP,j); inc = rel_uu * SUNMAX(SUNRabs(udata[j]) , (ONE / uscdata[j])); inc_inv = ONE / inc; i1 = SUNMAX(0, (j - mukeep)); i2 = SUNMIN((j + mlkeep), (Nlocal - 1)); for (i = i1; i <= i2; i++) BAND_COL_ELEM(col_j, i, j) = inc_inv * (gtempdata[i] - gudata[i]); } } return(0); }
int kinDlsBandDQJac(long int N, long int mupper, long int mlower, N_Vector u, N_Vector fu, DlsMat Jac, void *data, N_Vector tmp1, N_Vector tmp2) { realtype inc, inc_inv; N_Vector futemp, utemp; int retval; long int group, i, j, width, ngroups, i1, i2; realtype *col_j, *fu_data, *futemp_data, *u_data, *utemp_data, *uscale_data; KINMem kin_mem; KINDlsMem kindls_mem; /* data points to kinmem */ kin_mem = (KINMem) data; kindls_mem = (KINDlsMem) lmem; /* Rename work vectors for use as temporary values of u and fu */ futemp = tmp1; utemp = tmp2; /* Obtain pointers to the data for ewt, fy, futemp, y, ytemp */ fu_data = N_VGetArrayPointer(fu); futemp_data = N_VGetArrayPointer(futemp); u_data = N_VGetArrayPointer(u); uscale_data = N_VGetArrayPointer(uscale); utemp_data = N_VGetArrayPointer(utemp); /* Load utemp with u */ N_VScale(ONE, u, utemp); /* Set bandwidth and number of column groups for band differencing */ width = mlower + mupper + 1; ngroups = MIN(width, N); for (group = 1; group <= ngroups; group++) { /* Increment all utemp components in group */ for (j = group - 1; j < N; j += width) { inc = sqrt_relfunc * MAX(ABS(u_data[j]), ABS(uscale_data[j])); utemp_data[j] += inc; } /* Evaluate f with incremented u */ retval = func(utemp, futemp, user_data); if (retval != 0) { return(-1); } /* Restore utemp components, then form and load difference quotients */ for (j = group - 1; j < N; j += width) { utemp_data[j] = u_data[j]; col_j = BAND_COL(Jac, j); inc = sqrt_relfunc * MAX(ABS(u_data[j]), ABS(uscale_data[j])); inc_inv = ONE / inc; i1 = MAX(0, j - mupper); i2 = MIN(j + mlower, N - 1); for (i = i1; i <= i2; i++) { BAND_COL_ELEM(col_j, i, j) = inc_inv * (futemp_data[i] - fu_data[i]); } } } /* Increment counter nfeDQ */ nfeDQ += ngroups; return(0); }
int idaDlsBandDQJac(long int N, long int mupper, long int mlower, realtype tt, realtype c_j, N_Vector yy, N_Vector yp, N_Vector rr, DlsMat Jac, void *data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { realtype inc, inc_inv, yj, ypj, srur, conj, ewtj; realtype *y_data, *yp_data, *ewt_data, *cns_data = NULL; realtype *ytemp_data, *yptemp_data, *rtemp_data, *r_data, *col_j; N_Vector rtemp, ytemp, yptemp; long int i, j, i1, i2, width, ngroups, group; int retval = 0; IDAMem IDA_mem; IDADlsMem idadls_mem; /* data points to IDA_mem */ IDA_mem = (IDAMem) data; idadls_mem = (IDADlsMem) lmem; rtemp = tmp1; /* Rename work vector for use as the perturbed residual. */ ytemp = tmp2; /* Rename work vector for use as a temporary for yy. */ yptemp = tmp3; /* Rename work vector for use as a temporary for yp. */ /* Obtain pointers to the data for all eight vectors used. */ ewt_data = N_VGetArrayPointer(ewt); r_data = N_VGetArrayPointer(rr); y_data = N_VGetArrayPointer(yy); yp_data = N_VGetArrayPointer(yp); rtemp_data = N_VGetArrayPointer(rtemp); ytemp_data = N_VGetArrayPointer(ytemp); yptemp_data = N_VGetArrayPointer(yptemp); if (constraints != NULL) { cns_data = N_VGetArrayPointer(constraints); } /* Initialize ytemp and yptemp. */ N_VScale(ONE, yy, ytemp); N_VScale(ONE, yp, yptemp); /* Compute miscellaneous values for the Jacobian computation. */ srur = RSqrt(uround); width = mlower + mupper + 1; ngroups = MIN(width, N); /* Loop over column groups. */ for (group = 1; group <= ngroups; group++) { /* Increment all yy[j] and yp[j] for j in this group. */ for (j = group - 1; j < N; j += width) { yj = y_data[j]; ypj = yp_data[j]; ewtj = ewt_data[j]; /* Set increment inc to yj based on sqrt(uround)*abs(yj), with adjustments using ypj and ewtj if this is small, and a further adjustment to give it the same sign as hh*ypj. */ inc = MAX( srur * MAX( ABS(yj), ABS(hh * ypj) ) , ONE / ewtj ); if (hh * ypj < ZERO) { inc = -inc; } inc = (yj + inc) - yj; /* Adjust sign(inc) again if yj has an inequality constraint. */ if (constraints != NULL) { conj = cns_data[j]; if (ABS(conj) == ONE) { if ((yj + inc)*conj < ZERO) { inc = -inc; } } else if (ABS(conj) == TWO) { if ((yj + inc)*conj <= ZERO) { inc = -inc; } } } /* Increment yj and ypj. */ ytemp_data[j] += inc; yptemp_data[j] += cj * inc; } /* Call res routine with incremented arguments. */ retval = res(tt, ytemp, yptemp, rtemp, user_data); nreDQ++; if (retval != 0) { break; } /* Loop over the indices j in this group again. */ for (j = group - 1; j < N; j += width) { /* Reset ytemp and yptemp components that were perturbed. */ yj = ytemp_data[j] = y_data[j]; ypj = yptemp_data[j] = yp_data[j]; col_j = BAND_COL(Jac, j); ewtj = ewt_data[j]; /* Set increment inc exactly as above. */ inc = MAX( srur * MAX( ABS(yj), ABS(hh * ypj) ) , ONE / ewtj ); if (hh * ypj < ZERO) { inc = -inc; } inc = (yj + inc) - yj; if (constraints != NULL) { conj = cns_data[j]; if (ABS(conj) == ONE) { if ((yj + inc)*conj < ZERO) { inc = -inc; } } else if (ABS(conj) == TWO) { if ((yj + inc)*conj <= ZERO) { inc = -inc; } } } /* Load the difference quotient Jacobian elements for column j. */ inc_inv = ONE / inc; i1 = MAX(0, j - mupper); i2 = MIN(j + mlower, N - 1); for (i = i1; i <= i2; i++) { BAND_COL_ELEM(col_j, i, j) = inc_inv * (rtemp_data[i] - r_data[i]); } } } return(retval); }
static int cpBBDDQJacImpl(CPBBDPrecData pdata, realtype t, realtype gamma, N_Vector y, N_Vector yp, N_Vector gref, N_Vector ytemp, N_Vector yptemp, N_Vector gtemp) { CPodeMem cp_mem; realtype inc, inc_inv; int retval; int group, i, j, width, ngroups, i1, i2; realtype *ydata, *ypdata, *ytempdata, *yptempdata, *grefdata, *gtempdata; realtype *ewtdata; realtype *col_j, yj, ypj, ewtj; cp_mem = (CPodeMem) pdata->cpode_mem; /* Initialize ytemp and yptemp. */ N_VScale(ONE, y, ytemp); N_VScale(ONE, yp, yptemp); /* Obtain pointers as required to the data array of vectors. */ ydata = N_VGetArrayPointer(y); ypdata = N_VGetArrayPointer(yp); gtempdata = N_VGetArrayPointer(gtemp); ewtdata = N_VGetArrayPointer(ewt); ytempdata = N_VGetArrayPointer(ytemp); yptempdata= N_VGetArrayPointer(yptemp); grefdata = N_VGetArrayPointer(gref); /* Call cfn and glocI to get base value of G(t,y,y'). */ if (cfn != NULL) { retval = cfn(Nlocal, t, y, yp, f_data); if (retval != 0) return(retval); } retval = glocI(Nlocal, t, y, yp, gref, f_data); nge++; if (retval != 0) return(retval); /* Set bandwidth and number of column groups for band differencing. */ width = mldq + mudq + 1; ngroups = MIN(width, Nlocal); /* Loop over groups. */ for(group = 1; group <= ngroups; group++) { /* Loop over the components in this group. */ for(j = group-1; j < Nlocal; j += width) { yj = ydata[j]; ypj = ypdata[j]; ewtj = ewtdata[j]; /* Set increment inc to yj based on rel_yy*abs(yj), with adjustments using ypj and ewtj if this is small, and a further adjustment to give it the same sign as hh*ypj. */ inc = dqrely*MAX(ABS(yj), MAX( ABS(h*ypj), ONE/ewtj)); if (h*ypj < ZERO) inc = -inc; inc = (yj + inc) - yj; /* Increment yj and ypj. */ ytempdata[j] += gamma*inc; yptempdata[j] += inc; } /* Evaluate G with incremented y and yp arguments. */ retval = glocI(Nlocal, t, ytemp, yptemp, gtemp, f_data); nge++; if (retval != 0) return(retval); /* Loop over components of the group again; restore ytemp and yptemp. */ for(j = group-1; j < Nlocal; j += width) { yj = ytempdata[j] = ydata[j]; ypj = yptempdata[j] = ypdata[j]; ewtj = ewtdata[j]; /* Set increment inc as before .*/ inc = dqrely*MAX(ABS(yj), MAX( ABS(h*ypj), ONE/ewtj)); if (h*ypj < ZERO) inc = -inc; inc = (yj + inc) - yj; /* Form difference quotients and load into savedP. */ inc_inv = ONE/inc; col_j = BAND_COL(savedP,j); i1 = MAX(0, j-mukeep); i2 = MIN(j+mlkeep, Nlocal-1); for(i = i1; i <= i2; i++) BAND_COL_ELEM(col_j,i,j) = inc_inv * (gtempdata[i] - grefdata[i]); } } return(0); }
void KernelBand<NLSSystemObject>::QuasiNewton(const Eigen::VectorXd& dxi, const Eigen::VectorXd& dfi) { const double tstart = OpenSMOKE::OpenSMOKEGetCpuTime(); { // The auxiliary vector named x_plus is used here Eigen::VectorXd* normSquared = &x_plus_; normSquared->setZero(); for (int group = 1; group <= ngroups_; group++) { for (int j = group - 1; j < static_cast<int>(this->ne_); j += width_) { int i1 = std::max(0, j - J_->nUpper()); int i2 = std::min(j + J_->nLower(), static_cast<int>(this->ne_ - 1)); for (int i = i1; i <= i2; i++) (*normSquared)(i) += dxi(j)*dxi(j); } } // The auxiliary vector named x_plus is used here Eigen::VectorXd* sum_vector = &f_plus_; (*sum_vector) = dfi; for (int group = 1; group <= ngroups_; group++) { for (int j = group - 1; j < static_cast<int>(this->ne_); j += width_) { double* col_j = BAND_COL(J_, j); int i1 = std::max(0, j - J_->nUpper()); int i2 = std::min(j + J_->nLower(), static_cast<int>(this->ne_ - 1)); for (int i = i1; i <= i2; i++) (*sum_vector)(i) -= BAND_COL_ELEM(col_j, i, j)*dxi(j); } } for (int group = 1; group <= ngroups_; group++) { for (int j = group - 1; j < static_cast<int>(this->ne_); j += width_) { double* col_j = BAND_COL(J_, j); int i1 = std::max(0, j - J_->nUpper()); int i2 = std::min(j + J_->nLower(), static_cast<int>(this->ne_ - 1)); } } const double eps = 1.e-10; for (int j = 0; j < static_cast<int>(this->ne_); j++) (*sum_vector)(j) /= ((*normSquared)(j) + eps); for (int group = 1; group <= ngroups_; group++) { for (int j = group - 1; j < static_cast<int>(this->ne_); j += width_) { double* col_j = BAND_COL(J_, j); int i1 = std::max(0, j - J_->nUpper()); int i2 = std::min(j + J_->nLower(), static_cast<int>(this->ne_ - 1)); for (int i = i1; i <= i2; i++) BAND_COL_ELEM(col_j, i, j) += (*sum_vector)(i)*dxi(j); } } } const double tend = OpenSMOKE::OpenSMOKEGetCpuTime(); numberOfJacobianQuasiAssembling_++; cpuTimeSingleJacobianQuasiAssembling_ = tend - tstart; cpuTimeJacobianQuasiAssembling_ += cpuTimeSingleJacobianQuasiAssembling_; }
int cpDlsBandDQJacImpl(int N, int mupper, int mlower, realtype t, realtype gm, N_Vector y, N_Vector yp, N_Vector r, DlsMat Jac, void *jac_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { N_Vector ftemp, ytemp, yptemp; realtype inc, inc_inv, yj, ypj, srur, ewtj; realtype *y_data, *yp_data, *ewt_data; realtype *ytemp_data, *yptemp_data, *ftemp_data, *r_data, *col_j; int i, j, i1, i2, width, group, ngroups; int retval = 0; CPodeMem cp_mem; CPDlsMem cpdls_mem; /* jac_data points to cpode_mem */ cp_mem = (CPodeMem) jac_data; cpdls_mem = (CPDlsMem) lmem; ftemp = tmp1; /* Rename work vector for use as the perturbed residual. */ ytemp = tmp2; /* Rename work vector for use as a temporary for yy. */ yptemp= tmp3; /* Rename work vector for use as a temporary for yp. */ /* Obtain pointers to the data for all vectors used. */ ewt_data = N_VGetArrayPointer(ewt); r_data = N_VGetArrayPointer(r); y_data = N_VGetArrayPointer(y); yp_data = N_VGetArrayPointer(yp); ftemp_data = N_VGetArrayPointer(ftemp); ytemp_data = N_VGetArrayPointer(ytemp); yptemp_data = N_VGetArrayPointer(yptemp); /* Initialize ytemp and yptemp. */ N_VScale(ONE, y, ytemp); N_VScale(ONE, yp, yptemp); /* Compute miscellaneous values for the Jacobian computation. */ srur = RSqrt(uround); width = mlower + mupper + 1; ngroups = MIN(width, N); /* Loop over column groups. */ for (group=1; group <= ngroups; group++) { /* Increment all y[j] and yp[j] for j in this group. */ for (j=group-1; j<N; j+=width) { yj = y_data[j]; ypj = yp_data[j]; ewtj = ewt_data[j]; /* Set increment inc to yj based on sqrt(uround)*abs(yj), with adjustments using ypj and ewtj if this is small, and a further adjustment to give it the same sign as h*ypj. */ inc = MAX( srur * MAX( ABS(yj), ABS(h*ypj) ) , ONE/ewtj ); if (h*ypj < ZERO) inc = -inc; inc = (yj + inc) - yj; /* Increment yj and ypj. */ ytemp_data[j] += gamma*inc; yptemp_data[j] += inc; } /* Call ODE fct. with incremented arguments. */ retval = fi(tn, ytemp, yptemp, ftemp, f_data); nfeDQ++; if (retval != 0) break; /* Loop over the indices j in this group again. */ for (j=group-1; j<N; j+=width) { /* Reset ytemp and yptemp components that were perturbed. */ yj = ytemp_data[j] = y_data[j]; ypj = yptemp_data[j] = yp_data[j]; col_j = BAND_COL(Jac, j); ewtj = ewt_data[j]; /* Set increment inc exactly as above. */ inc = MAX( srur * MAX( ABS(yj), ABS(h*ypj) ) , ONE/ewtj ); if (h*ypj < ZERO) inc = -inc; inc = (yj + inc) - yj; /* Load the difference quotient Jacobian elements for column j. */ inc_inv = ONE/inc; i1 = MAX(0, j-mupper); i2 = MIN(j+mlower,N-1); for (i=i1; i<=i2; i++) BAND_COL_ELEM(col_j,i,j) = inc_inv*(ftemp_data[i]-r_data[i]); } } return(retval); }
static int IBBDDQJac(IBBDPrecData pdata, realtype tt, realtype cj, N_Vector yy, N_Vector yp, N_Vector gref, N_Vector ytemp, N_Vector yptemp, N_Vector gtemp) { IDAMem IDA_mem; realtype inc, inc_inv; int retval; long int group, i, j, width, ngroups, i1, i2; realtype *ydata, *ypdata, *ytempdata, *yptempdata, *grefdata, *gtempdata; realtype *cnsdata = NULL, *ewtdata; realtype *col_j, conj, yj, ypj, ewtj; IDA_mem = (IDAMem) pdata->ida_mem; /* Initialize ytemp and yptemp. */ N_VScale(ONE, yy, ytemp); N_VScale(ONE, yp, yptemp); /* Obtain pointers as required to the data array of vectors. */ ydata = N_VGetArrayPointer(yy); ypdata = N_VGetArrayPointer(yp); gtempdata = N_VGetArrayPointer(gtemp); ewtdata = N_VGetArrayPointer(ewt); if (constraints != NULL) cnsdata = N_VGetArrayPointer(constraints); ytempdata = N_VGetArrayPointer(ytemp); yptempdata= N_VGetArrayPointer(yptemp); grefdata = N_VGetArrayPointer(gref); /* Call gcomm and glocal to get base value of G(t,y,y'). */ if (gcomm != NULL) { retval = gcomm(Nlocal, tt, yy, yp, res_data); if (retval != 0) return(retval); } retval = glocal(Nlocal, tt, yy, yp, gref, res_data); nge++; if (retval != 0) return(retval); /* Set bandwidth and number of column groups for band differencing. */ width = mldq + mudq + 1; ngroups = MIN(width, Nlocal); /* Loop over groups. */ for(group = 1; group <= ngroups; group++) { /* Loop over the components in this group. */ for(j = group-1; j < Nlocal; j += width) { yj = ydata[j]; ypj = ypdata[j]; ewtj = ewtdata[j]; /* Set increment inc to yj based on rel_yy*abs(yj), with adjustments using ypj and ewtj if this is small, and a further adjustment to give it the same sign as hh*ypj. */ inc = rel_yy*MAX(ABS(yj), MAX( ABS(hh*ypj), ONE/ewtj)); if (hh*ypj < ZERO) inc = -inc; inc = (yj + inc) - yj; /* Adjust sign(inc) again if yj has an inequality constraint. */ if (constraints != NULL) { conj = cnsdata[j]; if (ABS(conj) == ONE) {if ((yj+inc)*conj < ZERO) inc = -inc;} else if (ABS(conj) == TWO) {if ((yj+inc)*conj <= ZERO) inc = -inc;} } /* Increment yj and ypj. */ ytempdata[j] += inc; yptempdata[j] += cj*inc; } /* Evaluate G with incremented y and yp arguments. */ retval = glocal(Nlocal, tt, ytemp, yptemp, gtemp, res_data); nge++; if (retval != 0) return(retval); /* Loop over components of the group again; restore ytemp and yptemp. */ for(j = group-1; j < Nlocal; j += width) { yj = ytempdata[j] = ydata[j]; ypj = yptempdata[j] = ypdata[j]; ewtj = ewtdata[j]; /* Set increment inc as before .*/ inc = rel_yy*MAX(ABS(yj), MAX( ABS(hh*ypj), ONE/ewtj)); if (hh*ypj < ZERO) inc = -inc; inc = (yj + inc) - yj; if (constraints != NULL) { conj = cnsdata[j]; if (ABS(conj) == ONE) {if ((yj+inc)*conj < ZERO) inc = -inc;} else if (ABS(conj) == TWO) {if ((yj+inc)*conj <= ZERO) inc = -inc;} } /* Form difference quotients and load into PP. */ inc_inv = ONE/inc; col_j = BAND_COL(PP,j); i1 = MAX(0, j-mukeep); i2 = MIN(j+mlkeep, Nlocal-1); for(i = i1; i <= i2; i++) BAND_COL_ELEM(col_j,i,j) = inc_inv * (gtempdata[i] - grefdata[i]); } } return(0); }
int cvDlsBandDQJac(long int N, long int mupper, long int mlower, realtype t, N_Vector y, N_Vector fy, DlsMat Jac, void *data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { N_Vector ftemp, ytemp; realtype fnorm, minInc, inc, inc_inv, srur; realtype *col_j, *ewt_data, *fy_data, *ftemp_data, *y_data, *ytemp_data; long int group, i, j, width, ngroups, i1, i2; int retval = 0; CVodeMem cv_mem; CVDlsMem cvdls_mem; /* data points to cvode_mem */ cv_mem = (CVodeMem) data; cvdls_mem = (CVDlsMem) lmem; /* Rename work vectors for use as temporary values of y and f */ ftemp = tmp1; ytemp = tmp2; /* Obtain pointers to the data for ewt, fy, ftemp, y, ytemp */ ewt_data = N_VGetArrayPointer(ewt); fy_data = N_VGetArrayPointer(fy); ftemp_data = N_VGetArrayPointer(ftemp); y_data = N_VGetArrayPointer(y); ytemp_data = N_VGetArrayPointer(ytemp); /* Load ytemp with y = predicted y vector */ N_VScale(ONE, y, ytemp); /* Set minimum increment based on uround and norm of f */ srur = RSqrt(uround); fnorm = N_VWrmsNorm(fy, ewt); minInc = (fnorm != ZERO) ? (MIN_INC_MULT * ABS(h) * uround * N * fnorm) : ONE; /* Set bandwidth and number of column groups for band differencing */ width = mlower + mupper + 1; ngroups = MIN(width, N); /* Loop over column groups. */ for (group=1; group <= ngroups; group++) { /* Increment all y_j in group */ for(j=group-1; j < N; j+=width) { inc = MAX(srur*ABS(y_data[j]), minInc/ewt_data[j]); ytemp_data[j] += inc; } /* Evaluate f with incremented y */ retval = f(tn, ytemp, ftemp, user_data); nfeDQ++; if (retval != 0) break; /* Restore ytemp, then form and load difference quotients */ for (j=group-1; j < N; j+=width) { ytemp_data[j] = y_data[j]; col_j = BAND_COL(Jac,j); inc = MAX(srur*ABS(y_data[j]), minInc/ewt_data[j]); inc_inv = ONE/inc; i1 = MAX(0, j-mupper); i2 = MIN(j+mlower, N-1); for (i=i1; i <= i2; i++) BAND_COL_ELEM(col_j,i,j) = inc_inv * (ftemp_data[i] - fy_data[i]); } } return(retval); }
/*--------------------------------------------------------------- ARKBandPDQJac: This routine generates a banded difference quotient approximation to the Jacobian of f(t,y). It assumes that a band matrix of type DlsMat is stored column-wise, and that elements within each column are contiguous. This makes it possible to get the address of a column of J via the macro BAND_COL and to write a simple for loop to set each of the elements of a column in succession. ---------------------------------------------------------------*/ static int ARKBandPDQJac(ARKBandPrecData pdata, realtype t, N_Vector y, N_Vector fy, N_Vector ftemp, N_Vector ytemp) { ARKodeMem ark_mem; realtype fnorm, minInc, inc, inc_inv, srur; long int group, i, j, width, ngroups, i1, i2; realtype *col_j, *ewt_data, *fy_data, *ftemp_data, *y_data, *ytemp_data; int retval; ark_mem = (ARKodeMem) pdata->arkode_mem; /* Obtain pointers to the data for ewt, fy, ftemp, y, ytemp. */ ewt_data = N_VGetArrayPointer(ark_mem->ark_ewt); fy_data = N_VGetArrayPointer(fy); ftemp_data = N_VGetArrayPointer(ftemp); y_data = N_VGetArrayPointer(y); ytemp_data = N_VGetArrayPointer(ytemp); /* Load ytemp with y = predicted y vector. */ N_VScale(ONE, y, ytemp); /* Set minimum increment based on uround and norm of f. */ srur = SUNRsqrt(ark_mem->ark_uround); /* fnorm = N_VWrmsNorm(fy, ark_mem->ark_ewt); */ fnorm = N_VWrmsNorm(fy, ark_mem->ark_rwt); minInc = (fnorm != ZERO) ? (MIN_INC_MULT * SUNRabs(ark_mem->ark_h) * ark_mem->ark_uround * pdata->N * fnorm) : ONE; /* Set bandwidth and number of column groups for band differencing. */ width = pdata->ml + pdata->mu + 1; ngroups = SUNMIN(width, pdata->N); for (group = 1; group <= ngroups; group++) { /* Increment all y_j in group. */ for(j = group-1; j < pdata->N; j += width) { inc = SUNMAX(srur*SUNRabs(y_data[j]), minInc/ewt_data[j]); ytemp_data[j] += inc; } /* Evaluate f with incremented y. */ retval = ark_mem->ark_fi(t, ytemp, ftemp, ark_mem->ark_user_data); pdata->nfeBP++; if (retval != 0) return(retval); /* Restore ytemp, then form and load difference quotients. */ for (j = group-1; j < pdata->N; j += width) { ytemp_data[j] = y_data[j]; col_j = BAND_COL(pdata->savedJ,j); inc = SUNMAX(srur*SUNRabs(y_data[j]), minInc/ewt_data[j]); inc_inv = ONE/inc; i1 = SUNMAX(0, j-pdata->mu); i2 = SUNMIN(j+pdata->ml, pdata->N-1); for (i=i1; i <= i2; i++) BAND_COL_ELEM(col_j,i,j) = inc_inv * (ftemp_data[i] - fy_data[i]); } } return(0); }
static void CVBBDDQJac(CVBBDPrecData pdata, realtype t, N_Vector y, N_Vector gy, N_Vector ytemp, N_Vector gtemp) { CVodeMem cv_mem; realtype gnorm, minInc, inc, inc_inv; long int group, i, j, width, ngroups, i1, i2; realtype *y_data, *ewt_data, *gy_data, *gtemp_data, *ytemp_data, *col_j; cv_mem = (CVodeMem) pdata->cvode_mem; /* Load ytemp with y = predicted solution vector */ N_VScale(ONE, y, ytemp); /* Call cfn and gloc to get base value of g(t,y) */ if (cfn != NULL) cfn (Nlocal, t, y, f_data); gloc(Nlocal, t, ytemp, gy, f_data); /* Obtain pointers to the data for various vectors */ y_data = N_VGetArrayPointer(y); gy_data = N_VGetArrayPointer(gy); ewt_data = N_VGetArrayPointer(ewt); ytemp_data = N_VGetArrayPointer(ytemp); gtemp_data = N_VGetArrayPointer(gtemp); /* Set minimum increment based on uround and norm of g */ gnorm = N_VWrmsNorm(gy, ewt); minInc = (gnorm != ZERO) ? (MIN_INC_MULT * ABS(h) * uround * Nlocal * gnorm) : ONE; /* Set bandwidth and number of column groups for band differencing */ width = mldq + mudq + 1; ngroups = MIN(width, Nlocal); /* Loop over groups */ for (group=1; group <= ngroups; group++) { /* Increment all y_j in group */ for(j=group-1; j < Nlocal; j+=width) { inc = MAX(dqrely*ABS(y_data[j]), minInc/ewt_data[j]); ytemp_data[j] += inc; } /* Evaluate g with incremented y */ gloc(Nlocal, t, ytemp, gtemp, f_data); /* Restore ytemp, then form and load difference quotients */ for (j=group-1; j < Nlocal; j+=width) { ytemp_data[j] = y_data[j]; col_j = BAND_COL(savedJ,j); inc = MAX(dqrely*ABS(y_data[j]), minInc/ewt_data[j]); inc_inv = ONE/inc; i1 = MAX(0, j-mukeep); i2 = MIN(j+mlkeep, Nlocal-1); for (i=i1; i <= i2; i++) BAND_COL_ELEM(col_j,i,j) = inc_inv * (gtemp_data[i] - gy_data[i]); } } }
void KernelBand<NLSSystemObject>::NumericalJacobian(const Eigen::VectorXd& x, const Eigen::VectorXd& f, Eigen::VectorXd& x_dimensions, const bool max_constraints, const Eigen::VectorXd& xMax) { if (pre_processing_ == false) PreProcessing(); const double tstart = OpenSMOKE::OpenSMOKEGetCpuTime(); const double ZERO_DER = 1.e-8; const double ETA2 = std::sqrt(OpenSMOKE::OPENSMOKE_MACH_EPS_DOUBLE); // Save the original vector x_plus_ = x; // Loop for (int group = 1; group <= ngroups_; group++) { if (max_constraints == false) { for (int j = group - 1; j < static_cast<int>(this->ne_); j += width_) { const double xh = std::fabs(x(j)); const double xdh = std::fabs(x_dimensions(j)); hJ_(j) = ETA2*std::max(xh, xdh); hJ_(j) = std::max(hJ_(j), ZERO_DER); hJ_(j) = std::min(hJ_(j), 0.001 + 0.001*std::fabs(xh)); x_plus_(j) += hJ_(j); } } else { for (int j = group - 1; j < static_cast<int>(this->ne_); j += width_) { const double xh = std::fabs(x(j)); const double xdh = std::fabs(x_dimensions(j)); hJ_(j) = ETA2*std::max(xh, xdh); hJ_(j) = std::max(hJ_(j), ZERO_DER); hJ_(j) = std::min(hJ_(j), 0.001 + 0.001*std::fabs(xh)); if (xh + hJ_(j) > xMax(j)) hJ_(j) = -hJ_(j); x_plus_(j) += hJ_(j); } } this->Equations(x_plus_, f_plus_); for (int j = group - 1; j < static_cast<int>(this->ne_); j += width_) { x_plus_(j) = x(j); double* col_j = BAND_COL(J_, j); int i1 = std::max(0, j - J_->nUpper()); int i2 = std::min(j + J_->nLower(), static_cast<int>(this->ne_ - 1)); for (int i = i1; i <= i2; i++) BAND_COL_ELEM(col_j, i, j) = (f_plus_(i) - f(i)) / hJ_(j); } } const double tend = OpenSMOKE::OpenSMOKEGetCpuTime(); numberOfSystemCallsForJacobian_ += this->ngroups_; numberOfJacobianFullAssembling_++; cpuTimeSingleJacobianFullAssembling_ = tend - tstart; cpuTimeJacobianFullAssembling_ += cpuTimeSingleJacobianFullAssembling_; }