/*@
MatColoringApply - Apply the coloring to the matrix, producing index
sets corresponding to a number of independent sets in the induced
graph.
Collective on MatColoring
Input Parameters:
. mc - the MatColoring context
Output Parameter:
. coloring - the ISColoring instance containing the coloring
Level: beginner
.keywords: Coloring, Apply
.seealso: MatColoring, MatColoringCreate()
@*/
PetscErrorCode MatColoringApply(MatColoring mc,ISColoring *coloring)
{
PetscErrorCode ierr;
PetscBool flg;
PetscViewerFormat format;
PetscViewer viewer;
PetscInt nc,ncolors;
PetscFunctionBegin;
PetscValidHeaderSpecific(mc,MAT_COLORING_CLASSID,1);
ierr = PetscLogEventBegin(Mat_Coloring_Apply,mc,0,0,0);CHKERRQ(ierr);
ierr = (*mc->ops->apply)(mc,coloring);CHKERRQ(ierr);
ierr = PetscLogEventEnd(Mat_Coloring_Apply,mc,0,0,0);CHKERRQ(ierr);
/* valid */
if (mc->valid) {
ierr = MatColoringTestValid(mc,*coloring);CHKERRQ(ierr);
}
/* view */
ierr = PetscOptionsGetViewer(PetscObjectComm((PetscObject)mc),((PetscObject)mc)->prefix,"-mat_coloring_view",&viewer,&format,&flg);CHKERRQ(ierr);
if (flg && !PetscPreLoadingOn) {
ierr = PetscViewerPushFormat(viewer,format);CHKERRQ(ierr);
ierr = MatColoringView(mc,viewer);CHKERRQ(ierr);
ierr = MatGetSize(mc->mat,NULL,&nc);CHKERRQ(ierr);
ierr = ISColoringGetIS(*coloring,&ncolors,NULL);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer," Number of colors %d\n",ncolors);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer," Number of total columns %d\n",nc);CHKERRQ(ierr);
if (nc <= 1000) {ierr = ISColoringView(*coloring,viewer);CHKERRQ(ierr);}
ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*@C
ISColoringView - Views a coloring context.
Collective on ISColoring
Input Parameters:
+ iscoloring - the coloring context
- viewer - the viewer
Level: advanced
.seealso: ISColoringDestroy(), ISColoringGetIS(), MatColoring
@*/
PetscErrorCode ISColoringView(ISColoring iscoloring,PetscViewer viewer)
{
PetscInt i;
PetscErrorCode ierr;
PetscBool iascii;
IS *is;
PetscFunctionBegin;
PetscValidPointer(iscoloring,1);
if (!viewer) {
ierr = PetscViewerASCIIGetStdout(iscoloring->comm,&viewer);CHKERRQ(ierr);
}
PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,2);
ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr);
if (iascii) {
MPI_Comm comm;
PetscMPIInt rank;
ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
ierr = PetscViewerASCIISynchronizedAllow(viewer,PETSC_TRUE);CHKERRQ(ierr);
ierr = PetscViewerASCIISynchronizedPrintf(viewer,"[%d] Number of colors %d\n",rank,iscoloring->n);CHKERRQ(ierr);
ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIISynchronizedAllow(viewer,PETSC_FALSE);CHKERRQ(ierr);
} else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Viewer type %s not supported for ISColoring",((PetscObject)viewer)->type_name);
ierr = ISColoringGetIS(iscoloring,PETSC_IGNORE,&is);CHKERRQ(ierr);
for (i=0; i<iscoloring->n; i++) {
ierr = ISView(iscoloring->is[i],viewer);CHKERRQ(ierr);
}
ierr = ISColoringRestoreIS(iscoloring,&is);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
ISColoringView - Views a coloring context.
Collective on ISColoring
Input Parameters:
+ iscoloring - the coloring context
- viewer - the viewer
Level: advanced
.seealso: ISColoringDestroy(), ISColoringGetIS(), MatColoring
@*/
PetscErrorCode ISColoringView(ISColoring iscoloring,PetscViewer viewer)
{
PetscInt i;
PetscErrorCode ierr;
PetscBool iascii;
IS *is;
PetscFunctionBegin;
PetscValidPointer(iscoloring,1);
if (!viewer) {
ierr = PetscViewerASCIIGetStdout(iscoloring->comm,&viewer);CHKERRQ(ierr);
}
PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,2);
ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr);
if (iascii) {
MPI_Comm comm;
PetscMPIInt size,rank;
ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"ISColoring Object: %d MPI processes\n",size);CHKERRQ(ierr);
ierr = PetscViewerASCIIPushSynchronized(viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIISynchronizedPrintf(viewer,"[%d] Number of colors %d\n",rank,iscoloring->n);CHKERRQ(ierr);
ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPopSynchronized(viewer);CHKERRQ(ierr);
}
ierr = ISColoringGetIS(iscoloring,PETSC_IGNORE,&is);CHKERRQ(ierr);
for (i=0; i<iscoloring->n; i++) {
ierr = ISView(iscoloring->is[i],viewer);CHKERRQ(ierr);
}
ierr = ISColoringRestoreIS(iscoloring,&is);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode MatFDColoringSetUp_MPIXAIJ(Mat mat,ISColoring iscoloring,MatFDColoring c)
{
PetscErrorCode ierr;
PetscMPIInt size,*ncolsonproc,*disp,nn;
PetscInt i,n,nrows,nrows_i,j,k,m,ncols,col,*rowhit,cstart,cend,colb;
const PetscInt *is,*A_ci,*A_cj,*B_ci,*B_cj,*row=NULL,*ltog=NULL;
PetscInt nis=iscoloring->n,nctot,*cols;
IS *isa;
ISLocalToGlobalMapping map=mat->cmap->mapping;
PetscInt ctype=c->ctype,*spidxA,*spidxB,nz,bs,bs2,spidx;
Mat A,B;
PetscScalar *A_val,*B_val,**valaddrhit;
MatEntry *Jentry;
MatEntry2 *Jentry2;
PetscBool isBAIJ;
PetscInt bcols=c->bcols;
#if defined(PETSC_USE_CTABLE)
PetscTable colmap=NULL;
#else
PetscInt *colmap=NULL; /* local col number of off-diag col */
#endif
PetscFunctionBegin;
if (ctype == IS_COLORING_GHOSTED) {
if (!map) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_INCOMP,"When using ghosted differencing matrix must have local to global mapping provided with MatSetLocalToGlobalMapping");
ierr = ISLocalToGlobalMappingGetIndices(map,<og);CHKERRQ(ierr);
}
ierr = MatGetBlockSize(mat,&bs);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)mat,MATMPIBAIJ,&isBAIJ);CHKERRQ(ierr);
if (isBAIJ) {
Mat_MPIBAIJ *baij=(Mat_MPIBAIJ*)mat->data;
Mat_SeqBAIJ *spA,*spB;
A = baij->A; spA = (Mat_SeqBAIJ*)A->data; A_val = spA->a;
B = baij->B; spB = (Mat_SeqBAIJ*)B->data; B_val = spB->a;
nz = spA->nz + spB->nz; /* total nonzero entries of mat */
if (!baij->colmap) {
ierr = MatCreateColmap_MPIBAIJ_Private(mat);CHKERRQ(ierr);
colmap = baij->colmap;
}
ierr = MatGetColumnIJ_SeqBAIJ_Color(A,0,PETSC_FALSE,PETSC_FALSE,&ncols,&A_ci,&A_cj,&spidxA,NULL);CHKERRQ(ierr);
ierr = MatGetColumnIJ_SeqBAIJ_Color(B,0,PETSC_FALSE,PETSC_FALSE,&ncols,&B_ci,&B_cj,&spidxB,NULL);CHKERRQ(ierr);
if (ctype == IS_COLORING_GLOBAL && c->htype[0] == 'd') { /* create vscale for storing dx */
PetscInt *garray;
ierr = PetscMalloc1(B->cmap->n,&garray);CHKERRQ(ierr);
for (i=0; i<baij->B->cmap->n/bs; i++) {
for (j=0; j<bs; j++) {
garray[i*bs+j] = bs*baij->garray[i]+j;
}
}
ierr = VecCreateGhost(PetscObjectComm((PetscObject)mat),mat->cmap->n,PETSC_DETERMINE,B->cmap->n,garray,&c->vscale);CHKERRQ(ierr);
ierr = PetscFree(garray);CHKERRQ(ierr);
}
} else {
Mat_MPIAIJ *aij=(Mat_MPIAIJ*)mat->data;
Mat_SeqAIJ *spA,*spB;
A = aij->A; spA = (Mat_SeqAIJ*)A->data; A_val = spA->a;
B = aij->B; spB = (Mat_SeqAIJ*)B->data; B_val = spB->a;
nz = spA->nz + spB->nz; /* total nonzero entries of mat */
if (!aij->colmap) {
/* Allow access to data structures of local part of matrix
- creates aij->colmap which maps global column number to local number in part B */
ierr = MatCreateColmap_MPIAIJ_Private(mat);CHKERRQ(ierr);
colmap = aij->colmap;
}
ierr = MatGetColumnIJ_SeqAIJ_Color(A,0,PETSC_FALSE,PETSC_FALSE,&ncols,&A_ci,&A_cj,&spidxA,NULL);CHKERRQ(ierr);
ierr = MatGetColumnIJ_SeqAIJ_Color(B,0,PETSC_FALSE,PETSC_FALSE,&ncols,&B_ci,&B_cj,&spidxB,NULL);CHKERRQ(ierr);
bs = 1; /* only bs=1 is supported for non MPIBAIJ matrix */
if (ctype == IS_COLORING_GLOBAL && c->htype[0] == 'd') { /* create vscale for storing dx */
ierr = VecCreateGhost(PetscObjectComm((PetscObject)mat),mat->cmap->n,PETSC_DETERMINE,B->cmap->n,aij->garray,&c->vscale);CHKERRQ(ierr);
}
}
m = mat->rmap->n/bs;
cstart = mat->cmap->rstart/bs;
cend = mat->cmap->rend/bs;
ierr = PetscMalloc1(nis,&c->ncolumns);CHKERRQ(ierr);
ierr = PetscMalloc1(nis,&c->columns);CHKERRQ(ierr);
ierr = PetscMalloc1(nis,&c->nrows);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)c,3*nis*sizeof(PetscInt));CHKERRQ(ierr);
if (c->htype[0] == 'd') {
ierr = PetscMalloc1(nz,&Jentry);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)c,nz*sizeof(MatEntry));CHKERRQ(ierr);
c->matentry = Jentry;
} else if (c->htype[0] == 'w') {
ierr = PetscMalloc1(nz,&Jentry2);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)c,nz*sizeof(MatEntry2));CHKERRQ(ierr);
c->matentry2 = Jentry2;
} else SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"htype is not supported");
ierr = PetscMalloc2(m+1,&rowhit,m+1,&valaddrhit);CHKERRQ(ierr);
nz = 0;
ierr = ISColoringGetIS(iscoloring,PETSC_IGNORE,&isa);CHKERRQ(ierr);
for (i=0; i<nis; i++) { /* for each local color */
ierr = ISGetLocalSize(isa[i],&n);CHKERRQ(ierr);
ierr = ISGetIndices(isa[i],&is);CHKERRQ(ierr);
c->ncolumns[i] = n; /* local number of columns of this color on this process */
if (n) {
ierr = PetscMalloc1(n,&c->columns[i]);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)c,n*sizeof(PetscInt));CHKERRQ(ierr);
ierr = PetscMemcpy(c->columns[i],is,n*sizeof(PetscInt));CHKERRQ(ierr);
} else {
c->columns[i] = 0;
}
if (ctype == IS_COLORING_GLOBAL) {
/* Determine nctot, the total (parallel) number of columns of this color */
ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
ierr = PetscMalloc2(size,&ncolsonproc,size,&disp);CHKERRQ(ierr);
/* ncolsonproc[j]: local ncolumns on proc[j] of this color */
ierr = PetscMPIIntCast(n,&nn);CHKERRQ(ierr);
ierr = MPI_Allgather(&nn,1,MPI_INT,ncolsonproc,1,MPI_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
nctot = 0; for (j=0; j<size; j++) nctot += ncolsonproc[j];
if (!nctot) {
ierr = PetscInfo(mat,"Coloring of matrix has some unneeded colors with no corresponding rows\n");CHKERRQ(ierr);
}
disp[0] = 0;
for (j=1; j<size; j++) {
disp[j] = disp[j-1] + ncolsonproc[j-1];
}
/* Get cols, the complete list of columns for this color on each process */
ierr = PetscMalloc1(nctot+1,&cols);CHKERRQ(ierr);
ierr = MPI_Allgatherv((void*)is,n,MPIU_INT,cols,ncolsonproc,disp,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
ierr = PetscFree2(ncolsonproc,disp);CHKERRQ(ierr);
} else if (ctype == IS_COLORING_GHOSTED) {
/* Determine local number of columns of this color on this process, including ghost points */
nctot = n;
ierr = PetscMalloc1(nctot+1,&cols);CHKERRQ(ierr);
ierr = PetscMemcpy(cols,is,n*sizeof(PetscInt));CHKERRQ(ierr);
} else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not provided for this MatFDColoring type");
/* Mark all rows affect by these columns */
ierr = PetscMemzero(rowhit,m*sizeof(PetscInt));CHKERRQ(ierr);
bs2 = bs*bs;
nrows_i = 0;
for (j=0; j<nctot; j++) { /* loop over columns*/
if (ctype == IS_COLORING_GHOSTED) {
col = ltog[cols[j]];
} else {
col = cols[j];
}
if (col >= cstart && col < cend) { /* column is in A, diagonal block of mat */
row = A_cj + A_ci[col-cstart];
nrows = A_ci[col-cstart+1] - A_ci[col-cstart];
nrows_i += nrows;
/* loop over columns of A marking them in rowhit */
for (k=0; k<nrows; k++) {
/* set valaddrhit for part A */
spidx = bs2*spidxA[A_ci[col-cstart] + k];
valaddrhit[*row] = &A_val[spidx];
rowhit[*row++] = col - cstart + 1; /* local column index */
}
} else { /* column is in B, off-diagonal block of mat */
#if defined(PETSC_USE_CTABLE)
ierr = PetscTableFind(colmap,col+1,&colb);CHKERRQ(ierr);
colb--;
#else
colb = colmap[col] - 1; /* local column index */
#endif
if (colb == -1) {
nrows = 0;
} else {
colb = colb/bs;
row = B_cj + B_ci[colb];
nrows = B_ci[colb+1] - B_ci[colb];
}
nrows_i += nrows;
/* loop over columns of B marking them in rowhit */
for (k=0; k<nrows; k++) {
/* set valaddrhit for part B */
spidx = bs2*spidxB[B_ci[colb] + k];
valaddrhit[*row] = &B_val[spidx];
rowhit[*row++] = colb + 1 + cend - cstart; /* local column index */
}
}
}
c->nrows[i] = nrows_i;
if (c->htype[0] == 'd') {
for (j=0; j<m; j++) {
if (rowhit[j]) {
Jentry[nz].row = j; /* local row index */
Jentry[nz].col = rowhit[j] - 1; /* local column index */
Jentry[nz].valaddr = valaddrhit[j]; /* address of mat value for this entry */
nz++;
}
}
} else { /* c->htype == 'wp' */
for (j=0; j<m; j++) {
if (rowhit[j]) {
Jentry2[nz].row = j; /* local row index */
Jentry2[nz].valaddr = valaddrhit[j]; /* address of mat value for this entry */
nz++;
}
}
}
ierr = PetscFree(cols);CHKERRQ(ierr);
}
if (bcols > 1) { /* reorder Jentry for faster MatFDColoringApply() */
ierr = MatFDColoringSetUpBlocked_AIJ_Private(mat,c,nz);CHKERRQ(ierr);
}
if (isBAIJ) {
ierr = MatRestoreColumnIJ_SeqBAIJ_Color(A,0,PETSC_FALSE,PETSC_FALSE,&ncols,&A_ci,&A_cj,&spidxA,NULL);CHKERRQ(ierr);
ierr = MatRestoreColumnIJ_SeqBAIJ_Color(B,0,PETSC_FALSE,PETSC_FALSE,&ncols,&B_ci,&B_cj,&spidxB,NULL);CHKERRQ(ierr);
ierr = PetscMalloc1(bs*mat->rmap->n,&c->dy);CHKERRQ(ierr);
} else {
ierr = MatRestoreColumnIJ_SeqAIJ_Color(A,0,PETSC_FALSE,PETSC_FALSE,&ncols,&A_ci,&A_cj,&spidxA,NULL);CHKERRQ(ierr);
ierr = MatRestoreColumnIJ_SeqAIJ_Color(B,0,PETSC_FALSE,PETSC_FALSE,&ncols,&B_ci,&B_cj,&spidxB,NULL);CHKERRQ(ierr);
}
ierr = ISColoringRestoreIS(iscoloring,&isa);CHKERRQ(ierr);
ierr = PetscFree2(rowhit,valaddrhit);CHKERRQ(ierr);
if (ctype == IS_COLORING_GHOSTED) {
ierr = ISLocalToGlobalMappingRestoreIndices(map,<og);CHKERRQ(ierr);
}
ierr = PetscInfo3(c,"ncolors %D, brows %D and bcols %D are used.\n",c->ncolors,c->brows,c->bcols);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PETSC_EXTERN PetscErrorCode SNESComputeNGSDefaultSecant(SNES snes,Vec X,Vec B,void *ctx)
{
PetscErrorCode ierr;
SNES_NGS *gs = (SNES_NGS*)snes->data;
PetscInt i,j,k,ncolors;
DM dm;
PetscBool flg;
ISColoring coloring = gs->coloring;
MatColoring mc;
Vec W,G,F;
PetscScalar h=gs->h;
IS *coloris;
PetscScalar f,g,x,w,d;
PetscReal dxt,xt,ft,ft1=0;
const PetscInt *idx;
PetscInt size,s;
PetscReal atol,rtol,stol;
PetscInt its;
PetscErrorCode (*func)(SNES,Vec,Vec,void*);
void *fctx;
PetscBool mat = gs->secant_mat,equal,isdone,alldone;
PetscScalar *xa,*fa,*wa,*ga;
PetscFunctionBegin;
if (snes->nwork < 3) {
ierr = SNESSetWorkVecs(snes,3);CHKERRQ(ierr);
}
W = snes->work[0];
G = snes->work[1];
F = snes->work[2];
ierr = VecGetOwnershipRange(X,&s,NULL);CHKERRQ(ierr);
ierr = SNESNGSGetTolerances(snes,&atol,&rtol,&stol,&its);CHKERRQ(ierr);
ierr = SNESGetDM(snes,&dm);CHKERRQ(ierr);
ierr = SNESGetFunction(snes,NULL,&func,&fctx);CHKERRQ(ierr);
if (!coloring) {
/* create the coloring */
ierr = DMHasColoring(dm,&flg);CHKERRQ(ierr);
if (flg && !mat) {
ierr = DMCreateColoring(dm,IS_COLORING_GLOBAL,&coloring);CHKERRQ(ierr);
} else {
if (!snes->jacobian) {ierr = SNESSetUpMatrices(snes);CHKERRQ(ierr);}
ierr = MatColoringCreate(snes->jacobian,&mc);CHKERRQ(ierr);
ierr = MatColoringSetDistance(mc,1);CHKERRQ(ierr);
ierr = MatColoringSetFromOptions(mc);CHKERRQ(ierr);
ierr = MatColoringApply(mc,&coloring);CHKERRQ(ierr);
ierr = MatColoringDestroy(&mc);CHKERRQ(ierr);
}
gs->coloring = coloring;
}
ierr = ISColoringGetIS(coloring,&ncolors,&coloris);CHKERRQ(ierr);
ierr = VecEqual(X,snes->vec_sol,&equal);CHKERRQ(ierr);
if (equal && snes->normschedule == SNES_NORM_ALWAYS) {
/* assume that the function is already computed */
ierr = VecCopy(snes->vec_func,F);CHKERRQ(ierr);
} else {
ierr = PetscLogEventBegin(SNES_NGSFuncEval,snes,X,B,0);CHKERRQ(ierr);
ierr = (*func)(snes,X,F,fctx);CHKERRQ(ierr);
ierr = PetscLogEventEnd(SNES_NGSFuncEval,snes,X,B,0);CHKERRQ(ierr);
if (B) {ierr = VecAXPY(F,-1.0,B);CHKERRQ(ierr);}
}
ierr = VecGetArray(X,&xa);CHKERRQ(ierr);
ierr = VecGetArray(F,&fa);CHKERRQ(ierr);
ierr = VecGetArray(G,&ga);CHKERRQ(ierr);
ierr = VecGetArray(W,&wa);CHKERRQ(ierr);
for (i=0;i<ncolors;i++) {
ierr = ISGetIndices(coloris[i],&idx);CHKERRQ(ierr);
ierr = ISGetLocalSize(coloris[i],&size);CHKERRQ(ierr);
ierr = VecCopy(X,W);CHKERRQ(ierr);
for (j=0;j<size;j++) {
wa[idx[j]-s] += h;
}
ierr = PetscLogEventBegin(SNES_NGSFuncEval,snes,X,B,0);CHKERRQ(ierr);
ierr = (*func)(snes,W,G,fctx);CHKERRQ(ierr);
ierr = PetscLogEventEnd(SNES_NGSFuncEval,snes,X,B,0);CHKERRQ(ierr);
if (B) {ierr = VecAXPY(G,-1.0,B);CHKERRQ(ierr);}
for (k=0;k<its;k++) {
dxt = 0.;
xt = 0.;
ft = 0.;
for (j=0;j<size;j++) {
f = fa[idx[j]-s];
x = xa[idx[j]-s];
g = ga[idx[j]-s];
w = wa[idx[j]-s];
if (PetscAbsScalar(g-f) > atol) {
/* This is equivalent to d = x - (h*f) / PetscRealPart(g-f) */
d = (x*g-w*f) / PetscRealPart(g-f);
} else {
d = x;
}
dxt += PetscRealPart(PetscSqr(d-x));
xt += PetscRealPart(PetscSqr(x));
ft += PetscRealPart(PetscSqr(f));
xa[idx[j]-s] = d;
}
if (k == 0) ft1 = PetscSqrtReal(ft);
if (k<its-1) {
isdone = PETSC_FALSE;
if (stol*PetscSqrtReal(xt) > PetscSqrtReal(dxt)) isdone = PETSC_TRUE;
if (PetscSqrtReal(ft) < atol) isdone = PETSC_TRUE;
if (rtol*ft1 > PetscSqrtReal(ft)) isdone = PETSC_TRUE;
ierr = MPIU_Allreduce(&isdone,&alldone,1,MPIU_BOOL,MPI_BAND,PetscObjectComm((PetscObject)snes));CHKERRQ(ierr);
if (alldone) break;
}
if (i < ncolors-1 || k < its-1) {
ierr = PetscLogEventBegin(SNES_NGSFuncEval,snes,X,B,0);CHKERRQ(ierr);
ierr = (*func)(snes,X,F,fctx);CHKERRQ(ierr);
ierr = PetscLogEventEnd(SNES_NGSFuncEval,snes,X,B,0);CHKERRQ(ierr);
if (B) {ierr = VecAXPY(F,-1.0,B);CHKERRQ(ierr);}
}
if (k<its-1) {
ierr = VecSwap(X,W);CHKERRQ(ierr);
ierr = VecSwap(F,G);CHKERRQ(ierr);
}
}
}
ierr = VecRestoreArray(X,&xa);CHKERRQ(ierr);
ierr = VecRestoreArray(F,&fa);CHKERRQ(ierr);
ierr = VecRestoreArray(G,&ga);CHKERRQ(ierr);
ierr = VecRestoreArray(W,&wa);CHKERRQ(ierr);
ierr = ISColoringRestoreIS(coloring,&coloris);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
#if defined(PETSC_HAVE_FORTRAN_CAPS)
#define iscoloringgetisf90_ ISCOLORINGGETISF90
#define iscoloringrestoreisf90_ ISCOLORINGRESTOREISF90
#elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
#define iscoloringgetisf90_ iscoloringgetisf90
#define iscoloringrestoreisf90_ iscoloringrestoreisf90
#endif
PETSC_EXTERN void PETSC_STDCALL iscoloringgetisf90_(ISColoring *iscoloring,PetscInt *n,F90Array1d *ptr,int *__ierr PETSC_F90_2PTR_PROTO(ptrd))
{
IS *lis;
PetscFortranAddr *newisint;
int i;
*__ierr = ISColoringGetIS(*iscoloring,n,&lis); if (*__ierr) return;
*__ierr = PetscMalloc1(*n,&newisint); if (*__ierr) return;
for (i=0; i<*n; i++) newisint[i] = (PetscFortranAddr)lis[i];
*__ierr = F90Array1dCreate(newisint,PETSC_FORTRANADDR,1,*n,ptr PETSC_F90_2PTR_PARAM(ptrd));
}
PETSC_EXTERN void PETSC_STDCALL iscoloringrestoreisf90_(ISColoring *iscoloring,F90Array1d *ptr,int *__ierr PETSC_F90_2PTR_PROTO(ptrd))
{
PetscFortranAddr *is;
*__ierr = F90Array1dAccess(ptr,PETSC_FORTRANADDR,(void**)&is PETSC_F90_2PTR_PARAM(ptrd));if (*__ierr) return;
*__ierr = F90Array1dDestroy(ptr,PETSC_FORTRANADDR PETSC_F90_2PTR_PARAM(ptrd));if (*__ierr) return;
*__ierr = ISColoringRestoreIS(*iscoloring,(IS**)is);if (*__ierr) return;
*__ierr = PetscFree(is);
}
