static PetscErrorCode KSPAllocateVectors_FCG(KSP ksp, PetscInt nvecsneeded, PetscInt chunksize)
{
PetscErrorCode ierr;
PetscInt i;
KSP_FCG *fcg = (KSP_FCG*)ksp->data;
PetscInt nnewvecs, nvecsprev;
PetscFunctionBegin;
/* Allocate enough new vectors to add chunksize new vectors, reach nvecsneedtotal, or to reach mmax+1, whichever is smallest */
if (fcg->nvecs < PetscMin(fcg->mmax+1,nvecsneeded)){
nvecsprev = fcg->nvecs;
nnewvecs = PetscMin(PetscMax(nvecsneeded-fcg->nvecs,chunksize),fcg->mmax+1-fcg->nvecs);
ierr = KSPCreateVecs(ksp,nnewvecs,&fcg->pCvecs[fcg->nchunks],0,NULL);CHKERRQ(ierr);
ierr = PetscLogObjectParents((PetscObject)ksp,nnewvecs,fcg->pCvecs[fcg->nchunks]);CHKERRQ(ierr);
ierr = KSPCreateVecs(ksp,nnewvecs,&fcg->pPvecs[fcg->nchunks],0,NULL);CHKERRQ(ierr);
ierr = PetscLogObjectParents((PetscObject)ksp,nnewvecs,fcg->pPvecs[fcg->nchunks]);CHKERRQ(ierr);
fcg->nvecs += nnewvecs;
for (i=0;i<nnewvecs;++i){
fcg->Cvecs[nvecsprev + i] = fcg->pCvecs[fcg->nchunks][i];
fcg->Pvecs[nvecsprev + i] = fcg->pPvecs[fcg->nchunks][i];
}
fcg->chunksizes[fcg->nchunks] = nnewvecs;
++fcg->nchunks;
}
PetscFunctionReturn(0);
}
/*
KSPSetUp_PIPEFGMRES - Sets up the workspace needed by pipefgmres.
This is called once, usually automatically by KSPSolve() or KSPSetUp(),
but can be called directly by KSPSetUp().
*/
static PetscErrorCode KSPSetUp_PIPEFGMRES(KSP ksp)
{
PetscErrorCode ierr;
PetscInt k;
KSP_PIPEFGMRES *pipefgmres = (KSP_PIPEFGMRES*)ksp->data;
const PetscInt max_k = pipefgmres->max_k;
PetscFunctionBegin;
ierr = KSPSetUp_GMRES(ksp);CHKERRQ(ierr);
ierr = PetscMalloc1((VEC_OFFSET+max_k),&pipefgmres->prevecs);CHKERRQ(ierr);
ierr = PetscMalloc1((VEC_OFFSET+max_k),&pipefgmres->prevecs_user_work);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)ksp,(VEC_OFFSET+max_k)*(2*sizeof(void*)));CHKERRQ(ierr);
ierr = KSPCreateVecs(ksp,pipefgmres->vv_allocated,&pipefgmres->prevecs_user_work[0],0,NULL);CHKERRQ(ierr);
ierr = PetscLogObjectParents(ksp,pipefgmres->vv_allocated,pipefgmres->prevecs_user_work[0]);CHKERRQ(ierr);
for (k=0; k < pipefgmres->vv_allocated; k++) {
pipefgmres->prevecs[k] = pipefgmres->prevecs_user_work[0][k];
}
ierr = PetscMalloc1((VEC_OFFSET+max_k),&pipefgmres->zvecs);CHKERRQ(ierr);
ierr = PetscMalloc1((VEC_OFFSET+max_k),&pipefgmres->zvecs_user_work);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)ksp,(VEC_OFFSET+max_k)*(2*sizeof(void*)));CHKERRQ(ierr);
ierr = PetscMalloc1((VEC_OFFSET+max_k),&pipefgmres->redux);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)ksp,(VEC_OFFSET+max_k)*(sizeof(void*)));CHKERRQ(ierr);
ierr = KSPCreateVecs(ksp,pipefgmres->vv_allocated,&pipefgmres->zvecs_user_work[0],0,NULL);CHKERRQ(ierr);
ierr = PetscLogObjectParents(ksp,pipefgmres->vv_allocated,pipefgmres->zvecs_user_work[0]);CHKERRQ(ierr);
for (k=0; k < pipefgmres->vv_allocated; k++) {
pipefgmres->zvecs[k] = pipefgmres->zvecs_user_work[0][k];
}
PetscFunctionReturn(0);
}
static PetscErrorCode KSPAllocateVectors_PIPEFCG(KSP ksp, PetscInt nvecsneeded, PetscInt chunksize)
{
PetscErrorCode ierr;
PetscInt i;
KSP_PIPEFCG *pipefcg;
PetscInt nnewvecs, nvecsprev;
PetscFunctionBegin;
pipefcg = (KSP_PIPEFCG*)ksp->data;
/* Allocate enough new vectors to add chunksize new vectors, reach nvecsneedtotal, or to reach mmax+1, whichever is smallest */
if(pipefcg->nvecs < PetscMin(pipefcg->mmax+1,nvecsneeded)){
nvecsprev = pipefcg->nvecs;
nnewvecs = PetscMin(PetscMax(nvecsneeded-pipefcg->nvecs,chunksize),pipefcg->mmax+1-pipefcg->nvecs);
ierr = KSPCreateVecs(ksp,nnewvecs,&pipefcg->pQvecs[pipefcg->nchunks],0,NULL);CHKERRQ(ierr);
ierr = PetscLogObjectParents((PetscObject)ksp,nnewvecs,pipefcg->pQvecs[pipefcg->nchunks]);CHKERRQ(ierr);
ierr = KSPCreateVecs(ksp,nnewvecs,&pipefcg->pZETAvecs[pipefcg->nchunks],0,NULL);CHKERRQ(ierr);
ierr = PetscLogObjectParents((PetscObject)ksp,nnewvecs,pipefcg->pZETAvecs[pipefcg->nchunks]);CHKERRQ(ierr);
ierr = KSPCreateVecs(ksp,nnewvecs,&pipefcg->pPvecs[pipefcg->nchunks],0,NULL);CHKERRQ(ierr);
ierr = PetscLogObjectParents((PetscObject)ksp,nnewvecs,pipefcg->pPvecs[pipefcg->nchunks]);CHKERRQ(ierr);
ierr = KSPCreateVecs(ksp,nnewvecs,&pipefcg->pSvecs[pipefcg->nchunks],0,NULL);CHKERRQ(ierr);
ierr = PetscLogObjectParents((PetscObject)ksp,nnewvecs,pipefcg->pSvecs[pipefcg->nchunks]);CHKERRQ(ierr);
pipefcg->nvecs += nnewvecs;
for(i=0;i<nnewvecs;++i){
pipefcg->Qvecs[nvecsprev + i] = pipefcg->pQvecs[pipefcg->nchunks][i];
pipefcg->ZETAvecs[nvecsprev + i] = pipefcg->pZETAvecs[pipefcg->nchunks][i];
pipefcg->Pvecs[nvecsprev + i] = pipefcg->pPvecs[pipefcg->nchunks][i];
pipefcg->Svecs[nvecsprev + i] = pipefcg->pSvecs[pipefcg->nchunks][i];
}
pipefcg->chunksizes[pipefcg->nchunks] = nnewvecs;
++pipefcg->nchunks;
}
PetscFunctionReturn(0);
}
PetscErrorCode KSPSetUp_LGMRES(KSP ksp)
{
PetscErrorCode ierr;
PetscInt max_k,k, aug_dim;
KSP_LGMRES *lgmres = (KSP_LGMRES*)ksp->data;
PetscFunctionBegin;
max_k = lgmres->max_k;
aug_dim = lgmres->aug_dim;
ierr = KSPSetUp_GMRES(ksp);CHKERRQ(ierr);
/* need array of pointers to augvecs*/
ierr = PetscMalloc1((2 * aug_dim + AUG_OFFSET),&lgmres->augvecs);CHKERRQ(ierr);
lgmres->aug_vecs_allocated = 2 *aug_dim + AUG_OFFSET;
ierr = PetscMalloc1((2* aug_dim + AUG_OFFSET),&lgmres->augvecs_user_work);CHKERRQ(ierr);
ierr = PetscMalloc1(aug_dim,&lgmres->aug_order);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)ksp,(aug_dim)*(4*sizeof(void*) + sizeof(PetscInt)) + AUG_OFFSET*2*sizeof(void*));CHKERRQ(ierr);
/* for now we will preallocate the augvecs - because aug_dim << restart
... also keep in mind that we need to keep augvecs from cycle to cycle*/
lgmres->aug_vv_allocated = 2* aug_dim + AUG_OFFSET;
lgmres->augwork_alloc = 2* aug_dim + AUG_OFFSET;
ierr = KSPGetVecs(ksp,lgmres->aug_vv_allocated,&lgmres->augvecs_user_work[0],0,NULL);CHKERRQ(ierr);
ierr = PetscMalloc1((max_k+1),&lgmres->hwork);CHKERRQ(ierr);
ierr = PetscLogObjectParents(ksp,lgmres->aug_vv_allocated,lgmres->augvecs_user_work[0]);CHKERRQ(ierr);
for (k=0; k<lgmres->aug_vv_allocated; k++) {
lgmres->augvecs[k] = lgmres->augvecs_user_work[0][k];
}
PetscFunctionReturn(0);
}
PetscErrorCode KSPGMRESGetNewVectors(KSP ksp,PetscInt it)
{
KSP_GMRES *gmres = (KSP_GMRES*)ksp->data;
PetscErrorCode ierr;
PetscInt nwork = gmres->nwork_alloc,k,nalloc;
PetscFunctionBegin;
nalloc = PetscMin(ksp->max_it,gmres->delta_allocate);
/* Adjust the number to allocate to make sure that we don't exceed the
number of available slots */
if (it + VEC_OFFSET + nalloc >= gmres->vecs_allocated) {
nalloc = gmres->vecs_allocated - it - VEC_OFFSET;
}
if (!nalloc) PetscFunctionReturn(0);
gmres->vv_allocated += nalloc;
ierr = KSPGetVecs(ksp,nalloc,&gmres->user_work[nwork],0,NULL);CHKERRQ(ierr);
ierr = PetscLogObjectParents(ksp,nalloc,gmres->user_work[nwork]);CHKERRQ(ierr);
gmres->mwork_alloc[nwork] = nalloc;
for (k=0; k<nalloc; k++) {
gmres->vecs[it+VEC_OFFSET+k] = gmres->user_work[nwork][k];
}
gmres->nwork_alloc++;
PetscFunctionReturn(0);
}
/*
KSPSetUp_FGMRES - Sets up the workspace needed by fgmres.
This is called once, usually automatically by KSPSolve() or KSPSetUp(),
but can be called directly by KSPSetUp().
*/
PetscErrorCode KSPSetUp_FGMRES(KSP ksp)
{
PetscErrorCode ierr;
PetscInt max_k,k;
KSP_FGMRES *fgmres = (KSP_FGMRES*)ksp->data;
PetscFunctionBegin;
max_k = fgmres->max_k;
ierr = KSPSetUp_GMRES(ksp);CHKERRQ(ierr);
ierr = PetscMalloc1(max_k+2,&fgmres->prevecs);CHKERRQ(ierr);
ierr = PetscMalloc1(max_k+2,&fgmres->prevecs_user_work);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)ksp,(max_k+2)*(2*sizeof(void*)));CHKERRQ(ierr);
/* fgmres->vv_allocated includes extra work vectors, which are not used in the additional
block of vectors used to store the preconditioned directions, hence the -VEC_OFFSET
term for this first allocation of vectors holding preconditioned directions */
ierr = KSPCreateVecs(ksp,fgmres->vv_allocated-VEC_OFFSET,&fgmres->prevecs_user_work[0],0,NULL);CHKERRQ(ierr);
ierr = PetscLogObjectParents(ksp,fgmres->vv_allocated-VEC_OFFSET,fgmres->prevecs_user_work[0]);CHKERRQ(ierr);
for (k=0; k < fgmres->vv_allocated - VEC_OFFSET ; k++) {
fgmres->prevecs[k] = fgmres->prevecs_user_work[0][k];
}
PetscFunctionReturn(0);
}
static PetscErrorCode KSPPIPEFGMRESGetNewVectors(KSP ksp,PetscInt it)
{
KSP_PIPEFGMRES *pipefgmres = (KSP_PIPEFGMRES*)ksp->data;
PetscInt nwork = pipefgmres->nwork_alloc; /* number of work vector chunks allocated */
PetscInt nalloc; /* number to allocate */
PetscErrorCode ierr;
PetscInt k;
PetscFunctionBegin;
nalloc = pipefgmres->delta_allocate; /* number of vectors to allocate
in a single chunk */
/* Adjust the number to allocate to make sure that we don't exceed the
number of available slots (pipefgmres->vecs_allocated)*/
if (it + VEC_OFFSET + nalloc >= pipefgmres->vecs_allocated) {
nalloc = pipefgmres->vecs_allocated - it - VEC_OFFSET;
}
if (!nalloc) PetscFunctionReturn(0);
pipefgmres->vv_allocated += nalloc; /* vv_allocated is the number of vectors allocated */
/* work vectors */
ierr = KSPCreateVecs(ksp,nalloc,&pipefgmres->user_work[nwork],0,NULL);CHKERRQ(ierr);
ierr = PetscLogObjectParents(ksp,nalloc,pipefgmres->user_work[nwork]);CHKERRQ(ierr);
for (k=0; k < nalloc; k++) {
pipefgmres->vecs[it+VEC_OFFSET+k] = pipefgmres->user_work[nwork][k];
}
/* specify size of chunk allocated */
pipefgmres->mwork_alloc[nwork] = nalloc;
/* preconditioned vectors (note we don't use VEC_OFFSET) */
ierr = KSPCreateVecs(ksp,nalloc,&pipefgmres->prevecs_user_work[nwork],0,NULL);CHKERRQ(ierr);
ierr = PetscLogObjectParents(ksp,nalloc,pipefgmres->prevecs_user_work[nwork]);CHKERRQ(ierr);
for (k=0; k < nalloc; k++) {
pipefgmres->prevecs[it+k] = pipefgmres->prevecs_user_work[nwork][k];
}
ierr = KSPCreateVecs(ksp,nalloc,&pipefgmres->zvecs_user_work[nwork],0,NULL);CHKERRQ(ierr);
ierr = PetscLogObjectParents(ksp,nalloc,pipefgmres->zvecs_user_work[nwork]);CHKERRQ(ierr);
for (k=0; k < nalloc; k++) {
pipefgmres->zvecs[it+k] = pipefgmres->zvecs_user_work[nwork][k];
}
/* increment the number of work vector chunks */
pipefgmres->nwork_alloc++;
PetscFunctionReturn(0);
}
PETSC_EXTERN PetscErrorCode BVCreate_Contiguous(BV bv)
{
PetscErrorCode ierr;
BV_CONTIGUOUS *ctx;
PetscInt j,nloc,bs;
PetscBool seq;
char str[50];
PetscFunctionBegin;
ierr = PetscNewLog(bv,&ctx);CHKERRQ(ierr);
bv->data = (void*)ctx;
ierr = PetscObjectTypeCompare((PetscObject)bv->t,VECMPI,&ctx->mpi);CHKERRQ(ierr);
if (!ctx->mpi) {
ierr = PetscObjectTypeCompare((PetscObject)bv->t,VECSEQ,&seq);CHKERRQ(ierr);
if (!seq) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot create a contiguous BV from a non-standard template vector");
}
ierr = VecGetLocalSize(bv->t,&nloc);CHKERRQ(ierr);
ierr = VecGetBlockSize(bv->t,&bs);CHKERRQ(ierr);
ierr = PetscMalloc1(bv->m*nloc,&ctx->array);CHKERRQ(ierr);
ierr = PetscMemzero(ctx->array,bv->m*nloc*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = PetscMalloc1(bv->m,&ctx->V);CHKERRQ(ierr);
for (j=0;j<bv->m;j++) {
if (ctx->mpi) {
ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)bv->t),bs,nloc,PETSC_DECIDE,ctx->array+j*nloc,ctx->V+j);CHKERRQ(ierr);
} else {
ierr = VecCreateSeqWithArray(PetscObjectComm((PetscObject)bv->t),bs,nloc,ctx->array+j*nloc,ctx->V+j);CHKERRQ(ierr);
}
}
ierr = PetscLogObjectParents(bv,bv->m,ctx->V);CHKERRQ(ierr);
if (((PetscObject)bv)->name) {
for (j=0;j<bv->m;j++) {
ierr = PetscSNPrintf(str,50,"%s_%D",((PetscObject)bv)->name,j);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject)ctx->V[j],str);CHKERRQ(ierr);
}
}
bv->ops->mult = BVMult_Contiguous;
bv->ops->multvec = BVMultVec_Contiguous;
bv->ops->multinplace = BVMultInPlace_Contiguous;
bv->ops->multinplacetrans = BVMultInPlaceTranspose_Contiguous;
bv->ops->axpy = BVAXPY_Contiguous;
bv->ops->dot = BVDot_Contiguous;
bv->ops->dotvec = BVDotVec_Contiguous;
bv->ops->scale = BVScale_Contiguous;
bv->ops->norm = BVNorm_Contiguous;
/*bv->ops->orthogonalize = BVOrthogonalize_Contiguous;*/
bv->ops->matmult = BVMatMult_Contiguous;
bv->ops->copy = BVCopy_Contiguous;
bv->ops->resize = BVResize_Contiguous;
bv->ops->getcolumn = BVGetColumn_Contiguous;
bv->ops->getarray = BVGetArray_Contiguous;
bv->ops->destroy = BVDestroy_Contiguous;
PetscFunctionReturn(0);
}
PetscErrorCode KSPFischerGuessCreate_Method1(KSP ksp,int maxl,KSPFischerGuess_Method1 **ITG)
{
KSPFischerGuess_Method1 *itg;
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(ksp,KSP_CLASSID,1);
ierr = PetscNew(&itg);CHKERRQ(ierr);
ierr = PetscMalloc1(maxl,&itg->alpha);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)ksp,sizeof(KSPFischerGuess_Method1) + maxl*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = KSPCreateVecs(ksp,maxl,&itg->xtilde,0,NULL);CHKERRQ(ierr);
ierr = PetscLogObjectParents(ksp,maxl,itg->xtilde);CHKERRQ(ierr);
ierr = KSPCreateVecs(ksp,maxl,&itg->btilde,0,NULL);CHKERRQ(ierr);
ierr = PetscLogObjectParents(ksp,maxl,itg->btilde);CHKERRQ(ierr);
ierr = VecDuplicate(itg->xtilde[0],&itg->guess);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)ksp,(PetscObject)itg->guess);CHKERRQ(ierr);
*ITG = itg;
PetscFunctionReturn(0);
}
/*@
SNESDefaultGetWork - Gets a number of work vectors.
Input Parameters:
. snes - the SNES context
. nw - number of work vectors to allocate
Level: developer
Notes:
Call this only if no work vectors have been allocated
@*/
PetscErrorCode SNESDefaultGetWork(SNES snes,PetscInt nw)
{
PetscErrorCode ierr;
PetscFunctionBegin;
if (snes->work) {ierr = VecDestroyVecs(snes->nwork,&snes->work);CHKERRQ(ierr);}
snes->nwork = nw;
ierr = VecDuplicateVecs(snes->vec_sol,snes->nwork,&snes->work);CHKERRQ(ierr);
ierr = PetscLogObjectParents(snes,nw,snes->work);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
KSPSetWorkVecs - Sets a number of work vectors into a KSP object
Input Parameters:
. ksp - iterative context
. nw - number of work vectors to allocate
Developers Note: This is PETSC_EXTERN because it may be used by user written plugin KSP implementations
*/
PetscErrorCode KSPSetWorkVecs(KSP ksp,PetscInt nw)
{
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = VecDestroyVecs(ksp->nwork,&ksp->work);CHKERRQ(ierr);
ksp->nwork = nw;
ierr = KSPCreateVecs(ksp,nw,&ksp->work,0,NULL);CHKERRQ(ierr);
ierr = PetscLogObjectParents(ksp,nw,ksp->work);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
PEPSetWorkVecs - Sets a number of work vectors into a PEP object.
Collective on PEP
Input Parameters:
+ pep - polynomial eigensolver context
- nw - number of work vectors to allocate
Developers Note:
This is PETSC_EXTERN because it may be required by user plugin PEP
implementations.
Level: developer
@*/
PetscErrorCode PEPSetWorkVecs(PEP pep,PetscInt nw)
{
PetscErrorCode ierr;
Vec t;
PetscFunctionBegin;
if (pep->nwork != nw) {
ierr = VecDestroyVecs(pep->nwork,&pep->work);CHKERRQ(ierr);
pep->nwork = nw;
ierr = BVGetColumn(pep->V,0,&t);CHKERRQ(ierr);
ierr = VecDuplicateVecs(t,nw,&pep->work);CHKERRQ(ierr);
ierr = BVRestoreColumn(pep->V,0,&t);CHKERRQ(ierr);
ierr = PetscLogObjectParents(pep,nw,pep->work);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode SNESSetUp_LS(SNES snes)
{
PetscErrorCode ierr;
PetscFunctionBegin;
if (!snes->vec_sol_update) {
ierr = VecDuplicate(snes->vec_sol,&snes->vec_sol_update);CHKERRQ(ierr);
ierr = PetscLogObjectParent(snes,snes->vec_sol_update);CHKERRQ(ierr);
}
if (!snes->work) {
snes->nwork = 3;
ierr = VecDuplicateVecs(snes->vec_sol,snes->nwork,&snes->work);CHKERRQ(ierr);
ierr = PetscLogObjectParents(snes,snes->nwork,snes->work);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*@C
SNESSetWorkVecs - Gets a number of work vectors.
Input Parameters:
. snes - the SNES context
. nw - number of work vectors to allocate
Level: developer
Developers Note: This is PETSC_EXTERN because it may be used by user written plugin SNES implementations
@*/
PetscErrorCode SNESSetWorkVecs(SNES snes,PetscInt nw)
{
DM dm;
Vec v;
PetscErrorCode ierr;
PetscFunctionBegin;
if (snes->work) {ierr = VecDestroyVecs(snes->nwork,&snes->work);CHKERRQ(ierr);}
snes->nwork = nw;
ierr = SNESGetDM(snes, &dm);CHKERRQ(ierr);
ierr = DMGetGlobalVector(dm, &v);CHKERRQ(ierr);
ierr = VecDuplicateVecs(v,snes->nwork,&snes->work);CHKERRQ(ierr);
ierr = DMRestoreGlobalVector(dm, &v);CHKERRQ(ierr);
ierr = PetscLogObjectParents(snes,nw,snes->work);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode KSPFischerGuessCreate_Method2(KSP ksp,int maxl,KSPFischerGuess_Method2 **ITG)
{
KSPFischerGuess_Method2 *itg;
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(ksp,KSP_CLASSID,1);
ierr = PetscMalloc(sizeof(KSPFischerGuess_Method2),&itg);CHKERRQ(ierr);
ierr = PetscMalloc(maxl * sizeof(PetscScalar),&itg->alpha);CHKERRQ(ierr);
ierr = PetscLogObjectMemory(ksp,sizeof(KSPFischerGuess_Method2) + maxl*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = KSPGetVecs(ksp,maxl,&itg->xtilde,0,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscLogObjectParents(ksp,maxl,itg->xtilde);CHKERRQ(ierr);
ierr = VecDuplicate(itg->xtilde[0],&itg->Ax);CHKERRQ(ierr);
ierr = PetscLogObjectParent(ksp,itg->Ax);CHKERRQ(ierr);
ierr = VecDuplicate(itg->xtilde[0],&itg->guess);CHKERRQ(ierr);
ierr = PetscLogObjectParent(ksp,itg->guess);CHKERRQ(ierr);
*ITG = itg;
PetscFunctionReturn(0);
}
static PetscErrorCode KSPLGMRESGetNewVectors(KSP ksp,PetscInt it)
{
KSP_LGMRES *lgmres = (KSP_LGMRES *)ksp->data;
PetscInt nwork = lgmres->nwork_alloc; /* number of work vector chunks allocated */
PetscInt nalloc; /* number to allocate */
PetscErrorCode ierr;
PetscInt k;
PetscFunctionBegin;
nalloc = lgmres->delta_allocate; /* number of vectors to allocate
in a single chunk */
/* Adjust the number to allocate to make sure that we don't exceed the
number of available slots (lgmres->vecs_allocated)*/
if (it + VEC_OFFSET + nalloc >= lgmres->vecs_allocated) {
nalloc = lgmres->vecs_allocated - it - VEC_OFFSET;
}
if (!nalloc) PetscFunctionReturn(0);
lgmres->vv_allocated += nalloc; /* vv_allocated is the number of vectors allocated */
/* work vectors */
ierr = KSPGetVecs(ksp,nalloc,&lgmres->user_work[nwork],0,PETSC_NULL);
CHKERRQ(ierr);
ierr = PetscLogObjectParents(ksp,nalloc,lgmres->user_work[nwork]);
CHKERRQ(ierr);
/* specify size of chunk allocated */
lgmres->mwork_alloc[nwork] = nalloc;
for (k=0; k < nalloc; k++) {
lgmres->vecs[it+VEC_OFFSET+k] = lgmres->user_work[nwork][k];
}
/* LGMRES_MOD - for now we are preallocating the augmentation vectors */
/* increment the number of work vector chunks */
lgmres->nwork_alloc++;
PetscFunctionReturn(0);
}
PetscErrorCode KSPSetUp_FGMRES(KSP ksp)
{
PetscErrorCode ierr;
PetscInt max_k,k;
KSP_FGMRES *fgmres = (KSP_FGMRES*)ksp->data;
PetscFunctionBegin;
max_k = fgmres->max_k;
ierr = KSPSetUp_GMRES(ksp);CHKERRQ(ierr);
ierr = PetscMalloc1((VEC_OFFSET+2+max_k),&fgmres->prevecs);CHKERRQ(ierr);
ierr = PetscMalloc1((VEC_OFFSET+2+max_k),&fgmres->prevecs_user_work);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)ksp,(VEC_OFFSET+2+max_k)*(2*sizeof(void*)));CHKERRQ(ierr);
ierr = KSPGetVecs(ksp,fgmres->vv_allocated,&fgmres->prevecs_user_work[0],0,NULL);CHKERRQ(ierr);
ierr = PetscLogObjectParents(ksp,fgmres->vv_allocated,fgmres->prevecs_user_work[0]);CHKERRQ(ierr);
for (k=0; k < fgmres->vv_allocated; k++) {
fgmres->prevecs[k] = fgmres->prevecs_user_work[0][k];
}
PetscFunctionReturn(0);
}
PetscErrorCode BVResize_Contiguous(BV bv,PetscInt m,PetscBool copy)
{
PetscErrorCode ierr;
BV_CONTIGUOUS *ctx = (BV_CONTIGUOUS*)bv->data;
PetscInt j,bs;
PetscScalar *newarray;
Vec *newV;
char str[50];
PetscFunctionBegin;
ierr = VecGetBlockSize(bv->t,&bs);CHKERRQ(ierr);
ierr = PetscMalloc1(m*bv->n,&newarray);CHKERRQ(ierr);
ierr = PetscMemzero(newarray,m*bv->n*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = PetscMalloc1(m,&newV);CHKERRQ(ierr);
for (j=0;j<m;j++) {
if (ctx->mpi) {
ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)bv->t),bs,bv->n,PETSC_DECIDE,newarray+j*bv->n,newV+j);CHKERRQ(ierr);
} else {
ierr = VecCreateSeqWithArray(PetscObjectComm((PetscObject)bv->t),bs,bv->n,newarray+j*bv->n,newV+j);CHKERRQ(ierr);
}
}
ierr = PetscLogObjectParents(bv,m,newV);CHKERRQ(ierr);
if (((PetscObject)bv)->name) {
for (j=0;j<m;j++) {
ierr = PetscSNPrintf(str,50,"%s_%D",((PetscObject)bv)->name,j);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject)newV[j],str);CHKERRQ(ierr);
}
}
if (copy) {
ierr = PetscMemcpy(newarray,ctx->array,PetscMin(m,bv->m)*bv->n*sizeof(PetscScalar));CHKERRQ(ierr);
}
ierr = VecDestroyVecs(bv->m,&ctx->V);CHKERRQ(ierr);
ctx->V = newV;
ierr = PetscFree(ctx->array);CHKERRQ(ierr);
ctx->array = newarray;
PetscFunctionReturn(0);
}
/*@C
SNESComputeJacobianDefault - Computes the Jacobian using finite differences.
Collective on SNES
Input Parameters:
+ x1 - compute Jacobian at this point
- ctx - application's function context, as set with SNESSetFunction()
Output Parameters:
+ J - Jacobian matrix (not altered in this routine)
- B - newly computed Jacobian matrix to use with preconditioner (generally the same as J)
Options Database Key:
+ -snes_fd - Activates SNESComputeJacobianDefault()
. -snes_test_err - Square root of function error tolerance, default square root of machine
epsilon (1.e-8 in double, 3.e-4 in single)
- -mat_fd_type - Either wp or ds (see MATMFFD_WP or MATMFFD_DS)
Notes:
This routine is slow and expensive, and is not currently optimized
to take advantage of sparsity in the problem. Although
SNESComputeJacobianDefault() is not recommended for general use
in large-scale applications, It can be useful in checking the
correctness of a user-provided Jacobian.
An alternative routine that uses coloring to exploit matrix sparsity is
SNESComputeJacobianDefaultColor().
Level: intermediate
.keywords: SNES, finite differences, Jacobian
.seealso: SNESSetJacobian(), SNESComputeJacobianDefaultColor(), MatCreateSNESMF()
@*/
PetscErrorCode SNESComputeJacobianDefault(SNES snes,Vec x1,Mat J,Mat B,void *ctx)
{
Vec j1a,j2a,x2;
PetscErrorCode ierr;
PetscInt i,N,start,end,j,value,root;
PetscScalar dx,*y,*xx,wscale;
PetscReal amax,epsilon = PETSC_SQRT_MACHINE_EPSILON;
PetscReal dx_min = 1.e-16,dx_par = 1.e-1,unorm;
MPI_Comm comm;
PetscErrorCode (*eval_fct)(SNES,Vec,Vec)=0;
PetscBool assembled,use_wp = PETSC_TRUE,flg;
const char *list[2] = {"ds","wp"};
PetscMPIInt size;
const PetscInt *ranges;
PetscFunctionBegin;
ierr = PetscOptionsGetReal(((PetscObject)snes)->prefix,"-snes_test_err",&epsilon,0);CHKERRQ(ierr);
eval_fct = SNESComputeFunction;
ierr = PetscObjectGetComm((PetscObject)x1,&comm);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = MatAssembled(B,&assembled);CHKERRQ(ierr);
if (assembled) {
ierr = MatZeroEntries(B);CHKERRQ(ierr);
}
if (!snes->nvwork) {
snes->nvwork = 3;
ierr = VecDuplicateVecs(x1,snes->nvwork,&snes->vwork);CHKERRQ(ierr);
ierr = PetscLogObjectParents(snes,snes->nvwork,snes->vwork);CHKERRQ(ierr);
}
j1a = snes->vwork[0]; j2a = snes->vwork[1]; x2 = snes->vwork[2];
ierr = VecGetSize(x1,&N);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(x1,&start,&end);CHKERRQ(ierr);
ierr = (*eval_fct)(snes,x1,j1a);CHKERRQ(ierr);
ierr = PetscOptionsEList("-mat_fd_type","Algorithm to compute difference parameter","SNESComputeJacobianDefault",list,2,"wp",&value,&flg);CHKERRQ(ierr);
if (flg && !value) use_wp = PETSC_FALSE;
if (use_wp) {
ierr = VecNorm(x1,NORM_2,&unorm);CHKERRQ(ierr);
}
/* Compute Jacobian approximation, 1 column at a time.
x1 = current iterate, j1a = F(x1)
x2 = perturbed iterate, j2a = F(x2)
*/
for (i=0; i<N; i++) {
ierr = VecCopy(x1,x2);CHKERRQ(ierr);
if (i>= start && i<end) {
ierr = VecGetArray(x1,&xx);CHKERRQ(ierr);
if (use_wp) dx = 1.0 + unorm;
else dx = xx[i-start];
ierr = VecRestoreArray(x1,&xx);CHKERRQ(ierr);
if (PetscAbsScalar(dx) < dx_min) dx = (PetscRealPart(dx) < 0. ? -1. : 1.) * dx_par;
dx *= epsilon;
wscale = 1.0/dx;
ierr = VecSetValues(x2,1,&i,&dx,ADD_VALUES);CHKERRQ(ierr);
} else {
wscale = 0.0;
}
ierr = VecAssemblyBegin(x2);CHKERRQ(ierr);
ierr = VecAssemblyEnd(x2);CHKERRQ(ierr);
ierr = (*eval_fct)(snes,x2,j2a);CHKERRQ(ierr);
ierr = VecAXPY(j2a,-1.0,j1a);CHKERRQ(ierr);
/* Communicate scale=1/dx_i to all processors */
ierr = VecGetOwnershipRanges(x1,&ranges);CHKERRQ(ierr);
root = size;
for (j=size-1; j>-1; j--) {
root--;
if (i>=ranges[j]) break;
}
ierr = MPI_Bcast(&wscale,1,MPIU_SCALAR,root,comm);CHKERRQ(ierr);
ierr = VecScale(j2a,wscale);CHKERRQ(ierr);
ierr = VecNorm(j2a,NORM_INFINITY,&amax);CHKERRQ(ierr); amax *= 1.e-14;
ierr = VecGetArray(j2a,&y);CHKERRQ(ierr);
for (j=start; j<end; j++) {
if (PetscAbsScalar(y[j-start]) > amax || j == i) {
ierr = MatSetValues(B,1,&j,1,&i,y+j-start,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = VecRestoreArray(j2a,&y);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
if (B != J) {
ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode KSPSetUp_GMRES(KSP ksp)
{
PetscInt hh,hes,rs,cc;
PetscErrorCode ierr;
PetscInt max_k,k;
KSP_GMRES *gmres = (KSP_GMRES*)ksp->data;
PetscFunctionBegin;
max_k = gmres->max_k; /* restart size */
hh = (max_k + 2) * (max_k + 1);
hes = (max_k + 1) * (max_k + 1);
rs = (max_k + 2);
cc = (max_k + 1);
ierr = PetscMalloc5(hh,PetscScalar,&gmres->hh_origin,hes,PetscScalar,&gmres->hes_origin,rs,PetscScalar,&gmres->rs_origin,cc,PetscScalar,&gmres->cc_origin,cc,PetscScalar,&gmres->ss_origin);CHKERRQ(ierr);
ierr = PetscMemzero(gmres->hh_origin,hh*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = PetscMemzero(gmres->hes_origin,hes*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = PetscMemzero(gmres->rs_origin,rs*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = PetscMemzero(gmres->cc_origin,cc*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = PetscMemzero(gmres->ss_origin,cc*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = PetscLogObjectMemory(ksp,(hh + hes + rs + 2*cc)*sizeof(PetscScalar));CHKERRQ(ierr);
if (ksp->calc_sings) {
/* Allocate workspace to hold Hessenberg matrix needed by lapack */
ierr = PetscMalloc((max_k + 3)*(max_k + 9)*sizeof(PetscScalar),&gmres->Rsvd);CHKERRQ(ierr);
ierr = PetscLogObjectMemory(ksp,(max_k + 3)*(max_k + 9)*sizeof(PetscScalar));CHKERRQ(ierr);
ierr = PetscMalloc(6*(max_k+2)*sizeof(PetscReal),&gmres->Dsvd);CHKERRQ(ierr);
ierr = PetscLogObjectMemory(ksp,6*(max_k+2)*sizeof(PetscReal));CHKERRQ(ierr);
}
/* Allocate array to hold pointers to user vectors. Note that we need
4 + max_k + 1 (since we need it+1 vectors, and it <= max_k) */
gmres->vecs_allocated = VEC_OFFSET + 2 + max_k + gmres->nextra_vecs;
ierr = PetscMalloc((gmres->vecs_allocated)*sizeof(Vec),&gmres->vecs);CHKERRQ(ierr);
ierr = PetscMalloc((VEC_OFFSET+2+max_k)*sizeof(Vec*),&gmres->user_work);CHKERRQ(ierr);
ierr = PetscMalloc((VEC_OFFSET+2+max_k)*sizeof(PetscInt),&gmres->mwork_alloc);CHKERRQ(ierr);
ierr = PetscLogObjectMemory(ksp,(VEC_OFFSET+2+max_k)*(sizeof(Vec*)+sizeof(PetscInt)) + gmres->vecs_allocated*sizeof(Vec));CHKERRQ(ierr);
if (gmres->q_preallocate) {
gmres->vv_allocated = VEC_OFFSET + 2 + max_k;
ierr = KSPGetVecs(ksp,gmres->vv_allocated,&gmres->user_work[0],0,NULL);CHKERRQ(ierr);
ierr = PetscLogObjectParents(ksp,gmres->vv_allocated,gmres->user_work[0]);CHKERRQ(ierr);
gmres->mwork_alloc[0] = gmres->vv_allocated;
gmres->nwork_alloc = 1;
for (k=0; k<gmres->vv_allocated; k++) {
gmres->vecs[k] = gmres->user_work[0][k];
}
} else {
gmres->vv_allocated = 5;
ierr = KSPGetVecs(ksp,5,&gmres->user_work[0],0,NULL);CHKERRQ(ierr);
ierr = PetscLogObjectParents(ksp,5,gmres->user_work[0]);CHKERRQ(ierr);
gmres->mwork_alloc[0] = 5;
gmres->nwork_alloc = 1;
for (k=0; k<gmres->vv_allocated; k++) {
gmres->vecs[k] = gmres->user_work[0][k];
}
}
PetscFunctionReturn(0);
}
