PETSC_EXTERN PetscErrorCode PetscViewerCreate_Draw(PetscViewer viewer) { PetscInt i; PetscErrorCode ierr; PetscViewer_Draw *vdraw; PetscFunctionBegin; ierr = PetscNewLog(viewer,PetscViewer_Draw,&vdraw);CHKERRQ(ierr); viewer->data = (void*)vdraw; viewer->ops->flush = PetscViewerFlush_Draw; viewer->ops->destroy = PetscViewerDestroy_Draw; viewer->ops->setfromoptions = PetscViewerSetFromOptions_Draw; viewer->ops->getsingleton = PetscViewerGetSingleton_Draw; viewer->ops->restoresingleton = PetscViewerRestoreSingleton_Draw; /* these are created on the fly if requested */ vdraw->draw_max = 5; vdraw->draw_base = 0; vdraw->w = PETSC_DECIDE; vdraw->h = PETSC_DECIDE; ierr = PetscMalloc3(vdraw->draw_max,PetscDraw,&vdraw->draw,vdraw->draw_max,PetscDrawLG,&vdraw->drawlg,vdraw->draw_max,PetscDrawAxis,&vdraw->drawaxis);CHKERRQ(ierr); ierr = PetscMemzero(vdraw->draw,vdraw->draw_max*sizeof(PetscDraw));CHKERRQ(ierr); ierr = PetscMemzero(vdraw->drawlg,vdraw->draw_max*sizeof(PetscDrawLG));CHKERRQ(ierr); ierr = PetscMemzero(vdraw->drawaxis,vdraw->draw_max*sizeof(PetscDrawAxis));CHKERRQ(ierr); for (i=0; i<vdraw->draw_max; i++) { vdraw->draw[i] = 0; vdraw->drawlg[i] = 0; vdraw->drawaxis[i] = 0; } vdraw->singleton_made = PETSC_FALSE; PetscFunctionReturn(0); }
EXTERN_C_BEGIN #undef __FUNCT__ #define __FUNCT__ "PetscViewerCreate_Draw" PetscErrorCode PETSC_DLLEXPORT PetscViewerCreate_Draw(PetscViewer viewer) { PetscInt i; PetscErrorCode ierr; PetscViewer_Draw *vdraw; PetscFunctionBegin; ierr = PetscNewLog(viewer,PetscViewer_Draw,&vdraw);CHKERRQ(ierr); viewer->data = (void*)vdraw; viewer->ops->flush = PetscViewerFlush_Draw; viewer->ops->destroy = PetscViewerDestroy_Draw; viewer->ops->getsingleton = PetscViewerGetSingleton_Draw; viewer->ops->restoresingleton = PetscViewerRestoreSingleton_Draw; viewer->format = PETSC_VIEWER_NOFORMAT; /* these are created on the fly if requested */ vdraw->draw_max = 5; vdraw->draw_base = 0; ierr = PetscMalloc3(vdraw->draw_max,PetscDraw,&vdraw->draw,vdraw->draw_max,PetscDrawLG,&vdraw->drawlg,vdraw->draw_max,PetscDrawAxis,&vdraw->drawaxis);CHKERRQ(ierr); ierr = PetscMemzero(vdraw->draw,vdraw->draw_max*sizeof(PetscDraw));CHKERRQ(ierr); ierr = PetscMemzero(vdraw->drawlg,vdraw->draw_max*sizeof(PetscDrawLG));CHKERRQ(ierr); ierr = PetscMemzero(vdraw->drawaxis,vdraw->draw_max*sizeof(PetscDrawAxis));CHKERRQ(ierr); for (i=0; i<vdraw->draw_max; i++) { vdraw->draw[i] = 0; vdraw->drawlg[i] = 0; vdraw->drawaxis[i] = 0; } vdraw->singleton_made = PETSC_FALSE; PetscFunctionReturn(0); }
PetscErrorCode OpForcing(Op op,DM dm,Vec F) { PetscErrorCode ierr; Vec X,Floc; DM dmx; const PetscScalar *x; PetscScalar *f; const PetscReal *B,*D,*w3; PetscReal L[3]; PetscInt nelem,ne = op->ne,P,Q,P3,Q3; PetscFunctionBegin; ierr = PetscLogEventBegin(OP_Forcing,dm,F,0,0);CHKERRQ(ierr); ierr = DMFEGetTensorEval(dm,&P,&Q,&B,&D,NULL,NULL,&w3);CHKERRQ(ierr); P3 = P*P*P; Q3 = Q*Q*Q; ierr = DMFEGetUniformCoordinates(dm,L);CHKERRQ(ierr); ierr = DMGetLocalVector(dm,&Floc);CHKERRQ(ierr); ierr = DMGetCoordinateDM(dm,&dmx);CHKERRQ(ierr); ierr = DMGetCoordinatesLocal(dm,&X);CHKERRQ(ierr); ierr = DMFEGetNumElements(dm,&nelem);CHKERRQ(ierr); ierr = VecGetArrayRead(X,&x);CHKERRQ(ierr); ierr = VecZeroEntries(Floc);CHKERRQ(ierr); ierr = VecGetArray(Floc,&f);CHKERRQ(ierr); for (PetscInt e=0; e<nelem; e+=ne) { PetscScalar fe[op->dof*P3*ne]_align,fq[op->dof][Q3][ne]_align,xe[3*P3*ne]_align,xq[3][Q3][ne]_align,dx[3][3][Q3][ne]_align,wdxdet[Q3][ne]_align; ierr = DMFEExtractElements(dmx,x,e,ne,xe);CHKERRQ(ierr); ierr = PetscMemzero(xq,sizeof xq);CHKERRQ(ierr); ierr = TensorContract(op->Tensor3,B,B,B,TENSOR_EVAL,xe,xq[0][0]);CHKERRQ(ierr); ierr = PetscMemzero(dx,sizeof dx);CHKERRQ(ierr); ierr = TensorContract(op->Tensor3,D,B,B,TENSOR_EVAL,xe,dx[0][0][0]);CHKERRQ(ierr); ierr = TensorContract(op->Tensor3,B,D,B,TENSOR_EVAL,xe,dx[1][0][0]);CHKERRQ(ierr); ierr = TensorContract(op->Tensor3,B,B,D,TENSOR_EVAL,xe,dx[2][0][0]);CHKERRQ(ierr); ierr = PointwiseJacobianInvert(ne,Q*Q*Q,w3,dx,wdxdet);CHKERRQ(ierr); for (PetscInt i=0; i<Q3; i++) { for (PetscInt l=0; l<ne; l++) { PetscReal xx[] = {xq[0][i][l],xq[1][i][l],xq[2][i][l]}; PetscScalar fql[op->dof]; ierr = (op->PointwiseForcing)(op,xx,L,fql);CHKERRQ(ierr); for (PetscInt d=0; d<op->dof; d++) fq[d][i][l] = wdxdet[i][l] * fql[d]; } } ierr = PetscMemzero(fe,sizeof fe);CHKERRQ(ierr); ierr = TensorContract(op->TensorDOF,B,B,B,TENSOR_TRANSPOSE,fq[0][0],fe);CHKERRQ(ierr); ierr = DMFESetElements(dm,f,e,ne,ADD_VALUES,DOMAIN_INTERIOR,fe);CHKERRQ(ierr); } ierr = VecRestoreArrayRead(X,&x);CHKERRQ(ierr); ierr = VecRestoreArray(Floc,&f);CHKERRQ(ierr); ierr = VecZeroEntries(F);CHKERRQ(ierr); ierr = DMLocalToGlobalBegin(dm,Floc,ADD_VALUES,F);CHKERRQ(ierr); ierr = DMLocalToGlobalEnd(dm,Floc,ADD_VALUES,F);CHKERRQ(ierr); ierr = DMRestoreLocalVector(dm,&Floc);CHKERRQ(ierr); ierr = PetscLogEventEnd(OP_Forcing,dm,F,0,0);CHKERRQ(ierr); PetscFunctionReturn(0); }
int main(int argc, char *argv[]) { PetscErrorCode ierr; PetscInt opts[6] = {0}; PetscBool hascl = PETSC_FALSE,hasstr = PETSC_FALSE; ierr = PetscInitialize(&argc,&argv,0,help);CHKERRQ(ierr); ierr = PetscOptionsSetValue(NULL,"-zero","0");CHKERRQ(ierr); ierr = PetscOptionsPrefixPush(NULL,"a_");CHKERRQ(ierr); ierr = PetscOptionsSetValue(NULL,"-one","1");CHKERRQ(ierr); ierr = PetscOptionsPrefixPush(NULL,"bb_");CHKERRQ(ierr); ierr = PetscOptionsSetValue(NULL,"-two","2");CHKERRQ(ierr); ierr = PetscOptionsPrefixPop(NULL);CHKERRQ(ierr); ierr = PetscOptionsSetValue(NULL,"-three","3");CHKERRQ(ierr); ierr = PetscOptionsPrefixPush(NULL,"cc_");CHKERRQ(ierr); ierr = PetscOptionsPrefixPush(NULL,"ddd_");CHKERRQ(ierr); ierr = PetscOptionsSetValue(NULL,"-four","4");CHKERRQ(ierr); ierr = PetscOptionsPrefixPop(NULL);CHKERRQ(ierr); ierr = PetscOptionsPrefixPop(NULL);CHKERRQ(ierr); ierr = PetscOptionsPrefixPop(NULL);CHKERRQ(ierr); ierr = PetscOptionsSetValue(NULL,"-five","5");CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,0,"-zero",&opts[0],0);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,0,"-a_one",&opts[1],0);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,0,"-a_bb_two",&opts[2],0);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,0,"-a_three",&opts[3],0);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,0,"-a_cc_ddd_four",&opts[4],0);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,0,"-five",&opts[5],0);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"opts = {%D %D %D %D %D %D}\n",opts[0],opts[1],opts[2],opts[3],opts[4],opts[5]);CHKERRQ(ierr); ierr = PetscOptionsGetBool(NULL,0,"-cl",&hascl,0);CHKERRQ(ierr); if (hascl) { ierr = PetscMemzero(opts,sizeof(opts));CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,0,"-cl_zero",&opts[0],0);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,0,"-cl_a_one",&opts[1],0);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,0,"-cl_a_bb_two",&opts[2],0);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,0,"-cl_a_three",&opts[3],0);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,0,"-cl_a_cc_ddd_four",&opts[4],0);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,0,"-cl_five",&opts[5],0);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"cl_opts = {%D %D %D %D %D %D}\n",opts[0],opts[1],opts[2],opts[3],opts[4],opts[5]);CHKERRQ(ierr); } ierr = PetscOptionsGetBool(NULL,0,"-str",&hasstr,0);CHKERRQ(ierr); if (hasstr) { ierr = PetscOptionsInsertString(NULL,"-prefix_push str_ -zero 100 -prefix_push a_ -one 101 -prefix_push bb_ -two 102 -prefix_pop -three 103 -prefix_push cc_ -prefix_push ddd_ -four 104 -prefix_pop -prefix_pop -prefix_pop -five 105 -prefix_pop");CHKERRQ(ierr); ierr = PetscMemzero(opts,sizeof(opts));CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,0,"-str_zero",&opts[0],0);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,0,"-str_a_one",&opts[1],0);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,0,"-str_a_bb_two",&opts[2],0);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,0,"-str_a_three",&opts[3],0);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,0,"-str_a_cc_ddd_four",&opts[4],0);CHKERRQ(ierr); ierr = PetscOptionsGetInt(NULL,0,"-str_five",&opts[5],0);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"str_opts = {%D %D %D %D %D %D}\n",opts[0],opts[1],opts[2],opts[3],opts[4],opts[5]);CHKERRQ(ierr); } ierr = PetscFinalize();CHKERRQ(ierr); return 0; }
PetscErrorCode MatMPIAIJDiagonalScaleLocalSetUp(Mat inA,Vec scale) { Mat_MPIAIJ *ina = (Mat_MPIAIJ*) inA->data; /*access private part of matrix */ PetscErrorCode ierr; PetscInt i,n,nt,cstart,cend,no,*garray = ina->garray,*lindices; PetscInt *r_rmapd,*r_rmapo; PetscFunctionBegin; ierr = MatGetOwnershipRange(inA,&cstart,&cend);CHKERRQ(ierr); ierr = MatGetSize(ina->A,PETSC_NULL,&n);CHKERRQ(ierr); ierr = PetscMalloc((inA->rmap->mapping->n+1)*sizeof(PetscInt),&r_rmapd);CHKERRQ(ierr); ierr = PetscMemzero(r_rmapd,inA->rmap->mapping->n*sizeof(PetscInt));CHKERRQ(ierr); nt = 0; for (i=0; i<inA->rmap->mapping->n; i++) { if (inA->rmap->mapping->indices[i] >= cstart && inA->rmap->mapping->indices[i] < cend) { nt++; r_rmapd[i] = inA->rmap->mapping->indices[i] + 1; } } if (nt != n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Hmm nt %D n %D",nt,n); ierr = PetscMalloc((n+1)*sizeof(PetscInt),&auglyrmapd);CHKERRQ(ierr); for (i=0; i<inA->rmap->mapping->n; i++) { if (r_rmapd[i]){ auglyrmapd[(r_rmapd[i]-1)-cstart] = i; } } ierr = PetscFree(r_rmapd);CHKERRQ(ierr); ierr = VecCreateSeq(PETSC_COMM_SELF,n,&auglydd);CHKERRQ(ierr); ierr = PetscMalloc((inA->cmap->N+1)*sizeof(PetscInt),&lindices);CHKERRQ(ierr); ierr = PetscMemzero(lindices,inA->cmap->N*sizeof(PetscInt));CHKERRQ(ierr); for (i=0; i<ina->B->cmap->n; i++) { lindices[garray[i]] = i+1; } no = inA->rmap->mapping->n - nt; ierr = PetscMalloc((inA->rmap->mapping->n+1)*sizeof(PetscInt),&r_rmapo);CHKERRQ(ierr); ierr = PetscMemzero(r_rmapo,inA->rmap->mapping->n*sizeof(PetscInt));CHKERRQ(ierr); nt = 0; for (i=0; i<inA->rmap->mapping->n; i++) { if (lindices[inA->rmap->mapping->indices[i]]) { nt++; r_rmapo[i] = lindices[inA->rmap->mapping->indices[i]]; } } if (nt > no) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Hmm nt %D no %D",nt,n); ierr = PetscFree(lindices);CHKERRQ(ierr); ierr = PetscMalloc((nt+1)*sizeof(PetscInt),&auglyrmapo);CHKERRQ(ierr); for (i=0; i<inA->rmap->mapping->n; i++) { if (r_rmapo[i]){ auglyrmapo[(r_rmapo[i]-1)] = i; } } ierr = PetscFree(r_rmapo);CHKERRQ(ierr); ierr = VecCreateSeq(PETSC_COMM_SELF,nt,&auglyoo);CHKERRQ(ierr); PetscFunctionReturn(0); }
PetscErrorCode DMCreateInterpolation_Composite(DM coarse,DM fine,Mat *A,Vec *v) { PetscErrorCode ierr; PetscInt m,n,M,N,nDM,i; struct DMCompositeLink *nextc; struct DMCompositeLink *nextf; Vec gcoarse,gfine,*vecs; DM_Composite *comcoarse = (DM_Composite*)coarse->data; DM_Composite *comfine = (DM_Composite*)fine->data; Mat *mats; PetscFunctionBegin; PetscValidHeaderSpecific(coarse,DM_CLASSID,1); PetscValidHeaderSpecific(fine,DM_CLASSID,2); ierr = DMSetUp(coarse);CHKERRQ(ierr); ierr = DMSetUp(fine);CHKERRQ(ierr); /* use global vectors only for determining matrix layout */ ierr = DMGetGlobalVector(coarse,&gcoarse);CHKERRQ(ierr); ierr = DMGetGlobalVector(fine,&gfine);CHKERRQ(ierr); ierr = VecGetLocalSize(gcoarse,&n);CHKERRQ(ierr); ierr = VecGetLocalSize(gfine,&m);CHKERRQ(ierr); ierr = VecGetSize(gcoarse,&N);CHKERRQ(ierr); ierr = VecGetSize(gfine,&M);CHKERRQ(ierr); ierr = DMRestoreGlobalVector(coarse,&gcoarse);CHKERRQ(ierr); ierr = DMRestoreGlobalVector(fine,&gfine);CHKERRQ(ierr); nDM = comfine->nDM; if (nDM != comcoarse->nDM) SETERRQ2(((PetscObject)fine)->comm,PETSC_ERR_ARG_INCOMP,"Fine DMComposite has %D entries, but coarse has %D",nDM,comcoarse->nDM); ierr = PetscMalloc(nDM*nDM*sizeof(Mat),&mats);CHKERRQ(ierr); ierr = PetscMemzero(mats,nDM*nDM*sizeof(Mat));CHKERRQ(ierr); if (v) { ierr = PetscMalloc(nDM*sizeof(Vec),&vecs);CHKERRQ(ierr); ierr = PetscMemzero(vecs,nDM*sizeof(Vec));CHKERRQ(ierr); } /* loop over packed objects, handling one at at time */ for (nextc=comcoarse->next,nextf=comfine->next,i=0; nextc; nextc=nextc->next,nextf=nextf->next,i++) { if (!v) { ierr = DMCreateInterpolation(nextc->dm,nextf->dm,&mats[i*nDM+i],PETSC_NULL);CHKERRQ(ierr); } else { ierr = DMCreateInterpolation(nextc->dm,nextf->dm,&mats[i*nDM+i],&vecs[i]);CHKERRQ(ierr); } } ierr = MatCreateNest(((PetscObject)fine)->comm,nDM,PETSC_NULL,nDM,PETSC_NULL,mats,A);CHKERRQ(ierr); if (v) { ierr = VecCreateNest(((PetscObject)fine)->comm,nDM,PETSC_NULL,vecs,v);CHKERRQ(ierr); } for (i=0; i<nDM*nDM; i++) {ierr = MatDestroy(&mats[i]);CHKERRQ(ierr);} ierr = PetscFree(mats);CHKERRQ(ierr); if (v) { for (i=0; i<nDM; i++) {ierr = VecDestroy(&vecs[i]);CHKERRQ(ierr);} ierr = PetscFree(vecs);CHKERRQ(ierr); } PetscFunctionReturn(0); }
static PetscErrorCode PCSetUp_CP(PC pc) { PC_CP *cp = (PC_CP*)pc->data; PetscInt i,j,*colcnt; PetscErrorCode ierr; PetscTruth flg; Mat_SeqAIJ *aij = (Mat_SeqAIJ*)pc->pmat->data; PetscFunctionBegin; ierr = PetscTypeCompare((PetscObject)pc->pmat,MATSEQAIJ,&flg);CHKERRQ(ierr); if (!flg) SETERRQ(PETSC_ERR_SUP,"Currently only handles SeqAIJ matrices"); ierr = MatGetLocalSize(pc->pmat,&cp->m,&cp->n);CHKERRQ(ierr); if (cp->m != cp->n) SETERRQ(PETSC_ERR_SUP,"Currently only for square matrices"); if (!cp->work) {ierr = MatGetVecs(pc->pmat,&cp->work,PETSC_NULL);CHKERRQ(ierr);} if (!cp->d) {ierr = PetscMalloc(cp->n*sizeof(PetscScalar),&cp->d);CHKERRQ(ierr);} if (cp->a && pc->flag != SAME_NONZERO_PATTERN) { ierr = PetscFree3(cp->a,cp->i,cp->j);CHKERRQ(ierr); cp->a = 0; } /* convert to column format */ if (!cp->a) { ierr = PetscMalloc3(aij->nz,PetscScalar,&cp->a,cp->n+1,PetscInt,&cp->i,aij->nz,PetscInt,&cp->j);CHKERRQ(ierr); } ierr = PetscMalloc(cp->n*sizeof(PetscInt),&colcnt);CHKERRQ(ierr); ierr = PetscMemzero(colcnt,cp->n*sizeof(PetscInt));CHKERRQ(ierr); for (i=0; i<aij->nz; i++) { colcnt[aij->j[i]]++; } cp->i[0] = 0; for (i=0; i<cp->n; i++) { cp->i[i+1] = cp->i[i] + colcnt[i]; } ierr = PetscMemzero(colcnt,cp->n*sizeof(PetscInt));CHKERRQ(ierr); for (i=0; i<cp->m; i++) { /* over rows */ for (j=aij->i[i]; j<aij->i[i+1]; j++) { /* over columns in row */ cp->j[cp->i[aij->j[j]]+colcnt[aij->j[j]]] = i; cp->a[cp->i[aij->j[j]]+colcnt[aij->j[j]]++] = aij->a[j]; } } ierr = PetscFree(colcnt);CHKERRQ(ierr); /* compute sum of squares of each column d[] */ for (i=0; i<cp->n; i++) { /* over columns */ cp->d[i] = 0.; for (j=cp->i[i]; j<cp->i[i+1]; j++) { /* over rows in column */ cp->d[i] += cp->a[j]*cp->a[j]; } cp->d[i] = 1.0/cp->d[i]; } PetscFunctionReturn(0); }
/*@C ISColoringGetIS - Extracts index sets from the coloring context Collective on ISColoring Input Parameter: . iscoloring - the coloring context Output Parameters: + nn - number of index sets in the coloring context - is - array of index sets Level: advanced .seealso: ISColoringRestoreIS(), ISColoringView() @*/ PetscErrorCode ISColoringGetIS(ISColoring iscoloring,PetscInt *nn,IS *isis[]) { PetscErrorCode ierr; PetscFunctionBegin; PetscValidPointer(iscoloring,1); if (nn) *nn = iscoloring->n; if (isis) { if (!iscoloring->is) { PetscInt *mcolors,**ii,nc = iscoloring->n,i,base, n = iscoloring->N; ISColoringValue *colors = iscoloring->colors; IS *is; #if defined(PETSC_USE_DEBUG) for (i=0; i<n; i++) { if (((PetscInt)colors[i]) >= nc) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Coloring is our of range index %d value %d number colors %d",(int)i,(int)colors[i],(int)nc); } #endif /* generate the lists of nodes for each color */ ierr = PetscMalloc(nc*sizeof(PetscInt),&mcolors);CHKERRQ(ierr); ierr = PetscMemzero(mcolors,nc*sizeof(PetscInt));CHKERRQ(ierr); for (i=0; i<n; i++) mcolors[colors[i]]++; ierr = PetscMalloc(nc*sizeof(PetscInt*),&ii);CHKERRQ(ierr); ierr = PetscMalloc(n*sizeof(PetscInt),&ii[0]);CHKERRQ(ierr); for (i=1; i<nc; i++) ii[i] = ii[i-1] + mcolors[i-1]; ierr = PetscMemzero(mcolors,nc*sizeof(PetscInt));CHKERRQ(ierr); if (iscoloring->ctype == IS_COLORING_GLOBAL) { ierr = MPI_Scan(&iscoloring->N,&base,1,MPIU_INT,MPI_SUM,iscoloring->comm);CHKERRQ(ierr); base -= iscoloring->N; for (i=0; i<n; i++) ii[colors[i]][mcolors[colors[i]]++] = i + base; /* global idx */ } else if (iscoloring->ctype == IS_COLORING_GHOSTED) { for (i=0; i<n; i++) ii[colors[i]][mcolors[colors[i]]++] = i; /* local idx */ } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not provided for this ISColoringType type"); ierr = PetscMalloc(nc*sizeof(IS),&is);CHKERRQ(ierr); for (i=0; i<nc; i++) { ierr = ISCreateGeneral(iscoloring->comm,mcolors[i],ii[i],PETSC_COPY_VALUES,is+i);CHKERRQ(ierr); } iscoloring->is = is; ierr = PetscFree(ii[0]);CHKERRQ(ierr); ierr = PetscFree(ii);CHKERRQ(ierr); ierr = PetscFree(mcolors);CHKERRQ(ierr); } *isis = iscoloring->is; } PetscFunctionReturn(0); }
/*@C PetscViewerDrawGetDraw - Returns PetscDraw object from PetscViewer object. This PetscDraw object may then be used to perform graphics using PetscDrawXXX() commands. Not collective (but PetscDraw returned will be parallel object if PetscViewer is) Input Parameters: + viewer - the PetscViewer (created with PetscViewerDrawOpen()) - windownumber - indicates which subwindow (usually 0) Ouput Parameter: . draw - the draw object Level: intermediate Concepts: drawing^accessing PetscDraw context from PetscViewer Concepts: graphics .seealso: PetscViewerDrawGetLG(), PetscViewerDrawGetAxis(), PetscViewerDrawOpen() @*/ PetscErrorCode PETSC_DLLEXPORT PetscViewerDrawGetDraw(PetscViewer viewer,PetscInt windownumber,PetscDraw *draw) { PetscViewer_Draw *vdraw = (PetscViewer_Draw*)viewer->data; PetscErrorCode ierr; PetscTruth isdraw; char *title; PetscFunctionBegin; PetscValidHeaderSpecific(viewer,PETSC_VIEWER_COOKIE,1); if (draw) PetscValidPointer(draw,3); ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_DRAW,&isdraw);CHKERRQ(ierr); if (!isdraw) { SETERRQ(PETSC_ERR_ARG_WRONG,"Must be draw type PetscViewer"); } if (windownumber < 0) { SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Window number cannot be negative"); } windownumber += vdraw->draw_base; if (windownumber >= vdraw->draw_max) { /* allocate twice as many slots as needed */ PetscInt draw_max = vdraw->draw_max; PetscDraw *tdraw = vdraw->draw; PetscDrawLG *drawlg = vdraw->drawlg; PetscDrawAxis *drawaxis = vdraw->drawaxis; vdraw->draw_max = 2*windownumber; ierr = PetscMalloc3(vdraw->draw_max,PetscDraw,&vdraw->draw,vdraw->draw_max,PetscDrawLG,&vdraw->drawlg,vdraw->draw_max,PetscDrawAxis,&vdraw->drawaxis);CHKERRQ(ierr); ierr = PetscMemzero(vdraw->draw,vdraw->draw_max*sizeof(PetscDraw));CHKERRQ(ierr); ierr = PetscMemzero(vdraw->drawlg,vdraw->draw_max*sizeof(PetscDrawLG));CHKERRQ(ierr); ierr = PetscMemzero(vdraw->drawaxis,vdraw->draw_max*sizeof(PetscDrawAxis));CHKERRQ(ierr); ierr = PetscMemcpy(vdraw->draw,tdraw,draw_max*sizeof(PetscDraw));CHKERRQ(ierr); ierr = PetscMemcpy(vdraw->drawlg,drawlg,draw_max*sizeof(PetscDrawLG));CHKERRQ(ierr); ierr = PetscMemcpy(vdraw->drawaxis,drawaxis,draw_max*sizeof(PetscDrawAxis));CHKERRQ(ierr); ierr = PetscFree3(tdraw,drawlg,drawaxis);CHKERRQ(ierr); } if (!vdraw->draw[windownumber]) { if (!windownumber) { title = vdraw->title; } else { char tmp_str[128]; ierr = PetscSNPrintf(tmp_str, 128, "%s:%d", vdraw->title,windownumber);CHKERRQ(ierr); title = tmp_str; } ierr = PetscDrawCreate(((PetscObject)viewer)->comm,vdraw->display,title,PETSC_DECIDE,PETSC_DECIDE,vdraw->w,vdraw->h,&vdraw->draw[windownumber]);CHKERRQ(ierr); ierr = PetscDrawSetFromOptions(vdraw->draw[windownumber]);CHKERRQ(ierr); } if (draw) *draw = vdraw->draw[windownumber]; PetscFunctionReturn(0); }
PetscErrorCode KSPSetUp_AGMRES(KSP ksp) { PetscErrorCode ierr; PetscInt hes; PetscInt nloc; KSP_AGMRES *agmres = (KSP_AGMRES*)ksp->data; PetscInt neig = agmres->neig; PetscInt max_k = agmres->max_k; PetscInt N = MAXKSPSIZE; PetscInt lwork = PetscMax(8 * N + 16, 4 * neig * (N - neig)); PetscFunctionBegin; if (ksp->pc_side == PC_SYMMETRIC) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"no symmetric preconditioning for KSPAGMRES"); max_k = agmres->max_k; N = MAXKSPSIZE; /* Preallocate space during the call to KSPSetup_GMRES for the Krylov basis */ agmres->q_preallocate = PETSC_TRUE; /* No allocation on the fly */ /* Preallocate space to compute later the eigenvalues in GMRES */ ksp->calc_sings = PETSC_TRUE; agmres->max_k = N; /* Set the augmented size to be allocated in KSPSetup_GMRES */ ierr = KSPSetUp_DGMRES(ksp);CHKERRQ(ierr); agmres->max_k = max_k; hes = (N + 1) * (N + 1); /* Data for the Newton basis GMRES */ ierr = PetscCalloc4(max_k,&agmres->Rshift,max_k,&agmres->Ishift,hes,&agmres->Rloc,((N+1)*4),&agmres->wbufptr);CHKERRQ(ierr); ierr = PetscMalloc7((N+1),&agmres->Scale,(N+1),&agmres->sgn,(N+1),&agmres->tloc,(N+1),&agmres->temp,(N+1),&agmres->tau,lwork,&agmres->work,(N+1),&agmres->nrs);CHKERRQ(ierr); ierr = PetscMemzero(agmres->Scale, (N+1)*sizeof(PetscScalar));CHKERRQ(ierr); ierr = PetscMemzero(agmres->sgn, (N+1)*sizeof(PetscScalar));CHKERRQ(ierr); ierr = PetscMemzero(agmres->tloc, (N+1)*sizeof(PetscScalar));CHKERRQ(ierr); ierr = PetscMemzero(agmres->temp, (N+1)*sizeof(PetscScalar));CHKERRQ(ierr); /* Allocate space for the vectors in the orthogonalized basis*/ ierr = VecGetLocalSize(agmres->vecs[0], &nloc);CHKERRQ(ierr); ierr = PetscMalloc1(nloc*(N+1), &agmres->Qloc);CHKERRQ(ierr); /* Init the ring of processors for the roddec orthogonalization */ ierr = KSPAGMRESRoddecInitNeighboor(ksp);CHKERRQ(ierr); if (agmres->neig < 1) PetscFunctionReturn(0); /* Allocate space for the deflation */ ierr = PetscMalloc1(N, &agmres->select);CHKERRQ(ierr); ierr = VecDuplicateVecs(VEC_V(0), N, &agmres->TmpU);CHKERRQ(ierr); ierr = PetscMalloc2(N*N, &agmres->MatEigL, N*N, &agmres->MatEigR);CHKERRQ(ierr); /* ierr = PetscMalloc6(N*N, &agmres->Q, N*N, &agmres->Z, N, &agmres->wr, N, &agmres->wi, N, &agmres->beta, N, &agmres->modul);CHKERRQ(ierr); */ ierr = PetscMalloc3(N*N, &agmres->Q, N*N, &agmres->Z, N, &agmres->beta);CHKERRQ(ierr); ierr = PetscMalloc2((N+1),&agmres->perm,(2*neig*N),&agmres->iwork);CHKERRQ(ierr); PetscFunctionReturn(0); }
PETSC_EXTERN PetscErrorCode VecCreate_Seq(Vec V) { Vec_Seq *s; PetscScalar *array; PetscErrorCode ierr; PetscInt n = PetscMax(V->map->n,V->map->N); PetscMPIInt size; PetscFunctionBegin; ierr = MPI_Comm_size(PetscObjectComm((PetscObject)V),&size);CHKERRQ(ierr); if (size > 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Cannot create VECSEQ on more than one process"); #if !defined(PETSC_USE_MIXED_PRECISION) ierr = PetscMalloc1(n,&array);CHKERRQ(ierr); ierr = PetscLogObjectMemory((PetscObject)V, n*sizeof(PetscScalar));CHKERRQ(ierr); ierr = VecCreate_Seq_Private(V,array);CHKERRQ(ierr); s = (Vec_Seq*)V->data; s->array_allocated = array; ierr = VecSet(V,0.0);CHKERRQ(ierr); #else switch (((PetscObject)V)->precision) { case PETSC_PRECISION_SINGLE: { float *aarray; ierr = PetscMalloc1(n,&aarray);CHKERRQ(ierr); ierr = PetscLogObjectMemory((PetscObject)V, n*sizeof(float));CHKERRQ(ierr); ierr = PetscMemzero(aarray,n*sizeof(float));CHKERRQ(ierr); ierr = VecCreate_Seq_Private(V,aarray);CHKERRQ(ierr); s = (Vec_Seq*)V->data; s->array_allocated = (PetscScalar*)aarray; } break; case PETSC_PRECISION_DOUBLE: { double *aarray; ierr = PetscMalloc1(n,&aarray);CHKERRQ(ierr); ierr = PetscLogObjectMemory((PetscObject)V, n*sizeof(double));CHKERRQ(ierr); ierr = PetscMemzero(aarray,n*sizeof(double));CHKERRQ(ierr); ierr = VecCreate_Seq_Private(V,aarray);CHKERRQ(ierr); s = (Vec_Seq*)V->data; s->array_allocated = (PetscScalar*)aarray; } break; default: SETERRQ1(PetscObjectComm((PetscObject)V),PETSC_ERR_SUP,"No support for mixed precision %d",(int)(((PetscObject)V)->precision)); } #endif PetscFunctionReturn(0); }
PetscErrorCode MatZeroRowsLocal_HYPRESStruct_3d(Mat mat,PetscInt nrow,const PetscInt irow[],PetscScalar d,Vec x,Vec b) { PetscErrorCode ierr; PetscInt i,index[3]; PetscScalar **values; Mat_HYPRESStruct *ex = (Mat_HYPRESStruct*) mat->data; PetscInt part = 0; /* Petsc sstruct interface only allows 1 part */ PetscInt ordering = ex->dofs_order; PetscInt grid_rank; PetscInt var_type; PetscInt nvars= ex->nvars; PetscInt row,*entries; PetscFunctionBegin; if (x && b) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"No support"); ierr = PetscMalloc1(7*nvars,&entries);CHKERRQ(ierr); ierr = PetscMalloc1(nvars,&values);CHKERRQ(ierr); ierr = PetscMalloc1(7*nvars*nvars,&values[0]);CHKERRQ(ierr); for (i=1; i<nvars; i++) { values[i] = values[i-1] + nvars*7; } for (i=0; i< nvars; i++) { ierr = PetscMemzero(values[i],nvars*7*sizeof(PetscScalar));CHKERRQ(ierr); *(values[i]+3) = d; } for (i= 0; i< nvars*7; i++) entries[i] = i; if (!ordering) { for (i=0; i<nrow; i++) { grid_rank = irow[i] / nvars; var_type =(irow[i] % nvars); row = ex->gindices[grid_rank] - ex->rstart; index[0] = ex->xs + (row % ex->nx); index[1] = ex->ys + ((row/ex->nx) % ex->ny); index[2] = ex->zs + (row/(ex->nxny)); PetscStackCallStandard(HYPRE_SStructMatrixSetValues,(ex->ss_mat,part,(HYPRE_Int *)index,var_type,7*nvars,(HYPRE_Int *)entries,values[var_type])); } } else { for (i=0; i<nrow; i++) { var_type = irow[i]/(ex->gnxgnygnz); grid_rank= irow[i] - var_type*(ex->gnxgnygnz); row = ex->gindices[grid_rank] - ex->rstart; index[0] = ex->xs + (row % ex->nx); index[1] = ex->ys + ((row/ex->nx) % ex->ny); index[2] = ex->zs + (row/(ex->nxny)); PetscStackCallStandard(HYPRE_SStructMatrixSetValues,(ex->ss_mat,part,(HYPRE_Int *)index,var_type,7*nvars,(HYPRE_Int *)entries,values[var_type])); } } PetscStackCallStandard(HYPRE_SStructMatrixAssemble,(ex->ss_mat)); ierr = PetscFree(values[0]);CHKERRQ(ierr); ierr = PetscFree(values);CHKERRQ(ierr); ierr = PetscFree(entries);CHKERRQ(ierr); PetscFunctionReturn(0); }
PetscErrorCode EPSCreate_XD(EPS eps) { PetscErrorCode ierr; EPS_DAVIDSON *data; PetscFunctionBegin; eps->ops->solve = EPSSolve_XD; eps->ops->setup = EPSSetUp_XD; eps->ops->reset = EPSReset_XD; eps->ops->backtransform = EPSBackTransform_Default; eps->ops->computevectors = EPSComputeVectors_XD; eps->ops->view = EPSView_XD; ierr = PetscNewLog(eps,&data);CHKERRQ(ierr); eps->data = (void*)data; ierr = PetscMemzero(&data->ddb,sizeof(dvdDashboard));CHKERRQ(ierr); /* Set default values */ ierr = EPSXDSetKrylovStart_XD(eps,PETSC_FALSE);CHKERRQ(ierr); ierr = EPSXDSetBlockSize_XD(eps,1);CHKERRQ(ierr); ierr = EPSXDSetRestart_XD(eps,6,0);CHKERRQ(ierr); ierr = EPSXDSetInitialSize_XD(eps,5);CHKERRQ(ierr); ierr = EPSJDSetFix_JD(eps,0.01);CHKERRQ(ierr); ierr = EPSXDSetBOrth_XD(eps,PETSC_TRUE);CHKERRQ(ierr); ierr = EPSJDSetConstCorrectionTol_JD(eps,PETSC_TRUE);CHKERRQ(ierr); ierr = EPSXDSetWindowSizes_XD(eps,0,0);CHKERRQ(ierr); PetscFunctionReturn(0); }
/*@C PCSetType - Builds PC for a particular preconditioner type Collective on PC Input Parameter: + pc - the preconditioner context. - type - a known method Options Database Key: . -pc_type <type> - Sets PC type Use -help for a list of available methods (for instance, jacobi or bjacobi) Notes: See "petsc/include/petscpc.h" for available methods (for instance, PCJACOBI, PCILU, or PCBJACOBI). Normally, it is best to use the KSPSetFromOptions() command and then set the PC type from the options database rather than by using this routine. Using the options database provides the user with maximum flexibility in evaluating the many different preconditioners. The PCSetType() routine is provided for those situations where it is necessary to set the preconditioner independently of the command line or options database. This might be the case, for example, when the choice of preconditioner changes during the execution of the program, and the user's application is taking responsibility for choosing the appropriate preconditioner. In other words, this routine is not for beginners. Level: intermediate Developer Note: PCRegister() is used to add preconditioner types to PCList from which they are accessed by PCSetType(). .keywords: PC, set, method, type .seealso: KSPSetType(), PCType, PCRegister(), PCCreate(), KSPGetPC() @*/ PetscErrorCode PCSetType(PC pc,PCType type) { PetscErrorCode ierr,(*r)(PC); PetscBool match; PetscFunctionBegin; PetscValidHeaderSpecific(pc,PC_CLASSID,1); PetscValidCharPointer(type,2); ierr = PetscObjectTypeCompare((PetscObject)pc,type,&match);CHKERRQ(ierr); if (match) PetscFunctionReturn(0); ierr = PetscFunctionListFind(PCList,type,&r);CHKERRQ(ierr); if (!r) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_ARG_UNKNOWN_TYPE,"Unable to find requested PC type %s",type); /* Destroy the previous private PC context */ if (pc->ops->destroy) { ierr = (*pc->ops->destroy)(pc);CHKERRQ(ierr); pc->ops->destroy = NULL; pc->data = 0; } ierr = PetscFunctionListDestroy(&((PetscObject)pc)->qlist);CHKERRQ(ierr); /* Reinitialize function pointers in PCOps structure */ ierr = PetscMemzero(pc->ops,sizeof(struct _PCOps));CHKERRQ(ierr); /* XXX Is this OK?? */ pc->modifysubmatrices = 0; pc->modifysubmatricesP = 0; /* Call the PCCreate_XXX routine for this particular preconditioner */ pc->setupcalled = 0; ierr = PetscObjectChangeTypeName((PetscObject)pc,type);CHKERRQ(ierr); ierr = (*r)(pc);CHKERRQ(ierr); PetscFunctionReturn(0); }
PetscErrorCode MatZeroEntries_HYPRESStruct_3d(Mat mat) { PetscErrorCode ierr; Mat_HYPRESStruct *ex = (Mat_HYPRESStruct*) mat->data; PetscInt nvars= ex->nvars; PetscInt size; PetscInt part= 0; /* only one part */ PetscFunctionBegin; size = ((ex->hbox.imax[0])-(ex->hbox.imin[0])+1)*((ex->hbox.imax[1])-(ex->hbox.imin[1])+1)*((ex->hbox.imax[2])-(ex->hbox.imin[2])+1); { PetscInt i,*entries,iupper[3],ilower[3]; PetscScalar *values; for (i= 0; i< 3; i++) { ilower[i]= ex->hbox.imin[i]; iupper[i]= ex->hbox.imax[i]; } ierr = PetscMalloc2(nvars*7,&entries,nvars*7*size,&values);CHKERRQ(ierr); for (i= 0; i< nvars*7; i++) entries[i]= i; ierr = PetscMemzero(values,nvars*7*size*sizeof(PetscScalar));CHKERRQ(ierr); for (i= 0; i< nvars; i++) { PetscStackCallStandard(HYPRE_SStructMatrixSetBoxValues,(ex->ss_mat,part,(HYPRE_Int *)ilower,(HYPRE_Int *)iupper,i,nvars*7,(HYPRE_Int *)entries,values)); } ierr = PetscFree2(entries,values);CHKERRQ(ierr); } PetscStackCallStandard(HYPRE_SStructMatrixAssemble,(ex->ss_mat)); PetscFunctionReturn(0); }
/*@C PetscObjectCopyFortranFunctionPointers - Copy function pointers to another object Logically Collective on PetscObject Input Parameter: + src - source object - dest - destination object Level: developer Note: Both objects must have the same class. @*/ PetscErrorCode PetscObjectCopyFortranFunctionPointers(PetscObject src,PetscObject dest) { PetscErrorCode ierr; PetscInt cbtype,numcb[PETSC_FORTRAN_CALLBACK_MAXTYPE]; PetscFunctionBegin; PetscValidHeader(src,1); PetscValidHeader(dest,2); if (src->classid != dest->classid) SETERRQ(src->comm,PETSC_ERR_ARG_INCOMP,"Objects must be of the same class"); ierr = PetscFree(dest->fortran_func_pointers);CHKERRQ(ierr); ierr = PetscMalloc(src->num_fortran_func_pointers*sizeof(void(*)(void)),&dest->fortran_func_pointers);CHKERRQ(ierr); ierr = PetscMemcpy(dest->fortran_func_pointers,src->fortran_func_pointers,src->num_fortran_func_pointers*sizeof(void(*)(void)));CHKERRQ(ierr); dest->num_fortran_func_pointers = src->num_fortran_func_pointers; ierr = PetscFortranCallbackGetSizes(src->classid,&numcb[PETSC_FORTRAN_CALLBACK_CLASS],&numcb[PETSC_FORTRAN_CALLBACK_SUBTYPE]);CHKERRQ(ierr); for (cbtype=PETSC_FORTRAN_CALLBACK_CLASS; cbtype<PETSC_FORTRAN_CALLBACK_MAXTYPE; cbtype++) { ierr = PetscFree(dest->fortrancallback[cbtype]);CHKERRQ(ierr); ierr = PetscMalloc(numcb[cbtype]*sizeof(PetscFortranCallback),&dest->fortrancallback[cbtype]);CHKERRQ(ierr); ierr = PetscMemzero(dest->fortrancallback[cbtype],numcb[cbtype]*sizeof(PetscFortranCallback));CHKERRQ(ierr); ierr = PetscMemcpy(dest->fortrancallback[cbtype],src->fortrancallback[cbtype],src->num_fortrancallback[cbtype]*sizeof(PetscFortranCallback));CHKERRQ(ierr); } PetscFunctionReturn(0); }
PetscErrorCode ComputeMatrix(KSP ksp,Mat J,Mat jac,MatStructure *str,void *ctx) { PetscErrorCode ierr; PetscInt i,mx,xm,xs; PetscScalar v[7],Hx; MatStencil row,col[7]; PetscScalar lambda; DM da; PetscFunctionBeginUser; ierr = KSPGetDM(ksp,&da);CHKERRQ(ierr); ierr = PetscMemzero(col,7*sizeof(MatStencil));CHKERRQ(ierr); ierr = DMDAGetInfo(da,0,&mx,0,0,0,0,0,0,0,0,0,0,0);CHKERRQ(ierr); Hx = 2.0*PETSC_PI / (PetscReal)(mx); ierr = DMDAGetCorners(da,&xs,0,0,&xm,0,0);CHKERRQ(ierr); lambda = 2.0*Hx; for (i=xs; i<xs+xm; i++) { row.i = i; row.j = 0; row.k = 0; row.c = 0; v[0] = Hx; col[0].i = i; col[0].c = 0; v[1] = lambda; col[1].i = i-1; col[1].c = 1; v[2] = -lambda;col[2].i = i+1; col[2].c = 1; ierr = MatSetValuesStencil(jac,1,&row,3,col,v,INSERT_VALUES);CHKERRQ(ierr); row.i = i; row.j = 0; row.k = 0; row.c = 1; v[0] = lambda; col[0].i = i-1; col[0].c = 0; v[1] = Hx; col[1].i = i; col[1].c = 1; v[2] = -lambda;col[2].i = i+1; col[2].c = 0; ierr = MatSetValuesStencil(jac,1,&row,3,col,v,INSERT_VALUES);CHKERRQ(ierr); } ierr = MatAssemblyBegin(jac,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(jac,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatView(jac,PETSC_VIEWER_BINARY_(PETSC_COMM_SELF));CHKERRQ(ierr); PetscFunctionReturn(0); }
/*@C PetscViewerSetType - Builds PetscViewer for a particular implementation. Collective on PetscViewer Input Parameter: + viewer - the PetscViewer context - type - for example, PETSCVIEWERASCII Options Database Command: . -draw_type <type> - Sets the type; use -help for a list of available methods (for instance, ascii) Level: advanced Notes: See "include/petscviewer.h" for available methods (for instance, PETSCVIEWERSOCKET) .seealso: PetscViewerCreate(), PetscViewerGetType(), PetscViewerType, PetscViewerSetFormat() @*/ PetscErrorCode PetscViewerSetType(PetscViewer viewer,PetscViewerType type) { PetscErrorCode ierr,(*r)(PetscViewer); PetscBool match; PetscFunctionBegin; PetscValidHeaderSpecific(viewer,PETSC_VIEWER_CLASSID,1); PetscValidCharPointer(type,2); ierr = PetscObjectTypeCompare((PetscObject)viewer,type,&match);CHKERRQ(ierr); if (match) PetscFunctionReturn(0); /* cleanup any old type that may be there */ if (viewer->data) { ierr = (*viewer->ops->destroy)(viewer);CHKERRQ(ierr); viewer->ops->destroy = NULL; viewer->data = 0; } ierr = PetscMemzero(viewer->ops,sizeof(struct _PetscViewerOps));CHKERRQ(ierr); ierr = PetscFunctionListFind(PetscViewerList,type,&r);CHKERRQ(ierr); if (!r) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_UNKNOWN_TYPE,"Unknown PetscViewer type given: %s",type); ierr = PetscObjectChangeTypeName((PetscObject)viewer,type);CHKERRQ(ierr); ierr = (*r)(viewer);CHKERRQ(ierr); PetscFunctionReturn(0); }
PETSC_EXTERN PetscErrorCode MatCreate_Preallocator(Mat A) { Mat_Preallocator *p; PetscErrorCode ierr; PetscFunctionBegin; ierr = PetscNewLog(A, &p);CHKERRQ(ierr); A->data = (void *) p; p->ht = NULL; p->dnz = NULL; p->onz = NULL; /* matrix ops */ ierr = PetscMemzero(A->ops, sizeof(struct _MatOps));CHKERRQ(ierr); A->ops->destroy = MatDestroy_Preallocator; A->ops->setup = MatSetUp_Preallocator; A->ops->setvalues = MatSetValues_Preallocator; A->ops->assemblybegin = MatAssemblyBegin_Preallocator; A->ops->assemblyend = MatAssemblyEnd_Preallocator; A->ops->view = MatView_Preallocator; A->ops->setoption = MatSetOption_Preallocator; /* special MATPREALLOCATOR functions */ ierr = PetscObjectComposeFunction((PetscObject) A, "MatPreallocatorPreallocate_C", MatPreallocatorPreallocate_Preallocator);CHKERRQ(ierr); ierr = PetscObjectChangeTypeName((PetscObject) A, MATPREALLOCATOR);CHKERRQ(ierr); PetscFunctionReturn(0); }
static PetscErrorCode BVOrthogonalize_GS(BV V,Mat R) { PetscErrorCode ierr; PetscScalar *r=NULL; PetscReal norm; PetscInt j,ldr; PetscFunctionBegin; ldr = V->k; if (R) { ierr = MatDenseGetArray(R,&r);CHKERRQ(ierr); ierr = PetscMemzero(r+V->l*ldr,ldr*(ldr-V->l)*sizeof(PetscScalar));CHKERRQ(ierr); } for (j=V->l;j<V->k;j++) { if (R) { ierr = BVOrthogonalizeColumn(V,j,r+j*ldr,&norm,NULL);CHKERRQ(ierr); r[j+j*ldr] = norm; } else { ierr = BVOrthogonalizeColumn(V,j,NULL,&norm,NULL);CHKERRQ(ierr); } ierr = BVScaleColumn(V,j,1.0/norm);CHKERRQ(ierr); } if (R) { ierr = MatDenseRestoreArray(R,&r);CHKERRQ(ierr); } PetscFunctionReturn(0); }
PetscErrorCode MatGetDiagonalHermitian_Normal(Mat N,Vec v) { Mat_Normal *Na = (Mat_Normal*)N->data; Mat A = Na->A; PetscErrorCode ierr; PetscInt i,j,rstart,rend,nnz; const PetscInt *cols; PetscScalar *diag,*work,*values; const PetscScalar *mvalues; PetscFunctionBegin; ierr = PetscMalloc2(A->cmap->N,&diag,A->cmap->N,&work);CHKERRQ(ierr); ierr = PetscMemzero(work,A->cmap->N*sizeof(PetscScalar));CHKERRQ(ierr); ierr = MatGetOwnershipRange(A,&rstart,&rend);CHKERRQ(ierr); for (i=rstart; i<rend; i++) { ierr = MatGetRow(A,i,&nnz,&cols,&mvalues);CHKERRQ(ierr); for (j=0; j<nnz; j++) { work[cols[j]] += mvalues[j]*PetscConj(mvalues[j]); } ierr = MatRestoreRow(A,i,&nnz,&cols,&mvalues);CHKERRQ(ierr); } ierr = MPIU_Allreduce(work,diag,A->cmap->N,MPIU_SCALAR,MPIU_SUM,PetscObjectComm((PetscObject)N));CHKERRQ(ierr); rstart = N->cmap->rstart; rend = N->cmap->rend; ierr = VecGetArray(v,&values);CHKERRQ(ierr); ierr = PetscMemcpy(values,diag+rstart,(rend-rstart)*sizeof(PetscScalar));CHKERRQ(ierr); ierr = VecRestoreArray(v,&values);CHKERRQ(ierr); ierr = PetscFree2(diag,work);CHKERRQ(ierr); ierr = VecScale(v,Na->scale);CHKERRQ(ierr); PetscFunctionReturn(0); }
/*@C KSPSetType - Builds KSP for a particular solver. Logically Collective on KSP Input Parameters: + ksp - the Krylov space context - type - a known method Options Database Key: . -ksp_type <method> - Sets the method; use -help for a list of available methods (for instance, cg or gmres) Notes: See "petsc/include/petscksp.h" for available methods (for instance, KSPCG or KSPGMRES). Normally, it is best to use the KSPSetFromOptions() command and then set the KSP type from the options database rather than by using this routine. Using the options database provides the user with maximum flexibility in evaluating the many different Krylov methods. The KSPSetType() routine is provided for those situations where it is necessary to set the iterative solver independently of the command line or options database. This might be the case, for example, when the choice of iterative solver changes during the execution of the program, and the user's application is taking responsibility for choosing the appropriate method. In other words, this routine is not for beginners. Level: intermediate Developer Note: KSPRegister() is used to add Krylov types to KSPList from which they are accessed by KSPSetType(). .keywords: KSP, set, method .seealso: PCSetType(), KSPType, KSPRegister(), KSPCreate() @*/ PetscErrorCode KSPSetType(KSP ksp, KSPType type) { PetscErrorCode ierr,(*r)(KSP); PetscBool match; PetscFunctionBegin; PetscValidHeaderSpecific(ksp,KSP_CLASSID,1); PetscValidCharPointer(type,2); ierr = PetscObjectTypeCompare((PetscObject)ksp,type,&match);CHKERRQ(ierr); if (match) PetscFunctionReturn(0); ierr = PetscFunctionListFind(KSPList,type,&r);CHKERRQ(ierr); if (!r) SETERRQ1(PetscObjectComm((PetscObject)ksp),PETSC_ERR_ARG_UNKNOWN_TYPE,"Unable to find requested KSP type %s",type); /* Destroy the previous private KSP context */ if (ksp->ops->destroy) { ierr = (*ksp->ops->destroy)(ksp);CHKERRQ(ierr); ksp->ops->destroy = NULL; } /* Reinitialize function pointers in KSPOps structure */ ierr = PetscMemzero(ksp->ops,sizeof(struct _KSPOps));CHKERRQ(ierr); ksp->ops->buildsolution = KSPBuildSolutionDefault; ksp->ops->buildresidual = KSPBuildResidualDefault; ierr = KSPNormSupportTableReset_Private(ksp);CHKERRQ(ierr); /* Call the KSPCreate_XXX routine for this particular Krylov solver */ ksp->setupstage = KSP_SETUP_NEW; ierr = PetscObjectChangeTypeName((PetscObject)ksp,type);CHKERRQ(ierr); ierr = (*r)(ksp);CHKERRQ(ierr); PetscFunctionReturn(0); }
/*@C EPSSetType - Selects the particular solver to be used in the EPS object. Logically Collective on EPS Input Parameters: + eps - the eigensolver context - type - a known method Options Database Key: . -eps_type <method> - Sets the method; use -help for a list of available methods Notes: See "slepc/include/slepceps.h" for available methods. The default is EPSKRYLOVSCHUR. Normally, it is best to use the EPSSetFromOptions() command and then set the EPS type from the options database rather than by using this routine. Using the options database provides the user with maximum flexibility in evaluating the different available methods. The EPSSetType() routine is provided for those situations where it is necessary to set the iterative solver independently of the command line or options database. Level: intermediate .seealso: STSetType(), EPSType @*/ PetscErrorCode EPSSetType(EPS eps,EPSType type) { PetscErrorCode ierr,(*r)(EPS); PetscBool match; PetscFunctionBegin; PetscValidHeaderSpecific(eps,EPS_CLASSID,1); PetscValidCharPointer(type,2); ierr = PetscObjectTypeCompare((PetscObject)eps,type,&match); CHKERRQ(ierr); if (match) PetscFunctionReturn(0); ierr = PetscFunctionListFind(EPSList,type,&r); CHKERRQ(ierr); if (!r) SETERRQ1(PetscObjectComm((PetscObject)eps),PETSC_ERR_ARG_UNKNOWN_TYPE,"Unknown EPS type given: %s",type); if (eps->ops->destroy) { ierr = (*eps->ops->destroy)(eps); CHKERRQ(ierr); } ierr = PetscMemzero(eps->ops,sizeof(struct _EPSOps)); CHKERRQ(ierr); eps->state = EPS_STATE_INITIAL; ierr = PetscObjectChangeTypeName((PetscObject)eps,type); CHKERRQ(ierr); ierr = (*r)(eps); CHKERRQ(ierr); PetscFunctionReturn(0); }
/*@C PetscViewerVUPrintDeferred - Prints to the deferred write cache instead of the file. Not Collective Input Parameters: + viewer - The PetscViewer - format - The format string Level: intermediate .keywords: Viewer, print, deferred .seealso: PetscViewerVUFlushDeferred() @*/ PetscErrorCode PetscViewerVUPrintDeferred(PetscViewer viewer, const char format[], ...) { PetscViewer_VU *vu = (PetscViewer_VU*) viewer->data; va_list Argp; size_t fullLength; PrintfQueue next; PetscErrorCode ierr; PetscFunctionBegin; ierr = PetscNew(struct _PrintfQueue, &next);CHKERRQ(ierr); if (vu->queue) { vu->queue->next = next; vu->queue = next; vu->queue->next = NULL; } else { vu->queueBase = vu->queue = next; } vu->queueLength++; va_start(Argp, format); ierr = PetscMemzero(next->string,QUEUESTRINGSIZE);CHKERRQ(ierr); ierr = PetscVSNPrintf(next->string, QUEUESTRINGSIZE,format,&fullLength, Argp);CHKERRQ(ierr); va_end(Argp); PetscFunctionReturn(0); }
/*@C TSSetType - Sets the method for the timestepping solver. Collective on TS Input Parameters: + ts - The TS context - type - A known method Options Database Command: . -ts_type <type> - Sets the method; use -help for a list of available methods (for instance, euler) Notes: See "petsc/include/petscts.h" for available methods (for instance) + TSEULER - Euler . TSSUNDIALS - SUNDIALS interface . TSBEULER - Backward Euler - TSPSEUDO - Pseudo-timestepping Normally, it is best to use the TSSetFromOptions() command and then set the TS type from the options database rather than by using this routine. Using the options database provides the user with maximum flexibility in evaluating the many different solvers. The TSSetType() routine is provided for those situations where it is necessary to set the timestepping solver independently of the command line or options database. This might be the case, for example, when the choice of solver changes during the execution of the program, and the user's application is taking responsibility for choosing the appropriate method. In other words, this routine is not for beginners. Level: intermediate .keywords: TS, set, type @*/ PetscErrorCode TSSetType(TS ts,TSType type) { PetscErrorCode (*r)(TS); PetscBool match; PetscErrorCode ierr; PetscFunctionBegin; PetscValidHeaderSpecific(ts, TS_CLASSID,1); ierr = PetscObjectTypeCompare((PetscObject) ts, type, &match);CHKERRQ(ierr); if (match) PetscFunctionReturn(0); ierr = PetscFunctionListFind(((PetscObject)ts)->comm,TSList, type,PETSC_TRUE, (void (**)(void)) &r);CHKERRQ(ierr); if (!r) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_UNKNOWN_TYPE, "Unknown TS type: %s", type); if (ts->ops->destroy) { ierr = (*(ts)->ops->destroy)(ts);CHKERRQ(ierr); ts->ops->destroy = PETSC_NULL; } ierr = PetscMemzero(ts->ops,sizeof(*ts->ops));CHKERRQ(ierr); ts->setupcalled = PETSC_FALSE; ierr = PetscObjectChangeTypeName((PetscObject)ts, type);CHKERRQ(ierr); ierr = (*r)(ts);CHKERRQ(ierr); #if defined(PETSC_HAVE_AMS) if (PetscAMSPublishAll) { ierr = PetscObjectAMSPublish((PetscObject)ts);CHKERRQ(ierr); } #endif PetscFunctionReturn(0); }
/* PetscHeaderCreate_Private - Creates a base PETSc object header and fills in the default values. Called by the macro PetscHeaderCreate(). */ PetscErrorCode PetscHeaderCreate_Private(PetscObject h,PetscClassId classid,const char class_name[],const char descr[],const char mansec[], MPI_Comm comm,PetscObjectDestroyFunction destroy,PetscObjectViewFunction view) { static PetscInt idcnt = 1; PetscErrorCode ierr; #if defined(PETSC_USE_LOG) PetscObject *newPetscObjects; PetscInt newPetscObjectsMaxCounts,i; #endif PetscFunctionBegin; h->classid = classid; h->type = 0; h->class_name = (char*)class_name; h->description = (char*)descr; h->mansec = (char*)mansec; h->prefix = 0; h->refct = 1; #if defined(PETSC_HAVE_SAWS) h->amsmem = PETSC_FALSE; #endif h->id = idcnt++; h->parentid = 0; h->qlist = 0; h->olist = 0; h->bops->destroy = destroy; h->bops->view = view; h->bops->getcomm = PetscObjectGetComm_Petsc; h->bops->compose = PetscObjectCompose_Petsc; h->bops->query = PetscObjectQuery_Petsc; h->bops->composefunction = PetscObjectComposeFunction_Petsc; h->bops->queryfunction = PetscObjectQueryFunction_Petsc; ierr = PetscCommDuplicate(comm,&h->comm,&h->tag);CHKERRQ(ierr); #if defined(PETSC_USE_LOG) /* Keep a record of object created */ if (PetscObjectsLog) { PetscObjectsCounts++; for (i=0; i<PetscObjectsMaxCounts; i++) { if (!PetscObjects[i]) { PetscObjects[i] = h; PetscFunctionReturn(0); } } /* Need to increase the space for storing PETSc objects */ if (!PetscObjectsMaxCounts) newPetscObjectsMaxCounts = 100; else newPetscObjectsMaxCounts = 2*PetscObjectsMaxCounts; ierr = PetscMalloc1(newPetscObjectsMaxCounts,&newPetscObjects);CHKERRQ(ierr); ierr = PetscMemcpy(newPetscObjects,PetscObjects,PetscObjectsMaxCounts*sizeof(PetscObject));CHKERRQ(ierr); ierr = PetscMemzero(newPetscObjects+PetscObjectsMaxCounts,(newPetscObjectsMaxCounts - PetscObjectsMaxCounts)*sizeof(PetscObject));CHKERRQ(ierr); ierr = PetscFree(PetscObjects);CHKERRQ(ierr); PetscObjects = newPetscObjects; PetscObjects[PetscObjectsMaxCounts] = h; PetscObjectsMaxCounts = newPetscObjectsMaxCounts; } #endif PetscFunctionReturn(0); }
PetscErrorCode KSPComputeEigenvalues_CG(KSP ksp,PetscInt nmax,PetscReal *r,PetscReal *c,PetscInt *neig) { KSP_CG *cgP = (KSP_CG*)ksp->data; PetscScalar *d,*e; PetscReal *ee; PetscErrorCode ierr; PetscInt j,n = ksp->its; PetscFunctionBegin; if (nmax < n) SETERRQ(PetscObjectComm((PetscObject)ksp),PETSC_ERR_ARG_SIZ,"Not enough room in work space r and c for eigenvalues"); *neig = n; ierr = PetscMemzero(c,nmax*sizeof(PetscReal));CHKERRQ(ierr); if (!n) { PetscFunctionReturn(0); } d = cgP->d; e = cgP->e; ee = cgP->ee; /* copy tridiagonal matrix to work space */ for (j=0; j<n; j++) { r[j] = PetscRealPart(d[j]); ee[j] = PetscRealPart(e[j]); } LINPACKcgtql1(&n,r,ee,&j); if (j != 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error from tql1(); eispack eigenvalue routine"); ierr = PetscSortReal(n,r);CHKERRQ(ierr); PetscFunctionReturn(0); }
/*@C SNESMSRegister - register a multistage scheme Not Collective, but the same schemes should be registered on all processes on which they will be used Input Parameters: + name - identifier for method . nstages - number of stages . nregisters - number of registers used by low-storage implementation . gamma - coefficients, see Ketcheson's paper . delta - coefficients, see Ketcheson's paper - betasub - subdiagonal of Shu-Osher form Notes: The notation is described in Ketcheson (2010) Runge-Kutta methods with minimum storage implementations. Level: advanced .keywords: SNES, register .seealso: SNESMS @*/ PetscErrorCode SNESMSRegister(const SNESMSType name,PetscInt nstages,PetscInt nregisters,PetscReal stability,const PetscReal gamma[],const PetscReal delta[],const PetscReal betasub[]) { PetscErrorCode ierr; SNESMSTableauLink link; SNESMSTableau t; PetscFunctionBegin; PetscValidCharPointer(name,1); if (nstages < 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Must have at least one stage"); if (nregisters != 3) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Only support for methods written in 3-register form"); PetscValidPointer(gamma,4); PetscValidPointer(delta,5); PetscValidPointer(betasub,6); ierr = PetscMalloc(sizeof(*link),&link);CHKERRQ(ierr); ierr = PetscMemzero(link,sizeof(*link));CHKERRQ(ierr); t = &link->tab; ierr = PetscStrallocpy(name,&t->name);CHKERRQ(ierr); t->nstages = nstages; t->nregisters = nregisters; t->stability = stability; ierr = PetscMalloc3(nstages*nregisters,PetscReal,&t->gamma,nstages,PetscReal,&t->delta,nstages,PetscReal,&t->betasub);CHKERRQ(ierr); ierr = PetscMemcpy(t->gamma,gamma,nstages*nregisters*sizeof(PetscReal));CHKERRQ(ierr); ierr = PetscMemcpy(t->delta,delta,nstages*sizeof(PetscReal));CHKERRQ(ierr); ierr = PetscMemcpy(t->betasub,betasub,nstages*sizeof(PetscReal));CHKERRQ(ierr); link->next = SNESMSTableauList; SNESMSTableauList = link; PetscFunctionReturn(0); }
PetscErrorCode DMPlexPreallocateOperator_2(DM dm, PetscInt bs, PetscSection section, PetscSection sectionGlobal, PetscInt dnz[], PetscInt onz[], PetscInt dnzu[], PetscInt onzu[], Mat A, PetscBool fillMatrix) { PetscInt *tmpClosure,*tmpAdj,*visits; PetscInt c,cStart,cEnd,pStart,pEnd; PetscErrorCode ierr; PetscFunctionBegin; ierr = DMGetDimension(dm, &dim);CHKERRQ(ierr); ierr = DMPlexGetDepth(dm, &depth);CHKERRQ(ierr); ierr = DMPlexGetMaxSizes(dm, &maxConeSize, &maxSupportSize);CHKERRQ(ierr); maxClosureSize = 2*PetscMax(PetscPowInt(mesh->maxConeSize,depth+1),PetscPowInt(mesh->maxSupportSize,depth+1)); ierr = PetscSectionGetChart(section, &pStart, &pEnd);CHKERRQ(ierr); npoints = pEnd - pStart; ierr = PetscMalloc3(maxClosureSize,&tmpClosure,npoints,&lvisits,npoints,&visits);CHKERRQ(ierr); ierr = PetscMemzero(lvisits,(pEnd-pStart)*sizeof(PetscInt));CHKERRQ(ierr); ierr = PetscMemzero(visits,(pEnd-pStart)*sizeof(PetscInt));CHKERRQ(ierr); ierr = DMPlexGetHeightStratum(dm, 0, &cStart, &cEnd);CHKERRQ(ierr); for (c=cStart; c<cEnd; c++) { PetscInt *support = tmpClosure; ierr = DMPlexGetTransitiveClosure(dm, c, PETSC_FALSE, &supportSize, (PetscInt**)&support);CHKERRQ(ierr); for (p=0; p<supportSize; p++) lvisits[support[p]]++; } ierr = PetscSFReduceBegin(sf,MPIU_INT,lvisits,visits,MPI_SUM);CHKERRQ(ierr); ierr = PetscSFReduceEnd (sf,MPIU_INT,lvisits,visits,MPI_SUM);CHKERRQ(ierr); ierr = PetscSFBcastBegin(sf,MPIU_INT,visits,lvisits);CHKERRQ(ierr); ierr = PetscSFBcastEnd (sf,MPIU_INT,visits,lvisits);CHKERRQ(ierr); ierr = PetscSFGetRanks();CHKERRQ(ierr); ierr = PetscMalloc2(maxClosureSize*maxClosureSize,&cellmat,npoints,&owner);CHKERRQ(ierr); for (c=cStart; c<cEnd; c++) { ierr = PetscMemzero(cellmat,maxClosureSize*maxClosureSize*sizeof(PetscInt));CHKERRQ(ierr); /* Depth-first walk of transitive closure. At each leaf frame f of transitive closure that we see, add 1/visits[f] to each pair (p,q) not marked as done in cellmat. This contribution is added to dnz if owning ranks of p and q match, to onz otherwise. */ } ierr = PetscSFReduceBegin(sf,MPIU_INT,ldnz,dnz,MPI_SUM);CHKERRQ(ierr); ierr = PetscSFReduceEnd (sf,MPIU_INT,lonz,onz,MPI_SUM);CHKERRQ(ierr); PetscFunctionReturn(0); }
static gs_id *gsi_new(void) { PetscErrorCode ierr; gs_id *gs; gs = (gs_id *) malloc(sizeof(gs_id)); ierr = PetscMemzero(gs,sizeof(gs_id));CHKERRABORT(PETSC_COMM_WORLD,ierr); return(gs); }