/*@C
DMMGSolve - Actually solves the (non)linear system defined with the DMMG
Collective on DMMG
Input Parameter:
. dmmg - the context
Level: advanced
Options Database:
+ -dmmg_grid_sequence - use grid sequencing to get the initial solution for each level from the previous
- -dmmg_monitor_solution - display the solution at each iteration
Notes: For linear (KSP) problems may be called more than once, uses the same
matrices but recomputes the right hand side for each new solve. Call DMMGSetKSP()
to generate new matrices.
.seealso DMMGCreate(), DMMGDestroy(), DMMG, DMMGSetSNES(), DMMGSetKSP(), DMMGSetUp(), DMMGSetMatType()
@*/
PetscErrorCode PETSCSNES_DLLEXPORT DMMGSolve(DMMG *dmmg)
{
PetscErrorCode ierr;
PetscInt i,nlevels = dmmg[0]->nlevels;
PetscTruth gridseq = PETSC_FALSE,vecmonitor = PETSC_FALSE,flg;
PetscFunctionBegin;
ierr = PetscOptionsGetTruth(0,"-dmmg_grid_sequence",&gridseq,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetTruth(0,"-dmmg_monitor_solution",&vecmonitor,PETSC_NULL);CHKERRQ(ierr);
if (gridseq) {
if (dmmg[0]->initialguess) {
ierr = (*dmmg[0]->initialguess)(dmmg[0],dmmg[0]->x);CHKERRQ(ierr);
if (dmmg[0]->ksp && !dmmg[0]->snes) {
ierr = KSPSetInitialGuessNonzero(dmmg[0]->ksp,PETSC_TRUE);CHKERRQ(ierr);
}
}
for (i=0; i<nlevels-1; i++) {
ierr = (*dmmg[i]->solve)(dmmg,i);CHKERRQ(ierr);
if (vecmonitor) {
ierr = VecView(dmmg[i]->x,PETSC_VIEWER_DRAW_(dmmg[i]->comm));CHKERRQ(ierr);
}
ierr = MatInterpolate(dmmg[i+1]->R,dmmg[i]->x,dmmg[i+1]->x);CHKERRQ(ierr);
if (dmmg[i+1]->ksp && !dmmg[i+1]->snes) {
ierr = KSPSetInitialGuessNonzero(dmmg[i+1]->ksp,PETSC_TRUE);CHKERRQ(ierr);
}
}
} else {
if (dmmg[nlevels-1]->initialguess) {
ierr = (*dmmg[nlevels-1]->initialguess)(dmmg[nlevels-1],dmmg[nlevels-1]->x);CHKERRQ(ierr);
}
}
/*ierr = VecView(dmmg[nlevels-1]->x,PETSC_VIEWER_DRAW_WORLD);CHKERRQ(ierr);*/
ierr = (*DMMGGetFine(dmmg)->solve)(dmmg,nlevels-1);CHKERRQ(ierr);
if (vecmonitor) {
ierr = VecView(dmmg[nlevels-1]->x,PETSC_VIEWER_DRAW_(dmmg[nlevels-1]->comm));CHKERRQ(ierr);
}
flg = PETSC_FALSE;
ierr = PetscOptionsGetTruth(PETSC_NULL,"-dmmg_view",&flg,PETSC_NULL);CHKERRQ(ierr);
if (flg && !PetscPreLoadingOn) {
PetscViewer viewer;
ierr = PetscViewerASCIIGetStdout(dmmg[0]->comm,&viewer);CHKERRQ(ierr);
ierr = DMMGView(dmmg,viewer);CHKERRQ(ierr);
}
flg = PETSC_FALSE;
ierr = PetscOptionsGetTruth(PETSC_NULL,"-dmmg_view_binary",&flg,PETSC_NULL);CHKERRQ(ierr);
if (flg && !PetscPreLoadingOn) {
ierr = DMMGView(dmmg,PETSC_VIEWER_BINARY_(dmmg[0]->comm));CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
static PetscErrorCode bfgs_apply(PC pc, Vec xin, Vec xout)
{
TaoLMVMMat *M ;
TaoVecPetsc Xin(xin);
TaoVecPetsc Xout(xout);
TaoTruth info2;
int info;
PetscFunctionBegin;
PetscTruth VerbosePrint = PETSC_FALSE;
PetscOptionsGetTruth(PETSC_NULL,"-verboseapp",&VerbosePrint,PETSC_NULL);
info = PCShellGetContext(pc,(void**)&M); CHKERRQ(info);
PetscScalar solnNorm,solnDot;
info = VecNorm(xin,NORM_2,&solnNorm); CHKERRQ(info)
info=PetscPrintf(PETSC_COMM_WORLD,"bfgs_apply: ||Xin||_2 = %22.15e\n",solnNorm);
if(VerbosePrint) VecView(xin,0);
info = M->Solve(&Xin, &Xout, &info2); CHKERRQ(info);
info = VecNorm(xout,NORM_2,&solnNorm); CHKERRQ(info)
info = VecDot(xin,xout,&solnDot); CHKERRQ(info)
info=PetscPrintf(PETSC_COMM_WORLD,"bfgs_apply: ||Xout||_2 = %22.15e, Xin^T Xout= %22.15e\n",solnNorm,solnDot);
if(VerbosePrint) VecView(xout,0);
PetscFunctionReturn(0);
}
/*
Only the options related to GtKG should be set here.
*/
PetscErrorCode BSSCR_PCSetFromOptions_GtKG( PC pc )
{
PC_GtKG ctx = (PC_GtKG)pc->data;
PetscTruth ivalue, flg;
PetscOptionsGetTruth( PETSC_NULL, "-pc_gtkg_monitor", &ivalue, &flg );
if( flg==PETSC_TRUE ) {
ctx->monitor_activated = ivalue;
}
PetscOptionsGetTruth( PETSC_NULL, "-pc_gtkg_monitor_rhs_consistency", &ivalue, &flg );
if( flg==PETSC_TRUE ) {
ctx->monitor_rhs_consistency = ivalue;
}
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
PetscMPIInt rank;
PetscInt m = PETSC_DECIDE,n = PETSC_DECIDE,p = PETSC_DECIDE,M = 3,N = 5,P=3,s=1;
PetscInt *lx = PETSC_NULL,*ly = PETSC_NULL,*lz = PETSC_NULL;
PetscErrorCode ierr;
PetscTruth flg = PETSC_FALSE;
DA da;
Vec local,global,vslice;
PetscScalar value;
DAPeriodicType wrap = DA_XYPERIODIC;
DAStencilType stencil_type = DA_STENCIL_BOX;
VecScatter scatter;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
/* Read options */
ierr = PetscOptionsGetInt(PETSC_NULL,"-M",&M,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-N",&N,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-P",&P,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-m",&m,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-n",&n,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-p",&p,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-s",&s,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetTruth(PETSC_NULL,"-star",&flg,PETSC_NULL);CHKERRQ(ierr);
if (flg) stencil_type = DA_STENCIL_STAR;
/* Create distributed array and get vectors */
ierr = DACreate3d(PETSC_COMM_WORLD,wrap,stencil_type,M,N,P,m,n,p,1,s,
lx,ly,lz,&da);CHKERRQ(ierr);
ierr = DAView(da,PETSC_VIEWER_DRAW_WORLD);CHKERRQ(ierr);
ierr = DACreateGlobalVector(da,&global);CHKERRQ(ierr);
ierr = DACreateLocalVector(da,&local);CHKERRQ(ierr);
ierr = GenerateSliceScatter(da,&scatter,&vslice);CHKERRQ(ierr);
/* Put the value rank+1 into all locations of vslice and transfer back to global vector */
value = 1.0 + rank;
ierr = VecSet(vslice,value);CHKERRQ(ierr);
ierr = VecScatterBegin(scatter,vslice,global,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecScatterEnd(scatter,vslice,global,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
ierr = VecView(global,PETSC_VIEWER_DRAW_WORLD);CHKERRQ(ierr);
ierr = VecDestroy(local);CHKERRQ(ierr);
ierr = VecDestroy(global);CHKERRQ(ierr);
ierr = DADestroy(da);CHKERRQ(ierr);
ierr = PetscFinalize();CHKERRQ(ierr);
return 0;
}
/*
Only the options related to GtKG should be set here.
*/
PetscErrorCode BSSCR_PCSetFromOptions_ScGtKG( PC pc )
{
PC_SC_GtKG ctx = (PC_SC_GtKG)pc->data;
PetscTruth ivalue, flg;
if(ctx->ksp_BBt!=PETSC_NULL) {
PetscOptionsGetTruth( PETSC_NULL, "-pc_gtkg_monitor", &ivalue, &flg );
BSSCR_PCScGtKGSetSubKSPMonitor( pc, ivalue );
}
PetscFunctionReturn(0);
}
/*
PFStringCreateFunction - Creates a function from a string
Collective over PF
Input Parameters:
+ pf - the function object
- string - the string that defines the function
Output Parameter:
. f - the function pointer.
.seealso: PFSetFromOptions()
*/
PetscErrorCode PETSCVEC_DLLEXPORT PFStringCreateFunction(PF pf,char *string,void **f)
{
#if defined(PETSC_USE_DYNAMIC_LIBRARIES)
PetscErrorCode ierr;
char task[1024],tmp[256],lib[PETSC_MAX_PATH_LEN],username[64];
FILE *fd;
PetscTruth tmpshared,wdshared,keeptmpfiles = PETSC_FALSE;
MPI_Comm comm;
#endif
PetscFunctionBegin;
#if defined(PETSC_USE_DYNAMIC_LIBRARIES)
ierr = PetscStrfree(pf->data);CHKERRQ(ierr);
ierr = PetscStrallocpy(string,(char**)&pf->data);CHKERRQ(ierr);
/* create the new C function and compile it */
ierr = PetscSharedTmp(((PetscObject)pf)->comm,&tmpshared);CHKERRQ(ierr);
ierr = PetscSharedWorkingDirectory(((PetscObject)pf)->comm,&wdshared);CHKERRQ(ierr);
if (tmpshared) { /* do it in /tmp since everyone has one */
ierr = PetscGetTmp(((PetscObject)pf)->comm,tmp,PETSC_MAX_PATH_LEN);CHKERRQ(ierr);
comm = ((PetscObject)pf)->comm;
} else if (!wdshared) { /* each one does in private /tmp */
ierr = PetscGetTmp(((PetscObject)pf)->comm,tmp,PETSC_MAX_PATH_LEN);CHKERRQ(ierr);
comm = PETSC_COMM_SELF;
} else { /* do it in current directory */
ierr = PetscStrcpy(tmp,".");CHKERRQ(ierr);
comm = ((PetscObject)pf)->comm;
}
ierr = PetscOptionsGetTruth(((PetscObject)pf)->prefix,"-pf_string_keep_files",&keeptmpfiles,PETSC_NULL);CHKERRQ(ierr);
if (keeptmpfiles) {
sprintf(task,"cd %s ; mkdir ${USERNAME} ; cd ${USERNAME} ; \\cp -f ${PETSC_DIR}/src/pf/impls/string/makefile ./makefile ; ke MIN=%d NOUT=%d petscdlib STRINGFUNCTION=\"%s\" ; sync\n",tmp,(int)pf->dimin,(int)pf->dimout,string);
} else {
sprintf(task,"cd %s ; mkdir ${USERNAME} ;cd ${USERNAME} ; \\cp -f ${PETSC_DIR}/src/pf/impls/string/makefile ./makefile ; make MIN=%d NOUT=%d -f makefile petscdlib STRINGFUNCTION=\"%s\" ; \\rm -f makefile petscdlib.c libpetscdlib.a ; sync\n",tmp,(int)pf->dimin,(int)pf->dimout,string);
}
#if defined(PETSC_HAVE_POPEN)
ierr = PetscPOpen(comm,PETSC_NULL,task,"r",&fd);CHKERRQ(ierr);
ierr = PetscPClose(comm,fd);CHKERRQ(ierr);
#else
SETERRQ(PETSC_ERR_SUP_SYS,"Cannot run external programs on this machine");
#endif
ierr = MPI_Barrier(comm);CHKERRQ(ierr);
/* load the apply function from the dynamic library */
ierr = PetscGetUserName(username,64);CHKERRQ(ierr);
sprintf(lib,"%s/%s/libpetscdlib",tmp,username);
ierr = PetscDLLibrarySym(comm,PETSC_NULL,lib,"PFApply_String",f);CHKERRQ(ierr);
#endif
PetscFunctionReturn(0);
}
/*@C
DMMGSetDM - Sets the coarse grid information for the grids
Collective on DMMG
Input Parameter:
+ dmmg - the context
- dm - the DA or DMComposite object
Options Database Keys:
. -dmmg_refine: Use the input problem as the coarse level and refine. Otherwise, use it as the fine level and coarsen.
Level: advanced
.seealso DMMGCreate(), DMMGDestroy(), DMMGSetMatType()
@*/
PetscErrorCode PETSCSNES_DLLEXPORT DMMGSetDM(DMMG *dmmg, DM dm)
{
PetscInt nlevels = dmmg[0]->nlevels;
PetscTruth doRefine = PETSC_TRUE;
PetscInt i;
DM *hierarchy;
PetscErrorCode ierr;
PetscFunctionBegin;
if (!dmmg) SETERRQ(PETSC_ERR_ARG_NULL,"Passing null as DMMG");
/* Create DM data structure for all the levels */
ierr = PetscOptionsGetTruth(PETSC_NULL, "-dmmg_refine", &doRefine, PETSC_IGNORE);CHKERRQ(ierr);
ierr = PetscObjectReference((PetscObject) dm);CHKERRQ(ierr);
ierr = PetscMalloc(nlevels*sizeof(DM),&hierarchy);CHKERRQ(ierr);
if (doRefine) {
ierr = DMRefineHierarchy(dm,nlevels-1,hierarchy);CHKERRQ(ierr);
dmmg[0]->dm = dm;
for(i=1; i<nlevels; ++i) {
dmmg[i]->dm = hierarchy[i-1];
}
} else {
dmmg[nlevels-1]->dm = dm;
ierr = DMCoarsenHierarchy(dm,nlevels-1,hierarchy);CHKERRQ(ierr);
for(i=0; i<nlevels-1; ++i) {
dmmg[nlevels-2-i]->dm = hierarchy[i];
}
}
ierr = PetscFree(hierarchy);CHKERRQ(ierr);
/* Cleanup old structures (should use some private Destroy() instead) */
for(i = 0; i < nlevels; ++i) {
if (dmmg[i]->B) {ierr = MatDestroy(dmmg[i]->B);CHKERRQ(ierr); dmmg[i]->B = PETSC_NULL;}
if (dmmg[i]->J) {ierr = MatDestroy(dmmg[i]->J);CHKERRQ(ierr); dmmg[i]->J = PETSC_NULL;}
}
/* Create work vectors and matrix for each level */
for (i=0; i<nlevels; i++) {
ierr = DMCreateGlobalVector(dmmg[i]->dm,&dmmg[i]->x);CHKERRQ(ierr);
ierr = VecDuplicate(dmmg[i]->x,&dmmg[i]->b);CHKERRQ(ierr);
ierr = VecDuplicate(dmmg[i]->x,&dmmg[i]->r);CHKERRQ(ierr);
}
/* Create interpolation/restriction between levels */
for (i=1; i<nlevels; i++) {
ierr = DMGetInterpolation(dmmg[i-1]->dm,dmmg[i]->dm,&dmmg[i]->R,PETSC_NULL);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/* Sets up Solver to be a custom ksp (KSP_BSSCR) solve by default: */
void _StokesBlockKSPInterface_Solve( void* solver, void* _stokesSLE ) {
StokesBlockKSPInterface* self = (StokesBlockKSPInterface*)solver;
PetscLogDouble flopsA,flopsB;
PetscTruth found, get_flops;
found = PETSC_FALSE;
get_flops = PETSC_FALSE;
PetscOptionsGetTruth( PETSC_NULL, "-get_flops", &get_flops, &found);
if(get_flops){
PetscGetFlops(&flopsA); }
_BlockSolve(solver, _stokesSLE);
if(get_flops){
PetscGetFlops(&flopsB);
self->stats.total_flops=(double)(flopsB-flopsA); }
}
void bsscr_writeMat(Mat K, char name[], char message[]){
PetscViewer mat_view_file;
char str[100];
PetscTruth dump=PETSC_FALSE;
PetscOptionsGetTruth( PETSC_NULL ,"-dump_matvec", &dump, 0 );
if(dump){
if( K != NULL ) {
PetscPrintf( PETSC_COMM_WORLD,"%s \n",message);
PetscObjectSetName((PetscObject)K,name);
sprintf(str,"%smatrixBin",name);
PetscViewerBinaryOpen( PETSC_COMM_WORLD, str, FILE_MODE_WRITE, &mat_view_file );
PetscViewerSetFormat( mat_view_file, PETSC_VIEWER_NATIVE );
MatView( K, mat_view_file );
Stg_PetscViewerDestroy(&mat_view_file );
sprintf(str,"%smatrix.m",name);
PetscViewerASCIIOpen( PETSC_COMM_WORLD, str, &mat_view_file );
PetscViewerSetFormat( mat_view_file, PETSC_VIEWER_ASCII_MATLAB );
MatView( K, mat_view_file );
Stg_PetscViewerDestroy(&mat_view_file );
}
}
}
void bsscr_dirwriteVec(Vec V, char name[], char dir[], char message[]){
PetscViewer vec_view_file;
char str[100];
PetscTruth dump=PETSC_FALSE;
PetscOptionsGetTruth( PETSC_NULL ,"-dump_matvec", &dump, 0 );
if(dump){
if( V != NULL ) {
PetscPrintf( PETSC_COMM_WORLD,"%s \n",message);
PetscObjectSetName((PetscObject)V,name);
sprintf(str,"%s%svectorBin",dir,name);
PetscViewerBinaryOpen( PETSC_COMM_WORLD, str, FILE_MODE_WRITE, &vec_view_file );
PetscViewerSetFormat( vec_view_file, PETSC_VIEWER_NATIVE );
VecView( V, vec_view_file );
Stg_PetscViewerDestroy(&vec_view_file );
sprintf(str,"%s%svector.m",dir,name);
PetscViewerASCIIOpen( PETSC_COMM_WORLD, str, &vec_view_file );
PetscViewerSetFormat( vec_view_file, PETSC_VIEWER_ASCII_MATLAB );
VecView( V, vec_view_file );
Stg_PetscViewerDestroy(&vec_view_file );
}
}
}
int main(int argc,char **argv)
{
PetscMPIInt rank;
PetscInt M = -10,N = -8;
PetscErrorCode ierr;
PetscTruth flg = PETSC_FALSE;
DA da;
PetscViewer viewer;
Vec local,global;
PetscScalar value;
DAPeriodicType ptype = DA_NONPERIODIC;
DAStencilType stype = DA_STENCIL_BOX;
#if defined(PETSC_HAVE_MATLAB_ENGINE)
PetscViewer mviewer;
#endif
ierr = PetscInitialize(&argc,&argv,(char*)0,help);CHKERRQ(ierr);
ierr = PetscViewerDrawOpen(PETSC_COMM_WORLD,0,"",300,0,300,300,&viewer);CHKERRQ(ierr);
#if defined(PETSC_HAVE_MATLAB_ENGINE)
ierr = PetscViewerMatlabOpen(PETSC_COMM_WORLD,"tmp.mat",FILE_MODE_WRITE,&mviewer);CHKERRQ(ierr);
#endif
ierr = PetscOptionsGetTruth(PETSC_NULL,"-star_stencil",&flg,PETSC_NULL);CHKERRQ(ierr);
if (flg) stype = DA_STENCIL_STAR;
/* Create distributed array and get vectors */
ierr = DACreate2d(PETSC_COMM_WORLD,ptype,stype,M,N,PETSC_DECIDE,PETSC_DECIDE,1,1,PETSC_NULL,PETSC_NULL,&da);CHKERRQ(ierr);
ierr = DACreateGlobalVector(da,&global);CHKERRQ(ierr);
ierr = DACreateLocalVector(da,&local);CHKERRQ(ierr);
value = -3.0;
ierr = VecSet(global,value);CHKERRQ(ierr);
ierr = DAGlobalToLocalBegin(da,global,INSERT_VALUES,local);CHKERRQ(ierr);
ierr = DAGlobalToLocalEnd(da,global,INSERT_VALUES,local);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
value = rank+1;
ierr = VecScale(local,value);CHKERRQ(ierr);
ierr = DALocalToGlobal(da,local,ADD_VALUES,global);CHKERRQ(ierr);
flg = PETSC_FALSE;
ierr = PetscOptionsGetTruth(PETSC_NULL, "-view_global", &flg,PETSC_NULL);CHKERRQ(ierr);
if (flg) { /* view global vector in natural ordering */
ierr = VecView(global,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
}
ierr = DAView(da,viewer);CHKERRQ(ierr);
ierr = VecView(global,viewer);CHKERRQ(ierr);
#if defined(PETSC_HAVE_MATLAB_ENGINE)
ierr = DAView(da,mviewer);CHKERRQ(ierr);
ierr = VecView(global,mviewer);CHKERRQ(ierr);
#endif
/* Free memory */
#if defined(PETSC_HAVE_MATLAB_ENGINE)
ierr = PetscViewerDestroy(mviewer);CHKERRQ(ierr);
#endif
ierr = PetscViewerDestroy(viewer);CHKERRQ(ierr);
ierr = VecDestroy(local);CHKERRQ(ierr);
ierr = VecDestroy(global);CHKERRQ(ierr);
ierr = DADestroy(da);CHKERRQ(ierr);
ierr = PetscFinalize();CHKERRQ(ierr);
return 0;
}
/*@C
ISLocalToGlobalMappingGetInfo - Gets the neighbor information for each processor and
each index shared by more than one processor
Collective on ISLocalToGlobalMapping
Input Parameters:
. mapping - the mapping from local to global indexing
Output Parameter:
+ nproc - number of processors that are connected to this one
. proc - neighboring processors
. numproc - number of indices for each subdomain (processor)
- indices - indices of nodes (in local numbering) shared with neighbors (sorted by global numbering)
Level: advanced
Concepts: mapping^local to global
Fortran Usage:
$ ISLocalToGlobalMpngGetInfoSize(ISLocalToGlobalMapping,PetscInt nproc,PetscInt numprocmax,ierr) followed by
$ ISLocalToGlobalMappingGetInfo(ISLocalToGlobalMapping,PetscInt nproc, PetscInt procs[nproc],PetscInt numprocs[nproc],
PetscInt indices[nproc][numprocmax],ierr)
There is no ISLocalToGlobalMappingRestoreInfo() in Fortran. You must make sure that procs[], numprocs[] and
indices[][] are large enough arrays, either by allocating them dynamically or defining static ones large enough.
.seealso: ISLocalToGlobalMappingDestroy(), ISLocalToGlobalMappingCreateIS(), ISLocalToGlobalMappingCreate(),
ISLocalToGlobalMappingRestoreInfo()
@*/
PetscErrorCode PETSCVEC_DLLEXPORT ISLocalToGlobalMappingGetInfo(ISLocalToGlobalMapping mapping,PetscInt *nproc,PetscInt *procs[],PetscInt *numprocs[],PetscInt **indices[])
{
PetscErrorCode ierr;
PetscMPIInt size,rank,tag1,tag2,tag3,*len,*source,imdex;
PetscInt i,n = mapping->n,Ng,ng,max = 0,*lindices = mapping->indices;
PetscInt *nprocs,*owner,nsends,*sends,j,*starts,nmax,nrecvs,*recvs,proc;
PetscInt cnt,scale,*ownedsenders,*nownedsenders,rstart,nowned;
PetscInt node,nownedm,nt,*sends2,nsends2,*starts2,*lens2,*dest,nrecvs2,*starts3,*recvs2,k,*bprocs,*tmp;
PetscInt first_procs,first_numprocs,*first_indices;
MPI_Request *recv_waits,*send_waits;
MPI_Status recv_status,*send_status,*recv_statuses;
MPI_Comm comm = ((PetscObject)mapping)->comm;
PetscTruth debug = PETSC_FALSE;
PetscFunctionBegin;
PetscValidHeaderSpecific(mapping,IS_LTOGM_COOKIE,1);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
if (size == 1) {
*nproc = 0;
*procs = PETSC_NULL;
ierr = PetscMalloc(sizeof(PetscInt),numprocs);CHKERRQ(ierr);
(*numprocs)[0] = 0;
ierr = PetscMalloc(sizeof(PetscInt*),indices);CHKERRQ(ierr);
(*indices)[0] = PETSC_NULL;
PetscFunctionReturn(0);
}
ierr = PetscOptionsGetTruth(PETSC_NULL,"-islocaltoglobalmappinggetinfo_debug",&debug,PETSC_NULL);CHKERRQ(ierr);
/*
Notes on ISLocalToGlobalMappingGetInfo
globally owned node - the nodes that have been assigned to this processor in global
numbering, just for this routine.
nontrivial globally owned node - node assigned to this processor that is on a subdomain
boundary (i.e. is has more than one local owner)
locally owned node - node that exists on this processors subdomain
nontrivial locally owned node - node that is not in the interior (i.e. has more than one
local subdomain
*/
ierr = PetscObjectGetNewTag((PetscObject)mapping,&tag1);CHKERRQ(ierr);
ierr = PetscObjectGetNewTag((PetscObject)mapping,&tag2);CHKERRQ(ierr);
ierr = PetscObjectGetNewTag((PetscObject)mapping,&tag3);CHKERRQ(ierr);
for (i=0; i<n; i++) {
if (lindices[i] > max) max = lindices[i];
}
ierr = MPI_Allreduce(&max,&Ng,1,MPIU_INT,MPI_MAX,comm);CHKERRQ(ierr);
Ng++;
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
scale = Ng/size + 1;
ng = scale; if (rank == size-1) ng = Ng - scale*(size-1); ng = PetscMax(1,ng);
rstart = scale*rank;
/* determine ownership ranges of global indices */
ierr = PetscMalloc(2*size*sizeof(PetscInt),&nprocs);CHKERRQ(ierr);
ierr = PetscMemzero(nprocs,2*size*sizeof(PetscInt));CHKERRQ(ierr);
/* determine owners of each local node */
ierr = PetscMalloc(n*sizeof(PetscInt),&owner);CHKERRQ(ierr);
for (i=0; i<n; i++) {
proc = lindices[i]/scale; /* processor that globally owns this index */
nprocs[2*proc+1] = 1; /* processor globally owns at least one of ours */
owner[i] = proc;
nprocs[2*proc]++; /* count of how many that processor globally owns of ours */
}
nsends = 0; for (i=0; i<size; i++) nsends += nprocs[2*i+1];
ierr = PetscInfo1(mapping,"Number of global owners for my local data %d\n",nsends);CHKERRQ(ierr);
/* inform other processors of number of messages and max length*/
ierr = PetscMaxSum(comm,nprocs,&nmax,&nrecvs);CHKERRQ(ierr);
ierr = PetscInfo1(mapping,"Number of local owners for my global data %d\n",nrecvs);CHKERRQ(ierr);
/* post receives for owned rows */
ierr = PetscMalloc((2*nrecvs+1)*(nmax+1)*sizeof(PetscInt),&recvs);CHKERRQ(ierr);
ierr = PetscMalloc((nrecvs+1)*sizeof(MPI_Request),&recv_waits);CHKERRQ(ierr);
for (i=0; i<nrecvs; i++) {
ierr = MPI_Irecv(recvs+2*nmax*i,2*nmax,MPIU_INT,MPI_ANY_SOURCE,tag1,comm,recv_waits+i);CHKERRQ(ierr);
}
/* pack messages containing lists of local nodes to owners */
ierr = PetscMalloc((2*n+1)*sizeof(PetscInt),&sends);CHKERRQ(ierr);
ierr = PetscMalloc((size+1)*sizeof(PetscInt),&starts);CHKERRQ(ierr);
starts[0] = 0;
for (i=1; i<size; i++) { starts[i] = starts[i-1] + 2*nprocs[2*i-2];}
for (i=0; i<n; i++) {
sends[starts[owner[i]]++] = lindices[i];
sends[starts[owner[i]]++] = i;
}
ierr = PetscFree(owner);CHKERRQ(ierr);
starts[0] = 0;
for (i=1; i<size; i++) { starts[i] = starts[i-1] + 2*nprocs[2*i-2];}
/* send the messages */
ierr = PetscMalloc((nsends+1)*sizeof(MPI_Request),&send_waits);CHKERRQ(ierr);
ierr = PetscMalloc((nsends+1)*sizeof(PetscInt),&dest);CHKERRQ(ierr);
cnt = 0;
for (i=0; i<size; i++) {
if (nprocs[2*i]) {
ierr = MPI_Isend(sends+starts[i],2*nprocs[2*i],MPIU_INT,i,tag1,comm,send_waits+cnt);CHKERRQ(ierr);
dest[cnt] = i;
cnt++;
}
}
ierr = PetscFree(starts);CHKERRQ(ierr);
/* wait on receives */
ierr = PetscMalloc((nrecvs+1)*sizeof(PetscMPIInt),&source);CHKERRQ(ierr);
ierr = PetscMalloc((nrecvs+1)*sizeof(PetscMPIInt),&len);CHKERRQ(ierr);
cnt = nrecvs;
ierr = PetscMalloc((ng+1)*sizeof(PetscInt),&nownedsenders);CHKERRQ(ierr);
ierr = PetscMemzero(nownedsenders,ng*sizeof(PetscInt));CHKERRQ(ierr);
while (cnt) {
ierr = MPI_Waitany(nrecvs,recv_waits,&imdex,&recv_status);CHKERRQ(ierr);
/* unpack receives into our local space */
ierr = MPI_Get_count(&recv_status,MPIU_INT,&len[imdex]);CHKERRQ(ierr);
source[imdex] = recv_status.MPI_SOURCE;
len[imdex] = len[imdex]/2;
/* count how many local owners for each of my global owned indices */
for (i=0; i<len[imdex]; i++) nownedsenders[recvs[2*imdex*nmax+2*i]-rstart]++;
cnt--;
}
ierr = PetscFree(recv_waits);CHKERRQ(ierr);
/* count how many globally owned indices are on an edge multiplied by how many processors own them. */
nowned = 0;
nownedm = 0;
for (i=0; i<ng; i++) {
if (nownedsenders[i] > 1) {nownedm += nownedsenders[i]; nowned++;}
}
/* create single array to contain rank of all local owners of each globally owned index */
ierr = PetscMalloc((nownedm+1)*sizeof(PetscInt),&ownedsenders);CHKERRQ(ierr);
ierr = PetscMalloc((ng+1)*sizeof(PetscInt),&starts);CHKERRQ(ierr);
starts[0] = 0;
for (i=1; i<ng; i++) {
if (nownedsenders[i-1] > 1) starts[i] = starts[i-1] + nownedsenders[i-1];
else starts[i] = starts[i-1];
}
/* for each nontrival globally owned node list all arriving processors */
for (i=0; i<nrecvs; i++) {
for (j=0; j<len[i]; j++) {
node = recvs[2*i*nmax+2*j]-rstart;
if (nownedsenders[node] > 1) {
ownedsenders[starts[node]++] = source[i];
}
}
}
if (debug) { /* ----------------------------------- */
starts[0] = 0;
for (i=1; i<ng; i++) {
if (nownedsenders[i-1] > 1) starts[i] = starts[i-1] + nownedsenders[i-1];
else starts[i] = starts[i-1];
}
for (i=0; i<ng; i++) {
if (nownedsenders[i] > 1) {
ierr = PetscSynchronizedPrintf(comm,"[%d] global node %d local owner processors: ",rank,i+rstart);CHKERRQ(ierr);
for (j=0; j<nownedsenders[i]; j++) {
ierr = PetscSynchronizedPrintf(comm,"%d ",ownedsenders[starts[i]+j]);CHKERRQ(ierr);
}
ierr = PetscSynchronizedPrintf(comm,"\n");CHKERRQ(ierr);
}
}
ierr = PetscSynchronizedFlush(comm);CHKERRQ(ierr);
}/* ----------------------------------- */
/* wait on original sends */
if (nsends) {
ierr = PetscMalloc(nsends*sizeof(MPI_Status),&send_status);CHKERRQ(ierr);
ierr = MPI_Waitall(nsends,send_waits,send_status);CHKERRQ(ierr);
ierr = PetscFree(send_status);CHKERRQ(ierr);
}
ierr = PetscFree(send_waits);CHKERRQ(ierr);
ierr = PetscFree(sends);CHKERRQ(ierr);
ierr = PetscFree(nprocs);CHKERRQ(ierr);
/* pack messages to send back to local owners */
starts[0] = 0;
for (i=1; i<ng; i++) {
if (nownedsenders[i-1] > 1) starts[i] = starts[i-1] + nownedsenders[i-1];
else starts[i] = starts[i-1];
}
nsends2 = nrecvs;
ierr = PetscMalloc((nsends2+1)*sizeof(PetscInt),&nprocs);CHKERRQ(ierr); /* length of each message */
for (i=0; i<nrecvs; i++) {
nprocs[i] = 1;
for (j=0; j<len[i]; j++) {
node = recvs[2*i*nmax+2*j]-rstart;
if (nownedsenders[node] > 1) {
nprocs[i] += 2 + nownedsenders[node];
}
}
}
nt = 0; for (i=0; i<nsends2; i++) nt += nprocs[i];
ierr = PetscMalloc((nt+1)*sizeof(PetscInt),&sends2);CHKERRQ(ierr);
ierr = PetscMalloc((nsends2+1)*sizeof(PetscInt),&starts2);CHKERRQ(ierr);
starts2[0] = 0; for (i=1; i<nsends2; i++) starts2[i] = starts2[i-1] + nprocs[i-1];
/*
Each message is 1 + nprocs[i] long, and consists of
(0) the number of nodes being sent back
(1) the local node number,
(2) the number of processors sharing it,
(3) the processors sharing it
*/
for (i=0; i<nsends2; i++) {
cnt = 1;
sends2[starts2[i]] = 0;
for (j=0; j<len[i]; j++) {
node = recvs[2*i*nmax+2*j]-rstart;
if (nownedsenders[node] > 1) {
sends2[starts2[i]]++;
sends2[starts2[i]+cnt++] = recvs[2*i*nmax+2*j+1];
sends2[starts2[i]+cnt++] = nownedsenders[node];
ierr = PetscMemcpy(&sends2[starts2[i]+cnt],&ownedsenders[starts[node]],nownedsenders[node]*sizeof(PetscInt));CHKERRQ(ierr);
cnt += nownedsenders[node];
}
}
}
/* receive the message lengths */
nrecvs2 = nsends;
ierr = PetscMalloc((nrecvs2+1)*sizeof(PetscInt),&lens2);CHKERRQ(ierr);
ierr = PetscMalloc((nrecvs2+1)*sizeof(PetscInt),&starts3);CHKERRQ(ierr);
ierr = PetscMalloc((nrecvs2+1)*sizeof(MPI_Request),&recv_waits);CHKERRQ(ierr);
for (i=0; i<nrecvs2; i++) {
ierr = MPI_Irecv(&lens2[i],1,MPIU_INT,dest[i],tag2,comm,recv_waits+i);CHKERRQ(ierr);
}
/* send the message lengths */
for (i=0; i<nsends2; i++) {
ierr = MPI_Send(&nprocs[i],1,MPIU_INT,source[i],tag2,comm);CHKERRQ(ierr);
}
/* wait on receives of lens */
if (nrecvs2) {
ierr = PetscMalloc(nrecvs2*sizeof(MPI_Status),&recv_statuses);CHKERRQ(ierr);
ierr = MPI_Waitall(nrecvs2,recv_waits,recv_statuses);CHKERRQ(ierr);
ierr = PetscFree(recv_statuses);CHKERRQ(ierr);
}
ierr = PetscFree(recv_waits);
starts3[0] = 0;
nt = 0;
for (i=0; i<nrecvs2-1; i++) {
starts3[i+1] = starts3[i] + lens2[i];
nt += lens2[i];
}
nt += lens2[nrecvs2-1];
ierr = PetscMalloc((nt+1)*sizeof(PetscInt),&recvs2);CHKERRQ(ierr);
ierr = PetscMalloc((nrecvs2+1)*sizeof(MPI_Request),&recv_waits);CHKERRQ(ierr);
for (i=0; i<nrecvs2; i++) {
ierr = MPI_Irecv(recvs2+starts3[i],lens2[i],MPIU_INT,dest[i],tag3,comm,recv_waits+i);CHKERRQ(ierr);
}
/* send the messages */
ierr = PetscMalloc((nsends2+1)*sizeof(MPI_Request),&send_waits);CHKERRQ(ierr);
for (i=0; i<nsends2; i++) {
ierr = MPI_Isend(sends2+starts2[i],nprocs[i],MPIU_INT,source[i],tag3,comm,send_waits+i);CHKERRQ(ierr);
}
/* wait on receives */
if (nrecvs2) {
ierr = PetscMalloc(nrecvs2*sizeof(MPI_Status),&recv_statuses);CHKERRQ(ierr);
ierr = MPI_Waitall(nrecvs2,recv_waits,recv_statuses);CHKERRQ(ierr);
ierr = PetscFree(recv_statuses);CHKERRQ(ierr);
}
ierr = PetscFree(recv_waits);CHKERRQ(ierr);
ierr = PetscFree(nprocs);CHKERRQ(ierr);
if (debug) { /* ----------------------------------- */
cnt = 0;
for (i=0; i<nrecvs2; i++) {
nt = recvs2[cnt++];
for (j=0; j<nt; j++) {
ierr = PetscSynchronizedPrintf(comm,"[%d] local node %d number of subdomains %d: ",rank,recvs2[cnt],recvs2[cnt+1]);CHKERRQ(ierr);
for (k=0; k<recvs2[cnt+1]; k++) {
ierr = PetscSynchronizedPrintf(comm,"%d ",recvs2[cnt+2+k]);CHKERRQ(ierr);
}
cnt += 2 + recvs2[cnt+1];
ierr = PetscSynchronizedPrintf(comm,"\n");CHKERRQ(ierr);
}
}
ierr = PetscSynchronizedFlush(comm);CHKERRQ(ierr);
} /* ----------------------------------- */
/* count number subdomains for each local node */
ierr = PetscMalloc(size*sizeof(PetscInt),&nprocs);CHKERRQ(ierr);
ierr = PetscMemzero(nprocs,size*sizeof(PetscInt));CHKERRQ(ierr);
cnt = 0;
for (i=0; i<nrecvs2; i++) {
nt = recvs2[cnt++];
for (j=0; j<nt; j++) {
for (k=0; k<recvs2[cnt+1]; k++) {
nprocs[recvs2[cnt+2+k]]++;
}
cnt += 2 + recvs2[cnt+1];
}
}
nt = 0; for (i=0; i<size; i++) nt += (nprocs[i] > 0);
*nproc = nt;
ierr = PetscMalloc((nt+1)*sizeof(PetscInt),procs);CHKERRQ(ierr);
ierr = PetscMalloc((nt+1)*sizeof(PetscInt),numprocs);CHKERRQ(ierr);
ierr = PetscMalloc((nt+1)*sizeof(PetscInt*),indices);CHKERRQ(ierr);
ierr = PetscMalloc(size*sizeof(PetscInt),&bprocs);CHKERRQ(ierr);
cnt = 0;
for (i=0; i<size; i++) {
if (nprocs[i] > 0) {
bprocs[i] = cnt;
(*procs)[cnt] = i;
(*numprocs)[cnt] = nprocs[i];
ierr = PetscMalloc(nprocs[i]*sizeof(PetscInt),&(*indices)[cnt]);CHKERRQ(ierr);
cnt++;
}
}
/* make the list of subdomains for each nontrivial local node */
ierr = PetscMemzero(*numprocs,nt*sizeof(PetscInt));CHKERRQ(ierr);
cnt = 0;
for (i=0; i<nrecvs2; i++) {
nt = recvs2[cnt++];
for (j=0; j<nt; j++) {
for (k=0; k<recvs2[cnt+1]; k++) {
(*indices)[bprocs[recvs2[cnt+2+k]]][(*numprocs)[bprocs[recvs2[cnt+2+k]]]++] = recvs2[cnt];
}
cnt += 2 + recvs2[cnt+1];
}
}
ierr = PetscFree(bprocs);CHKERRQ(ierr);
ierr = PetscFree(recvs2);CHKERRQ(ierr);
/* sort the node indexing by their global numbers */
nt = *nproc;
for (i=0; i<nt; i++) {
ierr = PetscMalloc(((*numprocs)[i])*sizeof(PetscInt),&tmp);CHKERRQ(ierr);
for (j=0; j<(*numprocs)[i]; j++) {
tmp[j] = lindices[(*indices)[i][j]];
}
ierr = PetscSortIntWithArray((*numprocs)[i],tmp,(*indices)[i]);CHKERRQ(ierr);
ierr = PetscFree(tmp);CHKERRQ(ierr);
}
if (debug) { /* ----------------------------------- */
nt = *nproc;
for (i=0; i<nt; i++) {
ierr = PetscSynchronizedPrintf(comm,"[%d] subdomain %d number of indices %d: ",rank,(*procs)[i],(*numprocs)[i]);CHKERRQ(ierr);
for (j=0; j<(*numprocs)[i]; j++) {
ierr = PetscSynchronizedPrintf(comm,"%d ",(*indices)[i][j]);CHKERRQ(ierr);
}
ierr = PetscSynchronizedPrintf(comm,"\n");CHKERRQ(ierr);
}
ierr = PetscSynchronizedFlush(comm);CHKERRQ(ierr);
} /* ----------------------------------- */
/* wait on sends */
if (nsends2) {
ierr = PetscMalloc(nsends2*sizeof(MPI_Status),&send_status);CHKERRQ(ierr);
ierr = MPI_Waitall(nsends2,send_waits,send_status);CHKERRQ(ierr);
ierr = PetscFree(send_status);CHKERRQ(ierr);
}
ierr = PetscFree(starts3);CHKERRQ(ierr);
ierr = PetscFree(dest);CHKERRQ(ierr);
ierr = PetscFree(send_waits);CHKERRQ(ierr);
ierr = PetscFree(nownedsenders);CHKERRQ(ierr);
ierr = PetscFree(ownedsenders);CHKERRQ(ierr);
ierr = PetscFree(starts);CHKERRQ(ierr);
ierr = PetscFree(starts2);CHKERRQ(ierr);
ierr = PetscFree(lens2);CHKERRQ(ierr);
ierr = PetscFree(source);CHKERRQ(ierr);
ierr = PetscFree(len);CHKERRQ(ierr);
ierr = PetscFree(recvs);CHKERRQ(ierr);
ierr = PetscFree(nprocs);CHKERRQ(ierr);
ierr = PetscFree(sends2);CHKERRQ(ierr);
/* put the information about myself as the first entry in the list */
first_procs = (*procs)[0];
first_numprocs = (*numprocs)[0];
first_indices = (*indices)[0];
for (i=0; i<*nproc; i++) {
if ((*procs)[i] == rank) {
(*procs)[0] = (*procs)[i];
(*numprocs)[0] = (*numprocs)[i];
(*indices)[0] = (*indices)[i];
(*procs)[i] = first_procs;
(*numprocs)[i] = first_numprocs;
(*indices)[i] = first_indices;
break;
}
}
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
PetscErrorCode ierr;
KSP ksp;
PC pc;
Vec x,b;
DA da;
Mat A,Atrans;
PetscInt dof=1,M=-8;
PetscTruth flg,trans=PETSC_FALSE;
PetscInitialize(&argc,&argv,(char *)0,help);
ierr = PetscOptionsGetInt(PETSC_NULL,"-dof",&dof,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-M",&M,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetTruth(PETSC_NULL,"-trans",&trans,PETSC_NULL);CHKERRQ(ierr);
ierr = DACreate(PETSC_COMM_WORLD,&da);CHKERRQ(ierr);
ierr = DASetDim(da,3);CHKERRQ(ierr);
ierr = DASetPeriodicity(da,DA_NONPERIODIC);CHKERRQ(ierr);
ierr = DASetStencilType(da,DA_STENCIL_STAR);CHKERRQ(ierr);
ierr = DASetSizes(da,M,M,M);CHKERRQ(ierr);
ierr = DASetNumProcs(da,PETSC_DECIDE,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
ierr = DASetDof(da,dof);CHKERRQ(ierr);
ierr = DASetStencilWidth(da,1);CHKERRQ(ierr);
ierr = DASetVertexDivision(da,PETSC_NULL,PETSC_NULL,PETSC_NULL);CHKERRQ(ierr);
ierr = DASetFromOptions(da);CHKERRQ(ierr);
ierr = DACreateGlobalVector(da,&x);CHKERRQ(ierr);
ierr = DACreateGlobalVector(da,&b);CHKERRQ(ierr);
ierr = ComputeRHS(da,b);CHKERRQ(ierr);
ierr = DAGetMatrix(da,MATBAIJ,&A);CHKERRQ(ierr);
ierr = ComputeMatrix(da,A);CHKERRQ(ierr);
/* A is non-symmetric. Make A = 0.5*(A + Atrans) symmetric for testing icc and cholesky */
ierr = MatTranspose(A,MAT_INITIAL_MATRIX,&Atrans);CHKERRQ(ierr);
ierr = MatAXPY(A,1.0,Atrans,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = MatScale(A,0.5);CHKERRQ(ierr);
ierr = MatDestroy(Atrans);CHKERRQ(ierr);
/* Test sbaij matrix */
flg = PETSC_FALSE;
ierr = PetscOptionsGetTruth(PETSC_NULL, "-test_sbaij1", &flg,PETSC_NULL);CHKERRQ(ierr);
if (flg){
Mat sA;
ierr = MatConvert(A,MATSBAIJ,MAT_INITIAL_MATRIX,&sA);CHKERRQ(ierr);
ierr = MatDestroy(A);CHKERRQ(ierr);
A = sA;
}
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr);
ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr);
ierr = KSPSetOperators(ksp,A,A,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr);
ierr = PCSetDA(pc,da);CHKERRQ(ierr);
if (trans) {
ierr = KSPSolveTranspose(ksp,b,x);CHKERRQ(ierr);
} else {
ierr = KSPSolve(ksp,b,x);CHKERRQ(ierr);
}
/* check final residual */
flg = PETSC_FALSE;
ierr = PetscOptionsGetTruth(PETSC_NULL, "-check_final_residual", &flg,PETSC_NULL);CHKERRQ(ierr);
if (flg){
Vec b1;
PetscReal norm;
ierr = KSPGetSolution(ksp,&x);CHKERRQ(ierr);
ierr = VecDuplicate(b,&b1);CHKERRQ(ierr);
ierr = MatMult(A,x,b1);CHKERRQ(ierr);
ierr = VecAXPY(b1,-1.0,b);CHKERRQ(ierr);
ierr = VecNorm(b1,NORM_2,&norm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Final residual %g\n",norm);CHKERRQ(ierr);
ierr = VecDestroy(b1);CHKERRQ(ierr);
}
ierr = KSPDestroy(ksp);CHKERRQ(ierr);
ierr = VecDestroy(x);CHKERRQ(ierr);
ierr = VecDestroy(b);CHKERRQ(ierr);
ierr = MatDestroy(A);CHKERRQ(ierr);
ierr = DADestroy(da);CHKERRQ(ierr);
ierr = PetscFinalize();CHKERRQ(ierr);
return 0;
}
int main(int argc,char **args)
{
Vec x,b,u; /* approx solution, RHS, exact solution */
Mat A; /* linear system matrix */
KSP ksp; /* KSP context */
KSP *subksp; /* array of local KSP contexts on this processor */
PC pc; /* PC context */
PC subpc; /* PC context for subdomain */
PetscReal norm; /* norm of solution error */
PetscErrorCode ierr;
PetscInt i,j,Ii,J,*blks,m = 8,n;
PetscMPIInt rank,size;
PetscInt its,nlocal,first,Istart,Iend;
PetscScalar v,one = 1.0,none = -1.0;
PetscTruth isbjacobi,flg = PETSC_FALSE;
PetscInitialize(&argc,&args,(char *)0,help);
ierr = PetscOptionsGetInt(PETSC_NULL,"-m",&m,PETSC_NULL);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
n = m+2;
/* -------------------------------------------------------------------
Compute the matrix and right-hand-side vector that define
the linear system, Ax = b.
------------------------------------------------------------------- */
/*
Create and assemble parallel matrix
*/
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,m*n,m*n);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(A,&Istart,&Iend);CHKERRQ(ierr);
for (Ii=Istart; Ii<Iend; Ii++) {
v = -1.0; i = Ii/n; j = Ii - i*n;
if (i>0) {J = Ii - n; ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
if (i<m-1) {J = Ii + n; ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
if (j>0) {J = Ii - 1; ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
if (j<n-1) {J = Ii + 1; ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
v = 4.0; ierr = MatSetValues(A,1,&Ii,1,&Ii,&v,ADD_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/*
Create parallel vectors
*/
ierr = VecCreate(PETSC_COMM_WORLD,&u);CHKERRQ(ierr);
ierr = VecSetSizes(u,PETSC_DECIDE,m*n);CHKERRQ(ierr);
ierr = VecSetFromOptions(u);CHKERRQ(ierr);
ierr = VecDuplicate(u,&b);CHKERRQ(ierr);
ierr = VecDuplicate(b,&x);CHKERRQ(ierr);
/*
Set exact solution; then compute right-hand-side vector.
*/
ierr = VecSet(u,one);CHKERRQ(ierr);
ierr = MatMult(A,u,b);CHKERRQ(ierr);
/*
Create linear solver context
*/
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr);
/*
Set operators. Here the matrix that defines the linear system
also serves as the preconditioning matrix.
*/
ierr = KSPSetOperators(ksp,A,A,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
/*
Set default preconditioner for this program to be block Jacobi.
This choice can be overridden at runtime with the option
-pc_type <type>
*/
ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr);
ierr = PCSetType(pc,PCBJACOBI);CHKERRQ(ierr);
/* -------------------------------------------------------------------
Define the problem decomposition
------------------------------------------------------------------- */
/*
Call PCBJacobiSetTotalBlocks() to set individually the size of
each block in the preconditioner. This could also be done with
the runtime option
-pc_bjacobi_blocks <blocks>
Also, see the command PCBJacobiSetLocalBlocks() to set the
local blocks.
Note: The default decomposition is 1 block per processor.
*/
ierr = PetscMalloc(m*sizeof(PetscInt),&blks);CHKERRQ(ierr);
for (i=0; i<m; i++) blks[i] = n;
ierr = PCBJacobiSetTotalBlocks(pc,m,blks);CHKERRQ(ierr);
ierr = PetscFree(blks);CHKERRQ(ierr);
/* -------------------------------------------------------------------
Set the linear solvers for the subblocks
------------------------------------------------------------------- */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Basic method, should be sufficient for the needs of most users.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
By default, the block Jacobi method uses the same solver on each
block of the problem. To set the same solver options on all blocks,
use the prefix -sub before the usual PC and KSP options, e.g.,
-sub_pc_type <pc> -sub_ksp_type <ksp> -sub_ksp_rtol 1.e-4
*/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Advanced method, setting different solvers for various blocks.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Note that each block's KSP context is completely independent of
the others, and the full range of uniprocessor KSP options is
available for each block. The following section of code is intended
to be a simple illustration of setting different linear solvers for
the individual blocks. These choices are obviously not recommended
for solving this particular problem.
*/
ierr = PetscTypeCompare((PetscObject)pc,PCBJACOBI,&isbjacobi);CHKERRQ(ierr);
if (isbjacobi) {
/*
Call KSPSetUp() to set the block Jacobi data structures (including
creation of an internal KSP context for each block).
Note: KSPSetUp() MUST be called before PCBJacobiGetSubKSP().
*/
ierr = KSPSetUp(ksp);CHKERRQ(ierr);
/*
Extract the array of KSP contexts for the local blocks
*/
ierr = PCBJacobiGetSubKSP(pc,&nlocal,&first,&subksp);CHKERRQ(ierr);
/*
Loop over the local blocks, setting various KSP options
for each block.
*/
for (i=0; i<nlocal; i++) {
ierr = KSPGetPC(subksp[i],&subpc);CHKERRQ(ierr);
if (!rank) {
if (i%2) {
ierr = PCSetType(subpc,PCILU);CHKERRQ(ierr);
} else {
ierr = PCSetType(subpc,PCNONE);CHKERRQ(ierr);
ierr = KSPSetType(subksp[i],KSPBCGS);CHKERRQ(ierr);
ierr = KSPSetTolerances(subksp[i],1.e-6,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT);CHKERRQ(ierr);
}
} else {
ierr = PCSetType(subpc,PCJACOBI);CHKERRQ(ierr);
ierr = KSPSetType(subksp[i],KSPGMRES);CHKERRQ(ierr);
ierr = KSPSetTolerances(subksp[i],1.e-7,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT);CHKERRQ(ierr);
}
}
}
/* -------------------------------------------------------------------
Solve the linear system
------------------------------------------------------------------- */
/*
Set runtime options
*/
ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr);
/*
Solve the linear system
*/
ierr = KSPSolve(ksp,b,x);CHKERRQ(ierr);
/*
View info about the solver
*/
ierr = PetscOptionsGetTruth(PETSC_NULL,"-nokspview",&flg,PETSC_NULL);CHKERRQ(ierr);
if (!flg) {
ierr = KSPView(ksp,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
}
/* -------------------------------------------------------------------
Check solution and clean up
------------------------------------------------------------------- */
/*
Check the error
*/
ierr = VecAXPY(x,none,u);CHKERRQ(ierr);
ierr = VecNorm(x,NORM_2,&norm);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(ksp,&its);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Norm of error %A iterations %D\n",norm,its);CHKERRQ(ierr);
/*
Free work space. All PETSc objects should be destroyed when they
are no longer needed.
*/
ierr = KSPDestroy(ksp);CHKERRQ(ierr);
ierr = VecDestroy(u);CHKERRQ(ierr); ierr = VecDestroy(x);CHKERRQ(ierr);
ierr = VecDestroy(b);CHKERRQ(ierr); ierr = MatDestroy(A);CHKERRQ(ierr);
ierr = PetscFinalize();CHKERRQ(ierr);
return 0;
}
PetscErrorCode BSSCR_DRIVER_flex( KSP ksp, Mat stokes_A, Vec stokes_x, Vec stokes_b, Mat approxS, KSP ksp_K,
MatStokesBlockScaling BA, PetscTruth sym, KSP_BSSCR * bsscrp_self )
{
char name[PETSC_MAX_PATH_LEN];
char ubefore[100];
char uafter[100];
char pbefore[100];
char pafter[100];
PetscTruth flg, flg2, truth, useAcceleratingSmoothingMG, useFancySmoothingMG;
PetscTruth usePreviousGuess, useNormInfStoppingConditions, useNormInfMonitor, found, extractMats;
Mat K,G,D,C;
Vec u,p,f,h;
Mat S;
Vec h_hat,t,t2,q,v;
KSP ksp_inner;
KSP ksp_S;
KSP ksp_cleaner;
KSPType ksp_inner_type;
PetscTruth has_cnst_nullspace;
PC pc_S, pc_MG, pcInner;
PetscInt monitor_index,max_it,min_it;
Vec nsp_vec = PETSC_NULL;
PetscReal scr_rtol;
PetscReal inner_rtol;
PetscReal vSolver_rtol;
PetscScalar uNormInf, pNormInf;
PetscScalar uNorm, pNorm, rNorm, fNorm;
PetscInt uSize, pSize;
PetscInt lmin,lmax;
PetscInt iterations;
PetscReal min,max;
PetscReal p_sum;
MGContext mgCtx;
PC shellPC;
double t0, t1;
double mgSetupTime, scrSolveTime, a11SingleSolveTime, solutionAnalysisTime;
Index nx,ny,nz;
PetscInt j,start,end;
static int been_here = 0; /* Ha Ha Ha !! */
/* get sub matrix / vector objects */
MatNestGetSubMat( stokes_A, 0,0, &K );
MatNestGetSubMat( stokes_A, 0,1, &G );
MatNestGetSubMat( stokes_A, 1,0, &D );
MatNestGetSubMat( stokes_A, 1,1, &C );
VecNestGetSubVec( stokes_x, 0, &u );
VecNestGetSubVec( stokes_x, 1, &p );
VecNestGetSubVec( stokes_b, 0, &f );
VecNestGetSubVec( stokes_b, 1, &h );
/* PetscPrintf( PETSC_COMM_WORLD, "\t Adress of stokes_x is %p\n", stokes_x); */
/* VecNorm( u, NORM_2, &uNorm ); */
/* PetscPrintf( PETSC_COMM_WORLD, "\t u Norm is %.6e in %s: address is %p\n",uNorm,__func__,u); */
/* VecNorm( p, NORM_2, &pNorm ); */
/* PetscPrintf( PETSC_COMM_WORLD, "\t p Norm is %.6e in %s: addres is %p\n",pNorm,__func__,p); */
/* Create Schur complement matrix */
//MatCreateSchurFromBlock( stokes_A, 0.0, "MatSchur_A11", &S );
MatCreateSchurComplement(K,K,G,D,C, &S);
/* configure inner solver */
if (ksp_K!=PETSC_NULL) {
MatSchurComplementSetKSP( S, ksp_K );
MatSchurComplementGetKSP( S, &ksp_inner );
}
else {
abort();
MatSchurComplementGetKSP( S, &ksp_inner );
KSPSetType( ksp_inner, "cg" );
}
KSPGetPC( ksp_inner, &pcInner );
/* If we're using multigrid, replace the preconditioner here
so we get the same options prefix. */
if(bsscrp_self->mg) {
mgSetupTime=setupMG( bsscrp_self, ksp_inner, pcInner, K, &mgCtx );
}
/* SETFROMOPTIONS MIGHT F**K MG UP */
KSPSetOptionsPrefix( ksp_inner, "A11_" );
KSPSetFromOptions( ksp_inner );
useNormInfStoppingConditions = PETSC_FALSE;
PetscOptionsGetTruth( PETSC_NULL ,"-A11_use_norm_inf_stopping_condition", &useNormInfStoppingConditions, &found );
if(useNormInfStoppingConditions)
BSSCR_KSPSetNormInfConvergenceTest( ksp_inner );
useNormInfMonitor = PETSC_FALSE;
PetscOptionsGetTruth( PETSC_NULL, "-A11_ksp_norm_inf_monitor", &useNormInfMonitor, &found );
if(useNormInfMonitor)
KSPMonitorSet( ksp_inner, BSSCR_KSPNormInfMonitor, PETSC_NULL, PETSC_NULL );
useNormInfMonitor = PETSC_FALSE;
PetscOptionsGetTruth( PETSC_NULL, "-A11_ksp_norm_inf_to_norm_2_monitor", &useNormInfMonitor, &found );
if(useNormInfMonitor)
KSPMonitorSet( ksp_inner, BSSCR_KSPNormInfToNorm2Monitor, PETSC_NULL, PETSC_NULL );
/* create right hand side */
/* h_hat = G'*inv(K)*f - h */
MatGetVecs(K,PETSC_NULL,&t);
MatGetVecs( S, PETSC_NULL, &h_hat );
KSPSetOptionsPrefix( ksp_inner, "A11_" );
KSPSetFromOptions( ksp_inner );
KSPSolve(ksp_inner,f,t);/* t=f/K */
//bsscr_writeVec( t, "ts", "Writing t vector");
MatMult(D,t,h_hat);/* G'*t */
VecAXPY(h_hat, -1.0, h);/* h_hat = h_hat - h */
Stg_VecDestroy(&t);
//bsscr_writeVec( h_hat, "h_hat", "Writing h_hat Vector in Solver");
//MatSchurApplyReductionToVecFromBlock( S, stokes_b, h_hat );
/* create solver for S p = h_hat */
KSPCreate( PETSC_COMM_WORLD, &ksp_S );
KSPSetOptionsPrefix( ksp_S, "scr_");
Stg_KSPSetOperators( ksp_S, S,S, SAME_NONZERO_PATTERN );
KSPSetType( ksp_S, "cg" );
/* Build preconditioner for S */
KSPGetPC( ksp_S, &pc_S );
BSSCR_BSSCR_StokesCreatePCSchur2( K,G,D,C,approxS,pc_S,sym, bsscrp_self );
KSPSetFromOptions(ksp_S);
/* Set specific monitor test */
KSPGetTolerances( ksp_S, PETSC_NULL, PETSC_NULL, PETSC_NULL, &max_it );
//BSSCR_KSPLogSetMonitor( ksp_S, max_it, &monitor_index );
/* Pressure / Velocity Solve */
scrSolveTime = MPI_Wtime();
PetscPrintf( PETSC_COMM_WORLD, "\t* Pressure / Velocity Solve \n");
usePreviousGuess = PETSC_FALSE;
if(been_here)
PetscOptionsGetTruth( PETSC_NULL, "-scr_use_previous_guess", &usePreviousGuess, &found );
if(usePreviousGuess) { /* Note this should actually look at checkpoint information */
KSPSetInitialGuessNonzero( ksp_S, PETSC_TRUE );
}
else {
KSPSetInitialGuessNonzero( ksp_S, PETSC_FALSE );
}
//KSPSetRelativeRhsConvergenceTest( ksp_S );
useNormInfStoppingConditions = PETSC_FALSE;
PetscOptionsGetTruth( PETSC_NULL ,"-scr_use_norm_inf_stopping_condition", &useNormInfStoppingConditions, &found );
if(useNormInfStoppingConditions)
BSSCR_KSPSetNormInfConvergenceTest(ksp_S);
useNormInfMonitor = PETSC_FALSE;
PetscOptionsGetTruth( PETSC_NULL, "-scr_ksp_norm_inf_monitor", &useNormInfMonitor, &found );
if(useNormInfMonitor)
KSPMonitorSet( ksp_S, BSSCR_KSPNormInfToNorm2Monitor, PETSC_NULL, PETSC_NULL );
PetscPrintf( PETSC_COMM_WORLD, "\t* KSPSolve( ksp_S, h_hat, p )\n");
/* if h_hat needs to be fixed up ..take out any nullspace vectors here */
/* we want to check that there is no "noise" in the null-space in the h vector */
/* this causes problems when we are trying to solve a Jacobian system when the Residual is almost converged */
if(bsscrp_self->check_pressureNS){
bsscrp_self->buildPNS(ksp);/* build and set nullspace vectors on bsscr - which is on ksp (function pointer is set in KSPSetUp_BSSCR */
}
PetscScalar norm, a, a1, a2, hnorm, pnorm, gnorm;
MatNorm(G,NORM_INFINITY,&gnorm);
VecNorm(h_hat, NORM_2, &hnorm);
hnorm=hnorm/gnorm;
if((hnorm < 1e-6) && (hnorm > 1e-20)){
VecScale(h_hat,1.0/hnorm);
}
/* test to see if v or t are in nullspace of G and orthogonalize wrt h_hat if needed */
KSPRemovePressureNullspace_BSSCR(ksp, h_hat);
/***************************************/
/* set convergence test to use min_it */
found = PETSC_FALSE;
min_it = 0;
PetscOptionsGetInt( PETSC_NULL,"-scr_ksp_set_min_it_converge", &min_it, &found);
if(found && min_it > 0){
BSSCR_KSPSetConvergenceMinIts(ksp_S, min_it, bsscrp_self);
}
KSPSolve( ksp_S, h_hat, p );
sprintf(pafter,"psafter_%d",been_here);
bsscr_writeVec( p, pafter, "Writing p Vector in Solver");
/***************************************/
if((hnorm < 1e-6) && (hnorm > 1e-20)){
VecScale(h_hat,hnorm);
VecScale(p,hnorm);
}
KSPRemovePressureNullspace_BSSCR(ksp, p);
scrSolveTime = MPI_Wtime() - scrSolveTime;
PetscPrintf( PETSC_COMM_WORLD, "\n\t* KSPSolve( ksp_S, h_hat, p ) Solve Finished in time: %lf seconds\n\n", scrSolveTime);
/* Resolve with this pressure to obtain solution for u */
/* obtain solution for u */
VecDuplicate( u, &t );
MatMult( G, p, t);
VecAYPX( t, -1.0, f ); /* t <- -t + f */
MatSchurComplementGetKSP( S, &ksp_inner );
a11SingleSolveTime = MPI_Wtime(); /* ---------------------------------- Final V Solve */
if(usePreviousGuess)
KSPSetInitialGuessNonzero( ksp_inner, PETSC_TRUE );
KSPSetOptionsPrefix( ksp_inner, "backsolveA11_" );
KSPSetFromOptions( ksp_inner );
KSPSolve( ksp_inner, t, u ); /* Solve, then restore default tolerance and initial guess */
a11SingleSolveTime = MPI_Wtime() - a11SingleSolveTime; /* ------------------ Final V Solve */
PetscPrintf( PETSC_COMM_WORLD, "\n\nSCR Solver Summary:\n\n");
if(bsscrp_self->mg)
PetscPrintf( PETSC_COMM_WORLD, " Multigrid setup: = %.4g secs \n", mgSetupTime);
KSPGetIterationNumber( ksp_S, &iterations);
PetscPrintf( PETSC_COMM_WORLD, " Pressure Solve: = %.4g secs / %d its\n", scrSolveTime, iterations);
KSPGetIterationNumber( ksp_inner, &iterations);
PetscPrintf( PETSC_COMM_WORLD, " Final V Solve: = %.4g secs / %d its\n\n", a11SingleSolveTime, iterations);
/* Analysis of solution:
This can be somewhat time consuming as it requires allocation / de-allocation,
computing vector norms etc. So we make it optional..
This should be put into a proper KSP monitor now?
*/
flg = PETSC_TRUE;
PetscOptionsGetTruth( PETSC_NULL, "-scr_ksp_solution_summary", &flg, &found );
if(flg) {
solutionAnalysisTime = MPI_Wtime();
VecGetSize( u, &uSize );
VecGetSize( p, &pSize );
VecDuplicate( u, &t2 );
MatMult( K, u, t2);
VecAYPX( t2, -1.0, t ); /* t2 <- -t2 + t ... should be the formal residual vector */
VecNorm( t2, NORM_2, &rNorm );
VecNorm( f, NORM_2, &fNorm );
PetscPrintf( PETSC_COMM_WORLD, " |f - K u - G p|/|f| = %.6e\n", rNorm/fNorm );
VecDuplicate( p, &q );
MatMult( D, u, q );
VecNorm( u, NORM_2, &uNorm );
VecNorm( q, NORM_2, &rNorm );
PetscPrintf( PETSC_COMM_WORLD, " |G^T u|_2/|u|_2 = %.6e\n", sqrt( (double) uSize / (double) pSize ) * rNorm / uNorm);
VecNorm( q, NORM_INFINITY, &rNorm );
PetscPrintf( PETSC_COMM_WORLD, " |G^T u|_infty/|u|_2 = %.6e\n", sqrt( (double) uSize ) * rNorm / uNorm);
VecNorm( u, NORM_INFINITY, &uNormInf );
VecNorm( u, NORM_2, &uNorm );
VecGetSize( u, &uSize );
VecNorm( p, NORM_INFINITY, &pNormInf );
VecNorm( p, NORM_2, &pNorm );
PetscPrintf( PETSC_COMM_WORLD, " |u|_{\\infty} = %.6e , u_rms = %.6e\n",
uNormInf, uNorm / sqrt( (double) uSize ) );
PetscPrintf( PETSC_COMM_WORLD, " |p|_{\\infty} = %.6e , p_rms = %.6e\n",
pNormInf, pNorm / sqrt( (double) pSize ) );
VecMax( u, &lmax, &max );
VecMin( u, &lmin, &min );
PetscPrintf( PETSC_COMM_WORLD, " min/max(u) = %.6e [%d] / %.6e [%d]\n",min,lmin,max,lmax);
VecMax( p, &lmax, &max );
VecMin( p, &lmin, &min );
PetscPrintf( PETSC_COMM_WORLD, " min/max(p) = %.6e [%d] / %.6e [%d]\n",min,lmin,max,lmax);
VecSum( p, &p_sum );
PetscPrintf( PETSC_COMM_WORLD, " \\sum_i p_i = %.6e \n", p_sum );
solutionAnalysisTime = MPI_Wtime() - solutionAnalysisTime;
PetscPrintf( PETSC_COMM_WORLD, "\n Time for this analysis = %.4g secs\n\n",solutionAnalysisTime);
Stg_VecDestroy(&t2 );
Stg_VecDestroy(&q );
}
if(bsscrp_self->mg) {
//MG_inner_solver_pcmg_shutdown( pcInner );
}
Stg_VecDestroy(&t );
// KSPLogDestroyMonitor( ksp_S );
Stg_KSPDestroy(&ksp_S );
//Stg_KSPDestroy(&ksp_inner );
Stg_VecDestroy(&h_hat );
Stg_MatDestroy(&S );
/* Destroy nullspace vector if it exists. */
if(nsp_vec)
Stg_VecDestroy(&nsp_vec);
//been_here = 1;
been_here++;
PetscFunctionReturn(0);
}
void PETScMGSolver_UpdateSolvers( PETScMGSolver* self ) {
PETScMGSolver_Level* level;
PC pc;
KSP levelKSP;
PC levelPC;
PetscErrorCode ec;
unsigned l_i;
PetscTruth smoothers_differ, flag;
PetscMPIInt size;
MPI_Comm comm;
assert( self && Stg_CheckType( self, PETScMGSolver ) );
ec = KSPGetPC( self->mgData->ksp, &pc );
CheckPETScError( ec );
ec = PCMGSetLevels( pc, self->nLevels, PETSC_NULL );
CheckPETScError( ec );
ec = PCMGSetType( pc, PC_MG_MULTIPLICATIVE );
CheckPETScError( ec );
ec=PetscOptionsGetTruth( PETSC_NULL, "-pc_mg_different_smoothers", &smoothers_differ, &flag ); CheckPETScError(ec);
ec=PetscObjectGetComm( (PetscObject)pc, &comm ); CheckPETScError(ec);
MPI_Comm_size( comm, &size );
for( l_i = 1; l_i < self->nLevels; l_i++ ) {
level = self->levels + l_i;
printf("Configuring MG level %d \n", l_i );
ec = PCMGGetSmootherDown( pc, l_i, &levelKSP );
CheckPETScError( ec );
if(smoothers_differ==PETSC_TRUE) { ec=KSPAppendOptionsPrefix( levelKSP, "down_" ); CheckPETScError(ec); }
ec = KSPSetType( levelKSP, KSPRICHARDSON ); CheckPETScError( ec );
ec = KSPGetPC( levelKSP, &levelPC ); CheckPETScError( ec );
if(size==1) {
ec = PCSetType( levelPC, PCSOR ); CheckPETScError( ec );
}
/* This does not work - bug with the order the operators are created I guess */
/* For parallel jobs you best bet is to use the command line args and let petsc work it out */
/*
else {
KSP *sub_ksp;
PetscInt k, n_local, first_local;
PC sub_pc;
PCSetType( levelPC, PCBJACOBI );
KSPSetUp( levelKSP );
PCBJacobiGetSubKSP( levelPC, &n_local,&first_local,&sub_ksp);
for(k=0;k<n_local;k++ ) {
KSPSetType( sub_ksp[k], KSPFGMRES );
KSPGetPC( sub_ksp[k], &sub_pc );
PCSetType( sub_pc, PCSOR );
}
}
*/
ec = KSPSetTolerances( levelKSP, PETSC_DEFAULT, PETSC_DEFAULT, PETSC_DEFAULT, level->nDownIts ); CheckPETScError( ec );
if( l_i == self->nLevels - 1 ) {
ec = KSPSetInitialGuessNonzero( levelKSP, PETSC_TRUE ); CheckPETScError( ec );
}
else { ec = KSPSetInitialGuessNonzero( levelKSP, PETSC_FALSE ); CheckPETScError( ec ); }
ec = PCMGGetSmootherUp( pc, l_i, &levelKSP ); CheckPETScError( ec );
if(smoothers_differ==PETSC_TRUE) { ec=KSPAppendOptionsPrefix( levelKSP, "up_" ); CheckPETScError(ec); }
ec = KSPSetType( levelKSP, KSPRICHARDSON ); CheckPETScError( ec );
ec = KSPGetPC( levelKSP, &levelPC ); CheckPETScError( ec );
if(size==1) {
ec = PCSetType( levelPC, PCSOR ); CheckPETScError( ec );
}
ec = KSPSetTolerances( levelKSP, PETSC_DEFAULT, PETSC_DEFAULT, PETSC_DEFAULT, level->nUpIts ); CheckPETScError( ec );
ec = KSPSetInitialGuessNonzero( levelKSP, PETSC_TRUE ); CheckPETScError( ec );
ec = PCMGSetCyclesOnLevel( pc, l_i, level->nCycles ); CheckPETScError( ec );
}
}
PetscErrorCode KSPSetUp_BSSCR(KSP ksp)
{
KSP_BSSCR *bsscr = (KSP_BSSCR *)ksp->data;
Mat K;
Stokes_SLE* stokesSLE = (Stokes_SLE*)bsscr->st_sle;
PetscTruth ismumps,augment,scale,konly,found,conp,checkerp;
PetscFunctionBegin;
BSSCR_PetscExtStokesSolversInitialize();
K = stokesSLE->kStiffMat->matrix;
bsscr->K2=PETSC_NULL;
BSSCR_MatStokesBlockScalingCreate( &(bsscr->BA) );/* allocate memory for scaling struct */
found = PETSC_FALSE;
augment = PETSC_TRUE;
PetscOptionsGetTruth(PETSC_NULL, "-augmented_lagrangian", &augment, &found);
if(augment){
bsscr->buildK2 = bsscr_buildK2; }
else {
bsscr->buildK2 = PETSC_NULL; }
/***************************************************************************************************************/
/** Do scaling *************************************************************************************************/
/***************************************************************************************************************/
found = PETSC_FALSE;
scale = PETSC_FALSE;/* scaling off by default */
PetscOptionsGetTruth(PETSC_NULL, "-rescale_equations", &scale, &found);
Stg_PetscObjectTypeCompare((PetscObject)K, "mataijmumps", &ismumps);/** older versions of petsc have this */
if(ismumps && scale){
PetscPrintf( PETSC_COMM_WORLD, "\t* Not applying scaling to matrices as MatGetRowMax operation not defined for MATAIJMUMPS matrix type \n");
scale = PETSC_FALSE;
}
if( scale ) {
bsscr->scale = KSPScale_BSSCR;
bsscr->unscale = KSPUnscale_BSSCR;
bsscr->do_scaling = PETSC_TRUE;
bsscr->scaletype = KONLY;
konly = PETSC_TRUE;
found = PETSC_FALSE;
PetscOptionsGetTruth(PETSC_NULL, "-k_scale_only", &konly, &found);
if(!konly){ bsscr->scaletype = DEFAULT; }
}
/***************************************************************************************************************/
/** Set up functions for building Pressure Null Space Vectors *************************************************/
/***************************************************************************************************************/
found = PETSC_FALSE;
checkerp = PETSC_FALSE;
PetscOptionsGetTruth(PETSC_NULL, "-remove_checkerboard_pressure_null_space", &checkerp, &found );
if(checkerp){
bsscr->check_cb_pressureNS = PETSC_TRUE;
bsscr->check_pressureNS = PETSC_TRUE;
bsscr->buildPNS = KSPBuildPressure_CB_Nullspace_BSSCR;
}
found = PETSC_FALSE;
conp = PETSC_FALSE;
PetscOptionsGetTruth(PETSC_NULL, "-remove_constant_pressure_null_space", &conp, &found );
if(conp){
bsscr->check_const_pressureNS = PETSC_TRUE;
bsscr->check_pressureNS = PETSC_TRUE;
bsscr->buildPNS = KSPBuildPressure_Const_Nullspace_BSSCR;
}
/***************************************************************************************************************/
PetscFunctionReturn(0);
}
PetscErrorCode KSPSolve_BSSCR(KSP ksp)
{
Mat Amat,Pmat; /* Stokes Matrix and it's Preconditioner matrix: Both 2x2 PetscExt block matrices */
Vec B, X; /* rhs and solution vectors */
//MatStructure pflag;
PetscErrorCode ierr;
KSP_BSSCR * bsscr;
Stokes_SLE * SLE;
//PETScMGSolver * MG;
Mat K,D,ApproxS;
MatStokesBlockScaling BA;
PetscTruth flg, sym, augment;
double TotalSolveTime;
PetscFunctionBegin;
TotalSolveTime = MPI_Wtime();
PetscPrintf( PETSC_COMM_WORLD, "\nBSSCR -- Block Stokes Schur Compliment Reduction Solver \n");
/** Get the stokes Block matrix and its preconditioner matrix */
ierr = Stg_PCGetOperators(ksp->pc,&Amat,&Pmat,PETSC_NULL);CHKERRQ(ierr);
/** In Petsc proper, KSP's ksp->data is usually set in KSPCreate_XXX function.
Here it is set in the _StokesBlockKSPInterface_Solve function instead so that we can ensure that the solver
has everything it needs */
bsscr = (KSP_BSSCR*)ksp->data;
//MG = (PETScMGSolver*)bsscr->mg;
SLE = (Stokes_SLE*)bsscr->st_sle;
X = ksp->vec_sol;
B = ksp->vec_rhs;
if( bsscr->do_scaling ){
(*bsscr->scale)(ksp); /* scales everything including the UW preconditioner */
BA = bsscr->BA;
}
if( (bsscr->k2type != 0) ){
if(bsscr->buildK2 != PETSC_NULL) {
(*bsscr->buildK2)(ksp); /* building K2 from scaled version of stokes operators: K2 lives on bsscr struct = ksp->data */
}
}
/* get sub matrix / vector objects */
MatNestGetSubMat( Amat, 0,0, &K );
/* Underworld preconditioner matrix*/
ApproxS = PETSC_NULL;
if( ((StokesBlockKSPInterface*)SLE->solver)->preconditioner ) { /* SLE->solver->st_sle == SLE here, by the way */
StiffnessMatrix *preconditioner;
preconditioner = ((StokesBlockKSPInterface*)SLE->solver)->preconditioner;
ApproxS = BSSCR_GetPetscMatrix( preconditioner->matrix );
}
sym = bsscr->DIsSym;
MatNestGetSubMat( Amat, 1,0, &D );if(!D){ PetscPrintf( PETSC_COMM_WORLD, "D does not exist but should!!\n"); exit(1); }
/**********************************************************/
/******* SOLVE!! ******************************************/
/**********************************************************/
flg = PETSC_FALSE;
augment = PETSC_TRUE;
PetscOptionsGetTruth(PETSC_NULL, "-augmented_lagrangian", &augment, &flg);
BSSCR_DRIVER_auglag( ksp, Amat, X, B, ApproxS, BA, sym, bsscr );
/**********************************************************/
/***** END SOLVE!! ****************************************/
/**********************************************************/
if( bsscr->do_scaling ){
(*bsscr->unscale)(ksp); }
if( (bsscr->k2type != 0) && bsscr->K2 != PETSC_NULL ){
if(bsscr->k2type != K2_SLE){/* don't destroy here, as in this case, K2 is just pointing to an existing matrix on the SLE */
Stg_MatDestroy(&bsscr->K2 );
}
bsscr->K2built = PETSC_FALSE;
bsscr->K2 = PETSC_NULL; }
ksp->reason = KSP_CONVERGED_RTOL;
TotalSolveTime = MPI_Wtime() - TotalSolveTime;
PetscPrintf( PETSC_COMM_WORLD, " Total BSSCR Linear solve time: %lf seconds\n\n", TotalSolveTime);
bsscr->solver->stats.total_time=TotalSolveTime;
PetscFunctionReturn(0);
}
int main(int argc,char **args)
{
Vec x,b,u; /* approx solution, RHS, exact solution */
Mat A; /* linear system matrix */
KSP ksp; /* linear solver context */
PetscReal norm; /* norm of solution error */
PetscInt dim,i,j,Ii,J,Istart,Iend,n = 6,its,use_random;
PetscErrorCode ierr;
PetscScalar v,none = -1.0,sigma2,pfive = 0.5,*xa;
PetscRandom rctx;
PetscReal h2,sigma1 = 100.0;
PetscTruth flg = PETSC_FALSE;
PetscInitialize(&argc,&args,(char *)0,help);
#if !defined(PETSC_USE_COMPLEX)
SETERRQ(1,"This example requires complex numbers");
#endif
ierr = PetscOptionsGetReal(PETSC_NULL,"-sigma1",&sigma1,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-n",&n,PETSC_NULL);CHKERRQ(ierr);
dim = n*n;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Compute the matrix and right-hand-side vector that define
the linear system, Ax = b.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Create parallel matrix, specifying only its global dimensions.
When using MatCreate(), the matrix format can be specified at
runtime. Also, the parallel partitioning of the matrix is
determined by PETSc at runtime.
*/
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,dim,dim);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
/*
Currently, all PETSc parallel matrix formats are partitioned by
contiguous chunks of rows across the processors. Determine which
rows of the matrix are locally owned.
*/
ierr = MatGetOwnershipRange(A,&Istart,&Iend);CHKERRQ(ierr);
/*
Set matrix elements in parallel.
- Each processor needs to insert only elements that it owns
locally (but any non-local elements will be sent to the
appropriate processor during matrix assembly).
- Always specify global rows and columns of matrix entries.
*/
ierr = PetscOptionsGetTruth(PETSC_NULL,"-norandom",&flg,PETSC_NULL);CHKERRQ(ierr);
if (flg) use_random = 0;
else use_random = 1;
if (use_random) {
ierr = PetscRandomCreate(PETSC_COMM_WORLD,&rctx);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rctx);CHKERRQ(ierr);
ierr = PetscRandomSetInterval(rctx,0.0,PETSC_i);CHKERRQ(ierr);
} else {
sigma2 = 10.0*PETSC_i;
}
h2 = 1.0/((n+1)*(n+1));
for (Ii=Istart; Ii<Iend; Ii++) {
v = -1.0; i = Ii/n; j = Ii - i*n;
if (i>0) {
J = Ii-n; ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
if (i<n-1) {
J = Ii+n; ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
if (j>0) {
J = Ii-1; ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
if (j<n-1) {
J = Ii+1; ierr = MatSetValues(A,1,&Ii,1,&J,&v,ADD_VALUES);CHKERRQ(ierr);}
if (use_random) {ierr = PetscRandomGetValue(rctx,&sigma2);CHKERRQ(ierr);}
v = 4.0 - sigma1*h2 + sigma2*h2;
ierr = MatSetValues(A,1,&Ii,1,&Ii,&v,ADD_VALUES);CHKERRQ(ierr);
}
if (use_random) {ierr = PetscRandomDestroy(rctx);CHKERRQ(ierr);}
/*
Assemble matrix, using the 2-step process:
MatAssemblyBegin(), MatAssemblyEnd()
Computations can be done while messages are in transition
by placing code between these two statements.
*/
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/*
Create parallel vectors.
- When using VecCreate(), VecSetSizes() and VecSetFromOptions(),
we specify only the vector's global
dimension; the parallel partitioning is determined at runtime.
- Note: We form 1 vector from scratch and then duplicate as needed.
*/
ierr = VecCreate(PETSC_COMM_WORLD,&u);CHKERRQ(ierr);
ierr = VecSetSizes(u,PETSC_DECIDE,dim);CHKERRQ(ierr);
ierr = VecSetFromOptions(u);CHKERRQ(ierr);
ierr = VecDuplicate(u,&b);CHKERRQ(ierr);
ierr = VecDuplicate(b,&x);CHKERRQ(ierr);
/*
Set exact solution; then compute right-hand-side vector.
*/
if (use_random) {
ierr = PetscRandomCreate(PETSC_COMM_WORLD,&rctx);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rctx);CHKERRQ(ierr);
ierr = VecSetRandom(u,rctx);CHKERRQ(ierr);
} else {
ierr = VecSet(u,pfive);CHKERRQ(ierr);
}
ierr = MatMult(A,u,b);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create the linear solver and set various options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Create linear solver context
*/
ierr = KSPCreate(PETSC_COMM_WORLD,&ksp);CHKERRQ(ierr);
/*
Set operators. Here the matrix that defines the linear system
also serves as the preconditioning matrix.
*/
ierr = KSPSetOperators(ksp,A,A,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
/*
Set runtime options, e.g.,
-ksp_type <type> -pc_type <type> -ksp_monitor -ksp_rtol <rtol>
*/
ierr = KSPSetFromOptions(ksp);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve the linear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = KSPSolve(ksp,b,x);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Check solution and clean up
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
Print the first 3 entries of x; this demonstrates extraction of the
real and imaginary components of the complex vector, x.
*/
flg = PETSC_FALSE;
ierr = PetscOptionsGetTruth(PETSC_NULL,"-print_x3",&flg,PETSC_NULL);CHKERRQ(ierr);
if (flg) {
ierr = VecGetArray(x,&xa);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"The first three entries of x are:\n");CHKERRQ(ierr);
for (i=0; i<3; i++){
ierr = PetscPrintf(PETSC_COMM_WORLD,"x[%D] = %G + %G i\n",i,PetscRealPart(xa[i]),PetscImaginaryPart(xa[i]));CHKERRQ(ierr);
}
ierr = VecRestoreArray(x,&xa);CHKERRQ(ierr);
}
/*
Check the error
*/
ierr = VecAXPY(x,none,u);CHKERRQ(ierr);
ierr = VecNorm(x,NORM_2,&norm);CHKERRQ(ierr);
ierr = KSPGetIterationNumber(ksp,&its);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Norm of error %A iterations %D\n",norm,its);CHKERRQ(ierr);
/*
Free work space. All PETSc objects should be destroyed when they
are no longer needed.
*/
ierr = KSPDestroy(ksp);CHKERRQ(ierr);
if (use_random) {ierr = PetscRandomDestroy(rctx);CHKERRQ(ierr);}
ierr = VecDestroy(u);CHKERRQ(ierr); ierr = VecDestroy(x);CHKERRQ(ierr);
ierr = VecDestroy(b);CHKERRQ(ierr); ierr = MatDestroy(A);CHKERRQ(ierr);
ierr = PetscFinalize();CHKERRQ(ierr);
return 0;
}
int main(int argc,char **argv)
{
PetscInt i,j,M = 10,N = 8,m = PETSC_DECIDE,n = PETSC_DECIDE;
PetscMPIInt rank;
PetscErrorCode ierr;
PetscTruth flg = PETSC_FALSE;
DA da;
PetscViewer viewer;
Vec localall,global;
PetscScalar value,*vlocal;
DAPeriodicType ptype = DA_NONPERIODIC;
DAStencilType stype = DA_STENCIL_BOX;
VecScatter tolocalall,fromlocalall;
PetscInt start,end;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);CHKERRQ(ierr);
ierr = PetscViewerDrawOpen(PETSC_COMM_WORLD,0,"",300,0,300,300,&viewer);CHKERRQ(ierr);
/* Read options */
ierr = PetscOptionsGetInt(PETSC_NULL,"-M",&M,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-N",&N,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-m",&m,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-n",&n,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetTruth(PETSC_NULL,"-star_stencil",&flg,PETSC_NULL);CHKERRQ(ierr);
if (flg) stype = DA_STENCIL_STAR;
/* Create distributed array and get vectors */
ierr = DACreate2d(PETSC_COMM_WORLD,ptype,stype,
M,N,m,n,1,1,PETSC_NULL,PETSC_NULL,&da);CHKERRQ(ierr);
ierr = DACreateGlobalVector(da,&global);CHKERRQ(ierr);
ierr = VecCreateSeq(PETSC_COMM_SELF,M*N,&localall);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(global,&start,&end);CHKERRQ(ierr);
for (i=start; i<end; i++) {
value = 5.0*rank;
ierr = VecSetValues(global,1,&i,&value,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = VecView(global,viewer);CHKERRQ(ierr);
/*
Create Scatter from global DA parallel vector to local vector that
contains all entries
*/
ierr = DAGlobalToNaturalAllCreate(da,&tolocalall);CHKERRQ(ierr);
ierr = DANaturalAllToGlobalCreate(da,&fromlocalall);CHKERRQ(ierr);
ierr = VecScatterBegin(tolocalall,global,localall,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(tolocalall,global,localall,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecGetArray(localall,&vlocal);CHKERRQ(ierr);
for (j=0; j<N; j++) {
for (i=0; i<M; i++) {
*vlocal++ += i + j*M;
}
}
ierr = VecRestoreArray(localall,&vlocal);CHKERRQ(ierr);
/* scatter back to global vector */
ierr = VecScatterBegin(fromlocalall,localall,global,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecScatterEnd(fromlocalall,localall,global,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
ierr = VecView(global,viewer);CHKERRQ(ierr);
/* Free memory */
ierr = VecScatterDestroy(tolocalall);CHKERRQ(ierr);
ierr = VecScatterDestroy(fromlocalall);CHKERRQ(ierr);
ierr = PetscViewerDestroy(viewer);CHKERRQ(ierr);
ierr = VecDestroy(localall);CHKERRQ(ierr);
ierr = VecDestroy(global);CHKERRQ(ierr);
ierr = DADestroy(da);CHKERRQ(ierr);
ierr = PetscFinalize();CHKERRQ(ierr);
return 0;
}
int main(int argc, char **argv) {
PetscInitialize(&argc, &argv, "cmame.opt", help);
int rank;
MPI_Comm_rank(MPI_COMM_WORLD, &rank);
// The global domain size
double gSize[3];
gSize[0] = 1.; gSize[1] = 1.; gSize[2] = 1.;
// Parameters for the balancing algorithm.
// Refer to manual for details ...
bool incCorner = 1; // balance across corners = true
unsigned int maxNumPts= 1; // maximum number of points per octant
unsigned int dim=3; // spatial dimensions
// unsigned int maxDepth=8; // maximum depth of the octree, has to be <= 30
int maxDepth=8; // maximum depth of the octree, has to be <= 30
int Ns = 32;
unsigned int dof = 3;
char problemName[PETSC_MAX_PATH_LEN];
char filename[PETSC_MAX_PATH_LEN];
double t0 = 0.0;
double dt = 0.1;
double t1 = 1.0;
double beta = 0.000001;
Vec rho; // density - elemental scalar
Vec lambda; // Lame parameter - lambda - elemental scalar
Vec mu; // Lame parameter - mu - elemental scalar
Vec fibers; // Fiber orientations - nodal vector (3-dof)
std::vector<Vec> tau; // the scalar activation - nodal scalar
std::vector<ot::TreeNode> linOct, balOct, newLinOct;
std::vector<double> pts;
// Initial conditions
Vec initialDisplacement;
Vec initialVelocity;
double nu, E;
nu = 0.45;
E = 1000;
timeInfo ti;
PetscTruth mf = PETSC_FALSE;
bool mfree = false;
PetscOptionsGetTruth(0, "-mfree", &mf, 0);
if (mf == PETSC_TRUE) {
mfree = true;
} else
mfree = false;
double ctrst = 1.0;
// get Ns
CHKERRQ ( PetscOptionsGetInt(0,"-Ns",&Ns,0) );
CHKERRQ ( PetscOptionsGetInt(0,"-mdepth",&maxDepth,0) );
CHKERRQ ( PetscOptionsGetScalar(0,"-ctrst",&ctrst,0) );
CHKERRQ ( PetscOptionsGetScalar(0,"-t0",&t0,0) );
CHKERRQ ( PetscOptionsGetScalar(0,"-nu",&nu,0) );
CHKERRQ ( PetscOptionsGetScalar(0,"-Youngs",&E,0) );
CHKERRQ ( PetscOptionsGetScalar(0,"-t1",&t1,0) );
CHKERRQ ( PetscOptionsGetScalar(0,"-dt",&dt,0) );
CHKERRQ ( PetscOptionsGetScalar(0,"-beta",&beta,0) );
CHKERRQ ( PetscOptionsGetString(PETSC_NULL,"-pn",problemName,PETSC_MAX_PATH_LEN-1,PETSC_NULL));
// Time info for timestepping
ti.start = t0;
ti.stop = t1;
ti.step = dt;
if (!rank) {
std::cout << "Grid size is " << Ns+1 << " and NT is " << (int)ceil(1.0/dt) << std::endl;
std::cout << "MaxDepth is " << maxDepth << std::endl;
}
/*
for (int i=0; i<3*Ns*Ns*Ns; i++) {
double val = gaussian(); //randgauss(0., 1., 2.0, 0.);
// std::cout << val << std::endl;
pts.push_back(val);
}
MPI_Barrier(MPI_COMM_WORLD);
*/
/*********************************************************************** */
// CONSTRUCT: Construct the linear octree from the points ...
/*********************************************************************** */
// ot::points2Octree(pts, gSize, linOct, dim, maxDepth, maxNumPts, MPI_COMM_WORLD);
// The points are not needed anymore, and can be cleared to free memory.
// pts.clear();
if (!rank) {
ot::readNodesFromFile("test.256.oct", newLinOct);
std::cout << "Finished reading" << std::endl;
}
// std::sort(linOct.begin(), linOct.end());
std::cout << rank << " Original octree size is " << newLinOct.size() << std::endl;
/*
par::Partition<ot::TreeNode>(linoct, newLinOct, MPI_COMM_WORLD);
linOct.clear();
*/
par::sampleSort<ot::TreeNode>(newLinOct, linOct, MPI_COMM_WORLD);
newLinOct.clear();
std::cout << rank << ": after Part octree size is " << linOct.size() << std::endl;
/*********************************************************************** */
// BALANCE: Balance the linear octree to enforce the 2:1 balance conditions.
/*********************************************************************** */
ot::balanceOctree (linOct, balOct, dim, maxDepth, incCorner, MPI_COMM_WORLD);
std::cout << "Balanced octree size is " << balOct.size() << std::endl;
// The linear octree (unbalanced) can be cleared to free memory.
linOct.clear();
// If desired the octree can be written to a file using the supplied routine ...
ot::writeNodesToFile("filename.oct", balOct);
/*********************************************************************** */
// MESH : Construct the octree-based Distruted Array.
/*********************************************************************** */
ot::DA da(balOct,MPI_COMM_WORLD);
balOct.clear();
MPI_Barrier(MPI_COMM_WORLD);
if (!rank)
std::cout <<"Finshed Meshing" << std::endl;
PetscFinalize();
return 0;
// create Matrices and Vectors
elasMass *Mass = new elasMass(feMat::OCT); // Mass Matrix
elasStiffness *Stiffness = new elasStiffness(feMat::OCT); // Stiffness matrix
raleighDamping *Damping = new raleighDamping(feMat::OCT); // Damping Matrix
cardiacForce *Force = new cardiacForce(feVec::OCT); // Force Vector
// create vectors
da.createVector(rho, false, false, 1);
da.createVector(mu, false, false, 1);
da.createVector(lambda, false, false, 1);
da.createVector(initialDisplacement, false, false, dof);
da.createVector(initialVelocity, false, false, dof);
// Set initial conditions
CHKERRQ( VecSet ( initialDisplacement, 0.0) );
CHKERRQ( VecSet ( initialVelocity, 0.0) );
int parFac = 2;
int numParams = 120;
CHKERRQ ( PetscOptionsGetInt(0,"-pFac", &parFac,0) );
numParams = parFac*parFac*parFac*5*3;
if (!rank)
std::cout << "Total number of unknowns is " << numParams << std::endl;
// Generate the basis ...
std::vector < radialBasis > spatialBasis;
bSplineBasis temporalBasis(3, 5); // this creates and sets up the basis ...
// temporalBasis.knot();
double fac = 1.0/parFac;
double ssq = fac*fac/5.5452; // 8log(2) = 5.5452
PetscPrintf(0, "SSQ is %f\n", ssq);
// Now to set up the radial bases ...
for (int k=0; k<parFac; k++) {
for (int j=0; j<parFac; j++) {
for (int i=0; i<parFac; i++) {
// std::cout << "Adding radial basis at: " << fac/2+i*fac << ", " << fac/2+j*fac << ", " << fac/2+k*fac << std::endl;
radialBasis tmp(Point( fac/2+i*fac,fac/2+j*fac,fac/2+k*fac), Point(ssq,ssq,ssq));
spatialBasis.push_back(tmp);
}
}
}
/*
// Homogeneous material properties ...
CHKERRQ( VecSet ( rho, 1.0) );
nu = 0.45; E = 1000;
double mmu = E/(2*(1+nu));
double llam = E*nu/((1+nu)*(1-2*nu));
CHKERRQ( VecSet ( mu, mmu) );
CHKERRQ( VecSet ( lambda, llam) );
*/
PetscScalar *muArray, *lamArray, *rhoArray;
// Read in material properties from file ...
unsigned int elemSize = Ns*Ns*Ns;
unsigned char *tmp_mat = new unsigned char[elemSize];
double *tmp_tau = new double[elemSize];
double *tmp_fib = new double[dof*elemSize];
// generate filenames & read in the raw arrays first ...
std::ifstream fin;
sprintf(filename, "%s.%d.img", problemName, Ns);
fin.open(filename, std::ios::binary); fin.read((char *)tmp_mat, elemSize); fin.close();
nu = 0.35; E = 1000;
double mmu = E/(2*(1+nu));
double llam = E*nu/((1+nu)*(1-2*nu));
nu = 0.45; E = 1000*ctrst;
double mmu2 = E/(2*(1+nu));
double llam2 = E*nu/((1+nu)*(1-2*nu));
da.vecGetBuffer(mu, muArray,true,true,false,1);
da.vecGetBuffer(lambda, lamArray,true,true,false,1);
da.vecGetBuffer(rho, rhoArray,true,true,false,1);
for ( da.init<ot::DA::ALL>(), da.init<ot::DA::WRITABLE>(); da.curr() < da.end<ot::DA::ALL>(); da.next<ot::DA::ALL>()) {
unsigned int i = da.curr();
Point pt;
pt = da.getCurrentOffset();
int indx = pt.z()*Ns*Ns + pt.y()*Ns + pt.x();
if ( tmp_mat[indx] ) {
muArray[i] = mmu2;
lamArray[i] = llam2;
rhoArray[i] = 1.0;
} else {
muArray[i] = mmu;
lamArray[i] = llam;
rhoArray[i] = 1.0;
}
}
da.vecRestoreBuffer(mu, muArray,true,true,false,1);
da.vecRestoreBuffer(lambda, lamArray,true,true,false,1);
da.vecRestoreBuffer(rho, rhoArray,true,true,false,1);
delete [] tmp_mat;
// Now set the activation ...
unsigned int numSteps = (unsigned int)(ceil(( ti.stop - ti.start)/ti.step));
Vec tauVec, tmpTau;
// Create elemental vector ...
da.createVector(tmpTau, true, true, 1);
da.createVector(fibers, true, true, 3);
PetscScalar *tauArray;
// load the fibers ...
da.vecGetBuffer(fibers, tauArray, true, true, 3);
sprintf(filename, "%s.%d.fibers", problemName, Ns);
std::ifstream fin3(filename, std::ios::binary); fin3.read((char *)tmp_fib, dof*elemSize*sizeof(double)); fin3.close();
for ( da.init<ot::DA::ALL>(), da.init<ot::DA::WRITABLE>(); da.curr() < da.end<ot::DA::ALL>(); da.next<ot::DA::ALL>()) {
unsigned int i = da.curr();
Point pt;
pt = da.getCurrentOffset();
int indx = pt.z()*Ns*Ns + pt.y()*Ns + pt.x();
for (int d=0; d<dof; d++) {
tauArray[dof*i+d] = tmp_tau[dof*indx+d];
}
}
da.vecRestoreBuffer(fibers, tauArray, true, true, 3);
delete [] tmp_fib;
// loop through time steps
for (unsigned int t=0; t<numSteps+1; t++) {
// a. Create new nodal vector ...
da.createVector(tauVec, false, true, 1);
VecSet( tmpTau, 0.0 );
da.vecGetBuffer(tmpTau, tauArray, true, true, 1);
// b. read in the activation
// std::cout << "Setting force vectors" << std::endl;
sprintf(filename, "%s.%d.%.3d.fld", problemName, Ns, t);
// std::cout << "Reading force file " << filename << std::endl;
fin.open(filename); fin.read((char *)tmp_tau, elemSize*sizeof(double)); fin.close();
// c. set the values ...
for ( da.init<ot::DA::ALL>(), da.init<ot::DA::WRITABLE>(); da.curr() < da.end<ot::DA::ALL>(); da.next<ot::DA::ALL>()) {
unsigned int i = da.curr();
Point pt;
pt = da.getCurrentOffset();
int indx = pt.z()*Ns*Ns + pt.y()*Ns + pt.x();
tauArray[i] = tmp_tau[indx];
}
// restore
da.vecRestoreBuffer(tmpTau, tauArray, true, true, 1);
// d. element2node
elementToNode(da, tmpTau, tauVec, 1);
// store in vector
tau.push_back(tauVec);
}
// Setup Matrices and Force Vector ...
Mass->setProblemDimensions(1.0, 1.0, 1.0);
Mass->setDA(&da);
Mass->setDof(dof);
Mass->setDensity(rho);
Stiffness->setProblemDimensions(1.0, 1.0, 1.0);
Stiffness->setDA(&da);
Stiffness->setDof(dof);
Stiffness->setLame(lambda, mu);
Damping->setAlpha(0.0);
Damping->setBeta(0.00075);
Damping->setMassMatrix(Mass);
Damping->setStiffnessMatrix(Stiffness);
Damping->setDA(&da);
Damping->setDof(dof);
// Force Vector
Force->setProblemDimensions(1.0,1.0,1.0);
Force->setDA(&da);
// Force->setFDynamic(tau);
Force->setActivationVec(tau);
Force->setFiberOrientations(fibers);
Force->setTimeInfo(&ti);
// Newmark time stepper ...
newmark *ts = new newmark;
ts->setMassMatrix(Mass);
ts->setDampingMatrix(Damping);
ts->setStiffnessMatrix(Stiffness);
ts->damp(false);
ts->setTimeFrames(1);
ts->storeVec(true);
ts->setForceVector(Force);
ts->setInitialDisplacement(initialDisplacement);
ts->setInitialVelocity(initialVelocity);
ts->setTimeInfo(&ti);
ts->setAdjoint(false); // set if adjoint or forward
ts->useMatrixFree(mfree);
//if (!rank)
// std::cout << RED"Initializing Newmark"NRM << std::endl;
double itime = MPI_Wtime();
ts->init(); // initialize IMPORTANT
//if (!rank)
// std::cout << RED"Starting Newmark Solve"NRM << std::endl;
double stime = MPI_Wtime();
ts->solve();// solve
double etime = MPI_Wtime();
// PetscFinalize();
Vec alpha, outvec;
PetscScalar *avec;
VecCreateSeq(PETSC_COMM_SELF, numParams, &alpha);
VecGetArray(alpha, &avec);
for (int j=0; j<numParams; j++)
avec[j] = 0.0;
avec[1] = 1.0;
VecRestoreArray(alpha, &avec);
VecDuplicate(alpha, &outvec);
// Inverse solver set up
parametricActivationInverse *hyperInv = new parametricActivationInverse;
hyperInv->setBasis(spatialBasis, temporalBasis);
hyperInv->setForwardInitialConditions(initialDisplacement, initialVelocity);
hyperInv->setTimeStepper(ts); // set the timestepper
hyperInv->setInitialGuess(alpha);// set the initial guess
hyperInv->setRegularizationParameter(beta); // set the regularization paramter
// hyperInv->setObservations(solvec); // set the data for the problem
hyperInv->init(); // initialize the inverse solver
hyperInv->solve();
Vec FinalSolution;
hyperInv->getCurrentControl(FinalSolution);
char fname[256];
sprintf(fname, "%s.soln.%d.%d.raw",problemName, Ns, parFac );
std::ofstream sol;
if (!rank) {
sol.open(fname, std::ios::binary);
VecGetArray(FinalSolution, &avec);
sol.write((char *)avec, numParams*sizeof(PetscScalar));
VecRestoreArray(outvec, &avec);
sol.close();
}
PetscFinalize();
}
int main(int argc,char **argv)
{
PetscMPIInt size,rank;
PetscInt M=8,dof=1,stencil_width=1,i,start,end,P=5,N = 6,m=PETSC_DECIDE,n=PETSC_DECIDE,p=PETSC_DECIDE,pt = 0,st = 0;
PetscErrorCode ierr;
PetscTruth flg2,flg3,flg;
DAPeriodicType periodic = DA_NONPERIODIC;
DAStencilType stencil_type = DA_STENCIL_STAR;
DA da;
SDA sda;
Vec local,global,local_copy;
PetscScalar value,*in,*out;
PetscReal norm,work;
PetscViewer viewer;
char filename[PETSC_MAX_PATH_LEN];
FILE *file;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-M",&M,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-N",&N,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-P",&P,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-dof",&dof,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-stencil_width",&stencil_width,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-periodic",&pt,PETSC_NULL);CHKERRQ(ierr);
periodic = (DAPeriodicType) pt;
ierr = PetscOptionsGetInt(PETSC_NULL,"-stencil_type",&st,PETSC_NULL);CHKERRQ(ierr);
stencil_type = (DAStencilType) st;
ierr = PetscOptionsHasName(PETSC_NULL,"-1d",&flg2);CHKERRQ(ierr);
ierr = PetscOptionsHasName(PETSC_NULL,"-2d",&flg2);CHKERRQ(ierr);
ierr = PetscOptionsHasName(PETSC_NULL,"-3d",&flg3);CHKERRQ(ierr);
if (flg2) {
ierr = DACreate2d(PETSC_COMM_WORLD,periodic,stencil_type,M,N,m,n,dof,stencil_width,0,0,&da);CHKERRQ(ierr);
ierr = SDACreate2d(PETSC_COMM_WORLD,periodic,stencil_type,M,N,m,n,dof,stencil_width,0,0,&sda);CHKERRQ(ierr);
} else if (flg3) {
ierr = DACreate3d(PETSC_COMM_WORLD,periodic,stencil_type,M,N,P,m,n,p,dof,stencil_width,0,0,0,&da);CHKERRQ(ierr);
ierr = SDACreate3d(PETSC_COMM_WORLD,periodic,stencil_type,M,N,P,m,n,p,dof,stencil_width,0,0,0,&sda);CHKERRQ(ierr);
}
else {
ierr = DACreate1d(PETSC_COMM_WORLD,periodic,M,dof,stencil_width,PETSC_NULL,&da);CHKERRQ(ierr);
ierr = SDACreate1d(PETSC_COMM_WORLD,periodic,M,dof,stencil_width,PETSC_NULL,&sda);CHKERRQ(ierr);
}
ierr = DACreateGlobalVector(da,&global);CHKERRQ(ierr);
ierr = DACreateLocalVector(da,&local);CHKERRQ(ierr);
ierr = VecDuplicate(local,&local_copy);CHKERRQ(ierr);
/* zero out vectors so that ghostpoints are zero */
value = 0;
ierr = VecSet(local,value);CHKERRQ(ierr);
ierr = VecSet(local_copy,value);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(global,&start,&end);CHKERRQ(ierr);
for (i=start; i<end; i++) {
value = i + 1;
ierr = VecSetValues(global,1,&i,&value,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = VecAssemblyBegin(global);CHKERRQ(ierr);
ierr = VecAssemblyEnd(global);CHKERRQ(ierr);
ierr = DAGlobalToLocalBegin(da,global,INSERT_VALUES,local);CHKERRQ(ierr);
ierr = DAGlobalToLocalEnd(da,global,INSERT_VALUES,local);CHKERRQ(ierr);
flg = PETSC_FALSE;
ierr = PetscOptionsGetTruth(PETSC_NULL,"-same_array",&flg,PETSC_NULL);CHKERRQ(ierr);
if (flg) {
/* test the case where the input and output array is the same */
ierr = VecCopy(local,local_copy);CHKERRQ(ierr);
ierr = VecGetArray(local_copy,&in);CHKERRQ(ierr);
ierr = VecRestoreArray(local_copy,PETSC_NULL);CHKERRQ(ierr);
ierr = SDALocalToLocalBegin(sda,in,INSERT_VALUES,in);CHKERRQ(ierr);
ierr = SDALocalToLocalEnd(sda,in,INSERT_VALUES,in);CHKERRQ(ierr);
} else {
ierr = VecGetArray(local,&out);CHKERRQ(ierr);
ierr = VecRestoreArray(local,PETSC_NULL);CHKERRQ(ierr);
ierr = VecGetArray(local_copy,&in);CHKERRQ(ierr);
ierr = VecRestoreArray(local_copy,PETSC_NULL);CHKERRQ(ierr);
ierr = SDALocalToLocalBegin(sda,out,INSERT_VALUES,in);CHKERRQ(ierr);
ierr = SDALocalToLocalEnd(sda,out,INSERT_VALUES,in);CHKERRQ(ierr);
}
flg = PETSC_FALSE;
ierr = PetscOptionsGetTruth(PETSC_NULL,"-save",&flg,PETSC_NULL);CHKERRQ(ierr);
if (flg) {
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
sprintf(filename,"local.%d",rank);
ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIGetPointer(viewer,&file);CHKERRQ(ierr);
ierr = VecView(local,viewer);CHKERRQ(ierr);
fprintf(file,"Vector with correct ghost points\n");
ierr = VecView(local_copy,viewer);CHKERRQ(ierr);
ierr = PetscViewerDestroy(viewer);CHKERRQ(ierr);
}
ierr = VecAXPY(local_copy,-1.0,local);CHKERRQ(ierr);
ierr = VecNorm(local_copy,NORM_MAX,&work);CHKERRQ(ierr);
ierr = MPI_Allreduce(&work,&norm,1,MPIU_REAL,MPI_MAX,PETSC_COMM_WORLD);CHKERRQ(ierr);
if (norm != 0.0) {
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Norm of difference %G should be zero\n",norm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," Number of processors %d\n",size);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," M,N,P,dof %D %D %D %D\n",M,N,P,dof);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," stencil_width %D stencil_type %d periodic %d\n",stencil_width,(int)stencil_type,(int)periodic);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD," dimension %d\n",1 + (int) flg2 + (int) flg3);CHKERRQ(ierr);
}
ierr = DADestroy(da);CHKERRQ(ierr);
ierr = SDADestroy(sda);CHKERRQ(ierr);
ierr = VecDestroy(local_copy);CHKERRQ(ierr);
ierr = VecDestroy(local);CHKERRQ(ierr);
ierr = VecDestroy(global);CHKERRQ(ierr);
ierr = PetscFinalize();CHKERRQ(ierr);
return 0;
}
/*
Builds
B Y1 X1 Bt
and creates a ksp when C=0, otherwise it builds
B Y1 X1 Bt - C
*/
PetscErrorCode BSSCR_PCScGtKGUseStandardBBtOperator( PC pc )
{
PC_SC_GtKG ctx = (PC_SC_GtKG)pc->data;
PetscReal fill;
Mat diag_mat,C;
Vec diag;
PetscInt M,N, m,n;
MPI_Comm comm;
PetscInt nnz_I, nnz_G;
MatType mtype;
const char *prefix;
Mat BBt;
KSP ksp;
PetscTruth ivalue, flg, has_cnst_nullsp;
BSSCR_BSSCR_pc_error_ScGtKG( pc, __func__ );
/* Assemble BBt */
MatGetSize( ctx->Bt, &M, &N );
MatGetLocalSize( ctx->Bt, &m, &n );
MatGetVecs( ctx->Bt, PETSC_NULL, &diag );
/* Define diagonal matrix Y1 X1 */
VecPointwiseMult( diag, ctx->Y1, ctx->X1 );
PetscObjectGetComm( (PetscObject)ctx->F, &comm );
MatCreate( comm, &diag_mat );
MatSetSizes( diag_mat, m,m , M, M );
#if (((PETSC_VERSION_MAJOR==3) && (PETSC_VERSION_MINOR>=3)) || (PETSC_VERSION_MAJOR>3) )
MatSetUp(diag_mat);
#endif
MatGetType( ctx->Bt, &mtype );
MatSetType( diag_mat, mtype );
MatDiagonalSet( diag_mat, diag, INSERT_VALUES );
/* Build operator B Y1 X1 Bt */
BSSCR_BSSCR_get_number_nonzeros_AIJ_ScGtKG( diag_mat, &nnz_I );
BSSCR_BSSCR_get_number_nonzeros_AIJ_ScGtKG( ctx->Bt, &nnz_G );
/*
Not sure the best way to estimate the fill factor.
BBt is a laplacian on the pressure space.
This might tell us something useful...
*/
fill = (PetscReal)(nnz_G)/(PetscReal)( nnz_I );
MatPtAP( diag_mat, ctx->Bt, MAT_INITIAL_MATRIX, fill, &BBt );
Stg_MatDestroy(&diag_mat );
Stg_VecDestroy(&diag );
C = ctx->C;
if( C !=PETSC_NULL ) {
MatAXPY( BBt, -1.0, C, DIFFERENT_NONZERO_PATTERN );
}
/* Build the solver */
KSPCreate( ((PetscObject)pc)->comm, &ksp );
Stg_KSPSetOperators( ksp, BBt, BBt, SAME_NONZERO_PATTERN );
PCGetOptionsPrefix( pc,&prefix );
KSPSetOptionsPrefix( ksp, prefix );
KSPAppendOptionsPrefix( ksp, "pc_gtkg_" ); /* -pc_GtKG_ksp_type <type>, -ksp_GtKG_pc_type <type> */
BSSCR_PCScGtKGSetKSP( pc, ksp );
BSSCR_MatContainsConstNullSpace( BBt, NULL, &has_cnst_nullsp );
if( has_cnst_nullsp == PETSC_TRUE ) {
BSSCR_PCScGtKGAttachNullSpace( pc );
}
PetscOptionsGetTruth( PETSC_NULL, "-pc_gtkg_monitor", &ivalue, &flg );
BSSCR_PCScGtKGSetSubKSPMonitor( pc, ivalue );
Stg_KSPDestroy(&ksp);
Stg_MatDestroy(&BBt);
PetscFunctionReturn(0);
}
PetscErrorCode BSSCR_DRIVER_auglag( KSP ksp, Mat stokes_A, Vec stokes_x, Vec stokes_b, Mat approxS,
MatStokesBlockScaling BA, PetscTruth sym, KSP_BSSCR * bsscrp_self )
{
AugLagStokes_SLE * stokesSLE = (AugLagStokes_SLE*)bsscrp_self->solver->st_sle;
PetscTruth uzawastyle, KisJustK=PETSC_TRUE, restorek, change_A11rhspresolve;
PetscTruth usePreviousGuess, useNormInfStoppingConditions, useNormInfMonitor, found, forcecorrection;
PetscTruth change_backsolve, mg_active;
PetscErrorCode ierr;
//PetscInt monitor_index;
PetscInt max_it,min_it;
KSP ksp_inner, ksp_S, ksp_new_inner;
PC pc_S, pcInner;
Mat K,G,D,C, S, K2;// Korig;
Vec u,p,f,f2=0,f3=0,h, h_hat,t;
MGContext mgCtx;
double mgSetupTime, scrSolveTime, a11SingleSolveTime, penaltyNumber;// hFactor;
static int been_here = 0; /* Ha Ha Ha !! */
char name[PETSC_MAX_PATH_LEN];
char matname[PETSC_MAX_PATH_LEN];
char suffix[PETSC_MAX_PATH_LEN];
char str[PETSC_MAX_PATH_LEN];
PetscTruth flg, extractMats;
PetscLogDouble flopsA,flopsB;
/***************************************************************************************************************/
/***************************************************************************************************************/
//if( bsscrp_self->solver->st_sle->context->loadFromCheckPoint ){
// been_here=1;
//}
/* get sub matrix / vector objects */
/* note that here, the matrix D should always exist. It is set up in _StokesBlockKSPInterface_Solve in StokesBlockKSPInterface.c */
/* now extract K,G etc from a MatNest object */
MatNestGetSubMat( stokes_A, 0,0, &K );
MatNestGetSubMat( stokes_A, 0,1, &G );
MatNestGetSubMat( stokes_A, 1,0, &D );if(!D){ PetscPrintf( PETSC_COMM_WORLD, "D does not exist but should!!\n"); exit(1); }
MatNestGetSubMat( stokes_A, 1,1, &C );
VecNestGetSubVec( stokes_x, 0, &u );
VecNestGetSubVec( stokes_x, 1, &p );
VecNestGetSubVec( stokes_b, 0, &f );
VecNestGetSubVec( stokes_b, 1, &h );
PetscPrintf( PETSC_COMM_WORLD, "\n\n---------- AUGMENTED LAGRANGIAN K2 METHOD ---------\n\n" );
PetscPrintf( PETSC_COMM_WORLD, "----------- Penalty = %f\n\n", bsscrp_self->solver->penaltyNumber );
sprintf(suffix,"%s","x");
PetscOptionsGetString( PETSC_NULL, "-matsuffix", suffix, PETSC_MAX_PATH_LEN-1, &extractMats );
flg=0;
PetscOptionsGetString( PETSC_NULL, "-matdumpdir", name, PETSC_MAX_PATH_LEN-1, &flg );
if(flg){
sprintf(str,"%s/",name); sprintf(matname,"K%s",suffix);
bsscr_dirwriteMat( K, matname,str, "Writing K matrix in al Solver");
sprintf(str,"%s/",name); sprintf(matname,"G%s",suffix);
bsscr_dirwriteMat( G, matname,str, "Writing G matrix in al Solver");
sprintf(str,"%s/",name); sprintf(matname,"D%s",suffix);
bsscr_dirwriteMat( D, matname,str, "Writing D matrix in al Solver");
sprintf(str,"%s/",name); sprintf(matname,"f%s",suffix);
bsscr_dirwriteVec( f, matname,str, "Writing f vector in al Solver");
sprintf(str,"%s/",name); sprintf(matname,"h%s",suffix);
bsscr_dirwriteVec( h, matname,str, "Writing h vector in al Solver");
sprintf(str,"%s/",name); sprintf(matname,"Shat%s",suffix);
bsscr_dirwriteMat( approxS, matname,str, "Writing Shat matrix in al Solver");
if(C){
sprintf(str,"%s/",name); sprintf(matname,"C%s",suffix);
bsscr_dirwriteMat( C, matname,str, "Writing C matrix in al Solver");
}
}
mg_active=PETSC_TRUE;
PetscOptionsGetTruth( PETSC_NULL ,"-A11_mg_active", &mg_active, &found );
bsscrp_self->solver->mg_active=mg_active;
penaltyNumber = bsscrp_self->solver->penaltyNumber;
//hFactor = stokesSLE->hFactor;
/***************************************************************************************************************/
/***************************************************************************************************************/
/****** GET K2 ****************************************************************************************/
if(penaltyNumber > 1e-10 && bsscrp_self->k2type){
flg=0;
PetscOptionsGetString( PETSC_NULL, "-matdumpdir", name, PETSC_MAX_PATH_LEN-1, &flg );
if(flg){
sprintf(str,"%s/",name); sprintf(matname,"K2%s",suffix);
bsscr_dirwriteMat( bsscrp_self->K2, matname,str, "Writing K2 matrix in al Solver");
}
K2=bsscrp_self->K2;
scrSolveTime = MPI_Wtime();
ierr=MatAXPY(K,penaltyNumber,K2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);/* Computes K = penaltyNumber*K2 + K */
scrSolveTime = MPI_Wtime() - scrSolveTime;
PetscPrintf( PETSC_COMM_WORLD, "\n\t* K+p*K2 in time: %lf seconds\n\n", scrSolveTime);
KisJustK=PETSC_FALSE;
forcecorrection=PETSC_TRUE;
PetscOptionsGetTruth( PETSC_NULL ,"-force_correction", &forcecorrection, &found );
if(forcecorrection){
if(bsscrp_self->f2 && forcecorrection){
f2=bsscrp_self->f2;
ierr=VecAXPY(f,penaltyNumber,f2);/* f <- f +a*f2 */
}else{
switch (bsscrp_self->k2type) {
case (K2_GG):
{
VecDuplicate( u, &f3 );
MatMult( G, h, f3); ierr=VecAXPY(f,penaltyNumber,f3);/* f <- f +a*f2 */
}
break;
case (K2_GMG):
{
Mat M;
Vec Mdiag;
VecDuplicate( u, &f3 );
M = bsscrp_self->solver->mStiffMat->matrix;
MatGetVecs( M, &Mdiag, PETSC_NULL );
MatGetDiagonal( M, Mdiag );
VecReciprocal(Mdiag);
VecPointwiseMult(Mdiag,Mdiag,h);
MatMult( G, Mdiag, f3); ierr=VecAXPY(f,penaltyNumber,f3);/* f <- f +a*f2 */
Stg_VecDestroy(&Mdiag);
}
break;
case (K2_DGMGD):
{
Mat M;
Vec Mdiag;
VecDuplicate( u, &f3 );
M = bsscrp_self->solver->mStiffMat->matrix;
MatGetVecs( M, &Mdiag, PETSC_NULL );
MatGetDiagonal( M, Mdiag );
VecReciprocal(Mdiag);
VecPointwiseMult(Mdiag,Mdiag,h);
MatMult( G, Mdiag, f3); ierr=VecAXPY(f,penaltyNumber,f3);/* f <- f +a*f2 */
Stg_VecDestroy(&Mdiag);
}
break;
case (K2_NULL):
{
;
}
break;
case (K2_SLE):
{
;
}
break;
}
}
}
}
/* Create Schur complement matrix */
MatCreateSchurComplement(K,K,G,D,C, &S);
MatSchurComplementGetKSP( S, &ksp_inner);
KSPGetPC( ksp_inner, &pcInner );
/***************************************************************************************************************/
/***************************************************************************************************************/
/********* SET PREFIX FOR INNER/VELOCITY KSP *************************************************************/
KSPSetOptionsPrefix( ksp_inner, "A11_" );
KSPSetFromOptions( ksp_inner );
Stg_KSPSetOperators(ksp_inner, K, K, DIFFERENT_NONZERO_PATTERN);
useNormInfStoppingConditions = PETSC_FALSE;
PetscOptionsGetTruth( PETSC_NULL ,"-A11_use_norm_inf_stopping_condition", &useNormInfStoppingConditions, &found );
if(useNormInfStoppingConditions)
BSSCR_KSPSetNormInfConvergenceTest( ksp_inner );
useNormInfMonitor = PETSC_FALSE;
PetscOptionsGetTruth( PETSC_NULL, "-A11_ksp_norm_inf_monitor", &useNormInfMonitor, &found );
if(useNormInfMonitor) KSPMonitorSet( ksp_inner, BSSCR_KSPNormInfMonitor, PETSC_NULL, PETSC_NULL );
useNormInfMonitor = PETSC_FALSE;
PetscOptionsGetTruth( PETSC_NULL, "-A11_ksp_norm_inf_to_norm_2_monitor", &useNormInfMonitor, &found );
if(useNormInfMonitor) KSPMonitorSet( ksp_inner, BSSCR_KSPNormInfToNorm2Monitor, PETSC_NULL, PETSC_NULL );
/***************************************************************************************************************/
/***************************************************************************************************************/
/* If multigrid is enabled, set it now. */
change_A11rhspresolve = PETSC_FALSE;
PetscOptionsGetTruth( PETSC_NULL, "-change_A11rhspresolve", &change_A11rhspresolve, &found );
if(bsscrp_self->solver->mg_active && !change_A11rhspresolve) { mgSetupTime=setupMG( bsscrp_self, ksp_inner, pcInner, K, &mgCtx ); }
/***************************************************************************************************************/
/***************************************************************************************************************/
/* create right hand side */
if(change_A11rhspresolve){
//Stg_KSPDestroy(&ksp_inner );
KSPCreate(PETSC_COMM_WORLD, &ksp_new_inner);
Stg_KSPSetOperators(ksp_new_inner, K, K, DIFFERENT_NONZERO_PATTERN);
KSPSetOptionsPrefix(ksp_new_inner, "rhsA11_");
MatSchurComplementSetKSP( S, ksp_new_inner );/* this call destroys the ksp_inner that is already set on S */
ksp_inner=ksp_new_inner;
KSPGetPC( ksp_inner, &pcInner );
KSPSetFromOptions(ksp_inner); /* make sure we are setting up our solver how we want it */
}
MatGetVecs( S, PETSC_NULL, &h_hat );
Vec f_tmp;
/* It may be the case that the current velocity solution might not be bad guess for f_tmp? <-- maybe not */
MatGetVecs( K, PETSC_NULL, &f_tmp );
scrSolveTime = MPI_Wtime();
KSPSolve(ksp_inner, f, f_tmp);
scrSolveTime = MPI_Wtime() - scrSolveTime;
PetscPrintf( PETSC_COMM_WORLD, "\n\t* KSPSolve for RHS setup Finished in time: %lf seconds\n\n", scrSolveTime);
MatMult(D, f_tmp, h_hat);
VecAYPX(h_hat, -1.0, h); /* Computes y = x + alpha y. h_hat -> h - Gt*K^(-1)*f*/
Stg_VecDestroy(&f_tmp);
if(bsscrp_self->solver->mg_active && change_A11rhspresolve) {
//Stg_KSPDestroy(&ksp_inner );
KSPCreate(PETSC_COMM_WORLD, &ksp_new_inner);
Stg_KSPSetOperators(ksp_new_inner, K, K, DIFFERENT_NONZERO_PATTERN);
KSPSetOptionsPrefix( ksp_new_inner, "A11_" );
MatSchurComplementSetKSP( S, ksp_new_inner );
ksp_inner=ksp_new_inner;
//MatSchurSetKSP( S, ksp_inner );
KSPGetPC( ksp_inner, &pcInner );
KSPSetFromOptions( ksp_inner );
mgSetupTime=setupMG( bsscrp_self, ksp_inner, pcInner, K, &mgCtx );
}
/* create solver for S p = h_hat */
KSPCreate( PETSC_COMM_WORLD, &ksp_S );
KSPSetOptionsPrefix( ksp_S, "scr_");
/* By default use the UW approxS Schur preconditioner -- same as the one used by the Uzawa solver */
/* Note that if scaling is activated then the approxS matrix has been scaled already */
/* so no need to rebuild in the case of scaling as we have been doing */
if(!approxS){ PetscPrintf( PETSC_COMM_WORLD, "WARNING approxS is NULL\n"); }
Stg_KSPSetOperators( ksp_S, S, S, SAME_NONZERO_PATTERN );
KSPSetType( ksp_S, "cg" );
KSPGetPC( ksp_S, &pc_S );
BSSCR_BSSCR_StokesCreatePCSchur2( K,G,D,C,approxS, pc_S, sym, bsscrp_self );
flg=0;
PetscOptionsGetString( PETSC_NULL, "-NN", name, PETSC_MAX_PATH_LEN-1, &flg );
if(flg){
Mat Smat, Pmat;
//MatStructure mstruct;
Stg_PCGetOperators( pc_S, &Smat, &Pmat, NULL );
sprintf(str,"%s/",name); sprintf(matname,"Pmat%s",suffix);
bsscr_dirwriteMat( Pmat, matname,str, "Writing Pmat matrix in al Solver");
}
uzawastyle=PETSC_FALSE;
PetscOptionsGetTruth( PETSC_NULL, "-uzawa_style", &uzawastyle, &found );
if(uzawastyle){
/* now want to set up the ksp_S->pc to be of type ksp (gmres) by default to match Uzawa */
KSP pc_ksp;
KSPGetPC( ksp_S, &pc_S );
PCSetType(pc_S,PCKSP);
PCKSPGetKSP( pc_S, &pc_ksp);
KSPSetType(pc_ksp, "gmres" );
KSPSetOptionsPrefix( pc_ksp, "scrPCKSP_");
KSPSetFromOptions( pc_ksp );
}
KSPSetFromOptions( ksp_S );
/* Set specific monitor test */
KSPGetTolerances( ksp_S, PETSC_NULL, PETSC_NULL, PETSC_NULL, &max_it );
// Weirdness with petsc 3.2 here...look at it later
//BSSCR_KSPLogSetMonitor( ksp_S, max_it, &monitor_index );
/***************************************************************************************************************/
/* Pressure / Velocity Solve */
/***************************************************************************************************************/
PetscPrintf( PETSC_COMM_WORLD, "\t* Pressure / Velocity Solve \n");
/***************************************************************************************************************/
/***************************************************************************************************************/
usePreviousGuess = PETSC_FALSE;
if(been_here)
PetscOptionsGetTruth( PETSC_NULL, "-scr_use_previous_guess", &usePreviousGuess, &found );
if(usePreviousGuess) { /* Note this should actually look at checkpoint information */
KSPSetInitialGuessNonzero( ksp_S, PETSC_TRUE ); }
else {
KSPSetInitialGuessNonzero( ksp_S, PETSC_FALSE ); }
/***************************************************************************************************************/
/***************************************************************************************************************/
/******* SET CONVERGENCE TESTS *************************************************************************/
useNormInfStoppingConditions = PETSC_FALSE;
PetscOptionsGetTruth( PETSC_NULL ,"-scr_use_norm_inf_stopping_condition", &useNormInfStoppingConditions, &found );
if(useNormInfStoppingConditions)
BSSCR_KSPSetNormInfConvergenceTest(ksp_S);
useNormInfMonitor = PETSC_FALSE;
PetscOptionsGetTruth( PETSC_NULL, "-scr_ksp_norm_inf_monitor", &useNormInfMonitor, &found );
if(useNormInfMonitor)
KSPMonitorSet( ksp_S, BSSCR_KSPNormInfToNorm2Monitor, PETSC_NULL, PETSC_NULL );
/***************************************************************************************************************/
/***************************************************************************************************************/
/******* PRESSURE SOLVE ************************************************************************************/
PetscPrintf( PETSC_COMM_WORLD, "\t* KSPSolve( ksp_S, h_hat, p )\n");
/* if h_hat needs to be fixed up ..take out any nullspace vectors here */
/* we want to check that there is no "noise" in the null-space in the h vector */
/* this causes problems when we are trying to solve a Jacobian system when the Residual is almost converged */
if(bsscrp_self->check_pressureNS){
bsscrp_self->buildPNS(ksp);/* build and set nullspace vectors on bsscr - which is on ksp (function pointer is set in KSPSetUp_BSSCR) */
}
PetscScalar hnorm, gnorm;
MatNorm(G,NORM_INFINITY,&gnorm);
VecNorm(h_hat, NORM_2, &hnorm);
hnorm=hnorm/gnorm;
if((hnorm < 1e-6) && (hnorm > 1e-20)){
VecScale(h_hat,1.0/hnorm);
}
/* test to see if v or t are in nullspace of G and orthogonalize wrt h_hat if needed */
KSPRemovePressureNullspace_BSSCR(ksp, h_hat);
/* set convergence test to use min_it */
found = PETSC_FALSE;
min_it = 0;
PetscOptionsGetInt( PETSC_NULL,"-scr_ksp_set_min_it_converge", &min_it, &found);
if(found && min_it > 0){
BSSCR_KSPSetConvergenceMinIts(ksp_S, min_it, bsscrp_self);
}
/** Pressure Solve **/
PetscGetFlops(&flopsA);
scrSolveTime = MPI_Wtime();
KSPSolve( ksp_S, h_hat, p );
scrSolveTime = MPI_Wtime() - scrSolveTime;
PetscGetFlops(&flopsB);
PetscPrintf( PETSC_COMM_WORLD, "\n\t* KSPSolve( ksp_S, h_hat, p ) Solve Finished in time: %lf seconds\n\n", scrSolveTime);
bsscrp_self->solver->stats.pressure_time=scrSolveTime;
bsscrp_self->solver->stats.pressure_flops=(double)(flopsB-flopsA);
/***************************************/
if((hnorm < 1e-6) && (hnorm > 1e-20)){
VecScale(h_hat,hnorm);
VecScale(p,hnorm);
}
KSPRemovePressureNullspace_BSSCR(ksp, p);
/***************************************************************************************************************/
/***************************************************************************************************************/
/* restore K and f for the Velocity back solve */
found = PETSC_FALSE;
restorek = PETSC_FALSE;
PetscOptionsGetTruth( PETSC_NULL, "-restore_K", &restorek, &found);
//PetscOptionsGetString( PETSC_NULL, "-restore_K", name, PETSC_MAX_PATH_LEN-1, &flg );
if(penaltyNumber > 1e-10 && bsscrp_self->k2type){
if(restorek){
penaltyNumber = -penaltyNumber;
if(f2) { ierr=VecAXPY(f,penaltyNumber,f2); }/* f <- f +a*f2 */
if(f3) { ierr=VecAXPY(f,penaltyNumber,f3); }/* f <- f +a*f3 */
ierr=MatAXPY(K,penaltyNumber,K2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);/* Computes K = penaltyNumber*K2 + K */
//K=Korig;
Stg_KSPSetOperators(ksp_inner, K, K, DIFFERENT_NONZERO_PATTERN);
KisJustK=PETSC_TRUE;
}
}
if(f3){ Stg_VecDestroy(&f3 ); } /* always destroy this local vector if was created */
/* obtain solution for u */
VecDuplicate( u, &t ); MatMult( G, p, t); VecAYPX( t, -1.0, f ); /*** t <- -t + f = f - G*p ***/
MatSchurComplementGetKSP( S, &ksp_inner );
a11SingleSolveTime = MPI_Wtime(); /* ---------------------------------- Final V Solve */
if(usePreviousGuess) KSPSetInitialGuessNonzero( ksp_inner, PETSC_TRUE );
/***************************************************************************************************************/
/***************************************************************************************************************/
/******* VELOCITY SOLVE ************************************************************************************/
/** Easier to just create a new KSP here if we want to do backsolve diffferently. (getting petsc errors now when switching from fgmres) */
change_backsolve=PETSC_FALSE;
PetscOptionsGetTruth( PETSC_NULL, "-change_backsolve", &change_backsolve, &found );
if(change_backsolve){
//Stg_KSPDestroy(&ksp_inner );
KSPCreate(PETSC_COMM_WORLD, &ksp_new_inner);
Stg_KSPSetOperators(ksp_new_inner, K, K, DIFFERENT_NONZERO_PATTERN);
KSPSetOptionsPrefix(ksp_new_inner, "backsolveA11_");
KSPSetFromOptions(ksp_new_inner); /* make sure we are setting up our solver how we want it */
MatSchurComplementSetKSP( S, ksp_new_inner );/* need to give the Schur it's inner ksp back for when we destroy it at end */
ksp_inner=ksp_new_inner;
}
PetscGetFlops(&flopsA);
KSPSolve(ksp_inner, t, u); /* Solve, then restore default tolerance and initial guess */
PetscGetFlops(&flopsB);
bsscrp_self->solver->stats.velocity_backsolve_flops=(double)(flopsB-flopsA);
a11SingleSolveTime = MPI_Wtime() - a11SingleSolveTime; /* ------------------ Final V Solve */
bsscrp_self->solver->stats.velocity_backsolve_time=a11SingleSolveTime;
flg=0;
PetscOptionsGetString( PETSC_NULL, "-solutiondumpdir", name, PETSC_MAX_PATH_LEN-1, &flg );
if(flg){
sprintf(str,"%s/",name); sprintf(matname,"p%s",suffix);
bsscr_dirwriteVec( p, matname,str, "Writing p vector in al Solver");
sprintf(str,"%s/",name); sprintf(matname,"u%s",suffix);
bsscr_dirwriteVec( u, matname,str, "Writing u vector in al Solver");
sprintf(str,"%s/",name); sprintf(matname,"h_hat%s",suffix);
bsscr_dirwriteVec( h_hat, matname,str, "Writing h_hat vector in al Solver");
}
found = PETSC_FALSE;
restorek = PETSC_FALSE;
PetscOptionsGetTruth( PETSC_NULL, "-restore_K_after_solve", &restorek, &found);
if(penaltyNumber > 1e-10 && bsscrp_self->k2type){
if(restorek){
penaltyNumber = -penaltyNumber;
ierr=MatAXPY(K,penaltyNumber,K2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);/* Computes K = penaltyNumber*K2 + K */
KisJustK=PETSC_TRUE;
}
}
/***************************************************************************************************************/
/***************************************************************************************************************/
/****** SOLUTION SUMMARY ******************************************************************************/
bsscr_summary(bsscrp_self,ksp_S,ksp_inner,K,K2,D,G,C,u,p,f,h,t,penaltyNumber,KisJustK, mgSetupTime, scrSolveTime, a11SingleSolveTime);
//bsscr_summary(bsscrp_self,ksp_S,ksp_inner,K,Korig,K2,D,G,C,u,p,f,h,t,penaltyNumber,KisJustK, mgSetupTime, scrSolveTime, a11SingleSolveTime);
/***************************************************************************************************************/
/***************************************************************************************************************/
Stg_VecDestroy(&t );
Stg_KSPDestroy(&ksp_S );
Stg_VecDestroy(&h_hat );
Stg_MatDestroy(&S );//This will destroy ksp_inner: also.. pcInner == pc_MG and is destroyed when ksp_inner is
been_here = 1;
PetscFunctionReturn(0);
}
static int TaoSolve_BNLS(TAO_SOLVER tao, void*solver){
TAO_BNLS *bnls = (TAO_BNLS *)solver;
int info;
TaoInt lsflag,iter=0;
TaoTerminateReason reason=TAO_CONTINUE_ITERATING;
double f,f_full,gnorm,gdx,stepsize=1.0;
TaoTruth success;
TaoVec *XU, *XL;
TaoVec *X, *G=bnls->G, *PG=bnls->PG;
TaoVec *R=bnls->R, *DXFree=bnls->DXFree;
TaoVec *DX=bnls->DX, *Work=bnls->Work;
TaoMat *H, *Hsub=bnls->Hsub;
TaoIndexSet *FreeVariables = bnls->FreeVariables;
TaoFunctionBegin;
/* Check if upper bound greater than lower bound. */
info = TaoGetSolution(tao,&X);CHKERRQ(info); bnls->X=X;
info = TaoGetVariableBounds(tao,&XL,&XU);CHKERRQ(info);
info = TaoEvaluateVariableBounds(tao,XL,XU); CHKERRQ(info);
info = TaoGetHessian(tao,&H);CHKERRQ(info); bnls->H=H;
/* Project the current point onto the feasible set */
info = X->Median(XL,X,XU); CHKERRQ(info);
TaoLinearSolver *tls;
// Modify the linear solver to a conjugate gradient method
info = TaoGetLinearSolver(tao, &tls); CHKERRQ(info);
TaoLinearSolverPetsc *pls;
pls = dynamic_cast <TaoLinearSolverPetsc *> (tls);
// set trust radius to zero
// PETSc ignores this case and should return the negative curvature direction
// at its current default length
pls->SetTrustRadius(0.0);
if(!bnls->M) bnls->M = new TaoLMVMMat(X);
TaoLMVMMat *M = bnls->M;
KSP pksp = pls->GetKSP();
// we will want to provide an initial guess in case neg curvature on the first iteration
info = KSPSetInitialGuessNonzero(pksp,PETSC_TRUE); CHKERRQ(info);
PC ppc;
// Modify the preconditioner to use the bfgs approximation
info = KSPGetPC(pksp, &ppc); CHKERRQ(info);
PetscTruth BFGSPreconditioner=PETSC_FALSE;// debug flag
info = PetscOptionsGetTruth(PETSC_NULL,"-bnls_pc_bfgs",
&BFGSPreconditioner,PETSC_NULL); CHKERRQ(info);
if( BFGSPreconditioner)
{
info=PetscInfo(tao,"TaoSolve_BNLS: using bfgs preconditioner\n");
info = KSPSetNormType(pksp, KSP_NORM_PRECONDITIONED); CHKERRQ(info);
info = PCSetType(ppc, PCSHELL); CHKERRQ(info);
info = PCShellSetName(ppc, "bfgs"); CHKERRQ(info);
info = PCShellSetContext(ppc, M); CHKERRQ(info);
info = PCShellSetApply(ppc, bfgs_apply); CHKERRQ(info);
}
else
{// default to none
info=PetscInfo(tao,"TaoSolve_BNLS: using no preconditioner\n");
info = PCSetType(ppc, PCNONE); CHKERRQ(info);
}
info = TaoComputeMeritFunctionGradient(tao,X,&f,G);CHKERRQ(info);
info = PG->BoundGradientProjection(G,XL,X,XU);CHKERRQ(info);
info = PG->Norm2(&gnorm); CHKERRQ(info);
// Set initial scaling for the function
if (f != 0.0) {
info = M->SetDelta(2.0 * TaoAbsDouble(f) / (gnorm*gnorm)); CHKERRQ(info);
}
else {
info = M->SetDelta(2.0 / (gnorm*gnorm)); CHKERRQ(info);
}
while (reason==TAO_CONTINUE_ITERATING){
/* Project the gradient and calculate the norm */
info = PG->BoundGradientProjection(G,XL,X,XU);CHKERRQ(info);
info = PG->Norm2(&gnorm); CHKERRQ(info);
info = M->Update(X, PG); CHKERRQ(info);
PetscScalar ewAtol = PetscMin(0.5,gnorm)*gnorm;
info = KSPSetTolerances(pksp,PETSC_DEFAULT,ewAtol,
PETSC_DEFAULT, PETSC_DEFAULT); CHKERRQ(info);
info=PetscInfo1(tao,"TaoSolve_BNLS: gnorm =%g\n",gnorm);
pksp->printreason = PETSC_TRUE;
info = KSPView(pksp,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(info);
M->View();
info = TaoMonitor(tao,iter++,f,gnorm,0.0,stepsize,&reason);
CHKERRQ(info);
if (reason!=TAO_CONTINUE_ITERATING) break;
info = FreeVariables->WhichEqual(PG,G); CHKERRQ(info);
info = TaoComputeHessian(tao,X,H);CHKERRQ(info);
/* Create a reduced linear system */
info = R->SetReducedVec(G,FreeVariables);CHKERRQ(info);
info = R->Negate();CHKERRQ(info);
/* Use gradient as initial guess */
PetscTruth UseGradientIG=PETSC_FALSE;// debug flag
info = PetscOptionsGetTruth(PETSC_NULL,"-bnls_use_gradient_ig",
&UseGradientIG,PETSC_NULL); CHKERRQ(info);
if(UseGradientIG)
info = DX->CopyFrom(G);
else
{
info=PetscInfo(tao,"TaoSolve_BNLS: use bfgs init guess \n");
info = M->Solve(G, DX, &success);
}
CHKERRQ(info);
info = DXFree->SetReducedVec(DX,FreeVariables);CHKERRQ(info);
info = DXFree->Negate(); CHKERRQ(info);
info = Hsub->SetReducedMatrix(H,FreeVariables,FreeVariables);CHKERRQ(info);
bnls->gamma_factor /= 2;
success = TAO_FALSE;
while (success==TAO_FALSE) {
/* Approximately solve the reduced linear system */
info = TaoPreLinearSolve(tao,Hsub);CHKERRQ(info);
info = TaoLinearSolve(tao,Hsub,R,DXFree,&success);CHKERRQ(info);
info = DX->SetToZero(); CHKERRQ(info);
info = DX->ReducedXPY(DXFree,FreeVariables);CHKERRQ(info);
info = DX->Dot(G,&gdx); CHKERRQ(info);
if (gdx>=0 || success==TAO_FALSE) { /* use bfgs direction */
info = M->Solve(G, DX, &success); CHKERRQ(info);
info = DX->BoundGradientProjection(DX,XL,X,XU); CHKERRQ(info);
info = DX->Negate(); CHKERRQ(info);
// Check for success (descent direction)
info = DX->Dot(G,&gdx); CHKERRQ(info);
if (gdx >= 0) {
// Step is not descent or solve was not successful
// Use steepest descent direction (scaled)
if (f != 0.0) {
info = M->SetDelta(2.0 * TaoAbsDouble(f) / (gnorm*gnorm)); CHKERRQ(info);
}
else {
info = M->SetDelta(2.0 / (gnorm*gnorm)); CHKERRQ(info);
}
info = M->Reset(); CHKERRQ(info);
info = M->Update(X, G); CHKERRQ(info);
info = DX->CopyFrom(G);
info = DX->Negate(); CHKERRQ(info);
info = DX->Dot(G,&gdx); CHKERRQ(info);
info=PetscInfo1(tao,"LMVM Solve Fail use steepest descent, gdx %22.12e \n",gdx);
}
else {
info=PetscInfo1(tao,"Newton Solve Fail use BFGS direction, gdx %22.12e \n",gdx);
}
success = TAO_TRUE;
// bnls->gamma_factor *= 2;
// bnls->gamma = bnls->gamma_factor*(gnorm);
//#if !defined(PETSC_USE_COMPLEX)
// info=PetscInfo2(tao,"TaoSolve_NLS: modify diagonal (assume same nonzero structure), gamma_factor=%g, gamma=%g\n",bnls->gamma_factor,bnls->gamma);
// CHKERRQ(info);
//#else
// info=PetscInfo3(tao,"TaoSolve_NLS: modify diagonal (asuume same nonzero structure), gamma_factor=%g, gamma=%g, gdx %22.12e \n",
// bnls->gamma_factor,PetscReal(bnls->gamma),gdx);CHKERRQ(info);
//#endif
// info = Hsub->ShiftDiagonal(bnls->gamma);CHKERRQ(info);
// if (f != 0.0) {
// info = M->SetDelta(2.0 * TaoAbsDouble(f) / (gnorm*gnorm)); CHKERRQ(info);
// }
// else {
// info = M->SetDelta(2.0 / (gnorm*gnorm)); CHKERRQ(info);
// }
// info = M->Reset(); CHKERRQ(info);
// info = M->Update(X, G); CHKERRQ(info);
// success = TAO_FALSE;
} else {
info=PetscInfo1(tao,"Newton Solve is descent direction, gdx %22.12e \n",gdx);
success = TAO_TRUE;
}
}
stepsize=1.0;
info = TaoLineSearchApply(tao,X,G,DX,Work,
&f,&f_full,&stepsize,&lsflag);
CHKERRQ(info);
} /* END MAIN LOOP */
TaoFunctionReturn(0);
}
void bsscr_summary(KSP_BSSCR * bsscrp_self, KSP ksp_S, KSP ksp_inner,
Mat K,Mat K2,Mat D,Mat G,Mat C,Vec u,Vec p,Vec f,Vec h,Vec t,
double penaltyNumber,PetscTruth KisJustK,double mgSetupTime,double scrSolveTime,double a11SingleSolveTime){
PetscTruth flg, found;
PetscInt uSize, pSize, lmax, lmin, iterations;
PetscReal rNorm, fNorm, uNorm, uNormInf, pNorm, pNormInf, p_sum, min, max;
Vec q, qq, t2, t3;
double solutionAnalysisTime;
PetscPrintf( PETSC_COMM_WORLD, "\n\nSCR Solver Summary:\n\n");
if(bsscrp_self->mg)
PetscPrintf( PETSC_COMM_WORLD, " Multigrid setup: = %.4g secs \n", mgSetupTime);
KSPGetIterationNumber( ksp_S, &iterations);
bsscrp_self->solver->stats.pressure_its = iterations;
PetscPrintf( PETSC_COMM_WORLD, " Pressure Solve: = %.4g secs / %d its\n", scrSolveTime, iterations);
KSPGetIterationNumber( ksp_inner, &iterations);
bsscrp_self->solver->stats.velocity_backsolve_its = iterations;
PetscPrintf( PETSC_COMM_WORLD, " Final V Solve: = %.4g secs / %d its\n\n", a11SingleSolveTime, iterations);
/***************************************************************************************************************/
flg = PETSC_FALSE; /* Off by default */
PetscOptionsGetTruth( PETSC_NULL, "-scr_ksp_solution_summary", &flg, &found );
if(flg) {
PetscScalar KuNorm;
solutionAnalysisTime = MPI_Wtime();
VecGetSize( u, &uSize );
VecGetSize( p, &pSize );
VecDuplicate( u, &t2 );
VecDuplicate( u, &t3 );
MatMult( K, u, t3); VecNorm( t3, NORM_2, &KuNorm );
double angle, kdot;
if(penaltyNumber > 1e-10){/* should change this to ifK2built maybe */
MatMult( K2, u, t2); VecNorm( t2, NORM_2, &rNorm );
VecDot(t2,t3,&kdot);
angle = (kdot/(rNorm*KuNorm));
PetscPrintf( PETSC_COMM_WORLD, " <K u, K2 u>/(|K u| |K2 u|) = %.6e\n", angle);
}
VecNorm( t, NORM_2, &rNorm ); /* t = f- G p should be the formal residual vector, calculated on line 267 in auglag-driver-DGTGD.c */
VecDot(t3,t,&kdot);
angle = (kdot/(rNorm*KuNorm));
PetscPrintf( PETSC_COMM_WORLD, " <K u, (f-G p)>/(|K u| |f- G p|) = %.6e\n\n", angle);
MatMult( K, u, t2); VecNorm(t2, NORM_2, &KuNorm);
VecAYPX( t2, -1.0, t ); /* t2 <- -t2 + t : t = f- G p should be the formal residual vector, calculated on line 267 in auglag-driver-DGTGD.c*/
VecNorm( t2, NORM_2, &rNorm );
VecNorm( f, NORM_2, &fNorm );
if(KisJustK){
PetscPrintf( PETSC_COMM_WORLD,"Velocity back-solve with original K matrix\n");
PetscPrintf( PETSC_COMM_WORLD,"Solved K u = G p -f\n");
PetscPrintf( PETSC_COMM_WORLD,"Residual with original K matrix\n");
PetscPrintf( PETSC_COMM_WORLD, " |f - K u - G p| = %.12e\n", rNorm);
PetscPrintf( PETSC_COMM_WORLD, " |f - K u - G p|/|f| = %.12e\n", rNorm/fNorm);
if(penaltyNumber > 1e-10){/* means the restore_K flag was used */
//if(K2 && f2){
MatAXPY(K,penaltyNumber,K2,DIFFERENT_NONZERO_PATTERN);/* Computes K = penaltyNumber*K2 + K */
//VecAXPY(f,penaltyNumber,f2); /* f = penaltyNumber*f2 + f */
KisJustK=PETSC_FALSE;
MatMult( K, u, t2);
MatMult( G, p, t);
VecAYPX( t, -1.0, f ); /* t <- -t + f */
VecAYPX( t2, -1.0, t ); /* t2 <- -t2 + t */
VecNorm( t2, NORM_2, &rNorm );
PetscPrintf( PETSC_COMM_WORLD,"Residual with K+K2 matrix and f rhs vector\n");
PetscPrintf( PETSC_COMM_WORLD, " |(f) - (K + K2) u - G p| = %.12e\n", rNorm);
//}
}
}
else{
PetscPrintf( PETSC_COMM_WORLD,"Velocity back-solve with K+K2 matrix\n");
PetscPrintf( PETSC_COMM_WORLD,"Solved (K + K2) u = G p - (f)\n");
PetscPrintf( PETSC_COMM_WORLD,"Residual with K+K2 matrix and f rhs vector\n");
PetscPrintf( PETSC_COMM_WORLD, " |(f) - (K + K2) u - G p| = %.12e\n", rNorm);
PetscReal KK2Norm,KK2Normf;
MatNorm(K,NORM_1,&KK2Norm);
MatNorm(K,NORM_FROBENIUS,&KK2Normf);
penaltyNumber = -penaltyNumber;
MatAXPY(K,penaltyNumber,K2,DIFFERENT_NONZERO_PATTERN);/* Computes K = penaltyNumber*K2 + K */
//VecAXPY(f,penaltyNumber,f2); /* f = penaltyNumber*f2 + f */
KisJustK=PETSC_FALSE;
MatMult( K, u, t2); /* t2 = K*u */
MatMult( G, p, t); /* t = G*p */
VecAYPX( t, -1.0, f ); /* t <- f - t ; t = f - G*p */
VecAYPX( t2, -1.0, t ); /* t2 <- t - t2; t2 = f - G*p - K*u */
VecNorm( t2, NORM_2, &rNorm );
PetscPrintf( PETSC_COMM_WORLD,"Residual with original K matrix\n");
PetscPrintf( PETSC_COMM_WORLD, " |f - K u - G p| = %.12e\n", rNorm);
PetscPrintf( PETSC_COMM_WORLD, " |f - K u - G p|/|f| = %.12e\n", rNorm/fNorm);
PetscReal KNorm, K2Norm;
MatNorm(K,NORM_1,&KNorm); MatNorm(K2,NORM_1,&K2Norm);
PetscPrintf( PETSC_COMM_WORLD,"K and K2 norm_1 %.12e %.12e ratio %.12e\n",KNorm,K2Norm,K2Norm/KNorm);
MatNorm(K,NORM_INFINITY,&KNorm); MatNorm(K2,NORM_INFINITY,&K2Norm);
PetscPrintf( PETSC_COMM_WORLD,"K and K2 norm_inf %.12e %.12e ratio %.12e\n",KNorm,K2Norm,K2Norm/KNorm);
MatNorm(K,NORM_FROBENIUS,&KNorm); MatNorm(K2,NORM_FROBENIUS,&K2Norm);
PetscPrintf( PETSC_COMM_WORLD,"K and K2 norm_frob %.12e %.12e ratio %.12e\n",KNorm,K2Norm,K2Norm/KNorm);
PetscPrintf( PETSC_COMM_WORLD,"K+r*K2 norm_1 %.12e\n",KK2Norm);
PetscPrintf( PETSC_COMM_WORLD,"K+r*K2 norm_frob %.12e\n",KK2Normf);
penaltyNumber = -penaltyNumber;
MatAXPY(K,penaltyNumber,K2,DIFFERENT_NONZERO_PATTERN);/* Computes K = penaltyNumber*K2 + K */
}
PetscPrintf( PETSC_COMM_WORLD,"\n");
PetscPrintf( PETSC_COMM_WORLD, " |K u| = %.12e\n", KuNorm);
if(penaltyNumber > 1e-10){
MatMult( K2, u, t2); VecNorm( t2, NORM_2, &rNorm );
PetscPrintf( PETSC_COMM_WORLD, " |K2 u| = %.12e\n", rNorm);
PetscPrintf( PETSC_COMM_WORLD,"\n");
}
VecDuplicate( p, &q );
MatMult( D, u, q ); /* q = G'*u = D*u */
VecNorm( u, NORM_2, &uNorm );
VecNorm( q, NORM_2, &rNorm );
PetscPrintf( PETSC_COMM_WORLD, " |G^T u|_2 = %.6e\n", rNorm );
PetscPrintf( PETSC_COMM_WORLD, " |G^T u|_2/|u|_2 = %.6e\n", sqrt( (double) uSize / (double) pSize ) * rNorm / uNorm);
VecDuplicate( p, &qq );
MatMultTranspose( G, u, qq );
VecNorm( qq, NORM_2, &rNorm );
PetscPrintf( PETSC_COMM_WORLD, " |G^T u|/|u| = %.8e\n", rNorm/uNorm ); /* to compare directly with Uzawa */
VecNorm( q, NORM_INFINITY, &rNorm );
PetscPrintf( PETSC_COMM_WORLD, " |G^T u|_infty/|u|_2 = %.6e\n", sqrt( (double) uSize ) * rNorm / uNorm);
/* create G'*u+C*p-h to check on this constraint */
/* already have q = D*u */
VecZeroEntries(qq);
if(C){
MatMult( C, p, qq );
}
VecAYPX( q, 1.0, qq ); /* q = q+qq; G'*u + C*p*/
VecAXPY( q, -1.0, h ); /* q = q-h; G'*u + C*p - h */
VecNorm( q, NORM_2, &rNorm );
PetscPrintf( PETSC_COMM_WORLD, " |G^T u + C p - h| = %.8e :constraint\n", rNorm );
VecNorm( u, NORM_INFINITY, &uNormInf );
VecNorm( u, NORM_2, &uNorm );
VecGetSize( u, &uSize );
VecNorm( p, NORM_INFINITY, &pNormInf );
VecNorm( p, NORM_2, &pNorm );
PetscPrintf( PETSC_COMM_WORLD, " |u|_{\\infty} = %.6e , u_rms = %.6e\n",
uNormInf, uNorm / sqrt( (double) uSize ) );
PetscPrintf( PETSC_COMM_WORLD, " |p|_{\\infty} = %.6e , p_rms = %.6e\n",
pNormInf, pNorm / sqrt( (double) pSize ) );
VecMax( u, &lmax, &max );
VecMin( u, &lmin, &min );
PetscPrintf( PETSC_COMM_WORLD, " min/max(u) = %.6e [%d] / %.6e [%d]\n",min,lmin,max,lmax);
bsscrp_self->solver->stats.vmin = min;
bsscrp_self->solver->stats.vmax = max;
VecMax( p, &lmax, &max );
VecMin( p, &lmin, &min );
PetscPrintf( PETSC_COMM_WORLD, " min/max(p) = %.6e [%d] / %.6e [%d]\n",min,lmin,max,lmax);
bsscrp_self->solver->stats.pmin = min;
bsscrp_self->solver->stats.pmax = max;
VecSum( p, &p_sum );
PetscPrintf( PETSC_COMM_WORLD, " \\sum_i p_i = %.6e \n", p_sum );
bsscrp_self->solver->stats.p_sum=p_sum;
solutionAnalysisTime = MPI_Wtime() - solutionAnalysisTime;
PetscPrintf( PETSC_COMM_WORLD, "\n Time for this analysis = %.4g secs\n\n",solutionAnalysisTime);
Stg_VecDestroy(&t2 );
Stg_VecDestroy(&t3 );
Stg_VecDestroy(&q );
Stg_VecDestroy(&qq );
}
}
