/*@
ISEqual - Compares if two index sets have the same set of indices.
Collective on IS
Input Parameters:
. is1, is2 - The index sets being compared
Output Parameters:
. flg - output flag, either PETSC_TRUE (if both index sets have the
same indices), or PETSC_FALSE if the index sets differ by size
or by the set of indices)
Level: intermediate
Note:
This routine sorts the contents of the index sets before
the comparision is made, so the order of the indices on a processor is immaterial.
Each processor has to have the same indices in the two sets, for example,
$ Processor
$ 0 1
$ is1 = {0, 1} {2, 3}
$ is2 = {2, 3} {0, 1}
will return false.
Concepts: index sets^equal
Concepts: IS^equal
@*/
PetscErrorCode PETSCVEC_DLLEXPORT ISEqual(IS is1,IS is2,PetscTruth *flg)
{
PetscInt sz1,sz2,*a1,*a2;
const PetscInt *ptr1,*ptr2;
PetscTruth flag;
MPI_Comm comm;
PetscErrorCode ierr;
PetscMPIInt mflg;
PetscFunctionBegin;
PetscValidHeaderSpecific(is1,IS_COOKIE,1);
PetscValidHeaderSpecific(is2,IS_COOKIE,2);
PetscValidIntPointer(flg,3);
if (is1 == is2) {
*flg = PETSC_TRUE;
PetscFunctionReturn(0);
}
ierr = MPI_Comm_compare(((PetscObject)is1)->comm,((PetscObject)is2)->comm,&mflg);CHKERRQ(ierr);
if (mflg != MPI_CONGRUENT && mflg != MPI_IDENT) {
*flg = PETSC_FALSE;
PetscFunctionReturn(0);
}
ierr = ISGetSize(is1,&sz1);CHKERRQ(ierr);
ierr = ISGetSize(is2,&sz2);CHKERRQ(ierr);
if (sz1 != sz2) {
*flg = PETSC_FALSE;
} else {
ierr = ISGetLocalSize(is1,&sz1);CHKERRQ(ierr);
ierr = ISGetLocalSize(is2,&sz2);CHKERRQ(ierr);
if (sz1 != sz2) {
flag = PETSC_FALSE;
} else {
ierr = ISGetIndices(is1,&ptr1);CHKERRQ(ierr);
ierr = ISGetIndices(is2,&ptr2);CHKERRQ(ierr);
ierr = PetscMalloc(sz1*sizeof(PetscInt),&a1);CHKERRQ(ierr);
ierr = PetscMalloc(sz2*sizeof(PetscInt),&a2);CHKERRQ(ierr);
ierr = PetscMemcpy(a1,ptr1,sz1*sizeof(PetscInt));CHKERRQ(ierr);
ierr = PetscMemcpy(a2,ptr2,sz2*sizeof(PetscInt));CHKERRQ(ierr);
ierr = PetscSortInt(sz1,a1);CHKERRQ(ierr);
ierr = PetscSortInt(sz2,a2);CHKERRQ(ierr);
ierr = PetscMemcmp(a1,a2,sz1*sizeof(PetscInt),&flag);CHKERRQ(ierr);
ierr = ISRestoreIndices(is1,&ptr1);CHKERRQ(ierr);
ierr = ISRestoreIndices(is2,&ptr2);CHKERRQ(ierr);
ierr = PetscFree(a1);CHKERRQ(ierr);
ierr = PetscFree(a2);CHKERRQ(ierr);
}
ierr = PetscObjectGetComm((PetscObject)is1,&comm);CHKERRQ(ierr);
ierr = MPI_Allreduce(&flag,flg,1,MPI_INT,MPI_MIN,comm);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode UMReadISs(UM *mesh, char *filename) {
PetscErrorCode ierr;
PetscViewer viewer;
int n_bfn, n_bfs;
if ((mesh->K > 0) || (mesh->P > 0)) {
SETERRQ(PETSC_COMM_WORLD,1,
"elements already created? ... stopping\n");
}
if ((!mesh->loc) || (mesh->N == 0)) {
SETERRQ(PETSC_COMM_WORLD,2,
"node coordinates not created ... do that first ... stopping\n");
}
ierr = PetscViewerBinaryOpen(PETSC_COMM_WORLD,filename,FILE_MODE_READ,&viewer); CHKERRQ(ierr);
// create and load e
ierr = ISCreate(PETSC_COMM_WORLD,&(mesh->e)); CHKERRQ(ierr);
ierr = ISLoad(mesh->e,viewer); CHKERRQ(ierr);
ierr = ISGetSize(mesh->e,&(mesh->K)); CHKERRQ(ierr);
if (mesh->K % 3 != 0) {
SETERRQ1(PETSC_COMM_WORLD,3,
"IS e loaded from %s is wrong size for list of element triples\n",filename);
}
mesh->K /= 3;
// create and load bfn
ierr = ISCreate(PETSC_COMM_WORLD,&(mesh->bfn)); CHKERRQ(ierr);
ierr = ISLoad(mesh->bfn,viewer); CHKERRQ(ierr);
ierr = ISGetSize(mesh->bfn,&n_bfn); CHKERRQ(ierr);
if (n_bfn != mesh->N) {
SETERRQ1(PETSC_COMM_WORLD,4,
"IS bfn loaded from %s is wrong size\n",filename);
}
// create and load s
ierr = ISCreate(PETSC_COMM_WORLD,&(mesh->s)); CHKERRQ(ierr);
ierr = ISLoad(mesh->s,viewer); CHKERRQ(ierr);
ierr = ISGetSize(mesh->s,&(mesh->P)); CHKERRQ(ierr);
if (mesh->P % 2 != 0) {
SETERRQ1(PETSC_COMM_WORLD,4,
"IS s loaded from %s is wrong size for list of segment pairs\n",filename);
}
mesh->P /= 2;
// create and load bfn
ierr = ISCreate(PETSC_COMM_WORLD,&(mesh->bfs)); CHKERRQ(ierr);
ierr = ISLoad(mesh->bfs,viewer); CHKERRQ(ierr);
ierr = ISGetSize(mesh->bfs,&n_bfs); CHKERRQ(ierr);
if (n_bfs != mesh->P) {
SETERRQ1(PETSC_COMM_WORLD,4,
"IS bfs loaded from %s is wrong size\n",filename);
}
// mesh should be complete now
ierr = PetscViewerDestroy(&viewer); CHKERRQ(ierr);
ierr = UMCheckElements(mesh); CHKERRQ(ierr);
ierr = UMCheckBoundaryData(mesh); CHKERRQ(ierr);
return 0;
}
/*@
ISSetPermutation - Informs the index set that it is a permutation.
Logically Collective on IS
Input Parmeters:
. is - the index set
Level: intermediate
Concepts: permutation
Concepts: index sets^permutation
The debug version of the libraries (./configure --with-debugging=1) checks if the
index set is actually a permutation. The optimized version just believes you.
.seealso: ISPermutation()
@*/
PetscErrorCode ISSetPermutation(IS is)
{
PetscFunctionBegin;
PetscValidHeaderSpecific(is,IS_CLASSID,1);
#if defined(PETSC_USE_DEBUG)
{
PetscMPIInt size;
PetscErrorCode ierr;
ierr = MPI_Comm_size(PetscObjectComm((PetscObject)is),&size);CHKERRQ(ierr);
if (size == 1) {
PetscInt i,n,*idx;
const PetscInt *iidx;
ierr = ISGetSize(is,&n);CHKERRQ(ierr);
ierr = PetscMalloc(n*sizeof(PetscInt),&idx);CHKERRQ(ierr);
ierr = ISGetIndices(is,&iidx);CHKERRQ(ierr);
ierr = PetscMemcpy(idx,iidx,n*sizeof(PetscInt));CHKERRQ(ierr);
ierr = PetscSortInt(n,idx);CHKERRQ(ierr);
for (i=0; i<n; i++) {
if (idx[i] != i) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Index set is not a permutation");
}
ierr = PetscFree(idx);CHKERRQ(ierr);
ierr = ISRestoreIndices(is,&iidx);CHKERRQ(ierr);
}
}
#endif
is->isperm = PETSC_TRUE;
PetscFunctionReturn(0);
}
/** Set rotation for certain nodes in a function space
*
* @param fs the function space
* @param is index set of nodes to rotate, sequential, with respect blocks of local vector
* @param rot Rotation matrices at all nodes in \a is. Should have length \c bs*bs*size(is).
* @param ns number of dofs to enforce strongly at each node (every entry must have 0<=ns[i]<=bs)
* @param v Vector of values for strongly enforced dofs
*
* @example Consider 2D flow over a bed with known melt rates. Suppose the local velocity vector is
*
* [u0x,u0y; u1x,u1y; u2x,u2y; u3x,u3y | u4x,u4y]
*
* (4 owned blocks, one ghosted block) and nodes 1,4 are on the slip boundary with normal and tangent vectors n1,t1,n4,t4
* and melt rates r1,r4. To enforce the melt rate strongly, use
*
* \a is = [1,4]
* \a rot = [n10,n11,t10,t11, n40,n41,t40,t41]
* \a ns = [1,1]
* \a v = [r1,r4]
*
* The rotated vector will become (. = \cdot)
*
* [u0x,u0y; u1.n1,u1.t1; u2x,u2y; u3x,u3y | u4.n4,u4.t4]
*
* and strongly enforcing melt rate produces the global vector
*
* [u0x,u0y; r1,u1.t1; u2x,u2y; u3x,u3y | r4,u4.t4] .
*
* This is what the solver sees, the Jacobian will always have rows and columns of the identity corresponding to the
* strongly enforced components (2,8 of the local vector) and the residual will always be 0 in these components. Hence
* the Newton step v will always be of the form
*
* [v0x,v0y; 0,v1y; v2x,v2y; v3x,v3y | 0,v4y] .
**/
dErr dFSRotationCreate(dFS fs,IS is,dReal rmat[],dInt ns[],Vec v,dFSRotation *inrot)
{
dFSRotation rot;
dInt bs,n;
dErr err;
dFunctionBegin;
dValidHeader(fs,DM_CLASSID,1);
dValidHeader(is,IS_CLASSID,2);
dValidRealPointer(rmat,3);
dValidIntPointer(ns,4);
dValidHeader(v,VEC_CLASSID,5);
dValidPointer(inrot,6);
*inrot = 0;
err = PetscHeaderCreate(rot,_p_dFSRotation,struct _dFSRotationOps,dFSROT_CLASSID,"dFSRotation","Local function space rotation","FS",PETSC_COMM_SELF,dFSRotationDestroy,dFSRotationView);dCHK(err);
err = dFSGetBlockSize(fs,&bs);dCHK(err);
rot->bs = bs;
err = ISGetSize(is,&n);dCHK(err);
rot->n = n;
err = PetscObjectReference((PetscObject)is);dCHK(err);
rot->is = is;
err = PetscObjectReference((PetscObject)v);dCHK(err);
rot->strong = v;
for (dInt i=0; i<n; i++) {
if (ns[i] < 0 || bs < ns[i]) dERROR(PETSC_COMM_SELF,1,"Number of strong dofs must be between 0 and bs=%d (inclusive)",bs);
/* \todo Check that every rmat is orthogonal */
}
err = dMallocA2(n*bs*bs,&rot->rmat,n,&rot->nstrong);dCHK(err);
err = dMemcpy(rot->rmat,rmat,n*bs*bs*sizeof rmat[0]);dCHK(err);
err = dMemcpy(rot->nstrong,ns,n*sizeof ns[0]);dCHK(err);
*inrot = rot;
dFunctionReturn(0);
}
/*@
ISGetNonlocalIS - Gather all nonlocal indices for this IS and present
them as another sequential index set.
Collective on IS
Input Parameter:
. is - the index set
Output Parameter:
. complement - sequential IS with indices identical to the result of
ISGetNonlocalIndices()
Level: intermediate
Notes: complement represents the result of ISGetNonlocalIndices as an IS.
Therefore scalability issues similar to ISGetNonlocalIndices apply.
The resulting IS must be restored using ISRestoreNonlocalIS().
Concepts: index sets^getting nonlocal indices
.seealso: ISGetNonlocalIndices(), ISRestoreNonlocalIndices(), ISAllGather(), ISGetSize()
@*/
PetscErrorCode ISGetNonlocalIS(IS is, IS *complement)
{
PetscErrorCode ierr;
PetscFunctionBegin;
PetscValidHeaderSpecific(is,IS_CLASSID,1);
PetscValidPointer(complement,2);
/* Check if the complement exists already. */
if (is->complement) {
*complement = is->complement;
ierr = PetscObjectReference((PetscObject)(is->complement));
CHKERRQ(ierr);
} else {
PetscInt N, n;
const PetscInt *idx;
ierr = ISGetSize(is, &N);
CHKERRQ(ierr);
ierr = ISGetLocalSize(is,&n);
CHKERRQ(ierr);
ierr = ISGetNonlocalIndices(is, &idx);
CHKERRQ(ierr);
ierr = ISCreateGeneral(PETSC_COMM_SELF, N-n,idx, PETSC_USE_POINTER, &(is->complement));
CHKERRQ(ierr);
ierr = PetscObjectReference((PetscObject)is->complement);
CHKERRQ(ierr);
*complement = is->complement;
}
PetscFunctionReturn(0);
}
/*@C
ISGetNonlocalIndices - Retrieve an array of indices from remote processors
in this communicator.
Collective on IS
Input Parameter:
. is - the index set
Output Parameter:
. indices - indices with rank 0 indices first, and so on, omitting
the current rank. Total number of indices is the difference
total and local, obtained with ISGetSize() and ISGetLocalSize(),
respectively.
Level: intermediate
Notes: restore the indices using ISRestoreNonlocalIndices().
The same scalability considerations as those for ISGetTotalIndices
apply here.
Concepts: index sets^getting nonlocal indices
.seealso: ISGetTotalIndices(), ISRestoreNonlocalIndices(), ISGetSize(), ISGetLocalSize().
@*/
PetscErrorCode ISGetNonlocalIndices(IS is, const PetscInt *indices[])
{
PetscErrorCode ierr;
PetscMPIInt size;
PetscInt n, N;
PetscFunctionBegin;
PetscValidHeaderSpecific(is,IS_CLASSID,1);
PetscValidPointer(indices,2);
ierr = MPI_Comm_size(PetscObjectComm((PetscObject)is), &size);
CHKERRQ(ierr);
if (size == 1) *indices = NULL;
else {
if (!is->total) {
ierr = ISGatherTotal_Private(is);
CHKERRQ(ierr);
}
ierr = ISGetLocalSize(is,&n);
CHKERRQ(ierr);
ierr = ISGetSize(is,&N);
CHKERRQ(ierr);
ierr = PetscMalloc(sizeof(PetscInt)*(N-n), &(is->nonlocal));
CHKERRQ(ierr);
ierr = PetscMemcpy(is->nonlocal, is->total, sizeof(PetscInt)*is->local_offset);
CHKERRQ(ierr);
ierr = PetscMemcpy(is->nonlocal+is->local_offset, is->total+is->local_offset+n, sizeof(PetscInt)*(N - is->local_offset - n));
CHKERRQ(ierr);
*indices = is->nonlocal;
}
PetscFunctionReturn(0);
}
PetscErrorCode ISGetIndicesCopy(IS is, PetscInt idx[])
{
PetscErrorCode ierr;
PetscInt len,i;
const PetscInt *ptr;
PetscFunctionBegin;
ierr = ISGetSize(is,&len);CHKERRQ(ierr);
ierr = ISGetIndices(is,&ptr);CHKERRQ(ierr);
for (i=0; i<len; i++) idx[i] = ptr[i];
ierr = ISRestoreIndices(is,&ptr);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/**
* Constructor, extracts a subvector from 'v' using mapping 'is'
* without copy.
*/
VectorPetsc( VectorPetsc<value_type> &v, IS &is )
:
super(),
M_destroy_vec_on_exit( false )
{
#if (PETSC_VERSION_MAJOR == 3) && (PETSC_VERSION_MINOR >= 2)
/* map */
PetscInt n;
ISGetSize(is,&n);
datamap_ptrtype dm( new datamap_type(n, n, v.comm()) );
this->setMap(dm);
/* init */
VecGetSubVector(v.vec(), is, &this->M_vec);
this->M_is_initialized = true;
/* close */
this->close(); /* no // assembly required */
#endif
}
static PetscErrorCode VecSetUp_NestIS_Private(Vec V,PetscInt nb,IS is[])
{
Vec_Nest *ctx = (Vec_Nest*)V->data;
PetscInt i,offset,m,n,M,N;
PetscErrorCode ierr;
PetscFunctionBegin;
if (is) { /* Do some consistency checks and reference the is */
offset = V->map->rstart;
for (i=0; i<ctx->nb; i++) {
ierr = ISGetSize(is[i],&M);CHKERRQ(ierr);
ierr = VecGetSize(ctx->v[i],&N);CHKERRQ(ierr);
if (M != N) SETERRQ3(PetscObjectComm((PetscObject)V),PETSC_ERR_ARG_INCOMP,"In slot %D, IS of size %D is not compatible with Vec of size %D",i,M,N);
ierr = ISGetLocalSize(is[i],&m);CHKERRQ(ierr);
ierr = VecGetLocalSize(ctx->v[i],&n);CHKERRQ(ierr);
if (m != n) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_INCOMP,"In slot %D, IS of local size %D is not compatible with Vec of local size %D",i,m,n);
#if defined(PETSC_USE_DEBUG)
{ /* This test can be expensive */
PetscInt start;
PetscBool contiguous;
ierr = ISContiguousLocal(is[i],offset,offset+n,&start,&contiguous);CHKERRQ(ierr);
if (!contiguous) SETERRQ1(PetscObjectComm((PetscObject)V),PETSC_ERR_SUP,"Index set %D is not contiguous with layout of matching vector",i);
if (start != 0) SETERRQ1(PetscObjectComm((PetscObject)V),PETSC_ERR_SUP,"Index set %D introduces overlap or a hole",i);
}
#endif
ierr = PetscObjectReference((PetscObject)is[i]);CHKERRQ(ierr);
ctx->is[i] = is[i];
offset += n;
}
} else { /* Create a contiguous ISStride for each entry */
offset = V->map->rstart;
for (i=0; i<ctx->nb; i++) {
PetscInt bs;
ierr = VecGetLocalSize(ctx->v[i],&n);CHKERRQ(ierr);
ierr = VecGetBlockSize(ctx->v[i],&bs);CHKERRQ(ierr);
ierr = ISCreateStride(((PetscObject)ctx->v[i])->comm,n,offset,1,&ctx->is[i]);CHKERRQ(ierr);
ierr = ISSetBlockSize(ctx->is[i],bs);CHKERRQ(ierr);
offset += n;
}
}
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
PetscInt i,n,start,stride;
const PetscInt *ii;
IS is;
PetscBool flg;
PetscErrorCode ierr;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);CHKERRQ(ierr);
/*
Test IS of size 0
*/
ierr = ISCreateStride(PETSC_COMM_SELF,0,0,2,&is);CHKERRQ(ierr);
ierr = ISGetSize(is,&n);CHKERRQ(ierr);
if (n != 0) SETERRQ(PETSC_COMM_SELF,1,"ISCreateStride");
ierr = ISStrideGetInfo(is,&start,&stride);CHKERRQ(ierr);
if (start != 0) SETERRQ(PETSC_COMM_SELF,1,"ISStrideGetInfo");
if (stride != 2) SETERRQ(PETSC_COMM_SELF,1,"ISStrideGetInfo");
ierr = PetscObjectTypeCompare((PetscObject)is,ISSTRIDE,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_COMM_SELF,1,"ISStride");
ierr = ISGetIndices(is,&ii);CHKERRQ(ierr);
ierr = ISRestoreIndices(is,&ii);CHKERRQ(ierr);
ierr = ISDestroy(&is);CHKERRQ(ierr);
/*
Test ISGetIndices()
*/
ierr = ISCreateStride(PETSC_COMM_SELF,10000,-8,3,&is);CHKERRQ(ierr);
ierr = ISGetLocalSize(is,&n);CHKERRQ(ierr);
ierr = ISGetIndices(is,&ii);CHKERRQ(ierr);
for (i=0; i<10000; i++) {
if (ii[i] != -8 + 3*i) SETERRQ(PETSC_COMM_SELF,1,"ISGetIndices");
}
ierr = ISRestoreIndices(is,&ii);CHKERRQ(ierr);
ierr = ISDestroy(&is);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
static PetscErrorCode TaoSolve_GPCG(Tao tao)
{
TAO_GPCG *gpcg = (TAO_GPCG *)tao->data;
PetscErrorCode ierr;
PetscInt its;
PetscReal actred,f,f_new,gnorm,gdx,stepsize,xtb;
PetscReal xtHx;
TaoConvergedReason reason = TAO_CONTINUE_ITERATING;
TaoLineSearchConvergedReason ls_status = TAOLINESEARCH_CONTINUE_ITERATING;
PetscFunctionBegin;
ierr = TaoComputeVariableBounds(tao);CHKERRQ(ierr);
ierr = VecMedian(tao->XL,tao->solution,tao->XU,tao->solution);CHKERRQ(ierr);
ierr = TaoLineSearchSetVariableBounds(tao->linesearch,tao->XL,tao->XU);CHKERRQ(ierr);
/* Using f = .5*x'Hx + x'b + c and g=Hx + b, compute b,c */
ierr = TaoComputeHessian(tao,tao->solution,tao->hessian,tao->hessian_pre);CHKERRQ(ierr);
ierr = TaoComputeObjectiveAndGradient(tao,tao->solution,&f,tao->gradient);CHKERRQ(ierr);
ierr = VecCopy(tao->gradient, gpcg->B);CHKERRQ(ierr);
ierr = MatMult(tao->hessian,tao->solution,gpcg->Work);CHKERRQ(ierr);
ierr = VecDot(gpcg->Work, tao->solution, &xtHx);CHKERRQ(ierr);
ierr = VecAXPY(gpcg->B,-1.0,gpcg->Work);CHKERRQ(ierr);
ierr = VecDot(gpcg->B,tao->solution,&xtb);CHKERRQ(ierr);
gpcg->c=f-xtHx/2.0-xtb;
if (gpcg->Free_Local) {
ierr = ISDestroy(&gpcg->Free_Local);CHKERRQ(ierr);
}
ierr = VecWhichBetween(tao->XL,tao->solution,tao->XU,&gpcg->Free_Local);CHKERRQ(ierr);
/* Project the gradient and calculate the norm */
ierr = VecCopy(tao->gradient,gpcg->G_New);CHKERRQ(ierr);
ierr = VecBoundGradientProjection(tao->gradient,tao->solution,tao->XL,tao->XU,gpcg->PG);CHKERRQ(ierr);
ierr = VecNorm(gpcg->PG,NORM_2,&gpcg->gnorm);CHKERRQ(ierr);
tao->step=1.0;
gpcg->f = f;
/* Check Stopping Condition */
ierr=TaoMonitor(tao,tao->niter,f,gpcg->gnorm,0.0,tao->step,&reason);CHKERRQ(ierr);
while (reason == TAO_CONTINUE_ITERATING){
tao->ksp_its=0;
ierr = GPCGGradProjections(tao);CHKERRQ(ierr);
ierr = ISGetSize(gpcg->Free_Local,&gpcg->n_free);CHKERRQ(ierr);
f=gpcg->f; gnorm=gpcg->gnorm;
ierr = KSPReset(tao->ksp);CHKERRQ(ierr);
if (gpcg->n_free > 0){
/* Create a reduced linear system */
ierr = VecDestroy(&gpcg->R);CHKERRQ(ierr);
ierr = VecDestroy(&gpcg->DXFree);CHKERRQ(ierr);
ierr = TaoVecGetSubVec(tao->gradient,gpcg->Free_Local, tao->subset_type, 0.0, &gpcg->R);CHKERRQ(ierr);
ierr = VecScale(gpcg->R, -1.0);CHKERRQ(ierr);
ierr = TaoVecGetSubVec(tao->stepdirection,gpcg->Free_Local,tao->subset_type, 0.0, &gpcg->DXFree);CHKERRQ(ierr);
ierr = VecSet(gpcg->DXFree,0.0);CHKERRQ(ierr);
ierr = TaoMatGetSubMat(tao->hessian, gpcg->Free_Local, gpcg->Work, tao->subset_type, &gpcg->Hsub);CHKERRQ(ierr);
if (tao->hessian_pre == tao->hessian) {
ierr = MatDestroy(&gpcg->Hsub_pre);CHKERRQ(ierr);
ierr = PetscObjectReference((PetscObject)gpcg->Hsub);CHKERRQ(ierr);
gpcg->Hsub_pre = gpcg->Hsub;
} else {
ierr = TaoMatGetSubMat(tao->hessian, gpcg->Free_Local, gpcg->Work, tao->subset_type, &gpcg->Hsub_pre);CHKERRQ(ierr);
}
ierr = KSPReset(tao->ksp);CHKERRQ(ierr);
ierr = KSPSetOperators(tao->ksp,gpcg->Hsub,gpcg->Hsub_pre);CHKERRQ(ierr);
ierr = KSPSolve(tao->ksp,gpcg->R,gpcg->DXFree);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(tao->ksp,&its);CHKERRQ(ierr);
tao->ksp_its+=its;
tao->ksp_tot_its+=its;
ierr = VecSet(tao->stepdirection,0.0);CHKERRQ(ierr);
ierr = VecISAXPY(tao->stepdirection,gpcg->Free_Local,1.0,gpcg->DXFree);CHKERRQ(ierr);
ierr = VecDot(tao->stepdirection,tao->gradient,&gdx);CHKERRQ(ierr);
ierr = TaoLineSearchSetInitialStepLength(tao->linesearch,1.0);CHKERRQ(ierr);
f_new=f;
ierr = TaoLineSearchApply(tao->linesearch,tao->solution,&f_new,tao->gradient,tao->stepdirection,&stepsize,&ls_status);CHKERRQ(ierr);
actred = f_new - f;
/* Evaluate the function and gradient at the new point */
ierr = VecBoundGradientProjection(tao->gradient,tao->solution,tao->XL,tao->XU, gpcg->PG);CHKERRQ(ierr);
ierr = VecNorm(gpcg->PG, NORM_2, &gnorm);CHKERRQ(ierr);
f=f_new;
ierr = ISDestroy(&gpcg->Free_Local);CHKERRQ(ierr);
ierr = VecWhichBetween(tao->XL,tao->solution,tao->XU,&gpcg->Free_Local);CHKERRQ(ierr);
} else {
actred = 0; gpcg->step=1.0;
/* if there were no free variables, no cg method */
}
tao->niter++;
ierr = TaoMonitor(tao,tao->niter,f,gnorm,0.0,gpcg->step,&reason);CHKERRQ(ierr);
gpcg->f=f;gpcg->gnorm=gnorm; gpcg->actred=actred;
if (reason!=TAO_CONTINUE_ITERATING) break;
} /* END MAIN LOOP */
PetscFunctionReturn(0);
}
PetscErrorCode PCBDDCNullSpaceAssembleCorrection(PC pc, PetscBool isdir, IS local_dofs)
{
PC_BDDC *pcbddc = (PC_BDDC*)pc->data;
PC_IS *pcis = (PC_IS*)pc->data;
Mat_IS* matis = (Mat_IS*)pc->pmat->data;
KSP local_ksp;
PC newpc;
NullSpaceCorrection_ctx shell_ctx;
Mat local_mat,local_pmat,small_mat,inv_small_mat;
Vec work1,work2;
const Vec *nullvecs;
VecScatter scatter_ctx;
IS is_aux;
MatFactorInfo matinfo;
PetscScalar *basis_mat,*Kbasis_mat,*array,*array_mat;
PetscScalar one = 1.0,zero = 0.0, m_one = -1.0;
PetscInt basis_dofs,basis_size,nnsp_size,i,k;
PetscBool nnsp_has_cnst;
PetscErrorCode ierr;
PetscFunctionBegin;
/* Infer the local solver */
ierr = ISGetSize(local_dofs,&basis_dofs);CHKERRQ(ierr);
if (isdir) {
/* Dirichlet solver */
local_ksp = pcbddc->ksp_D;
} else {
/* Neumann solver */
local_ksp = pcbddc->ksp_R;
}
ierr = KSPGetOperators(local_ksp,&local_mat,&local_pmat);CHKERRQ(ierr);
/* Get null space vecs */
ierr = MatNullSpaceGetVecs(pcbddc->NullSpace,&nnsp_has_cnst,&nnsp_size,&nullvecs);CHKERRQ(ierr);
basis_size = nnsp_size;
if (nnsp_has_cnst) {
basis_size++;
}
if (basis_dofs) {
/* Create shell ctx */
ierr = PetscNew(&shell_ctx);CHKERRQ(ierr);
/* Create work vectors in shell context */
ierr = VecCreate(PETSC_COMM_SELF,&shell_ctx->work_small_1);CHKERRQ(ierr);
ierr = VecSetSizes(shell_ctx->work_small_1,basis_size,basis_size);CHKERRQ(ierr);
ierr = VecSetType(shell_ctx->work_small_1,VECSEQ);CHKERRQ(ierr);
ierr = VecDuplicate(shell_ctx->work_small_1,&shell_ctx->work_small_2);CHKERRQ(ierr);
ierr = VecCreate(PETSC_COMM_SELF,&shell_ctx->work_full_1);CHKERRQ(ierr);
ierr = VecSetSizes(shell_ctx->work_full_1,basis_dofs,basis_dofs);CHKERRQ(ierr);
ierr = VecSetType(shell_ctx->work_full_1,VECSEQ);CHKERRQ(ierr);
ierr = VecDuplicate(shell_ctx->work_full_1,&shell_ctx->work_full_2);CHKERRQ(ierr);
/* Allocate workspace */
ierr = MatCreateSeqDense(PETSC_COMM_SELF,basis_dofs,basis_size,NULL,&shell_ctx->basis_mat );CHKERRQ(ierr);
ierr = MatCreateSeqDense(PETSC_COMM_SELF,basis_dofs,basis_size,NULL,&shell_ctx->Kbasis_mat);CHKERRQ(ierr);
ierr = MatDenseGetArray(shell_ctx->basis_mat,&basis_mat);CHKERRQ(ierr);
ierr = MatDenseGetArray(shell_ctx->Kbasis_mat,&Kbasis_mat);CHKERRQ(ierr);
/* Restrict local null space on selected dofs (Dirichlet or Neumann)
and compute matrices N and K*N */
ierr = VecDuplicate(shell_ctx->work_full_1,&work1);CHKERRQ(ierr);
ierr = VecDuplicate(shell_ctx->work_full_1,&work2);CHKERRQ(ierr);
ierr = VecScatterCreate(pcis->vec1_N,local_dofs,work1,(IS)0,&scatter_ctx);CHKERRQ(ierr);
}
for (k=0;k<nnsp_size;k++) {
ierr = VecScatterBegin(matis->rctx,nullvecs[k],pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(matis->rctx,nullvecs[k],pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
if (basis_dofs) {
ierr = VecPlaceArray(work1,(const PetscScalar*)&basis_mat[k*basis_dofs]);CHKERRQ(ierr);
ierr = VecScatterBegin(scatter_ctx,pcis->vec1_N,work1,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(scatter_ctx,pcis->vec1_N,work1,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecPlaceArray(work2,(const PetscScalar*)&Kbasis_mat[k*basis_dofs]);CHKERRQ(ierr);
ierr = MatMult(local_mat,work1,work2);CHKERRQ(ierr);
ierr = VecResetArray(work1);CHKERRQ(ierr);
ierr = VecResetArray(work2);CHKERRQ(ierr);
}
}
if (basis_dofs) {
if (nnsp_has_cnst) {
ierr = VecPlaceArray(work1,(const PetscScalar*)&basis_mat[k*basis_dofs]);CHKERRQ(ierr);
ierr = VecSet(work1,one);CHKERRQ(ierr);
ierr = VecPlaceArray(work2,(const PetscScalar*)&Kbasis_mat[k*basis_dofs]);CHKERRQ(ierr);
ierr = MatMult(local_mat,work1,work2);CHKERRQ(ierr);
ierr = VecResetArray(work1);CHKERRQ(ierr);
ierr = VecResetArray(work2);CHKERRQ(ierr);
}
ierr = VecDestroy(&work1);CHKERRQ(ierr);
ierr = VecDestroy(&work2);CHKERRQ(ierr);
ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(shell_ctx->basis_mat,&basis_mat);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(shell_ctx->Kbasis_mat,&Kbasis_mat);CHKERRQ(ierr);
/* Assemble another Mat object in shell context */
ierr = MatTransposeMatMult(shell_ctx->basis_mat,shell_ctx->Kbasis_mat,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&small_mat);CHKERRQ(ierr);
ierr = MatFactorInfoInitialize(&matinfo);CHKERRQ(ierr);
ierr = ISCreateStride(PETSC_COMM_SELF,basis_size,0,1,&is_aux);CHKERRQ(ierr);
ierr = MatLUFactor(small_mat,is_aux,is_aux,&matinfo);CHKERRQ(ierr);
ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
ierr = PetscMalloc1(basis_size*basis_size,&array_mat);CHKERRQ(ierr);
for (k=0;k<basis_size;k++) {
ierr = VecSet(shell_ctx->work_small_1,zero);CHKERRQ(ierr);
ierr = VecSetValue(shell_ctx->work_small_1,k,one,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecAssemblyBegin(shell_ctx->work_small_1);CHKERRQ(ierr);
ierr = VecAssemblyEnd(shell_ctx->work_small_1);CHKERRQ(ierr);
ierr = MatSolve(small_mat,shell_ctx->work_small_1,shell_ctx->work_small_2);CHKERRQ(ierr);
ierr = VecGetArrayRead(shell_ctx->work_small_2,(const PetscScalar**)&array);CHKERRQ(ierr);
for (i=0;i<basis_size;i++) {
array_mat[i*basis_size+k]=array[i];
}
ierr = VecRestoreArrayRead(shell_ctx->work_small_2,(const PetscScalar**)&array);CHKERRQ(ierr);
}
ierr = MatCreateSeqDense(PETSC_COMM_SELF,basis_size,basis_size,array_mat,&inv_small_mat);CHKERRQ(ierr);
ierr = MatMatMult(shell_ctx->basis_mat,inv_small_mat,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&shell_ctx->Lbasis_mat);CHKERRQ(ierr);
ierr = PetscFree(array_mat);CHKERRQ(ierr);
ierr = MatDestroy(&inv_small_mat);CHKERRQ(ierr);
ierr = MatDestroy(&small_mat);CHKERRQ(ierr);
ierr = MatScale(shell_ctx->Kbasis_mat,m_one);CHKERRQ(ierr);
/* Rebuild local PC */
ierr = KSPGetPC(local_ksp,&shell_ctx->local_pc);CHKERRQ(ierr);
ierr = PetscObjectReference((PetscObject)shell_ctx->local_pc);CHKERRQ(ierr);
ierr = PCCreate(PETSC_COMM_SELF,&newpc);CHKERRQ(ierr);
ierr = PCSetOperators(newpc,local_mat,local_mat);CHKERRQ(ierr);
ierr = PCSetType(newpc,PCSHELL);CHKERRQ(ierr);
ierr = PCShellSetContext(newpc,shell_ctx);CHKERRQ(ierr);
ierr = PCShellSetApply(newpc,PCBDDCApplyNullSpaceCorrectionPC);CHKERRQ(ierr);
ierr = PCShellSetDestroy(newpc,PCBDDCDestroyNullSpaceCorrectionPC);CHKERRQ(ierr);
ierr = PCSetUp(newpc);CHKERRQ(ierr);
ierr = KSPSetPC(local_ksp,newpc);CHKERRQ(ierr);
ierr = PCDestroy(&newpc);CHKERRQ(ierr);
ierr = KSPSetUp(local_ksp);CHKERRQ(ierr);
}
/* test */
if (pcbddc->dbg_flag && basis_dofs) {
KSP check_ksp;
PC check_pc;
Mat test_mat;
Vec work3;
PetscReal test_err,lambda_min,lambda_max;
PetscBool setsym,issym=PETSC_FALSE;
PetscInt tabs;
ierr = PetscViewerASCIIGetTab(pcbddc->dbg_viewer,&tabs);CHKERRQ(ierr);
ierr = KSPGetPC(local_ksp,&check_pc);CHKERRQ(ierr);
ierr = VecDuplicate(shell_ctx->work_full_1,&work1);CHKERRQ(ierr);
ierr = VecDuplicate(shell_ctx->work_full_1,&work2);CHKERRQ(ierr);
ierr = VecDuplicate(shell_ctx->work_full_1,&work3);CHKERRQ(ierr);
ierr = VecSetRandom(shell_ctx->work_small_1,NULL);CHKERRQ(ierr);
ierr = MatMult(shell_ctx->basis_mat,shell_ctx->work_small_1,work1);CHKERRQ(ierr);
ierr = VecCopy(work1,work2);CHKERRQ(ierr);
ierr = MatMult(local_mat,work1,work3);CHKERRQ(ierr);
ierr = PCApply(check_pc,work3,work1);CHKERRQ(ierr);
ierr = VecAXPY(work1,m_one,work2);CHKERRQ(ierr);
ierr = VecNorm(work1,NORM_INFINITY,&test_err);CHKERRQ(ierr);
ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d error for nullspace correction for ",PetscGlobalRank);CHKERRQ(ierr);
ierr = PetscViewerASCIIUseTabs(pcbddc->dbg_viewer,PETSC_FALSE);CHKERRQ(ierr);
if (isdir) {
ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Dirichlet ");CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Neumann ");CHKERRQ(ierr);
}
ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"solver is :%1.14e\n",test_err);CHKERRQ(ierr);
ierr = PetscViewerASCIISetTab(pcbddc->dbg_viewer,tabs);CHKERRQ(ierr);
ierr = PetscViewerASCIIUseTabs(pcbddc->dbg_viewer,PETSC_TRUE);CHKERRQ(ierr);
ierr = MatTransposeMatMult(shell_ctx->Lbasis_mat,shell_ctx->Kbasis_mat,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&test_mat);CHKERRQ(ierr);
ierr = MatShift(test_mat,one);CHKERRQ(ierr);
ierr = MatNorm(test_mat,NORM_INFINITY,&test_err);CHKERRQ(ierr);
ierr = MatDestroy(&test_mat);CHKERRQ(ierr);
ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d error for nullspace matrices is :%1.14e\n",PetscGlobalRank,test_err);CHKERRQ(ierr);
/* Create ksp object suitable for extreme eigenvalues' estimation */
ierr = KSPCreate(PETSC_COMM_SELF,&check_ksp);CHKERRQ(ierr);
ierr = KSPSetErrorIfNotConverged(check_ksp,pc->erroriffailure);CHKERRQ(ierr);
ierr = KSPSetOperators(check_ksp,local_mat,local_mat);CHKERRQ(ierr);
ierr = KSPSetTolerances(check_ksp,1.e-8,1.e-8,PETSC_DEFAULT,basis_dofs);CHKERRQ(ierr);
ierr = KSPSetComputeSingularValues(check_ksp,PETSC_TRUE);CHKERRQ(ierr);
ierr = MatIsSymmetricKnown(pc->pmat,&setsym,&issym);CHKERRQ(ierr);
if (issym) {
ierr = KSPSetType(check_ksp,KSPCG);CHKERRQ(ierr);
}
ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
ierr = VecSetRandom(work1,NULL);CHKERRQ(ierr);
ierr = MatMult(local_mat,work1,work2);CHKERRQ(ierr);
ierr = KSPSolve(check_ksp,work2,work2);CHKERRQ(ierr);
ierr = VecAXPY(work2,m_one,work1);CHKERRQ(ierr);
ierr = VecNorm(work2,NORM_INFINITY,&test_err);CHKERRQ(ierr);
ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max,&lambda_min);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(check_ksp,&k);CHKERRQ(ierr);
ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d error for adapted KSP %1.14e (it %d, eigs %1.6e %1.6e)\n",PetscGlobalRank,test_err,k,lambda_min,lambda_max);CHKERRQ(ierr);
ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
ierr = VecDestroy(&work1);CHKERRQ(ierr);
ierr = VecDestroy(&work2);CHKERRQ(ierr);
ierr = VecDestroy(&work3);CHKERRQ(ierr);
}
/* all processes shoud call this, even the void ones */
if (pcbddc->dbg_flag) {
ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
void PETSC_STDCALL isgetsize_(IS is,PetscInt *size, int *__ierr ){
*__ierr = ISGetSize(
(IS)PetscToPointer((is) ),size);
}
PetscErrorCode PCGAMGProlongator_GEO(PC pc,const Mat Amat,const Mat Gmat,PetscCoarsenData *agg_lists,Mat *a_P_out)
{
PC_MG *mg = (PC_MG*)pc->data;
PC_GAMG *pc_gamg = (PC_GAMG*)mg->innerctx;
const PetscInt verbose = pc_gamg->verbose;
const PetscInt dim = pc_gamg->data_cell_cols, data_cols = pc_gamg->data_cell_cols;
PetscErrorCode ierr;
PetscInt Istart,Iend,nloc,my0,jj,kk,ncols,nLocalSelected,bs,*clid_flid;
Mat Prol;
PetscMPIInt rank, size;
MPI_Comm comm;
IS selected_2,selected_1;
const PetscInt *selected_idx;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)Amat,&comm);CHKERRQ(ierr);
#if defined PETSC_USE_LOG
ierr = PetscLogEventBegin(PC_GAMGProlongator_GEO,0,0,0,0);CHKERRQ(ierr);
#endif
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(Amat, &Istart, &Iend);CHKERRQ(ierr);
ierr = MatGetBlockSize(Amat, &bs);CHKERRQ(ierr);
nloc = (Iend-Istart)/bs; my0 = Istart/bs;
if ((Iend-Istart) % bs) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"(Iend %D - Istart %D) % bs %D",Iend,Istart,bs);
/* get 'nLocalSelected' */
ierr = PetscCDGetMIS(agg_lists, &selected_1);CHKERRQ(ierr);
ierr = ISGetSize(selected_1, &jj);CHKERRQ(ierr);
ierr = PetscMalloc1(jj, &clid_flid);CHKERRQ(ierr);
ierr = ISGetIndices(selected_1, &selected_idx);CHKERRQ(ierr);
for (kk=0,nLocalSelected=0; kk<jj; kk++) {
PetscInt lid = selected_idx[kk];
if (lid<nloc) {
ierr = MatGetRow(Gmat,lid+my0,&ncols,0,0);CHKERRQ(ierr);
if (ncols>1) clid_flid[nLocalSelected++] = lid; /* fiter out singletons */
ierr = MatRestoreRow(Gmat,lid+my0,&ncols,0,0);CHKERRQ(ierr);
}
}
ierr = ISRestoreIndices(selected_1, &selected_idx);CHKERRQ(ierr);
ierr = ISDestroy(&selected_1);CHKERRQ(ierr); /* this is selected_1 in serial */
/* create prolongator, create P matrix */
ierr = MatCreate(comm, &Prol);CHKERRQ(ierr);
ierr = MatSetSizes(Prol,nloc*bs,nLocalSelected*bs,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
ierr = MatSetBlockSizes(Prol, bs, bs);CHKERRQ(ierr);
ierr = MatSetType(Prol, MATAIJ);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(Prol,3*data_cols,NULL);CHKERRQ(ierr);
ierr = MatMPIAIJSetPreallocation(Prol,3*data_cols,NULL,3*data_cols,NULL);CHKERRQ(ierr);
/* ierr = MatCreateAIJ(comm, */
/* nloc*bs, nLocalSelected*bs, */
/* PETSC_DETERMINE, PETSC_DETERMINE, */
/* 3*data_cols, NULL, */
/* 3*data_cols, NULL, */
/* &Prol); */
/* CHKERRQ(ierr); */
/* can get all points "removed" - but not on geomg */
ierr = MatGetSize(Prol, &kk, &jj);CHKERRQ(ierr);
if (jj==0) {
if (verbose) PetscPrintf(comm,"[%d]%s ERROE: no selected points on coarse grid\n",rank,__FUNCT__);
ierr = PetscFree(clid_flid);CHKERRQ(ierr);
ierr = MatDestroy(&Prol);CHKERRQ(ierr);
*a_P_out = NULL; /* out */
PetscFunctionReturn(0);
}
{
PetscReal *coords;
PetscInt data_stride;
PetscInt *crsGID = NULL;
Mat Gmat2;
if (dim != data_cols) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"dim %D != data_cols %D",dim,data_cols);
/* grow ghost data for better coarse grid cover of fine grid */
#if defined PETSC_GAMG_USE_LOG
ierr = PetscLogEventBegin(petsc_gamg_setup_events[SET5],0,0,0,0);CHKERRQ(ierr);
#endif
/* messy method, squares graph and gets some data */
ierr = getGIDsOnSquareGraph(nLocalSelected, clid_flid, Gmat, &selected_2, &Gmat2, &crsGID);CHKERRQ(ierr);
/* llist is now not valid wrt squared graph, but will work as iterator in 'triangulateAndFormProl' */
#if defined PETSC_GAMG_USE_LOG
ierr = PetscLogEventEnd(petsc_gamg_setup_events[SET5],0,0,0,0);CHKERRQ(ierr);
#endif
/* create global vector of coorindates in 'coords' */
if (size > 1) {
ierr = PCGAMGGetDataWithGhosts(Gmat2, dim, pc_gamg->data, &data_stride, &coords);CHKERRQ(ierr);
} else {
coords = (PetscReal*)pc_gamg->data;
data_stride = pc_gamg->data_sz/pc_gamg->data_cell_cols;
}
ierr = MatDestroy(&Gmat2);CHKERRQ(ierr);
/* triangulate */
if (dim == 2) {
PetscReal metric,tm;
#if defined PETSC_GAMG_USE_LOG
ierr = PetscLogEventBegin(petsc_gamg_setup_events[SET6],0,0,0,0);CHKERRQ(ierr);
#endif
ierr = triangulateAndFormProl(selected_2, data_stride, coords,nLocalSelected, clid_flid, agg_lists, crsGID, bs, Prol, &metric);CHKERRQ(ierr);
#if defined PETSC_GAMG_USE_LOG
ierr = PetscLogEventEnd(petsc_gamg_setup_events[SET6],0,0,0,0);CHKERRQ(ierr);
#endif
ierr = PetscFree(crsGID);CHKERRQ(ierr);
/* clean up and create coordinates for coarse grid (output) */
if (size > 1) ierr = PetscFree(coords);CHKERRQ(ierr);
ierr = MPI_Allreduce(&metric, &tm, 1, MPIU_REAL, MPIU_MAX, comm);CHKERRQ(ierr);
if (tm > 1.) { /* needs to be globalized - should not happen */
if (verbose) PetscPrintf(comm,"[%d]%s failed metric for coarse grid %e\n",rank,__FUNCT__,tm);
ierr = MatDestroy(&Prol);CHKERRQ(ierr);
Prol = NULL;
} else if (metric > .0) {
if (verbose) PetscPrintf(comm,"[%d]%s worst metric for coarse grid = %e\n",rank,__FUNCT__,metric);
}
} else SETERRQ(comm,PETSC_ERR_PLIB,"3D not implemented for 'geo' AMG");
{ /* create next coords - output */
PetscReal *crs_crds;
ierr = PetscMalloc1(dim*nLocalSelected, &crs_crds);CHKERRQ(ierr);
for (kk=0; kk<nLocalSelected; kk++) { /* grab local select nodes to promote - output */
PetscInt lid = clid_flid[kk];
for (jj=0; jj<dim; jj++) crs_crds[jj*nLocalSelected + kk] = pc_gamg->data[jj*nloc + lid];
}
ierr = PetscFree(pc_gamg->data);CHKERRQ(ierr);
pc_gamg->data = crs_crds; /* out */
pc_gamg->data_sz = dim*nLocalSelected;
}
ierr = ISDestroy(&selected_2);CHKERRQ(ierr);
}
*a_P_out = Prol; /* out */
ierr = PetscFree(clid_flid);CHKERRQ(ierr);
#if defined PETSC_USE_LOG
ierr = PetscLogEventEnd(PC_GAMGProlongator_GEO,0,0,0,0);CHKERRQ(ierr);
#endif
PetscFunctionReturn(0);
}
static PetscErrorCode triangulateAndFormProl(IS selected_2, /* list of selected local ID, includes selected ghosts */
const PetscInt data_stride,
const PetscReal coords[], /* column vector of local coordinates w/ ghosts */
const PetscInt nselected_1, /* list of selected local ID, includes selected ghosts */
const PetscInt clid_lid_1[],
const PetscCoarsenData *agg_lists_1, /* selected_1 vertices of aggregate unselected vertices */
const PetscInt crsGID[],
const PetscInt bs,
Mat a_Prol, /* prolongation operator (output) */
PetscReal *a_worst_best) /* measure of worst missed fine vertex, 0 is no misses */
{
#if defined(PETSC_HAVE_TRIANGLE)
PetscErrorCode ierr;
PetscInt jj,tid,tt,idx,nselected_2;
struct triangulateio in,mid;
const PetscInt *selected_idx_2;
PetscMPIInt rank,size;
PetscInt Istart,Iend,nFineLoc,myFine0;
int kk,nPlotPts,sid;
MPI_Comm comm;
PetscReal tm;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)a_Prol,&comm);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = ISGetSize(selected_2, &nselected_2);CHKERRQ(ierr);
if (nselected_2 == 1 || nselected_2 == 2) { /* 0 happens on idle processors */
*a_worst_best = 100.0; /* this will cause a stop, but not globalized (should not happen) */
} else *a_worst_best = 0.0;
ierr = MPI_Allreduce(a_worst_best, &tm, 1, MPIU_REAL, MPIU_MAX, comm);CHKERRQ(ierr);
if (tm > 0.0) {
*a_worst_best = 100.0;
PetscFunctionReturn(0);
}
ierr = MatGetOwnershipRange(a_Prol, &Istart, &Iend);CHKERRQ(ierr);
nFineLoc = (Iend-Istart)/bs; myFine0 = Istart/bs;
nPlotPts = nFineLoc; /* locals */
/* traingle */
/* Define input points - in*/
in.numberofpoints = nselected_2;
in.numberofpointattributes = 0;
/* get nselected points */
ierr = PetscMalloc1(2*(nselected_2), &in.pointlist);CHKERRQ(ierr);
ierr = ISGetIndices(selected_2, &selected_idx_2);CHKERRQ(ierr);
for (kk=0,sid=0; kk<nselected_2; kk++,sid += 2) {
PetscInt lid = selected_idx_2[kk];
in.pointlist[sid] = coords[lid];
in.pointlist[sid+1] = coords[data_stride + lid];
if (lid>=nFineLoc) nPlotPts++;
}
if (sid != 2*nselected_2) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"sid %D != 2*nselected_2 %D",sid,nselected_2);
in.numberofsegments = 0;
in.numberofedges = 0;
in.numberofholes = 0;
in.numberofregions = 0;
in.trianglelist = 0;
in.segmentmarkerlist = 0;
in.pointattributelist = 0;
in.pointmarkerlist = 0;
in.triangleattributelist = 0;
in.trianglearealist = 0;
in.segmentlist = 0;
in.holelist = 0;
in.regionlist = 0;
in.edgelist = 0;
in.edgemarkerlist = 0;
in.normlist = 0;
/* triangulate */
mid.pointlist = 0; /* Not needed if -N switch used. */
/* Not needed if -N switch used or number of point attributes is zero: */
mid.pointattributelist = 0;
mid.pointmarkerlist = 0; /* Not needed if -N or -B switch used. */
mid.trianglelist = 0; /* Not needed if -E switch used. */
/* Not needed if -E switch used or number of triangle attributes is zero: */
mid.triangleattributelist = 0;
mid.neighborlist = 0; /* Needed only if -n switch used. */
/* Needed only if segments are output (-p or -c) and -P not used: */
mid.segmentlist = 0;
/* Needed only if segments are output (-p or -c) and -P and -B not used: */
mid.segmentmarkerlist = 0;
mid.edgelist = 0; /* Needed only if -e switch used. */
mid.edgemarkerlist = 0; /* Needed if -e used and -B not used. */
mid.numberoftriangles = 0;
/* Triangulate the points. Switches are chosen to read and write a */
/* PSLG (p), preserve the convex hull (c), number everything from */
/* zero (z), assign a regional attribute to each element (A), and */
/* produce an edge list (e), a Voronoi diagram (v), and a triangle */
/* neighbor list (n). */
if (nselected_2 != 0) { /* inactive processor */
char args[] = "npczQ"; /* c is needed ? */
triangulate(args, &in, &mid, (struct triangulateio*) NULL);
/* output .poly files for 'showme' */
if (!PETSC_TRUE) {
static int level = 1;
FILE *file; char fname[32];
sprintf(fname,"C%d_%d.poly",level,rank); file = fopen(fname, "w");
/*First line: <# of vertices> <dimension (must be 2)> <# of attributes> <# of boundary markers (0 or 1)>*/
fprintf(file, "%d %d %d %d\n",in.numberofpoints,2,0,0);
/*Following lines: <vertex #> <x> <y> */
for (kk=0,sid=0; kk<in.numberofpoints; kk++,sid += 2) {
fprintf(file, "%d %e %e\n",kk,in.pointlist[sid],in.pointlist[sid+1]);
}
/*One line: <# of segments> <# of boundary markers (0 or 1)> */
fprintf(file, "%d %d\n",0,0);
/*Following lines: <segment #> <endpoint> <endpoint> [boundary marker] */
/* One line: <# of holes> */
fprintf(file, "%d\n",0);
/* Following lines: <hole #> <x> <y> */
/* Optional line: <# of regional attributes and/or area constraints> */
/* Optional following lines: <region #> <x> <y> <attribute> <maximum area> */
fclose(file);
/* elems */
sprintf(fname,"C%d_%d.ele",level,rank); file = fopen(fname, "w");
/* First line: <# of triangles> <nodes per triangle> <# of attributes> */
fprintf(file, "%d %d %d\n",mid.numberoftriangles,3,0);
/* Remaining lines: <triangle #> <node> <node> <node> ... [attributes] */
for (kk=0,sid=0; kk<mid.numberoftriangles; kk++,sid += 3) {
fprintf(file, "%d %d %d %d\n",kk,mid.trianglelist[sid],mid.trianglelist[sid+1],mid.trianglelist[sid+2]);
}
fclose(file);
sprintf(fname,"C%d_%d.node",level,rank); file = fopen(fname, "w");
/* First line: <# of vertices> <dimension (must be 2)> <# of attributes> <# of boundary markers (0 or 1)> */
/* fprintf(file, "%d %d %d %d\n",in.numberofpoints,2,0,0); */
fprintf(file, "%d %d %d %d\n",nPlotPts,2,0,0);
/*Following lines: <vertex #> <x> <y> */
for (kk=0,sid=0; kk<in.numberofpoints; kk++,sid+=2) {
fprintf(file, "%d %e %e\n",kk,in.pointlist[sid],in.pointlist[sid+1]);
}
sid /= 2;
for (jj=0; jj<nFineLoc; jj++) {
PetscBool sel = PETSC_TRUE;
for (kk=0; kk<nselected_2 && sel; kk++) {
PetscInt lid = selected_idx_2[kk];
if (lid == jj) sel = PETSC_FALSE;
}
if (sel) fprintf(file, "%d %e %e\n",sid++,coords[jj],coords[data_stride + jj]);
}
fclose(file);
if (sid != nPlotPts) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"sid %D != nPlotPts %D",sid,nPlotPts);
level++;
}
}
#if defined PETSC_GAMG_USE_LOG
ierr = PetscLogEventBegin(petsc_gamg_setup_events[FIND_V],0,0,0,0);CHKERRQ(ierr);
#endif
{ /* form P - setup some maps */
PetscInt clid,mm,*nTri,*node_tri;
ierr = PetscMalloc1(nselected_2, &node_tri);CHKERRQ(ierr);
ierr = PetscMalloc1(nselected_2, &nTri);CHKERRQ(ierr);
/* need list of triangles on node */
for (kk=0; kk<nselected_2; kk++) nTri[kk] = 0;
for (tid=0,kk=0; tid<mid.numberoftriangles; tid++) {
for (jj=0; jj<3; jj++) {
PetscInt cid = mid.trianglelist[kk++];
if (nTri[cid] == 0) node_tri[cid] = tid;
nTri[cid]++;
}
}
#define EPS 1.e-12
/* find points and set prolongation */
for (mm = clid = 0; mm < nFineLoc; mm++) {
PetscBool ise;
ierr = PetscCDEmptyAt(agg_lists_1,mm,&ise);CHKERRQ(ierr);
if (!ise) {
const PetscInt lid = mm;
/* for (clid_iterator=0;clid_iterator<nselected_1;clid_iterator++) { */
PetscScalar AA[3][3];
PetscBLASInt N=3,NRHS=1,LDA=3,IPIV[3],LDB=3,INFO;
PetscCDPos pos;
ierr = PetscCDGetHeadPos(agg_lists_1,lid,&pos);CHKERRQ(ierr);
while (pos) {
PetscInt flid;
ierr = PetscLLNGetID(pos, &flid);CHKERRQ(ierr);
ierr = PetscCDGetNextPos(agg_lists_1,lid,&pos);CHKERRQ(ierr);
if (flid < nFineLoc) { /* could be a ghost */
PetscInt bestTID = -1; PetscReal best_alpha = 1.e10;
const PetscInt fgid = flid + myFine0;
/* compute shape function for gid */
const PetscReal fcoord[3] = {coords[flid],coords[data_stride+flid],1.0};
PetscBool haveit =PETSC_FALSE; PetscScalar alpha[3]; PetscInt clids[3];
/* look for it */
for (tid = node_tri[clid], jj=0;
jj < 5 && !haveit && tid != -1;
jj++) {
for (tt=0; tt<3; tt++) {
PetscInt cid2 = mid.trianglelist[3*tid + tt];
PetscInt lid2 = selected_idx_2[cid2];
AA[tt][0] = coords[lid2]; AA[tt][1] = coords[data_stride + lid2]; AA[tt][2] = 1.0;
clids[tt] = cid2; /* store for interp */
}
for (tt=0; tt<3; tt++) alpha[tt] = (PetscScalar)fcoord[tt];
/* SUBROUTINE DGESV(N, NRHS, A, LDA, IPIV, B, LDB, INFO) */
PetscStackCallBLAS("LAPACKgesv",LAPACKgesv_(&N, &NRHS, (PetscScalar*)AA, &LDA, IPIV, alpha, &LDB, &INFO));
{
PetscBool have=PETSC_TRUE; PetscReal lowest=1.e10;
for (tt = 0, idx = 0; tt < 3; tt++) {
if (PetscRealPart(alpha[tt]) > (1.0+EPS) || PetscRealPart(alpha[tt]) < -EPS) have = PETSC_FALSE;
if (PetscRealPart(alpha[tt]) < lowest) {
lowest = PetscRealPart(alpha[tt]);
idx = tt;
}
}
haveit = have;
}
tid = mid.neighborlist[3*tid + idx];
}
if (!haveit) {
/* brute force */
for (tid=0; tid<mid.numberoftriangles && !haveit; tid++) {
for (tt=0; tt<3; tt++) {
PetscInt cid2 = mid.trianglelist[3*tid + tt];
PetscInt lid2 = selected_idx_2[cid2];
AA[tt][0] = coords[lid2]; AA[tt][1] = coords[data_stride + lid2]; AA[tt][2] = 1.0;
clids[tt] = cid2; /* store for interp */
}
for (tt=0; tt<3; tt++) alpha[tt] = fcoord[tt];
/* SUBROUTINE DGESV(N, NRHS, A, LDA, IPIV, B, LDB, INFO) */
PetscStackCallBLAS("LAPACKgesv",LAPACKgesv_(&N, &NRHS, (PetscScalar*)AA, &LDA, IPIV, alpha, &LDB, &INFO));
{
PetscBool have=PETSC_TRUE; PetscReal worst=0.0, v;
for (tt=0; tt<3 && have; tt++) {
if (PetscRealPart(alpha[tt]) > 1.0+EPS || PetscRealPart(alpha[tt]) < -EPS) have=PETSC_FALSE;
if ((v=PetscAbs(PetscRealPart(alpha[tt])-0.5)) > worst) worst = v;
}
if (worst < best_alpha) {
best_alpha = worst; bestTID = tid;
}
haveit = have;
}
}
}
if (!haveit) {
if (best_alpha > *a_worst_best) *a_worst_best = best_alpha;
/* use best one */
for (tt=0; tt<3; tt++) {
PetscInt cid2 = mid.trianglelist[3*bestTID + tt];
PetscInt lid2 = selected_idx_2[cid2];
AA[tt][0] = coords[lid2]; AA[tt][1] = coords[data_stride + lid2]; AA[tt][2] = 1.0;
clids[tt] = cid2; /* store for interp */
}
for (tt=0; tt<3; tt++) alpha[tt] = fcoord[tt];
/* SUBROUTINE DGESV(N, NRHS, A, LDA, IPIV, B, LDB, INFO) */
PetscStackCallBLAS("LAPACKgesv",LAPACKgesv_(&N, &NRHS, (PetscScalar*)AA, &LDA, IPIV, alpha, &LDB, &INFO));
}
/* put in row of P */
for (idx=0; idx<3; idx++) {
PetscScalar shp = alpha[idx];
if (PetscAbs(PetscRealPart(shp)) > 1.e-6) {
PetscInt cgid = crsGID[clids[idx]];
PetscInt jj = cgid*bs, ii = fgid*bs; /* need to gloalize */
for (tt=0; tt < bs; tt++, ii++, jj++) {
ierr = MatSetValues(a_Prol,1,&ii,1,&jj,&shp,INSERT_VALUES);CHKERRQ(ierr);
}
}
}
}
} /* aggregates iterations */
clid++;
} /* a coarse agg */
} /* for all fine nodes */
ierr = ISRestoreIndices(selected_2, &selected_idx_2);CHKERRQ(ierr);
ierr = MatAssemblyBegin(a_Prol,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(a_Prol,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = PetscFree(node_tri);CHKERRQ(ierr);
ierr = PetscFree(nTri);CHKERRQ(ierr);
}
#if defined PETSC_GAMG_USE_LOG
ierr = PetscLogEventEnd(petsc_gamg_setup_events[FIND_V],0,0,0,0);CHKERRQ(ierr);
#endif
free(mid.trianglelist);
free(mid.neighborlist);
ierr = PetscFree(in.pointlist);CHKERRQ(ierr);
PetscFunctionReturn(0);
#else
SETERRQ(PetscObjectComm((PetscObject)a_Prol),PETSC_ERR_PLIB,"configure with TRIANGLE to use geometric MG");
#endif
}
static PetscErrorCode TaoSolve_ASILS(Tao tao)
{
TAO_SSLS *asls = (TAO_SSLS *)tao->data;
PetscReal psi,ndpsi, normd, innerd, t=0;
PetscInt iter=0, nf;
PetscErrorCode ierr;
TaoConvergedReason reason;
TaoLineSearchConvergedReason ls_reason;
PetscFunctionBegin;
/* Assume that Setup has been called!
Set the structure for the Jacobian and create a linear solver. */
ierr = TaoComputeVariableBounds(tao);CHKERRQ(ierr);
ierr = TaoLineSearchSetObjectiveAndGradientRoutine(tao->linesearch,Tao_ASLS_FunctionGradient,tao);CHKERRQ(ierr);
ierr = TaoLineSearchSetObjectiveRoutine(tao->linesearch,Tao_SSLS_Function,tao);CHKERRQ(ierr);
/* Calculate the function value and fischer function value at the
current iterate */
ierr = TaoLineSearchComputeObjectiveAndGradient(tao->linesearch,tao->solution,&psi,asls->dpsi);CHKERRQ(ierr);
ierr = VecNorm(asls->dpsi,NORM_2,&ndpsi);CHKERRQ(ierr);
while (1) {
/* Check the termination criteria */
ierr = PetscInfo3(tao,"iter %D, merit: %g, ||dpsi||: %g\n",iter, (double)asls->merit, (double)ndpsi);CHKERRQ(ierr);
ierr = TaoMonitor(tao, iter++, asls->merit, ndpsi, 0.0, t, &reason);CHKERRQ(ierr);
if (TAO_CONTINUE_ITERATING != reason) break;
/* We are going to solve a linear system of equations. We need to
set the tolerances for the solve so that we maintain an asymptotic
rate of convergence that is superlinear.
Note: these tolerances are for the reduced system. We really need
to make sure that the full system satisfies the full-space conditions.
This rule gives superlinear asymptotic convergence
asls->atol = min(0.5, asls->merit*sqrt(asls->merit));
asls->rtol = 0.0;
This rule gives quadratic asymptotic convergence
asls->atol = min(0.5, asls->merit*asls->merit);
asls->rtol = 0.0;
Calculate a free and fixed set of variables. The fixed set of
variables are those for the d_b is approximately equal to zero.
The definition of approximately changes as we approach the solution
to the problem.
No one rule is guaranteed to work in all cases. The following
definition is based on the norm of the Jacobian matrix. If the
norm is large, the tolerance becomes smaller. */
ierr = MatNorm(tao->jacobian,NORM_1,&asls->identifier);CHKERRQ(ierr);
asls->identifier = PetscMin(asls->merit, 1e-2) / (1 + asls->identifier);
ierr = VecSet(asls->t1,-asls->identifier);CHKERRQ(ierr);
ierr = VecSet(asls->t2, asls->identifier);CHKERRQ(ierr);
ierr = ISDestroy(&asls->fixed);CHKERRQ(ierr);
ierr = ISDestroy(&asls->free);CHKERRQ(ierr);
ierr = VecWhichBetweenOrEqual(asls->t1, asls->db, asls->t2, &asls->fixed);CHKERRQ(ierr);
ierr = ISComplementVec(asls->fixed,asls->t1, &asls->free);CHKERRQ(ierr);
ierr = ISGetSize(asls->fixed,&nf);CHKERRQ(ierr);
ierr = PetscInfo1(tao,"Number of fixed variables: %D\n", nf);CHKERRQ(ierr);
/* We now have our partition. Now calculate the direction in the
fixed variable space. */
ierr = TaoVecGetSubVec(asls->ff, asls->fixed, tao->subset_type, 0.0, &asls->r1);
ierr = TaoVecGetSubVec(asls->da, asls->fixed, tao->subset_type, 1.0, &asls->r2);
ierr = VecPointwiseDivide(asls->r1,asls->r1,asls->r2);CHKERRQ(ierr);
ierr = VecSet(tao->stepdirection,0.0);CHKERRQ(ierr);
ierr = VecISAXPY(tao->stepdirection, asls->fixed,1.0,asls->r1);CHKERRQ(ierr);
/* Our direction in the Fixed Variable Set is fixed. Calculate the
information needed for the step in the Free Variable Set. To
do this, we need to know the diagonal perturbation and the
right hand side. */
ierr = TaoVecGetSubVec(asls->da, asls->free, tao->subset_type, 0.0, &asls->r1);CHKERRQ(ierr);
ierr = TaoVecGetSubVec(asls->ff, asls->free, tao->subset_type, 0.0, &asls->r2);CHKERRQ(ierr);
ierr = TaoVecGetSubVec(asls->db, asls->free, tao->subset_type, 1.0, &asls->r3);CHKERRQ(ierr);
ierr = VecPointwiseDivide(asls->r1,asls->r1, asls->r3);CHKERRQ(ierr);
ierr = VecPointwiseDivide(asls->r2,asls->r2, asls->r3);CHKERRQ(ierr);
/* r1 is the diagonal perturbation
r2 is the right hand side
r3 is no longer needed
Now need to modify r2 for our direction choice in the fixed
variable set: calculate t1 = J*d, take the reduced vector
of t1 and modify r2. */
ierr = MatMult(tao->jacobian, tao->stepdirection, asls->t1);CHKERRQ(ierr);
ierr = TaoVecGetSubVec(asls->t1,asls->free,tao->subset_type,0.0,&asls->r3);CHKERRQ(ierr);
ierr = VecAXPY(asls->r2, -1.0, asls->r3);CHKERRQ(ierr);
/* Calculate the reduced problem matrix and the direction */
if (!asls->w && (tao->subset_type == TAO_SUBSET_MASK || tao->subset_type == TAO_SUBSET_MATRIXFREE)) {
ierr = VecDuplicate(tao->solution, &asls->w);CHKERRQ(ierr);
}
ierr = TaoMatGetSubMat(tao->jacobian, asls->free, asls->w, tao->subset_type,&asls->J_sub);CHKERRQ(ierr);
if (tao->jacobian != tao->jacobian_pre) {
ierr = TaoMatGetSubMat(tao->jacobian_pre, asls->free, asls->w, tao->subset_type, &asls->Jpre_sub);CHKERRQ(ierr);
} else {
ierr = MatDestroy(&asls->Jpre_sub);CHKERRQ(ierr);
asls->Jpre_sub = asls->J_sub;
ierr = PetscObjectReference((PetscObject)(asls->Jpre_sub));CHKERRQ(ierr);
}
ierr = MatDiagonalSet(asls->J_sub, asls->r1,ADD_VALUES);CHKERRQ(ierr);
ierr = TaoVecGetSubVec(tao->stepdirection, asls->free, tao->subset_type, 0.0, &asls->dxfree);CHKERRQ(ierr);
ierr = VecSet(asls->dxfree, 0.0);CHKERRQ(ierr);
/* Calculate the reduced direction. (Really negative of Newton
direction. Therefore, rest of the code uses -d.) */
ierr = KSPReset(tao->ksp);
ierr = KSPSetOperators(tao->ksp, asls->J_sub, asls->Jpre_sub);CHKERRQ(ierr);
ierr = KSPSolve(tao->ksp, asls->r2, asls->dxfree);CHKERRQ(ierr);
/* Add the direction in the free variables back into the real direction. */
ierr = VecISAXPY(tao->stepdirection, asls->free, 1.0,asls->dxfree);CHKERRQ(ierr);
/* Check the real direction for descent and if not, use the negative
gradient direction. */
ierr = VecNorm(tao->stepdirection, NORM_2, &normd);CHKERRQ(ierr);
ierr = VecDot(tao->stepdirection, asls->dpsi, &innerd);CHKERRQ(ierr);
if (innerd <= asls->delta*pow(normd, asls->rho)) {
ierr = PetscInfo1(tao,"Gradient direction: %5.4e.\n", (double)innerd);CHKERRQ(ierr);
ierr = PetscInfo1(tao, "Iteration %D: newton direction not descent\n", iter);CHKERRQ(ierr);
ierr = VecCopy(asls->dpsi, tao->stepdirection);CHKERRQ(ierr);
ierr = VecDot(asls->dpsi, tao->stepdirection, &innerd);CHKERRQ(ierr);
}
ierr = VecScale(tao->stepdirection, -1.0);CHKERRQ(ierr);
innerd = -innerd;
/* We now have a correct descent direction. Apply a linesearch to
find the new iterate. */
ierr = TaoLineSearchSetInitialStepLength(tao->linesearch, 1.0);CHKERRQ(ierr);
ierr = TaoLineSearchApply(tao->linesearch, tao->solution, &psi,asls->dpsi, tao->stepdirection, &t, &ls_reason);CHKERRQ(ierr);
ierr = VecNorm(asls->dpsi, NORM_2, &ndpsi);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
PetscMPIInt rank,size;
PetscInt i,n,*indices;
const PetscInt *ii;
IS is,newis;
PetscBool flg;
PetscErrorCode ierr;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
/*
Test IS of size 0
*/
ierr = ISCreateGeneral(PETSC_COMM_SELF,0,&n,PETSC_COPY_VALUES,&is);CHKERRQ(ierr);
ierr = ISGetSize(is,&n);CHKERRQ(ierr);
if (n != 0) SETERRQ(PETSC_COMM_SELF,1,"ISGetSize");
ierr = ISDestroy(&is);CHKERRQ(ierr);
/*
Create large IS and test ISGetIndices()
*/
n = 10000 + rank;
ierr = PetscMalloc1(n,&indices);CHKERRQ(ierr);
for (i=0; i<n; i++) indices[i] = rank + i;
ierr = ISCreateGeneral(PETSC_COMM_SELF,n,indices,PETSC_COPY_VALUES,&is);CHKERRQ(ierr);
ierr = ISGetIndices(is,&ii);CHKERRQ(ierr);
for (i=0; i<n; i++) {
if (ii[i] != indices[i]) SETERRQ(PETSC_COMM_SELF,1,"ISGetIndices");
}
ierr = ISRestoreIndices(is,&ii);CHKERRQ(ierr);
/*
Check identity and permutation
*/
ierr = ISPermutation(is,&flg);CHKERRQ(ierr);
if (flg) SETERRQ(PETSC_COMM_SELF,1,"ISPermutation");
ierr = ISIdentity(is,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_COMM_SELF,1,"ISIdentity");
ierr = ISSetPermutation(is);CHKERRQ(ierr);
ierr = ISSetIdentity(is);CHKERRQ(ierr);
ierr = ISPermutation(is,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_COMM_SELF,1,"ISPermutation");
ierr = ISIdentity(is,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_COMM_SELF,1,"ISIdentity");
/*
Check equality of index sets
*/
ierr = ISEqual(is,is,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_COMM_SELF,1,"ISEqual");
/*
Sorting
*/
ierr = ISSort(is);CHKERRQ(ierr);
ierr = ISSorted(is,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_COMM_SELF,1,"ISSort");
/*
Thinks it is a different type?
*/
ierr = PetscObjectTypeCompare((PetscObject)is,ISSTRIDE,&flg);CHKERRQ(ierr);
if (flg) SETERRQ(PETSC_COMM_SELF,1,"ISStride");
ierr = PetscObjectTypeCompare((PetscObject)is,ISBLOCK,&flg);CHKERRQ(ierr);
if (flg) SETERRQ(PETSC_COMM_SELF,1,"ISBlock");
ierr = ISDestroy(&is);CHKERRQ(ierr);
/*
Inverting permutation
*/
for (i=0; i<n; i++) indices[i] = n - i - 1;
ierr = ISCreateGeneral(PETSC_COMM_SELF,n,indices,PETSC_COPY_VALUES,&is);CHKERRQ(ierr);
ierr = PetscFree(indices);CHKERRQ(ierr);
ierr = ISSetPermutation(is);CHKERRQ(ierr);
ierr = ISInvertPermutation(is,PETSC_DECIDE,&newis);CHKERRQ(ierr);
ierr = ISGetIndices(newis,&ii);CHKERRQ(ierr);
for (i=0; i<n; i++) {
if (ii[i] != n - i - 1) SETERRQ(PETSC_COMM_SELF,1,"ISInvertPermutation");
}
ierr = ISRestoreIndices(newis,&ii);CHKERRQ(ierr);
ierr = ISDestroy(&newis);CHKERRQ(ierr);
ierr = ISDestroy(&is);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
/*@C
TaoVecGetSubVec - Gets a subvector using the IS
Input Parameters:
+ vfull - the full matrix
. is - the index set for the subvector
. reduced_type - the method TAO is using for subsetting (TAO_SUBSET_SUBVEC, TAO_SUBSET_MASK, TAO_SUBSET_MATRIXFREE)
- maskvalue - the value to set the unused vector elements to (for TAO_SUBSET_MASK or TAO_SUBSET_MATRIXFREE)
Output Parameters:
. vreduced - the subvector
Notes:
maskvalue should usually be 0.0, unless a pointwise divide will be used.
@*/
PetscErrorCode TaoVecGetSubVec(Vec vfull, IS is, TaoSubsetType reduced_type, PetscReal maskvalue, Vec *vreduced)
{
PetscErrorCode ierr;
PetscInt nfull,nreduced,nreduced_local,rlow,rhigh,flow,fhigh;
PetscInt i,nlocal;
PetscReal *fv,*rv;
const PetscInt *s;
IS ident;
VecType vtype;
VecScatter scatter;
MPI_Comm comm;
PetscFunctionBegin;
PetscValidHeaderSpecific(vfull,VEC_CLASSID,1);
PetscValidHeaderSpecific(is,IS_CLASSID,2);
ierr = VecGetSize(vfull, &nfull);CHKERRQ(ierr);
ierr = ISGetSize(is, &nreduced);CHKERRQ(ierr);
if (nreduced == nfull) {
ierr = VecDestroy(vreduced);CHKERRQ(ierr);
ierr = VecDuplicate(vfull,vreduced);CHKERRQ(ierr);
ierr = VecCopy(vfull,*vreduced);CHKERRQ(ierr);
} else {
switch (reduced_type) {
case TAO_SUBSET_SUBVEC:
ierr = VecGetType(vfull,&vtype);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(vfull,&flow,&fhigh);CHKERRQ(ierr);
ierr = ISGetLocalSize(is,&nreduced_local);CHKERRQ(ierr);
ierr = PetscObjectGetComm((PetscObject)vfull,&comm);CHKERRQ(ierr);
if (*vreduced) {
ierr = VecDestroy(vreduced);CHKERRQ(ierr);
}
ierr = VecCreate(comm,vreduced);CHKERRQ(ierr);
ierr = VecSetType(*vreduced,vtype);CHKERRQ(ierr);
ierr = VecSetSizes(*vreduced,nreduced_local,nreduced);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(*vreduced,&rlow,&rhigh);CHKERRQ(ierr);
ierr = ISCreateStride(comm,nreduced_local,rlow,1,&ident);CHKERRQ(ierr);
ierr = VecScatterCreate(vfull,is,*vreduced,ident,&scatter);CHKERRQ(ierr);
ierr = VecScatterBegin(scatter,vfull,*vreduced,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(scatter,vfull,*vreduced,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterDestroy(&scatter);CHKERRQ(ierr);
ierr = ISDestroy(&ident);CHKERRQ(ierr);
break;
case TAO_SUBSET_MASK:
case TAO_SUBSET_MATRIXFREE:
/* vr[i] = vf[i] if i in is
vr[i] = 0 otherwise */
if (!*vreduced) {
ierr = VecDuplicate(vfull,vreduced);CHKERRQ(ierr);
}
ierr = VecSet(*vreduced,maskvalue);CHKERRQ(ierr);
ierr = ISGetLocalSize(is,&nlocal);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(vfull,&flow,&fhigh);CHKERRQ(ierr);
ierr = VecGetArray(vfull,&fv);CHKERRQ(ierr);
ierr = VecGetArray(*vreduced,&rv);CHKERRQ(ierr);
ierr = ISGetIndices(is,&s);CHKERRQ(ierr);
if (nlocal > (fhigh-flow)) SETERRQ2(PETSC_COMM_WORLD,1,"IS local size %d > Vec local size %d",nlocal,fhigh-flow);
for (i=0;i<nlocal;i++) {
rv[s[i]-flow] = fv[s[i]-flow];
}
ierr = ISRestoreIndices(is,&s);CHKERRQ(ierr);
ierr = VecRestoreArray(vfull,&fv);CHKERRQ(ierr);
ierr = VecRestoreArray(*vreduced,&rv);CHKERRQ(ierr);
break;
}
}
PetscFunctionReturn(0);
}
PetscErrorCode SNESSolve_VINEWTONRSLS(SNES snes)
{
SNES_VINEWTONRSLS *vi = (SNES_VINEWTONRSLS*)snes->data;
PetscErrorCode ierr;
PetscInt maxits,i,lits;
PetscBool lssucceed;
MatStructure flg = DIFFERENT_NONZERO_PATTERN;
PetscReal fnorm,gnorm,xnorm=0,ynorm;
Vec Y,X,F;
KSPConvergedReason kspreason;
PetscFunctionBegin;
snes->numFailures = 0;
snes->numLinearSolveFailures = 0;
snes->reason = SNES_CONVERGED_ITERATING;
maxits = snes->max_its; /* maximum number of iterations */
X = snes->vec_sol; /* solution vector */
F = snes->vec_func; /* residual vector */
Y = snes->work[0]; /* work vectors */
ierr = SNESLineSearchSetVIFunctions(snes->linesearch, SNESVIProjectOntoBounds, SNESVIComputeInactiveSetFnorm);CHKERRQ(ierr);
ierr = SNESLineSearchSetVecs(snes->linesearch, X, PETSC_NULL, PETSC_NULL, PETSC_NULL, PETSC_NULL);CHKERRQ(ierr);
ierr = SNESLineSearchSetUp(snes->linesearch);CHKERRQ(ierr);
ierr = PetscObjectTakeAccess(snes);CHKERRQ(ierr);
snes->iter = 0;
snes->norm = 0.0;
ierr = PetscObjectGrantAccess(snes);CHKERRQ(ierr);
ierr = SNESVIProjectOntoBounds(snes,X);CHKERRQ(ierr);
ierr = SNESComputeFunction(snes,X,F);CHKERRQ(ierr);
if (snes->domainerror) {
snes->reason = SNES_DIVERGED_FUNCTION_DOMAIN;
PetscFunctionReturn(0);
}
ierr = SNESVIComputeInactiveSetFnorm(snes,F,X,&fnorm);CHKERRQ(ierr);
ierr = VecNormBegin(X,NORM_2,&xnorm);CHKERRQ(ierr); /* xnorm <- ||x|| */
ierr = VecNormEnd(X,NORM_2,&xnorm);CHKERRQ(ierr);
if (PetscIsInfOrNanReal(fnorm)) SETERRQ(((PetscObject)X)->comm,PETSC_ERR_FP,"User provided compute function generated a Not-a-Number");
ierr = PetscObjectTakeAccess(snes);CHKERRQ(ierr);
snes->norm = fnorm;
ierr = PetscObjectGrantAccess(snes);CHKERRQ(ierr);
SNESLogConvHistory(snes,fnorm,0);
ierr = SNESMonitor(snes,0,fnorm);CHKERRQ(ierr);
/* set parameter for default relative tolerance convergence test */
snes->ttol = fnorm*snes->rtol;
/* test convergence */
ierr = (*snes->ops->converged)(snes,0,0.0,0.0,fnorm,&snes->reason,snes->cnvP);CHKERRQ(ierr);
if (snes->reason) PetscFunctionReturn(0);
for (i=0; i<maxits; i++) {
IS IS_act,IS_inact; /* _act -> active set _inact -> inactive set */
IS IS_redact; /* redundant active set */
VecScatter scat_act,scat_inact;
PetscInt nis_act,nis_inact;
Vec Y_act,Y_inact,F_inact;
Mat jac_inact_inact,prejac_inact_inact;
PetscBool isequal;
/* Call general purpose update function */
if (snes->ops->update) {
ierr = (*snes->ops->update)(snes, snes->iter);CHKERRQ(ierr);
}
ierr = SNESComputeJacobian(snes,X,&snes->jacobian,&snes->jacobian_pre,&flg);CHKERRQ(ierr);
/* Create active and inactive index sets */
/*original
ierr = SNESVICreateIndexSets_RS(snes,X,F,&IS_act,&IS_inact);CHKERRQ(ierr);
*/
ierr = SNESVIGetActiveSetIS(snes,X,F,&IS_act);CHKERRQ(ierr);
if (vi->checkredundancy) {
(*vi->checkredundancy)(snes,IS_act,&IS_redact,vi->ctxP);CHKERRQ(ierr);
if (IS_redact){
ierr = ISSort(IS_redact);CHKERRQ(ierr);
ierr = ISComplement(IS_redact,X->map->rstart,X->map->rend,&IS_inact);CHKERRQ(ierr);
ierr = ISDestroy(&IS_redact);CHKERRQ(ierr);
}
else {
ierr = ISComplement(IS_act,X->map->rstart,X->map->rend,&IS_inact);CHKERRQ(ierr);
}
} else {
ierr = ISComplement(IS_act,X->map->rstart,X->map->rend,&IS_inact);CHKERRQ(ierr);
}
/* Create inactive set submatrix */
ierr = MatGetSubMatrix(snes->jacobian,IS_inact,IS_inact,MAT_INITIAL_MATRIX,&jac_inact_inact);CHKERRQ(ierr);
if (0) { /* Dead code (temporary developer hack) */
IS keptrows;
ierr = MatFindNonzeroRows(jac_inact_inact,&keptrows);CHKERRQ(ierr);
if (keptrows) {
PetscInt cnt,*nrows,k;
const PetscInt *krows,*inact;
PetscInt rstart=jac_inact_inact->rmap->rstart;
ierr = MatDestroy(&jac_inact_inact);CHKERRQ(ierr);
ierr = ISDestroy(&IS_act);CHKERRQ(ierr);
ierr = ISGetLocalSize(keptrows,&cnt);CHKERRQ(ierr);
ierr = ISGetIndices(keptrows,&krows);CHKERRQ(ierr);
ierr = ISGetIndices(IS_inact,&inact);CHKERRQ(ierr);
ierr = PetscMalloc(cnt*sizeof(PetscInt),&nrows);CHKERRQ(ierr);
for (k=0; k<cnt; k++) {
nrows[k] = inact[krows[k]-rstart];
}
ierr = ISRestoreIndices(keptrows,&krows);CHKERRQ(ierr);
ierr = ISRestoreIndices(IS_inact,&inact);CHKERRQ(ierr);
ierr = ISDestroy(&keptrows);CHKERRQ(ierr);
ierr = ISDestroy(&IS_inact);CHKERRQ(ierr);
ierr = ISCreateGeneral(((PetscObject)snes)->comm,cnt,nrows,PETSC_OWN_POINTER,&IS_inact);CHKERRQ(ierr);
ierr = ISComplement(IS_inact,F->map->rstart,F->map->rend,&IS_act);CHKERRQ(ierr);
ierr = MatGetSubMatrix(snes->jacobian,IS_inact,IS_inact,MAT_INITIAL_MATRIX,&jac_inact_inact);CHKERRQ(ierr);
}
}
ierr = DMSetVI(snes->dm,IS_inact);CHKERRQ(ierr);
/* remove later */
/*
ierr = VecView(vi->xu,PETSC_VIEWER_BINARY_(((PetscObject)(vi->xu))->comm));CHKERRQ(ierr);
ierr = VecView(vi->xl,PETSC_VIEWER_BINARY_(((PetscObject)(vi->xl))->comm));CHKERRQ(ierr);
ierr = VecView(X,PETSC_VIEWER_BINARY_(((PetscObject)X)->comm));CHKERRQ(ierr);
ierr = VecView(F,PETSC_VIEWER_BINARY_(((PetscObject)F)->comm));CHKERRQ(ierr);
ierr = ISView(IS_inact,PETSC_VIEWER_BINARY_(((PetscObject)IS_inact)->comm));CHKERRQ(ierr);
*/
/* Get sizes of active and inactive sets */
ierr = ISGetLocalSize(IS_act,&nis_act);CHKERRQ(ierr);
ierr = ISGetLocalSize(IS_inact,&nis_inact);CHKERRQ(ierr);
/* Create active and inactive set vectors */
ierr = SNESCreateSubVectors_VINEWTONRSLS(snes,nis_inact,&F_inact);CHKERRQ(ierr);
ierr = SNESCreateSubVectors_VINEWTONRSLS(snes,nis_act,&Y_act);CHKERRQ(ierr);
ierr = SNESCreateSubVectors_VINEWTONRSLS(snes,nis_inact,&Y_inact);CHKERRQ(ierr);
/* Create scatter contexts */
ierr = VecScatterCreate(Y,IS_act,Y_act,PETSC_NULL,&scat_act);CHKERRQ(ierr);
ierr = VecScatterCreate(Y,IS_inact,Y_inact,PETSC_NULL,&scat_inact);CHKERRQ(ierr);
/* Do a vec scatter to active and inactive set vectors */
ierr = VecScatterBegin(scat_inact,F,F_inact,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(scat_inact,F,F_inact,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterBegin(scat_act,Y,Y_act,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(scat_act,Y,Y_act,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterBegin(scat_inact,Y,Y_inact,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(scat_inact,Y,Y_inact,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
/* Active set direction = 0 */
ierr = VecSet(Y_act,0);CHKERRQ(ierr);
if (snes->jacobian != snes->jacobian_pre) {
ierr = MatGetSubMatrix(snes->jacobian_pre,IS_inact,IS_inact,MAT_INITIAL_MATRIX,&prejac_inact_inact);CHKERRQ(ierr);
} else prejac_inact_inact = jac_inact_inact;
ierr = ISEqual(vi->IS_inact_prev,IS_inact,&isequal);CHKERRQ(ierr);
if (!isequal) {
ierr = SNESVIResetPCandKSP(snes,jac_inact_inact,prejac_inact_inact);CHKERRQ(ierr);
flg = DIFFERENT_NONZERO_PATTERN;
}
/* ierr = ISView(IS_inact,0);CHKERRQ(ierr); */
/* ierr = ISView(IS_act,0);CHKERRQ(ierr);*/
/* ierr = MatView(snes->jacobian_pre,0); */
ierr = KSPSetOperators(snes->ksp,jac_inact_inact,prejac_inact_inact,flg);CHKERRQ(ierr);
ierr = KSPSetUp(snes->ksp);CHKERRQ(ierr);
{
PC pc;
PetscBool flg;
ierr = KSPGetPC(snes->ksp,&pc);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)pc,PCFIELDSPLIT,&flg);CHKERRQ(ierr);
if (flg) {
KSP *subksps;
ierr = PCFieldSplitGetSubKSP(pc,PETSC_NULL,&subksps);CHKERRQ(ierr);
ierr = KSPGetPC(subksps[0],&pc);CHKERRQ(ierr);
ierr = PetscFree(subksps);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)pc,PCBJACOBI,&flg);CHKERRQ(ierr);
if (flg) {
PetscInt n,N = 101*101,j,cnts[3] = {0,0,0};
const PetscInt *ii;
ierr = ISGetSize(IS_inact,&n);CHKERRQ(ierr);
ierr = ISGetIndices(IS_inact,&ii);CHKERRQ(ierr);
for (j=0; j<n; j++) {
if (ii[j] < N) cnts[0]++;
else if (ii[j] < 2*N) cnts[1]++;
else if (ii[j] < 3*N) cnts[2]++;
}
ierr = ISRestoreIndices(IS_inact,&ii);CHKERRQ(ierr);
ierr = PCBJacobiSetTotalBlocks(pc,3,cnts);CHKERRQ(ierr);
}
}
}
ierr = SNES_KSPSolve(snes,snes->ksp,F_inact,Y_inact);CHKERRQ(ierr);
ierr = KSPGetConvergedReason(snes->ksp,&kspreason);CHKERRQ(ierr);
if (kspreason < 0) {
if (++snes->numLinearSolveFailures >= snes->maxLinearSolveFailures) {
ierr = PetscInfo2(snes,"iter=%D, number linear solve failures %D greater than current SNES allowed, stopping solve\n",snes->iter,snes->numLinearSolveFailures);CHKERRQ(ierr);
snes->reason = SNES_DIVERGED_LINEAR_SOLVE;
break;
}
}
ierr = VecScatterBegin(scat_act,Y_act,Y,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd(scat_act,Y_act,Y,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterBegin(scat_inact,Y_inact,Y,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd(scat_inact,Y_inact,Y,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecDestroy(&F_inact);CHKERRQ(ierr);
ierr = VecDestroy(&Y_act);CHKERRQ(ierr);
ierr = VecDestroy(&Y_inact);CHKERRQ(ierr);
ierr = VecScatterDestroy(&scat_act);CHKERRQ(ierr);
ierr = VecScatterDestroy(&scat_inact);CHKERRQ(ierr);
ierr = ISDestroy(&IS_act);CHKERRQ(ierr);
if (!isequal) {
ierr = ISDestroy(&vi->IS_inact_prev);CHKERRQ(ierr);
ierr = ISDuplicate(IS_inact,&vi->IS_inact_prev);CHKERRQ(ierr);
}
ierr = ISDestroy(&IS_inact);CHKERRQ(ierr);
ierr = MatDestroy(&jac_inact_inact);CHKERRQ(ierr);
if (snes->jacobian != snes->jacobian_pre) {
ierr = MatDestroy(&prejac_inact_inact);CHKERRQ(ierr);
}
ierr = KSPGetIterationNumber(snes->ksp,&lits);CHKERRQ(ierr);
snes->linear_its += lits;
ierr = PetscInfo2(snes,"iter=%D, linear solve iterations=%D\n",snes->iter,lits);CHKERRQ(ierr);
/*
if (snes->ops->precheck) {
PetscBool changed_y = PETSC_FALSE;
ierr = (*snes->ops->precheck)(snes,X,Y,snes->precheck,&changed_y);CHKERRQ(ierr);
}
if (PetscLogPrintInfo){
ierr = SNESVICheckResidual_Private(snes,snes->jacobian,F,Y,G,W);CHKERRQ(ierr);
}
*/
/* Compute a (scaled) negative update in the line search routine:
Y <- X - lambda*Y
and evaluate G = function(Y) (depends on the line search).
*/
ierr = VecCopy(Y,snes->vec_sol_update);CHKERRQ(ierr);
ynorm = 1; gnorm = fnorm;
ierr = SNESLineSearchApply(snes->linesearch, X, F, &gnorm, Y);CHKERRQ(ierr);
ierr = SNESLineSearchGetNorms(snes->linesearch, &xnorm, &gnorm, &ynorm);CHKERRQ(ierr);
ierr = PetscInfo4(snes,"fnorm=%18.16e, gnorm=%18.16e, ynorm=%18.16e, lssucceed=%d\n",(double)fnorm,(double)gnorm,(double)ynorm,(int)lssucceed);CHKERRQ(ierr);
if (snes->reason == SNES_DIVERGED_FUNCTION_COUNT) break;
if (snes->domainerror) {
snes->reason = SNES_DIVERGED_FUNCTION_DOMAIN;
ierr = DMDestroyVI(snes->dm);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
ierr = SNESLineSearchGetSuccess(snes->linesearch, &lssucceed);CHKERRQ(ierr);
if (!lssucceed) {
if (++snes->numFailures >= snes->maxFailures) {
PetscBool ismin;
snes->reason = SNES_DIVERGED_LINE_SEARCH;
ierr = SNESVICheckLocalMin_Private(snes,snes->jacobian,F,X,gnorm,&ismin);CHKERRQ(ierr);
if (ismin) snes->reason = SNES_DIVERGED_LOCAL_MIN;
break;
}
}
/* Update function and solution vectors */
fnorm = gnorm;
/* Monitor convergence */
ierr = PetscObjectTakeAccess(snes);CHKERRQ(ierr);
snes->iter = i+1;
snes->norm = fnorm;
ierr = PetscObjectGrantAccess(snes);CHKERRQ(ierr);
SNESLogConvHistory(snes,snes->norm,lits);
ierr = SNESMonitor(snes,snes->iter,snes->norm);CHKERRQ(ierr);
/* Test for convergence, xnorm = || X || */
if (snes->ops->converged != SNESSkipConverged) { ierr = VecNorm(X,NORM_2,&xnorm);CHKERRQ(ierr); }
ierr = (*snes->ops->converged)(snes,snes->iter,xnorm,ynorm,fnorm,&snes->reason,snes->cnvP);CHKERRQ(ierr);
if (snes->reason) break;
}
ierr = DMDestroyVI(snes->dm);CHKERRQ(ierr);
if (i == maxits) {
ierr = PetscInfo1(snes,"Maximum number of iterations has been reached: %D\n",maxits);CHKERRQ(ierr);
if (!snes->reason) snes->reason = SNES_DIVERGED_MAX_IT;
}
PetscFunctionReturn(0);
}
static PetscErrorCode IPMInitializeBounds(Tao tao)
{
TAO_IPM *ipmP = (TAO_IPM*)tao->data;
Vec xtmp;
PetscInt xstart,xend;
PetscInt ucstart,ucend; /* user ci */
PetscInt ucestart,uceend; /* user ce */
PetscInt sstart,send;
PetscInt bigsize;
PetscInt i,counter,nloc;
PetscInt *cind,*xind,*ucind,*uceind,*stepind;
VecType vtype;
const PetscInt *xli,*xui;
PetscInt xl_offset,xu_offset;
IS bigxl,bigxu,isuc,isc,isx,sis,is1;
PetscErrorCode ierr;
MPI_Comm comm;
PetscFunctionBegin;
cind=xind=ucind=uceind=stepind=0;
ipmP->mi=0;
ipmP->nxlb=0;
ipmP->nxub=0;
ipmP->nb=0;
ipmP->nslack=0;
ierr = VecDuplicate(tao->solution,&xtmp);CHKERRQ(ierr);
if (!tao->XL && !tao->XU && tao->ops->computebounds) {
ierr = TaoComputeVariableBounds(tao);CHKERRQ(ierr);
}
if (tao->XL) {
ierr = VecSet(xtmp,PETSC_NINFINITY);CHKERRQ(ierr);
ierr = VecWhichGreaterThan(tao->XL,xtmp,&ipmP->isxl);CHKERRQ(ierr);
ierr = ISGetSize(ipmP->isxl,&ipmP->nxlb);CHKERRQ(ierr);
} else {
ipmP->nxlb=0;
}
if (tao->XU) {
ierr = VecSet(xtmp,PETSC_INFINITY);CHKERRQ(ierr);
ierr = VecWhichLessThan(tao->XU,xtmp,&ipmP->isxu);CHKERRQ(ierr);
ierr = ISGetSize(ipmP->isxu,&ipmP->nxub);CHKERRQ(ierr);
} else {
ipmP->nxub=0;
}
ierr = VecDestroy(&xtmp);CHKERRQ(ierr);
if (tao->constraints_inequality) {
ierr = VecGetSize(tao->constraints_inequality,&ipmP->mi);CHKERRQ(ierr);
} else {
ipmP->mi = 0;
}
ipmP->nb = ipmP->nxlb + ipmP->nxub + ipmP->mi;
comm = ((PetscObject)(tao->solution))->comm;
bigsize = ipmP->n+2*ipmP->nb+ipmP->me;
ierr = PetscMalloc1(bigsize,&stepind);CHKERRQ(ierr);
ierr = PetscMalloc1(ipmP->n,&xind);CHKERRQ(ierr);
ierr = PetscMalloc1(ipmP->me,&uceind);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(tao->solution,&xstart,&xend);CHKERRQ(ierr);
if (ipmP->nb > 0) {
ierr = VecCreate(comm,&ipmP->s);CHKERRQ(ierr);
ierr = VecSetSizes(ipmP->s,PETSC_DECIDE,ipmP->nb);CHKERRQ(ierr);
ierr = VecSetFromOptions(ipmP->s);CHKERRQ(ierr);
ierr = VecDuplicate(ipmP->s,&ipmP->ds);CHKERRQ(ierr);
ierr = VecDuplicate(ipmP->s,&ipmP->rhs_s);CHKERRQ(ierr);
ierr = VecDuplicate(ipmP->s,&ipmP->complementarity);CHKERRQ(ierr);
ierr = VecDuplicate(ipmP->s,&ipmP->ci);CHKERRQ(ierr);
ierr = VecDuplicate(ipmP->s,&ipmP->lamdai);CHKERRQ(ierr);
ierr = VecDuplicate(ipmP->s,&ipmP->dlamdai);CHKERRQ(ierr);
ierr = VecDuplicate(ipmP->s,&ipmP->rhs_lamdai);CHKERRQ(ierr);
ierr = VecDuplicate(ipmP->s,&ipmP->save_lamdai);CHKERRQ(ierr);
ierr = VecDuplicate(ipmP->s,&ipmP->save_s);CHKERRQ(ierr);
ierr = VecDuplicate(ipmP->s,&ipmP->rpi);CHKERRQ(ierr);
ierr = VecDuplicate(ipmP->s,&ipmP->Zero_nb);CHKERRQ(ierr);
ierr = VecSet(ipmP->Zero_nb,0.0);CHKERRQ(ierr);
ierr = VecDuplicate(ipmP->s,&ipmP->One_nb);CHKERRQ(ierr);
ierr = VecSet(ipmP->One_nb,1.0);CHKERRQ(ierr);
ierr = VecDuplicate(ipmP->s,&ipmP->Inf_nb);CHKERRQ(ierr);
ierr = VecSet(ipmP->Inf_nb,PETSC_INFINITY);CHKERRQ(ierr);
ierr = PetscMalloc1(ipmP->nb,&cind);CHKERRQ(ierr);
ierr = PetscMalloc1(ipmP->mi,&ucind);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(ipmP->s,&sstart,&send);CHKERRQ(ierr);
if (ipmP->mi > 0) {
ierr = VecGetOwnershipRange(tao->constraints_inequality,&ucstart,&ucend);CHKERRQ(ierr);
counter=0;
for (i=ucstart;i<ucend;i++) {
cind[counter++] = i;
}
ierr = ISCreateGeneral(comm,counter,cind,PETSC_COPY_VALUES,&isuc);CHKERRQ(ierr);
ierr = ISCreateGeneral(comm,counter,cind,PETSC_COPY_VALUES,&isc);CHKERRQ(ierr);
ierr = VecScatterCreate(tao->constraints_inequality,isuc,ipmP->ci,isc,&ipmP->ci_scat);CHKERRQ(ierr);
ierr = ISDestroy(&isuc);CHKERRQ(ierr);
ierr = ISDestroy(&isc);CHKERRQ(ierr);
}
/* need to know how may xbound indices are on each process */
/* TODO better way */
if (ipmP->nxlb) {
ierr = ISAllGather(ipmP->isxl,&bigxl);CHKERRQ(ierr);
ierr = ISGetIndices(bigxl,&xli);CHKERRQ(ierr);
/* find offsets for this processor */
xl_offset = ipmP->mi;
for (i=0;i<ipmP->nxlb;i++) {
if (xli[i] < xstart) {
xl_offset++;
} else break;
}
ierr = ISRestoreIndices(bigxl,&xli);CHKERRQ(ierr);
ierr = ISGetIndices(ipmP->isxl,&xli);CHKERRQ(ierr);
ierr = ISGetLocalSize(ipmP->isxl,&nloc);CHKERRQ(ierr);
for (i=0;i<nloc;i++) {
xind[i] = xli[i];
cind[i] = xl_offset+i;
}
ierr = ISCreateGeneral(comm,nloc,xind,PETSC_COPY_VALUES,&isx);CHKERRQ(ierr);
ierr = ISCreateGeneral(comm,nloc,cind,PETSC_COPY_VALUES,&isc);CHKERRQ(ierr);
ierr = VecScatterCreate(tao->XL,isx,ipmP->ci,isc,&ipmP->xl_scat);CHKERRQ(ierr);
ierr = ISDestroy(&isx);CHKERRQ(ierr);
ierr = ISDestroy(&isc);CHKERRQ(ierr);
ierr = ISDestroy(&bigxl);CHKERRQ(ierr);
}
if (ipmP->nxub) {
ierr = ISAllGather(ipmP->isxu,&bigxu);CHKERRQ(ierr);
ierr = ISGetIndices(bigxu,&xui);CHKERRQ(ierr);
/* find offsets for this processor */
xu_offset = ipmP->mi + ipmP->nxlb;
for (i=0;i<ipmP->nxub;i++) {
if (xui[i] < xstart) {
xu_offset++;
} else break;
}
ierr = ISRestoreIndices(bigxu,&xui);CHKERRQ(ierr);
ierr = ISGetIndices(ipmP->isxu,&xui);CHKERRQ(ierr);
ierr = ISGetLocalSize(ipmP->isxu,&nloc);CHKERRQ(ierr);
for (i=0;i<nloc;i++) {
xind[i] = xui[i];
cind[i] = xu_offset+i;
}
ierr = ISCreateGeneral(comm,nloc,xind,PETSC_COPY_VALUES,&isx);CHKERRQ(ierr);
ierr = ISCreateGeneral(comm,nloc,cind,PETSC_COPY_VALUES,&isc);CHKERRQ(ierr);
ierr = VecScatterCreate(tao->XU,isx,ipmP->ci,isc,&ipmP->xu_scat);CHKERRQ(ierr);
ierr = ISDestroy(&isx);CHKERRQ(ierr);
ierr = ISDestroy(&isc);CHKERRQ(ierr);
ierr = ISDestroy(&bigxu);CHKERRQ(ierr);
}
}
ierr = VecCreate(comm,&ipmP->bigrhs);CHKERRQ(ierr);
ierr = VecGetType(tao->solution,&vtype);CHKERRQ(ierr);
ierr = VecSetType(ipmP->bigrhs,vtype);CHKERRQ(ierr);
ierr = VecSetSizes(ipmP->bigrhs,PETSC_DECIDE,bigsize);CHKERRQ(ierr);
ierr = VecSetFromOptions(ipmP->bigrhs);CHKERRQ(ierr);
ierr = VecDuplicate(ipmP->bigrhs,&ipmP->bigstep);CHKERRQ(ierr);
/* create scatters for step->x and x->rhs */
for (i=xstart;i<xend;i++) {
stepind[i-xstart] = i;
xind[i-xstart] = i;
}
ierr = ISCreateGeneral(comm,xend-xstart,stepind,PETSC_COPY_VALUES,&sis);CHKERRQ(ierr);
ierr = ISCreateGeneral(comm,xend-xstart,xind,PETSC_COPY_VALUES,&is1);CHKERRQ(ierr);
ierr = VecScatterCreate(ipmP->bigstep,sis,tao->solution,is1,&ipmP->step1);CHKERRQ(ierr);
ierr = VecScatterCreate(tao->solution,is1,ipmP->bigrhs,sis,&ipmP->rhs1);CHKERRQ(ierr);
ierr = ISDestroy(&sis);CHKERRQ(ierr);
ierr = ISDestroy(&is1);CHKERRQ(ierr);
if (ipmP->nb > 0) {
for (i=sstart;i<send;i++) {
stepind[i-sstart] = i+ipmP->n;
cind[i-sstart] = i;
}
ierr = ISCreateGeneral(comm,send-sstart,stepind,PETSC_COPY_VALUES,&sis);CHKERRQ(ierr);
ierr = ISCreateGeneral(comm,send-sstart,cind,PETSC_COPY_VALUES,&is1);CHKERRQ(ierr);
ierr = VecScatterCreate(ipmP->bigstep,sis,ipmP->s,is1,&ipmP->step2);CHKERRQ(ierr);
ierr = ISDestroy(&sis);CHKERRQ(ierr);
for (i=sstart;i<send;i++) {
stepind[i-sstart] = i+ipmP->n+ipmP->me;
cind[i-sstart] = i;
}
ierr = ISCreateGeneral(comm,send-sstart,stepind,PETSC_COPY_VALUES,&sis);CHKERRQ(ierr);
ierr = VecScatterCreate(ipmP->s,is1,ipmP->bigrhs,sis,&ipmP->rhs3);CHKERRQ(ierr);
ierr = ISDestroy(&sis);CHKERRQ(ierr);
ierr = ISDestroy(&is1);CHKERRQ(ierr);
}
if (ipmP->me > 0) {
ierr = VecGetOwnershipRange(tao->constraints_equality,&ucestart,&uceend);CHKERRQ(ierr);
for (i=ucestart;i<uceend;i++) {
stepind[i-ucestart] = i + ipmP->n+ipmP->nb;
uceind[i-ucestart] = i;
}
ierr = ISCreateGeneral(comm,uceend-ucestart,stepind,PETSC_COPY_VALUES,&sis);CHKERRQ(ierr);
ierr = ISCreateGeneral(comm,uceend-ucestart,uceind,PETSC_COPY_VALUES,&is1);CHKERRQ(ierr);
ierr = VecScatterCreate(ipmP->bigstep,sis,tao->constraints_equality,is1,&ipmP->step3);CHKERRQ(ierr);
ierr = ISDestroy(&sis);CHKERRQ(ierr);
for (i=ucestart;i<uceend;i++) {
stepind[i-ucestart] = i + ipmP->n;
}
ierr = ISCreateGeneral(comm,uceend-ucestart,stepind,PETSC_COPY_VALUES,&sis);CHKERRQ(ierr);
ierr = VecScatterCreate(tao->constraints_equality,is1,ipmP->bigrhs,sis,&ipmP->rhs2);CHKERRQ(ierr);
ierr = ISDestroy(&sis);CHKERRQ(ierr);
ierr = ISDestroy(&is1);CHKERRQ(ierr);
}
if (ipmP->nb > 0) {
for (i=sstart;i<send;i++) {
stepind[i-sstart] = i + ipmP->n + ipmP->nb + ipmP->me;
cind[i-sstart] = i;
}
ierr = ISCreateGeneral(comm,send-sstart,cind,PETSC_COPY_VALUES,&is1);CHKERRQ(ierr);
ierr = ISCreateGeneral(comm,send-sstart,stepind,PETSC_COPY_VALUES,&sis);CHKERRQ(ierr);
ierr = VecScatterCreate(ipmP->bigstep,sis,ipmP->s,is1,&ipmP->step4);CHKERRQ(ierr);
ierr = VecScatterCreate(ipmP->s,is1,ipmP->bigrhs,sis,&ipmP->rhs4);CHKERRQ(ierr);
ierr = ISDestroy(&sis);CHKERRQ(ierr);
ierr = ISDestroy(&is1);CHKERRQ(ierr);
}
ierr = PetscFree(stepind);CHKERRQ(ierr);
ierr = PetscFree(cind);CHKERRQ(ierr);
ierr = PetscFree(ucind);CHKERRQ(ierr);
ierr = PetscFree(uceind);CHKERRQ(ierr);
ierr = PetscFree(xind);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode private_ISView_Swarm_XDMF(IS is,PetscViewer viewer)
{
long int *bytes = NULL;
PetscContainer container = NULL;
const char *viewername;
char datafile[PETSC_MAX_PATH_LEN];
PetscViewer fviewer;
PetscInt N,bs;
const char *vecname;
char fieldname[PETSC_MAX_PATH_LEN];
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscObjectQuery((PetscObject)viewer,"XDMFViewerContext",(PetscObject*)&container);CHKERRQ(ierr);
if (container) {
ierr = PetscContainerGetPointer(container,(void**)&bytes);CHKERRQ(ierr);
} else SETERRQ(PetscObjectComm((PetscObject)viewer),PETSC_ERR_SUP,"Valid to find attached data XDMFViewerContext");
ierr = PetscViewerFileGetName(viewer,&viewername);CHKERRQ(ierr);
ierr = private_CreateDataFileNameXDMF(viewername,datafile);CHKERRQ(ierr);
/* re-open a sub-viewer for all data fields */
/* name is viewer.name + "_swarm_fields.pbin" */
ierr = PetscViewerCreate(PetscObjectComm((PetscObject)viewer),&fviewer);CHKERRQ(ierr);
ierr = PetscViewerSetType(fviewer,PETSCVIEWERBINARY);CHKERRQ(ierr);
ierr = PetscViewerBinarySetSkipHeader(fviewer,PETSC_TRUE);CHKERRQ(ierr);
ierr = PetscViewerBinarySetSkipInfo(fviewer,PETSC_TRUE);CHKERRQ(ierr);
ierr = PetscViewerFileSetMode(fviewer,FILE_MODE_APPEND);CHKERRQ(ierr);
ierr = PetscViewerFileSetName(fviewer,datafile);CHKERRQ(ierr);
ierr = ISGetSize(is,&N);CHKERRQ(ierr);
ierr = ISGetBlockSize(is,&bs);CHKERRQ(ierr);
N = N/bs;
ierr = PetscObjectGetName((PetscObject)is,&vecname);CHKERRQ(ierr);
if (!vecname) {
ierr = PetscSNPrintf(fieldname,PETSC_MAX_PATH_LEN-1,"swarmfield_%D",((PetscObject)is)->tag);CHKERRQ(ierr);
} else {
ierr = PetscSNPrintf(fieldname,PETSC_MAX_PATH_LEN-1,"%s",vecname);CHKERRQ(ierr);
}
/* write data header */
ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"<Attribute Center=\"Node\" Name=\"%s\" Type=\"None\">\n",fieldname);CHKERRQ(ierr);
ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
if (bs == 1) {
ierr = PetscViewerASCIIPrintf(viewer,"<DataItem Format=\"Binary\" Endian=\"Big\" DataType=\"Int\" Precision=\"4\" Dimensions=\"%D\" Seek=\"%D\">\n",N,bytes[0]);CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIIPrintf(viewer,"<DataItem Format=\"Binary\" Endian=\"Big\" DataType=\"Int\" Precision=\"4\" Dimensions=\"%D %D\" Seek=\"%D\">\n",N,bs,bytes[0]);CHKERRQ(ierr);
}
ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"%s\n",datafile);CHKERRQ(ierr);
ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"</DataItem>\n");CHKERRQ(ierr);
ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"</Attribute>\n");CHKERRQ(ierr);
ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
/* write data */
ierr = ISView(is,fviewer);CHKERRQ(ierr);
bytes[0] += sizeof(PetscInt) * N * bs;
ierr = PetscViewerDestroy(&fviewer);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode TaoSolve_TRON(Tao tao)
{
TAO_TRON *tron = (TAO_TRON *)tao->data;
PetscErrorCode ierr;
PetscInt its;
TaoConvergedReason reason = TAO_CONTINUE_ITERATING;
TaoLineSearchConvergedReason ls_reason = TAOLINESEARCH_CONTINUE_ITERATING;
PetscReal prered,actred,delta,f,f_new,rhok,gdx,xdiff,stepsize;
PetscFunctionBegin;
tron->pgstepsize=1.0;
tao->trust = tao->trust0;
/* Project the current point onto the feasible set */
ierr = TaoComputeVariableBounds(tao);CHKERRQ(ierr);
ierr = VecMedian(tao->XL,tao->solution,tao->XU,tao->solution);CHKERRQ(ierr);
ierr = TaoLineSearchSetVariableBounds(tao->linesearch,tao->XL,tao->XU);CHKERRQ(ierr);
ierr = TaoComputeObjectiveAndGradient(tao,tao->solution,&tron->f,tao->gradient);CHKERRQ(ierr);
ierr = ISDestroy(&tron->Free_Local);CHKERRQ(ierr);
ierr = VecWhichBetween(tao->XL,tao->solution,tao->XU,&tron->Free_Local);CHKERRQ(ierr);
/* Project the gradient and calculate the norm */
ierr = VecBoundGradientProjection(tao->gradient,tao->solution, tao->XL, tao->XU, tao->gradient);CHKERRQ(ierr);
ierr = VecNorm(tao->gradient,NORM_2,&tron->gnorm);CHKERRQ(ierr);
if (PetscIsInfOrNanReal(tron->f) || PetscIsInfOrNanReal(tron->gnorm)) SETERRQ(PETSC_COMM_SELF,1, "User provided compute function generated Inf pr NaN");
if (tao->trust <= 0) {
tao->trust=PetscMax(tron->gnorm*tron->gnorm,1.0);
}
tron->stepsize=tao->trust;
ierr = TaoMonitor(tao, tao->niter, tron->f, tron->gnorm, 0.0, tron->stepsize, &reason);CHKERRQ(ierr);
while (reason==TAO_CONTINUE_ITERATING){
tao->ksp_its=0;
ierr = TronGradientProjections(tao,tron);CHKERRQ(ierr);
f=tron->f; delta=tao->trust;
tron->n_free_last = tron->n_free;
ierr = TaoComputeHessian(tao,tao->solution,tao->hessian,tao->hessian_pre);CHKERRQ(ierr);
ierr = ISGetSize(tron->Free_Local, &tron->n_free);CHKERRQ(ierr);
/* If no free variables */
if (tron->n_free == 0) {
actred=0;
ierr = PetscInfo(tao,"No free variables in tron iteration.\n");CHKERRQ(ierr);
ierr = VecNorm(tao->gradient,NORM_2,&tron->gnorm);CHKERRQ(ierr);
ierr = TaoMonitor(tao, tao->niter, tron->f, tron->gnorm, 0.0, delta, &reason);CHKERRQ(ierr);
if (!reason) {
reason = TAO_CONVERGED_STEPTOL;
ierr = TaoSetConvergedReason(tao,reason);CHKERRQ(ierr);
}
break;
}
/* use free_local to mask/submat gradient, hessian, stepdirection */
ierr = TaoVecGetSubVec(tao->gradient,tron->Free_Local,tao->subset_type,0.0,&tron->R);CHKERRQ(ierr);
ierr = TaoVecGetSubVec(tao->gradient,tron->Free_Local,tao->subset_type,0.0,&tron->DXFree);CHKERRQ(ierr);
ierr = VecSet(tron->DXFree,0.0);CHKERRQ(ierr);
ierr = VecScale(tron->R, -1.0);CHKERRQ(ierr);
ierr = TaoMatGetSubMat(tao->hessian, tron->Free_Local, tron->diag, tao->subset_type, &tron->H_sub);CHKERRQ(ierr);
if (tao->hessian == tao->hessian_pre) {
ierr = MatDestroy(&tron->Hpre_sub);CHKERRQ(ierr);
ierr = PetscObjectReference((PetscObject)(tron->H_sub));CHKERRQ(ierr);
tron->Hpre_sub = tron->H_sub;
} else {
ierr = TaoMatGetSubMat(tao->hessian_pre, tron->Free_Local, tron->diag, tao->subset_type,&tron->Hpre_sub);CHKERRQ(ierr);
}
ierr = KSPReset(tao->ksp);CHKERRQ(ierr);
ierr = KSPSetOperators(tao->ksp, tron->H_sub, tron->Hpre_sub);CHKERRQ(ierr);
while (1) {
/* Approximately solve the reduced linear system */
ierr = KSPSTCGSetRadius(tao->ksp,delta);CHKERRQ(ierr);
ierr = KSPSolve(tao->ksp, tron->R, tron->DXFree);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(tao->ksp,&its);CHKERRQ(ierr);
tao->ksp_its+=its;
tao->ksp_tot_its+=its;
ierr = VecSet(tao->stepdirection,0.0);CHKERRQ(ierr);
/* Add dxfree matrix to compute step direction vector */
ierr = VecISAXPY(tao->stepdirection,tron->Free_Local,1.0,tron->DXFree);CHKERRQ(ierr);
if (0) {
PetscReal rhs,stepnorm;
ierr = VecNorm(tron->R,NORM_2,&rhs);CHKERRQ(ierr);
ierr = VecNorm(tron->DXFree,NORM_2,&stepnorm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"|rhs|=%g\t|s|=%g\n",(double)rhs,(double)stepnorm);CHKERRQ(ierr);
}
ierr = VecDot(tao->gradient, tao->stepdirection, &gdx);CHKERRQ(ierr);
ierr = PetscInfo1(tao,"Expected decrease in function value: %14.12e\n",(double)gdx);CHKERRQ(ierr);
ierr = VecCopy(tao->solution, tron->X_New);CHKERRQ(ierr);
ierr = VecCopy(tao->gradient, tron->G_New);CHKERRQ(ierr);
stepsize=1.0;f_new=f;
ierr = TaoLineSearchSetInitialStepLength(tao->linesearch,1.0);CHKERRQ(ierr);
ierr = TaoLineSearchApply(tao->linesearch, tron->X_New, &f_new, tron->G_New, tao->stepdirection,&stepsize,&ls_reason);CHKERRQ(ierr);CHKERRQ(ierr);
ierr = TaoAddLineSearchCounts(tao);CHKERRQ(ierr);
ierr = MatMult(tao->hessian, tao->stepdirection, tron->Work);CHKERRQ(ierr);
ierr = VecAYPX(tron->Work, 0.5, tao->gradient);CHKERRQ(ierr);
ierr = VecDot(tao->stepdirection, tron->Work, &prered);CHKERRQ(ierr);
actred = f_new - f;
if (actred<0) {
rhok=PetscAbs(-actred/prered);
} else {
rhok=0.0;
}
/* Compare actual improvement to the quadratic model */
if (rhok > tron->eta1) { /* Accept the point */
/* d = x_new - x */
ierr = VecCopy(tron->X_New, tao->stepdirection);CHKERRQ(ierr);
ierr = VecAXPY(tao->stepdirection, -1.0, tao->solution);CHKERRQ(ierr);
ierr = VecNorm(tao->stepdirection, NORM_2, &xdiff);CHKERRQ(ierr);
xdiff *= stepsize;
/* Adjust trust region size */
if (rhok < tron->eta2 ){
delta = PetscMin(xdiff,delta)*tron->sigma1;
} else if (rhok > tron->eta4 ){
delta= PetscMin(xdiff,delta)*tron->sigma3;
} else if (rhok > tron->eta3 ){
delta=PetscMin(xdiff,delta)*tron->sigma2;
}
ierr = VecBoundGradientProjection(tron->G_New,tron->X_New, tao->XL, tao->XU, tao->gradient);CHKERRQ(ierr);
if (tron->Free_Local) {
ierr = ISDestroy(&tron->Free_Local);CHKERRQ(ierr);
}
ierr = VecWhichBetween(tao->XL, tron->X_New, tao->XU, &tron->Free_Local);CHKERRQ(ierr);
f=f_new;
ierr = VecNorm(tao->gradient,NORM_2,&tron->gnorm);CHKERRQ(ierr);
ierr = VecCopy(tron->X_New, tao->solution);CHKERRQ(ierr);
ierr = VecCopy(tron->G_New, tao->gradient);CHKERRQ(ierr);
break;
}
else if (delta <= 1e-30) {
break;
}
else {
delta /= 4.0;
}
} /* end linear solve loop */
tron->f=f; tron->actred=actred; tao->trust=delta;
tao->niter++;
ierr = TaoMonitor(tao, tao->niter, tron->f, tron->gnorm, 0.0, delta, &reason);CHKERRQ(ierr);
} /* END MAIN LOOP */
PetscFunctionReturn(0);
}
PetscErrorCode ISView_General_HDF5(IS is, PetscViewer viewer)
{
hid_t filespace; /* file dataspace identifier */
hid_t chunkspace; /* chunk dataset property identifier */
hid_t plist_id; /* property list identifier */
hid_t dset_id; /* dataset identifier */
hid_t memspace; /* memory dataspace identifier */
hid_t inttype; /* int type (H5T_NATIVE_INT or H5T_NATIVE_LLONG) */
hid_t file_id, group;
herr_t status;
hsize_t dim, maxDims[3], dims[3], chunkDims[3], count[3],offset[3];
PetscInt bs, N, n, timestep, low;
const PetscInt *ind;
const char *isname;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = ISGetBlockSize(is,&bs);CHKERRQ(ierr);
ierr = PetscViewerHDF5OpenGroup(viewer, &file_id, &group);CHKERRQ(ierr);
ierr = PetscViewerHDF5GetTimestep(viewer, ×tep);CHKERRQ(ierr);
/* Create the dataspace for the dataset.
*
* dims - holds the current dimensions of the dataset
*
* maxDims - holds the maximum dimensions of the dataset (unlimited
* for the number of time steps with the current dimensions for the
* other dimensions; so only additional time steps can be added).
*
* chunkDims - holds the size of a single time step (required to
* permit extending dataset).
*/
dim = 0;
if (timestep >= 0) {
dims[dim] = timestep+1;
maxDims[dim] = H5S_UNLIMITED;
chunkDims[dim] = 1;
++dim;
}
ierr = ISGetSize(is, &N);CHKERRQ(ierr);
ierr = ISGetLocalSize(is, &n);CHKERRQ(ierr);
ierr = PetscHDF5IntCast(N/bs,dims + dim);CHKERRQ(ierr);
maxDims[dim] = dims[dim];
chunkDims[dim] = dims[dim];
++dim;
if (bs >= 1) {
dims[dim] = bs;
maxDims[dim] = dims[dim];
chunkDims[dim] = dims[dim];
++dim;
}
filespace = H5Screate_simple(dim, dims, maxDims);
if (filespace == -1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Cannot H5Screate_simple()");
#if defined(PETSC_USE_64BIT_INDICES)
inttype = H5T_NATIVE_LLONG;
#else
inttype = H5T_NATIVE_INT;
#endif
/* Create the dataset with default properties and close filespace */
ierr = PetscObjectGetName((PetscObject) is, &isname);CHKERRQ(ierr);
if (!H5Lexists(group, isname, H5P_DEFAULT)) {
/* Create chunk */
chunkspace = H5Pcreate(H5P_DATASET_CREATE);
if (chunkspace == -1) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_LIB, "Cannot H5Pcreate()");
status = H5Pset_chunk(chunkspace, dim, chunkDims);CHKERRQ(status);
#if (H5_VERS_MAJOR * 10000 + H5_VERS_MINOR * 100 + H5_VERS_RELEASE >= 10800)
dset_id = H5Dcreate2(group, isname, inttype, filespace, H5P_DEFAULT, chunkspace, H5P_DEFAULT);
#else
dset_id = H5Dcreate(group, isname, inttype, filespace, H5P_DEFAULT);
#endif
if (dset_id == -1) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_LIB, "Cannot H5Dcreate2()");
status = H5Pclose(chunkspace);CHKERRQ(status);
} else {
dset_id = H5Dopen2(group, isname, H5P_DEFAULT);
status = H5Dset_extent(dset_id, dims);CHKERRQ(status);
}
status = H5Sclose(filespace);CHKERRQ(status);
/* Each process defines a dataset and writes it to the hyperslab in the file */
dim = 0;
if (timestep >= 0) {
count[dim] = 1;
++dim;
}
ierr = PetscHDF5IntCast(n/bs,count + dim);CHKERRQ(ierr);
++dim;
if (bs >= 1) {
count[dim] = bs;
++dim;
}
if (n > 0) {
memspace = H5Screate_simple(dim, count, NULL);
if (memspace == -1) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_LIB, "Cannot H5Screate_simple()");
} else {
/* Can't create dataspace with zero for any dimension, so create null dataspace. */
memspace = H5Screate(H5S_NULL);
if (memspace == -1) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_LIB, "Cannot H5Screate()");
}
/* Select hyperslab in the file */
ierr = PetscLayoutGetRange(is->map, &low, NULL);CHKERRQ(ierr);
dim = 0;
if (timestep >= 0) {
offset[dim] = timestep;
++dim;
}
ierr = PetscHDF5IntCast(low/bs,offset + dim);CHKERRQ(ierr);
++dim;
if (bs >= 1) {
offset[dim] = 0;
++dim;
}
if (n > 0) {
filespace = H5Dget_space(dset_id);
if (filespace == -1) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_LIB, "Cannot H5Dget_space()");
status = H5Sselect_hyperslab(filespace, H5S_SELECT_SET, offset, NULL, count, NULL);CHKERRQ(status);
} else {
/* Create null filespace to match null memspace. */
filespace = H5Screate(H5S_NULL);
if (filespace == -1) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_LIB, "Cannot H5Screate(H5S_NULL)");
}
/* Create property list for collective dataset write */
plist_id = H5Pcreate(H5P_DATASET_XFER);
if (plist_id == -1) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_LIB, "Cannot H5Pcreate()");
#if defined(PETSC_HAVE_H5PSET_FAPL_MPIO)
status = H5Pset_dxpl_mpio(plist_id, H5FD_MPIO_COLLECTIVE);CHKERRQ(status);
#endif
/* To write dataset independently use H5Pset_dxpl_mpio(plist_id, H5FD_MPIO_INDEPENDENT) */
ierr = ISGetIndices(is, &ind);CHKERRQ(ierr);
status = H5Dwrite(dset_id, inttype, memspace, filespace, plist_id, ind);CHKERRQ(status);
status = H5Fflush(file_id, H5F_SCOPE_GLOBAL);CHKERRQ(status);
ierr = ISGetIndices(is, &ind);CHKERRQ(ierr);
/* Close/release resources */
if (group != file_id) {status = H5Gclose(group);CHKERRQ(status);}
status = H5Pclose(plist_id);CHKERRQ(status);
status = H5Sclose(filespace);CHKERRQ(status);
status = H5Sclose(memspace);CHKERRQ(status);
status = H5Dclose(dset_id);CHKERRQ(status);
ierr = PetscInfo1(is, "Wrote IS object with name %s\n", isname);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode PCBDDCSubSchursSetUp(PCBDDCSubSchurs sub_schurs, Mat S, IS is_A_I, IS is_A_B, PetscInt ncc, IS is_cc[], PetscInt xadj[], PetscInt adjncy[], PetscInt nlayers)
{
Mat A_II,A_IB,A_BI,A_BB;
ISLocalToGlobalMapping BtoNmap,ItoNmap;
PetscBT touched;
PetscInt i,n_I,n_B,n_local,*local_numbering;
PetscBool is_sorted;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = ISSorted(is_A_I,&is_sorted);CHKERRQ(ierr);
if (!is_sorted) {
SETERRQ(PetscObjectComm((PetscObject)is_A_I),PETSC_ERR_PLIB,"IS for I dofs should be shorted");
}
ierr = ISSorted(is_A_B,&is_sorted);CHKERRQ(ierr);
if (!is_sorted) {
SETERRQ(PetscObjectComm((PetscObject)is_A_B),PETSC_ERR_PLIB,"IS for B dofs should be shorted");
}
/* get sizes */
ierr = ISGetLocalSize(is_A_I,&n_I);CHKERRQ(ierr);
ierr = ISGetLocalSize(is_A_B,&n_B);CHKERRQ(ierr);
n_local = n_I+n_B;
/* maps */
ierr = ISLocalToGlobalMappingCreateIS(is_A_B,&BtoNmap);CHKERRQ(ierr);
if (nlayers >= 0 && xadj != NULL && adjncy != NULL) { /* I problems have a different size of the original ones */
ierr = ISLocalToGlobalMappingCreateIS(is_A_I,&ItoNmap);CHKERRQ(ierr);
/* allocate some auxiliary space */
ierr = PetscMalloc1(n_local,&local_numbering);CHKERRQ(ierr);
ierr = PetscBTCreate(n_local,&touched);CHKERRQ(ierr);
} else {
ItoNmap = 0;
local_numbering = 0;
touched = 0;
}
/* get Schur complement matrices */
ierr = MatSchurComplementGetSubMatrices(S,&A_II,NULL,&A_IB,&A_BI,&A_BB);CHKERRQ(ierr);
/* allocate space for schur complements */
ierr = PetscMalloc5(ncc,&sub_schurs->is_AEj_I,ncc,&sub_schurs->is_AEj_B,ncc,&sub_schurs->S_Ej,ncc,&sub_schurs->work1,ncc,&sub_schurs->work2);CHKERRQ(ierr);
sub_schurs->n_subs = ncc;
/* cycle on subsets and extract schur complements */
for (i=0;i<sub_schurs->n_subs;i++) {
Mat AE_II,AE_IE,AE_EI,AE_EE;
IS is_I,is_subset_B;
/* get IS for subsets in B numbering */
ierr = ISDuplicate(is_cc[i],&sub_schurs->is_AEj_B[i]);CHKERRQ(ierr);
ierr = ISSort(sub_schurs->is_AEj_B[i]);CHKERRQ(ierr);
ierr = ISGlobalToLocalMappingApplyIS(BtoNmap,IS_GTOLM_DROP,sub_schurs->is_AEj_B[i],&is_subset_B);CHKERRQ(ierr);
/* BB block on subset */
ierr = MatGetSubMatrix(A_BB,is_subset_B,is_subset_B,MAT_INITIAL_MATRIX,&AE_EE);CHKERRQ(ierr);
if (ItoNmap) { /* is ItoNmap has been computed, extracts only a part of I dofs */
const PetscInt* idx_B;
PetscInt n_local_dofs,n_prev_added,j,layer,subset_size;
/* all boundary dofs must be skipped when adding layers */
ierr = PetscBTMemzero(n_local,touched);CHKERRQ(ierr);
ierr = ISGetIndices(is_A_B,&idx_B);CHKERRQ(ierr);
for (j=0;j<n_B;j++) {
ierr = PetscBTSet(touched,idx_B[j]);CHKERRQ(ierr);
}
ierr = ISRestoreIndices(is_A_B,&idx_B);CHKERRQ(ierr);
/* add next layers of dofs */
ierr = ISGetLocalSize(is_cc[i],&subset_size);CHKERRQ(ierr);
ierr = ISGetIndices(is_cc[i],&idx_B);CHKERRQ(ierr);
ierr = PetscMemcpy(local_numbering,idx_B,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
ierr = ISRestoreIndices(is_cc[i],&idx_B);CHKERRQ(ierr);
n_local_dofs = subset_size;
n_prev_added = subset_size;
for (layer=0;layer<nlayers;layer++) {
PetscInt n_added;
if (n_local_dofs == n_I+subset_size) break;
if (n_local_dofs > n_I+subset_size) {
SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error querying layer %d. Out of bound access (%d > %d)",layer,n_local_dofs,n_I+subset_size);
}
ierr = PCBDDCAdjGetNextLayer_Private(local_numbering+n_local_dofs,n_prev_added,touched,xadj,adjncy,&n_added);CHKERRQ(ierr);
n_prev_added = n_added;
n_local_dofs += n_added;
if (!n_added) break;
}
/* IS for I dofs in original numbering and in I numbering */
ierr = ISCreateGeneral(PetscObjectComm((PetscObject)ItoNmap),n_local_dofs-subset_size,local_numbering+subset_size,PETSC_COPY_VALUES,&sub_schurs->is_AEj_I[i]);CHKERRQ(ierr);
ierr = ISSort(sub_schurs->is_AEj_I[i]);CHKERRQ(ierr);
ierr = ISGlobalToLocalMappingApplyIS(ItoNmap,IS_GTOLM_DROP,sub_schurs->is_AEj_I[i],&is_I);CHKERRQ(ierr);
/* II block */
ierr = MatGetSubMatrix(A_II,is_I,is_I,MAT_INITIAL_MATRIX,&AE_II);CHKERRQ(ierr);
} else { /* in this case we can take references of already existing IS and matrices for I dofs */
/* IS for I dofs in original numbering */
ierr = PetscObjectReference((PetscObject)is_A_I);CHKERRQ(ierr);
sub_schurs->is_AEj_I[i] = is_A_I;
/* IS for I dofs in I numbering TODO: "first" argument of ISCreateStride is not general */
ierr = ISCreateStride(PetscObjectComm((PetscObject)is_A_I),n_I,0,1,&is_I);CHKERRQ(ierr);
/* II block is the same */
ierr = PetscObjectReference((PetscObject)A_II);CHKERRQ(ierr);
AE_II = A_II;
}
/* IE block */
ierr = MatGetSubMatrix(A_IB,is_I,is_subset_B,MAT_INITIAL_MATRIX,&AE_IE);CHKERRQ(ierr);
/* EI block */
ierr = MatGetSubMatrix(A_BI,is_subset_B,is_I,MAT_INITIAL_MATRIX,&AE_EI);CHKERRQ(ierr);
/* setup Schur complements on subset */
ierr = MatCreateSchurComplement(AE_II,AE_II,AE_IE,AE_EI,AE_EE,&sub_schurs->S_Ej[i]);CHKERRQ(ierr);
ierr = MatGetVecs(sub_schurs->S_Ej[i],&sub_schurs->work1[i],&sub_schurs->work2[i]);CHKERRQ(ierr);
if (AE_II == A_II) { /* we can reuse the same ksp */
KSP ksp;
ierr = MatSchurComplementGetKSP(S,&ksp);CHKERRQ(ierr);
ierr = MatSchurComplementSetKSP(sub_schurs->S_Ej[i],ksp);CHKERRQ(ierr);
} else { /* build new ksp object which inherits ksp and pc types from the original one */
KSP origksp,schurksp;
PC origpc,schurpc;
KSPType ksp_type;
PCType pc_type;
PetscInt n_internal;
ierr = MatSchurComplementGetKSP(S,&origksp);CHKERRQ(ierr);
ierr = MatSchurComplementGetKSP(sub_schurs->S_Ej[i],&schurksp);CHKERRQ(ierr);
ierr = KSPGetType(origksp,&ksp_type);CHKERRQ(ierr);
ierr = KSPSetType(schurksp,ksp_type);CHKERRQ(ierr);
ierr = KSPGetPC(schurksp,&schurpc);CHKERRQ(ierr);
ierr = KSPGetPC(origksp,&origpc);CHKERRQ(ierr);
ierr = PCGetType(origpc,&pc_type);CHKERRQ(ierr);
ierr = PCSetType(schurpc,pc_type);CHKERRQ(ierr);
ierr = ISGetSize(is_I,&n_internal);CHKERRQ(ierr);
if (n_internal) { /* UMFPACK gives error with 0 sized problems */
MatSolverPackage solver=NULL;
ierr = PCFactorGetMatSolverPackage(origpc,(const MatSolverPackage*)&solver);CHKERRQ(ierr);
if (solver) {
ierr = PCFactorSetMatSolverPackage(schurpc,solver);CHKERRQ(ierr);
}
}
ierr = KSPSetUp(schurksp);CHKERRQ(ierr);
}
/* free */
ierr = MatDestroy(&AE_II);CHKERRQ(ierr);
ierr = MatDestroy(&AE_EE);CHKERRQ(ierr);
ierr = MatDestroy(&AE_IE);CHKERRQ(ierr);
ierr = MatDestroy(&AE_EI);CHKERRQ(ierr);
ierr = ISDestroy(&is_I);CHKERRQ(ierr);
ierr = ISDestroy(&is_subset_B);CHKERRQ(ierr);
}
/* free */
ierr = ISLocalToGlobalMappingDestroy(&ItoNmap);CHKERRQ(ierr);
ierr = ISLocalToGlobalMappingDestroy(&BtoNmap);CHKERRQ(ierr);
ierr = PetscFree(local_numbering);CHKERRQ(ierr);
ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
