static PetscErrorCode SNESSetUp_QN(SNES snes)
{
SNES_QN *qn = (SNES_QN*)snes->data;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = VecDuplicateVecs(snes->vec_sol, qn->m, &qn->U);CHKERRQ(ierr);
ierr = VecDuplicateVecs(snes->vec_sol, qn->m, &qn->V);CHKERRQ(ierr);
ierr = PetscMalloc3(qn->m, PetscScalar, &qn->alpha,
qn->m, PetscScalar, &qn->beta,
qn->m, PetscScalar, &qn->dXtdF);CHKERRQ(ierr);
if (qn->singlereduction) {
ierr = PetscMalloc3(qn->m*qn->m, PetscScalar, &qn->dXdFmat,
qn->m, PetscScalar, &qn->dFtdX,
qn->m, PetscScalar, &qn->YtdX);CHKERRQ(ierr);
}
ierr = SNESSetWorkVecs(snes,4);CHKERRQ(ierr);
/* set up the line search */
if (qn->scale_type == SNES_QN_SCALE_JACOBIAN) {
ierr = SNESSetUpMatrices(snes);CHKERRQ(ierr);
}
if (snes->pcside == PC_LEFT && snes->functype == SNES_FUNCTION_DEFAULT) {snes->functype = SNES_FUNCTION_UNPRECONDITIONED;}
PetscFunctionReturn(0);
}
static PetscErrorCode KSPSetUp_PIPEFCG(KSP ksp)
{
PetscErrorCode ierr;
KSP_PIPEFCG *pipefcg;
const PetscInt nworkstd = 5;
PetscFunctionBegin;
pipefcg = (KSP_PIPEFCG*)ksp->data;
/* Allocate "standard" work vectors (not including the basis and transformed basis vectors) */
ierr = KSPSetWorkVecs(ksp,nworkstd);CHKERRQ(ierr);
/* Allocated space for pointers to additional work vectors
note that mmax is the number of previous directions, so we add 1 for the current direction,
and an extra 1 for the prealloc (which might be empty) */
ierr = PetscMalloc4(pipefcg->mmax+1,&(pipefcg->Pvecs),pipefcg->mmax+1,&(pipefcg->pPvecs),pipefcg->mmax+1,&(pipefcg->Svecs),pipefcg->mmax+1,&(pipefcg->pSvecs));CHKERRQ(ierr);
ierr = PetscMalloc4(pipefcg->mmax+1,&(pipefcg->Qvecs),pipefcg->mmax+1,&(pipefcg->pQvecs),pipefcg->mmax+1,&(pipefcg->ZETAvecs),pipefcg->mmax+1,&(pipefcg->pZETAvecs));CHKERRQ(ierr);
ierr = PetscMalloc4(pipefcg->mmax+1,&(pipefcg->Pold),pipefcg->mmax+1,&(pipefcg->Sold),pipefcg->mmax+1,&(pipefcg->Qold),pipefcg->mmax+1,&(pipefcg->ZETAold));CHKERRQ(ierr);
ierr = PetscMalloc1(pipefcg->mmax+1,&(pipefcg->chunksizes));CHKERRQ(ierr);
ierr = PetscMalloc3(pipefcg->mmax+2,&(pipefcg->dots),pipefcg->mmax+1,&(pipefcg->etas),pipefcg->mmax+2,&(pipefcg->redux));CHKERRQ(ierr);
/* If the requested number of preallocated vectors is greater than mmax reduce nprealloc */
if(pipefcg->nprealloc > pipefcg->mmax+1){
ierr = PetscInfo2(NULL,"Requested nprealloc=%d is greater than m_max+1=%d. Resetting nprealloc = m_max+1.\n",pipefcg->nprealloc, pipefcg->mmax+1);CHKERRQ(ierr);
}
/* Preallocate additional work vectors */
ierr = KSPAllocateVectors_PIPEFCG(ksp,pipefcg->nprealloc,pipefcg->nprealloc);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)ksp,(pipefcg->mmax+1)*4*sizeof(Vec*)+(pipefcg->mmax+1)*4*sizeof(Vec**)+(pipefcg->mmax+1)*4*sizeof(Vec*)+
(pipefcg->mmax+1)*sizeof(PetscInt)+(pipefcg->mmax+2)*sizeof(Vec*)+(pipefcg->mmax+2)*sizeof(PetscScalar)+(pipefcg->mmax+1)*sizeof(PetscReal));CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PETSC_STATIC_INLINE PetscErrorCode DMInterpolate_Tetrahedron_Private(DMInterpolationInfo ctx, DM dm, Vec xLocal, Vec v)
{
PetscReal *v0, *J, *invJ, detJ;
PetscScalar *a, *coords;
PetscInt p;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscMalloc3(ctx->dim,&v0,ctx->dim*ctx->dim,&J,ctx->dim*ctx->dim,&invJ);CHKERRQ(ierr);
ierr = VecGetArray(ctx->coords, &coords);CHKERRQ(ierr);
ierr = VecGetArray(v, &a);CHKERRQ(ierr);
for (p = 0; p < ctx->n; ++p) {
PetscInt c = ctx->cells[p];
const PetscInt order[3] = {2, 1, 3};
PetscScalar *x = NULL;
PetscReal xi[4];
PetscInt d, f, comp;
ierr = DMPlexComputeCellGeometry(dm, c, v0, J, invJ, &detJ);CHKERRQ(ierr);
if (detJ <= 0.0) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Invalid determinant %g for element %d", detJ, c);
ierr = DMPlexVecGetClosure(dm, NULL, xLocal, c, NULL, &x);CHKERRQ(ierr);
for (comp = 0; comp < ctx->dof; ++comp) a[p*ctx->dof+comp] = x[0*ctx->dof+comp];
for (d = 0; d < ctx->dim; ++d) {
xi[d] = 0.0;
for (f = 0; f < ctx->dim; ++f) xi[d] += invJ[d*ctx->dim+f]*0.5*PetscRealPart(coords[p*ctx->dim+f] - v0[f]);
for (comp = 0; comp < ctx->dof; ++comp) a[p*ctx->dof+comp] += PetscRealPart(x[order[d]*ctx->dof+comp] - x[0*ctx->dof+comp])*xi[d];
}
ierr = DMPlexVecRestoreClosure(dm, NULL, xLocal, c, NULL, &x);CHKERRQ(ierr);
}
ierr = VecRestoreArray(v, &a);CHKERRQ(ierr);
ierr = VecRestoreArray(ctx->coords, &coords);CHKERRQ(ierr);
ierr = PetscFree3(v0, J, invJ);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode PetscMatStashSpaceGet(PetscInt bs2,PetscInt n,PetscMatStashSpace *space)
{
PetscMatStashSpace a;
PetscErrorCode ierr;
PetscFunctionBegin;
if (!n) PetscFunctionReturn(0);
ierr = PetscMalloc(sizeof(struct _MatStashSpace),&a);CHKERRQ(ierr);
ierr = PetscMalloc3(n*bs2,&(a->space_head),n,&a->idx,n,&a->idy);CHKERRQ(ierr);
a->val = a->space_head;
a->local_remaining = n;
a->local_used = 0;
a->total_space_size = 0;
a->next = NULL;
if (*space) {
(*space)->next = a;
a->total_space_size = (*space)->total_space_size;
}
a->total_space_size += n;
*space = a;
PetscFunctionReturn(0);
}
/*
MatGetOrdering_RCM - Find the Reverse Cuthill-McKee ordering of a given matrix.
*/
PETSC_INTERN PetscErrorCode MatGetOrdering_RCM(Mat mat,MatOrderingType type,IS *row,IS *col)
{
PetscErrorCode ierr;
PetscInt i,*mask,*xls,nrow,*perm;
const PetscInt *ia,*ja;
PetscBool done;
PetscFunctionBegin;
ierr = MatGetRowIJ(mat,1,PETSC_TRUE,PETSC_TRUE,&nrow,&ia,&ja,&done);
CHKERRQ(ierr);
if (!done) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot get rows for matrix");
ierr = PetscMalloc3(nrow,&mask,nrow,&perm,2*nrow,&xls);
CHKERRQ(ierr);
SPARSEPACKgenrcm(&nrow,ia,ja,perm,mask,xls);
ierr = MatRestoreRowIJ(mat,1,PETSC_TRUE,PETSC_TRUE,NULL,&ia,&ja,&done);
CHKERRQ(ierr);
/* shift because Sparsepack indices start at one */
for (i=0; i<nrow; i++) perm[i]--;
ierr = ISCreateGeneral(PETSC_COMM_SELF,nrow,perm,PETSC_COPY_VALUES,row);
CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_SELF,nrow,perm,PETSC_COPY_VALUES,col);
CHKERRQ(ierr);
ierr = PetscFree3(mask,perm,xls);
CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/* Check whether a was created via MPI_Type_contiguous from b
*
*/
PetscErrorCode MPIPetsc_Type_compare_contig(MPI_Datatype a,MPI_Datatype b,PetscInt *n)
{
PetscErrorCode ierr;
MPI_Datatype atype,btype;
PetscMPIInt aintcount,aaddrcount,atypecount,acombiner;
PetscFunctionBegin;
ierr = MPIPetsc_Type_unwrap(a,&atype);CHKERRQ(ierr);
ierr = MPIPetsc_Type_unwrap(b,&btype);CHKERRQ(ierr);
*n = PETSC_FALSE;
if (atype == btype) {
*n = 1;
PetscFunctionReturn(0);
}
ierr = MPI_Type_get_envelope(atype,&aintcount,&aaddrcount,&atypecount,&acombiner);CHKERRQ(ierr);
if (acombiner == MPI_COMBINER_CONTIGUOUS && aintcount >= 1) {
PetscMPIInt *aints;
MPI_Aint *aaddrs;
MPI_Datatype *atypes;
ierr = PetscMalloc3(aintcount,&aints,aaddrcount,&aaddrs,atypecount,&atypes);CHKERRQ(ierr);
ierr = MPI_Type_get_contents(atype,aintcount,aaddrcount,atypecount,aints,aaddrs,atypes);CHKERRQ(ierr);
if (atypes[0] == btype) *n = aints[0];
ierr = PetscFree3(aints,aaddrs,atypes);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscFunctionReturn(0);
}
PetscErrorCode MatBlockMatSetPreallocation_BlockMat(Mat A,PetscInt bs,PetscInt nz,PetscInt *nnz)
{
Mat_BlockMat *bmat = (Mat_BlockMat*)A->data;
PetscErrorCode ierr;
PetscInt i;
PetscFunctionBegin;
ierr = PetscLayoutSetBlockSize(A->rmap,bs);CHKERRQ(ierr);
ierr = PetscLayoutSetBlockSize(A->cmap,bs);CHKERRQ(ierr);
ierr = PetscLayoutSetUp(A->rmap);CHKERRQ(ierr);
ierr = PetscLayoutSetUp(A->cmap);CHKERRQ(ierr);
ierr = PetscLayoutGetBlockSize(A->rmap,&bs);CHKERRQ(ierr);
if (nz == PETSC_DEFAULT || nz == PETSC_DECIDE) nz = 5;
if (nz < 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"nz cannot be less than 0: value %d",nz);
if (nnz) {
for (i=0; i<A->rmap->n/bs; i++) {
if (nnz[i] < 0) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"nnz cannot be less than 0: local row %d value %d",i,nnz[i]);
if (nnz[i] > A->cmap->n/bs) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"nnz cannot be greater than row length: local row %d value %d rowlength %d",i,nnz[i],A->cmap->n/bs);
}
}
bmat->mbs = A->rmap->n/bs;
ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,bs,NULL,&bmat->right);CHKERRQ(ierr);
ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,bs,NULL,&bmat->middle);CHKERRQ(ierr);
ierr = VecCreateSeq(PETSC_COMM_SELF,bs,&bmat->left);CHKERRQ(ierr);
if (!bmat->imax) {
ierr = PetscMalloc2(A->rmap->n,&bmat->imax,A->rmap->n,&bmat->ilen);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)A,2*A->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
}
if (nnz) {
nz = 0;
for (i=0; i<A->rmap->n/A->rmap->bs; i++) {
bmat->imax[i] = nnz[i];
nz += nnz[i];
}
} else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Currently requires block row by row preallocation");
/* bmat->ilen will count nonzeros in each row so far. */
for (i=0; i<bmat->mbs; i++) bmat->ilen[i] = 0;
/* allocate the matrix space */
ierr = MatSeqXAIJFreeAIJ(A,(PetscScalar**)&bmat->a,&bmat->j,&bmat->i);CHKERRQ(ierr);
ierr = PetscMalloc3(nz,&bmat->a,nz,&bmat->j,A->rmap->n+1,&bmat->i);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)A,(A->rmap->n+1)*sizeof(PetscInt)+nz*(sizeof(PetscScalar)+sizeof(PetscInt)));CHKERRQ(ierr);
bmat->i[0] = 0;
for (i=1; i<bmat->mbs+1; i++) {
bmat->i[i] = bmat->i[i-1] + bmat->imax[i-1];
}
bmat->singlemalloc = PETSC_TRUE;
bmat->free_a = PETSC_TRUE;
bmat->free_ij = PETSC_TRUE;
bmat->nz = 0;
bmat->maxnz = nz;
A->info.nz_unneeded = (double)bmat->maxnz;
ierr = MatSetOption(A,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
SNESMSRegister - register a multistage scheme
Not Collective, but the same schemes should be registered on all processes on which they will be used
Input Parameters:
+ name - identifier for method
. nstages - number of stages
. nregisters - number of registers used by low-storage implementation
. gamma - coefficients, see Ketcheson's paper
. delta - coefficients, see Ketcheson's paper
- betasub - subdiagonal of Shu-Osher form
Notes:
The notation is described in Ketcheson (2010) Runge-Kutta methods with minimum storage implementations.
Level: advanced
.keywords: SNES, register
.seealso: SNESMS
@*/
PetscErrorCode SNESMSRegister(const SNESMSType name,PetscInt nstages,PetscInt nregisters,PetscReal stability,const PetscReal gamma[],const PetscReal delta[],const PetscReal betasub[])
{
PetscErrorCode ierr;
SNESMSTableauLink link;
SNESMSTableau t;
PetscFunctionBegin;
PetscValidCharPointer(name,1);
if (nstages < 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Must have at least one stage");
if (nregisters != 3) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Only support for methods written in 3-register form");
PetscValidPointer(gamma,4);
PetscValidPointer(delta,5);
PetscValidPointer(betasub,6);
ierr = PetscMalloc(sizeof(*link),&link);CHKERRQ(ierr);
ierr = PetscMemzero(link,sizeof(*link));CHKERRQ(ierr);
t = &link->tab;
ierr = PetscStrallocpy(name,&t->name);CHKERRQ(ierr);
t->nstages = nstages;
t->nregisters = nregisters;
t->stability = stability;
ierr = PetscMalloc3(nstages*nregisters,PetscReal,&t->gamma,nstages,PetscReal,&t->delta,nstages,PetscReal,&t->betasub);CHKERRQ(ierr);
ierr = PetscMemcpy(t->gamma,gamma,nstages*nregisters*sizeof(PetscReal));CHKERRQ(ierr);
ierr = PetscMemcpy(t->delta,delta,nstages*sizeof(PetscReal));CHKERRQ(ierr);
ierr = PetscMemcpy(t->betasub,betasub,nstages*sizeof(PetscReal));CHKERRQ(ierr);
link->next = SNESMSTableauList;
SNESMSTableauList = link;
PetscFunctionReturn(0);
}
EXTERN_C_BEGIN
#undef __FUNCT__
#define __FUNCT__ "PetscViewerCreate_Draw"
PetscErrorCode PETSC_DLLEXPORT PetscViewerCreate_Draw(PetscViewer viewer)
{
PetscInt i;
PetscErrorCode ierr;
PetscViewer_Draw *vdraw;
PetscFunctionBegin;
ierr = PetscNewLog(viewer,PetscViewer_Draw,&vdraw);CHKERRQ(ierr);
viewer->data = (void*)vdraw;
viewer->ops->flush = PetscViewerFlush_Draw;
viewer->ops->destroy = PetscViewerDestroy_Draw;
viewer->ops->getsingleton = PetscViewerGetSingleton_Draw;
viewer->ops->restoresingleton = PetscViewerRestoreSingleton_Draw;
viewer->format = PETSC_VIEWER_NOFORMAT;
/* these are created on the fly if requested */
vdraw->draw_max = 5;
vdraw->draw_base = 0;
ierr = PetscMalloc3(vdraw->draw_max,PetscDraw,&vdraw->draw,vdraw->draw_max,PetscDrawLG,&vdraw->drawlg,vdraw->draw_max,PetscDrawAxis,&vdraw->drawaxis);CHKERRQ(ierr);
ierr = PetscMemzero(vdraw->draw,vdraw->draw_max*sizeof(PetscDraw));CHKERRQ(ierr);
ierr = PetscMemzero(vdraw->drawlg,vdraw->draw_max*sizeof(PetscDrawLG));CHKERRQ(ierr);
ierr = PetscMemzero(vdraw->drawaxis,vdraw->draw_max*sizeof(PetscDrawAxis));CHKERRQ(ierr);
for (i=0; i<vdraw->draw_max; i++) {
vdraw->draw[i] = 0;
vdraw->drawlg[i] = 0;
vdraw->drawaxis[i] = 0;
}
vdraw->singleton_made = PETSC_FALSE;
PetscFunctionReturn(0);
}
EXTERN_C_BEGIN
/*
MatOrdering_RCM - Find the Reverse Cuthill-McKee ordering of a given matrix.
*/
#undef __FUNCT__
#define __FUNCT__ "MatOrdering_RCM"
PetscErrorCode PETSCMAT_DLLEXPORT MatOrdering_RCM(Mat mat,const MatOrderingType type,IS *row,IS *col)
{
PetscErrorCode ierr;
PetscInt i,*mask,*xls,nrow,*ia,*ja,*perm;
PetscTruth done;
PetscFunctionBegin;
ierr = MatGetRowIJ(mat,1,PETSC_TRUE,PETSC_TRUE,&nrow,&ia,&ja,&done);CHKERRQ(ierr);
if (!done) SETERRQ(PETSC_ERR_SUP,"Cannot get rows for matrix");
ierr = PetscMalloc3(nrow,PetscInt,&mask,nrow,PetscInt,&perm,2*nrow,PetscInt,&xls);CHKERRQ(ierr);
SPARSEPACKgenrcm(&nrow,ia,ja,perm,mask,xls);
ierr = MatRestoreRowIJ(mat,1,PETSC_TRUE,PETSC_TRUE,&nrow,&ia,&ja,&done);CHKERRQ(ierr);
/* shift because Sparsepack indices start at one */
for (i=0; i<nrow; i++) perm[i]--;
ierr = ISCreateGeneral(PETSC_COMM_SELF,nrow,perm,row);CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_SELF,nrow,perm,col);CHKERRQ(ierr);
ierr = PetscFree3(mask,perm,xls);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode DMRefineHierarchy_DA(DM da,PetscInt nlevels,DM daf[])
{
PetscErrorCode ierr;
PetscInt i,n,*refx,*refy,*refz;
PetscFunctionBegin;
PetscValidHeaderSpecific(da,DM_CLASSID,1);
if (nlevels < 0) SETERRQ(((PetscObject)da)->comm,PETSC_ERR_ARG_OUTOFRANGE,"nlevels cannot be negative");
if (nlevels == 0) PetscFunctionReturn(0);
PetscValidPointer(daf,3);
/* Get refinement factors, defaults taken from the coarse DMDA */
ierr = PetscMalloc3(nlevels,PetscInt,&refx,nlevels,PetscInt,&refy,nlevels,PetscInt,&refz);CHKERRQ(ierr);
for (i=0; i<nlevels; i++) {
ierr = DMDAGetRefinementFactor(da,&refx[i],&refy[i],&refz[i]);CHKERRQ(ierr);
}
n = nlevels;
ierr = PetscOptionsGetIntArray(((PetscObject)da)->prefix,"-da_refine_hierarchy_x",refx,&n,PETSC_NULL);CHKERRQ(ierr);
n = nlevels;
ierr = PetscOptionsGetIntArray(((PetscObject)da)->prefix,"-da_refine_hierarchy_y",refy,&n,PETSC_NULL);CHKERRQ(ierr);
n = nlevels;
ierr = PetscOptionsGetIntArray(((PetscObject)da)->prefix,"-da_refine_hierarchy_z",refz,&n,PETSC_NULL);CHKERRQ(ierr);
ierr = DMDASetRefinementFactor(da,refx[0],refy[0],refz[0]);CHKERRQ(ierr);
ierr = DMRefine(da,((PetscObject)da)->comm,&daf[0]);CHKERRQ(ierr);
for (i=1; i<nlevels; i++) {
ierr = DMDASetRefinementFactor(daf[i-1],refx[i],refy[i],refz[i]);CHKERRQ(ierr);
ierr = DMRefine(daf[i-1],((PetscObject)da)->comm,&daf[i]);CHKERRQ(ierr);
}
ierr = PetscFree3(refx,refy,refz);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PETSC_EXTERN PetscErrorCode PetscViewerCreate_Draw(PetscViewer viewer)
{
PetscInt i;
PetscErrorCode ierr;
PetscViewer_Draw *vdraw;
PetscFunctionBegin;
ierr = PetscNewLog(viewer,PetscViewer_Draw,&vdraw);CHKERRQ(ierr);
viewer->data = (void*)vdraw;
viewer->ops->flush = PetscViewerFlush_Draw;
viewer->ops->destroy = PetscViewerDestroy_Draw;
viewer->ops->setfromoptions = PetscViewerSetFromOptions_Draw;
viewer->ops->getsingleton = PetscViewerGetSingleton_Draw;
viewer->ops->restoresingleton = PetscViewerRestoreSingleton_Draw;
/* these are created on the fly if requested */
vdraw->draw_max = 5;
vdraw->draw_base = 0;
vdraw->w = PETSC_DECIDE;
vdraw->h = PETSC_DECIDE;
ierr = PetscMalloc3(vdraw->draw_max,PetscDraw,&vdraw->draw,vdraw->draw_max,PetscDrawLG,&vdraw->drawlg,vdraw->draw_max,PetscDrawAxis,&vdraw->drawaxis);CHKERRQ(ierr);
ierr = PetscMemzero(vdraw->draw,vdraw->draw_max*sizeof(PetscDraw));CHKERRQ(ierr);
ierr = PetscMemzero(vdraw->drawlg,vdraw->draw_max*sizeof(PetscDrawLG));CHKERRQ(ierr);
ierr = PetscMemzero(vdraw->drawaxis,vdraw->draw_max*sizeof(PetscDrawAxis));CHKERRQ(ierr);
for (i=0; i<vdraw->draw_max; i++) {
vdraw->draw[i] = 0;
vdraw->drawlg[i] = 0;
vdraw->drawaxis[i] = 0;
}
vdraw->singleton_made = PETSC_FALSE;
PetscFunctionReturn(0);
}
static PetscErrorCode DMPlexGetVTKConnectivity(DM dm,PieceInfo *piece,PetscVTKInt **oconn,PetscVTKInt **ooffsets,PetscVTKType **otypes)
{
PetscErrorCode ierr;
PetscVTKInt *conn,*offsets;
PetscVTKType *types;
PetscInt dim,vStart,vEnd,cStart,cEnd,pStart,pEnd,cellHeight,cMax,numLabelCells,hasLabel,c,v,countcell,countconn;
PetscFunctionBegin;
ierr = PetscMalloc3(piece->nconn,PetscVTKInt,&conn,piece->ncells,PetscVTKInt,&offsets,piece->ncells,PetscVTKType,&types);CHKERRQ(ierr);
ierr = DMPlexGetDimension(dm,&dim);CHKERRQ(ierr);
ierr = DMPlexGetChart(dm,&pStart,&pEnd);CHKERRQ(ierr);
ierr = DMPlexGetVTKCellHeight(dm, &cellHeight);CHKERRQ(ierr);
ierr = DMPlexGetHeightStratum(dm, cellHeight, &cStart, &cEnd);CHKERRQ(ierr);
ierr = DMPlexGetDepthStratum(dm, 0, &vStart, &vEnd);CHKERRQ(ierr);
ierr = DMPlexGetHybridBounds(dm, &cMax, NULL, NULL, NULL);CHKERRQ(ierr);
if (cMax >= 0) cEnd = PetscMin(cEnd, cMax);
ierr = DMPlexGetStratumSize(dm, "vtk", 1, &numLabelCells);CHKERRQ(ierr);
hasLabel = numLabelCells > 0 ? PETSC_TRUE : PETSC_FALSE;
countcell = 0;
countconn = 0;
for (c = cStart; c < cEnd; ++c) {
PetscInt *closure = NULL;
PetscInt closureSize,nverts,celltype,startoffset,nC=0;
if (hasLabel) {
PetscInt value;
ierr = DMPlexGetLabelValue(dm, "vtk", c, &value);CHKERRQ(ierr);
if (value != 1) continue;
}
startoffset = countconn;
ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
for (v = 0; v < closureSize*2; v += 2) {
if ((closure[v] >= vStart) && (closure[v] < vEnd)) {
conn[countconn++] = closure[v] - vStart;
++nC;
}
}
ierr = DMPlexRestoreTransitiveClosure(dm, c, PETSC_TRUE, &closureSize, &closure);CHKERRQ(ierr);
ierr = DMPlexInvertCell(dim, nC, &conn[countconn-nC]);CHKERRQ(ierr);
offsets[countcell] = countconn;
nverts = countconn - startoffset;
ierr = DMPlexVTKGetCellType(dm,dim,nverts,&celltype);CHKERRQ(ierr);
types[countcell] = celltype;
countcell++;
}
if (countcell != piece->ncells) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Inconsistent cell count");
if (countconn != piece->nconn) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Inconsistent connectivity count");
*oconn = conn;
*ooffsets = offsets;
*otypes = types;
PetscFunctionReturn(0);
}
/* collective on KSP */
PetscErrorCode KSPPlotEigenContours_Private(KSP ksp,PetscInt neig,const PetscReal *r,const PetscReal *c)
{
PetscErrorCode ierr;
PetscReal xmin,xmax,ymin,ymax,*xloc,*yloc,*value,px0,py0,rscale,iscale;
PetscInt M,N,i,j;
PetscMPIInt rank;
PetscViewer viewer;
PetscDraw draw;
PetscDrawAxis drawaxis;
PetscFunctionBegin;
ierr = MPI_Comm_rank(((PetscObject)ksp)->comm,&rank);CHKERRQ(ierr);
if (rank) PetscFunctionReturn(0);
M = 80;
N = 80;
xmin = r[0]; xmax = r[0];
ymin = c[0]; ymax = c[0];
for (i=1; i<neig; i++) {
xmin = PetscMin(xmin,r[i]);
xmax = PetscMax(xmax,r[i]);
ymin = PetscMin(ymin,c[i]);
ymax = PetscMax(ymax,c[i]);
}
ierr = PetscMalloc3(M,PetscReal,&xloc,N,PetscReal,&yloc,M*N,PetscReal,&value);CHKERRQ(ierr);
for (i=0; i<M; i++) xloc[i] = xmin - 0.1*(xmax-xmin) + 1.2*(xmax-xmin)*i/(M-1);
for (i=0; i<N; i++) yloc[i] = ymin - 0.1*(ymax-ymin) + 1.2*(ymax-ymin)*i/(N-1);
ierr = PolyEval(neig,r,c,0,0,&px0,&py0);CHKERRQ(ierr);
rscale = px0/(PetscSqr(px0)+PetscSqr(py0));
iscale = -py0/(PetscSqr(px0)+PetscSqr(py0));
for (j=0; j<N; j++) {
for (i=0; i<M; i++) {
PetscReal px,py,tx,ty,tmod;
ierr = PolyEval(neig,r,c,xloc[i],yloc[j],&px,&py);CHKERRQ(ierr);
tx = px*rscale - py*iscale;
ty = py*rscale + px*iscale;
tmod = PetscSqr(tx) + PetscSqr(ty); /* modulus of the complex polynomial */
if (tmod > 1) tmod = 1.0;
if (tmod > 0.5 && tmod < 1) tmod = 0.5;
if (tmod > 0.2 && tmod < 0.5) tmod = 0.2;
if (tmod > 0.05 && tmod < 0.2) tmod = 0.05;
if (tmod < 1e-3) tmod = 1e-3;
value[i+j*M] = PetscLogScalar(tmod) / PetscLogScalar(10.0);
}
}
ierr = PetscViewerDrawOpen(PETSC_COMM_SELF,0,"Iteratively Computed Eigen-contours",PETSC_DECIDE,PETSC_DECIDE,450,450,&viewer);CHKERRQ(ierr);
ierr = PetscViewerDrawGetDraw(viewer,0,&draw);CHKERRQ(ierr);
ierr = PetscDrawTensorContour(draw,M,N,PETSC_NULL,PETSC_NULL,value);CHKERRQ(ierr);
if (0) {
ierr = PetscDrawAxisCreate(draw,&drawaxis);CHKERRQ(ierr);
ierr = PetscDrawAxisSetLimits(drawaxis,xmin,xmax,ymin,ymax);CHKERRQ(ierr);
ierr = PetscDrawAxisSetLabels(drawaxis,"Eigen-counters","real","imag");CHKERRQ(ierr);
ierr = PetscDrawAxisDraw(drawaxis);CHKERRQ(ierr);
ierr = PetscDrawAxisDestroy(&drawaxis);CHKERRQ(ierr);
}
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
ierr = PetscFree3(xloc,yloc,value);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode BuildGradientReconstruction(DM dm, PetscFV fvm, DM dmFace, PetscScalar *fgeom, DM dmCell, PetscScalar *cgeom)
{
DMLabel ghostLabel;
PetscScalar *dx, *grad, **gref;
PetscInt dim, cStart, cEnd, c, cEndInterior, maxNumFaces;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = DMPlexGetDimension(dm, &dim);CHKERRQ(ierr);
ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
ierr = DMPlexGetHybridBounds(dm, &cEndInterior, NULL, NULL, NULL);CHKERRQ(ierr);
ierr = DMPlexGetMaxSizes(dm, &maxNumFaces, NULL);CHKERRQ(ierr);
ierr = PetscFVLeastSquaresSetMaxFaces(fvm, maxNumFaces);CHKERRQ(ierr);
ierr = DMPlexGetLabel(dm, "ghost", &ghostLabel);CHKERRQ(ierr);
ierr = PetscMalloc3(maxNumFaces*dim, &dx, maxNumFaces*dim, &grad, maxNumFaces, &gref);CHKERRQ(ierr);
for (c = cStart; c < cEndInterior; c++) {
const PetscInt *faces;
PetscInt numFaces, usedFaces, f, d;
const CellGeom *cg;
PetscBool boundary;
PetscInt ghost;
ierr = DMPlexPointLocalRead(dmCell, c, cgeom, &cg);CHKERRQ(ierr);
ierr = DMPlexGetConeSize(dm, c, &numFaces);CHKERRQ(ierr);
ierr = DMPlexGetCone(dm, c, &faces);CHKERRQ(ierr);
if (numFaces < dim) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"Cell %D has only %D faces, not enough for gradient reconstruction", c, numFaces);
for (f = 0, usedFaces = 0; f < numFaces; ++f) {
const CellGeom *cg1;
FaceGeom *fg;
const PetscInt *fcells;
PetscInt ncell, side;
ierr = DMLabelGetValue(ghostLabel, faces[f], &ghost);CHKERRQ(ierr);
ierr = DMPlexIsBoundaryPoint(dm, faces[f], &boundary);CHKERRQ(ierr);
if ((ghost >= 0) || boundary) continue;
ierr = DMPlexGetSupport(dm, faces[f], &fcells);CHKERRQ(ierr);
side = (c != fcells[0]); /* c is on left=0 or right=1 of face */
ncell = fcells[!side]; /* the neighbor */
ierr = DMPlexPointLocalRef(dmFace, faces[f], fgeom, &fg);CHKERRQ(ierr);
ierr = DMPlexPointLocalRead(dmCell, ncell, cgeom, &cg1);CHKERRQ(ierr);
for (d = 0; d < dim; ++d) dx[usedFaces*dim+d] = cg1->centroid[d] - cg->centroid[d];
gref[usedFaces++] = fg->grad[side]; /* Gradient reconstruction term will go here */
}
if (!usedFaces) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_USER, "Mesh contains isolated cell (no neighbors). Is it intentional?");
ierr = PetscFVComputeGradient(fvm, usedFaces, dx, grad);CHKERRQ(ierr);
for (f = 0, usedFaces = 0; f < numFaces; ++f) {
ierr = DMLabelGetValue(ghostLabel, faces[f], &ghost);CHKERRQ(ierr);
ierr = DMPlexIsBoundaryPoint(dm, faces[f], &boundary);CHKERRQ(ierr);
if ((ghost >= 0) || boundary) continue;
for (d = 0; d < dim; ++d) gref[usedFaces][d] = grad[usedFaces*dim+d];
++usedFaces;
}
}
ierr = PetscFree3(dx, grad, gref);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode PCSetUp_CP(PC pc)
{
PC_CP *cp = (PC_CP*)pc->data;
PetscInt i,j,*colcnt;
PetscErrorCode ierr;
PetscTruth flg;
Mat_SeqAIJ *aij = (Mat_SeqAIJ*)pc->pmat->data;
PetscFunctionBegin;
ierr = PetscTypeCompare((PetscObject)pc->pmat,MATSEQAIJ,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_ERR_SUP,"Currently only handles SeqAIJ matrices");
ierr = MatGetLocalSize(pc->pmat,&cp->m,&cp->n);CHKERRQ(ierr);
if (cp->m != cp->n) SETERRQ(PETSC_ERR_SUP,"Currently only for square matrices");
if (!cp->work) {ierr = MatGetVecs(pc->pmat,&cp->work,PETSC_NULL);CHKERRQ(ierr);}
if (!cp->d) {ierr = PetscMalloc(cp->n*sizeof(PetscScalar),&cp->d);CHKERRQ(ierr);}
if (cp->a && pc->flag != SAME_NONZERO_PATTERN) {
ierr = PetscFree3(cp->a,cp->i,cp->j);CHKERRQ(ierr);
cp->a = 0;
}
/* convert to column format */
if (!cp->a) {
ierr = PetscMalloc3(aij->nz,PetscScalar,&cp->a,cp->n+1,PetscInt,&cp->i,aij->nz,PetscInt,&cp->j);CHKERRQ(ierr);
}
ierr = PetscMalloc(cp->n*sizeof(PetscInt),&colcnt);CHKERRQ(ierr);
ierr = PetscMemzero(colcnt,cp->n*sizeof(PetscInt));CHKERRQ(ierr);
for (i=0; i<aij->nz; i++) {
colcnt[aij->j[i]]++;
}
cp->i[0] = 0;
for (i=0; i<cp->n; i++) {
cp->i[i+1] = cp->i[i] + colcnt[i];
}
ierr = PetscMemzero(colcnt,cp->n*sizeof(PetscInt));CHKERRQ(ierr);
for (i=0; i<cp->m; i++) { /* over rows */
for (j=aij->i[i]; j<aij->i[i+1]; j++) { /* over columns in row */
cp->j[cp->i[aij->j[j]]+colcnt[aij->j[j]]] = i;
cp->a[cp->i[aij->j[j]]+colcnt[aij->j[j]]++] = aij->a[j];
}
}
ierr = PetscFree(colcnt);CHKERRQ(ierr);
/* compute sum of squares of each column d[] */
for (i=0; i<cp->n; i++) { /* over columns */
cp->d[i] = 0.;
for (j=cp->i[i]; j<cp->i[i+1]; j++) { /* over rows in column */
cp->d[i] += cp->a[j]*cp->a[j];
}
cp->d[i] = 1.0/cp->d[i];
}
PetscFunctionReturn(0);
}
/*@C
MatSeqAIJFromMatlab - Given a MATLAB sparse matrix, fills a SeqAIJ matrix with its transpose.
Not Collective
Input Parameters:
+ mmat - a MATLAB sparse matris
- mat - an already created MATSEQAIJ
Level: intermediate
@*/
PETSC_EXTERN PetscErrorCode MatSeqAIJFromMatlab(mxArray *mmat,Mat mat)
{
PetscErrorCode ierr;
PetscInt nz,n,m,*i,*j,k;
mwIndex nnz,nn,nm,*ii,*jj;
Mat_SeqAIJ *aij = (Mat_SeqAIJ*)mat->data;
PetscFunctionBegin;
nn = mxGetN(mmat); /* rows of transpose of matrix */
nm = mxGetM(mmat);
nnz = (mxGetJc(mmat))[nn];
ii = mxGetJc(mmat);
jj = mxGetIr(mmat);
n = (PetscInt) nn;
m = (PetscInt) nm;
nz = (PetscInt) nnz;
if (mat->rmap->n < 0 && mat->cmap->n < 0) {
/* matrix has not yet had its size set */
ierr = MatSetSizes(mat,n,m,PETSC_DETERMINE,PETSC_DETERMINE);
CHKERRQ(ierr);
ierr = MatSetUp(mat);
CHKERRQ(ierr);
} else {
if (mat->rmap->n != n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot change size of PETSc matrix %D to %D",mat->rmap->n,n);
if (mat->cmap->n != m) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot change size of PETSc matrix %D to %D",mat->cmap->n,m);
}
if (nz != aij->nz) {
/* number of nonzeros in matrix has changed, so need new data structure */
ierr = MatSeqXAIJFreeAIJ(mat,&aij->a,&aij->j,&aij->i);
CHKERRQ(ierr);
aij->nz = nz;
ierr = PetscMalloc3(aij->nz,&aij->a,aij->nz,&aij->j,mat->rmap->n+1,&aij->i);
CHKERRQ(ierr);
aij->singlemalloc = PETSC_TRUE;
}
ierr = PetscMemcpy(aij->a,mxGetPr(mmat),aij->nz*sizeof(PetscScalar));
CHKERRQ(ierr);
/* MATLAB stores by column, not row so we pass in the transpose of the matrix */
i = aij->i;
for (k=0; k<n+1; k++) i[k] = (PetscInt) ii[k];
j = aij->j;
for (k=0; k<nz; k++) j[k] = (PetscInt) jj[k];
for (k=0; k<mat->rmap->n; k++) aij->ilen[k] = aij->imax[k] = aij->i[k+1] - aij->i[k];
ierr = MatAssemblyBegin(mat,MAT_FINAL_ASSEMBLY);
CHKERRQ(ierr);
ierr = MatAssemblyEnd(mat,MAT_FINAL_ASSEMBLY);
CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode KSPSetUp_AGMRES(KSP ksp)
{
PetscErrorCode ierr;
PetscInt hes;
PetscInt nloc;
KSP_AGMRES *agmres = (KSP_AGMRES*)ksp->data;
PetscInt neig = agmres->neig;
PetscInt max_k = agmres->max_k;
PetscInt N = MAXKSPSIZE;
PetscInt lwork = PetscMax(8 * N + 16, 4 * neig * (N - neig));
PetscFunctionBegin;
if (ksp->pc_side == PC_SYMMETRIC) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"no symmetric preconditioning for KSPAGMRES");
max_k = agmres->max_k;
N = MAXKSPSIZE;
/* Preallocate space during the call to KSPSetup_GMRES for the Krylov basis */
agmres->q_preallocate = PETSC_TRUE; /* No allocation on the fly */
/* Preallocate space to compute later the eigenvalues in GMRES */
ksp->calc_sings = PETSC_TRUE;
agmres->max_k = N; /* Set the augmented size to be allocated in KSPSetup_GMRES */
ierr = KSPSetUp_DGMRES(ksp);CHKERRQ(ierr);
agmres->max_k = max_k;
hes = (N + 1) * (N + 1);
/* Data for the Newton basis GMRES */
ierr = PetscMalloc4(max_k,PetscScalar,&agmres->Rshift,max_k,PetscScalar,&agmres->Ishift,hes,PetscScalar,&agmres->Rloc,((N+1)*4),PetscScalar,&agmres->wbufptr);CHKERRQ(ierr);
ierr = PetscMalloc7((N+1),PetscScalar,&agmres->Scale,(N+1),PetscScalar,&agmres->sgn,(N+1),PetscScalar,&agmres->tloc,(N+1),PetscScalar,&agmres->temp,(N+1),PetscScalar,&agmres->tau,lwork,PetscScalar,&agmres->work,(N+1),PetscScalar,&agmres->nrs);CHKERRQ(ierr);
ierr = PetscMemzero(agmres->Rshift, max_k*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = PetscMemzero(agmres->Ishift, max_k*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = PetscMemzero(agmres->Scale, (N+1)*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = PetscMemzero(agmres->Rloc, (N+1)*(N+1)*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = PetscMemzero(agmres->sgn, (N+1)*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = PetscMemzero(agmres->tloc, (N+1)*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = PetscMemzero(agmres->temp, (N+1)*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = PetscMemzero(agmres->wbufptr, (N+1)*4*sizeof(PetscScalar));CHKERRQ(ierr);
/* Allocate space for the vectors in the orthogonalized basis*/
ierr = VecGetLocalSize(agmres->vecs[0], &nloc);CHKERRQ(ierr);
ierr = PetscMalloc(nloc*(N+1)*sizeof(PetscScalar), &agmres->Qloc);CHKERRQ(ierr);
/* Init the ring of processors for the roddec orthogonalization */
ierr = KSPAGMRESRoddecInitNeighboor(ksp);CHKERRQ(ierr);
if (agmres->neig < 1) PetscFunctionReturn(0);
/* Allocate space for the deflation */
ierr = PetscMalloc(N*sizeof(PetscScalar), &agmres->select);CHKERRQ(ierr);
ierr = VecDuplicateVecs(VEC_V(0), N, &agmres->TmpU);CHKERRQ(ierr);
ierr = PetscMalloc2(N*N, PetscScalar, &agmres->MatEigL, N*N, PetscScalar, &agmres->MatEigR);CHKERRQ(ierr);
/* ierr = PetscMalloc6(N*N, PetscScalar, &agmres->Q, N*N, PetscScalar, &agmres->Z, N, PetscScalar, &agmres->wr, N, PetscScalar, &agmres->wi, N, PetscScalar, &agmres->beta, N, PetscScalar, &agmres->modul);CHKERRQ(ierr); */
ierr = PetscMalloc3(N*N, PetscScalar, &agmres->Q, N*N, PetscScalar, &agmres->Z, N, PetscScalar, &agmres->beta);CHKERRQ(ierr);
ierr = PetscMalloc2((N+1),PetscInt,&agmres->perm,(2*neig*N),PetscInt,&agmres->iwork);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
PetscViewerDrawGetDraw - Returns PetscDraw object from PetscViewer object.
This PetscDraw object may then be used to perform graphics using
PetscDrawXXX() commands.
Not collective (but PetscDraw returned will be parallel object if PetscViewer is)
Input Parameters:
+ viewer - the PetscViewer (created with PetscViewerDrawOpen())
- windownumber - indicates which subwindow (usually 0)
Ouput Parameter:
. draw - the draw object
Level: intermediate
Concepts: drawing^accessing PetscDraw context from PetscViewer
Concepts: graphics
.seealso: PetscViewerDrawGetLG(), PetscViewerDrawGetAxis(), PetscViewerDrawOpen()
@*/
PetscErrorCode PETSC_DLLEXPORT PetscViewerDrawGetDraw(PetscViewer viewer,PetscInt windownumber,PetscDraw *draw)
{
PetscViewer_Draw *vdraw = (PetscViewer_Draw*)viewer->data;
PetscErrorCode ierr;
PetscTruth isdraw;
char *title;
PetscFunctionBegin;
PetscValidHeaderSpecific(viewer,PETSC_VIEWER_COOKIE,1);
if (draw) PetscValidPointer(draw,3);
ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_DRAW,&isdraw);CHKERRQ(ierr);
if (!isdraw) {
SETERRQ(PETSC_ERR_ARG_WRONG,"Must be draw type PetscViewer");
}
if (windownumber < 0) {
SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Window number cannot be negative");
}
windownumber += vdraw->draw_base;
if (windownumber >= vdraw->draw_max) {
/* allocate twice as many slots as needed */
PetscInt draw_max = vdraw->draw_max;
PetscDraw *tdraw = vdraw->draw;
PetscDrawLG *drawlg = vdraw->drawlg;
PetscDrawAxis *drawaxis = vdraw->drawaxis;
vdraw->draw_max = 2*windownumber;
ierr = PetscMalloc3(vdraw->draw_max,PetscDraw,&vdraw->draw,vdraw->draw_max,PetscDrawLG,&vdraw->drawlg,vdraw->draw_max,PetscDrawAxis,&vdraw->drawaxis);CHKERRQ(ierr);
ierr = PetscMemzero(vdraw->draw,vdraw->draw_max*sizeof(PetscDraw));CHKERRQ(ierr);
ierr = PetscMemzero(vdraw->drawlg,vdraw->draw_max*sizeof(PetscDrawLG));CHKERRQ(ierr);
ierr = PetscMemzero(vdraw->drawaxis,vdraw->draw_max*sizeof(PetscDrawAxis));CHKERRQ(ierr);
ierr = PetscMemcpy(vdraw->draw,tdraw,draw_max*sizeof(PetscDraw));CHKERRQ(ierr);
ierr = PetscMemcpy(vdraw->drawlg,drawlg,draw_max*sizeof(PetscDrawLG));CHKERRQ(ierr);
ierr = PetscMemcpy(vdraw->drawaxis,drawaxis,draw_max*sizeof(PetscDrawAxis));CHKERRQ(ierr);
ierr = PetscFree3(tdraw,drawlg,drawaxis);CHKERRQ(ierr);
}
if (!vdraw->draw[windownumber]) {
if (!windownumber) {
title = vdraw->title;
} else {
char tmp_str[128];
ierr = PetscSNPrintf(tmp_str, 128, "%s:%d", vdraw->title,windownumber);CHKERRQ(ierr);
title = tmp_str;
}
ierr = PetscDrawCreate(((PetscObject)viewer)->comm,vdraw->display,title,PETSC_DECIDE,PETSC_DECIDE,vdraw->w,vdraw->h,&vdraw->draw[windownumber]);CHKERRQ(ierr);
ierr = PetscDrawSetFromOptions(vdraw->draw[windownumber]);CHKERRQ(ierr);
}
if (draw) *draw = vdraw->draw[windownumber];
PetscFunctionReturn(0);
}
/*@
SVDAllocateSolution - Allocate memory storage for common variables such
as the singular values and the basis vectors.
Collective on SVD
Input Parameters:
+ svd - eigensolver context
- extra - number of additional positions, used for methods that require a
working basis slightly larger than ncv
Developers Notes:
This is PETSC_EXTERN because it may be required by user plugin SVD
implementations.
This is called at setup after setting the value of ncv and the flag leftbasis.
Level: developer
@*/
PetscErrorCode SVDAllocateSolution(SVD svd,PetscInt extra)
{
PetscErrorCode ierr;
PetscInt oldsize,requested;
Vec tr,tl;
PetscFunctionBegin;
requested = svd->ncv + extra;
/* oldsize is zero if this is the first time setup is called */
ierr = BVGetSizes(svd->V,NULL,NULL,&oldsize);CHKERRQ(ierr);
/* allocate sigma */
if (requested != oldsize) {
if (oldsize) {
ierr = PetscFree3(svd->sigma,svd->perm,svd->errest);CHKERRQ(ierr);
}
ierr = PetscMalloc3(requested,&svd->sigma,requested,&svd->perm,requested,&svd->errest);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)svd,PetscMax(0,requested-oldsize)*(2*sizeof(PetscReal)+sizeof(PetscInt)));CHKERRQ(ierr);
}
/* allocate V */
if (!svd->V) { ierr = SVDGetBV(svd,&svd->V,NULL);CHKERRQ(ierr); }
if (!oldsize) {
if (!((PetscObject)(svd->V))->type_name) {
ierr = BVSetType(svd->V,BVSVEC);CHKERRQ(ierr);
}
ierr = SVDMatGetVecs(svd,&tr,NULL);CHKERRQ(ierr);
ierr = BVSetSizesFromVec(svd->V,tr,requested);CHKERRQ(ierr);
ierr = VecDestroy(&tr);CHKERRQ(ierr);
} else {
ierr = BVResize(svd->V,requested,PETSC_FALSE);CHKERRQ(ierr);
}
/* allocate U */
if (svd->leftbasis) {
if (!svd->U) { ierr = SVDGetBV(svd,NULL,&svd->U);CHKERRQ(ierr); }
if (!oldsize) {
if (!((PetscObject)(svd->U))->type_name) {
ierr = BVSetType(svd->U,BVSVEC);CHKERRQ(ierr);
}
ierr = SVDMatGetVecs(svd,NULL,&tl);CHKERRQ(ierr);
ierr = BVSetSizesFromVec(svd->U,tl,requested);CHKERRQ(ierr);
ierr = VecDestroy(&tl);CHKERRQ(ierr);
} else {
ierr = BVResize(svd->U,requested,PETSC_FALSE);CHKERRQ(ierr);
}
}
PetscFunctionReturn(0);
}
PETSC_EXTERN PetscErrorCode MatGetOrdering_WBM(Mat mat, MatOrderingType type, IS *row, IS *col)
{
PetscScalar *a, *dw;
const PetscInt *ia, *ja;
const PetscInt job = 5;
PetscInt *perm, nrow, ncol, nnz, liw, *iw, ldw, i;
PetscBool done;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = MatGetRowIJ(mat,1,PETSC_TRUE,PETSC_TRUE,&nrow,&ia,&ja,&done);CHKERRQ(ierr);
ncol = nrow;
nnz = ia[nrow];
if (!done) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot get rows for matrix");
ierr = MatSeqAIJGetArray(mat, &a);CHKERRQ(ierr);
switch (job) {
case 1: liw = 4*nrow + ncol; ldw = 0;break;
case 2: liw = 2*nrow + 2*ncol; ldw = ncol;break;
case 3: liw = 8*nrow + 2*ncol + nnz; ldw = nnz;break;
case 4: liw = 3*nrow + 2*ncol; ldw = 2*ncol + nnz;break;
case 5: liw = 3*nrow + 2*ncol; ldw = nrow + 2*ncol + nnz;break;
}
ierr = PetscMalloc3(liw,&iw,ldw,&dw,nrow,&perm);CHKERRQ(ierr);
#if defined(PETSC_HAVE_SUPERLU_DIST)
{
PetscInt num, info[10], icntl[10];
ierr = mc64id_dist(icntl);
if (ierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"HSL mc64id_dist returned %d\n",ierr);
icntl[0] = 0; /* allow printing error messages (f2c'd code uses if non-negative, ignores value otherwise) */
icntl[1] = -1; /* suppress warnings */
icntl[2] = -1; /* ignore diagnostic output [default] */
icntl[3] = 0; /* perform consistency checks [default] */
ierr = mc64ad_dist(&job, &nrow, &nnz, ia, ja, a, &num, perm, &liw, iw, &ldw, dw, icntl, info);
if (ierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"HSL mc64ad_dist returned %d\n",ierr);
}
#else
SETERRQ(PetscObjectComm((PetscObject) mat), PETSC_ERR_SUP, "WBM using MC64 does not support complex numbers");
#endif
ierr = MatRestoreRowIJ(mat, 1, PETSC_TRUE, PETSC_TRUE, NULL, &ia, &ja, &done);CHKERRQ(ierr);
for (i = 0; i < nrow; ++i) perm[i]--;
/* If job == 5, dw[0..ncols] contains the column scaling and dw[ncols..ncols+nrows] contains the row scaling */
ierr = ISCreateStride(PETSC_COMM_SELF, nrow, 0, 1, row);CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_SELF,nrow,perm,PETSC_COPY_VALUES,col);CHKERRQ(ierr);
ierr = PetscFree3(iw,dw,perm);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode DMPlexPreallocateOperator_2(DM dm, PetscInt bs, PetscSection section, PetscSection sectionGlobal, PetscInt dnz[], PetscInt onz[], PetscInt dnzu[], PetscInt onzu[], Mat A, PetscBool fillMatrix)
{
PetscInt *tmpClosure,*tmpAdj,*visits;
PetscInt c,cStart,cEnd,pStart,pEnd;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr);
ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr);
ierr = DMPlexGetMaxSizes(dm, &maxConeSize, &maxSupportSize);CHKERRQ(ierr);
maxClosureSize = 2*PetscMax(PetscPowInt(mesh->maxConeSize,depth+1),PetscPowInt(mesh->maxSupportSize,depth+1));
ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr);
npoints = pEnd - pStart;
ierr = PetscMalloc3(maxClosureSize,&tmpClosure,npoints,&lvisits,npoints,&visits);CHKERRQ(ierr);
ierr = PetscMemzero(lvisits,(pEnd-pStart)*sizeof(PetscInt));CHKERRQ(ierr);
ierr = PetscMemzero(visits,(pEnd-pStart)*sizeof(PetscInt));CHKERRQ(ierr);
ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr);
for (c=cStart; c<cEnd; c++) {
PetscInt *support = tmpClosure;
ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_FALSE, &supportSize, (PetscInt**)&support);CHKERRQ(ierr);
for (p=0; p<supportSize; p++) lvisits[support[p]]++;
}
ierr = PetscSFReduceBegin(sf,MPIU_INT,lvisits,visits,MPI_SUM);CHKERRQ(ierr);
ierr = PetscSFReduceEnd (sf,MPIU_INT,lvisits,visits,MPI_SUM);CHKERRQ(ierr);
ierr = PetscSFBcastBegin(sf,MPIU_INT,visits,lvisits);CHKERRQ(ierr);
ierr = PetscSFBcastEnd (sf,MPIU_INT,visits,lvisits);CHKERRQ(ierr);
ierr = PetscSFGetRanks();CHKERRQ(ierr);
ierr = PetscMalloc2(maxClosureSize*maxClosureSize,&cellmat,npoints,&owner);CHKERRQ(ierr);
for (c=cStart; c<cEnd; c++) {
ierr = PetscMemzero(cellmat,maxClosureSize*maxClosureSize*sizeof(PetscInt));CHKERRQ(ierr);
/*
Depth-first walk of transitive closure.
At each leaf frame f of transitive closure that we see, add 1/visits[f] to each pair (p,q) not marked as done in cellmat.
This contribution is added to dnz if owning ranks of p and q match, to onz otherwise.
*/
}
ierr = PetscSFReduceBegin(sf,MPIU_INT,ldnz,dnz,MPI_SUM);CHKERRQ(ierr);
ierr = PetscSFReduceEnd (sf,MPIU_INT,lonz,onz,MPI_SUM);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
ISPartitioningToNumbering - Takes an ISPartitioning and on each processor
generates an IS that contains a new global node number for each index based
on the partitioing.
Collective on IS
Input Parameters
. partitioning - a partitioning as generated by MatPartitioningApply()
Output Parameter:
. is - on each processor the index set that defines the global numbers
(in the new numbering) for all the nodes currently (before the partitioning)
on that processor
Level: advanced
.seealso: MatPartitioningCreate(), AOCreateBasic(), ISPartitioningCount()
@*/
PetscErrorCode ISPartitioningToNumbering(IS part,IS *is)
{
MPI_Comm comm;
PetscInt i,np,npt,n,*starts = NULL,*sums = NULL,*lsizes = NULL,*newi = NULL;
const PetscInt *indices = NULL;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)part,&comm);CHKERRQ(ierr);
/* count the number of partitions, i.e., virtual processors */
ierr = ISGetLocalSize(part,&n);CHKERRQ(ierr);
ierr = ISGetIndices(part,&indices);CHKERRQ(ierr);
np = 0;
for (i=0; i<n; i++) np = PetscMax(np,indices[i]);
ierr = MPI_Allreduce(&np,&npt,1,MPIU_INT,MPI_MAX,comm);CHKERRQ(ierr);
np = npt+1; /* so that it looks like a MPI_Comm_size output */
/*
lsizes - number of elements of each partition on this particular processor
sums - total number of "previous" nodes for any particular partition
starts - global number of first element in each partition on this processor
*/
ierr = PetscMalloc3(np,&lsizes,np,&starts,np,&sums);CHKERRQ(ierr);
ierr = PetscMemzero(lsizes,np*sizeof(PetscInt));CHKERRQ(ierr);
for (i=0; i<n; i++) lsizes[indices[i]]++;
ierr = MPI_Allreduce(lsizes,sums,np,MPIU_INT,MPI_SUM,comm);CHKERRQ(ierr);
ierr = MPI_Scan(lsizes,starts,np,MPIU_INT,MPI_SUM,comm);CHKERRQ(ierr);
for (i=0; i<np; i++) starts[i] -= lsizes[i];
for (i=1; i<np; i++) {
sums[i] += sums[i-1];
starts[i] += sums[i-1];
}
/*
For each local index give it the new global number
*/
ierr = PetscMalloc1(n,&newi);CHKERRQ(ierr);
for (i=0; i<n; i++) newi[i] = starts[indices[i]]++;
ierr = PetscFree3(lsizes,starts,sums);CHKERRQ(ierr);
ierr = ISRestoreIndices(part,&indices);CHKERRQ(ierr);
ierr = ISCreateGeneral(comm,n,newi,PETSC_OWN_POINTER,is);CHKERRQ(ierr);
ierr = ISSetPermutation(*is);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
DenseTridiagonal - Solves a real tridiagonal Hermitian Eigenvalue Problem.
Input Parameters:
+ n - dimension of the eigenproblem
. D - pointer to the array containing the diagonal elements
- E - pointer to the array containing the off-diagonal elements
Output Parameters:
+ w - pointer to the array to store the computed eigenvalues
- V - pointer to the array to store the eigenvectors
Notes:
If V is NULL then the eigenvectors are not computed.
This routine use LAPACK routines xSTEVR.
*/
static PetscErrorCode DenseTridiagonal(PetscInt n_,PetscReal *D,PetscReal *E,PetscReal *w,PetscScalar *V)
{
#if defined(SLEPC_MISSING_LAPACK_STEVR)
PetscFunctionBegin;
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"STEVR - Lapack routine is unavailable");
#else
PetscErrorCode ierr;
PetscReal abstol = 0.0,vl,vu,*work;
PetscBLASInt il,iu,m,*isuppz,n,lwork,*iwork,liwork,info;
const char *jobz;
#if defined(PETSC_USE_COMPLEX)
PetscInt i,j;
PetscReal *VV;
#endif
PetscFunctionBegin;
ierr = PetscBLASIntCast(n_,&n);CHKERRQ(ierr);
ierr = PetscBLASIntCast(20*n_,&lwork);CHKERRQ(ierr);
ierr = PetscBLASIntCast(10*n_,&liwork);CHKERRQ(ierr);
if (V) {
jobz = "V";
#if defined(PETSC_USE_COMPLEX)
ierr = PetscMalloc1(n*n,&VV);CHKERRQ(ierr);
#endif
} else jobz = "N";
ierr = PetscMalloc3(2*n,&isuppz,lwork,&work,liwork,&iwork);CHKERRQ(ierr);
ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
#if defined(PETSC_USE_COMPLEX)
PetscStackCallBLAS("LAPACKstevr",LAPACKstevr_(jobz,"A",&n,D,E,&vl,&vu,&il,&iu,&abstol,&m,w,VV,&n,isuppz,work,&lwork,iwork,&liwork,&info));
#else
PetscStackCallBLAS("LAPACKstevr",LAPACKstevr_(jobz,"A",&n,D,E,&vl,&vu,&il,&iu,&abstol,&m,w,V,&n,isuppz,work,&lwork,iwork,&liwork,&info));
#endif
ierr = PetscFPTrapPop();CHKERRQ(ierr);
if (info) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in Lapack DSTEVR %d",info);
#if defined(PETSC_USE_COMPLEX)
if (V) {
for (i=0;i<n;i++)
for (j=0;j<n;j++)
V[i*n+j] = VV[i*n+j];
ierr = PetscFree(VV);CHKERRQ(ierr);
}
#endif
ierr = PetscFree3(isuppz,work,iwork);CHKERRQ(ierr);
PetscFunctionReturn(0);
#endif
}
/* Check whether a was created via MPI_Type_contiguous from b
*
*/
PetscErrorCode MPIPetsc_Type_compare_contig(MPI_Datatype a,MPI_Datatype b,PetscInt *n)
{
PetscErrorCode ierr;
MPI_Datatype atype,btype;
PetscMPIInt aintcount,aaddrcount,atypecount,acombiner;
PetscBool freeatype,freebtype;
PetscFunctionBegin;
ierr = MPIPetsc_Type_unwrap(a,&atype,&freeatype);CHKERRQ(ierr);
ierr = MPIPetsc_Type_unwrap(b,&btype,&freebtype);CHKERRQ(ierr);
*n = PETSC_FALSE;
if (atype == btype) {
*n = 1;
goto free_types;
}
ierr = MPI_Type_get_envelope(atype,&aintcount,&aaddrcount,&atypecount,&acombiner);CHKERRQ(ierr);
if (acombiner == MPI_COMBINER_CONTIGUOUS && aintcount >= 1) {
PetscMPIInt *aints;
MPI_Aint *aaddrs;
MPI_Datatype *atypes;
PetscInt i;
PetscBool same;
ierr = PetscMalloc3(aintcount,&aints,aaddrcount,&aaddrs,atypecount,&atypes);CHKERRQ(ierr);
ierr = MPI_Type_get_contents(atype,aintcount,aaddrcount,atypecount,aints,aaddrs,atypes);CHKERRQ(ierr);
/* Check for identity first. */
if (atypes[0] == btype) {
*n = aints[0];
} else {
/* atypes[0] merely has to be equivalent to the type used to create atype. */
ierr = MPIPetsc_Type_compare(atypes[0],btype,&same);CHKERRQ(ierr);
if (same) *n = aints[0];
}
for (i=0; i<atypecount; i++) {
ierr = MPIPetsc_Type_free(&(atypes[i]));CHKERRQ(ierr);
}
ierr = PetscFree3(aints,aaddrs,atypes);CHKERRQ(ierr);
}
free_types:
if (freeatype) {
ierr = MPIPetsc_Type_free(&atype);CHKERRQ(ierr);
}
if (freebtype) {
ierr = MPIPetsc_Type_free(&btype);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
int readmm(char s[], Mat *pA){
FILE *file;
int *Is,*Js;
PetscScalar *Vs;
PetscInt m,n,nnz,i;
PetscErrorCode ierr;
ierr = PetscFOpen(PETSC_COMM_SELF,s,"r",&file);CHKERRQ(ierr);
char buf[100];
/* process header with comments */
do fgets(buf,PETSC_MAX_PATH_LEN-1,file);
while (buf[0] == '%');
sscanf(buf,"%d %d %d\n",&m,&n,&nnz);
//ierr = PetscPrintf (PETSC_COMM_SELF,"m = %d, n = %d, nnz = %d\n",m,n,nnz);
/* reseve memory for matrices */
ierr = PetscMalloc3(nnz,&Is, nnz,&Js, nnz,&Vs); CHKERRQ(ierr);
for (i=0; i<nnz; i++) {
ierr = fscanf(file,"%d %d %le\n",&Is[i],&Js[i],(double*)&Vs[i]);
//ierr = PetscPrintf(PETSC_COMM_WORLD,"%d,%d,%le\n",Is[i],Js[i],Vs[i]);CHKERRQ(ierr);
if (ierr == EOF) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_USER,"i=%d, reach EOF\n",i);
Is[i]--; Js[i]--; /* adjust from 1-based to 0-based */
}
fclose(file);
//ierr = PetscPrintf(PETSC_COMM_SELF,"Read file completes.\n");CHKERRQ(ierr);
/* Creat and asseble matrix */
ierr = MatCreate(PETSC_COMM_SELF,pA);CHKERRQ(ierr);
ierr = MatSetType(*pA, /*MATDENSE*/ MATSEQAIJ );CHKERRQ(ierr);
ierr = MatSetSizes(*pA,PETSC_DECIDE,PETSC_DECIDE,m,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(*pA);CHKERRQ(ierr);
ierr = MatSetUp(*pA);CHKERRQ(ierr);
for (i=0; i<nnz; i++) {
ierr = MatSetValues(*pA,1,&Is[i],1,&Js[i],&Vs[i],INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(*pA,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(*pA,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
//ierr = MatView(*pA,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = PetscFree3(Is,Js,Vs);CHKERRQ(ierr);
return 0;
}
static PetscErrorCode CheckPoints(const char *name,PetscInt npoints,const PetscReal *points,PetscInt ndegrees,const PetscInt *degrees)
{
PetscErrorCode ierr;
PetscReal *B,*D,*D2;
PetscInt i,j;
PetscFunctionBegin;
ierr = PetscMalloc3(npoints*ndegrees,&B,npoints*ndegrees,&D,npoints*ndegrees,&D2);CHKERRQ(ierr);
ierr = PetscDTLegendreEval(npoints,points,ndegrees,degrees,B,D,D2);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"%s\n",name);CHKERRQ(ierr);
for (i=0; i<npoints; i++) {
for (j=0; j<ndegrees; j++) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"degree %D at %12.4g: B=%12.4g D=%12.4g D2=%12.4g\n",degrees[j],(double)points[i],(double)B[i*ndegrees+j],(double)D[i*ndegrees+j],(double)D2[i*ndegrees+j]);CHKERRQ(ierr);
}
}
ierr = PetscFree3(B,D,D2);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
PetscConvEstSetUp - After the solver is specified, we create structures for estimating convergence
Collective on PetscConvEst
Input Parameters:
. ce - The PetscConvEst object
Level: beginner
.keywords: PetscConvEst, convergence, setup
.seealso: PetscConvEstCreate(), PetscConvEstGetConvRate()
@*/
PetscErrorCode PetscConvEstSetUp(PetscConvEst ce)
{
PetscDS prob;
PetscInt f;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = DMGetDS(ce->idm, &prob);CHKERRQ(ierr);
ierr = PetscDSGetNumFields(prob, &ce->Nf);CHKERRQ(ierr);
ierr = PetscMalloc1((ce->Nr+1)*ce->Nf, &ce->errors);CHKERRQ(ierr);
ierr = PetscMalloc3(ce->Nf, &ce->initGuess, ce->Nf, &ce->exactSol, ce->Nf, &ce->ctxs);CHKERRQ(ierr);
for (f = 0; f < ce->Nf; ++f) ce->initGuess[f] = zero_private;
for (f = 0; f < ce->Nf; ++f) {
ierr = PetscDSGetExactSolution(prob, f, &ce->exactSol[f], &ce->ctxs[f]);CHKERRQ(ierr);
if (!ce->exactSol[f]) SETERRQ1(PetscObjectComm((PetscObject) ce), PETSC_ERR_ARG_WRONG, "DS must contain exact solution functions in order to estimate convergence, missing for field %D", f);
}
PetscFunctionReturn(0);
}
static PetscErrorCode SNESSetUp_QN(SNES snes)
{
SNES_QN *qn = (SNES_QN*)snes->data;
PetscErrorCode ierr;
DM dm;
PetscFunctionBegin;
if (!snes->vec_sol) {
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
ierr = DMCreateGlobalVector(dm,&snes->vec_sol);CHKERRQ(ierr);
}
ierr = VecDuplicateVecs(snes->vec_sol, qn->m, &qn->U);CHKERRQ(ierr);
if (qn->type != SNES_QN_BROYDEN) ierr = VecDuplicateVecs(snes->vec_sol, qn->m, &qn->V);CHKERRQ(ierr);
ierr = PetscMalloc4(qn->m,&qn->alpha,qn->m,&qn->beta,qn->m,&qn->dXtdF,qn->m,&qn->lambda);CHKERRQ(ierr);
if (qn->singlereduction) {
ierr = PetscMalloc3(qn->m*qn->m,&qn->dXdFmat,qn->m,&qn->dFtdX,qn->m,&qn->YtdX);CHKERRQ(ierr);
}
ierr = SNESSetWorkVecs(snes,4);CHKERRQ(ierr);
/* set method defaults */
if (qn->scale_type == SNES_QN_SCALE_DEFAULT) {
if (qn->type == SNES_QN_BADBROYDEN) {
qn->scale_type = SNES_QN_SCALE_NONE;
} else {
qn->scale_type = SNES_QN_SCALE_SHANNO;
}
}
if (qn->restart_type == SNES_QN_RESTART_DEFAULT) {
if (qn->type == SNES_QN_LBFGS) {
qn->restart_type = SNES_QN_RESTART_POWELL;
} else {
qn->restart_type = SNES_QN_RESTART_PERIODIC;
}
}
if (qn->scale_type == SNES_QN_SCALE_JACOBIAN) {
ierr = SNESSetUpMatrices(snes);CHKERRQ(ierr);
}
if (snes->pcside == PC_LEFT && snes->functype == SNES_FUNCTION_DEFAULT) {snes->functype = SNES_FUNCTION_UNPRECONDITIONED;}
PetscFunctionReturn(0);
}
static PetscErrorCode MatWrapCholmod_seqaij(Mat A,PetscBool values,cholmod_sparse *C,PetscBool *aijalloc)
{
Mat_SeqAIJ *aij = (Mat_SeqAIJ*)A->data;
const PetscInt *ai = aij->i,*aj = aij->j,*adiag;
const MatScalar *aa = aij->a;
PetscInt m = A->rmap->n,i,j,k,nz,*ci,*cj;
PetscScalar *ca;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = MatMarkDiagonal_SeqAIJ(A);CHKERRQ(ierr);
adiag = aij->diag;
for (i=0,nz=0; i<m; i++) nz += ai[i+1] - adiag[i];
ierr = PetscMalloc3(m+1,&ci,nz,&cj,values ? nz : 0,&ca);CHKERRQ(ierr);
for (i=0,k=0; i<m; i++) {
ci[i] = k;
for (j=adiag[i]; j<ai[i+1]; j++,k++) {
cj[k] = aj[j];
if (values) ca[k] = aa[j];
}
}
ci[i] = k;
*aijalloc = PETSC_TRUE;
ierr = PetscMemzero(C,sizeof(*C));CHKERRQ(ierr);
C->nrow = (size_t)A->cmap->n;
C->ncol = (size_t)A->rmap->n;
C->nzmax = (size_t)nz;
C->p = ci;
C->i = cj;
C->x = values ? ca : 0;
C->stype = -1;
C->itype = CHOLMOD_INT_TYPE;
C->xtype = values ? CHOLMOD_SCALAR_TYPE : CHOLMOD_PATTERN;
C->dtype = CHOLMOD_DOUBLE;
C->sorted = 1;
C->packed = 1;
PetscFunctionReturn(0);
}
