PetscErrorCode MatSetUpMultiply_MPISBAIJ(Mat mat)
{
Mat_MPISBAIJ *sbaij = (Mat_MPISBAIJ*)mat->data;
Mat_SeqBAIJ *B = (Mat_SeqBAIJ*)(sbaij->B->data);
PetscErrorCode ierr;
PetscInt Nbs = sbaij->Nbs,i,j,*indices,*aj = B->j,ec = 0,*garray,*sgarray;
PetscInt bs = mat->rmap->bs,*stmp,mbs=sbaij->mbs, vec_size,nt;
IS from,to;
Vec gvec;
PetscMPIInt rank =sbaij->rank,lsize,size=sbaij->size;
PetscInt *owners=sbaij->rangebs,*ec_owner,k;
const PetscInt *sowners;
PetscScalar *ptr;
PetscFunctionBegin;
ierr = VecScatterDestroy(&sbaij->sMvctx);CHKERRQ(ierr);
/* For the first stab we make an array as long as the number of columns */
/* mark those columns that are in sbaij->B */
ierr = PetscCalloc1(Nbs,&indices);CHKERRQ(ierr);
for (i=0; i<mbs; i++) {
for (j=0; j<B->ilen[i]; j++) {
if (!indices[aj[B->i[i] + j]]) ec++;
indices[aj[B->i[i] + j]] = 1;
}
}
/* form arrays of columns we need */
ierr = PetscMalloc1(ec,&garray);CHKERRQ(ierr);
ierr = PetscMalloc2(2*ec,&sgarray,ec,&ec_owner);CHKERRQ(ierr);
ec = 0;
for (j=0; j<size; j++) {
for (i=owners[j]; i<owners[j+1]; i++) {
if (indices[i]) {
garray[ec] = i;
ec_owner[ec] = j;
ec++;
}
}
}
/* make indices now point into garray */
for (i=0; i<ec; i++) indices[garray[i]] = i;
/* compact out the extra columns in B */
for (i=0; i<mbs; i++) {
for (j=0; j<B->ilen[i]; j++) aj[B->i[i] + j] = indices[aj[B->i[i] + j]];
}
B->nbs = ec;
sbaij->B->cmap->n = sbaij->B->cmap->N = ec*mat->rmap->bs;
ierr = PetscLayoutSetUp((sbaij->B->cmap));CHKERRQ(ierr);
ierr = PetscFree(indices);CHKERRQ(ierr);
/* create local vector that is used to scatter into */
ierr = VecCreateSeq(PETSC_COMM_SELF,ec*bs,&sbaij->lvec);CHKERRQ(ierr);
/* create two temporary index sets for building scatter-gather */
ierr = PetscMalloc1(2*ec,&stmp);CHKERRQ(ierr);
ierr = ISCreateBlock(PETSC_COMM_SELF,bs,ec,garray,PETSC_COPY_VALUES,&from);CHKERRQ(ierr);
for (i=0; i<ec; i++) stmp[i] = i;
ierr = ISCreateBlock(PETSC_COMM_SELF,bs,ec,stmp,PETSC_COPY_VALUES,&to);CHKERRQ(ierr);
/* generate the scatter context
-- Mvctx and lvec are not used by MatMult_MPISBAIJ(), but usefule for some applications */
ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)mat),1,mat->cmap->n,mat->cmap->N,NULL,&gvec);CHKERRQ(ierr);
ierr = VecScatterCreateWithData(gvec,from,sbaij->lvec,to,&sbaij->Mvctx);CHKERRQ(ierr);
ierr = VecDestroy(&gvec);CHKERRQ(ierr);
sbaij->garray = garray;
ierr = PetscLogObjectParent((PetscObject)mat,(PetscObject)sbaij->Mvctx);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)mat,(PetscObject)sbaij->lvec);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)mat,(PetscObject)from);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)mat,(PetscObject)to);CHKERRQ(ierr);
ierr = ISDestroy(&from);CHKERRQ(ierr);
ierr = ISDestroy(&to);CHKERRQ(ierr);
/* create parallel vector that is used by SBAIJ matrix to scatter from/into */
lsize = (mbs + ec)*bs;
ierr = VecCreateMPI(PetscObjectComm((PetscObject)mat),lsize,PETSC_DETERMINE,&sbaij->slvec0);CHKERRQ(ierr);
ierr = VecDuplicate(sbaij->slvec0,&sbaij->slvec1);CHKERRQ(ierr);
ierr = VecGetSize(sbaij->slvec0,&vec_size);CHKERRQ(ierr);
ierr = VecGetOwnershipRanges(sbaij->slvec0,&sowners);CHKERRQ(ierr);
/* x index in the IS sfrom */
for (i=0; i<ec; i++) {
j = ec_owner[i];
sgarray[i] = garray[i] + (sowners[j]/bs - owners[j]);
}
/* b index in the IS sfrom */
k = sowners[rank]/bs + mbs;
for (i=ec,j=0; i< 2*ec; i++,j++) sgarray[i] = k + j;
ierr = ISCreateBlock(PETSC_COMM_SELF,bs,2*ec,sgarray,PETSC_COPY_VALUES,&from);CHKERRQ(ierr);
/* x index in the IS sto */
k = sowners[rank]/bs + mbs;
for (i=0; i<ec; i++) stmp[i] = (k + i);
/* b index in the IS sto */
for (i=ec; i<2*ec; i++) stmp[i] = sgarray[i-ec];
ierr = ISCreateBlock(PETSC_COMM_SELF,bs,2*ec,stmp,PETSC_COPY_VALUES,&to);CHKERRQ(ierr);
ierr = VecScatterCreateWithData(sbaij->slvec0,from,sbaij->slvec1,to,&sbaij->sMvctx);CHKERRQ(ierr);
ierr = VecGetLocalSize(sbaij->slvec1,&nt);CHKERRQ(ierr);
ierr = VecGetArray(sbaij->slvec1,&ptr);CHKERRQ(ierr);
ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,bs*mbs,ptr,&sbaij->slvec1a);CHKERRQ(ierr);
ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,nt-bs*mbs,ptr+bs*mbs,&sbaij->slvec1b);CHKERRQ(ierr);
ierr = VecRestoreArray(sbaij->slvec1,&ptr);CHKERRQ(ierr);
ierr = VecGetArray(sbaij->slvec0,&ptr);CHKERRQ(ierr);
ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,nt-bs*mbs,ptr+bs*mbs,&sbaij->slvec0b);CHKERRQ(ierr);
ierr = VecRestoreArray(sbaij->slvec0,&ptr);CHKERRQ(ierr);
ierr = PetscFree(stmp);CHKERRQ(ierr);
ierr = MPI_Barrier(PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)mat,(PetscObject)sbaij->sMvctx);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)mat,(PetscObject)sbaij->slvec0);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)mat,(PetscObject)sbaij->slvec1);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)mat,(PetscObject)sbaij->slvec0b);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)mat,(PetscObject)sbaij->slvec1a);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)mat,(PetscObject)sbaij->slvec1b);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)mat,(PetscObject)from);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)mat,(PetscObject)to);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)mat,(ec+1)*sizeof(PetscInt));CHKERRQ(ierr);
ierr = ISDestroy(&from);CHKERRQ(ierr);
ierr = ISDestroy(&to);CHKERRQ(ierr);
ierr = PetscFree2(sgarray,ec_owner);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode MatSetUpMultiply_MPISBAIJ_2comm(Mat mat)
{
Mat_MPISBAIJ *baij = (Mat_MPISBAIJ*)mat->data;
Mat_SeqBAIJ *B = (Mat_SeqBAIJ*)(baij->B->data);
PetscErrorCode ierr;
PetscInt i,j,*aj = B->j,ec = 0,*garray;
PetscInt bs = mat->rmap->bs,*stmp;
IS from,to;
Vec gvec;
#if defined(PETSC_USE_CTABLE)
PetscTable gid1_lid1;
PetscTablePosition tpos;
PetscInt gid,lid;
#else
PetscInt Nbs = baij->Nbs,*indices;
#endif
PetscFunctionBegin;
#if defined(PETSC_USE_CTABLE)
/* use a table - Mark Adams */
PetscTableCreate(B->mbs,baij->Nbs+1,&gid1_lid1);
for (i=0; i<B->mbs; i++) {
for (j=0; j<B->ilen[i]; j++) {
PetscInt data,gid1 = aj[B->i[i]+j] + 1;
ierr = PetscTableFind(gid1_lid1,gid1,&data);CHKERRQ(ierr);
if (!data) {
/* one based table */
ierr = PetscTableAdd(gid1_lid1,gid1,++ec,INSERT_VALUES);CHKERRQ(ierr);
}
}
}
/* form array of columns we need */
ierr = PetscMalloc1(ec,&garray);CHKERRQ(ierr);
ierr = PetscTableGetHeadPosition(gid1_lid1,&tpos);CHKERRQ(ierr);
while (tpos) {
ierr = PetscTableGetNext(gid1_lid1,&tpos,&gid,&lid);CHKERRQ(ierr);
gid--; lid--;
garray[lid] = gid;
}
ierr = PetscSortInt(ec,garray);CHKERRQ(ierr);
ierr = PetscTableRemoveAll(gid1_lid1);CHKERRQ(ierr);
for (i=0; i<ec; i++) {
ierr = PetscTableAdd(gid1_lid1,garray[i]+1,i+1,INSERT_VALUES);CHKERRQ(ierr);
}
/* compact out the extra columns in B */
for (i=0; i<B->mbs; i++) {
for (j=0; j<B->ilen[i]; j++) {
PetscInt gid1 = aj[B->i[i] + j] + 1;
ierr = PetscTableFind(gid1_lid1,gid1,&lid);CHKERRQ(ierr);
lid--;
aj[B->i[i]+j] = lid;
}
}
B->nbs = ec;
baij->B->cmap->n = baij->B->cmap->N = ec*mat->rmap->bs;
ierr = PetscLayoutSetUp((baij->B->cmap));CHKERRQ(ierr);
ierr = PetscTableDestroy(&gid1_lid1);CHKERRQ(ierr);
#else
/* For the first stab we make an array as long as the number of columns */
/* mark those columns that are in baij->B */
ierr = PetscCalloc1(Nbs,&indices);CHKERRQ(ierr);
for (i=0; i<B->mbs; i++) {
for (j=0; j<B->ilen[i]; j++) {
if (!indices[aj[B->i[i] + j]]) ec++;
indices[aj[B->i[i] + j]] = 1;
}
}
/* form array of columns we need */
ierr = PetscMalloc1(ec,&garray);CHKERRQ(ierr);
ec = 0;
for (i=0; i<Nbs; i++) {
if (indices[i]) {
garray[ec++] = i;
}
}
/* make indices now point into garray */
for (i=0; i<ec; i++) indices[garray[i]] = i;
/* compact out the extra columns in B */
for (i=0; i<B->mbs; i++) {
for (j=0; j<B->ilen[i]; j++) {
aj[B->i[i] + j] = indices[aj[B->i[i] + j]];
}
}
B->nbs = ec;
baij->B->cmap->n = ec*mat->rmap->bs;
ierr = PetscFree(indices);CHKERRQ(ierr);
#endif
/* create local vector that is used to scatter into */
ierr = VecCreateSeq(PETSC_COMM_SELF,ec*bs,&baij->lvec);CHKERRQ(ierr);
/* create two temporary index sets for building scatter-gather */
ierr = ISCreateBlock(PETSC_COMM_SELF,bs,ec,garray,PETSC_COPY_VALUES,&from);CHKERRQ(ierr);
ierr = PetscMalloc1(ec,&stmp);CHKERRQ(ierr);
for (i=0; i<ec; i++) stmp[i] = i;
ierr = ISCreateBlock(PETSC_COMM_SELF,bs,ec,stmp,PETSC_OWN_POINTER,&to);CHKERRQ(ierr);
/* create temporary global vector to generate scatter context */
ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)mat),1,mat->cmap->n,mat->cmap->N,NULL,&gvec);CHKERRQ(ierr);
ierr = VecScatterCreateWithData(gvec,from,baij->lvec,to,&baij->Mvctx);CHKERRQ(ierr);
ierr = VecDestroy(&gvec);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)mat,(PetscObject)baij->Mvctx);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)mat,(PetscObject)baij->lvec);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)mat,(PetscObject)from);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)mat,(PetscObject)to);CHKERRQ(ierr);
baij->garray = garray;
ierr = PetscLogObjectMemory((PetscObject)mat,(ec+1)*sizeof(PetscInt));CHKERRQ(ierr);
ierr = ISDestroy(&from);CHKERRQ(ierr);
ierr = ISDestroy(&to);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
Takes the local part of an already assembled MPISBAIJ matrix
and disassembles it. This is to allow new nonzeros into the matrix
that require more communication in the matrix vector multiply.
Thus certain data-structures must be rebuilt.
Kind of slow! But that's what application programmers get when
they are sloppy.
*/
PetscErrorCode MatDisAssemble_MPISBAIJ(Mat A)
{
Mat_MPISBAIJ *baij = (Mat_MPISBAIJ*)A->data;
Mat B = baij->B,Bnew;
Mat_SeqBAIJ *Bbaij = (Mat_SeqBAIJ*)B->data;
PetscErrorCode ierr;
PetscInt i,j,mbs=Bbaij->mbs,n = A->cmap->N,col,*garray=baij->garray;
PetscInt k,bs=A->rmap->bs,bs2=baij->bs2,*rvals,*nz,ec,m=A->rmap->n;
MatScalar *a = Bbaij->a;
PetscScalar *atmp;
#if defined(PETSC_USE_REAL_MAT_SINGLE)
PetscInt l;
#endif
PetscFunctionBegin;
#if defined(PETSC_USE_REAL_MAT_SINGLE)
ierr = PetscMalloc1(A->rmap->bs,&atmp);
#endif
/* free stuff related to matrix-vec multiply */
ierr = VecGetSize(baij->lvec,&ec);CHKERRQ(ierr); /* needed for PetscLogObjectMemory below */
ierr = VecDestroy(&baij->lvec);CHKERRQ(ierr);
ierr = VecScatterDestroy(&baij->Mvctx);CHKERRQ(ierr);
ierr = VecDestroy(&baij->slvec0);CHKERRQ(ierr);
ierr = VecDestroy(&baij->slvec0b);CHKERRQ(ierr);
ierr = VecDestroy(&baij->slvec1);CHKERRQ(ierr);
ierr = VecDestroy(&baij->slvec1a);CHKERRQ(ierr);
ierr = VecDestroy(&baij->slvec1b);CHKERRQ(ierr);
if (baij->colmap) {
#if defined(PETSC_USE_CTABLE)
ierr = PetscTableDestroy(&baij->colmap);CHKERRQ(ierr);
#else
ierr = PetscFree(baij->colmap);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)A,-Bbaij->nbs*sizeof(PetscInt));CHKERRQ(ierr);
#endif
}
/* make sure that B is assembled so we can access its values */
ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* invent new B and copy stuff over */
ierr = PetscMalloc1(mbs,&nz);CHKERRQ(ierr);
for (i=0; i<mbs; i++) {
nz[i] = Bbaij->i[i+1]-Bbaij->i[i];
}
ierr = MatCreate(PETSC_COMM_SELF,&Bnew);CHKERRQ(ierr);
ierr = MatSetSizes(Bnew,m,n,m,n);CHKERRQ(ierr);
ierr = MatSetType(Bnew,((PetscObject)B)->type_name);CHKERRQ(ierr);
ierr = MatSeqBAIJSetPreallocation(Bnew,B->rmap->bs,0,nz);CHKERRQ(ierr);
ierr = PetscFree(nz);CHKERRQ(ierr);
if (Bbaij->nonew >= 0) { /* Inherit insertion error options (if positive). */
((Mat_SeqSBAIJ*)Bnew->data)->nonew = Bbaij->nonew;
}
/*
Ensure that B's nonzerostate is monotonically increasing.
Or should this follow the MatSetValues() loop to preserve B's nonzerstate across a MatDisAssemble() call?
*/
Bnew->nonzerostate = B->nonzerostate;
ierr = PetscMalloc1(bs,&rvals);CHKERRQ(ierr);
for (i=0; i<mbs; i++) {
rvals[0] = bs*i;
for (j=1; j<bs; j++) rvals[j] = rvals[j-1] + 1;
for (j=Bbaij->i[i]; j<Bbaij->i[i+1]; j++) {
col = garray[Bbaij->j[j]]*bs;
for (k=0; k<bs; k++) {
#if defined(PETSC_USE_REAL_MAT_SINGLE)
for (l=0; l<bs; l++) atmp[l] = a[j*bs2+l];
#else
atmp = a+j*bs2 + k*bs;
#endif
ierr = MatSetValues_SeqSBAIJ(Bnew,bs,rvals,1,&col,atmp,B->insertmode);CHKERRQ(ierr);
col++;
}
}
}
#if defined(PETSC_USE_REAL_MAT_SINGLE)
ierr = PetscFree(atmp);CHKERRQ(ierr);
#endif
ierr = PetscFree(baij->garray);CHKERRQ(ierr);
baij->garray = 0;
ierr = PetscFree(rvals);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)A,-ec*sizeof(PetscInt));CHKERRQ(ierr);
ierr = MatDestroy(&B);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)A,(PetscObject)Bnew);CHKERRQ(ierr);
baij->B = Bnew;
A->was_assembled = PETSC_FALSE;
PetscFunctionReturn(0);
}
PetscErrorCode TSSetUp_Sundials(TS ts)
{
TS_Sundials *cvode = (TS_Sundials*)ts->data;
PetscErrorCode ierr;
PetscInt glosize,locsize,i,flag;
PetscScalar *y_data,*parray;
void *mem;
PC pc;
PCType pctype;
PetscBool pcnone;
PetscFunctionBegin;
if (ts->exact_final_time == TS_EXACTFINALTIME_MATCHSTEP) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"No support for exact final time option 'MATCHSTEP' when using Sundials");
/* get the vector size */
ierr = VecGetSize(ts->vec_sol,&glosize);CHKERRQ(ierr);
ierr = VecGetLocalSize(ts->vec_sol,&locsize);CHKERRQ(ierr);
/* allocate the memory for N_Vec y */
cvode->y = N_VNew_Parallel(cvode->comm_sundials,locsize,glosize);
if (!cvode->y) SETERRQ(PETSC_COMM_SELF,1,"cvode->y is not allocated");
/* initialize N_Vec y: copy ts->vec_sol to cvode->y */
ierr = VecGetArray(ts->vec_sol,&parray);CHKERRQ(ierr);
y_data = (PetscScalar*) N_VGetArrayPointer(cvode->y);
for (i = 0; i < locsize; i++) y_data[i] = parray[i];
ierr = VecRestoreArray(ts->vec_sol,NULL);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&cvode->update);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&cvode->ydot);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)ts,(PetscObject)cvode->update);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)ts,(PetscObject)cvode->ydot);CHKERRQ(ierr);
/*
Create work vectors for the TSPSolve_Sundials() routine. Note these are
allocated with zero space arrays because the actual array space is provided
by Sundials and set using VecPlaceArray().
*/
ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)ts),1,locsize,PETSC_DECIDE,0,&cvode->w1);CHKERRQ(ierr);
ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)ts),1,locsize,PETSC_DECIDE,0,&cvode->w2);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)ts,(PetscObject)cvode->w1);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)ts,(PetscObject)cvode->w2);CHKERRQ(ierr);
/* Call CVodeCreate to create the solver memory and the use of a Newton iteration */
mem = CVodeCreate(cvode->cvode_type, CV_NEWTON);
if (!mem) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"CVodeCreate() fails");
cvode->mem = mem;
/* Set the pointer to user-defined data */
flag = CVodeSetUserData(mem, ts);
if (flag) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVodeSetUserData() fails");
/* Sundials may choose to use a smaller initial step, but will never use a larger step. */
flag = CVodeSetInitStep(mem,(realtype)ts->time_step);
if (flag) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_LIB,"CVodeSetInitStep() failed");
if (cvode->mindt > 0) {
flag = CVodeSetMinStep(mem,(realtype)cvode->mindt);
if (flag) {
if (flag == CV_MEM_NULL) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_LIB,"CVodeSetMinStep() failed, cvode_mem pointer is NULL");
else if (flag == CV_ILL_INPUT) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_LIB,"CVodeSetMinStep() failed, hmin is nonpositive or it exceeds the maximum allowable step size");
else SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_LIB,"CVodeSetMinStep() failed");
}
}
if (cvode->maxdt > 0) {
flag = CVodeSetMaxStep(mem,(realtype)cvode->maxdt);
if (flag) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_LIB,"CVodeSetMaxStep() failed");
}
/* Call CVodeInit to initialize the integrator memory and specify the
* user's right hand side function in u'=f(t,u), the inital time T0, and
* the initial dependent variable vector cvode->y */
flag = CVodeInit(mem,TSFunction_Sundials,ts->ptime,cvode->y);
if (flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVodeInit() fails, flag %d",flag);
/* specifies scalar relative and absolute tolerances */
flag = CVodeSStolerances(mem,cvode->reltol,cvode->abstol);
if (flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVodeSStolerances() fails, flag %d",flag);
/* Specify max num of steps to be taken by cvode in its attempt to reach the next output time */
flag = CVodeSetMaxNumSteps(mem,ts->max_steps);
if (flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVodeSetMaxNumSteps() fails, flag %d",flag);
/* call CVSpgmr to use GMRES as the linear solver. */
/* setup the ode integrator with the given preconditioner */
ierr = TSSundialsGetPC(ts,&pc);CHKERRQ(ierr);
ierr = PCGetType(pc,&pctype);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)pc,PCNONE,&pcnone);CHKERRQ(ierr);
if (pcnone) {
flag = CVSpgmr(mem,PREC_NONE,0);
if (flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVSpgmr() fails, flag %d",flag);
} else {
flag = CVSpgmr(mem,PREC_LEFT,cvode->maxl);
if (flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVSpgmr() fails, flag %d",flag);
/* Set preconditioner and solve routines Precond and PSolve,
and the pointer to the user-defined block data */
flag = CVSpilsSetPreconditioner(mem,TSPrecond_Sundials,TSPSolve_Sundials);
if (flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVSpilsSetPreconditioner() fails, flag %d", flag);
}
flag = CVSpilsSetGSType(mem, MODIFIED_GS);
if (flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVSpgmrSetGSType() fails, flag %d",flag);
PetscFunctionReturn(0);
}
static PetscErrorCode PCSetUp_Redundant(PC pc)
{
PC_Redundant *red = (PC_Redundant*)pc->data;
PetscErrorCode ierr;
PetscInt mstart,mend,mlocal,m,mlocal_sub,rstart_sub,rend_sub,mloc_sub;
PetscMPIInt size;
MatReuse reuse = MAT_INITIAL_MATRIX;
MatStructure str = DIFFERENT_NONZERO_PATTERN;
MPI_Comm comm = ((PetscObject)pc)->comm,subcomm;
Vec vec;
PetscMPIInt subsize,subrank;
const char *prefix;
const PetscInt *range;
PetscFunctionBegin;
ierr = MatGetVecs(pc->pmat,&vec,0);CHKERRQ(ierr);
ierr = VecGetSize(vec,&m);CHKERRQ(ierr);
if (!pc->setupcalled) {
if (!red->psubcomm) {
ierr = PetscSubcommCreate(comm,red->nsubcomm,&red->psubcomm);CHKERRQ(ierr);
ierr = PetscLogObjectMemory(pc,sizeof(PetscSubcomm));CHKERRQ(ierr);
/* create a new PC that processors in each subcomm have copy of */
subcomm = red->psubcomm->comm;
ierr = KSPCreate(subcomm,&red->ksp);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)red->ksp,(PetscObject)pc,1);CHKERRQ(ierr);
ierr = PetscLogObjectParent(pc,red->ksp);CHKERRQ(ierr);
ierr = KSPSetType(red->ksp,KSPPREONLY);CHKERRQ(ierr);
ierr = KSPGetPC(red->ksp,&red->pc);CHKERRQ(ierr);
ierr = PCSetType(red->pc,PCLU);CHKERRQ(ierr);
ierr = PCGetOptionsPrefix(pc,&prefix);CHKERRQ(ierr);
ierr = KSPSetOptionsPrefix(red->ksp,prefix);CHKERRQ(ierr);
ierr = KSPAppendOptionsPrefix(red->ksp,"redundant_");CHKERRQ(ierr);
} else {
subcomm = red->psubcomm->comm;
}
/* create working vectors xsub/ysub and xdup/ydup */
ierr = VecGetLocalSize(vec,&mlocal);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(vec,&mstart,&mend);CHKERRQ(ierr);
/* get local size of xsub/ysub */
ierr = MPI_Comm_size(subcomm,&subsize);CHKERRQ(ierr);
ierr = MPI_Comm_rank(subcomm,&subrank);CHKERRQ(ierr);
ierr = MatGetOwnershipRanges(pc->pmat,&range);CHKERRQ(ierr);
rstart_sub = range[red->psubcomm->n*subrank]; /* rstart in xsub/ysub */
if (subrank+1 < subsize){
rend_sub = range[red->psubcomm->n*(subrank+1)];
} else {
rend_sub = m;
}
mloc_sub = rend_sub - rstart_sub;
ierr = VecCreateMPI(subcomm,mloc_sub,PETSC_DECIDE,&red->ysub);CHKERRQ(ierr);
/* create xsub with empty local arrays, because xdup's arrays will be placed into it */
ierr = VecCreateMPIWithArray(subcomm,mloc_sub,PETSC_DECIDE,PETSC_NULL,&red->xsub);CHKERRQ(ierr);
/* create xdup and ydup. ydup has empty local arrays because ysub's arrays will be place into it.
Note: we use communicator dupcomm, not ((PetscObject)pc)->comm! */
ierr = VecCreateMPI(red->psubcomm->dupparent,mloc_sub,PETSC_DECIDE,&red->xdup);CHKERRQ(ierr);
ierr = VecCreateMPIWithArray(red->psubcomm->dupparent,mloc_sub,PETSC_DECIDE,PETSC_NULL,&red->ydup);CHKERRQ(ierr);
/* create vec scatters */
if (!red->scatterin){
IS is1,is2;
PetscInt *idx1,*idx2,i,j,k;
ierr = PetscMalloc2(red->psubcomm->n*mlocal,PetscInt,&idx1,red->psubcomm->n*mlocal,PetscInt,&idx2);CHKERRQ(ierr);
j = 0;
for (k=0; k<red->psubcomm->n; k++){
for (i=mstart; i<mend; i++){
idx1[j] = i;
idx2[j++] = i + m*k;
}
}
ierr = ISCreateGeneral(comm,red->psubcomm->n*mlocal,idx1,&is1);CHKERRQ(ierr);
ierr = ISCreateGeneral(comm,red->psubcomm->n*mlocal,idx2,&is2);CHKERRQ(ierr);
ierr = VecScatterCreate(vec,is1,red->xdup,is2,&red->scatterin);CHKERRQ(ierr);
ierr = ISDestroy(is1);CHKERRQ(ierr);
ierr = ISDestroy(is2);CHKERRQ(ierr);
ierr = ISCreateStride(comm,mlocal,mstart+ red->psubcomm->color*m,1,&is1);CHKERRQ(ierr);
ierr = ISCreateStride(comm,mlocal,mstart,1,&is2);CHKERRQ(ierr);
ierr = VecScatterCreate(red->xdup,is1,vec,is2,&red->scatterout);CHKERRQ(ierr);
ierr = ISDestroy(is1);CHKERRQ(ierr);
ierr = ISDestroy(is2);CHKERRQ(ierr);
ierr = PetscFree2(idx1,idx2);CHKERRQ(ierr);
}
}
ierr = VecDestroy(vec);CHKERRQ(ierr);
/* if pmatrix set by user is sequential then we do not need to gather the parallel matrix */
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
if (size == 1) {
red->useparallelmat = PETSC_FALSE;
}
if (red->useparallelmat) {
if (pc->setupcalled == 1 && pc->flag == DIFFERENT_NONZERO_PATTERN) {
/* destroy old matrices */
if (red->pmats) {
ierr = MatDestroy(red->pmats);CHKERRQ(ierr);
}
} else if (pc->setupcalled == 1) {
reuse = MAT_REUSE_MATRIX;
str = SAME_NONZERO_PATTERN;
}
/* grab the parallel matrix and put it into processors of a subcomminicator */
/*--------------------------------------------------------------------------*/
ierr = VecGetLocalSize(red->ysub,&mlocal_sub);CHKERRQ(ierr);
ierr = MatGetRedundantMatrix(pc->pmat,red->psubcomm->n,red->psubcomm->comm,mlocal_sub,reuse,&red->pmats);CHKERRQ(ierr);
/* tell PC of the subcommunicator its operators */
ierr = KSPSetOperators(red->ksp,red->pmats,red->pmats,str);CHKERRQ(ierr);
} else {
ierr = KSPSetOperators(red->ksp,pc->mat,pc->pmat,pc->flag);CHKERRQ(ierr);
}
if (pc->setfromoptionscalled){
ierr = KSPSetFromOptions(red->ksp);CHKERRQ(ierr);
}
ierr = KSPSetUp(red->ksp);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode PCSetUp_ILU(PC pc)
{
PetscErrorCode ierr;
PC_ILU *ilu = (PC_ILU*)pc->data;
MatInfo info;
PetscBool flg;
PetscFunctionBegin;
/* ugly hack to change default, since it is not support by some matrix types */
if (((PC_Factor*)ilu)->info.shifttype == (PetscReal)MAT_SHIFT_NONZERO) {
ierr = PetscObjectTypeCompare((PetscObject)pc->pmat,MATSEQAIJ,&flg);CHKERRQ(ierr);
if (!flg) {
ierr = PetscObjectTypeCompare((PetscObject)pc->pmat,MATMPIAIJ,&flg);CHKERRQ(ierr);
if (!flg) {
((PC_Factor*)ilu)->info.shifttype = (PetscReal)MAT_SHIFT_INBLOCKS;
PetscInfo(pc,"Changing shift type from NONZERO to INBLOCKS because block matrices do not support NONZERO");CHKERRQ(ierr);
}
}
}
if (ilu->inplace) {
if (!pc->setupcalled) {
/* In-place factorization only makes sense with the natural ordering,
so we only need to get the ordering once, even if nonzero structure changes */
ierr = MatGetOrdering(pc->pmat,((PC_Factor*)ilu)->ordering,&ilu->row,&ilu->col);CHKERRQ(ierr);
if (ilu->row) {ierr = PetscLogObjectParent((PetscObject)pc,(PetscObject)ilu->row);CHKERRQ(ierr);}
if (ilu->col) {ierr = PetscLogObjectParent((PetscObject)pc,(PetscObject)ilu->col);CHKERRQ(ierr);}
}
/* In place ILU only makes sense with fill factor of 1.0 because
cannot have levels of fill */
((PC_Factor*)ilu)->info.fill = 1.0;
((PC_Factor*)ilu)->info.diagonal_fill = 0.0;
ierr = MatILUFactor(pc->pmat,ilu->row,ilu->col,&((PC_Factor*)ilu)->info);CHKERRQ(ierr);CHKERRQ(ierr);
((PC_Factor*)ilu)->fact = pc->pmat;
} else {
if (!pc->setupcalled) {
/* first time in so compute reordering and symbolic factorization */
ierr = MatGetOrdering(pc->pmat,((PC_Factor*)ilu)->ordering,&ilu->row,&ilu->col);CHKERRQ(ierr);
if (ilu->row) {ierr = PetscLogObjectParent((PetscObject)pc,(PetscObject)ilu->row);CHKERRQ(ierr);}
if (ilu->col) {ierr = PetscLogObjectParent((PetscObject)pc,(PetscObject)ilu->col);CHKERRQ(ierr);}
/* Remove zeros along diagonal? */
if (ilu->nonzerosalongdiagonal) {
ierr = MatReorderForNonzeroDiagonal(pc->pmat,ilu->nonzerosalongdiagonaltol,ilu->row,ilu->col);CHKERRQ(ierr);
}
if (!((PC_Factor*)ilu)->fact) {
ierr = MatGetFactor(pc->pmat,((PC_Factor*)ilu)->solvertype,MAT_FACTOR_ILU,&((PC_Factor*)ilu)->fact);CHKERRQ(ierr);
}
ierr = MatILUFactorSymbolic(((PC_Factor*)ilu)->fact,pc->pmat,ilu->row,ilu->col,&((PC_Factor*)ilu)->info);CHKERRQ(ierr);
ierr = MatGetInfo(((PC_Factor*)ilu)->fact,MAT_LOCAL,&info);CHKERRQ(ierr);
ilu->actualfill = info.fill_ratio_needed;
ierr = PetscLogObjectParent((PetscObject)pc,(PetscObject)((PC_Factor*)ilu)->fact);CHKERRQ(ierr);
} else if (pc->flag != SAME_NONZERO_PATTERN) {
if (!ilu->reuseordering) {
/* compute a new ordering for the ILU */
ierr = ISDestroy(&ilu->row);CHKERRQ(ierr);
ierr = ISDestroy(&ilu->col);CHKERRQ(ierr);
ierr = MatGetOrdering(pc->pmat,((PC_Factor*)ilu)->ordering,&ilu->row,&ilu->col);CHKERRQ(ierr);
if (ilu->row) {ierr = PetscLogObjectParent((PetscObject)pc,(PetscObject)ilu->row);CHKERRQ(ierr);}
if (ilu->col) {ierr = PetscLogObjectParent((PetscObject)pc,(PetscObject)ilu->col);CHKERRQ(ierr);}
/* Remove zeros along diagonal? */
if (ilu->nonzerosalongdiagonal) {
ierr = MatReorderForNonzeroDiagonal(pc->pmat,ilu->nonzerosalongdiagonaltol,ilu->row,ilu->col);CHKERRQ(ierr);
}
}
ierr = MatDestroy(&((PC_Factor*)ilu)->fact);CHKERRQ(ierr);
ierr = MatGetFactor(pc->pmat,((PC_Factor*)ilu)->solvertype,MAT_FACTOR_ILU,&((PC_Factor*)ilu)->fact);CHKERRQ(ierr);
ierr = MatILUFactorSymbolic(((PC_Factor*)ilu)->fact,pc->pmat,ilu->row,ilu->col,&((PC_Factor*)ilu)->info);CHKERRQ(ierr);
ierr = MatGetInfo(((PC_Factor*)ilu)->fact,MAT_LOCAL,&info);CHKERRQ(ierr);
ilu->actualfill = info.fill_ratio_needed;
ierr = PetscLogObjectParent((PetscObject)pc,(PetscObject)((PC_Factor*)ilu)->fact);CHKERRQ(ierr);
}
ierr = MatLUFactorNumeric(((PC_Factor*)ilu)->fact,pc->pmat,&((PC_Factor*)ilu)->info);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode DMSetUp_DA_2D(DM da)
{
DM_DA *dd = (DM_DA*)da->data;
const PetscInt M = dd->M;
const PetscInt N = dd->N;
PetscInt m = dd->m;
PetscInt n = dd->n;
const PetscInt dof = dd->w;
const PetscInt s = dd->s;
DMDABoundaryType bx = dd->bx;
DMDABoundaryType by = dd->by;
DMDAStencilType stencil_type = dd->stencil_type;
PetscInt *lx = dd->lx;
PetscInt *ly = dd->ly;
MPI_Comm comm;
PetscMPIInt rank,size;
PetscInt xs,xe,ys,ye,x,y,Xs,Xe,Ys,Ye,start,end,IXs,IXe,IYs,IYe;
PetscInt up,down,left,right,i,n0,n1,n2,n3,n5,n6,n7,n8,*idx,nn;
PetscInt xbase,*bases,*ldims,j,x_t,y_t,s_t,base,count;
PetscInt s_x,s_y; /* s proportionalized to w */
PetscInt sn0 = 0,sn2 = 0,sn6 = 0,sn8 = 0;
Vec local,global;
VecScatter ltog,gtol;
IS to,from,ltogis;
PetscErrorCode ierr;
PetscFunctionBegin;
if (stencil_type == DMDA_STENCIL_BOX && (bx == DMDA_BOUNDARY_MIRROR || by == DMDA_BOUNDARY_MIRROR)) SETERRQ(PetscObjectComm((PetscObject)da),PETSC_ERR_SUP,"Mirror boundary and box stencil");
ierr = PetscObjectGetComm((PetscObject)da,&comm);CHKERRQ(ierr);
#if !defined(PETSC_USE_64BIT_INDICES)
if (((Petsc64bitInt) M)*((Petsc64bitInt) N)*((Petsc64bitInt) dof) > (Petsc64bitInt) PETSC_MPI_INT_MAX) SETERRQ3(comm,PETSC_ERR_INT_OVERFLOW,"Mesh of %D by %D by %D (dof) is too large for 32 bit indices",M,N,dof);
#endif
if (dof < 1) SETERRQ1(comm,PETSC_ERR_ARG_OUTOFRANGE,"Must have 1 or more degrees of freedom per node: %D",dof);
if (s < 0) SETERRQ1(comm,PETSC_ERR_ARG_OUTOFRANGE,"Stencil width cannot be negative: %D",s);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
if (m != PETSC_DECIDE) {
if (m < 1) SETERRQ1(comm,PETSC_ERR_ARG_OUTOFRANGE,"Non-positive number of processors in X direction: %D",m);
else if (m > size) SETERRQ2(comm,PETSC_ERR_ARG_OUTOFRANGE,"Too many processors in X direction: %D %d",m,size);
}
if (n != PETSC_DECIDE) {
if (n < 1) SETERRQ1(comm,PETSC_ERR_ARG_OUTOFRANGE,"Non-positive number of processors in Y direction: %D",n);
else if (n > size) SETERRQ2(comm,PETSC_ERR_ARG_OUTOFRANGE,"Too many processors in Y direction: %D %d",n,size);
}
if (m == PETSC_DECIDE || n == PETSC_DECIDE) {
if (n != PETSC_DECIDE) {
m = size/n;
} else if (m != PETSC_DECIDE) {
n = size/m;
} else {
/* try for squarish distribution */
m = (PetscInt)(0.5 + PetscSqrtReal(((PetscReal)M)*((PetscReal)size)/((PetscReal)N)));
if (!m) m = 1;
while (m > 0) {
n = size/m;
if (m*n == size) break;
m--;
}
if (M > N && m < n) {PetscInt _m = m; m = n; n = _m;}
}
if (m*n != size) SETERRQ(comm,PETSC_ERR_PLIB,"Unable to create partition, check the size of the communicator and input m and n ");
} else if (m*n != size) SETERRQ(comm,PETSC_ERR_ARG_OUTOFRANGE,"Given Bad partition");
if (M < m) SETERRQ2(comm,PETSC_ERR_ARG_OUTOFRANGE,"Partition in x direction is too fine! %D %D",M,m);
if (N < n) SETERRQ2(comm,PETSC_ERR_ARG_OUTOFRANGE,"Partition in y direction is too fine! %D %D",N,n);
/*
Determine locally owned region
xs is the first local node number, x is the number of local nodes
*/
if (!lx) {
ierr = PetscMalloc1(m, &dd->lx);CHKERRQ(ierr);
lx = dd->lx;
for (i=0; i<m; i++) {
lx[i] = M/m + ((M % m) > i);
}
}
x = lx[rank % m];
xs = 0;
for (i=0; i<(rank % m); i++) {
xs += lx[i];
}
#if defined(PETSC_USE_DEBUG)
left = xs;
for (i=(rank % m); i<m; i++) {
left += lx[i];
}
if (left != M) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Sum of lx across processors not equal to M: %D %D",left,M);
#endif
/*
Determine locally owned region
ys is the first local node number, y is the number of local nodes
*/
if (!ly) {
ierr = PetscMalloc1(n, &dd->ly);CHKERRQ(ierr);
ly = dd->ly;
for (i=0; i<n; i++) {
ly[i] = N/n + ((N % n) > i);
}
}
y = ly[rank/m];
ys = 0;
for (i=0; i<(rank/m); i++) {
ys += ly[i];
}
#if defined(PETSC_USE_DEBUG)
left = ys;
for (i=(rank/m); i<n; i++) {
left += ly[i];
}
if (left != N) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Sum of ly across processors not equal to N: %D %D",left,N);
#endif
/*
check if the scatter requires more than one process neighbor or wraps around
the domain more than once
*/
if ((x < s) && ((m > 1) || (bx == DMDA_BOUNDARY_PERIODIC))) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Local x-width of domain x %D is smaller than stencil width s %D",x,s);
if ((y < s) && ((n > 1) || (by == DMDA_BOUNDARY_PERIODIC))) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Local y-width of domain y %D is smaller than stencil width s %D",y,s);
xe = xs + x;
ye = ys + y;
/* determine ghost region (Xs) and region scattered into (IXs) */
if (xs-s > 0) {
Xs = xs - s; IXs = xs - s;
} else {
if (bx) {
Xs = xs - s;
} else {
Xs = 0;
}
IXs = 0;
}
if (xe+s <= M) {
Xe = xe + s; IXe = xe + s;
} else {
if (bx) {
Xs = xs - s; Xe = xe + s;
} else {
Xe = M;
}
IXe = M;
}
if (bx == DMDA_BOUNDARY_PERIODIC || bx == DMDA_BOUNDARY_MIRROR) {
IXs = xs - s;
IXe = xe + s;
Xs = xs - s;
Xe = xe + s;
}
if (ys-s > 0) {
Ys = ys - s; IYs = ys - s;
} else {
if (by) {
Ys = ys - s;
} else {
Ys = 0;
}
IYs = 0;
}
if (ye+s <= N) {
Ye = ye + s; IYe = ye + s;
} else {
if (by) {
Ye = ye + s;
} else {
Ye = N;
}
IYe = N;
}
if (by == DMDA_BOUNDARY_PERIODIC || by == DMDA_BOUNDARY_MIRROR) {
IYs = ys - s;
IYe = ye + s;
Ys = ys - s;
Ye = ye + s;
}
/* stencil length in each direction */
s_x = s;
s_y = s;
/* determine starting point of each processor */
nn = x*y;
ierr = PetscMalloc2(size+1,&bases,size,&ldims);CHKERRQ(ierr);
ierr = MPI_Allgather(&nn,1,MPIU_INT,ldims,1,MPIU_INT,comm);CHKERRQ(ierr);
bases[0] = 0;
for (i=1; i<=size; i++) {
bases[i] = ldims[i-1];
}
for (i=1; i<=size; i++) {
bases[i] += bases[i-1];
}
base = bases[rank]*dof;
/* allocate the base parallel and sequential vectors */
dd->Nlocal = x*y*dof;
ierr = VecCreateMPIWithArray(comm,dof,dd->Nlocal,PETSC_DECIDE,0,&global);CHKERRQ(ierr);
dd->nlocal = (Xe-Xs)*(Ye-Ys)*dof;
ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,dof,dd->nlocal,0,&local);CHKERRQ(ierr);
/* generate appropriate vector scatters */
/* local to global inserts non-ghost point region into global */
ierr = VecGetOwnershipRange(global,&start,&end);CHKERRQ(ierr);
ierr = ISCreateStride(comm,x*y*dof,start,1,&to);CHKERRQ(ierr);
ierr = PetscMalloc1(x*y,&idx);CHKERRQ(ierr);
left = xs - Xs; right = left + x;
down = ys - Ys; up = down + y;
count = 0;
for (i=down; i<up; i++) {
for (j=left; j<right; j++) {
idx[count++] = i*(Xe-Xs) + j;
}
}
ierr = ISCreateBlock(comm,dof,count,idx,PETSC_OWN_POINTER,&from);CHKERRQ(ierr);
ierr = VecScatterCreate(local,from,global,to,<og);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)da,(PetscObject)ltog);CHKERRQ(ierr);
ierr = ISDestroy(&from);CHKERRQ(ierr);
ierr = ISDestroy(&to);CHKERRQ(ierr);
/* global to local must include ghost points within the domain,
but not ghost points outside the domain that aren't periodic */
if (stencil_type == DMDA_STENCIL_BOX) {
count = (IXe-IXs)*(IYe-IYs);
ierr = PetscMalloc1(count,&idx);CHKERRQ(ierr);
left = IXs - Xs; right = left + (IXe-IXs);
down = IYs - Ys; up = down + (IYe-IYs);
count = 0;
for (i=down; i<up; i++) {
for (j=left; j<right; j++) {
idx[count++] = j + i*(Xe-Xs);
}
}
ierr = ISCreateBlock(comm,dof,count,idx,PETSC_OWN_POINTER,&to);CHKERRQ(ierr);
} else {
/* must drop into cross shape region */
/* ---------|
| top |
|--- ---| up
| middle |
| |
---- ---- down
| bottom |
-----------
Xs xs xe Xe */
count = (ys-IYs)*x + y*(IXe-IXs) + (IYe-ye)*x;
ierr = PetscMalloc1(count,&idx);CHKERRQ(ierr);
left = xs - Xs; right = left + x;
down = ys - Ys; up = down + y;
count = 0;
/* bottom */
for (i=(IYs-Ys); i<down; i++) {
for (j=left; j<right; j++) {
idx[count++] = j + i*(Xe-Xs);
}
}
/* middle */
for (i=down; i<up; i++) {
for (j=(IXs-Xs); j<(IXe-Xs); j++) {
idx[count++] = j + i*(Xe-Xs);
}
}
/* top */
for (i=up; i<up+IYe-ye; i++) {
for (j=left; j<right; j++) {
idx[count++] = j + i*(Xe-Xs);
}
}
ierr = ISCreateBlock(comm,dof,count,idx,PETSC_OWN_POINTER,&to);CHKERRQ(ierr);
}
/* determine who lies on each side of us stored in n6 n7 n8
n3 n5
n0 n1 n2
*/
/* Assume the Non-Periodic Case */
n1 = rank - m;
if (rank % m) {
n0 = n1 - 1;
} else {
n0 = -1;
}
if ((rank+1) % m) {
n2 = n1 + 1;
n5 = rank + 1;
n8 = rank + m + 1; if (n8 >= m*n) n8 = -1;
} else {
n2 = -1; n5 = -1; n8 = -1;
}
if (rank % m) {
n3 = rank - 1;
n6 = n3 + m; if (n6 >= m*n) n6 = -1;
} else {
n3 = -1; n6 = -1;
}
n7 = rank + m; if (n7 >= m*n) n7 = -1;
if (bx == DMDA_BOUNDARY_PERIODIC && by == DMDA_BOUNDARY_PERIODIC) {
/* Modify for Periodic Cases */
/* Handle all four corners */
if ((n6 < 0) && (n7 < 0) && (n3 < 0)) n6 = m-1;
if ((n8 < 0) && (n7 < 0) && (n5 < 0)) n8 = 0;
if ((n2 < 0) && (n5 < 0) && (n1 < 0)) n2 = size-m;
if ((n0 < 0) && (n3 < 0) && (n1 < 0)) n0 = size-1;
/* Handle Top and Bottom Sides */
if (n1 < 0) n1 = rank + m * (n-1);
if (n7 < 0) n7 = rank - m * (n-1);
if ((n3 >= 0) && (n0 < 0)) n0 = size - m + rank - 1;
if ((n3 >= 0) && (n6 < 0)) n6 = (rank%m)-1;
if ((n5 >= 0) && (n2 < 0)) n2 = size - m + rank + 1;
if ((n5 >= 0) && (n8 < 0)) n8 = (rank%m)+1;
/* Handle Left and Right Sides */
if (n3 < 0) n3 = rank + (m-1);
if (n5 < 0) n5 = rank - (m-1);
if ((n1 >= 0) && (n0 < 0)) n0 = rank-1;
if ((n1 >= 0) && (n2 < 0)) n2 = rank-2*m+1;
if ((n7 >= 0) && (n6 < 0)) n6 = rank+2*m-1;
if ((n7 >= 0) && (n8 < 0)) n8 = rank+1;
} else if (by == DMDA_BOUNDARY_PERIODIC) { /* Handle Top and Bottom Sides */
if (n1 < 0) n1 = rank + m * (n-1);
if (n7 < 0) n7 = rank - m * (n-1);
if ((n3 >= 0) && (n0 < 0)) n0 = size - m + rank - 1;
if ((n3 >= 0) && (n6 < 0)) n6 = (rank%m)-1;
if ((n5 >= 0) && (n2 < 0)) n2 = size - m + rank + 1;
if ((n5 >= 0) && (n8 < 0)) n8 = (rank%m)+1;
} else if (bx == DMDA_BOUNDARY_PERIODIC) { /* Handle Left and Right Sides */
if (n3 < 0) n3 = rank + (m-1);
if (n5 < 0) n5 = rank - (m-1);
if ((n1 >= 0) && (n0 < 0)) n0 = rank-1;
if ((n1 >= 0) && (n2 < 0)) n2 = rank-2*m+1;
if ((n7 >= 0) && (n6 < 0)) n6 = rank+2*m-1;
if ((n7 >= 0) && (n8 < 0)) n8 = rank+1;
}
ierr = PetscMalloc1(9,&dd->neighbors);CHKERRQ(ierr);
dd->neighbors[0] = n0;
dd->neighbors[1] = n1;
dd->neighbors[2] = n2;
dd->neighbors[3] = n3;
dd->neighbors[4] = rank;
dd->neighbors[5] = n5;
dd->neighbors[6] = n6;
dd->neighbors[7] = n7;
dd->neighbors[8] = n8;
if (stencil_type == DMDA_STENCIL_STAR) {
/* save corner processor numbers */
sn0 = n0; sn2 = n2; sn6 = n6; sn8 = n8;
n0 = n2 = n6 = n8 = -1;
}
ierr = PetscMalloc1((Xe-Xs)*(Ye-Ys),&idx);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)da,(Xe-Xs)*(Ye-Ys)*sizeof(PetscInt));CHKERRQ(ierr);
nn = 0;
xbase = bases[rank];
for (i=1; i<=s_y; i++) {
if (n0 >= 0) { /* left below */
x_t = lx[n0 % m];
y_t = ly[(n0/m)];
s_t = bases[n0] + x_t*y_t - (s_y-i)*x_t - s_x;
for (j=0; j<s_x; j++) idx[nn++] = s_t++;
}
if (n1 >= 0) { /* directly below */
x_t = x;
y_t = ly[(n1/m)];
s_t = bases[n1] + x_t*y_t - (s_y+1-i)*x_t;
for (j=0; j<x_t; j++) idx[nn++] = s_t++;
} else if (by == DMDA_BOUNDARY_MIRROR) {
for (j=0; j<x; j++) idx[nn++] = bases[rank] + x*(s_y - i + 1) + j;
}
if (n2 >= 0) { /* right below */
x_t = lx[n2 % m];
y_t = ly[(n2/m)];
s_t = bases[n2] + x_t*y_t - (s_y+1-i)*x_t;
for (j=0; j<s_x; j++) idx[nn++] = s_t++;
}
}
for (i=0; i<y; i++) {
if (n3 >= 0) { /* directly left */
x_t = lx[n3 % m];
/* y_t = y; */
s_t = bases[n3] + (i+1)*x_t - s_x;
for (j=0; j<s_x; j++) idx[nn++] = s_t++;
} else if (bx == DMDA_BOUNDARY_MIRROR) {
for (j=0; j<s_x; j++) idx[nn++] = bases[rank] + x*i + s_x - j;
}
for (j=0; j<x; j++) idx[nn++] = xbase++; /* interior */
if (n5 >= 0) { /* directly right */
x_t = lx[n5 % m];
/* y_t = y; */
s_t = bases[n5] + (i)*x_t;
for (j=0; j<s_x; j++) idx[nn++] = s_t++;
} else if (bx == DMDA_BOUNDARY_MIRROR) {
for (j=0; j<s_x; j++) idx[nn++] = bases[rank] + x*(i + 1) - 2 - j;
}
}
for (i=1; i<=s_y; i++) {
if (n6 >= 0) { /* left above */
x_t = lx[n6 % m];
/* y_t = ly[(n6/m)]; */
s_t = bases[n6] + (i)*x_t - s_x;
for (j=0; j<s_x; j++) idx[nn++] = s_t++;
}
if (n7 >= 0) { /* directly above */
x_t = x;
/* y_t = ly[(n7/m)]; */
s_t = bases[n7] + (i-1)*x_t;
for (j=0; j<x_t; j++) idx[nn++] = s_t++;
} else if (by == DMDA_BOUNDARY_MIRROR) {
for (j=0; j<x; j++) idx[nn++] = bases[rank] + x*(y - i - 1) + j;
}
if (n8 >= 0) { /* right above */
x_t = lx[n8 % m];
/* y_t = ly[(n8/m)]; */
s_t = bases[n8] + (i-1)*x_t;
for (j=0; j<s_x; j++) idx[nn++] = s_t++;
}
}
ierr = ISCreateBlock(comm,dof,nn,idx,PETSC_COPY_VALUES,&from);CHKERRQ(ierr);
ierr = VecScatterCreate(global,from,local,to,>ol);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)da,(PetscObject)gtol);CHKERRQ(ierr);
ierr = ISDestroy(&to);CHKERRQ(ierr);
ierr = ISDestroy(&from);CHKERRQ(ierr);
if (stencil_type == DMDA_STENCIL_STAR) {
n0 = sn0; n2 = sn2; n6 = sn6; n8 = sn8;
}
if (((stencil_type == DMDA_STENCIL_STAR) ||
(bx && bx != DMDA_BOUNDARY_PERIODIC) ||
(by && by != DMDA_BOUNDARY_PERIODIC))) {
/*
Recompute the local to global mappings, this time keeping the
information about the cross corner processor numbers and any ghosted
but not periodic indices.
*/
nn = 0;
xbase = bases[rank];
for (i=1; i<=s_y; i++) {
if (n0 >= 0) { /* left below */
x_t = lx[n0 % m];
y_t = ly[(n0/m)];
s_t = bases[n0] + x_t*y_t - (s_y-i)*x_t - s_x;
for (j=0; j<s_x; j++) idx[nn++] = s_t++;
} else if (xs-Xs > 0 && ys-Ys > 0) {
for (j=0; j<s_x; j++) idx[nn++] = -1;
}
if (n1 >= 0) { /* directly below */
x_t = x;
y_t = ly[(n1/m)];
s_t = bases[n1] + x_t*y_t - (s_y+1-i)*x_t;
for (j=0; j<x_t; j++) idx[nn++] = s_t++;
} else if (ys-Ys > 0) {
if (by == DMDA_BOUNDARY_MIRROR) {
for (j=0; j<x; j++) idx[nn++] = bases[rank] + x*(s_y - i + 1) + j;
} else {
for (j=0; j<x; j++) idx[nn++] = -1;
}
}
if (n2 >= 0) { /* right below */
x_t = lx[n2 % m];
y_t = ly[(n2/m)];
s_t = bases[n2] + x_t*y_t - (s_y+1-i)*x_t;
for (j=0; j<s_x; j++) idx[nn++] = s_t++;
} else if (Xe-xe> 0 && ys-Ys > 0) {
for (j=0; j<s_x; j++) idx[nn++] = -1;
}
}
for (i=0; i<y; i++) {
if (n3 >= 0) { /* directly left */
x_t = lx[n3 % m];
/* y_t = y; */
s_t = bases[n3] + (i+1)*x_t - s_x;
for (j=0; j<s_x; j++) idx[nn++] = s_t++;
} else if (xs-Xs > 0) {
if (bx == DMDA_BOUNDARY_MIRROR) {
for (j=0; j<s_x; j++) idx[nn++] = bases[rank] + x*i + s_x - j;
} else {
for (j=0; j<s_x; j++) idx[nn++] = -1;
}
}
for (j=0; j<x; j++) idx[nn++] = xbase++; /* interior */
if (n5 >= 0) { /* directly right */
x_t = lx[n5 % m];
/* y_t = y; */
s_t = bases[n5] + (i)*x_t;
for (j=0; j<s_x; j++) idx[nn++] = s_t++;
} else if (Xe-xe > 0) {
if (bx == DMDA_BOUNDARY_MIRROR) {
for (j=0; j<s_x; j++) idx[nn++] = bases[rank] + x*(i + 1) - 2 - j;
} else {
for (j=0; j<s_x; j++) idx[nn++] = -1;
}
}
}
for (i=1; i<=s_y; i++) {
if (n6 >= 0) { /* left above */
x_t = lx[n6 % m];
/* y_t = ly[(n6/m)]; */
s_t = bases[n6] + (i)*x_t - s_x;
for (j=0; j<s_x; j++) idx[nn++] = s_t++;
} else if (xs-Xs > 0 && Ye-ye > 0) {
for (j=0; j<s_x; j++) idx[nn++] = -1;
}
if (n7 >= 0) { /* directly above */
x_t = x;
/* y_t = ly[(n7/m)]; */
s_t = bases[n7] + (i-1)*x_t;
for (j=0; j<x_t; j++) idx[nn++] = s_t++;
} else if (Ye-ye > 0) {
if (by == DMDA_BOUNDARY_MIRROR) {
for (j=0; j<x; j++) idx[nn++] = bases[rank] + x*(y - i - 1) + j;
} else {
for (j=0; j<x; j++) idx[nn++] = -1;
}
}
if (n8 >= 0) { /* right above */
x_t = lx[n8 % m];
/* y_t = ly[(n8/m)]; */
s_t = bases[n8] + (i-1)*x_t;
for (j=0; j<s_x; j++) idx[nn++] = s_t++;
} else if (Xe-xe > 0 && Ye-ye > 0) {
for (j=0; j<s_x; j++) idx[nn++] = -1;
}
}
}
/*
Set the local to global ordering in the global vector, this allows use
of VecSetValuesLocal().
*/
ierr = ISCreateBlock(comm,dof,nn,idx,PETSC_OWN_POINTER,<ogis);CHKERRQ(ierr);
ierr = ISLocalToGlobalMappingCreateIS(ltogis,&da->ltogmap);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)da,(PetscObject)da->ltogmap);CHKERRQ(ierr);
ierr = ISDestroy(<ogis);CHKERRQ(ierr);
ierr = ISLocalToGlobalMappingBlock(da->ltogmap,dd->w,&da->ltogmapb);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)da,(PetscObject)da->ltogmap);CHKERRQ(ierr);
ierr = PetscFree2(bases,ldims);CHKERRQ(ierr);
dd->m = m; dd->n = n;
/* note petsc expects xs/xe/Xs/Xe to be multiplied by #dofs in many places */
dd->xs = xs*dof; dd->xe = xe*dof; dd->ys = ys; dd->ye = ye; dd->zs = 0; dd->ze = 1;
dd->Xs = Xs*dof; dd->Xe = Xe*dof; dd->Ys = Ys; dd->Ye = Ye; dd->Zs = 0; dd->Ze = 1;
ierr = VecDestroy(&local);CHKERRQ(ierr);
ierr = VecDestroy(&global);CHKERRQ(ierr);
dd->gtol = gtol;
dd->ltog = ltog;
dd->base = base;
da->ops->view = DMView_DA_2d;
dd->ltol = NULL;
dd->ao = NULL;
PetscFunctionReturn(0);
}
PetscErrorCode MatLUFactorSymbolic_SeqBAIJ_inplace(Mat B,Mat A,IS isrow,IS iscol,const MatFactorInfo *info)
{
Mat_SeqBAIJ *a = (Mat_SeqBAIJ*)A->data,*b;
PetscInt n =a->mbs,bs = A->rmap->bs,bs2=a->bs2;
PetscBool row_identity,col_identity,both_identity;
IS isicol;
PetscErrorCode ierr;
const PetscInt *r,*ic;
PetscInt i,*ai=a->i,*aj=a->j;
PetscInt *bi,*bj,*ajtmp;
PetscInt *bdiag,row,nnz,nzi,reallocs=0,nzbd,*im;
PetscReal f;
PetscInt nlnk,*lnk,k,**bi_ptr;
PetscFreeSpaceList free_space=NULL,current_space=NULL;
PetscBT lnkbt;
PetscBool missing;
PetscFunctionBegin;
if (A->rmap->N != A->cmap->N) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"matrix must be square");
ierr = MatMissingDiagonal(A,&missing,&i);CHKERRQ(ierr);
if (missing) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Matrix is missing diagonal entry %D",i);
ierr = ISInvertPermutation(iscol,PETSC_DECIDE,&isicol);CHKERRQ(ierr);
ierr = ISGetIndices(isrow,&r);CHKERRQ(ierr);
ierr = ISGetIndices(isicol,&ic);CHKERRQ(ierr);
/* get new row and diagonal pointers, must be allocated separately because they will be given to the Mat_SeqAIJ and freed separately */
ierr = PetscMalloc1(n+1,&bi);CHKERRQ(ierr);
ierr = PetscMalloc1(n+1,&bdiag);CHKERRQ(ierr);
bi[0] = bdiag[0] = 0;
/* linked list for storing column indices of the active row */
nlnk = n + 1;
ierr = PetscLLCreate(n,n,nlnk,lnk,lnkbt);CHKERRQ(ierr);
ierr = PetscMalloc2(n+1,&bi_ptr,n+1,&im);CHKERRQ(ierr);
/* initial FreeSpace size is f*(ai[n]+1) */
f = info->fill;
ierr = PetscFreeSpaceGet(PetscRealIntMultTruncate(f,ai[n]+1),&free_space);CHKERRQ(ierr);
current_space = free_space;
for (i=0; i<n; i++) {
/* copy previous fill into linked list */
nzi = 0;
nnz = ai[r[i]+1] - ai[r[i]];
ajtmp = aj + ai[r[i]];
ierr = PetscLLAddPerm(nnz,ajtmp,ic,n,nlnk,lnk,lnkbt);CHKERRQ(ierr);
nzi += nlnk;
/* add pivot rows into linked list */
row = lnk[n];
while (row < i) {
nzbd = bdiag[row] - bi[row] + 1; /* num of entries in the row with column index <= row */
ajtmp = bi_ptr[row] + nzbd; /* points to the entry next to the diagonal */
ierr = PetscLLAddSortedLU(ajtmp,row,nlnk,lnk,lnkbt,i,nzbd,im);CHKERRQ(ierr);
nzi += nlnk;
row = lnk[row];
}
bi[i+1] = bi[i] + nzi;
im[i] = nzi;
/* mark bdiag */
nzbd = 0;
nnz = nzi;
k = lnk[n];
while (nnz-- && k < i) {
nzbd++;
k = lnk[k];
}
bdiag[i] = bi[i] + nzbd;
/* if free space is not available, make more free space */
if (current_space->local_remaining<nzi) {
nnz = PetscIntMultTruncate(n - i,nzi); /* estimated and max additional space needed */
ierr = PetscFreeSpaceGet(nnz,¤t_space);CHKERRQ(ierr);
reallocs++;
}
/* copy data into free space, then initialize lnk */
ierr = PetscLLClean(n,n,nzi,lnk,current_space->array,lnkbt);CHKERRQ(ierr);
bi_ptr[i] = current_space->array;
current_space->array += nzi;
current_space->local_used += nzi;
current_space->local_remaining -= nzi;
}
#if defined(PETSC_USE_INFO)
if (ai[n] != 0) {
PetscReal af = ((PetscReal)bi[n])/((PetscReal)ai[n]);
ierr = PetscInfo3(A,"Reallocs %D Fill ratio:given %g needed %g\n",reallocs,(double)f,(double)af);CHKERRQ(ierr);
ierr = PetscInfo1(A,"Run with -pc_factor_fill %g or use \n",(double)af);CHKERRQ(ierr);
ierr = PetscInfo1(A,"PCFactorSetFill(pc,%g);\n",(double)af);CHKERRQ(ierr);
ierr = PetscInfo(A,"for best performance.\n");CHKERRQ(ierr);
} else {
ierr = PetscInfo(A,"Empty matrix\n");CHKERRQ(ierr);
}
#endif
ierr = ISRestoreIndices(isrow,&r);CHKERRQ(ierr);
ierr = ISRestoreIndices(isicol,&ic);CHKERRQ(ierr);
/* destroy list of free space and other temporary array(s) */
ierr = PetscMalloc1(bi[n]+1,&bj);CHKERRQ(ierr);
ierr = PetscFreeSpaceContiguous(&free_space,bj);CHKERRQ(ierr);
ierr = PetscLLDestroy(lnk,lnkbt);CHKERRQ(ierr);
ierr = PetscFree2(bi_ptr,im);CHKERRQ(ierr);
/* put together the new matrix */
ierr = MatSeqBAIJSetPreallocation(B,bs,MAT_SKIP_ALLOCATION,NULL);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)B,(PetscObject)isicol);CHKERRQ(ierr);
b = (Mat_SeqBAIJ*)(B)->data;
b->free_a = PETSC_TRUE;
b->free_ij = PETSC_TRUE;
b->singlemalloc = PETSC_FALSE;
ierr = PetscMalloc1((bi[n]+1)*bs2,&b->a);CHKERRQ(ierr);
b->j = bj;
b->i = bi;
b->diag = bdiag;
b->free_diag = PETSC_TRUE;
b->ilen = 0;
b->imax = 0;
b->row = isrow;
b->col = iscol;
b->pivotinblocks = (info->pivotinblocks) ? PETSC_TRUE : PETSC_FALSE;
ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
b->icol = isicol;
ierr = PetscMalloc1(bs*n+bs,&b->solve_work);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)B,(bi[n]-n)*(sizeof(PetscInt)+sizeof(PetscScalar)*bs2));CHKERRQ(ierr);
b->maxnz = b->nz = bi[n];
(B)->factortype = MAT_FACTOR_LU;
(B)->info.factor_mallocs = reallocs;
(B)->info.fill_ratio_given = f;
if (ai[n] != 0) {
(B)->info.fill_ratio_needed = ((PetscReal)bi[n])/((PetscReal)ai[n]);
} else {
(B)->info.fill_ratio_needed = 0.0;
}
ierr = ISIdentity(isrow,&row_identity);CHKERRQ(ierr);
ierr = ISIdentity(iscol,&col_identity);CHKERRQ(ierr);
both_identity = (PetscBool) (row_identity && col_identity);
ierr = MatSeqBAIJSetNumericFactorization_inplace(B,both_identity);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode SNESSetUp_Multiblock(SNES snes)
{
SNES_Multiblock *mb = (SNES_Multiblock *) snes->data;
BlockDesc blocks;
PetscInt i, numBlocks;
PetscErrorCode ierr;
PetscFunctionBegin;
/* ierr = SNESDefaultGetWork(snes, 1);CHKERRQ(ierr); */
ierr = SNESMultiblockSetDefaults(snes);CHKERRQ(ierr);
numBlocks = mb->numBlocks;
blocks = mb->blocks;
/* Create ISs */
if (!mb->issetup) {
PetscInt ccsize, rstart, rend, nslots, bs;
PetscBool sorted;
mb->issetup = PETSC_TRUE;
bs = mb->bs;
ierr = MatGetOwnershipRange(snes->jacobian_pre, &rstart, &rend);CHKERRQ(ierr);
ierr = MatGetLocalSize(snes->jacobian_pre, PETSC_NULL, &ccsize);CHKERRQ(ierr);
nslots = (rend - rstart)/bs;
for (i = 0; i < numBlocks; ++i) {
if (mb->defaultblocks) {
ierr = ISCreateStride(((PetscObject) snes)->comm, nslots, rstart+i, numBlocks, &blocks->is);CHKERRQ(ierr);
} else if (!blocks->is) {
if (blocks->nfields > 1) {
PetscInt *ii, j, k, nfields = blocks->nfields, *fields = blocks->fields;
ierr = PetscMalloc(nfields*nslots*sizeof(PetscInt), &ii);CHKERRQ(ierr);
for (j = 0; j < nslots; ++j) {
for (k = 0; k < nfields; ++k) {
ii[nfields*j + k] = rstart + bs*j + fields[k];
}
}
ierr = ISCreateGeneral(((PetscObject) snes)->comm, nslots*nfields, ii, PETSC_OWN_POINTER, &blocks->is);CHKERRQ(ierr);
} else {
ierr = ISCreateStride(((PetscObject) snes)->comm, nslots, rstart+blocks->fields[0], bs, &blocks->is);CHKERRQ(ierr);
}
}
ierr = ISSorted(blocks->is, &sorted);CHKERRQ(ierr);
if (!sorted) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_USER, "Fields must be sorted when creating split");
blocks = blocks->next;
}
}
#if 0
/* Create matrices */
ilink = jac->head;
if (!jac->pmat) {
ierr = PetscMalloc(nsplit*sizeof(Mat),&jac->pmat);CHKERRQ(ierr);
for (i=0; i<nsplit; i++) {
ierr = MatGetSubMatrix(pc->pmat,ilink->is,ilink->is,MAT_INITIAL_MATRIX,&jac->pmat[i]);CHKERRQ(ierr);
ilink = ilink->next;
}
} else {
for (i=0; i<nsplit; i++) {
ierr = MatGetSubMatrix(pc->pmat,ilink->is,ilink->is,MAT_REUSE_MATRIX,&jac->pmat[i]);CHKERRQ(ierr);
ilink = ilink->next;
}
}
if (jac->realdiagonal) {
ilink = jac->head;
if (!jac->mat) {
ierr = PetscMalloc(nsplit*sizeof(Mat),&jac->mat);CHKERRQ(ierr);
for (i=0; i<nsplit; i++) {
ierr = MatGetSubMatrix(pc->mat,ilink->is,ilink->is,MAT_INITIAL_MATRIX,&jac->mat[i]);CHKERRQ(ierr);
ilink = ilink->next;
}
} else {
for (i=0; i<nsplit; i++) {
if (jac->mat[i]) {ierr = MatGetSubMatrix(pc->mat,ilink->is,ilink->is,MAT_REUSE_MATRIX,&jac->mat[i]);CHKERRQ(ierr);}
ilink = ilink->next;
}
}
} else {
jac->mat = jac->pmat;
}
#endif
#if 0
if (jac->type != PC_COMPOSITE_ADDITIVE && jac->type != PC_COMPOSITE_SCHUR) {
/* extract the rows of the matrix associated with each field: used for efficient computation of residual inside algorithm */
ilink = jac->head;
if (!jac->Afield) {
ierr = PetscMalloc(nsplit*sizeof(Mat),&jac->Afield);CHKERRQ(ierr);
for (i=0; i<nsplit; i++) {
ierr = MatGetSubMatrix(pc->mat,ilink->is,PETSC_NULL,MAT_INITIAL_MATRIX,&jac->Afield[i]);CHKERRQ(ierr);
ilink = ilink->next;
}
} else {
for (i=0; i<nsplit; i++) {
ierr = MatGetSubMatrix(pc->mat,ilink->is,PETSC_NULL,MAT_REUSE_MATRIX,&jac->Afield[i]);CHKERRQ(ierr);
ilink = ilink->next;
}
}
}
#endif
if (mb->type == PC_COMPOSITE_SCHUR) {
#if 0
IS ccis;
PetscInt rstart,rend;
if (nsplit != 2) SETERRQ(((PetscObject)pc)->comm,PETSC_ERR_ARG_INCOMP,"To use Schur complement preconditioner you must have exactly 2 fields");
/* When extracting off-diagonal submatrices, we take complements from this range */
ierr = MatGetOwnershipRangeColumn(pc->mat,&rstart,&rend);CHKERRQ(ierr);
/* need to handle case when one is resetting up the preconditioner */
if (jac->schur) {
ilink = jac->head;
ierr = ISComplement(ilink->is,rstart,rend,&ccis);CHKERRQ(ierr);
ierr = MatGetSubMatrix(pc->mat,ilink->is,ccis,MAT_REUSE_MATRIX,&jac->B);CHKERRQ(ierr);
ierr = ISDestroy(&ccis);CHKERRQ(ierr);
ilink = ilink->next;
ierr = ISComplement(ilink->is,rstart,rend,&ccis);CHKERRQ(ierr);
ierr = MatGetSubMatrix(pc->mat,ilink->is,ccis,MAT_REUSE_MATRIX,&jac->C);CHKERRQ(ierr);
ierr = ISDestroy(&ccis);CHKERRQ(ierr);
ierr = MatSchurComplementUpdate(jac->schur,jac->mat[0],jac->pmat[0],jac->B,jac->C,jac->pmat[1],pc->flag);CHKERRQ(ierr);
ierr = KSPSetOperators(jac->kspschur,jac->schur,FieldSplitSchurPre(jac),pc->flag);CHKERRQ(ierr);
} else {
KSP ksp;
char schurprefix[256];
/* extract the A01 and A10 matrices */
ilink = jac->head;
ierr = ISComplement(ilink->is,rstart,rend,&ccis);CHKERRQ(ierr);
ierr = MatGetSubMatrix(pc->mat,ilink->is,ccis,MAT_INITIAL_MATRIX,&jac->B);CHKERRQ(ierr);
ierr = ISDestroy(&ccis);CHKERRQ(ierr);
ilink = ilink->next;
ierr = ISComplement(ilink->is,rstart,rend,&ccis);CHKERRQ(ierr);
ierr = MatGetSubMatrix(pc->mat,ilink->is,ccis,MAT_INITIAL_MATRIX,&jac->C);CHKERRQ(ierr);
ierr = ISDestroy(&ccis);CHKERRQ(ierr);
/* Use mat[0] (diagonal block of the real matrix) preconditioned by pmat[0] */
ierr = MatCreateSchurComplement(jac->mat[0],jac->pmat[0],jac->B,jac->C,jac->mat[1],&jac->schur);CHKERRQ(ierr);
/* set tabbing and options prefix of KSP inside the MatSchur */
ierr = MatSchurComplementGetKSP(jac->schur,&ksp);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)ksp,(PetscObject)pc,2);CHKERRQ(ierr);
ierr = PetscSNPrintf(schurprefix,sizeof(schurprefix),"%sfieldsplit_%s_",((PetscObject)pc)->prefix?((PetscObject)pc)->prefix:"",jac->head->splitname);CHKERRQ(ierr);
ierr = KSPSetOptionsPrefix(ksp,schurprefix);CHKERRQ(ierr);
ierr = MatSetFromOptions(jac->schur);CHKERRQ(ierr);
ierr = KSPCreate(((PetscObject)pc)->comm,&jac->kspschur);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)pc,(PetscObject)jac->kspschur);CHKERRQ(ierr);
ierr = PetscObjectIncrementTabLevel((PetscObject)jac->kspschur,(PetscObject)pc,1);CHKERRQ(ierr);
ierr = KSPSetOperators(jac->kspschur,jac->schur,FieldSplitSchurPre(jac),DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
if (jac->schurpre == PC_FIELDSPLIT_SCHUR_PRE_SELF) {
PC pc;
ierr = KSPGetPC(jac->kspschur,&pc);CHKERRQ(ierr);
ierr = PCSetType(pc,PCNONE);CHKERRQ(ierr);
/* Note: This is bad if there exist preconditioners for MATSCHURCOMPLEMENT */
}
ierr = PetscSNPrintf(schurprefix,sizeof(schurprefix),"%sfieldsplit_%s_",((PetscObject)pc)->prefix?((PetscObject)pc)->prefix:"",ilink->splitname);CHKERRQ(ierr);
ierr = KSPSetOptionsPrefix(jac->kspschur,schurprefix);CHKERRQ(ierr);
/* really want setfromoptions called in PCSetFromOptions_FieldSplit(), but it is not ready yet */
ierr = KSPSetFromOptions(jac->kspschur);CHKERRQ(ierr);
ierr = PetscMalloc2(2,Vec,&jac->x,2,Vec,&jac->y);CHKERRQ(ierr);
ierr = MatGetVecs(jac->pmat[0],&jac->x[0],&jac->y[0]);CHKERRQ(ierr);
ierr = MatGetVecs(jac->pmat[1],&jac->x[1],&jac->y[1]);CHKERRQ(ierr);
ilink = jac->head;
ilink->x = jac->x[0]; ilink->y = jac->y[0];
ilink = ilink->next;
ilink->x = jac->x[1]; ilink->y = jac->y[1];
}
#endif
} else {
/* Set up the individual SNESs */
blocks = mb->blocks;
i = 0;
while (blocks) {
/*TODO: Set these correctly */
/*ierr = SNESSetFunction(blocks->snes, blocks->x, func);CHKERRQ(ierr);*/
/*ierr = SNESSetJacobian(blocks->snes, blocks->x, jac);CHKERRQ(ierr);*/
ierr = VecDuplicate(blocks->snes->vec_sol, &blocks->x);CHKERRQ(ierr);
/* really want setfromoptions called in SNESSetFromOptions_Multiblock(), but it is not ready yet */
ierr = SNESSetFromOptions(blocks->snes);CHKERRQ(ierr);
ierr = SNESSetUp(blocks->snes);CHKERRQ(ierr);
blocks = blocks->next;
i++;
}
}
/* Compute scatter contexts needed by multiplicative versions and non-default splits */
if (!mb->blocks->sctx) {
Vec xtmp;
blocks = mb->blocks;
ierr = MatGetVecs(snes->jacobian_pre, &xtmp, PETSC_NULL);CHKERRQ(ierr);
while(blocks) {
ierr = VecScatterCreate(xtmp, blocks->is, blocks->x, PETSC_NULL, &blocks->sctx);CHKERRQ(ierr);
blocks = blocks->next;
}
ierr = VecDestroy(&xtmp);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode MatSetUpMultiply_MPIAIJ(Mat mat)
{
Mat_MPIAIJ *aij = (Mat_MPIAIJ*)mat->data;
Mat_SeqAIJ *B = (Mat_SeqAIJ*)(aij->B->data);
PetscErrorCode ierr;
PetscInt i,j,*aj = B->j,ec = 0,*garray;
IS from,to;
Vec gvec;
PetscBool useblockis;
#if defined (PETSC_USE_CTABLE)
PetscTable gid1_lid1;
PetscTablePosition tpos;
PetscInt gid,lid;
#else
PetscInt N = mat->cmap->N,*indices;
#endif
PetscFunctionBegin;
#if defined (PETSC_USE_CTABLE)
/* use a table */
ierr = PetscTableCreate(aij->B->rmap->n,mat->cmap->N+1,&gid1_lid1);CHKERRQ(ierr);
for (i=0; i<aij->B->rmap->n; i++) {
for (j=0; j<B->ilen[i]; j++) {
PetscInt data,gid1 = aj[B->i[i] + j] + 1;
ierr = PetscTableFind(gid1_lid1,gid1,&data);CHKERRQ(ierr);
if (!data) {
/* one based table */
ierr = PetscTableAdd(gid1_lid1,gid1,++ec,INSERT_VALUES);CHKERRQ(ierr);
}
}
}
/* form array of columns we need */
ierr = PetscMalloc((ec+1)*sizeof(PetscInt),&garray);CHKERRQ(ierr);
ierr = PetscTableGetHeadPosition(gid1_lid1,&tpos);CHKERRQ(ierr);
while (tpos) {
ierr = PetscTableGetNext(gid1_lid1,&tpos,&gid,&lid);CHKERRQ(ierr);
gid--;
lid--;
garray[lid] = gid;
}
ierr = PetscSortInt(ec,garray);CHKERRQ(ierr); /* sort, and rebuild */
ierr = PetscTableRemoveAll(gid1_lid1);CHKERRQ(ierr);
for (i=0; i<ec; i++) {
ierr = PetscTableAdd(gid1_lid1,garray[i]+1,i+1,INSERT_VALUES);CHKERRQ(ierr);
}
/* compact out the extra columns in B */
for (i=0; i<aij->B->rmap->n; i++) {
for (j=0; j<B->ilen[i]; j++) {
PetscInt gid1 = aj[B->i[i] + j] + 1;
ierr = PetscTableFind(gid1_lid1,gid1,&lid);CHKERRQ(ierr);
lid --;
aj[B->i[i] + j] = lid;
}
}
aij->B->cmap->n = aij->B->cmap->N = ec;
ierr = PetscLayoutSetUp((aij->B->cmap));CHKERRQ(ierr);
ierr = PetscTableDestroy(&gid1_lid1);CHKERRQ(ierr);
#else
/* Make an array as long as the number of columns */
/* mark those columns that are in aij->B */
ierr = PetscMalloc((N+1)*sizeof(PetscInt),&indices);CHKERRQ(ierr);
ierr = PetscMemzero(indices,N*sizeof(PetscInt));CHKERRQ(ierr);
for (i=0; i<aij->B->rmap->n; i++) {
for (j=0; j<B->ilen[i]; j++) {
if (!indices[aj[B->i[i] + j] ]) ec++;
indices[aj[B->i[i] + j] ] = 1;
}
}
/* form array of columns we need */
ierr = PetscMalloc((ec+1)*sizeof(PetscInt),&garray);CHKERRQ(ierr);
ec = 0;
for (i=0; i<N; i++) {
if (indices[i]) garray[ec++] = i;
}
/* make indices now point into garray */
for (i=0; i<ec; i++) {
indices[garray[i]] = i;
}
/* compact out the extra columns in B */
for (i=0; i<aij->B->rmap->n; i++) {
for (j=0; j<B->ilen[i]; j++) {
aj[B->i[i] + j] = indices[aj[B->i[i] + j]];
}
}
aij->B->cmap->n = aij->B->cmap->N = ec;
ierr = PetscLayoutSetUp((aij->B->cmap));CHKERRQ(ierr);
ierr = PetscFree(indices);CHKERRQ(ierr);
#endif
/* create local vector that is used to scatter into */
ierr = VecCreateSeq(PETSC_COMM_SELF,ec,&aij->lvec);CHKERRQ(ierr);
/* create two temporary Index sets for build scatter gather */
/* check for the special case where blocks are communicated for faster VecScatterXXX */
useblockis = PETSC_FALSE;
if (mat->cmap->bs > 1) {
PetscInt bs = mat->cmap->bs,ibs,ga;
if (!(ec % bs)) {
useblockis = PETSC_TRUE;
for (i=0; i<ec/bs; i++) {
if ((ga = garray[ibs = i*bs]) % bs) {
useblockis = PETSC_FALSE;
break;
}
for (j=1; j<bs; j++) {
if (garray[ibs+j] != ga+j) {
useblockis = PETSC_FALSE;
break;
}
}
if (!useblockis) break;
}
}
}
#if defined(PETSC_USE_DEBUG)
i = (PetscInt)useblockis;
ierr = MPI_Allreduce(&i,&j,1,MPIU_INT,MPI_MIN,((PetscObject)mat)->comm); CHKERRQ(ierr);
if(j!=i) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Use of blocked not consistant (I am usning blocked)");
#endif
if (useblockis) {
PetscInt *ga,bs = mat->cmap->bs,iec = ec/bs;
if(ec%bs)SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"ec=%D bs=%D",ec,bs);
ierr = PetscInfo(mat,"Using block index set to define scatter\n");
ierr = PetscMalloc(iec*sizeof(PetscInt),&ga);CHKERRQ(ierr);
for (i=0; i<iec; i++) ga[i] = garray[i*bs]/bs;
ierr = ISCreateBlock(((PetscObject)mat)->comm,bs,iec,ga,PETSC_OWN_POINTER,&from);CHKERRQ(ierr);
} else {
ierr = ISCreateGeneral(((PetscObject)mat)->comm,ec,garray,PETSC_COPY_VALUES,&from);CHKERRQ(ierr);
}
ierr = ISCreateStride(PETSC_COMM_SELF,ec,0,1,&to);CHKERRQ(ierr);
/* create temporary global vector to generate scatter context */
/* This does not allocate the array's memory so is efficient */
ierr = VecCreateMPIWithArray(((PetscObject)mat)->comm,1,mat->cmap->n,mat->cmap->N,PETSC_NULL,&gvec);CHKERRQ(ierr);
/* generate the scatter context */
ierr = VecScatterCreate(gvec,from,aij->lvec,to,&aij->Mvctx);CHKERRQ(ierr);
ierr = PetscLogObjectParent(mat,aij->Mvctx);CHKERRQ(ierr);
ierr = PetscLogObjectParent(mat,aij->lvec);CHKERRQ(ierr);
ierr = PetscLogObjectParent(mat,from);CHKERRQ(ierr);
ierr = PetscLogObjectParent(mat,to);CHKERRQ(ierr);
aij->garray = garray;
ierr = PetscLogObjectMemory(mat,(ec+1)*sizeof(PetscInt));CHKERRQ(ierr);
ierr = ISDestroy(&from);CHKERRQ(ierr);
ierr = ISDestroy(&to);CHKERRQ(ierr);
ierr = VecDestroy(&gvec);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
KSPComputeEigenvaluesExplicitly - Computes all of the eigenvalues of the
preconditioned operator using LAPACK.
Collective on KSP
Input Parameter:
+ ksp - iterative context obtained from KSPCreate()
- n - size of arrays r and c
Output Parameters:
+ r - real part of computed eigenvalues, provided by user with a dimension at least of n
- c - complex part of computed eigenvalues, provided by user with a dimension at least of n
Notes:
This approach is very slow but will generally provide accurate eigenvalue
estimates. This routine explicitly forms a dense matrix representing
the preconditioned operator, and thus will run only for relatively small
problems, say n < 500.
Many users may just want to use the monitoring routine
KSPMonitorSingularValue() (which can be set with option -ksp_monitor_singular_value)
to print the singular values at each iteration of the linear solve.
The preconditoner operator, rhs vector, solution vectors should be
set before this routine is called. i.e use KSPSetOperators(),KSPSolve() or
KSPSetOperators()
Level: advanced
.keywords: KSP, compute, eigenvalues, explicitly
.seealso: KSPComputeEigenvalues(), KSPMonitorSingularValue(), KSPComputeExtremeSingularValues(), KSPSetOperators(), KSPSolve()
@*/
PetscErrorCode KSPComputeEigenvaluesExplicitly(KSP ksp,PetscInt nmax,PetscReal r[],PetscReal c[])
{
Mat BA;
PetscErrorCode ierr;
PetscMPIInt size,rank;
MPI_Comm comm;
PetscScalar *array;
Mat A;
PetscInt m,row,nz,i,n,dummy;
const PetscInt *cols;
const PetscScalar *vals;
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)ksp,&comm);CHKERRQ(ierr);
ierr = KSPComputeExplicitOperator(ksp,&BA);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
ierr = MatGetSize(BA,&n,&n);CHKERRQ(ierr);
if (size > 1) { /* assemble matrix on first processor */
ierr = MatCreate(PetscObjectComm((PetscObject)ksp),&A);CHKERRQ(ierr);
if (!rank) {
ierr = MatSetSizes(A,n,n,n,n);CHKERRQ(ierr);
} else {
ierr = MatSetSizes(A,0,0,n,n);CHKERRQ(ierr);
}
ierr = MatSetType(A,MATMPIDENSE);CHKERRQ(ierr);
ierr = MatMPIDenseSetPreallocation(A,NULL);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)BA,(PetscObject)A);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(BA,&row,&dummy);CHKERRQ(ierr);
ierr = MatGetLocalSize(BA,&m,&dummy);CHKERRQ(ierr);
for (i=0; i<m; i++) {
ierr = MatGetRow(BA,row,&nz,&cols,&vals);CHKERRQ(ierr);
ierr = MatSetValues(A,1,&row,nz,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatRestoreRow(BA,row,&nz,&cols,&vals);CHKERRQ(ierr);
row++;
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatDenseGetArray(A,&array);CHKERRQ(ierr);
} else {
ierr = MatDenseGetArray(BA,&array);CHKERRQ(ierr);
}
#if defined(PETSC_HAVE_ESSL)
/* ESSL has a different calling sequence for dgeev() and zgeev() than standard LAPACK */
if (!rank) {
PetscScalar sdummy,*cwork;
PetscReal *work,*realpart;
PetscBLASInt clen,idummy,lwork,bn,zero = 0;
PetscInt *perm;
#if !defined(PETSC_USE_COMPLEX)
clen = n;
#else
clen = 2*n;
#endif
ierr = PetscMalloc1(clen,&cwork);CHKERRQ(ierr);
idummy = -1; /* unused */
ierr = PetscBLASIntCast(n,&bn);CHKERRQ(ierr);
lwork = 5*n;
ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
ierr = PetscMalloc1(n,&realpart);CHKERRQ(ierr);
ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
PetscStackCallBLAS("LAPACKgeev",LAPACKgeev_(&zero,array,&bn,cwork,&sdummy,&idummy,&idummy,&bn,work,&lwork));
ierr = PetscFPTrapPop();CHKERRQ(ierr);
ierr = PetscFree(work);CHKERRQ(ierr);
/* For now we stick with the convention of storing the real and imaginary
components of evalues separately. But is this what we really want? */
ierr = PetscMalloc1(n,&perm);CHKERRQ(ierr);
#if !defined(PETSC_USE_COMPLEX)
for (i=0; i<n; i++) {
realpart[i] = cwork[2*i];
perm[i] = i;
}
ierr = PetscSortRealWithPermutation(n,realpart,perm);CHKERRQ(ierr);
for (i=0; i<n; i++) {
r[i] = cwork[2*perm[i]];
c[i] = cwork[2*perm[i]+1];
}
#else
for (i=0; i<n; i++) {
realpart[i] = PetscRealPart(cwork[i]);
perm[i] = i;
}
ierr = PetscSortRealWithPermutation(n,realpart,perm);CHKERRQ(ierr);
for (i=0; i<n; i++) {
r[i] = PetscRealPart(cwork[perm[i]]);
c[i] = PetscImaginaryPart(cwork[perm[i]]);
}
#endif
ierr = PetscFree(perm);CHKERRQ(ierr);
ierr = PetscFree(realpart);CHKERRQ(ierr);
ierr = PetscFree(cwork);CHKERRQ(ierr);
}
#elif !defined(PETSC_USE_COMPLEX)
if (!rank) {
PetscScalar *work;
PetscReal *realpart,*imagpart;
PetscBLASInt idummy,lwork;
PetscInt *perm;
idummy = n;
lwork = 5*n;
ierr = PetscMalloc2(n,&realpart,n,&imagpart);CHKERRQ(ierr);
ierr = PetscMalloc1(5*n,&work);CHKERRQ(ierr);
#if defined(PETSC_MISSING_LAPACK_GEEV)
SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"GEEV - Lapack routine is unavailable\nNot able to provide eigen values.");
#else
{
PetscBLASInt lierr;
PetscScalar sdummy;
PetscBLASInt bn;
ierr = PetscBLASIntCast(n,&bn);CHKERRQ(ierr);
ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
PetscStackCallBLAS("LAPACKgeev",LAPACKgeev_("N","N",&bn,array,&bn,realpart,imagpart,&sdummy,&idummy,&sdummy,&idummy,work,&lwork,&lierr));
if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in LAPACK routine %d",(int)lierr);
ierr = PetscFPTrapPop();CHKERRQ(ierr);
}
#endif
ierr = PetscFree(work);CHKERRQ(ierr);
ierr = PetscMalloc1(n,&perm);CHKERRQ(ierr);
for (i=0; i<n; i++) perm[i] = i;
ierr = PetscSortRealWithPermutation(n,realpart,perm);CHKERRQ(ierr);
for (i=0; i<n; i++) {
r[i] = realpart[perm[i]];
c[i] = imagpart[perm[i]];
}
ierr = PetscFree(perm);CHKERRQ(ierr);
ierr = PetscFree2(realpart,imagpart);CHKERRQ(ierr);
}
#else
if (!rank) {
PetscScalar *work,*eigs;
PetscReal *rwork;
PetscBLASInt idummy,lwork;
PetscInt *perm;
idummy = n;
lwork = 5*n;
ierr = PetscMalloc1(5*n,&work);CHKERRQ(ierr);
ierr = PetscMalloc1(2*n,&rwork);CHKERRQ(ierr);
ierr = PetscMalloc1(n,&eigs);CHKERRQ(ierr);
#if defined(PETSC_MISSING_LAPACK_GEEV)
SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"GEEV - Lapack routine is unavailable\nNot able to provide eigen values.");
#else
{
PetscBLASInt lierr;
PetscScalar sdummy;
PetscBLASInt nb;
ierr = PetscBLASIntCast(n,&nb);CHKERRQ(ierr);
ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
PetscStackCallBLAS("LAPACKgeev",LAPACKgeev_("N","N",&nb,array,&nb,eigs,&sdummy,&idummy,&sdummy,&idummy,work,&lwork,rwork,&lierr));
if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in LAPACK routine %d",(int)lierr);
ierr = PetscFPTrapPop();CHKERRQ(ierr);
}
#endif
ierr = PetscFree(work);CHKERRQ(ierr);
ierr = PetscFree(rwork);CHKERRQ(ierr);
ierr = PetscMalloc1(n,&perm);CHKERRQ(ierr);
for (i=0; i<n; i++) perm[i] = i;
for (i=0; i<n; i++) r[i] = PetscRealPart(eigs[i]);
ierr = PetscSortRealWithPermutation(n,r,perm);CHKERRQ(ierr);
for (i=0; i<n; i++) {
r[i] = PetscRealPart(eigs[perm[i]]);
c[i] = PetscImaginaryPart(eigs[perm[i]]);
}
ierr = PetscFree(perm);CHKERRQ(ierr);
ierr = PetscFree(eigs);CHKERRQ(ierr);
}
#endif
if (size > 1) {
ierr = MatDenseRestoreArray(A,&array);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
} else {
ierr = MatDenseRestoreArray(BA,&array);CHKERRQ(ierr);
}
ierr = MatDestroy(&BA);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@
NEPSetUp - Sets up all the internal data structures necessary for the
execution of the NEP solver.
Collective on NEP
Input Parameter:
. nep - solver context
Notes:
This function need not be called explicitly in most cases, since NEPSolve()
calls it. It can be useful when one wants to measure the set-up time
separately from the solve time.
Level: advanced
.seealso: NEPCreate(), NEPSolve(), NEPDestroy()
@*/
PetscErrorCode NEPSetUp(NEP nep)
{
PetscErrorCode ierr;
PetscInt k;
SlepcSC sc;
Mat T;
PetscFunctionBegin;
PetscValidHeaderSpecific(nep,NEP_CLASSID,1);
if (nep->state) PetscFunctionReturn(0);
ierr = PetscLogEventBegin(NEP_SetUp,nep,0,0,0);CHKERRQ(ierr);
/* reset the convergence flag from the previous solves */
nep->reason = NEP_CONVERGED_ITERATING;
/* set default solver type (NEPSetFromOptions was not called) */
if (!((PetscObject)nep)->type_name) {
ierr = NEPSetType(nep,NEPRII);CHKERRQ(ierr);
}
if (!nep->ds) { ierr = NEPGetDS(nep,&nep->ds);CHKERRQ(ierr); }
ierr = DSReset(nep->ds);CHKERRQ(ierr);
if (!nep->rg) { ierr = NEPGetRG(nep,&nep->rg);CHKERRQ(ierr); }
if (!((PetscObject)nep->rg)->type_name) {
ierr = RGSetType(nep->rg,RGINTERVAL);CHKERRQ(ierr);
}
if (!((PetscObject)nep->rand)->type_name) {
ierr = PetscRandomSetFromOptions(nep->rand);CHKERRQ(ierr);
}
if (!nep->ksp) {
ierr = NEPGetKSP(nep,&nep->ksp);CHKERRQ(ierr);
}
/* by default, compute eigenvalues close to target */
/* nep->target should contain the initial guess for the eigenvalue */
if (!nep->which) nep->which = NEP_TARGET_MAGNITUDE;
/* set problem dimensions */
if (nep->split) {
ierr = MatDuplicate(nep->A[0],MAT_DO_NOT_COPY_VALUES,&nep->function);CHKERRQ(ierr);
ierr = MatDuplicate(nep->A[0],MAT_DO_NOT_COPY_VALUES,&nep->jacobian);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)nep,(PetscObject)nep->function);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)nep,(PetscObject)nep->jacobian);CHKERRQ(ierr);
ierr = MatGetSize(nep->A[0],&nep->n,NULL);CHKERRQ(ierr);
ierr = MatGetLocalSize(nep->A[0],&nep->nloc,NULL);CHKERRQ(ierr);
} else {
ierr = NEPGetFunction(nep,&T,NULL,NULL,NULL);CHKERRQ(ierr);
ierr = MatGetSize(T,&nep->n,NULL);CHKERRQ(ierr);
ierr = MatGetLocalSize(T,&nep->nloc,NULL);CHKERRQ(ierr);
}
/* call specific solver setup */
ierr = (*nep->ops->setup)(nep);CHKERRQ(ierr);
/* set tolerances if not yet set */
if (nep->abstol==PETSC_DEFAULT) nep->abstol = 1e-50;
if (nep->rtol==PETSC_DEFAULT) nep->rtol = 100*SLEPC_DEFAULT_TOL;
if (nep->stol==PETSC_DEFAULT) nep->stol = SLEPC_DEFAULT_TOL;
nep->ktol = 0.1;
nep->nfuncs = 0;
if (nep->refine) {
if (nep->reftol==PETSC_DEFAULT) nep->reftol = SLEPC_DEFAULT_TOL;
if (nep->rits==PETSC_DEFAULT) nep->rits = (nep->refine==NEP_REFINE_SIMPLE)? 10: 1;
}
/* fill sorting criterion context */
switch (nep->which) {
case NEP_LARGEST_MAGNITUDE:
nep->sc->comparison = SlepcCompareLargestMagnitude;
nep->sc->comparisonctx = NULL;
break;
case NEP_SMALLEST_MAGNITUDE:
nep->sc->comparison = SlepcCompareSmallestMagnitude;
nep->sc->comparisonctx = NULL;
break;
case NEP_LARGEST_REAL:
nep->sc->comparison = SlepcCompareLargestReal;
nep->sc->comparisonctx = NULL;
break;
case NEP_SMALLEST_REAL:
nep->sc->comparison = SlepcCompareSmallestReal;
nep->sc->comparisonctx = NULL;
break;
case NEP_LARGEST_IMAGINARY:
nep->sc->comparison = SlepcCompareLargestImaginary;
nep->sc->comparisonctx = NULL;
break;
case NEP_SMALLEST_IMAGINARY:
nep->sc->comparison = SlepcCompareSmallestImaginary;
nep->sc->comparisonctx = NULL;
break;
case NEP_TARGET_MAGNITUDE:
nep->sc->comparison = SlepcCompareTargetMagnitude;
nep->sc->comparisonctx = &nep->target;
break;
case NEP_TARGET_REAL:
nep->sc->comparison = SlepcCompareTargetReal;
nep->sc->comparisonctx = &nep->target;
break;
case NEP_TARGET_IMAGINARY:
nep->sc->comparison = SlepcCompareTargetImaginary;
nep->sc->comparisonctx = &nep->target;
break;
}
nep->sc->map = NULL;
nep->sc->mapobj = NULL;
/* fill sorting criterion for DS */
ierr = DSGetSlepcSC(nep->ds,&sc);CHKERRQ(ierr);
sc->comparison = nep->sc->comparison;
sc->comparisonctx = nep->sc->comparisonctx;
sc->map = NULL;
sc->mapobj = NULL;
if (nep->ncv > nep->n) SETERRQ(PetscObjectComm((PetscObject)nep),PETSC_ERR_ARG_OUTOFRANGE,"ncv must be the problem size at most");
if (nep->nev > nep->ncv) SETERRQ(PetscObjectComm((PetscObject)nep),PETSC_ERR_ARG_OUTOFRANGE,"nev bigger than ncv");
/* process initial vectors */
if (nep->nini<0) {
k = -nep->nini;
if (k>nep->ncv) SETERRQ(PetscObjectComm((PetscObject)nep),1,"The number of initial vectors is larger than ncv");
ierr = BVInsertVecs(nep->V,0,&k,nep->IS,PETSC_TRUE);CHKERRQ(ierr);
ierr = SlepcBasisDestroy_Private(&nep->nini,&nep->IS);CHKERRQ(ierr);
nep->nini = k;
}
ierr = PetscLogEventEnd(NEP_SetUp,nep,0,0,0);CHKERRQ(ierr);
nep->state = NEP_STATE_SETUP;
PetscFunctionReturn(0);
}