/*@ 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); }