Пример #1
0
static int
CVDenseSetup(CVodeMem cv_mem, int convfail, N_Vector ypred,
			 N_Vector fpred, booleantype * jcurPtr,
			 N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3)
{
	booleantype jbad, jok;
	realtype dgamma;
	integertype ier;
	CVDenseMem cvdense_mem;

	cvdense_mem = (CVDenseMem) lmem;

	/* Use nst, gamma/gammap, and convfail to set J eval. flag jok */

	dgamma = ABS((gamma / gammap) - ONE);
	jbad = (nst == 0) || (nst > nstlj + CVD_MSBJ) ||
		((convfail == FAIL_BAD_J) && (dgamma < CVD_DGMAX)) ||
		(convfail == FAIL_OTHER);
	jok = !jbad;

	if (jok)
	{
		/* If jok = TRUE, use saved copy of J */
		*jcurPtr = FALSE;
		DenseCopy(savedJ, M);
	}
	else
	{
		/* If jok = FALSE, call jac routine for new J value */
		nje++;
		if (iopt != NULL)
			iopt[DENSE_NJE] = nje;
		nstlj = nst;
		*jcurPtr = TRUE;
		DenseZero(M);
		jac(N, M, f, f_data, tn, ypred, fpred, ewt, h,
			uround, J_data, &nfe, vtemp1, vtemp2, vtemp3);
		DenseCopy(M, savedJ);
	}

	/* Scale and add I to get M = I - gamma*J */
	DenseScale(-gamma, M);
	DenseAddI(M);

	/* Do LU factorization of M */
	ier = DenseFactor(M, pivots);

	/* Return 0 if the LU was complete; otherwise return 1 */
	if (ier > 0)
		return (1);
	return (0);
}
Пример #2
0
static int cvDenseSetup(CVodeMem cv_mem, int convfail, N_Vector ypred,
                        N_Vector fpred, booleantype *jcurPtr, 
                        N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3)
{
  CVDlsMem cvdls_mem;
  booleantype jbad, jok;
  realtype dgamma;
  int retval;
  long int ier;

  cvdls_mem = (CVDlsMem) lmem;
 
  /* Use nst, gamma/gammap, and convfail to set J eval. flag jok */
 
  dgamma = ABS((gamma/gammap) - ONE);
  jbad = (nst == 0) || (nst > nstlj + CVD_MSBJ) ||
         ((convfail == CV_FAIL_BAD_J) && (dgamma < CVD_DGMAX)) ||
         (convfail == CV_FAIL_OTHER);
  jok = !jbad;
 
  if (jok) {

    /* If jok = TRUE, use saved copy of J */
    *jcurPtr = FALSE;
    DenseCopy(savedJ, M);

  } else {

    /* If jok = FALSE, call jac routine for new J value */
    nje++;
    nstlj = nst;
    *jcurPtr = TRUE;
    SetToZero(M);

    retval = jac(n, tn, ypred, fpred, M, J_data, vtemp1, vtemp2, vtemp3);
    if (retval < 0) {
      cvProcessError(cv_mem, CVDLS_JACFUNC_UNRECVR, "CVSDENSE", "cvDenseSetup", MSGD_JACFUNC_FAILED);
      last_flag = CVDLS_JACFUNC_UNRECVR;
      return(-1);
    }
    if (retval > 0) {
      last_flag = CVDLS_JACFUNC_RECVR;
      return(1);
    }

    DenseCopy(M, savedJ);

  }
  
  /* Scale and add I to get M = I - gamma*J */
  DenseScale(-gamma, M);
  AddIdentity(M);

  /* Do LU factorization of M */
  ier = DenseGETRF(M, lpivots); 

  /* Return 0 if the LU was complete; otherwise return 1 */
  last_flag = ier;
  if (ier > 0) return(1);
  return(0);
}
Пример #3
0
CAMLprim value c_densematrix_scale(value vc, value va)
{
    CAMLparam2(vc, va);
    DenseScale(Double_val(vc), DLSMAT(va));
    CAMLreturn (Val_unit);
}
Пример #4
0
static int cpDenseSetup(CPodeMem cp_mem, int convfail,
                        N_Vector yP, N_Vector ypP, N_Vector fctP,
                        booleantype *jcurPtr,
                        N_Vector tmp1, N_Vector tmp2, N_Vector tmp3)
{
  booleantype jbad, jok;
  realtype dgamma;
  long int ier;
  CPDlsMem cpdls_mem;
  int retval;

  cpdls_mem = (CPDlsMem) lmem;

  switch (ode_type) {

  case CP_EXPL:

    /* Use nst, gamma/gammap, and convfail to set J eval. flag jok */
    dgamma = ABS((gamma/gammap) - ONE);
    jbad = (nst == 0) || (nst > nstlj + CPD_MSBJ) ||
      ((convfail == CP_FAIL_BAD_J) && (dgamma < CPD_DGMAX)) ||
      (convfail == CP_FAIL_OTHER);
    jok = !jbad;
    
    /* Test if it is enough to use a saved Jacobian copy */
    if (jok) {
      *jcurPtr = FALSE;
      DenseCopy(savedJ, M);
    } else {
      nstlj = nst;
      *jcurPtr = TRUE;
      DenseZero(M);
      retval = jacE(n, tn, yP, fctP, M, J_data, tmp1, tmp2, tmp3);
      nje++;
      if (retval < 0) {
        cpProcessError(cp_mem, CPDIRECT_JACFUNC_UNRECVR, "CPDENSE", "cpDenseSetup", MSGD_JACFUNC_FAILED);
        last_flag = CPDIRECT_JACFUNC_UNRECVR;
        return(-1);
      }
      if (retval > 0) {
        last_flag = CPDIRECT_JACFUNC_RECVR;
        return(1);
      }
      DenseCopy(M, savedJ);
    }
  
    /* Scale and add I to get M = I - gamma*J */
    DenseScale(-gamma, M);
    DenseAddI(M);

    break;

  case CP_IMPL:

    /* Initialize Jacobian to 0 and call Jacobian function */
    DenseZero(M);
    retval = jacI(n, tn, gamma, yP, ypP, fctP, M, J_data, tmp1, tmp2, tmp3);
    nje++;
    if (retval < 0) {
      cpProcessError(cp_mem, CPDIRECT_JACFUNC_UNRECVR, "CPDENSE", "cpDenseSetup", MSGD_JACFUNC_FAILED);
      last_flag = CPDIRECT_JACFUNC_UNRECVR;
      return(-1);
    }
    if (retval > 0) {
      last_flag = CPDIRECT_JACFUNC_RECVR;
      return(1);
    }
  
    break;

  }

  /* Do LU factorization of M */
  ier = DenseGETRF(M, pivots); 

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