Exemplo n.º 1
0
int IDASetMaxNumSteps(void *ida_mem, long int mxsteps)
{
  IDAMem IDA_mem;

  if (ida_mem==NULL) {
    IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetMaxNumSteps", MSG_NO_MEM);
    return(IDA_MEM_NULL);
  }

  IDA_mem = (IDAMem) ida_mem;

  /* Passing mxsteps=0 sets the default. Passing mxsteps<0 disables the test. */

  if (mxsteps == 0)
    IDA_mem->ida_mxstep = MXSTEP_DEFAULT;
  else
    IDA_mem->ida_mxstep = mxsteps;

  return(IDA_SUCCESS);
}
Exemplo n.º 2
0
static int idaDlsDenseJacBSWrapper(long int NeqB, realtype tt, realtype c_jB,
                                  N_Vector yyB, N_Vector ypB, N_Vector rrB,
                                  DlsMat JacB, void *ida_mem, 
                                  N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B)
{
  IDAadjMem IDAADJ_mem;
  IDAMem IDA_mem;
  IDABMem IDAB_mem;
  IDADlsMemB idadlsB_mem;
  int flag;

  IDA_mem = (IDAMem) ida_mem;
  IDAADJ_mem = IDA_mem->ida_adj_mem;

  /* Get current backward problem. */
  IDAB_mem = IDAADJ_mem->ia_bckpbCrt;
  
  /* Get linear solver's data for this backward problem. */
  idadlsB_mem = (IDADlsMemB) IDAB_mem->ida_lmem;

  /* Get forward solution from interpolation. */
  if( noInterp == FALSE) {
    if (interpSensi)
      flag = IDAADJ_mem->ia_getY(IDA_mem, tt, yyTmp, ypTmp, yySTmp, ypSTmp);
    else
      flag = IDAADJ_mem->ia_getY(IDA_mem, tt, yyTmp, ypTmp, NULL, NULL);
  
    if (flag != IDA_SUCCESS) {
      IDAProcessError(IDAB_mem->IDA_mem, -1, "IDASDLS", "idaDlsDenseJacBSWrapper", MSGD_BAD_T);
      return(-1);
    }
  }

  /* Call user's adjoint dense djacBS routine */
  flag = idadlsB_mem->d_djacBS(NeqB, tt, c_jB, 
                              yyTmp, ypTmp, yySTmp, ypSTmp, 
                              yyB, ypB, rrB, 
                              JacB, IDAB_mem->ida_user_data, 
                              tmp1B, tmp2B, tmp3B);
  return(flag);
}
int IDABBDSpgmr(void *ida_mem, int maxl, void *bbd_data)
{
  IDAMem IDA_mem;
  int flag;

  flag = IDASpgmr(ida_mem, maxl);
  if(flag != IDASPILS_SUCCESS) return(flag);

  IDA_mem = (IDAMem) ida_mem;

  if (bbd_data == NULL) {
    IDAProcessError(IDA_mem, IDABBDPRE_PDATA_NULL, "IDABBDPRE", "IDABBDSpgmr", MSGBBD_PDATA_NULL);
    return(IDABBDPRE_PDATA_NULL);
  }

  flag = IDASpilsSetPreconditioner(ida_mem, IDABBDPrecSetup,
                                   IDABBDPrecSolve, bbd_data);
  if(flag != IDASPILS_SUCCESS) return(flag);

  return(IDASPILS_SUCCESS);
}
Exemplo n.º 4
0
static int IDADenseSetup(IDAMem IDA_mem, N_Vector yyp, N_Vector ypp,
                         N_Vector rrp, N_Vector tmp1, N_Vector tmp2,
                         N_Vector tmp3)
{
    int retval;
    long int retfac;
    IDADlsMem idadls_mem;

    idadls_mem = (IDADlsMem) lmem;

    /* Increment nje counter. */
    nje++;

    /* Zero out JJ; call Jacobian routine jac; return if it failed. */
    SetToZero(JJ);
    retval = djac(neq, tn, cj, yyp, ypp, rrp, JJ, jacdata,
                  tmp1, tmp2, tmp3);
    if (retval < 0)
    {
        IDAProcessError(IDA_mem, IDADLS_JACFUNC_UNRECVR, "IDADENSE", "IDADenseSetup", MSGD_JACFUNC_FAILED);
        last_flag = IDADLS_JACFUNC_UNRECVR;
        return(-1);
    }
    if (retval > 0)
    {
        last_flag = IDADLS_JACFUNC_RECVR;
        return(+1);
    }

    /* Do LU factorization of JJ; return success or fail flag. */
    retfac = DenseGETRF(JJ, lpivots);

    if (retfac != 0)
    {
        last_flag = retfac;
        return(+1);
    }
    last_flag = IDADLS_SUCCESS;
    return(0);
}
static int IDABandSetup(IDAMem IDA_mem, N_Vector yyp, N_Vector ypp,
                        N_Vector rrp, N_Vector tmp1, N_Vector tmp2,
                        N_Vector tmp3)
{
    int retval;
    long int retfac;
    IDABandMem idaband_mem;

    idaband_mem = (IDABandMem) lmem;

    /* Increment nje counter. */
    nje++;

    /* Zero out JJ; call Jacobian routine jac; return if it failed. */
    BandZero(JJ);
    retval = jac(neq, mu, ml, tn, yyp, ypp, rrp, cj,
                 jacdata, JJ, tmp1, tmp2, tmp3);
    if (retval < 0) {
        IDAProcessError(IDA_mem, IDABAND_JACFUNC_UNRECVR, "IDABAND", "IDABandSetup", MSGB_JACFUNC_FAILED);
        last_flag = IDABAND_JACFUNC_UNRECVR;
        return(-1);
    }
    if (retval > 0) {
        last_flag = IDABAND_JACFUNC_RECVR;
        return(+1);
    }

    /* Do LU factorization of JJ; return success or fail flag. */
    retfac = BandGBTRF(JJ, pivots);

    if (retfac != 0) {
        last_flag = retfac;
        return(+1);
    }
    last_flag = IDABAND_SUCCESS;
    return(0);
}
Exemplo n.º 6
0
static int idaNlsConvTest(SUNNonlinearSolver NLS, N_Vector ycor, N_Vector del,
                          realtype tol, N_Vector ewt, void* ida_mem)
{
  IDAMem IDA_mem;
  int m, retval;
  realtype delnrm;
  realtype rate;

  if (ida_mem == NULL) {
    IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "idaNlsConvTest", MSG_NO_MEM);
    return(IDA_MEM_NULL);
  }
  IDA_mem = (IDAMem) ida_mem;

  /* compute the norm of the correction */
  delnrm = N_VWrmsNorm(del, ewt);

  /* get the current nonlinear solver iteration count */
  retval = SUNNonlinSolGetCurIter(NLS, &m);
  if (retval != IDA_SUCCESS) return(IDA_MEM_NULL);

  /* test for convergence, first directly, then with rate estimate. */
  if (m == 0){
    IDA_mem->ida_oldnrm = delnrm;
    if (delnrm <= PT0001 * IDA_mem->ida_toldel) return(SUN_NLS_SUCCESS);
  } else {
    rate = SUNRpowerR( delnrm/IDA_mem->ida_oldnrm, ONE/m );
    if (rate > RATEMAX) return(SUN_NLS_CONV_RECVR);
    IDA_mem->ida_ss = rate/(ONE - rate);
  }

  if (IDA_mem->ida_ss*delnrm <= tol) return(SUN_NLS_SUCCESS);

  /* not yet converged */
  return(SUN_NLS_CONTINUE);
}
Exemplo n.º 7
0
/*
 * idaLapackBandSetup does the setup operations for the band linear solver.
 * It calls the Jacobian function to obtain the Newton matrix M = F_y + c_j*F_y', 
 * updates counters, and calls the band LU factorization routine.
 */
static int idaLapackBandSetup(IDAMem IDA_mem,
                              N_Vector yP, N_Vector ypP, N_Vector fctP, 
                              N_Vector tmp1, N_Vector tmp2, N_Vector tmp3)
{
  IDADlsMem idadls_mem;
  int ier, retval;
  int intn, iml, imu, ldmat;

  idadls_mem = (IDADlsMem) lmem;
  intn = (int) n;
  iml = (int) ml;
  imu = (int) mu;
  ldmat = JJ->ldim;

  /* Call Jacobian function */
  nje++;
  SetToZero(JJ);
  retval = bjac(n, mu, ml, tn, cj, yP, ypP, fctP, JJ, J_data, tmp1, tmp2, tmp3);
  if (retval < 0) {
    IDAProcessError(IDA_mem, IDADLS_JACFUNC_UNRECVR, "IDALAPACK", "idaLapackBandSetup", MSGD_JACFUNC_FAILED);
    last_flag = IDADLS_JACFUNC_UNRECVR;
    return(-1);
  } else if (retval > 0) {
    last_flag = IDADLS_JACFUNC_RECVR;
    return(+1);
  }
  
  /* Do LU factorization of M */
  dgbtrf_f77(&intn, &intn, &iml, &imu, JJ->data, &ldmat, pivots, &ier);

  /* Return 0 if the LU was complete; otherwise return 1 */
  last_flag = (long int) ier;
  if (ier > 0) return(1);
  return(0);

}
int IDASetEwtFn(void *ida_mem, IDAEwtFn efun, void *edata)
{
  IDAMem IDA_mem;

  if (ida_mem==NULL) {
    IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetEwtFn", MSG_NO_MEM);
    return(IDA_MEM_NULL);
  }

  IDA_mem = (IDAMem) ida_mem;

  if ( IDA_mem->ida_VatolMallocDone ) {
    N_VDestroy(IDA_mem->ida_Vatol);
    lrw -= lrw1;
    liw -= liw1;
    IDA_mem->ida_VatolMallocDone = FALSE;
  }

  IDA_mem->ida_itol = IDA_WF;
  IDA_mem->ida_efun = efun;
  IDA_mem->ida_edata = edata;

  return(IDA_SUCCESS);
}
Exemplo n.º 9
0
int IDABand(void *ida_mem, int Neq, int mupper, int mlower)
{
  IDAMem IDA_mem;
  IDADlsMem idadls_mem;
  int flag;

  /* Return immediately if ida_mem is NULL. */
  if (ida_mem == NULL) {
    IDAProcessError(NULL, IDADLS_MEM_NULL, "IDASBAND", "IDABand", MSGD_IDAMEM_NULL);
    return(IDADLS_MEM_NULL);
  }
  IDA_mem = (IDAMem) ida_mem;

  /* Test if the NVECTOR package is compatible with the BAND solver */
  if(vec_tmpl->ops->nvgetarraypointer == NULL) {
    IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDASBAND", "IDABand", MSGD_BAD_NVECTOR);
    return(IDADLS_ILL_INPUT);
  }

  /* Test mlower and mupper for legality. */
  if ((mlower < 0) || (mupper < 0) || (mlower >= Neq) || (mupper >= Neq)) {
    IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDASBAND", "IDABand", MSGD_BAD_SIZES);
    return(IDADLS_ILL_INPUT);
  }

  if (lfree != NULL) flag = lfree((IDAMem) ida_mem);

  /* Set five main function fields in ida_mem. */
  linit  = IDABandInit;
  lsetup = IDABandSetup;
  lsolve = IDABandSolve;
  lperf  = NULL;
  lfree  = IDABandFree;

  /* Get memory for IDADlsMemRec. */
  idadls_mem = NULL;
  idadls_mem = (IDADlsMem) malloc(sizeof(struct IDADlsMemRec));
  if (idadls_mem == NULL) {
    IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDASBAND", "IDABand", MSGD_MEM_FAIL);
    return(IDADLS_MEM_FAIL);
  }

  /* Set matrix type */
  mtype = SUNDIALS_BAND;

  /* Set default Jacobian routine and Jacobian data */
  jacDQ   = TRUE;
  bjac    = NULL;
  jacdata = NULL;
  last_flag = IDADLS_SUCCESS;

  setupNonNull = TRUE;

  /* Store problem size */
  neq = Neq;

  idadls_mem->d_ml = mlower;
  idadls_mem->d_mu = mupper;
    
  /* Set extended upper half-bandwidth for JJ (required for pivoting). */
  smu = MIN(Neq-1, mupper + mlower);

  /* Allocate memory for JJ and pivot array. */
  JJ = NULL;
  JJ = NewBandMat(Neq, mupper, mlower, smu);
  if (JJ == NULL) {
    IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDASBAND", "IDABand", MSGD_MEM_FAIL);
    free(idadls_mem); idadls_mem = NULL;
    return(IDADLS_MEM_FAIL);
  }

  pivots = NULL;
  pivots = NewIntArray(Neq);
  if (pivots == NULL) {
    IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDASBAND", "IDABand", MSGD_MEM_FAIL);
    DestroyMat(JJ);
    free(idadls_mem); idadls_mem = NULL;
    return(IDADLS_MEM_FAIL);
  }  
  
  /* Attach linear solver memory to the integrator memory */
  lmem = idadls_mem;

  return(IDADLS_SUCCESS);
}
Exemplo n.º 10
0
int IDAKLU(void *ida_mem, int n, int nnz)
{
  IDAMem IDA_mem;
  IDASlsMem idasls_mem;
  KLUData klu_data;
  int flag;

  /* Return immediately if ida_mem is NULL. */
  if (ida_mem == NULL) {
    IDAProcessError(NULL, IDASLS_MEM_NULL, "IDASLS", "IDAKLU", 
		    MSGSP_IDAMEM_NULL);
    return(IDASLS_MEM_NULL);
  }
  IDA_mem = (IDAMem) ida_mem;

  /* Test if the NVECTOR package is compatible with the Direct solver */
  if (IDA_mem->ida_tempv1->ops->nvgetarraypointer == NULL) {
    IDAProcessError(IDA_mem, IDASLS_ILL_INPUT, "IDASLS", "IDAKLU", 
		    MSGSP_BAD_NVECTOR);
    return(IDASLS_ILL_INPUT);
  }

  if (IDA_mem->ida_lfree != NULL) flag = IDA_mem->ida_lfree(IDA_mem);

  /* Set five main function fields in IDA_mem. */
  IDA_mem->ida_linit  = IDAKLUInit;
  IDA_mem->ida_lsetup = IDAKLUSetup;
  IDA_mem->ida_lsolve = IDAKLUSolve;
  IDA_mem->ida_lperf  = NULL;
  IDA_mem->ida_lfree  = IDAKLUFree;

  /* Get memory for IDASlsMemRec. */
  idasls_mem = (IDASlsMem) malloc(sizeof(struct IDASlsMemRec));
  if (idasls_mem == NULL) {
    IDAProcessError(IDA_mem, IDASLS_MEM_FAIL, "IDASLS", "IDAKLU", 
		    MSGSP_MEM_FAIL);
    return(IDASLS_MEM_FAIL);
  }

  /* Get memory for KLUData. */
  klu_data = (KLUData)malloc(sizeof(struct KLUDataRec));
  if (klu_data == NULL) {
    IDAProcessError(IDA_mem, IDASLS_MEM_FAIL, "IDASLS", "IDAKLU", 
		    MSGSP_MEM_FAIL);
    return(IDASLS_MEM_FAIL);
  }

  IDA_mem->ida_setupNonNull = TRUE;

  /* Set default Jacobian routine and Jacobian data */
  idasls_mem->s_jaceval = NULL;
  idasls_mem->s_jacdata = IDA_mem->ida_user_data;

  /* Allocate memory for the sparse Jacobian */
  idasls_mem->s_JacMat = NewSparseMat(n, n, nnz);
  if (idasls_mem->s_JacMat == NULL) {
    IDAProcessError(IDA_mem, IDASLS_MEM_FAIL, "IDASLS", "IDAKLU", 
		    MSGSP_MEM_FAIL);
    return(IDASLS_MEM_FAIL);
  }

  /* KInitialize KLU structures */
  klu_data->s_Symbolic = NULL;
  klu_data->s_Numeric = NULL;

  /* Set default parameters for KLU */
  flag = klu_defaults(&klu_data->s_Common);
  if (flag == 0) {
    IDAProcessError(IDA_mem, IDASLS_PACKAGE_FAIL, "IDASLS", "IDAKLU", 
		    MSGSP_PACKAGE_FAIL);
    return(IDASLS_PACKAGE_FAIL);
  }

  /* Set ordering to COLAMD as the idas default use.
     Users can set a different value with IDAKLUSetOrdering,
     and the user-set value is loaded before any call to klu_analyze in
     IDAKLUSetup.  */
  klu_data->s_ordering = 1;
  klu_data->s_Common.ordering = klu_data->s_ordering;

  /* Attach linear solver memory to the integrator memory */
  idasls_mem->s_solver_data = (void *) klu_data;
  IDA_mem->ida_lmem = idasls_mem;

  idasls_mem->s_last_flag = IDASLS_SUCCESS;

  return(IDASLS_SUCCESS);
}
int IDASetTolerances(void *ida_mem, 
                     int itol, realtype rtol, void *atol)
{
  IDAMem IDA_mem;
  booleantype neg_atol;

  if (ida_mem==NULL) {
    IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetTolerances", MSG_NO_MEM);
    return(IDA_MEM_NULL);
  }

  IDA_mem = (IDAMem) ida_mem;

  /* Check if ida_mem was allocated */

  if (IDA_mem->ida_MallocDone == FALSE) {
    IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDA", "IDASetTolerances", MSG_NO_MALLOC);
    return(IDA_NO_MALLOC);
  }

  /* Check inputs */

  if ((itol != IDA_SS) && (itol != IDA_SV)) {
    IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetTolerances", MSG_BAD_ITOL);
    return(IDA_ILL_INPUT);
  }

  if (atol == NULL) { 
    IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetTolerances", MSG_ATOL_NULL);
    return(IDA_ILL_INPUT); 
  }

  if (rtol < ZERO) { 
    IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetTolerances", MSG_BAD_RTOL);
    return(IDA_ILL_INPUT); 
  }

    
  if (itol == IDA_SS) { 
    neg_atol = (*((realtype *)atol) < ZERO); 
  } else { 
    neg_atol = (N_VMin((N_Vector)atol) < ZERO); 
  }

  if (neg_atol) { 
    IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetTolerances", MSG_BAD_ATOL);
    return(IDA_ILL_INPUT); 
  }

  /* Copy tolerances into memory */

  if ( (itol != IDA_SV) && (IDA_mem->ida_VatolMallocDone) ) {
    N_VDestroy(IDA_mem->ida_Vatol);
    lrw -= lrw1;
    liw -= liw1;
    IDA_mem->ida_VatolMallocDone = FALSE;
  }

  if ( (itol == IDA_SV) && !(IDA_mem->ida_VatolMallocDone) ) {
    IDA_mem->ida_Vatol = NULL;
    IDA_mem->ida_Vatol = N_VClone(IDA_mem->ida_ewt);
    lrw += lrw1;
    liw += liw1;
    IDA_mem->ida_VatolMallocDone = TRUE;
  }

  IDA_mem->ida_itol = itol;
  IDA_mem->ida_rtol = rtol;      
  if (itol == IDA_SS)
    IDA_mem->ida_Satol = *((realtype *)atol);
  else 
    N_VScale(ONE, (N_Vector)atol, IDA_mem->ida_Vatol);

  IDA_mem->ida_efun = IDAEwtSet;
  IDA_mem->ida_edata = ida_mem;

  return(IDA_SUCCESS);
}
Exemplo n.º 12
0
int IDAKLUReInit(void *ida_mem_v, int n, int nnz, int reinit_type)
{
  IDAMem ida_mem;
  IDASlsMem idasls_mem;
  KLUData klu_data;
  SlsMat JacMat;

  /* Return immediately if ida_mem is NULL. */
  if (ida_mem_v == NULL) {
    IDAProcessError(NULL, IDASLS_MEM_NULL, "IDASLS", "IDAKLUReInit", 
		    MSGSP_IDAMEM_NULL);
    return(IDASLS_MEM_NULL);
  }
  ida_mem = (IDAMem) ida_mem_v;

  /* Return immediately if ark_lmem is NULL. */
  if (ida_mem->ida_lmem == NULL) {
    IDAProcessError(NULL, IDASLS_LMEM_NULL, "IDASLS", "IDAKLUReInit", 
		    MSGSP_LMEM_NULL);
    return(IDASLS_LMEM_NULL);
  }

  idasls_mem = (IDASlsMem) (ida_mem->ida_lmem);
  klu_data = (KLUData) idasls_mem->s_solver_data;

  /* Return if reinit_type is not valid */
  if ((reinit_type != 1) && (reinit_type != 2)) {
    IDAProcessError(NULL, IDASLS_ILL_INPUT, "IDASLS", "IDAKLUReInit", 
		    MSGSP_ILL_INPUT);
    return(IDASLS_ILL_INPUT);
  }

  JacMat = idasls_mem->s_JacMat;


  if (reinit_type == 1) {

    /* Destroy previous Jacobian information */
    if (idasls_mem->s_JacMat) {
      DestroySparseMat(idasls_mem->s_JacMat);
    }

    /* Allocate memory for the sparse Jacobian */
    idasls_mem->s_JacMat = NewSparseMat(n, n, nnz);
    if (idasls_mem->s_JacMat == NULL) {
      IDAProcessError(ida_mem, IDASLS_MEM_FAIL, "IDASLS", "IDAKLU", 
		    MSGSP_MEM_FAIL);
      return(IDASLS_MEM_FAIL);
    }
  }

  /* Free the prior factorazation and reset for first factorization */
  if( klu_data->s_Symbolic != NULL)
    klu_free_symbolic(&(klu_data->s_Symbolic), &(klu_data->s_Common));
  if( klu_data->s_Numeric != NULL)
    klu_free_numeric(&(klu_data->s_Numeric), &(klu_data->s_Common));
  idasls_mem->s_first_factorize = 1;

  idasls_mem->s_last_flag = IDASLS_SUCCESS;

  return(0);
}
Exemplo n.º 13
0
static int IDAKLUSetup(IDAMem IDA_mem, N_Vector yyp, N_Vector ypp,
		       N_Vector rrp, N_Vector tmp1, N_Vector tmp2,
		       N_Vector tmp3)
{
  int retval;
  realtype tn, cj;
  IDASlsMem idasls_mem;
  IDASlsSparseJacFn jaceval;
  KLUData klu_data;
  SlsMat JacMat;
  void *jacdata;
  
  realtype uround_twothirds;

  uround_twothirds = SUNRpowerR(IDA_mem->ida_uround,TWOTHIRDS);

  idasls_mem = (IDASlsMem) (IDA_mem->ida_lmem);
  tn = IDA_mem->ida_tn; 
  cj = IDA_mem->ida_cj;

  klu_data = (KLUData) idasls_mem->s_solver_data;

  jaceval = idasls_mem->s_jaceval;
  jacdata = idasls_mem->s_jacdata;
  JacMat = idasls_mem->s_JacMat;

  /* Check that Jacobian eval routine is set */
  if (jaceval == NULL) {
    IDAProcessError(IDA_mem, IDASLS_JAC_NOSET, "IDASLS", "IDAKLUSetup", 
		    MSGSP_JAC_NOSET);
    free(idasls_mem); idasls_mem = NULL;
    return(IDASLS_JAC_NOSET);
  }

  /* Increment nje counter and call Jacobian eval routine. */
  idasls_mem->s_nje++;
  retval = jaceval(tn, cj, yyp, ypp, rrp, JacMat, jacdata, 
		   tmp1, tmp2, tmp3);

  if (retval < 0) {
    IDAProcessError(IDA_mem, IDASLS_JACFUNC_UNRECVR, "IDASLS", 
		    "IDAKLUSetup", MSGSP_JACFUNC_FAILED);
    idasls_mem->s_last_flag = IDASLS_JACFUNC_UNRECVR;
    return(IDASLS_JACFUNC_UNRECVR);
  }
  if (retval > 0) {
    idasls_mem->s_last_flag = IDASLS_JACFUNC_RECVR;
    return(+1);
  }

  if (idasls_mem->s_first_factorize) {
    /* ------------------------------------------------------------
       Get the symbolic factorization
       ------------------------------------------------------------*/ 
    /* Update the ordering option with any user-updated values from 
       calls to IDAKLUSetOrdering */
    klu_data->s_Common.ordering = klu_data->s_ordering;

    klu_data->s_Symbolic = klu_analyze(JacMat->N, JacMat->colptrs, 
				       JacMat->rowvals, &(klu_data->s_Common));
    if (klu_data->s_Symbolic == NULL) {
      IDAProcessError(IDA_mem, IDASLS_PACKAGE_FAIL, "IDASLS", "IDAKLUSetup", 
		      MSGSP_PACKAGE_FAIL);
      return(IDASLS_PACKAGE_FAIL);
    }

    /* ------------------------------------------------------------
       Compute the LU factorization of  the Jacobian.
       ------------------------------------------------------------*/
    klu_data->s_Numeric = klu_factor(JacMat->colptrs, JacMat->rowvals, JacMat->data, 
				     klu_data->s_Symbolic, &(klu_data->s_Common));

    if (klu_data->s_Numeric == NULL) {
      IDAProcessError(IDA_mem, IDASLS_PACKAGE_FAIL, "IDASLS", "IDAKLUSetup", 
		      MSGSP_PACKAGE_FAIL);
      return(IDASLS_PACKAGE_FAIL);
    }

    idasls_mem->s_first_factorize = 0;
  }
  else {

    retval = klu_refactor(JacMat->colptrs, JacMat->rowvals, JacMat->data, 
			  klu_data->s_Symbolic, klu_data->s_Numeric,
			  &(klu_data->s_Common));
    if (retval == 0) {
      IDAProcessError(IDA_mem, IDASLS_PACKAGE_FAIL, "IDASLS", "idaKLUSetup", 
		      MSGSP_PACKAGE_FAIL);
      return(IDASLS_PACKAGE_FAIL);
    }
    
    /*-----------------------------------------------------------
      Check if a cheap estimate of the reciprocal of the condition 
      number is getting too small.  If so, delete
      the prior numeric factorization and recompute it.
      -----------------------------------------------------------*/
    
    retval = klu_rcond(klu_data->s_Symbolic, klu_data->s_Numeric,
		       &(klu_data->s_Common));
    if (retval == 0) {
      IDAProcessError(IDA_mem, IDASLS_PACKAGE_FAIL, "IDASLS", "idaKLUSetup", 
		      MSGSP_PACKAGE_FAIL);
      return(IDASLS_PACKAGE_FAIL);
    }

    if ( (klu_data->s_Common.rcond)  < uround_twothirds ) {
      
      /* Condition number may be getting large.  
	 Compute more accurate estimate */
      retval = klu_condest(JacMat->colptrs, JacMat->data, 
			   klu_data->s_Symbolic, klu_data->s_Numeric,
			   &(klu_data->s_Common));
      if (retval == 0) {
	IDAProcessError(IDA_mem, IDASLS_PACKAGE_FAIL, "IDASLS", "idaKLUSetup", 
			MSGSP_PACKAGE_FAIL);
	return(IDASLS_PACKAGE_FAIL);
      }
      
      if ( (klu_data->s_Common.condest) > 
	   (1.0/uround_twothirds) ) {

	/* More accurate estimate also says condition number is 
	   large, so recompute the numeric factorization */

	klu_free_numeric(&(klu_data->s_Numeric), &(klu_data->s_Common));
	
	klu_data->s_Numeric = klu_factor(JacMat->colptrs, JacMat->rowvals, 
					 JacMat->data, klu_data->s_Symbolic, 
					 &(klu_data->s_Common));

	if (klu_data->s_Numeric == NULL) {
	  IDAProcessError(IDA_mem, IDASLS_PACKAGE_FAIL, "IDASLS", 
			  "IDAKLUSetup", MSGSP_PACKAGE_FAIL);
	  return(IDASLS_PACKAGE_FAIL);
	}
      }
    }
  }

  idasls_mem->s_last_flag = IDASLS_SUCCESS;

  return(0);
}
Exemplo n.º 14
0
static int IDASpbcgSolve(IDAMem IDA_mem, N_Vector bb, N_Vector weight,
                         N_Vector yy_now, N_Vector yp_now, N_Vector rr_now)
{
  IDASpilsMem idaspils_mem;
  SpbcgMem spbcg_mem;
  int pretype, nli_inc, nps_inc, retval;
  realtype res_norm;

  idaspils_mem = (IDASpilsMem) lmem;

  spbcg_mem = (SpbcgMem)spils_mem;

  /* Set SpbcgSolve convergence test constant epslin, in terms of the
     Newton convergence test constant epsNewt and safety factors. The factor
     sqrt(Neq) assures that the Bi-CGSTAB convergence test is applied to the
     WRMS norm of the residual vector, rather than the weighted L2 norm. */
  epslin = sqrtN*eplifac*epsNewt;

  /* Set vectors ycur, ypcur, and rcur for use by the Atimes and Psolve */
  ycur = yy_now;
  ypcur = yp_now;
  rcur = rr_now;

  /* Set SpbcgSolve inputs pretype and initial guess xx = 0 */  
  pretype = (psolve == NULL) ? PREC_NONE : PREC_LEFT;
  N_VConst(ZERO, xx);
  
  /* Call SpbcgSolve and copy xx to bb */
  retval = SpbcgSolve(spbcg_mem, IDA_mem, xx, bb, pretype, epslin,
                      IDA_mem, weight, weight, IDASpilsAtimes,
                      IDASpilsPSolve, &res_norm, &nli_inc, &nps_inc);
  last_flag = retval;
  if (nli_inc == 0) N_VScale(ONE, SPBCG_VTEMP(spbcg_mem), bb);
  else N_VScale(ONE, xx, bb);
  
  /* Increment counters nli, nps, and return if successful */
  nli += nli_inc;
  nps += nps_inc;
  if (retval != SPBCG_SUCCESS) ncfl++;

  /* Interpret return value from SpbcgSolve */

  last_flag = retval;

  switch(retval) {

  case SPBCG_SUCCESS:
    return(0);
    break;
  case SPBCG_RES_REDUCED:
    return(1);
    break;
  case SPBCG_CONV_FAIL:
    return(1);
    break;
  case SPBCG_PSOLVE_FAIL_REC:
    return(1);
    break;
  case SPBCG_ATIMES_FAIL_REC:
    return(1);
    break;
  case SPBCG_MEM_NULL:
    return(-1);
    break;
  case SPBCG_ATIMES_FAIL_UNREC:
    IDAProcessError(IDA_mem, SPBCG_ATIMES_FAIL_UNREC, "IDaSPBCG", "IDASpbcgSolve", MSGS_JTIMES_FAILED);    
    return(-1);
    break;
  case SPBCG_PSOLVE_FAIL_UNREC:
    IDAProcessError(IDA_mem, SPBCG_PSOLVE_FAIL_UNREC, "IDASPBCG", "IDASpbcgSolve", MSGS_PSOLVE_FAILED);
    return(-1);
    break;
  }

  return(0);
}
Exemplo n.º 15
0
int IDACalcIC(void *ida_mem, int icopt, realtype tout1)
{
  int ewtsetOK;
  int ier, nwt, nh, mxnh, icret, retval=0;
  int is;
  realtype tdist, troundoff, minid, hic, ypnorm;
  IDAMem IDA_mem;
  booleantype sensi_stg, sensi_sim;

  /* Check if IDA memory exists */

  if(ida_mem == NULL) {
    IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDACalcIC", MSG_NO_MEM);
    return(IDA_MEM_NULL);
  }
  IDA_mem = (IDAMem) ida_mem;

  /* Check if problem was malloc'ed */
  
  if(IDA_mem->ida_MallocDone == FALSE) {
    IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDAS", "IDACalcIC", MSG_NO_MALLOC);
    return(IDA_NO_MALLOC);
  }

  /* Check inputs to IDA for correctness and consistency */

  ier = IDAInitialSetup(IDA_mem);
  if(ier != IDA_SUCCESS) return(IDA_ILL_INPUT);
  IDA_mem->ida_SetupDone = TRUE;

  /* Check legality of input arguments, and set IDA memory copies. */

  if(icopt != IDA_YA_YDP_INIT && icopt != IDA_Y_INIT) {
    IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDACalcIC", MSG_IC_BAD_ICOPT);
    return(IDA_ILL_INPUT);
  }
  IDA_mem->ida_icopt = icopt;

  if(icopt == IDA_YA_YDP_INIT && (id == NULL)) {
    IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDACalcIC", MSG_IC_MISSING_ID);
    return(IDA_ILL_INPUT);
  }

  tdist = SUNRabs(tout1 - tn);
  troundoff = TWO*uround*(SUNRabs(tn) + SUNRabs(tout1));
  if(tdist < troundoff) {
    IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDACalcIC", MSG_IC_TOO_CLOSE);
    return(IDA_ILL_INPUT);
  }

  /* Are we computing sensitivities? */
  sensi_stg  = (sensi && (ism==IDA_STAGGERED));
  sensi_sim  = (sensi && (ism==IDA_SIMULTANEOUS));

  /* Allocate space and initialize temporary vectors */

  yy0 = N_VClone(ee);
  yp0 = N_VClone(ee);
  t0  = tn;
  N_VScale(ONE, phi[0], yy0);
  N_VScale(ONE, phi[1], yp0);

  if (sensi) {

    /* Allocate temporary space required for sensitivity IC: yyS0 and ypS0. */      
    yyS0 = N_VCloneVectorArray(Ns, ee);
    ypS0 = N_VCloneVectorArray(Ns, ee);
    
    /* Initialize sensitivity vector. */
    for (is=0; is<Ns; is++) {
      N_VScale(ONE, phiS[0][is], yyS0[is]);  
      N_VScale(ONE, phiS[1][is], ypS0[is]);  
    }
    
    /* Initialize work space vectors needed for sensitivities. */
    savresS = phiS[2];
    delnewS = phiS[3];
    yyS0new = phiS[4];
    ypS0new = eeS;
  }

  /* For use in the IDA_YA_YP_INIT case, set sysindex and tscale. */

  IDA_mem->ida_sysindex = 1;
  IDA_mem->ida_tscale   = tdist;
  if(icopt == IDA_YA_YDP_INIT) {
    minid = N_VMin(id);
    if(minid < ZERO) {
      IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDACalcIC", MSG_IC_BAD_ID);
      return(IDA_ILL_INPUT);
    }
    if(minid > HALF) IDA_mem->ida_sysindex = 0;
  }

  /* Set the test constant in the Newton convergence test */

  IDA_mem->ida_epsNewt = epiccon;

  /* Initializations: 
     cjratio = 1 (for use in direct linear solvers); 
     set nbacktr = 0; */

  cjratio = ONE;
  nbacktr = 0;

  /* Set hic, hh, cj, and mxnh. */

  hic = PT001*tdist;
  ypnorm = IDAWrmsNorm(IDA_mem, yp0, ewt, suppressalg);

  if (sensi_sim) 
    ypnorm = IDASensWrmsNormUpdate(IDA_mem, ypnorm, ypS0, ewtS, FALSE);

  if(ypnorm > HALF/hic) hic = HALF/ypnorm;
  if(tout1 < tn) hic = -hic;
  hh = hic;
  if(icopt == IDA_YA_YDP_INIT) {
    cj = ONE/hic;
    mxnh = maxnh;
  }
  else {
    cj = ZERO;
    mxnh = 1;
  }

  /* Loop over nwt = number of evaluations of ewt vector. */

  for(nwt = 1; nwt <= 2; nwt++) {
 
    /* Loop over nh = number of h values. */
    for(nh = 1; nh <= mxnh; nh++) {

      /* Call the IC nonlinear solver function. */
      retval = IDANlsIC(IDA_mem);

      /* Cut h and loop on recoverable IDA_YA_YDP_INIT failure; else break. */
      if(retval == IDA_SUCCESS) break;
      ncfn++;
      if(retval < 0) break;
      if(nh == mxnh) break;

      /* If looping to try again, reset yy0 and yp0 if not converging. */
      if(retval != IC_SLOW_CONVRG) {
        N_VScale(ONE, phi[0], yy0);
        N_VScale(ONE, phi[1], yp0);
        if (sensi_sim) {

          /* Reset yyS0 and ypS0. */
          /* Copy phiS[0] and phiS[1] into yyS0 and ypS0. */
          for (is=0; is<Ns; is++) {
            N_VScale(ONE, phiS[0][is], yyS0[is]);         
            N_VScale(ONE, phiS[1][is], ypS0[is]);         
          }
        }
      }
      hic *= PT1;
      cj = ONE/hic;
      hh = hic;
    }   /* End of nh loop */

    /* Break on failure */
    if(retval != IDA_SUCCESS) break;
    
    /* Reset ewt, save yy0, yp0 in phi, and loop. */
    ewtsetOK = efun(yy0, ewt, edata);
    if(ewtsetOK != 0) { 
      retval = IDA_BAD_EWT; 
      break; 
    }
    N_VScale(ONE, yy0, phi[0]);
    N_VScale(ONE, yp0, phi[1]);
    
    if (sensi_sim) {
      
      /* Reevaluate ewtS. */
      ewtsetOK = IDASensEwtSet(IDA_mem, yyS0, ewtS);
      if(ewtsetOK != 0) { 
        retval = IDA_BAD_EWT; 
        break; 
      }
      
      /* Save yyS0 and ypS0. */
      for (is=0; is<Ns; is++) {
            N_VScale(ONE, yyS0[is], phiS[0][is]);         
            N_VScale(ONE, ypS0[is], phiS[1][is]);        
      }
    }

  }   /* End of nwt loop */

  /* Load the optional outputs. */

  if(icopt == IDA_YA_YDP_INIT)   hused = hic;

  /* On any failure, free memory, print error message and return */

  if(retval != IDA_SUCCESS) {
    N_VDestroy(yy0);
    N_VDestroy(yp0);

    if(sensi) {
      N_VDestroyVectorArray(yyS0, Ns);
      N_VDestroyVectorArray(ypS0, Ns);
    }

    icret = IDAICFailFlag(IDA_mem, retval);
    return(icret);
  }

  /* Unless using the STAGGERED approach for sensitivities, return now */

  if (!sensi_stg) {

    N_VDestroy(yy0);
    N_VDestroy(yp0);

    if(sensi) {
      N_VDestroyVectorArray(yyS0, Ns);
      N_VDestroyVectorArray(ypS0, Ns);
    }

    return(IDA_SUCCESS);
  }

  /* Find consistent I.C. for sensitivities using a staggered approach */
 
  
  /* Evaluate res at converged y, needed for future evaluations of sens. RHS 
     If res() fails recoverably, treat it as a convergence failure and 
     attempt the step again */
        
  retval = res(t0, yy0, yp0, delta, user_data);
  nre++;
  if(retval < 0) 
    /* res function failed unrecoverably. */
    return(IDA_RES_FAIL);

  if(retval > 0) 
    /* res function failed recoverably but no recovery possible. */
    return(IDA_FIRST_RES_FAIL);
  
  /* Loop over nwt = number of evaluations of ewt vector. */
  for(nwt = 1; nwt <= 2; nwt++) {
 
    /* Loop over nh = number of h values. */
    for(nh = 1; nh <= mxnh; nh++) {

      retval = IDASensNlsIC(IDA_mem);
      if(retval == IDA_SUCCESS) break;

      /* Increment the number of the sensitivity related corrector convergence failures. */
      ncfnS++;

      if(retval < 0) break;
      if(nh == mxnh) break;

      /* If looping to try again, reset yyS0 and ypS0 if not converging. */
      if(retval != IC_SLOW_CONVRG) {
        for (is=0; is<Ns; is++) {
          N_VScale(ONE, phiS[0][is], yyS0[is]);  
          N_VScale(ONE, phiS[1][is], ypS0[is]);  
        }
      }
      hic *= PT1;
      cj = ONE/hic;
      hh = hic;
        
    }   /* End of nh loop */

    /* Break on failure */
    if(retval != IDA_SUCCESS) break;

    /* Since it was successful, reevaluate ewtS with the new values of yyS0, save 
       yyS0 and ypS0 in phiS[0] and phiS[1] and loop one more time to check and 
       maybe correct the  new sensitivities IC with respect to the new weights. */
    
    /* Reevaluate ewtS. */
    ewtsetOK = IDASensEwtSet(IDA_mem, yyS0, ewtS);
    if(ewtsetOK != 0) { 
      retval = IDA_BAD_EWT; 
      break; 
    }

    /* Save yyS0 and ypS0. */
    for (is=0; is<Ns; is++) {
      N_VScale(ONE, yyS0[is], phiS[0][is]);         
      N_VScale(ONE, ypS0[is], phiS[1][is]);        
    }

  }   /* End of nwt loop */


  /* Load the optional outputs. */
  if(icopt == IDA_YA_YDP_INIT)   hused = hic;

  /* Free temporary space */
  N_VDestroy(yy0);
  N_VDestroy(yp0);

  /* Here sensi is TRUE, so deallocate sensitivity temporary vectors. */
  N_VDestroyVectorArray(yyS0, Ns);
  N_VDestroyVectorArray(ypS0, Ns);


  /* On any failure, print message and return proper flag. */
  if(retval != IDA_SUCCESS) {
    icret = IDAICFailFlag(IDA_mem, retval);
    return(icret);
  }

  /* Otherwise return success flag. */

  return(IDA_SUCCESS);

}
Exemplo n.º 16
0
int IDADense(void *ida_mem, long int Neq)
{
    IDAMem IDA_mem;
    IDADlsMem idadls_mem;
    int flag;

    /* Return immediately if ida_mem is NULL. */
    if (ida_mem == NULL)
    {
        IDAProcessError(NULL, IDADLS_MEM_NULL, "IDADENSE", "IDADense", MSGD_IDAMEM_NULL);
        return(IDADLS_MEM_NULL);
    }
    IDA_mem = (IDAMem) ida_mem;

    /* Test if the NVECTOR package is compatible with the DENSE solver */
    if (vec_tmpl->ops->nvgetarraypointer == NULL ||
            vec_tmpl->ops->nvsetarraypointer == NULL)
    {
        IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDADENSE", "IDADense", MSGD_BAD_NVECTOR);
        return(IDADLS_ILL_INPUT);
    }

    if (lfree != NULL)
    {
        flag = lfree(IDA_mem);
    }

    /* Set five main function fields in IDA_mem. */
    linit  = IDADenseInit;
    lsetup = IDADenseSetup;
    lsolve = IDADenseSolve;
    lperf  = NULL;
    lfree  = IDADenseFree;

    /* Get memory for IDADlsMemRec. */
    idadls_mem = NULL;
    idadls_mem = (IDADlsMem) malloc(sizeof(struct IDADlsMemRec));
    if (idadls_mem == NULL)
    {
        IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDADENSE", "IDADense", MSGD_MEM_FAIL);
        return(IDADLS_MEM_FAIL);
    }

    /* Set matrix type */
    mtype = SUNDIALS_DENSE;

    /* Set default Jacobian routine and Jacobian data */
    jacDQ   = TRUE;
    djac    = NULL;
    jacdata = NULL;

    last_flag = IDADLS_SUCCESS;

    setupNonNull = TRUE;

    /* Store problem size */
    neq = Neq;

    /* Allocate memory for JJ and pivot array. */
    JJ = NULL;
    JJ = NewDenseMat(Neq, Neq);
    if (JJ == NULL)
    {
        IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDADENSE", "IDADense", MSGD_MEM_FAIL);
        free(idadls_mem);
        idadls_mem = NULL;
        return(IDADLS_MEM_FAIL);
    }

    lpivots = NULL;
    lpivots = NewLintArray(Neq);
    if (lpivots == NULL)
    {
        IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDADENSE", "IDADense", MSGD_MEM_FAIL);
        DestroyMat(JJ);
        free(idadls_mem);
        idadls_mem = NULL;
        return(IDADLS_MEM_FAIL);
    }

    /* Attach linear solver memory to the integrator memory */
    lmem = idadls_mem;

    return(IDADLS_SUCCESS);
}
Exemplo n.º 17
0
/*---------------------------------------------------------------
  User-Callable Functions: initialization, reinit and free
  ---------------------------------------------------------------*/
int IDABBDPrecInit(void *ida_mem, sunindextype Nlocal, 
                   sunindextype mudq, sunindextype mldq, 
                   sunindextype mukeep, sunindextype mlkeep, 
                   realtype dq_rel_yy, 
                   IDABBDLocalFn Gres, IDABBDCommFn Gcomm)
{
  IDAMem IDA_mem;
  IDALsMem idals_mem;
  IBBDPrecData pdata;
  sunindextype muk, mlk, storage_mu, lrw1, liw1;
  long int lrw, liw;
  int flag;

  if (ida_mem == NULL) {
    IDAProcessError(NULL, IDALS_MEM_NULL, "IDASBBDPRE",
                    "IDABBDPrecInit", MSGBBD_MEM_NULL);
    return(IDALS_MEM_NULL);
  }
  IDA_mem = (IDAMem) ida_mem;

  /* Test if the LS linear solver interface has been created */
  if (IDA_mem->ida_lmem == NULL) {
    IDAProcessError(IDA_mem, IDALS_LMEM_NULL, "IDASBBDPRE",
                    "IDABBDPrecInit", MSGBBD_LMEM_NULL);
    return(IDALS_LMEM_NULL);
  }
  idals_mem = (IDALsMem) IDA_mem->ida_lmem;

  /* Test compatibility of NVECTOR package with the BBD preconditioner */
  if(IDA_mem->ida_tempv1->ops->nvgetarraypointer == NULL) {
    IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDASBBDPRE",
                    "IDABBDPrecInit", MSGBBD_BAD_NVECTOR);
    return(IDALS_ILL_INPUT);
  }

  /* Allocate data memory. */
  pdata = NULL;
  pdata = (IBBDPrecData) malloc(sizeof *pdata);
  if (pdata == NULL) {
    IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE",
                    "IDABBDPrecInit", MSGBBD_MEM_FAIL);
    return(IDALS_MEM_FAIL);
  }

  /* Set pointers to glocal and gcomm; load half-bandwidths. */
  pdata->ida_mem = IDA_mem;
  pdata->glocal = Gres;
  pdata->gcomm = Gcomm;
  pdata->mudq = SUNMIN(Nlocal-1, SUNMAX(0, mudq));
  pdata->mldq = SUNMIN(Nlocal-1, SUNMAX(0, mldq));
  muk = SUNMIN(Nlocal-1, SUNMAX(0, mukeep));
  mlk = SUNMIN(Nlocal-1, SUNMAX(0, mlkeep));
  pdata->mukeep = muk;
  pdata->mlkeep = mlk;

  /* Set extended upper half-bandwidth for PP (required for pivoting). */
  storage_mu = SUNMIN(Nlocal-1, muk+mlk);

  /* Allocate memory for preconditioner matrix. */
  pdata->PP = NULL;
  pdata->PP = SUNBandMatrixStorage(Nlocal, muk, mlk, storage_mu);
  if (pdata->PP == NULL) { 
    free(pdata); pdata = NULL;
    IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE",
                    "IDABBDPrecInit", MSGBBD_MEM_FAIL);
    return(IDALS_MEM_FAIL); 
  }

  /* Allocate memory for temporary N_Vectors */
  pdata->zlocal = NULL;
  pdata->zlocal = N_VNewEmpty_Serial(Nlocal);
  if (pdata->zlocal == NULL) {
    SUNMatDestroy(pdata->PP);
    free(pdata); pdata = NULL;
    IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE", 
                    "IDABBDPrecInit", MSGBBD_MEM_FAIL);
    return(IDALS_MEM_FAIL);
  }
  pdata->rlocal = NULL;
  pdata->rlocal = N_VNewEmpty_Serial(Nlocal);
  if (pdata->rlocal == NULL) {
    N_VDestroy(pdata->zlocal);
    SUNMatDestroy(pdata->PP);
    free(pdata); pdata = NULL;
    IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE", 
                    "IDABBDPrecInit", MSGBBD_MEM_FAIL);
    return(IDALS_MEM_FAIL);
  }
  pdata->tempv1 = NULL;
  pdata->tempv1 = N_VClone(IDA_mem->ida_tempv1); 
  if (pdata->tempv1 == NULL){
    N_VDestroy(pdata->rlocal);
    N_VDestroy(pdata->zlocal);
    SUNMatDestroy(pdata->PP);
    free(pdata); pdata = NULL;
    IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE",
                    "IDABBDPrecInit", MSGBBD_MEM_FAIL);
    return(IDALS_MEM_FAIL);
  }
  pdata->tempv2 = NULL;
  pdata->tempv2 = N_VClone(IDA_mem->ida_tempv1); 
  if (pdata->tempv2 == NULL){
    N_VDestroy(pdata->rlocal);
    N_VDestroy(pdata->zlocal);
    N_VDestroy(pdata->tempv1);
    SUNMatDestroy(pdata->PP);
    free(pdata); pdata = NULL;
    IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE",
                    "IDABBDPrecInit", MSGBBD_MEM_FAIL);
    return(IDALS_MEM_FAIL);
  }
  pdata->tempv3 = NULL;
  pdata->tempv3 = N_VClone(IDA_mem->ida_tempv1); 
  if (pdata->tempv3 == NULL){
    N_VDestroy(pdata->rlocal);
    N_VDestroy(pdata->zlocal);
    N_VDestroy(pdata->tempv1);
    N_VDestroy(pdata->tempv2);
    SUNMatDestroy(pdata->PP);
    free(pdata); pdata = NULL;
    IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE",
                    "IDABBDPrecInit", MSGBBD_MEM_FAIL);
    return(IDALS_MEM_FAIL);
  }
  pdata->tempv4 = NULL;
  pdata->tempv4 = N_VClone(IDA_mem->ida_tempv1); 
  if (pdata->tempv4 == NULL){
    N_VDestroy(pdata->rlocal);
    N_VDestroy(pdata->zlocal);
    N_VDestroy(pdata->tempv1);
    N_VDestroy(pdata->tempv2);
    N_VDestroy(pdata->tempv3);
    SUNMatDestroy(pdata->PP);
    free(pdata); pdata = NULL;
    IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE",
                    "IDABBDPrecInit", MSGBBD_MEM_FAIL);
    return(IDALS_MEM_FAIL);
  }

  /* Allocate memory for banded linear solver */
  pdata->LS = NULL;
  pdata->LS = SUNLinSol_Band(pdata->rlocal, pdata->PP);
  if (pdata->LS == NULL) {
    N_VDestroy(pdata->zlocal);
    N_VDestroy(pdata->rlocal);
    N_VDestroy(pdata->tempv1);
    N_VDestroy(pdata->tempv2);
    N_VDestroy(pdata->tempv3);
    N_VDestroy(pdata->tempv4);
    SUNMatDestroy(pdata->PP);
    free(pdata); pdata = NULL;
    IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE",
                    "IDABBDPrecInit", MSGBBD_MEM_FAIL);
    return(IDALS_MEM_FAIL);
  }

  /* initialize band linear solver object */
  flag = SUNLinSolInitialize(pdata->LS);
  if (flag != SUNLS_SUCCESS) {
    N_VDestroy(pdata->zlocal);
    N_VDestroy(pdata->rlocal);
    N_VDestroy(pdata->tempv1);
    N_VDestroy(pdata->tempv2);
    N_VDestroy(pdata->tempv3);
    N_VDestroy(pdata->tempv4);
    SUNMatDestroy(pdata->PP);
    SUNLinSolFree(pdata->LS);
    free(pdata); pdata = NULL;
    IDAProcessError(IDA_mem, IDALS_SUNLS_FAIL, "IDASBBDPRE",
                    "IDABBDPrecInit", MSGBBD_SUNLS_FAIL);
    return(IDALS_SUNLS_FAIL);
  }
 
  /* Set rel_yy based on input value dq_rel_yy (0 implies default). */
  pdata->rel_yy = (dq_rel_yy > ZERO) ?
    dq_rel_yy : SUNRsqrt(IDA_mem->ida_uround); 

  /* Store Nlocal to be used in IDABBDPrecSetup */
  pdata->n_local = Nlocal;
  
  /* Set work space sizes and initialize nge. */
  pdata->rpwsize = 0;
  pdata->ipwsize = 0;
  if (IDA_mem->ida_tempv1->ops->nvspace) {
    N_VSpace(IDA_mem->ida_tempv1, &lrw1, &liw1);
    pdata->rpwsize += 4*lrw1;
    pdata->ipwsize += 4*liw1;
  }
  if (pdata->rlocal->ops->nvspace) {
    N_VSpace(pdata->rlocal, &lrw1, &liw1);
    pdata->rpwsize += 2*lrw1;
    pdata->ipwsize += 2*liw1;
  }
  if (pdata->PP->ops->space) {
    flag = SUNMatSpace(pdata->PP, &lrw, &liw);
    pdata->rpwsize += lrw;
    pdata->ipwsize += liw;
  }
  if (pdata->LS->ops->space) {
    flag = SUNLinSolSpace(pdata->LS, &lrw, &liw);
    pdata->rpwsize += lrw;
    pdata->ipwsize += liw;
  }
  pdata->nge = 0;

  /* make sure pdata is free from any previous allocations */
  if (idals_mem->pfree) 
    idals_mem->pfree(IDA_mem);

  /* Point to the new pdata field in the LS memory */
  idals_mem->pdata = pdata;

  /* Attach the pfree function */
  idals_mem->pfree = IDABBDPrecFree;

  /* Attach preconditioner solve and setup functions */
  flag = IDASetPreconditioner(ida_mem, IDABBDPrecSetup,
                              IDABBDPrecSolve);

  return(flag);
}
Exemplo n.º 18
0
/*
 * -----------------------------------------------------------------
 * IDALapackBand
 * -----------------------------------------------------------------
 * This routine initializes the memory record and sets various function
 * fields specific to the band linear solver module. It first calls
 * the existing lfree routine if this is not NULL.  It then sets the
 * ida_linit, ida_lsetup, ida_lsolve, and ida_lfree fields in (*ida_mem)
 * to be idaLapackBandInit, idaLapackBandSetup, idaLapackBandSolve, 
 * and idaLapackBandFree, respectively.  It allocates memory for a 
 * structure of type IDALapackBandMemRec and sets the ida_lmem field in 
 * (*ida_mem) to the address of this structure.  It sets setupNonNull 
 * in (*ida_mem) to be TRUE, mu to be mupper, ml to be mlower, and 
 * the jacE and jacI field to NULL.
 * Finally, it allocates memory for M and pivots.
 * The IDALapackBand return value is IDADLS_SUCCESS = 0, 
 * IDADLS_MEM_FAIL = -1, or IDADLS_ILL_INPUT = -2.
 *
 * NOTE: The IDALAPACK linear solver assumes a serial implementation
 *       of the NVECTOR package. Therefore, IDALapackBand will first 
 *       test for compatible a compatible N_Vector internal
 *       representation by checking that the function 
 *       N_VGetArrayPointer exists.
 * -----------------------------------------------------------------
 */                  
int IDALapackBand(void *ida_mem, int N, int mupper, int mlower)
{
  IDAMem IDA_mem;
  IDADlsMem idadls_mem;

  /* Return immediately if ida_mem is NULL */
  if (ida_mem == NULL) {
    IDAProcessError(NULL, IDADLS_MEM_NULL, "IDALAPACK", "IDALapackBand", MSGD_IDAMEM_NULL);
    return(IDADLS_MEM_NULL);
  }
  IDA_mem = (IDAMem) ida_mem;

  /* Test if the NVECTOR package is compatible with the BAND solver */
  if (tempv->ops->nvgetarraypointer == NULL) {
    IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDALAPACK", "IDALapackBand", MSGD_BAD_NVECTOR);
    return(IDADLS_ILL_INPUT);
  }

  if (lfree != NULL) lfree(IDA_mem);

  /* Set four main function fields in IDA_mem */  
  linit  = idaLapackBandInit;
  lsetup = idaLapackBandSetup;
  lsolve = idaLapackBandSolve;
  lperf  = NULL;
  lfree  = idaLapackBandFree;
  
  /* Get memory for IDADlsMemRec */
  idadls_mem = NULL;
  idadls_mem = (IDADlsMem) malloc(sizeof(struct IDADlsMemRec));
  if (idadls_mem == NULL) {
    IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDALAPACK", "IDALapackBand", MSGD_MEM_FAIL);
    return(IDADLS_MEM_FAIL);
  }

  /* Set matrix type */
  mtype = SUNDIALS_BAND;

  /* Set default Jacobian routine and Jacobian data */
  jacDQ  = TRUE;
  bjac   = NULL;
  J_data = NULL;

  last_flag = IDADLS_SUCCESS;
  setupNonNull = TRUE;
  
  /* Load problem dimension */
  n = (long int) N;

  /* Load half-bandwiths in idadls_mem */
  ml = (long int) mlower;
  mu = (long int) mupper;

  /* Test ml and mu for legality */
  if ((ml < 0) || (mu < 0) || (ml >= n) || (mu >= n)) {
    IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDALAPACK", "IDALapackBand", MSGD_BAD_SIZES);
    free(idadls_mem); idadls_mem = NULL;
    return(IDADLS_ILL_INPUT);
  }

  /* Set extended upper half-bandwith for M (required for pivoting) */
  smu = MIN(n-1, mu + ml);

  /* Allocate memory for JJ and pivot arrays */
  JJ = NULL;
  pivots = NULL;

  JJ = NewBandMat(n, mu, ml, smu);
  if (JJ == NULL) {
    IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDALAPACK", "IDALapackBand", MSGD_MEM_FAIL);
    free(idadls_mem); idadls_mem = NULL;
    return(IDADLS_MEM_FAIL);
  }  
  pivots = NewIntArray(N);
  if (pivots == NULL) {
    IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDALAPACK", "IDALapackBand", MSGD_MEM_FAIL);
    DestroyMat(JJ);
    free(idadls_mem); idadls_mem = NULL;
    return(IDADLS_MEM_FAIL);
  }

  /* Attach linear solver memory to integrator memory */
  lmem = idadls_mem;

  return(IDADLS_SUCCESS);
}
Exemplo n.º 19
0
/*
 * -----------------------------------------------------------------
 * IDALapackDense
 * -----------------------------------------------------------------
 * This routine initializes the memory record and sets various function
 * fields specific to the linear solver module.  IDALapackDense first
 * calls the existing lfree routine if this is not NULL.  Then it sets
 * the ida_linit, ida_lsetup, ida_lsolve, ida_lfree fields in (*ida_mem)
 * to be idaLapackDenseInit, idaLapackDenseSetup, idaLapackDenseSolve, 
 * and idaLapackDenseFree, respectively.  It allocates memory for a 
 * structure of type IDADlsMemRec and sets the ida_lmem field in 
 * (*ida_mem) to the address of this structure.  It sets setupNonNull 
 * in (*ida_mem) to TRUE, and the d_jac field to the default 
 * idaLapackDenseDQJac. Finally, it allocates memory for M, pivots.
 *
 * The return value is SUCCESS = 0, or LMEM_FAIL = -1.
 *
 * NOTE: The dense linear solver assumes a serial implementation
 *       of the NVECTOR package. Therefore, IDALapackDense will first 
 *       test for a compatible N_Vector internal representation 
 *       by checking that N_VGetArrayPointer and N_VSetArrayPointer 
 *       exist.
 * -----------------------------------------------------------------
 */
int IDALapackDense(void *ida_mem, int N)
{
  IDAMem IDA_mem;
  IDADlsMem idadls_mem;

  /* Return immediately if ida_mem is NULL */
  if (ida_mem == NULL) {
    IDAProcessError(NULL, IDADLS_MEM_NULL, "IDALAPACK", "IDALapackDense", MSGD_IDAMEM_NULL);
    return(IDADLS_MEM_NULL);
  }
  IDA_mem = (IDAMem) ida_mem;

  /* Test if the NVECTOR package is compatible with the LAPACK solver */
  if (tempv->ops->nvgetarraypointer == NULL ||
      tempv->ops->nvsetarraypointer == NULL) {
    IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDALAPACK", "IDALapackDense", MSGD_BAD_NVECTOR);
    return(IDADLS_ILL_INPUT);
  }

  if (lfree !=NULL) lfree(IDA_mem);

  /* Set four main function fields in IDA_mem */
  linit  = idaLapackDenseInit;
  lsetup = idaLapackDenseSetup;
  lsolve = idaLapackDenseSolve;
  lperf  = NULL;
  lfree  = idaLapackDenseFree;

  /* Get memory for IDADlsMemRec */
  idadls_mem = NULL;
  idadls_mem = (IDADlsMem) malloc(sizeof(struct IDADlsMemRec));
  if (idadls_mem == NULL) {
    IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDALAPACK", "IDALapackDense", MSGD_MEM_FAIL);
    return(IDADLS_MEM_FAIL);
  }

  /* Set matrix type */
  mtype = SUNDIALS_DENSE;

  /* Set default Jacobian routine and Jacobian data */
  jacDQ  = TRUE;
  djac   = NULL;
  J_data = NULL;

  last_flag = IDADLS_SUCCESS;
  setupNonNull = TRUE;

  /* Set problem dimension */
  n = (long int) N;

  /* Allocate memory for JJ and pivot array */
  JJ = NULL;
  pivots = NULL;

  JJ = NewDenseMat(n, n);
  if (JJ == NULL) {
    IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDALAPACK", "IDALapackDense", MSGD_MEM_FAIL);
    free(idadls_mem); idadls_mem = NULL;
    return(IDADLS_MEM_FAIL);
  }
  pivots = NewIntArray(N);
  if (pivots == NULL) {
    IDAProcessError(IDA_mem, IDADLS_MEM_FAIL, "IDALAPACK", "IDALapackDense", MSGD_MEM_FAIL);
    DestroyMat(JJ);
    free(idadls_mem); idadls_mem = NULL;
    return(IDADLS_MEM_FAIL);
  }

  /* Attach linear solver memory to integrator memory */
  lmem = idadls_mem;

  return(IDADLS_SUCCESS);
}
void *IDABBDPrecAlloc(void *ida_mem, long int Nlocal, 
		      long int mudq, long int mldq, 
		      long int mukeep, long int mlkeep, 
		      realtype dq_rel_yy, 
		      IDABBDLocalFn Gres, IDABBDCommFn Gcomm)
{
  IDAMem IDA_mem;
  IBBDPrecData pdata;
  N_Vector tempv4;
  long int muk, mlk, storage_mu;

  if (ida_mem == NULL) {
    IDAProcessError(NULL, 0, "IDABBDPRE", "IDABBDPrecAlloc", MSGBBD_IDAMEM_NULL);
    return(NULL);
  }

  IDA_mem = (IDAMem) ida_mem;

  /* Test if the NVECTOR package is compatible with BLOCK BAND preconditioner */
  if(vec_tmpl->ops->nvgetarraypointer == NULL) {
    IDAProcessError(IDA_mem, 0, "IDABBDPRE", "IDABBDPrecAlloc", MSGBBD_BAD_NVECTOR);
    return(NULL);
  }

  /* Allocate data memory. */
  pdata = NULL;
  pdata = (IBBDPrecData) malloc(sizeof *pdata);
  if (pdata == NULL) {
    IDAProcessError(IDA_mem, 0, "IDABBDPRE", "IDABBDPrecAlloc", MSGBBD_MEM_FAIL);
    return(NULL);
  }

  /* Set pointers to glocal and gcomm; load half-bandwidths. */
  pdata->ida_mem = IDA_mem;
  pdata->glocal = Gres;
  pdata->gcomm = Gcomm;
  pdata->mudq = MIN(Nlocal-1, MAX(0, mudq));
  pdata->mldq = MIN(Nlocal-1, MAX(0, mldq));
  muk = MIN(Nlocal-1, MAX(0, mukeep));
  mlk = MIN(Nlocal-1, MAX(0, mlkeep));
  pdata->mukeep = muk;
  pdata->mlkeep = mlk;

  /* Set extended upper half-bandwidth for PP (required for pivoting). */
  storage_mu = MIN(Nlocal-1, muk+mlk);

  /* Allocate memory for preconditioner matrix. */
  pdata->PP = NULL;
  pdata->PP = BandAllocMat(Nlocal, muk, mlk, storage_mu);
  if (pdata->PP == NULL) { 
    free(pdata); pdata = NULL;
    IDAProcessError(IDA_mem, 0, "IDABBDPRE", "IDABBDPrecAlloc", MSGBBD_MEM_FAIL);
    return(NULL); 
  }

  /* Allocate memory for pivots. */
  pdata->pivots = NULL;
  pdata->pivots = BandAllocPiv(Nlocal);
  if (pdata->PP == NULL) {
    BandFreeMat(pdata->PP);
    free(pdata); pdata = NULL;
    IDAProcessError(IDA_mem, 0, "IDABBDPRE", "IDABBDPrecAlloc", MSGBBD_MEM_FAIL);
    return(NULL);
  }

  /* Allocate tempv4 for use by IBBDDQJac */
  tempv4 = NULL;
  tempv4 = N_VClone(vec_tmpl); 
  if (tempv4 == NULL){
    BandFreeMat(pdata->PP);
    BandFreePiv(pdata->pivots);
    free(pdata); pdata = NULL;
    IDAProcessError(IDA_mem, 0, "IDABBDPRE", "IDABBDPrecAlloc", MSGBBD_MEM_FAIL);
    return(NULL);
  }
  pdata->tempv4 = tempv4;
  
  /* Set rel_yy based on input value dq_rel_yy (0 implies default). */
  pdata->rel_yy = (dq_rel_yy > ZERO) ? dq_rel_yy : RSqrt(uround); 

  /* Store Nlocal to be used in IDABBDPrecSetup */
  pdata->n_local = Nlocal;
  
  /* Set work space sizes and initialize nge. */
  pdata->rpwsize = Nlocal*(mlk + storage_mu + 1);
  pdata->ipwsize = Nlocal;
  pdata->nge = 0;

  return((void *)pdata);
}
Exemplo n.º 21
0
int IDABandB(void *ida_mem, int which,
             int NeqB, int mupperB, int mlowerB)
{
  IDAMem IDA_mem;
  IDAadjMem IDAADJ_mem;
  IDABMem IDAB_mem;
  IDADlsMemB idadlsB_mem;
  void *ida_memB;
  int flag;
  
  /* Is ida_mem allright? */
  if (ida_mem == NULL) {
    IDAProcessError(NULL, IDADLS_MEM_NULL, "IDASBAND", "IDABandB", MSGD_CAMEM_NULL);
    return(IDADLS_MEM_NULL);
  }
  IDA_mem = (IDAMem) ida_mem;

  /* Is ASA initialized? */
  if (IDA_mem->ida_adjMallocDone == FALSE) {
    IDAProcessError(IDA_mem, IDADLS_NO_ADJ, "IDASBAND", "IDABandB",  MSGD_NO_ADJ);
    return(IDADLS_NO_ADJ);
  }
  IDAADJ_mem = IDA_mem->ida_adj_mem;

  /* Check the value of which */
  if ( which >= IDAADJ_mem->ia_nbckpbs ) {
    IDAProcessError(IDA_mem, IDADLS_ILL_INPUT, "IDASBAND", "IDABandB", MSGD_BAD_WHICH);
    return(IDADLS_ILL_INPUT);
  }

  /* Find the IDABMem entry in the linked list corresponding to 'which'. */
  IDAB_mem = IDAADJ_mem->IDAB_mem;
  while (IDAB_mem != NULL) {
    if( which == IDAB_mem->ida_index ) break;
    /* advance */
    IDAB_mem = IDAB_mem->ida_next;
  }

  /* Get memory for IDADlsMemRecB */
  idadlsB_mem = (IDADlsMemB) malloc(sizeof(struct IDADlsMemRecB));
  if (idadlsB_mem == NULL) {
    IDAProcessError(IDAB_mem->IDA_mem, IDADLS_MEM_FAIL, "IDASBAND", "IDABandB", MSGD_MEM_FAIL);
    return(IDADLS_MEM_FAIL);
  
  }

  /* set matrix type and initialize Jacob function. */
  idadlsB_mem->d_typeB = SUNDIALS_BAND;
  idadlsB_mem->d_bjacB = NULL;


  /* Attach lmemB data and lfreeB function. */
  IDAB_mem->ida_lmem  = idadlsB_mem;
  IDAB_mem->ida_lfree = IDABandFreeB;

  /* Call IDABand for the IDAS data of the backward problem. */
  ida_memB = (void *)IDAB_mem->IDA_mem;
  flag = IDABand(ida_memB, NeqB, mupperB, mlowerB);

  if (flag != IDADLS_SUCCESS) {
    free(idadlsB_mem);
    idadlsB_mem = NULL;
  }

  return(flag);
}
Exemplo n.º 22
0
int IDASpbcgB(void *ida_mem, int which, int maxlB)
{
  IDAMem IDA_mem;
  IDAadjMem IDAADJ_mem;
  IDABMem IDAB_mem;
  IDASpilsMemB idaspilsB_mem;
  void *ida_memB;
  int flag;
  
  /* Check if ida_mem is allright. */
  if (ida_mem == NULL) {
    IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPBCG", "IDASpbcgB", MSGS_IDAMEM_NULL);
    return(IDASPILS_MEM_NULL);
  }
  IDA_mem = (IDAMem) ida_mem;

  /* Is ASA initialized? */
  if (IDA_mem->ida_adjMallocDone == FALSE) {
    IDAProcessError(IDA_mem, IDASPILS_NO_ADJ, "IDASPBCG", "IDASpbcgB",  MSGS_NO_ADJ);
    return(IDASPILS_NO_ADJ);
  }
  IDAADJ_mem = IDA_mem->ida_adj_mem;

  /* Check the value of which */
  if ( which >= IDAADJ_mem->ia_nbckpbs ) {
    IDAProcessError(IDA_mem, IDASPILS_ILL_INPUT, "IDASPBCG", "IDASpbcgB", MSGS_BAD_WHICH);
    return(IDASPILS_ILL_INPUT);
  }

  /* Find the IDABMem entry in the linked list corresponding to 'which'. */
  IDAB_mem = IDAADJ_mem->IDAB_mem;
  while (IDAB_mem != NULL) {
    if( which == IDAB_mem->ida_index ) break;
    /* advance */
    IDAB_mem = IDAB_mem->ida_next;
  }
  /* ida_mem corresponding to 'which' problem. */
  ida_memB = (void *) IDAB_mem->IDA_mem;

  
  /* Get memory for IDASpilsMemRecB */
  idaspilsB_mem = NULL;
  idaspilsB_mem = (IDASpilsMemB) malloc(sizeof(struct IDASpilsMemRecB));
  if (idaspilsB_mem == NULL) {
    IDAProcessError(IDA_mem, IDASPILS_MEM_FAIL, "IDASPBCG", "IDASpbcgB", MSGS_MEM_FAIL);
    return(IDASPILS_MEM_FAIL);
  }

  idaspilsB_mem->s_psetB = NULL;
  idaspilsB_mem->s_psolveB = NULL;
  idaspilsB_mem->s_P_dataB = NULL;

  /* initialize Jacobian function */
  idaspilsB_mem->s_jtimesB = NULL;

  /* attach lmem and lfree */
  IDAB_mem->ida_lmem = idaspilsB_mem;
  IDAB_mem->ida_lfree = IDASpbcgFreeB;

  flag = IDASpbcg(IDAB_mem->IDA_mem, maxlB);

  if (flag != IDASPILS_SUCCESS) {
    free(idaspilsB_mem);
    idaspilsB_mem = NULL;
  }

  return(flag);
}
Exemplo n.º 23
0
int IDACalcIC(void *ida_mem, int icopt, realtype tout1)
{
  int ewtsetOK;
  int ier, nwt, nh, mxnh, icret, retval=0;
  realtype tdist, troundoff, minid, hic, ypnorm;
  IDAMem IDA_mem;

  /* Check if IDA memory exists */

  if(ida_mem == NULL) {
    IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDACalcIC", MSG_NO_MEM);
    return(IDA_MEM_NULL);
  }
  IDA_mem = (IDAMem) ida_mem;

  /* Check if problem was malloc'ed */
  
  if(IDA_mem->ida_MallocDone == FALSE) {
    IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDA", "IDACalcIC", MSG_NO_MALLOC);
    return(IDA_NO_MALLOC);
  }

  /* Check inputs to IDA for correctness and consistency */

  ier = IDAInitialSetup(IDA_mem);
  if(ier != IDA_SUCCESS) return(IDA_ILL_INPUT);
  IDA_mem->ida_SetupDone = TRUE;

  /* Check legality of input arguments, and set IDA memory copies. */

  if(icopt != IDA_YA_YDP_INIT && icopt != IDA_Y_INIT) {
    IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDACalcIC", MSG_IC_BAD_ICOPT);
    return(IDA_ILL_INPUT);
  }
  IDA_mem->ida_icopt = icopt;

  if(icopt == IDA_YA_YDP_INIT && (id == NULL)) {
    IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDACalcIC", MSG_IC_MISSING_ID);
    return(IDA_ILL_INPUT);
  }

  tdist = SUNRabs(tout1 - tn);
  troundoff = TWO*uround*(SUNRabs(tn) + SUNRabs(tout1));
  if(tdist < troundoff) {
    IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDACalcIC", MSG_IC_TOO_CLOSE);
    return(IDA_ILL_INPUT);
  }

  /* Allocate space and initialize temporary vectors */

  yy0 = N_VClone(ee);
  yp0 = N_VClone(ee);
  t0  = tn;
  N_VScale(ONE, phi[0], yy0);
  N_VScale(ONE, phi[1], yp0);

  /* For use in the IDA_YA_YP_INIT case, set sysindex and tscale. */

  IDA_mem->ida_sysindex = 1;
  IDA_mem->ida_tscale   = tdist;
  if(icopt == IDA_YA_YDP_INIT) {
    minid = N_VMin(id);
    if(minid < ZERO) {
      IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDACalcIC", MSG_IC_BAD_ID);
      return(IDA_ILL_INPUT);
    }
    if(minid > HALF) IDA_mem->ida_sysindex = 0;
  }

  /* Set the test constant in the Newton convergence test */

  IDA_mem->ida_epsNewt = epiccon;

  /* Initializations: 
     cjratio = 1 (for use in direct linear solvers); 
     set nbacktr = 0; */

  cjratio = ONE;
  nbacktr = 0;

  /* Set hic, hh, cj, and mxnh. */

  hic = PT001*tdist;
  ypnorm = IDAWrmsNorm(IDA_mem, yp0, ewt, suppressalg);
  if(ypnorm > HALF/hic) hic = HALF/ypnorm;
  if(tout1 < tn) hic = -hic;
  hh = hic;
  if(icopt == IDA_YA_YDP_INIT) {
    cj = ONE/hic;
    mxnh = maxnh;
  }
  else {
    cj = ZERO;
    mxnh = 1;
  }

  /* Loop over nwt = number of evaluations of ewt vector. */

  for(nwt = 1; nwt <= 2; nwt++) {
 
    /* Loop over nh = number of h values. */
    for(nh = 1; nh <= mxnh; nh++) {

      /* Call the IC nonlinear solver function. */
      retval = IDAnlsIC(IDA_mem);

      /* Cut h and loop on recoverable IDA_YA_YDP_INIT failure; else break. */
      if(retval == IDA_SUCCESS) break;
      ncfn++;
      if(retval < 0) break;
      if(nh == mxnh) break;
      /* If looping to try again, reset yy0 and yp0 if not converging. */
      if(retval != IC_SLOW_CONVRG) {
        N_VScale(ONE, phi[0], yy0);
        N_VScale(ONE, phi[1], yp0);
      }
      hic *= PT1;
      cj = ONE/hic;
      hh = hic;
    }   /* End of nh loop */

    /* Break on failure; else reset ewt, save yy0, yp0 in phi, and loop. */
    if(retval != IDA_SUCCESS) break;
    ewtsetOK = efun(yy0, ewt, edata);
    if(ewtsetOK != 0) { 
      retval = IDA_BAD_EWT; 
      break; 
    }
    N_VScale(ONE, yy0, phi[0]);
    N_VScale(ONE, yp0, phi[1]);

  }   /* End of nwt loop */

  /* Free temporary space */

  N_VDestroy(yy0);
  N_VDestroy(yp0);

  /* Load the optional outputs. */

  if(icopt == IDA_YA_YDP_INIT)   hused = hic;

  /* On any failure, print message and return proper flag. */

  if(retval != IDA_SUCCESS) {
    icret = IDAICFailFlag(IDA_mem, retval);
    return(icret);
  }

  /* Otherwise return success flag. */

  return(IDA_SUCCESS);

}
Exemplo n.º 24
0
int IDASetNonlinearSolver(void *ida_mem, SUNNonlinearSolver NLS)
{
  IDAMem IDA_mem;
  int retval;

  /* return immediately if IDA memory is NULL */
  if (ida_mem == NULL) {
    IDAProcessError(NULL, IDA_MEM_NULL, "IDA",
                    "IDASetNonlinearSolver", MSG_NO_MEM);
    return(IDA_MEM_NULL);
  }
  IDA_mem = (IDAMem) ida_mem;

  /* return immediately if NLS memory is NULL */
  if (NLS == NULL) {
    IDAProcessError(NULL, IDA_ILL_INPUT, "IDA",
                    "IDASetNonlinearSolver",
                    "NLS must be non-NULL");
    return(IDA_ILL_INPUT);
  }

  /* check for required nonlinear solver functions */
  if ( NLS->ops->gettype    == NULL ||
       NLS->ops->initialize == NULL ||
       NLS->ops->solve      == NULL ||
       NLS->ops->free       == NULL ||
       NLS->ops->setsysfn   == NULL ) {
    IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA",
                    "IDASetNonlinearSolver",
                    "NLS does not support required operations");
    return(IDA_ILL_INPUT);
  }

  /* check for allowed nonlinear solver types */
  if (SUNNonlinSolGetType(NLS) != SUNNONLINEARSOLVER_ROOTFIND) {
    IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA",
                    "IDASetNonlinearSolver",
                    "NLS type must be SUNNONLINEARSOLVER_ROOTFIND");
    return(IDA_ILL_INPUT);
  }

  /* free any existing nonlinear solver */
  if (IDA_mem->NLS) retval = SUNNonlinSolFree(IDA_mem->NLS);

  /* set SUNNonlinearSolver pointer */
  IDA_mem->NLS = NLS;

  /* Set NLS ownership flag. If this function was called to attach the default
     NLS, IDA will set the flag to SUNTRUE after this function returns. */
  IDA_mem->ownNLS = SUNFALSE;

  /* set the nonlinear residual function */
  retval = SUNNonlinSolSetSysFn(IDA_mem->NLS, idaNlsResidual);
  if (retval != IDA_SUCCESS) {
    IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA",
                    "IDASetNonlinearSolver",
                    "Setting nonlinear system function failed");
    return(IDA_ILL_INPUT);
  }

  /* set convergence test function */
  retval = SUNNonlinSolSetConvTestFn(IDA_mem->NLS, idaNlsConvTest);
  if (retval != IDA_SUCCESS) {
    IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA",
                    "IDASetNonlinearSolver",
                    "Setting convergence test function failed");
    return(IDA_ILL_INPUT);
  }

  /* set max allowed nonlinear iterations */
  retval = SUNNonlinSolSetMaxIters(IDA_mem->NLS, MAXIT);
  if (retval != IDA_SUCCESS) {
    IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA",
                    "IDASetNonlinearSolver",
                    "Setting maximum number of nonlinear iterations failed");
    return(IDA_ILL_INPUT);
  }

  return(IDA_SUCCESS);
}
Exemplo n.º 25
0
int IDASpbcg(void *ida_mem, int maxl)
{
  IDAMem IDA_mem;
  IDASpilsMem idaspils_mem;
  SpbcgMem spbcg_mem;
  int flag, maxl1;

  /* Return immediately if ida_mem is NULL */
  if (ida_mem == NULL) {
    IDAProcessError(NULL, IDASPILS_MEM_NULL, "IDASPBCG", "IDASpbcg", MSGS_IDAMEM_NULL);
    return(IDASPILS_MEM_NULL);
  }
  IDA_mem = (IDAMem) ida_mem;

  /* Check if N_VDotProd is present */
  if (vec_tmpl->ops->nvdotprod == NULL) {
    IDAProcessError(NULL, IDASPILS_ILL_INPUT, "IDASPBCG", "IDASpbcg", MSGS_BAD_NVECTOR);
    return(IDASPILS_ILL_INPUT);
  }

  if (lfree != NULL) flag = lfree((IDAMem) ida_mem);

  /* Set five main function fields in ida_mem */
  linit  = IDASpbcgInit;
  lsetup = IDASpbcgSetup;
  lsolve = IDASpbcgSolve;
  lperf  = IDASpbcgPerf;
  lfree  = IDASpbcgFree;

  /* Get memory for IDASpilsMemRec */
  idaspils_mem = NULL;
  idaspils_mem = (IDASpilsMem) malloc(sizeof(struct IDASpilsMemRec));
  if (idaspils_mem == NULL) {
    IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPBCG", "IDASpbcg", MSGS_MEM_FAIL);
    return(IDASPILS_MEM_FAIL);
  }

  /* Set ILS type */
  idaspils_mem->s_type = SPILS_SPBCG;

  /* Set SPBCG parameters that were passed in call sequence */
  maxl1 = (maxl <= 0) ? IDA_SPILS_MAXL : maxl;
  idaspils_mem->s_maxl = maxl1;

  /* Set defaults for Jacobian-related fileds */
  jtimesDQ = TRUE;
  jtimes   = NULL;
  jdata    = NULL;

  /* Set defaults for preconditioner-related fields */
  idaspils_mem->s_pset   = NULL;
  idaspils_mem->s_psolve = NULL;
  idaspils_mem->s_pfree  = NULL;
  idaspils_mem->s_pdata  = IDA_mem->ida_user_data;

  /* Set default values for the rest of the Spbcg parameters */
  idaspils_mem->s_eplifac   = PT05;
  idaspils_mem->s_dqincfac  = ONE;

  idaspils_mem->s_last_flag = IDASPILS_SUCCESS;

  /* Set setupNonNull to FALSE */
  setupNonNull = FALSE;

  /* Allocate memory for ytemp, yptemp, and xx */

  ytemp = N_VClone(vec_tmpl);
  if (ytemp == NULL) {
    IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPBCG", "IDASpbcg", MSGS_MEM_FAIL);
    free(idaspils_mem); idaspils_mem = NULL;
    return(IDASPILS_MEM_FAIL);
  }

  yptemp = N_VClone(vec_tmpl);
  if (yptemp == NULL) {
    IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPBCG", "IDASpbcg", MSGS_MEM_FAIL);
    N_VDestroy(ytemp);
    free(idaspils_mem); idaspils_mem = NULL;
    return(IDASPILS_MEM_FAIL);
  }

  xx = N_VClone(vec_tmpl);
  if (xx == NULL) {
    IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPBCG", "IDASpbcg", MSGS_MEM_FAIL);
    N_VDestroy(ytemp);
    N_VDestroy(yptemp);
    free(idaspils_mem); idaspils_mem = NULL;
    return(IDASPILS_MEM_FAIL);
  }

  /* Compute sqrtN from a dot product */
  N_VConst(ONE, ytemp);
  sqrtN = SUNRsqrt(N_VDotProd(ytemp, ytemp));

  /* Call SpbcgMalloc to allocate workspace for Spbcg */
  spbcg_mem = NULL;
  spbcg_mem = SpbcgMalloc(maxl1, vec_tmpl);
  if (spbcg_mem == NULL) {
    IDAProcessError(NULL, IDASPILS_MEM_FAIL, "IDASPBCG", "IDASpbcg", MSGS_MEM_FAIL);
    N_VDestroy(ytemp);
    N_VDestroy(yptemp);
    N_VDestroy(xx);
    free(idaspils_mem); idaspils_mem = NULL;
    return(IDASPILS_MEM_FAIL);
  }

  /* Attach SPBCG memory to spils memory structure */
  spils_mem = (void *)spbcg_mem;

  /* Attach linear solver memory to the integrator memory */
  lmem = idaspils_mem;

  return(IDASPILS_SUCCESS);
}
Exemplo n.º 26
0
/*---------------------------------------------------------------
  User-Callable Functions: initialization, reinit and free
  ---------------------------------------------------------------*/
int IDABBDPrecInitB(void *ida_mem, int which, sunindextype NlocalB,
                    sunindextype mudqB, sunindextype mldqB,
                    sunindextype mukeepB, sunindextype mlkeepB,
                    realtype dq_rel_yyB, IDABBDLocalFnB glocalB, 
                    IDABBDCommFnB gcommB)
{
  IDAMem IDA_mem;
  IDAadjMem IDAADJ_mem;
  IDABMem IDAB_mem;
  IDABBDPrecDataB idabbdB_mem;
  void *ida_memB;
  int flag;
  
  /* Check if ida_mem is allright. */
  if (ida_mem == NULL) {
    IDAProcessError(NULL, IDALS_MEM_NULL, "IDASBBDPRE",
                    "IDABBDPrecInitB", MSG_LS_IDAMEM_NULL);
    return(IDALS_MEM_NULL);
  }
  IDA_mem = (IDAMem) ida_mem;

  /* Is ASA initialized? */
  if (IDA_mem->ida_adjMallocDone == SUNFALSE) {
    IDAProcessError(IDA_mem, IDALS_NO_ADJ, "IDASBBDPRE",
                    "IDABBDPrecInitB", MSG_LS_NO_ADJ);
    return(IDALS_NO_ADJ);
  }
  IDAADJ_mem = IDA_mem->ida_adj_mem;

  /* Check the value of which */
  if ( which >= IDAADJ_mem->ia_nbckpbs ) {
    IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDASBBDPRE",
                    "IDABBDPrecInitB", MSG_LS_BAD_WHICH);
    return(IDALS_ILL_INPUT);
  }

  /* Find the IDABMem entry in the linked list corresponding to 'which'. */
  IDAB_mem = IDAADJ_mem->IDAB_mem;
  while (IDAB_mem != NULL) {
    if( which == IDAB_mem->ida_index ) break;
    /* advance */
    IDAB_mem = IDAB_mem->ida_next;
  }
  /* ida_mem corresponding to 'which' problem. */
  ida_memB = (void *) IDAB_mem->IDA_mem;

  /* Initialize the BBD preconditioner for this backward problem. */
  flag = IDABBDPrecInit(ida_memB, NlocalB, mudqB, mldqB, mukeepB,
                        mlkeepB, dq_rel_yyB, IDAAglocal, IDAAgcomm);
  if (flag != IDA_SUCCESS) return(flag);

  /* Allocate memory for IDABBDPrecDataB to store the user-provided
     functions which will be called from the wrappers */
  idabbdB_mem = NULL;
  idabbdB_mem = (IDABBDPrecDataB) malloc(sizeof(* idabbdB_mem));
  if (idabbdB_mem == NULL) {
    IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE",
                    "IDABBDPrecInitB", MSGBBD_MEM_FAIL);
    return(IDALS_MEM_FAIL);
  }

  /* set pointers to user-provided functions */
  idabbdB_mem->glocalB = glocalB;
  idabbdB_mem->gcommB  = gcommB;

  /* Attach pmem and pfree */
  IDAB_mem->ida_pmem  = idabbdB_mem;
  IDAB_mem->ida_pfree = IDABBDPrecFreeB;

  return(IDALS_SUCCESS);
}