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); }