コード例 #1
0
ファイル: cvode_direct.c プロジェクト: sn248/Rcppsbmod
/*-----------------------------------------------------------------
  cvDlsSolve
  -----------------------------------------------------------------
  This routine interfaces between CVode and the generic 
  SUNLinearSolver object LS, by calling the solver and scaling 
  the solution appropriately when gamrat != 1.
  -----------------------------------------------------------------*/
int cvDlsSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight,
               N_Vector ycur, N_Vector fcur)
{
  int retval;
  CVDlsMem cvdls_mem;

  /* Return immediately if cv_mem or cv_mem->cv_lmem are NULL */
  if (cv_mem == NULL) {
    cvProcessError(NULL, CVDLS_MEM_NULL, "CVDLS", 
		    "cvDlsSolve", MSGD_CVMEM_NULL);
    return(CVDLS_MEM_NULL);
  }
  if (cv_mem->cv_lmem == NULL) {
    cvProcessError(cv_mem, CVDLS_LMEM_NULL, "CVDLS", 
		    "cvDlsSolve", MSGD_LMEM_NULL);
    return(CVDLS_LMEM_NULL);
  }
  cvdls_mem = (CVDlsMem) cv_mem->cv_lmem;

  /* call the generic linear system solver, and copy b to x */
  retval = SUNLinSolSolve(cvdls_mem->LS, cvdls_mem->A, cvdls_mem->x, b, ZERO);
  N_VScale(ONE, cvdls_mem->x, b);
  
  /* scale the correction to account for change in gamma */
  if ((cv_mem->cv_lmm == CV_BDF) && (cv_mem->cv_gamrat != ONE))
    N_VScale(TWO/(ONE + cv_mem->cv_gamrat), b, b);
  
  /* store solver return value and return */
  cvdls_mem->last_flag = retval;
  return(retval);
}
コード例 #2
0
ファイル: idas_bbdpre.c プロジェクト: polymec/polymec-dev
/*---------------------------------------------------------------
  IDABBDPrecSolve

  The function IDABBDPrecSolve computes a solution to the linear
  system P z = r, where P is the left preconditioner defined by
  the routine IDABBDPrecSetup.
 
  The IDABBDPrecSolve parameters used here are as follows:
 
  rvec is the input right-hand side vector r.
 
  zvec is the computed solution vector z.
 
  bbd_data is the pointer to BBD data set by IDABBDInit.
 
  The arguments tt, yy, yp, rr, c_j and delta are NOT used.
 
  IDABBDPrecSolve returns the value returned from the linear 
  solver object.
  ---------------------------------------------------------------*/
static int IDABBDPrecSolve(realtype tt, N_Vector yy, N_Vector yp,
                           N_Vector rr, N_Vector rvec, N_Vector zvec,
                           realtype c_j, realtype delta, void *bbd_data)
{
  IBBDPrecData pdata;
  int retval;

  pdata = (IBBDPrecData) bbd_data;

  /* Attach local data arrays for rvec and zvec to rlocal and zlocal */
  N_VSetArrayPointer(N_VGetArrayPointer(rvec), pdata->rlocal);
  N_VSetArrayPointer(N_VGetArrayPointer(zvec), pdata->zlocal);
  
  /* Call banded solver object to do the work */
  retval = SUNLinSolSolve(pdata->LS, pdata->PP, pdata->zlocal, 
                          pdata->rlocal, ZERO);

  /* Detach local data arrays from rlocal and zlocal */
  N_VSetArrayPointer(NULL, pdata->rlocal);
  N_VSetArrayPointer(NULL, pdata->zlocal);

  return(retval);
}
コード例 #3
0
ファイル: cvode_ls.c プロジェクト: NumCosmo/NumCosmo
/*-----------------------------------------------------------------
  cvLsSolve

  This routine interfaces between CVode and the generic
  SUNLinearSolver object LS, by setting the appropriate tolerance
  and scaling vectors, calling the solver, and accumulating
  statistics from the solve for use/reporting by CVode.
  -----------------------------------------------------------------*/
int cvLsSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight,
              N_Vector ynow, N_Vector fnow)
{
  CVLsMem  cvls_mem;
  realtype bnorm, deltar, delta, w_mean;
  int      curiter, nli_inc, retval, LSType;
  /* access CVLsMem structure */
  if (cv_mem->cv_lmem==NULL) {
    cvProcessError(cv_mem, CVLS_LMEM_NULL, "CVLS",
                   "cvLsSolve", MSG_LS_LMEM_NULL);
    return(CVLS_LMEM_NULL);
  }
  cvls_mem = (CVLsMem) cv_mem->cv_lmem;

  /* Retrieve the LS type */
  LSType = SUNLinSolGetType(cvls_mem->LS);

  /* get current nonlinear solver iteration */
  retval = SUNNonlinSolGetCurIter(cv_mem->NLS, &curiter);

  /* If the linear solver is iterative:
     test norm(b), if small, return x = 0 or x = b;
     set linear solver tolerance (in left/right scaled 2-norm) */
  if ( (LSType == SUNLINEARSOLVER_ITERATIVE) ||
       (LSType == SUNLINEARSOLVER_MATRIX_ITERATIVE) ) {
    deltar = cvls_mem->eplifac * cv_mem->cv_tq[4];
    bnorm = N_VWrmsNorm(b, weight);
    if (bnorm <= deltar) {
      if (curiter > 0) N_VConst(ZERO, b);
      cvls_mem->last_flag = CVLS_SUCCESS;
      return(cvls_mem->last_flag);
    }
    delta = deltar * cvls_mem->sqrtN;
  } else {
    delta = ZERO;
  }

  /* Set vectors ycur and fcur for use by the Atimes and Psolve
     interface routines */
  cvls_mem->ycur = ynow;
  cvls_mem->fcur = fnow;

  /* Set initial guess x = 0 to LS */
  N_VConst(ZERO, cvls_mem->x);

  /* Set scaling vectors for LS to use (if applicable) */
  if (cvls_mem->LS->ops->setscalingvectors) {
    retval = SUNLinSolSetScalingVectors(cvls_mem->LS,
                                        weight,
                                        weight);
    if (retval != SUNLS_SUCCESS) {
      cvProcessError(cv_mem, CVLS_SUNLS_FAIL, "CVLS", "cvLsSolve",
                     "Error in calling SUNLinSolSetScalingVectors");
      cvls_mem->last_flag = CVLS_SUNLS_FAIL;
      return(cvls_mem->last_flag);
    }

  /* If solver is iterative and does not support scaling vectors, update the
     tolerance in an attempt to account for weight vector.  We make the
     following assumptions:
       1. w_i = w_mean, for i=0,...,n-1 (i.e. the weights are homogeneous)
       2. the linear solver uses a basic 2-norm to measure convergence
     Hence (using the notation from sunlinsol_spgmr.h, with S = diag(w)),
           || bbar - Abar xbar ||_2 < tol
       <=> || S b - S A x ||_2 < tol
       <=> || S (b - A x) ||_2 < tol
       <=> \sum_{i=0}^{n-1} (w_i (b - A x)_i)^2 < tol^2
       <=> w_mean^2 \sum_{i=0}^{n-1} (b - A x_i)^2 < tol^2
       <=> \sum_{i=0}^{n-1} (b - A x_i)^2 < tol^2 / w_mean^2
       <=> || b - A x ||_2 < tol / w_mean
     So we compute w_mean = ||w||_RMS = ||w||_2 / sqrt(n), and scale
     the desired tolerance accordingly. */
  } else if ( (LSType == SUNLINEARSOLVER_ITERATIVE) ||
              (LSType == SUNLINEARSOLVER_MATRIX_ITERATIVE) ) {

    w_mean = SUNRsqrt( N_VDotProd(weight, weight) ) / cvls_mem->sqrtN;
    delta /= w_mean;

  }

  /* If a user-provided jtsetup routine is supplied, call that here */
  if (cvls_mem->jtsetup) {
    cvls_mem->last_flag = cvls_mem->jtsetup(cv_mem->cv_tn, ynow, fnow,
                                            cvls_mem->jt_data);
    cvls_mem->njtsetup++;
    if (cvls_mem->last_flag != 0) {
      cvProcessError(cv_mem, retval, "CVLS",
                     "cvLsSolve", MSG_LS_JTSETUP_FAILED);
      return(cvls_mem->last_flag);
    }
  }

  /* Call solver, and copy x to b */
  retval = SUNLinSolSolve(cvls_mem->LS, cvls_mem->A, cvls_mem->x, b, delta);
  N_VScale(ONE, cvls_mem->x, b);

  /* If using a direct or matrix-iterative solver, BDF method, and gamma has changed,
     scale the correction to account for change in gamma */
  if ( ((LSType == SUNLINEARSOLVER_DIRECT) ||
        (LSType == SUNLINEARSOLVER_MATRIX_ITERATIVE)) &&
       (cv_mem->cv_lmm == CV_BDF) &&
       (cv_mem->cv_gamrat != ONE) )
    N_VScale(TWO/(ONE + cv_mem->cv_gamrat), b, b);

  /* Retrieve statistics from iterative linear solvers */
  nli_inc = 0;
  if ( ((LSType == SUNLINEARSOLVER_ITERATIVE) ||
        (LSType == SUNLINEARSOLVER_MATRIX_ITERATIVE)) &&
       (cvls_mem->LS->ops->numiters) )
    nli_inc = SUNLinSolNumIters(cvls_mem->LS);

  /* Increment counters nli and ncfl */
  cvls_mem->nli += nli_inc;
  if (retval != SUNLS_SUCCESS) cvls_mem->ncfl++;

  /* Interpret solver return value  */
  cvls_mem->last_flag = retval;

  switch(retval) {

  case SUNLS_SUCCESS:
    return(0);
    break;
  case SUNLS_RES_REDUCED:
    /* allow reduction but not solution on first Newton iteration,
       otherwise return with a recoverable failure */
    if (curiter == 0) return(0);
    else              return(1);
    break;
  case SUNLS_CONV_FAIL:
  case SUNLS_ATIMES_FAIL_REC:
  case SUNLS_PSOLVE_FAIL_REC:
  case SUNLS_PACKAGE_FAIL_REC:
  case SUNLS_QRFACT_FAIL:
  case SUNLS_LUFACT_FAIL:
    return(1);
    break;
  case SUNLS_MEM_NULL:
  case SUNLS_ILL_INPUT:
  case SUNLS_MEM_FAIL:
  case SUNLS_GS_FAIL:
  case SUNLS_QRSOL_FAIL:
    return(-1);
    break;
  case SUNLS_PACKAGE_FAIL_UNREC:
    cvProcessError(cv_mem, SUNLS_PACKAGE_FAIL_UNREC, "CVLS",
                   "cvLsSolve",
                    "Failure in SUNLinSol external package");
    return(-1);
    break;
  case SUNLS_ATIMES_FAIL_UNREC:
    cvProcessError(cv_mem, SUNLS_ATIMES_FAIL_UNREC, "CVLS",
                   "cvLsSolve", MSG_LS_JTIMES_FAILED);
    return(-1);
    break;
  case SUNLS_PSOLVE_FAIL_UNREC:
    cvProcessError(cv_mem, SUNLS_PSOLVE_FAIL_UNREC, "CVLS",
                   "cvLsSolve", MSG_LS_PSOLVE_FAILED);
    return(-1);
    break;
  }

  return(0);
}