Exemple #1
0
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;
    }
  }
}
Exemple #2
0
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);
}
Exemple #4
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);
}
Exemple #6
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));
	}
Exemple #7
0
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);
}
Exemple #8
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);
}
Exemple #9
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);

}
Exemple #10
0
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);
}
Exemple #11
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_;
	}
Exemple #12
0
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);
}
Exemple #15
0
/*---------------------------------------------------------------
 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]);
    }
  }
}
Exemple #17
0
	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_;
	}