int TSFunction_Sundials(realtype t,N_Vector y,N_Vector ydot,void *ctx)
{
TS ts = (TS) ctx;
MPI_Comm comm = ((PetscObject)ts)->comm;
TS_Sundials *cvode = (TS_Sundials*)ts->data;
Vec yy = cvode->w1,yyd = cvode->w2,yydot = cvode->ydot;
PetscScalar *y_data,*ydot_data;
PetscErrorCode ierr;
PetscFunctionBegin;
/* Make the PETSc work vectors yy and yyd point to the arrays in the SUNDIALS vectors y and ydot respectively*/
y_data = (PetscScalar *) N_VGetArrayPointer(y);
ydot_data = (PetscScalar *) N_VGetArrayPointer(ydot);
ierr = VecPlaceArray(yy,y_data);CHKERRABORT(comm,ierr);
ierr = VecPlaceArray(yyd,ydot_data); CHKERRABORT(comm,ierr);
/* now compute the right hand side function */
if (!ts->userops->ifunction) {
ierr = TSComputeRHSFunction(ts,t,yy,yyd);CHKERRQ(ierr);
} else { /* If rhsfunction is also set, this computes both parts and shifts them to the right */
ierr = VecZeroEntries(yydot);CHKERRQ(ierr);
ierr = TSComputeIFunction(ts,t,yy,yydot,yyd,PETSC_FALSE); CHKERRABORT(comm,ierr);
ierr = VecScale(yyd,-1.);CHKERRQ(ierr);
}
ierr = VecResetArray(yy); CHKERRABORT(comm,ierr);
ierr = VecResetArray(yyd); CHKERRABORT(comm,ierr);
PetscFunctionReturn(0);
}
int TSFunction_Sundials(realtype t,N_Vector y,N_Vector ydot,void *ctx)
{
TS ts = (TS) ctx;
DM dm;
DMTS tsdm;
TSIFunction ifunction;
MPI_Comm comm;
TS_Sundials *cvode = (TS_Sundials*)ts->data;
Vec yy = cvode->w1,yyd = cvode->w2,yydot = cvode->ydot;
PetscScalar *y_data,*ydot_data;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)ts,&comm);CHKERRQ(ierr);
/* Make the PETSc work vectors yy and yyd point to the arrays in the SUNDIALS vectors y and ydot respectively*/
y_data = (PetscScalar*) N_VGetArrayPointer(y);
ydot_data = (PetscScalar*) N_VGetArrayPointer(ydot);
ierr = VecPlaceArray(yy,y_data);CHKERRABORT(comm,ierr);
ierr = VecPlaceArray(yyd,ydot_data);CHKERRABORT(comm,ierr);
/* Now compute the right hand side function, via IFunction unless only the more efficient RHSFunction is set */
ierr = TSGetDM(ts,&dm);CHKERRQ(ierr);
ierr = DMGetDMTS(dm,&tsdm);CHKERRQ(ierr);
ierr = DMTSGetIFunction(dm,&ifunction,NULL);CHKERRQ(ierr);
if (!ifunction) {
ierr = TSComputeRHSFunction(ts,t,yy,yyd);CHKERRQ(ierr);
} else { /* If rhsfunction is also set, this computes both parts and shifts them to the right */
ierr = VecZeroEntries(yydot);CHKERRQ(ierr);
ierr = TSComputeIFunction(ts,t,yy,yydot,yyd,PETSC_FALSE);CHKERRABORT(comm,ierr);
ierr = VecScale(yyd,-1.);CHKERRQ(ierr);
}
ierr = VecResetArray(yy);CHKERRABORT(comm,ierr);
ierr = VecResetArray(yyd);CHKERRABORT(comm,ierr);
PetscFunctionReturn(0);
}
static void PETScMatvecGenNoBlock(void *x, PRIMME_INT ldx, void *y, PRIMME_INT ldy,
int blockSize, int trans, Mat matrix, MPI_Comm comm) {
int i;
Vec xvec, yvec;
PetscInt m, n, mLocal, nLocal;
PetscErrorCode ierr;
assert(sizeof(PetscScalar) == sizeof(SCALAR));
ierr = MatGetSize(matrix, &m, &n); CHKERRABORT(comm, ierr);
ierr = MatGetLocalSize(matrix, &mLocal, &nLocal); CHKERRABORT(comm, ierr);
#if PETSC_VERSION_LT(3,6,0)
ierr = MatGetVecs(matrix, &xvec, &yvec); CHKERRABORT(comm, ierr);
#else
ierr = MatCreateVecs(matrix, &xvec, &yvec); CHKERRABORT(comm, ierr);
#endif
if (trans == 1) {
Vec aux = xvec; xvec = yvec; yvec = aux;
}
for (i=0; i<blockSize; i++) {
ierr = VecPlaceArray(xvec, ((SCALAR*)x) + ldx*i); CHKERRABORT(comm, ierr);
ierr = VecPlaceArray(yvec, ((SCALAR*)y) + ldy*i); CHKERRABORT(comm, ierr);
if (trans == 0) {
ierr = MatMult(matrix, xvec, yvec); CHKERRABORT(comm, ierr);
} else {
ierr = MatMultHermitianTranspose(matrix, xvec, yvec); CHKERRABORT(comm, ierr);
}
ierr = VecResetArray(xvec); CHKERRABORT(comm, ierr);
ierr = VecResetArray(yvec); CHKERRABORT(comm, ierr);
}
ierr = VecDestroy(&xvec); CHKERRABORT(comm, ierr);
ierr = VecDestroy(&yvec); CHKERRABORT(comm, ierr);
}
PetscErrorCode MatMult_BlockMat(Mat A,Vec x,Vec y)
{
Mat_BlockMat *bmat = (Mat_BlockMat*)A->data;
PetscErrorCode ierr;
PetscScalar *xx,*yy;
PetscInt *aj,i,*ii,jrow,m = A->rmap->n/A->rmap->bs,bs = A->rmap->bs,n,j;
Mat *aa;
PetscFunctionBegin;
/*
Standard CSR multiply except each entry is a Mat
*/
ierr = VecGetArray(x,&xx);CHKERRQ(ierr);
ierr = VecSet(y,0.0);CHKERRQ(ierr);
ierr = VecGetArray(y,&yy);CHKERRQ(ierr);
aj = bmat->j;
aa = bmat->a;
ii = bmat->i;
for (i=0; i<m; i++) {
jrow = ii[i];
ierr = VecPlaceArray(bmat->left,yy + bs*i);CHKERRQ(ierr);
n = ii[i+1] - jrow;
for (j=0; j<n; j++) {
ierr = VecPlaceArray(bmat->right,xx + bs*aj[jrow]);CHKERRQ(ierr);
ierr = MatMultAdd(aa[jrow],bmat->right,bmat->left,bmat->left);CHKERRQ(ierr);
ierr = VecResetArray(bmat->right);CHKERRQ(ierr);
jrow++;
}
ierr = VecResetArray(bmat->left);CHKERRQ(ierr);
}
ierr = VecRestoreArray(x,&xx);CHKERRQ(ierr);
ierr = VecRestoreArray(y,&yy);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static void ApplyPCPrecPETSCGen(void *x, PRIMME_INT *ldx, void *y,
PRIMME_INT *ldy, int *blockSize, int trans, PC *pc, MPI_Comm comm) {
int i;
Vec xvec, yvec;
Mat matrix;
PetscErrorCode ierr;
PetscInt mLocal, nLocal;
ierr = PCGetOperators(pc[0],&matrix,NULL); CHKERRABORT(comm, ierr);
assert(sizeof(PetscScalar) == sizeof(SCALAR));
ierr = MatGetLocalSize(matrix, &mLocal, &nLocal); CHKERRABORT(comm, ierr);
assert(mLocal == nLocal && nLocal <= *ldx && mLocal <= *ldy);
#if PETSC_VERSION_LT(3,6,0)
ierr = MatGetVecs(matrix, &xvec, &yvec); CHKERRABORT(comm, ierr);
#else
ierr = MatCreateVecs(matrix, &xvec, &yvec); CHKERRABORT(comm, ierr);
#endif
for (i=0; i<*blockSize; i++) {
ierr = VecPlaceArray(xvec, ((SCALAR*)x) + (*ldx)*i); CHKERRABORT(comm, ierr);
ierr = VecPlaceArray(yvec, ((SCALAR*)y) + (*ldy)*i); CHKERRABORT(comm, ierr);
if (trans == 0) {
ierr = PCApply(*pc, xvec, yvec); CHKERRABORT(comm, ierr);
} else if (pc[1]) {
ierr = PCApply(pc[1], xvec, yvec); CHKERRABORT(comm, ierr);
} else {
ierr = PCApplyTranspose(pc[0], xvec, yvec);
}
ierr = VecResetArray(xvec); CHKERRABORT(comm, ierr);
ierr = VecResetArray(yvec); CHKERRABORT(comm, ierr);
}
ierr = VecDestroy(&xvec); CHKERRABORT(comm, ierr);
ierr = VecDestroy(&yvec); CHKERRABORT(comm, ierr);
}
static PetscErrorCode PCApply_Redundant(PC pc,Vec x,Vec y)
{
PC_Redundant *red = (PC_Redundant*)pc->data;
PetscErrorCode ierr;
PetscScalar *array;
PetscFunctionBegin;
/* scatter x to xdup */
ierr = VecScatterBegin(red->scatterin,x,red->xdup,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(red->scatterin,x,red->xdup,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
/* place xdup's local array into xsub */
ierr = VecGetArray(red->xdup,&array);CHKERRQ(ierr);
ierr = VecPlaceArray(red->xsub,(const PetscScalar*)array);CHKERRQ(ierr);
/* apply preconditioner on each processor */
ierr = PCApply(red->pc,red->xsub,red->ysub);CHKERRQ(ierr);
ierr = VecResetArray(red->xsub);CHKERRQ(ierr);
ierr = VecRestoreArray(red->xdup,&array);CHKERRQ(ierr);
/* place ysub's local array into ydup */
ierr = VecGetArray(red->ysub,&array);CHKERRQ(ierr);
ierr = VecPlaceArray(red->ydup,(const PetscScalar*)array);CHKERRQ(ierr);
/* scatter ydup to y */
ierr = VecScatterBegin(red->scatterout,red->ydup,y,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(red->scatterout,red->ydup,y,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecResetArray(red->ydup);CHKERRQ(ierr);
ierr = VecRestoreArray(red->ysub,&array);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
PEPLinearExtract_Norm - Auxiliary routine that copies the solution of the
linear eigenproblem to the PEP object. The eigenvector of the generalized
problem is supposed to be
z = [ x ]
[ l*x ]
If |l|<1.0, the eigenvector is taken from z(1:n), otherwise from z(n+1:2*n).
Finally, x is normalized so that ||x||_2 = 1.
*/
static PetscErrorCode PEPLinearExtract_Norm(PEP pep,EPS eps)
{
PetscErrorCode ierr;
PetscInt i,offset;
PetscScalar *px;
Vec xr,xi,w,vi;
#if !defined(PETSC_USE_COMPLEX)
Vec vi1;
#endif
Mat A;
PetscFunctionBegin;
ierr = EPSGetOperators(eps,&A,NULL);CHKERRQ(ierr);
ierr = MatGetVecs(A,&xr,NULL);CHKERRQ(ierr);
ierr = VecDuplicate(xr,&xi);CHKERRQ(ierr);
ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)pep),1,pep->nloc,pep->n,NULL,&w);CHKERRQ(ierr);
for (i=0;i<pep->nconv;i++) {
ierr = EPSGetEigenpair(eps,i,&pep->eigr[i],&pep->eigi[i],xr,xi);CHKERRQ(ierr);
pep->eigr[i] *= pep->sfactor;
pep->eigi[i] *= pep->sfactor;
if (SlepcAbsEigenvalue(pep->eigr[i],pep->eigi[i])>1.0) offset = pep->nloc;
else offset = 0;
#if !defined(PETSC_USE_COMPLEX)
if (pep->eigi[i]>0.0) { /* first eigenvalue of a complex conjugate pair */
ierr = VecGetArray(xr,&px);CHKERRQ(ierr);
ierr = VecPlaceArray(w,px+offset);CHKERRQ(ierr);
ierr = BVInsertVec(pep->V,i,w);CHKERRQ(ierr);
ierr = VecResetArray(w);CHKERRQ(ierr);
ierr = VecRestoreArray(xr,&px);CHKERRQ(ierr);
ierr = VecGetArray(xi,&px);CHKERRQ(ierr);
ierr = VecPlaceArray(w,px+offset);CHKERRQ(ierr);
ierr = BVInsertVec(pep->V,i+1,w);CHKERRQ(ierr);
ierr = VecResetArray(w);CHKERRQ(ierr);
ierr = VecRestoreArray(xi,&px);CHKERRQ(ierr);
ierr = BVGetColumn(pep->V,i,&vi);CHKERRQ(ierr);
ierr = BVGetColumn(pep->V,i+1,&vi1);CHKERRQ(ierr);
ierr = SlepcVecNormalize(vi,vi1,PETSC_TRUE,NULL);CHKERRQ(ierr);
ierr = BVRestoreColumn(pep->V,i,&vi);CHKERRQ(ierr);
ierr = BVRestoreColumn(pep->V,i+1,&vi1);CHKERRQ(ierr);
} else if (pep->eigi[i]==0.0) /* real eigenvalue */
#endif
{
ierr = VecGetArray(xr,&px);CHKERRQ(ierr);
ierr = VecPlaceArray(w,px+offset);CHKERRQ(ierr);
ierr = BVInsertVec(pep->V,i,w);CHKERRQ(ierr);
ierr = VecResetArray(w);CHKERRQ(ierr);
ierr = VecRestoreArray(xr,&px);CHKERRQ(ierr);
ierr = BVGetColumn(pep->V,i,&vi);CHKERRQ(ierr);
ierr = SlepcVecNormalize(vi,NULL,PETSC_FALSE,NULL);CHKERRQ(ierr);
ierr = BVRestoreColumn(pep->V,i,&vi);CHKERRQ(ierr);
}
}
ierr = VecDestroy(&w);CHKERRQ(ierr);
ierr = VecDestroy(&xr);CHKERRQ(ierr);
ierr = VecDestroy(&xi);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
void precond(const HpddmCustomOperator* const H, const K* in, K* out, int mu)
{
int n, nu;
MatGetLocalSize(H->_A, &n, NULL);
for (nu = 0; nu < mu; ++nu) {
VecPlaceArray(H->_b, in + nu * n);
VecPlaceArray(H->_x, out + nu * n);
PCApply(H->_M, H->_b, H->_x);
VecResetArray(H->_x);
VecResetArray(H->_b);
}
}
PetscErrorCode MatMult_BlockMat_Symmetric(Mat A,Vec x,Vec y)
{
Mat_BlockMat *bmat = (Mat_BlockMat*)A->data;
PetscErrorCode ierr;
PetscScalar *xx,*yy;
PetscInt *aj,i,*ii,jrow,m = A->rmap->n/A->rmap->bs,bs = A->rmap->bs,n,j;
Mat *aa;
PetscFunctionBegin;
/*
Standard CSR multiply except each entry is a Mat
*/
ierr = VecGetArray(x,&xx);CHKERRQ(ierr);
ierr = VecSet(y,0.0);CHKERRQ(ierr);
ierr = VecGetArray(y,&yy);CHKERRQ(ierr);
aj = bmat->j;
aa = bmat->a;
ii = bmat->i;
for (i=0; i<m; i++) {
jrow = ii[i];
n = ii[i+1] - jrow;
ierr = VecPlaceArray(bmat->left,yy + bs*i);CHKERRQ(ierr);
ierr = VecPlaceArray(bmat->middle,xx + bs*i);CHKERRQ(ierr);
/* if we ALWAYS required a diagonal entry then could remove this if test */
if (aj[jrow] == i) {
ierr = VecPlaceArray(bmat->right,xx + bs*aj[jrow]);CHKERRQ(ierr);
ierr = MatMultAdd(aa[jrow],bmat->right,bmat->left,bmat->left);CHKERRQ(ierr);
ierr = VecResetArray(bmat->right);CHKERRQ(ierr);
jrow++;
n--;
}
for (j=0; j<n; j++) {
ierr = VecPlaceArray(bmat->right,xx + bs*aj[jrow]);CHKERRQ(ierr); /* upper triangular part */
ierr = MatMultAdd(aa[jrow],bmat->right,bmat->left,bmat->left);CHKERRQ(ierr);
ierr = VecResetArray(bmat->right);CHKERRQ(ierr);
ierr = VecPlaceArray(bmat->right,yy + bs*aj[jrow]);CHKERRQ(ierr); /* lower triangular part */
ierr = MatMultTransposeAdd(aa[jrow],bmat->middle,bmat->right,bmat->right);CHKERRQ(ierr);
ierr = VecResetArray(bmat->right);CHKERRQ(ierr);
jrow++;
}
ierr = VecResetArray(bmat->left);CHKERRQ(ierr);
ierr = VecResetArray(bmat->middle);CHKERRQ(ierr);
}
ierr = VecRestoreArray(x,&xx);CHKERRQ(ierr);
ierr = VecRestoreArray(y,&yy);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode PetscML_comm(double p[],void *ML_data)
{
PetscErrorCode ierr;
FineGridCtx *ml=(FineGridCtx*)ML_data;
Mat A=ml->A;
Mat_MPIAIJ *a = (Mat_MPIAIJ*)A->data;
PetscMPIInt size;
PetscInt i,in_length=A->rmap->n,out_length=ml->Aloc->cmap->n;
PetscScalar *array;
PetscFunctionBegin;
ierr = MPI_Comm_size(((PetscObject)A)->comm,&size);CHKERRQ(ierr);
if (size == 1) return 0;
ierr = VecPlaceArray(ml->y,p);CHKERRQ(ierr);
ierr = VecScatterBegin(a->Mvctx,ml->y,a->lvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(a->Mvctx,ml->y,a->lvec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecResetArray(ml->y);CHKERRQ(ierr);
ierr = VecGetArray(a->lvec,&array);CHKERRQ(ierr);
for (i=in_length; i<out_length; i++){
p[i] = array[i-in_length];
}
ierr = VecRestoreArray(a->lvec,&array);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode TSPrecond_Sundials(realtype tn,N_Vector y,N_Vector fy,booleantype jok,booleantype *jcurPtr,
realtype _gamma,void *P_data,N_Vector vtemp1,N_Vector vtemp2,N_Vector vtemp3)
{
TS ts = (TS) P_data;
TS_Sundials *cvode = (TS_Sundials*)ts->data;
PC pc;
PetscErrorCode ierr;
Mat J,P;
Vec yy = cvode->w1,yydot = cvode->ydot;
PetscReal gm = (PetscReal)_gamma;
MatStructure str = DIFFERENT_NONZERO_PATTERN;
PetscScalar *y_data;
PetscFunctionBegin;
ierr = TSGetIJacobian(ts,&J,&P,NULL,NULL);CHKERRQ(ierr);
y_data = (PetscScalar*) N_VGetArrayPointer(y);
ierr = VecPlaceArray(yy,y_data);CHKERRQ(ierr);
ierr = VecZeroEntries(yydot);CHKERRQ(ierr); /* The Jacobian is independent of Ydot for ODE which is all that CVode works for */
/* compute the shifted Jacobian (1/gm)*I + Jrest */
ierr = TSComputeIJacobian(ts,ts->ptime,yy,yydot,1/gm,&J,&P,&str,PETSC_FALSE);CHKERRQ(ierr);
ierr = VecResetArray(yy);CHKERRQ(ierr);
ierr = MatScale(P,gm);CHKERRQ(ierr); /* turn into I-gm*Jrest, J is not used by Sundials */
*jcurPtr = TRUE;
ierr = TSSundialsGetPC(ts,&pc);CHKERRQ(ierr);
ierr = PCSetOperators(pc,J,P,str);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
DMCompositeGetAccess - Allows one to access the individual packed vectors in their global
representation.
Collective on DMComposite
Input Parameters:
+ dm - the packer object
- gvec - the global vector
Output Parameters:
. Vec* ... - the packed parallel vectors, PETSC_NULL for those that are not needed
Notes: Use DMCompositeRestoreAccess() to return the vectors when you no longer need them
Level: advanced
@*/
PetscErrorCode DMCompositeGetAccess(DM dm,Vec gvec,...)
{
va_list Argp;
PetscErrorCode ierr;
struct DMCompositeLink *next;
DM_Composite *com = (DM_Composite*)dm->data;
PetscFunctionBegin;
PetscValidHeaderSpecific(dm,DM_CLASSID,1);
PetscValidHeaderSpecific(gvec,VEC_CLASSID,2);
next = com->next;
if (!com->setup) {
ierr = DMSetUp(dm);CHKERRQ(ierr);
}
/* loop over packed objects, handling one at at time */
va_start(Argp,gvec);
while (next) {
Vec *vec;
vec = va_arg(Argp, Vec*);
if (vec) {
PetscScalar *array;
ierr = DMGetGlobalVector(next->dm,vec);CHKERRQ(ierr);
ierr = VecGetArray(gvec,&array);CHKERRQ(ierr);
ierr = VecPlaceArray(*vec,array+next->rstart);CHKERRQ(ierr);
ierr = VecRestoreArray(gvec,&array);CHKERRQ(ierr);
}
next = next->next;
}
va_end(Argp);
PetscFunctionReturn(0);
}
PetscErrorCode DMGlobalToLocalBegin_Composite(DM dm,Vec gvec,InsertMode mode,Vec lvec)
{
PetscErrorCode ierr;
struct DMCompositeLink *next;
PetscInt cnt = 3;
PetscMPIInt rank;
PetscScalar *garray,*larray;
DM_Composite *com = (DM_Composite*)dm->data;
PetscFunctionBegin;
PetscValidHeaderSpecific(dm,DM_CLASSID,1);
PetscValidHeaderSpecific(gvec,VEC_CLASSID,2);
next = com->next;
if (!com->setup) {
ierr = DMSetUp(dm);CHKERRQ(ierr);
}
ierr = MPI_Comm_rank(((PetscObject)dm)->comm,&rank);CHKERRQ(ierr);
ierr = VecGetArray(gvec,&garray);CHKERRQ(ierr);
ierr = VecGetArray(lvec,&larray);CHKERRQ(ierr);
/* loop over packed objects, handling one at at time */
while (next) {
Vec local,global;
PetscInt N;
ierr = DMGetGlobalVector(next->dm,&global);CHKERRQ(ierr);
ierr = VecGetLocalSize(global,&N);CHKERRQ(ierr);
ierr = VecPlaceArray(global,garray);CHKERRQ(ierr);
ierr = DMGetLocalVector(next->dm,&local);CHKERRQ(ierr);
ierr = VecPlaceArray(local,larray);CHKERRQ(ierr);
ierr = DMGlobalToLocalBegin(next->dm,global,mode,local);CHKERRQ(ierr);
ierr = DMGlobalToLocalEnd(next->dm,global,mode,local);CHKERRQ(ierr);
ierr = VecResetArray(global);CHKERRQ(ierr);
ierr = VecResetArray(local);CHKERRQ(ierr);
ierr = DMRestoreGlobalVector(next->dm,&global);CHKERRQ(ierr);
ierr = DMRestoreGlobalVector(next->dm,&local);CHKERRQ(ierr);
cnt++;
larray += next->nlocal;
next = next->next;
}
ierr = VecRestoreArray(gvec,PETSC_NULL);CHKERRQ(ierr);
ierr = VecRestoreArray(lvec,PETSC_NULL);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode PCTFSLocalMult_TFS(PC pc,PetscScalar *xin,PetscScalar *xout)
{
PC_TFS *tfs = (PC_TFS*)pc->data;
Mat A = pc->pmat;
Mat_MPIAIJ *a = (Mat_MPIAIJ*)A->data;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = VecPlaceArray(tfs->b,xout);CHKERRQ(ierr);
ierr = VecPlaceArray(tfs->xd,xin);CHKERRQ(ierr);
ierr = VecPlaceArray(tfs->xo,xin+tfs->nd);CHKERRQ(ierr);
ierr = MatMult(a->A,tfs->xd,tfs->b);CHKERRQ(ierr);
ierr = MatMultAdd(a->B,tfs->xo,tfs->b,tfs->b);CHKERRQ(ierr);
ierr = VecResetArray(tfs->b);CHKERRQ(ierr);
ierr = VecResetArray(tfs->xd);CHKERRQ(ierr);
ierr = VecResetArray(tfs->xo);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode BVMatMult_Mat(BV V,Mat A,BV W)
{
PetscErrorCode ierr;
BV_MAT *v = (BV_MAT*)V->data,*w = (BV_MAT*)W->data;
PetscScalar *pv,*pw;
PetscInt j;
PetscFunctionBegin;
ierr = MatDenseGetArray(v->A,&pv);CHKERRQ(ierr);
ierr = MatDenseGetArray(w->A,&pw);CHKERRQ(ierr);
for (j=0;j<V->k-V->l;j++) {
ierr = VecPlaceArray(V->cv[1],pv+(V->nc+V->l+j)*V->n);CHKERRQ(ierr);
ierr = VecPlaceArray(W->cv[1],pw+(W->nc+W->l+j)*W->n);CHKERRQ(ierr);
ierr = MatMult(A,V->cv[1],W->cv[1]);CHKERRQ(ierr);
ierr = VecResetArray(V->cv[1]);CHKERRQ(ierr);
ierr = VecResetArray(W->cv[1]);CHKERRQ(ierr);
}
ierr = MatDenseRestoreArray(v->A,&pv);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(w->A,&pw);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int TSFunction_Sundials(realtype t,N_Vector y,N_Vector ydot,void *ctx)
{
TS ts = (TS) ctx;
MPI_Comm comm = ((PetscObject)ts)->comm;
TS_Sundials *cvode = (TS_Sundials*)ts->data;
Vec yy = cvode->w1,yyd = cvode->w2;
PetscScalar *y_data,*ydot_data;
PetscErrorCode ierr;
PetscFunctionBegin;
/* Make the PETSc work vectors yy and yyd point to the arrays in the SUNDIALS vectors y and ydot respectively*/
y_data = (PetscScalar *) N_VGetArrayPointer(y);
ydot_data = (PetscScalar *) N_VGetArrayPointer(ydot);
ierr = VecPlaceArray(yy,y_data);CHKERRABORT(comm,ierr);
ierr = VecPlaceArray(yyd,ydot_data); CHKERRABORT(comm,ierr);
/* now compute the right hand side function */
ierr = TSComputeRHSFunction(ts,t,yy,yyd); CHKERRABORT(comm,ierr);
ierr = VecResetArray(yy); CHKERRABORT(comm,ierr);
ierr = VecResetArray(yyd); CHKERRABORT(comm,ierr);
PetscFunctionReturn(0);
}
PetscErrorCode BVGetColumn_Mat(BV bv,PetscInt j,Vec *v)
{
PetscErrorCode ierr;
BV_MAT *ctx = (BV_MAT*)bv->data;
PetscScalar *pA;
PetscInt l;
PetscFunctionBegin;
l = BVAvailableVec;
ierr = MatDenseGetArray(ctx->A,&pA);CHKERRQ(ierr);
ierr = VecPlaceArray(bv->cv[l],pA+(bv->nc+j)*bv->n);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode TSStep_Sundials_Nonlinear(TS ts,int *steps,double *time)
{
TS_Sundials *cvode = (TS_Sundials*)ts->data;
Vec sol = ts->vec_sol;
PetscErrorCode ierr;
PetscInt i,max_steps = ts->max_steps,flag;
long int its;
realtype t,tout;
PetscScalar *y_data;
void *mem;
PetscFunctionBegin;
mem = cvode->mem;
tout = ts->max_time;
ierr = VecGetArray(ts->vec_sol,&y_data);CHKERRQ(ierr);
N_VSetArrayPointer((realtype *)y_data,cvode->y);
ierr = VecRestoreArray(ts->vec_sol,PETSC_NULL);CHKERRQ(ierr);
for (i = 0; i < max_steps; i++) {
if (ts->ptime >= ts->max_time) break;
ierr = TSPreStep(ts);CHKERRQ(ierr);
if (cvode->monitorstep){
flag = CVode(mem,tout,cvode->y,&t,CV_ONE_STEP);
} else {
flag = CVode(mem,tout,cvode->y,&t,CV_NORMAL);
}
if (flag)SETERRQ1(PETSC_ERR_LIB,"CVode() fails, flag %d",flag);
if (t > ts->max_time && cvode->exact_final_time) {
/* interpolate to final requested time */
ierr = CVodeGetDky(mem,tout,0,cvode->y);CHKERRQ(ierr);
t = tout;
}
ts->time_step = t - ts->ptime;
ts->ptime = t;
/* copy the solution from cvode->y to cvode->update and sol */
ierr = VecPlaceArray(cvode->w1,y_data); CHKERRQ(ierr);
ierr = VecCopy(cvode->w1,cvode->update);CHKERRQ(ierr);
ierr = VecResetArray(cvode->w1); CHKERRQ(ierr);
ierr = VecCopy(cvode->update,sol);CHKERRQ(ierr);
ierr = CVodeGetNumNonlinSolvIters(mem,&its);CHKERRQ(ierr);
ts->nonlinear_its = its;
ierr = CVSpilsGetNumLinIters(mem, &its);
ts->linear_its = its;
ts->steps++;
ierr = TSPostStep(ts);CHKERRQ(ierr);
ierr = TSMonitor(ts,ts->steps,t,sol);CHKERRQ(ierr);
}
*steps += ts->steps;
*time = t;
PetscFunctionReturn(0);
}
PetscErrorCode TSPrecond_Sundials(realtype tn,N_Vector y,N_Vector fy,
booleantype jok,booleantype *jcurPtr,
realtype _gamma,void *P_data,
N_Vector vtemp1,N_Vector vtemp2,N_Vector vtemp3)
{
TS ts = (TS) P_data;
TS_Sundials *cvode = (TS_Sundials*)ts->data;
PC pc = cvode->pc;
PetscErrorCode ierr;
Mat Jac = ts->B;
Vec yy = cvode->w1;
PetscScalar one = 1.0,gm;
MatStructure str = DIFFERENT_NONZERO_PATTERN;
PetscScalar *y_data;
PetscFunctionBegin;
/* This allows us to construct preconditioners in-place if we like */
ierr = MatSetUnfactored(Jac);CHKERRQ(ierr);
/* jok - TRUE means reuse current Jacobian else recompute Jacobian */
if (jok) {
ierr = MatCopy(cvode->pmat,Jac,str);CHKERRQ(ierr);
*jcurPtr = FALSE;
} else {
/* make PETSc vector yy point to SUNDIALS vector y */
y_data = (PetscScalar *) N_VGetArrayPointer(y);
ierr = VecPlaceArray(yy,y_data); CHKERRQ(ierr);
/* compute the Jacobian */
ierr = TSComputeRHSJacobian(ts,ts->ptime,yy,&Jac,&Jac,&str);CHKERRQ(ierr);
ierr = VecResetArray(yy); CHKERRQ(ierr);
/* copy the Jacobian matrix */
if (!cvode->pmat) {
ierr = MatDuplicate(Jac,MAT_COPY_VALUES,&cvode->pmat);CHKERRQ(ierr);
ierr = PetscLogObjectParent(ts,cvode->pmat);CHKERRQ(ierr);
} else {
ierr = MatCopy(Jac,cvode->pmat,str);CHKERRQ(ierr);
}
*jcurPtr = TRUE;
}
/* construct I-gamma*Jac */
gm = -_gamma;
ierr = MatScale(Jac,gm);CHKERRQ(ierr);
ierr = MatShift(Jac,one);CHKERRQ(ierr);
ierr = PCSetOperators(pc,Jac,Jac,str);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode TSPSolve_Sundials(realtype tn,N_Vector y,N_Vector fy,N_Vector r,N_Vector z,
realtype _gamma,realtype delta,int lr,void *P_data,N_Vector vtemp)
{
TS ts = (TS) P_data;
TS_Sundials *cvode = (TS_Sundials*)ts->data;
PC pc = cvode->pc;
Vec rr = cvode->w1,zz = cvode->w2;
PetscErrorCode ierr;
PetscScalar *r_data,*z_data;
PetscFunctionBegin;
/* Make the PETSc work vectors rr and zz point to the arrays in the SUNDIALS vectors r and z respectively*/
r_data = (PetscScalar *) N_VGetArrayPointer(r);
z_data = (PetscScalar *) N_VGetArrayPointer(z);
ierr = VecPlaceArray(rr,r_data); CHKERRQ(ierr);
ierr = VecPlaceArray(zz,z_data); CHKERRQ(ierr);
/* Solve the Px=r and put the result in zz */
ierr = PCApply(pc,rr,zz); CHKERRQ(ierr);
ierr = VecResetArray(rr); CHKERRQ(ierr);
ierr = VecResetArray(zz); CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode VecPlaceArray_MPI(Vec vin,const PetscScalar *a)
{
PetscErrorCode ierr;
Vec_MPI *v = (Vec_MPI*)vin->data;
PetscFunctionBegin;
if (v->unplacedarray) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"VecPlaceArray() was already called on this vector, without a call to VecResetArray()");
v->unplacedarray = v->array; /* save previous array so reset can bring it back */
v->array = (PetscScalar*)a;
if (v->localrep) {
ierr = VecPlaceArray(v->localrep,a);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode MatMult_Brussel(Mat A,Vec x,Vec y)
{
PetscInt n;
const PetscScalar *px;
PetscScalar *py;
CTX_BRUSSEL *ctx;
PetscErrorCode ierr;
PetscFunctionBeginUser;
ierr = MatShellGetContext(A,(void**)&ctx);CHKERRQ(ierr);
ierr = MatGetLocalSize(ctx->T,&n,NULL);CHKERRQ(ierr);
ierr = VecGetArrayRead(x,&px);CHKERRQ(ierr);
ierr = VecGetArray(y,&py);CHKERRQ(ierr);
ierr = VecPlaceArray(ctx->x1,px);CHKERRQ(ierr);
ierr = VecPlaceArray(ctx->x2,px+n);CHKERRQ(ierr);
ierr = VecPlaceArray(ctx->y1,py);CHKERRQ(ierr);
ierr = VecPlaceArray(ctx->y2,py+n);CHKERRQ(ierr);
ierr = MatMult(ctx->T,ctx->x1,ctx->y1);CHKERRQ(ierr);
ierr = VecScale(ctx->y1,ctx->tau1);CHKERRQ(ierr);
ierr = VecAXPY(ctx->y1,ctx->beta - 1.0 + ctx->sigma,ctx->x1);CHKERRQ(ierr);
ierr = VecAXPY(ctx->y1,ctx->alpha * ctx->alpha,ctx->x2);CHKERRQ(ierr);
ierr = MatMult(ctx->T,ctx->x2,ctx->y2);CHKERRQ(ierr);
ierr = VecScale(ctx->y2,ctx->tau2);CHKERRQ(ierr);
ierr = VecAXPY(ctx->y2,-ctx->beta,ctx->x1);CHKERRQ(ierr);
ierr = VecAXPY(ctx->y2,-ctx->alpha * ctx->alpha + ctx->sigma,ctx->x2);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(x,&px);CHKERRQ(ierr);
ierr = VecRestoreArray(y,&py);CHKERRQ(ierr);
ierr = VecResetArray(ctx->x1);CHKERRQ(ierr);
ierr = VecResetArray(ctx->x2);CHKERRQ(ierr);
ierr = VecResetArray(ctx->y1);CHKERRQ(ierr);
ierr = VecResetArray(ctx->y2);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static int PetscML_matvec(ML_Operator *ML_data,int in_length,double p[],int out_length,double ap[])
{
PetscErrorCode ierr;
FineGridCtx *ml=(FineGridCtx*)ML_Get_MyMatvecData(ML_data);
Mat A=ml->A, Aloc=ml->Aloc;
PetscMPIInt size;
PetscScalar *pwork=ml->pwork;
PetscInt i;
PetscFunctionBegin;
ierr = MPI_Comm_size(((PetscObject)A)->comm,&size);CHKERRQ(ierr);
if (size == 1){
ierr = VecPlaceArray(ml->x,p);CHKERRQ(ierr);
} else {
for (i=0; i<in_length; i++) pwork[i] = p[i];
PetscML_comm(pwork,ml);
ierr = VecPlaceArray(ml->x,pwork);CHKERRQ(ierr);
}
ierr = VecPlaceArray(ml->y,ap);CHKERRQ(ierr);
ierr = MatMult(Aloc,ml->x,ml->y);CHKERRQ(ierr);
ierr = VecResetArray(ml->x);CHKERRQ(ierr);
ierr = VecResetArray(ml->y);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "VecView_DMComposite"
PetscErrorCode VecView_DMComposite(Vec gvec,PetscViewer viewer)
{
DM dm;
PetscErrorCode ierr;
struct DMCompositeLink *next;
PetscBool isdraw;
DM_Composite *com;
PetscFunctionBegin;
ierr = VecGetDM(gvec, &dm);CHKERRQ(ierr);
if (!dm) SETERRQ(((PetscObject)gvec)->comm,PETSC_ERR_ARG_WRONG,"Vector not generated from a DMComposite");
com = (DM_Composite*)dm->data;
next = com->next;
ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERDRAW,&isdraw);CHKERRQ(ierr);
if (!isdraw) {
/* do I really want to call this? */
ierr = VecView_MPI(gvec,viewer);CHKERRQ(ierr);
} else {
PetscInt cnt = 0;
/* loop over packed objects, handling one at at time */
while (next) {
Vec vec;
PetscScalar *array;
PetscInt bs;
/* Should use VecGetSubVector() eventually, but would need to forward the DM for that to work */
ierr = DMGetGlobalVector(next->dm,&vec);CHKERRQ(ierr);
ierr = VecGetArray(gvec,&array);CHKERRQ(ierr);
ierr = VecPlaceArray(vec,array+next->rstart);CHKERRQ(ierr);
ierr = VecRestoreArray(gvec,&array);CHKERRQ(ierr);
ierr = VecView(vec,viewer);CHKERRQ(ierr);
ierr = VecGetBlockSize(vec,&bs);CHKERRQ(ierr);
ierr = VecResetArray(vec);CHKERRQ(ierr);
ierr = DMRestoreGlobalVector(next->dm,&vec);CHKERRQ(ierr);
ierr = PetscViewerDrawBaseAdd(viewer,bs);CHKERRQ(ierr);
cnt += bs;
next = next->next;
}
ierr = PetscViewerDrawBaseAdd(viewer,-cnt);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*@C
DMCompositeGather - Gathers into a global packed vector from its individual local vectors
Collective on DMComposite
Input Parameter:
+ dm - the packer object
. gvec - the global vector
- Vec ... - the individual sequential vectors, PETSC_NULL for any that are not needed
Level: advanced
.seealso DMDestroy(), DMCompositeAddDM(), DMCreateGlobalVector(),
DMCompositeScatter(), DMCompositeCreate(), DMCompositeGetISLocalToGlobalMappings(), DMCompositeGetAccess(),
DMCompositeGetLocalVectors(), DMCompositeRestoreLocalVectors(), DMCompositeGetEntries()
@*/
PetscErrorCode DMCompositeGather(DM dm,Vec gvec,InsertMode imode,...)
{
va_list Argp;
PetscErrorCode ierr;
struct DMCompositeLink *next;
DM_Composite *com = (DM_Composite*)dm->data;
PetscInt cnt;
PetscFunctionBegin;
PetscValidHeaderSpecific(dm,DM_CLASSID,1);
PetscValidHeaderSpecific(gvec,VEC_CLASSID,2);
if (!com->setup) {
ierr = DMSetUp(dm);CHKERRQ(ierr);
}
/* loop over packed objects, handling one at at time */
va_start(Argp,imode);
for (cnt=3,next=com->next; next; cnt++,next=next->next) {
Vec local;
local = va_arg(Argp, Vec);
if (local) {
PetscScalar *array;
Vec global;
PetscValidHeaderSpecific(local,VEC_CLASSID,cnt);
ierr = DMGetGlobalVector(next->dm,&global);CHKERRQ(ierr);
ierr = VecGetArray(gvec,&array);CHKERRQ(ierr);
ierr = VecPlaceArray(global,array+next->rstart);CHKERRQ(ierr);
ierr = DMLocalToGlobalBegin(next->dm,local,imode,global);CHKERRQ(ierr);
ierr = DMLocalToGlobalEnd(next->dm,local,imode,global);CHKERRQ(ierr);
ierr = VecRestoreArray(gvec,&array);CHKERRQ(ierr);
ierr = VecResetArray(global);CHKERRQ(ierr);
ierr = DMRestoreGlobalVector(next->dm,&global);CHKERRQ(ierr);
}
}
va_end(Argp);
PetscFunctionReturn(0);
}
PetscErrorCode TSStep_Sundials(TS ts)
{
TS_Sundials *cvode = (TS_Sundials*)ts->data;
PetscErrorCode ierr;
PetscInt flag;
long int its,nsteps;
realtype t,tout;
PetscScalar *y_data;
void *mem;
PetscFunctionBegin;
mem = cvode->mem;
tout = ts->max_time;
ierr = VecGetArray(ts->vec_sol,&y_data);CHKERRQ(ierr);
N_VSetArrayPointer((realtype*)y_data,cvode->y);
ierr = VecRestoreArray(ts->vec_sol,NULL);CHKERRQ(ierr);
ierr = TSPreStep(ts);CHKERRQ(ierr);
/* We would like to call TSPreStep() when starting each step (including rejections) and TSPreStage() before each
* stage solve, but CVode does not appear to support this. */
if (cvode->monitorstep) flag = CVode(mem,tout,cvode->y,&t,CV_ONE_STEP);
else flag = CVode(mem,tout,cvode->y,&t,CV_NORMAL);
if (flag) { /* display error message */
switch (flag) {
case CV_ILL_INPUT:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVode() fails, CV_ILL_INPUT");
break;
case CV_TOO_CLOSE:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVode() fails, CV_TOO_CLOSE");
break;
case CV_TOO_MUCH_WORK: {
PetscReal tcur;
ierr = CVodeGetNumSteps(mem,&nsteps);CHKERRQ(ierr);
ierr = CVodeGetCurrentTime(mem,&tcur);CHKERRQ(ierr);
SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVode() fails, CV_TOO_MUCH_WORK. At t=%G, nsteps %D exceeds mxstep %D. Increase '-ts_max_steps <>' or modify TSSetDuration()",tcur,nsteps,ts->max_steps);
} break;
case CV_TOO_MUCH_ACC:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVode() fails, CV_TOO_MUCH_ACC");
break;
case CV_ERR_FAILURE:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVode() fails, CV_ERR_FAILURE");
break;
case CV_CONV_FAILURE:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVode() fails, CV_CONV_FAILURE");
break;
case CV_LINIT_FAIL:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVode() fails, CV_LINIT_FAIL");
break;
case CV_LSETUP_FAIL:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVode() fails, CV_LSETUP_FAIL");
break;
case CV_LSOLVE_FAIL:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVode() fails, CV_LSOLVE_FAIL");
break;
case CV_RHSFUNC_FAIL:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVode() fails, CV_RHSFUNC_FAIL");
break;
case CV_FIRST_RHSFUNC_ERR:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVode() fails, CV_FIRST_RHSFUNC_ERR");
break;
case CV_REPTD_RHSFUNC_ERR:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVode() fails, CV_REPTD_RHSFUNC_ERR");
break;
case CV_UNREC_RHSFUNC_ERR:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVode() fails, CV_UNREC_RHSFUNC_ERR");
break;
case CV_RTFUNC_FAIL:
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVode() fails, CV_RTFUNC_FAIL");
break;
default:
SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVode() fails, flag %d",flag);
}
}
/* copy the solution from cvode->y to cvode->update and sol */
ierr = VecPlaceArray(cvode->w1,y_data);CHKERRQ(ierr);
ierr = VecCopy(cvode->w1,cvode->update);CHKERRQ(ierr);
ierr = VecResetArray(cvode->w1);CHKERRQ(ierr);
ierr = VecCopy(cvode->update,ts->vec_sol);CHKERRQ(ierr);
ierr = CVodeGetNumNonlinSolvIters(mem,&its);CHKERRQ(ierr);
ierr = CVSpilsGetNumLinIters(mem, &its);
ts->snes_its = its; ts->ksp_its = its;
ts->time_step = t - ts->ptime;
ts->ptime = t;
ts->steps++;
ierr = CVodeGetNumSteps(mem,&nsteps);CHKERRQ(ierr);
if (!cvode->monitorstep) ts->steps = nsteps;
PetscFunctionReturn(0);
}
static PetscErrorCode PCBDDCScalingExtension_Deluxe(PC pc, Vec x, Vec y)
{
PC_IS* pcis=(PC_IS*)pc->data;
PC_BDDC* pcbddc=(PC_BDDC*)pc->data;
PCBDDCDeluxeScaling deluxe_ctx = pcbddc->deluxe_ctx;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = VecSet(pcbddc->work_scaling,0.0);CHKERRQ(ierr);
ierr = VecSet(y,0.0);CHKERRQ(ierr);
if (deluxe_ctx->n_simple) { /* scale deluxe vertices using diagonal scaling */
PetscInt i;
const PetscScalar *array_x,*array_D;
PetscScalar *array;
ierr = VecGetArrayRead(x,&array_x);CHKERRQ(ierr);
ierr = VecGetArrayRead(pcis->D,&array_D);CHKERRQ(ierr);
ierr = VecGetArray(pcbddc->work_scaling,&array);CHKERRQ(ierr);
for (i=0;i<deluxe_ctx->n_simple;i++) {
array[deluxe_ctx->idx_simple_B[i]] = array_x[deluxe_ctx->idx_simple_B[i]]*array_D[deluxe_ctx->idx_simple_B[i]];
}
ierr = VecRestoreArray(pcbddc->work_scaling,&array);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(pcis->D,&array_D);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(x,&array_x);CHKERRQ(ierr);
}
/* sequential part : all problems and Schur applications collapsed into a single matrix vector multiplication or a matvec and a solve */
if (deluxe_ctx->seq_mat) {
PetscInt i;
for (i=0;i<deluxe_ctx->seq_n;i++) {
if (deluxe_ctx->change) {
ierr = VecScatterBegin(deluxe_ctx->seq_scctx[i],x,deluxe_ctx->seq_work2[i],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(deluxe_ctx->seq_scctx[i],x,deluxe_ctx->seq_work2[i],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
if (deluxe_ctx->change_with_qr) {
Mat change;
ierr = KSPGetOperators(deluxe_ctx->change[i],&change,NULL);CHKERRQ(ierr);
ierr = MatMultTranspose(change,deluxe_ctx->seq_work2[i],deluxe_ctx->seq_work1[i]);CHKERRQ(ierr);
} else {
ierr = KSPSolve(deluxe_ctx->change[i],deluxe_ctx->seq_work2[i],deluxe_ctx->seq_work1[i]);CHKERRQ(ierr);
}
} else {
ierr = VecScatterBegin(deluxe_ctx->seq_scctx[i],x,deluxe_ctx->seq_work1[i],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(deluxe_ctx->seq_scctx[i],x,deluxe_ctx->seq_work1[i],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
}
ierr = MatMultTranspose(deluxe_ctx->seq_mat[i],deluxe_ctx->seq_work1[i],deluxe_ctx->seq_work2[i]);CHKERRQ(ierr);
if (deluxe_ctx->seq_mat_inv_sum[i]) {
PetscScalar *x;
ierr = VecGetArray(deluxe_ctx->seq_work2[i],&x);CHKERRQ(ierr);
ierr = VecPlaceArray(deluxe_ctx->seq_work1[i],x);CHKERRQ(ierr);
ierr = VecRestoreArray(deluxe_ctx->seq_work2[i],&x);CHKERRQ(ierr);
ierr = MatSolveTranspose(deluxe_ctx->seq_mat_inv_sum[i],deluxe_ctx->seq_work1[i],deluxe_ctx->seq_work2[i]);CHKERRQ(ierr);
ierr = VecResetArray(deluxe_ctx->seq_work1[i]);CHKERRQ(ierr);
}
if (deluxe_ctx->change) {
Mat change;
ierr = KSPGetOperators(deluxe_ctx->change[i],&change,NULL);CHKERRQ(ierr);
ierr = MatMult(change,deluxe_ctx->seq_work2[i],deluxe_ctx->seq_work1[i]);CHKERRQ(ierr);
ierr = VecScatterBegin(deluxe_ctx->seq_scctx[i],deluxe_ctx->seq_work1[i],pcbddc->work_scaling,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd(deluxe_ctx->seq_scctx[i],deluxe_ctx->seq_work1[i],pcbddc->work_scaling,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
} else {
ierr = VecScatterBegin(deluxe_ctx->seq_scctx[i],deluxe_ctx->seq_work2[i],pcbddc->work_scaling,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd(deluxe_ctx->seq_scctx[i],deluxe_ctx->seq_work2[i],pcbddc->work_scaling,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
}
}
}
/* put local boundary part in global vector */
ierr = VecScatterBegin(pcis->global_to_B,pcbddc->work_scaling,y,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd(pcis->global_to_B,pcbddc->work_scaling,y,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode PCBDDCNullSpaceAssembleCorrection(PC pc, PetscBool isdir, IS local_dofs)
{
PC_BDDC *pcbddc = (PC_BDDC*)pc->data;
PC_IS *pcis = (PC_IS*)pc->data;
Mat_IS* matis = (Mat_IS*)pc->pmat->data;
KSP local_ksp;
PC newpc;
NullSpaceCorrection_ctx shell_ctx;
Mat local_mat,local_pmat,small_mat,inv_small_mat;
Vec work1,work2;
const Vec *nullvecs;
VecScatter scatter_ctx;
IS is_aux;
MatFactorInfo matinfo;
PetscScalar *basis_mat,*Kbasis_mat,*array,*array_mat;
PetscScalar one = 1.0,zero = 0.0, m_one = -1.0;
PetscInt basis_dofs,basis_size,nnsp_size,i,k;
PetscBool nnsp_has_cnst;
PetscErrorCode ierr;
PetscFunctionBegin;
/* Infer the local solver */
ierr = ISGetSize(local_dofs,&basis_dofs);CHKERRQ(ierr);
if (isdir) {
/* Dirichlet solver */
local_ksp = pcbddc->ksp_D;
} else {
/* Neumann solver */
local_ksp = pcbddc->ksp_R;
}
ierr = KSPGetOperators(local_ksp,&local_mat,&local_pmat);CHKERRQ(ierr);
/* Get null space vecs */
ierr = MatNullSpaceGetVecs(pcbddc->NullSpace,&nnsp_has_cnst,&nnsp_size,&nullvecs);CHKERRQ(ierr);
basis_size = nnsp_size;
if (nnsp_has_cnst) {
basis_size++;
}
if (basis_dofs) {
/* Create shell ctx */
ierr = PetscNew(&shell_ctx);CHKERRQ(ierr);
/* Create work vectors in shell context */
ierr = VecCreate(PETSC_COMM_SELF,&shell_ctx->work_small_1);CHKERRQ(ierr);
ierr = VecSetSizes(shell_ctx->work_small_1,basis_size,basis_size);CHKERRQ(ierr);
ierr = VecSetType(shell_ctx->work_small_1,VECSEQ);CHKERRQ(ierr);
ierr = VecDuplicate(shell_ctx->work_small_1,&shell_ctx->work_small_2);CHKERRQ(ierr);
ierr = VecCreate(PETSC_COMM_SELF,&shell_ctx->work_full_1);CHKERRQ(ierr);
ierr = VecSetSizes(shell_ctx->work_full_1,basis_dofs,basis_dofs);CHKERRQ(ierr);
ierr = VecSetType(shell_ctx->work_full_1,VECSEQ);CHKERRQ(ierr);
ierr = VecDuplicate(shell_ctx->work_full_1,&shell_ctx->work_full_2);CHKERRQ(ierr);
/* Allocate workspace */
ierr = MatCreateSeqDense(PETSC_COMM_SELF,basis_dofs,basis_size,NULL,&shell_ctx->basis_mat );CHKERRQ(ierr);
ierr = MatCreateSeqDense(PETSC_COMM_SELF,basis_dofs,basis_size,NULL,&shell_ctx->Kbasis_mat);CHKERRQ(ierr);
ierr = MatDenseGetArray(shell_ctx->basis_mat,&basis_mat);CHKERRQ(ierr);
ierr = MatDenseGetArray(shell_ctx->Kbasis_mat,&Kbasis_mat);CHKERRQ(ierr);
/* Restrict local null space on selected dofs (Dirichlet or Neumann)
and compute matrices N and K*N */
ierr = VecDuplicate(shell_ctx->work_full_1,&work1);CHKERRQ(ierr);
ierr = VecDuplicate(shell_ctx->work_full_1,&work2);CHKERRQ(ierr);
ierr = VecScatterCreate(pcis->vec1_N,local_dofs,work1,(IS)0,&scatter_ctx);CHKERRQ(ierr);
}
for (k=0;k<nnsp_size;k++) {
ierr = VecScatterBegin(matis->rctx,nullvecs[k],pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(matis->rctx,nullvecs[k],pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
if (basis_dofs) {
ierr = VecPlaceArray(work1,(const PetscScalar*)&basis_mat[k*basis_dofs]);CHKERRQ(ierr);
ierr = VecScatterBegin(scatter_ctx,pcis->vec1_N,work1,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(scatter_ctx,pcis->vec1_N,work1,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecPlaceArray(work2,(const PetscScalar*)&Kbasis_mat[k*basis_dofs]);CHKERRQ(ierr);
ierr = MatMult(local_mat,work1,work2);CHKERRQ(ierr);
ierr = VecResetArray(work1);CHKERRQ(ierr);
ierr = VecResetArray(work2);CHKERRQ(ierr);
}
}
if (basis_dofs) {
if (nnsp_has_cnst) {
ierr = VecPlaceArray(work1,(const PetscScalar*)&basis_mat[k*basis_dofs]);CHKERRQ(ierr);
ierr = VecSet(work1,one);CHKERRQ(ierr);
ierr = VecPlaceArray(work2,(const PetscScalar*)&Kbasis_mat[k*basis_dofs]);CHKERRQ(ierr);
ierr = MatMult(local_mat,work1,work2);CHKERRQ(ierr);
ierr = VecResetArray(work1);CHKERRQ(ierr);
ierr = VecResetArray(work2);CHKERRQ(ierr);
}
ierr = VecDestroy(&work1);CHKERRQ(ierr);
ierr = VecDestroy(&work2);CHKERRQ(ierr);
ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(shell_ctx->basis_mat,&basis_mat);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(shell_ctx->Kbasis_mat,&Kbasis_mat);CHKERRQ(ierr);
/* Assemble another Mat object in shell context */
ierr = MatTransposeMatMult(shell_ctx->basis_mat,shell_ctx->Kbasis_mat,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&small_mat);CHKERRQ(ierr);
ierr = MatFactorInfoInitialize(&matinfo);CHKERRQ(ierr);
ierr = ISCreateStride(PETSC_COMM_SELF,basis_size,0,1,&is_aux);CHKERRQ(ierr);
ierr = MatLUFactor(small_mat,is_aux,is_aux,&matinfo);CHKERRQ(ierr);
ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
ierr = PetscMalloc1(basis_size*basis_size,&array_mat);CHKERRQ(ierr);
for (k=0;k<basis_size;k++) {
ierr = VecSet(shell_ctx->work_small_1,zero);CHKERRQ(ierr);
ierr = VecSetValue(shell_ctx->work_small_1,k,one,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecAssemblyBegin(shell_ctx->work_small_1);CHKERRQ(ierr);
ierr = VecAssemblyEnd(shell_ctx->work_small_1);CHKERRQ(ierr);
ierr = MatSolve(small_mat,shell_ctx->work_small_1,shell_ctx->work_small_2);CHKERRQ(ierr);
ierr = VecGetArrayRead(shell_ctx->work_small_2,(const PetscScalar**)&array);CHKERRQ(ierr);
for (i=0;i<basis_size;i++) {
array_mat[i*basis_size+k]=array[i];
}
ierr = VecRestoreArrayRead(shell_ctx->work_small_2,(const PetscScalar**)&array);CHKERRQ(ierr);
}
ierr = MatCreateSeqDense(PETSC_COMM_SELF,basis_size,basis_size,array_mat,&inv_small_mat);CHKERRQ(ierr);
ierr = MatMatMult(shell_ctx->basis_mat,inv_small_mat,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&shell_ctx->Lbasis_mat);CHKERRQ(ierr);
ierr = PetscFree(array_mat);CHKERRQ(ierr);
ierr = MatDestroy(&inv_small_mat);CHKERRQ(ierr);
ierr = MatDestroy(&small_mat);CHKERRQ(ierr);
ierr = MatScale(shell_ctx->Kbasis_mat,m_one);CHKERRQ(ierr);
/* Rebuild local PC */
ierr = KSPGetPC(local_ksp,&shell_ctx->local_pc);CHKERRQ(ierr);
ierr = PetscObjectReference((PetscObject)shell_ctx->local_pc);CHKERRQ(ierr);
ierr = PCCreate(PETSC_COMM_SELF,&newpc);CHKERRQ(ierr);
ierr = PCSetOperators(newpc,local_mat,local_mat);CHKERRQ(ierr);
ierr = PCSetType(newpc,PCSHELL);CHKERRQ(ierr);
ierr = PCShellSetContext(newpc,shell_ctx);CHKERRQ(ierr);
ierr = PCShellSetApply(newpc,PCBDDCApplyNullSpaceCorrectionPC);CHKERRQ(ierr);
ierr = PCShellSetDestroy(newpc,PCBDDCDestroyNullSpaceCorrectionPC);CHKERRQ(ierr);
ierr = PCSetUp(newpc);CHKERRQ(ierr);
ierr = KSPSetPC(local_ksp,newpc);CHKERRQ(ierr);
ierr = PCDestroy(&newpc);CHKERRQ(ierr);
ierr = KSPSetUp(local_ksp);CHKERRQ(ierr);
}
/* test */
if (pcbddc->dbg_flag && basis_dofs) {
KSP check_ksp;
PC check_pc;
Mat test_mat;
Vec work3;
PetscReal test_err,lambda_min,lambda_max;
PetscBool setsym,issym=PETSC_FALSE;
PetscInt tabs;
ierr = PetscViewerASCIIGetTab(pcbddc->dbg_viewer,&tabs);CHKERRQ(ierr);
ierr = KSPGetPC(local_ksp,&check_pc);CHKERRQ(ierr);
ierr = VecDuplicate(shell_ctx->work_full_1,&work1);CHKERRQ(ierr);
ierr = VecDuplicate(shell_ctx->work_full_1,&work2);CHKERRQ(ierr);
ierr = VecDuplicate(shell_ctx->work_full_1,&work3);CHKERRQ(ierr);
ierr = VecSetRandom(shell_ctx->work_small_1,NULL);CHKERRQ(ierr);
ierr = MatMult(shell_ctx->basis_mat,shell_ctx->work_small_1,work1);CHKERRQ(ierr);
ierr = VecCopy(work1,work2);CHKERRQ(ierr);
ierr = MatMult(local_mat,work1,work3);CHKERRQ(ierr);
ierr = PCApply(check_pc,work3,work1);CHKERRQ(ierr);
ierr = VecAXPY(work1,m_one,work2);CHKERRQ(ierr);
ierr = VecNorm(work1,NORM_INFINITY,&test_err);CHKERRQ(ierr);
ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d error for nullspace correction for ",PetscGlobalRank);CHKERRQ(ierr);
ierr = PetscViewerASCIIUseTabs(pcbddc->dbg_viewer,PETSC_FALSE);CHKERRQ(ierr);
if (isdir) {
ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Dirichlet ");CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Neumann ");CHKERRQ(ierr);
}
ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"solver is :%1.14e\n",test_err);CHKERRQ(ierr);
ierr = PetscViewerASCIISetTab(pcbddc->dbg_viewer,tabs);CHKERRQ(ierr);
ierr = PetscViewerASCIIUseTabs(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
ierr = MatTransposeMatMult(shell_ctx->Lbasis_mat,shell_ctx->Kbasis_mat,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&test_mat);CHKERRQ(ierr);
ierr = MatShift(test_mat,one);CHKERRQ(ierr);
ierr = MatNorm(test_mat,NORM_INFINITY,&test_err);CHKERRQ(ierr);
ierr = MatDestroy(&test_mat);CHKERRQ(ierr);
ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d error for nullspace matrices is :%1.14e\n",PetscGlobalRank,test_err);CHKERRQ(ierr);
/* Create ksp object suitable for extreme eigenvalues' estimation */
ierr = KSPCreate(PETSC_COMM_SELF,&check_ksp);CHKERRQ(ierr);
ierr = KSPSetErrorIfNotConverged(check_ksp,pc->erroriffailure);CHKERRQ(ierr);
ierr = KSPSetOperators(check_ksp,local_mat,local_mat);CHKERRQ(ierr);
ierr = KSPSetTolerances(check_ksp,1.e-8,1.e-8,PETSC_DEFAULT,basis_dofs);CHKERRQ(ierr);
ierr = KSPSetComputeSingularValues(check_ksp,PETSC_TRUE);CHKERRQ(ierr);
ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
if (issym) {
ierr = KSPSetType(check_ksp,KSPCG);CHKERRQ(ierr);
}
ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
ierr = VecSetRandom(work1,NULL);CHKERRQ(ierr);
ierr = MatMult(local_mat,work1,work2);CHKERRQ(ierr);
ierr = KSPSolve(check_ksp,work2,work2);CHKERRQ(ierr);
ierr = VecAXPY(work2,m_one,work1);CHKERRQ(ierr);
ierr = VecNorm(work2,NORM_INFINITY,&test_err);CHKERRQ(ierr);
ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(check_ksp,&k);CHKERRQ(ierr);
ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d error for adapted KSP %1.14e (it %d, eigs %1.6e %1.6e)\n",PetscGlobalRank,test_err,k,lambda_min,lambda_max);CHKERRQ(ierr);
ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
ierr = VecDestroy(&work1);CHKERRQ(ierr);
ierr = VecDestroy(&work2);CHKERRQ(ierr);
ierr = VecDestroy(&work3);CHKERRQ(ierr);
}
/* all processes shoud call this, even the void ones */
if (pcbddc->dbg_flag) {
ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode EPSSetUp_LAPACK(EPS eps)
{
PetscErrorCode ierr,ierra,ierrb;
PetscBool isshift,denseok=PETSC_FALSE;
Mat A,B,OP,Adense,Bdense;
PetscScalar shift,*Ap,*Bp;
PetscInt i,ld,nmat;
KSP ksp;
PC pc;
Vec v;
PetscFunctionBegin;
eps->ncv = eps->n;
if (eps->mpd) { ierr = PetscInfo(eps,"Warning: parameter mpd ignored\n");CHKERRQ(ierr); }
if (!eps->which) { ierr = EPSSetWhichEigenpairs_Default(eps);CHKERRQ(ierr); }
if (eps->balance!=EPS_BALANCE_NONE) { ierr = PetscInfo(eps,"Warning: balancing ignored\n");CHKERRQ(ierr); }
if (eps->extraction) { ierr = PetscInfo(eps,"Warning: extraction type ignored\n");CHKERRQ(ierr); }
ierr = EPSAllocateSolution(eps,0);CHKERRQ(ierr);
/* attempt to get dense representations of A and B separately */
ierr = PetscObjectTypeCompare((PetscObject)eps->st,STSHIFT,&isshift);CHKERRQ(ierr);
if (isshift) {
ierr = STGetNumMatrices(eps->st,&nmat);CHKERRQ(ierr);
ierr = STGetOperators(eps->st,0,&A);CHKERRQ(ierr);
if (nmat>1) { ierr = STGetOperators(eps->st,1,&B);CHKERRQ(ierr); }
PetscPushErrorHandler(PetscIgnoreErrorHandler,NULL);
ierra = SlepcMatConvertSeqDense(A,&Adense);CHKERRQ(ierr);
if (eps->isgeneralized) {
ierrb = SlepcMatConvertSeqDense(B,&Bdense);CHKERRQ(ierr);
} else {
ierrb = 0;
}
PetscPopErrorHandler();
denseok = (ierra == 0 && ierrb == 0)? PETSC_TRUE: PETSC_FALSE;
} else Adense = NULL;
/* setup DS */
if (denseok) {
if (eps->isgeneralized) {
if (eps->ishermitian) {
if (eps->ispositive) {
ierr = DSSetType(eps->ds,DSGHEP);CHKERRQ(ierr);
} else {
ierr = DSSetType(eps->ds,DSGNHEP);CHKERRQ(ierr); /* TODO: should be DSGHIEP */
}
} else {
ierr = DSSetType(eps->ds,DSGNHEP);CHKERRQ(ierr);
}
} else {
if (eps->ishermitian) {
ierr = DSSetType(eps->ds,DSHEP);CHKERRQ(ierr);
} else {
ierr = DSSetType(eps->ds,DSNHEP);CHKERRQ(ierr);
}
}
} else {
ierr = DSSetType(eps->ds,DSNHEP);CHKERRQ(ierr);
}
ierr = DSAllocate(eps->ds,eps->ncv);CHKERRQ(ierr);
ierr = DSGetLeadingDimension(eps->ds,&ld);CHKERRQ(ierr);
ierr = DSSetDimensions(eps->ds,eps->ncv,0,0,0);CHKERRQ(ierr);
if (denseok) {
ierr = STGetShift(eps->st,&shift);CHKERRQ(ierr);
if (shift != 0.0) {
ierr = MatShift(Adense,shift);CHKERRQ(ierr);
}
/* use dummy pc and ksp to avoid problems when B is not positive definite */
ierr = STGetKSP(eps->st,&ksp);CHKERRQ(ierr);
ierr = KSPSetType(ksp,KSPPREONLY);CHKERRQ(ierr);
ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr);
ierr = PCSetType(pc,PCNONE);CHKERRQ(ierr);
} else {
ierr = PetscInfo(eps,"Using slow explicit operator\n");CHKERRQ(ierr);
ierr = STComputeExplicitOperator(eps->st,&OP);CHKERRQ(ierr);
ierr = MatDestroy(&Adense);CHKERRQ(ierr);
ierr = SlepcMatConvertSeqDense(OP,&Adense);CHKERRQ(ierr);
}
/* fill DS matrices */
ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,ld,NULL,&v);CHKERRQ(ierr);
ierr = DSGetArray(eps->ds,DS_MAT_A,&Ap);CHKERRQ(ierr);
for (i=0;i<ld;i++) {
ierr = VecPlaceArray(v,Ap+i*ld);CHKERRQ(ierr);
ierr = MatGetColumnVector(Adense,v,i);CHKERRQ(ierr);
ierr = VecResetArray(v);CHKERRQ(ierr);
}
ierr = DSRestoreArray(eps->ds,DS_MAT_A,&Ap);CHKERRQ(ierr);
if (denseok && eps->isgeneralized) {
ierr = DSGetArray(eps->ds,DS_MAT_B,&Bp);CHKERRQ(ierr);
for (i=0;i<ld;i++) {
ierr = VecPlaceArray(v,Bp+i*ld);CHKERRQ(ierr);
ierr = MatGetColumnVector(Bdense,v,i);CHKERRQ(ierr);
ierr = VecResetArray(v);CHKERRQ(ierr);
}
ierr = DSRestoreArray(eps->ds,DS_MAT_B,&Bp);CHKERRQ(ierr);
}
ierr = VecDestroy(&v);CHKERRQ(ierr);
ierr = MatDestroy(&Adense);CHKERRQ(ierr);
if (!denseok) { ierr = MatDestroy(&OP);CHKERRQ(ierr); }
if (denseok && eps->isgeneralized) { ierr = MatDestroy(&Bdense);CHKERRQ(ierr); }
PetscFunctionReturn(0);
}
PetscErrorCode MatSOR_BlockMat_Symmetric(Mat A,Vec bb,PetscReal omega,MatSORType flag,PetscReal fshift,PetscInt its,PetscInt lits,Vec xx)
{
Mat_BlockMat *a = (Mat_BlockMat*)A->data;
PetscScalar *x;
const Mat *v;
const PetscScalar *b;
PetscErrorCode ierr;
PetscInt n = A->cmap->n,i,mbs = n/A->rmap->bs,j,bs = A->rmap->bs;
const PetscInt *idx;
IS row,col;
MatFactorInfo info;
Vec left = a->left,right = a->right, middle = a->middle;
Mat *diag;
PetscFunctionBegin;
its = its*lits;
if (its <= 0) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Relaxation requires global its %D and local its %D both positive",its,lits);
if (flag & SOR_EISENSTAT) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"No support yet for Eisenstat");
if (omega != 1.0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"No support yet for omega not equal to 1.0");
if (fshift) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"No support yet for fshift");
if ((flag & SOR_BACKWARD_SWEEP || flag & SOR_LOCAL_BACKWARD_SWEEP) && !(flag & SOR_FORWARD_SWEEP || flag & SOR_LOCAL_FORWARD_SWEEP)) {
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot do backward sweep without forward sweep");
}
if (!a->diags) {
ierr = PetscMalloc1(mbs,&a->diags);CHKERRQ(ierr);
ierr = MatFactorInfoInitialize(&info);CHKERRQ(ierr);
for (i=0; i<mbs; i++) {
ierr = MatGetOrdering(a->a[a->diag[i]], MATORDERINGND,&row,&col);CHKERRQ(ierr);
ierr = MatCholeskyFactorSymbolic(a->diags[i],a->a[a->diag[i]],row,&info);CHKERRQ(ierr);
ierr = MatCholeskyFactorNumeric(a->diags[i],a->a[a->diag[i]],&info);CHKERRQ(ierr);
ierr = ISDestroy(&row);CHKERRQ(ierr);
ierr = ISDestroy(&col);CHKERRQ(ierr);
}
ierr = VecDuplicate(bb,&a->workb);CHKERRQ(ierr);
}
diag = a->diags;
ierr = VecSet(xx,0.0);CHKERRQ(ierr);
ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
/* copy right hand side because it must be modified during iteration */
ierr = VecCopy(bb,a->workb);CHKERRQ(ierr);
ierr = VecGetArrayRead(a->workb,&b);CHKERRQ(ierr);
/* need to add code for when initial guess is zero, see MatSOR_SeqAIJ */
while (its--) {
if (flag & SOR_FORWARD_SWEEP || flag & SOR_LOCAL_FORWARD_SWEEP) {
for (i=0; i<mbs; i++) {
n = a->i[i+1] - a->i[i] - 1;
idx = a->j + a->i[i] + 1;
v = a->a + a->i[i] + 1;
ierr = VecSet(left,0.0);CHKERRQ(ierr);
for (j=0; j<n; j++) {
ierr = VecPlaceArray(right,x + idx[j]*bs);CHKERRQ(ierr);
ierr = MatMultAdd(v[j],right,left,left);CHKERRQ(ierr);
ierr = VecResetArray(right);CHKERRQ(ierr);
}
ierr = VecPlaceArray(right,b + i*bs);CHKERRQ(ierr);
ierr = VecAYPX(left,-1.0,right);CHKERRQ(ierr);
ierr = VecResetArray(right);CHKERRQ(ierr);
ierr = VecPlaceArray(right,x + i*bs);CHKERRQ(ierr);
ierr = MatSolve(diag[i],left,right);CHKERRQ(ierr);
/* now adjust right hand side, see MatSOR_SeqSBAIJ */
for (j=0; j<n; j++) {
ierr = MatMultTranspose(v[j],right,left);CHKERRQ(ierr);
ierr = VecPlaceArray(middle,b + idx[j]*bs);CHKERRQ(ierr);
ierr = VecAXPY(middle,-1.0,left);CHKERRQ(ierr);
ierr = VecResetArray(middle);CHKERRQ(ierr);
}
ierr = VecResetArray(right);CHKERRQ(ierr);
}
}
if (flag & SOR_BACKWARD_SWEEP || flag & SOR_LOCAL_BACKWARD_SWEEP) {
for (i=mbs-1; i>=0; i--) {
n = a->i[i+1] - a->i[i] - 1;
idx = a->j + a->i[i] + 1;
v = a->a + a->i[i] + 1;
ierr = VecSet(left,0.0);CHKERRQ(ierr);
for (j=0; j<n; j++) {
ierr = VecPlaceArray(right,x + idx[j]*bs);CHKERRQ(ierr);
ierr = MatMultAdd(v[j],right,left,left);CHKERRQ(ierr);
ierr = VecResetArray(right);CHKERRQ(ierr);
}
ierr = VecPlaceArray(right,b + i*bs);CHKERRQ(ierr);
ierr = VecAYPX(left,-1.0,right);CHKERRQ(ierr);
ierr = VecResetArray(right);CHKERRQ(ierr);
ierr = VecPlaceArray(right,x + i*bs);CHKERRQ(ierr);
ierr = MatSolve(diag[i],left,right);CHKERRQ(ierr);
ierr = VecResetArray(right);CHKERRQ(ierr);
}
}
}
ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(a->workb,&b);CHKERRQ(ierr);
PetscFunctionReturn(0);
}