static PetscErrorCode TSInterpolate_Sundials(TS ts,PetscReal t,Vec X)
{
TS_Sundials *cvode = (TS_Sundials*)ts->data;
N_Vector y;
PetscErrorCode ierr;
PetscScalar *x_data;
PetscInt glosize,locsize;
PetscFunctionBegin;
/* get the vector size */
ierr = VecGetSize(X,&glosize);CHKERRQ(ierr);
ierr = VecGetLocalSize(X,&locsize);CHKERRQ(ierr);
/* allocate the memory for N_Vec y */
y = N_VNew_Parallel(cvode->comm_sundials,locsize,glosize);
if (!y) SETERRQ(PETSC_COMM_SELF,1,"Interpolated y is not allocated");
ierr = VecGetArray(X,&x_data);CHKERRQ(ierr);
N_VSetArrayPointer((realtype*)x_data,y);
ierr = CVodeGetDky(cvode->mem,t,0,y);CHKERRQ(ierr);
ierr = VecRestoreArray(X,&x_data);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode SNESMonitorRange_Private(SNES snes,PetscInt it,PetscReal *per)
{
PetscErrorCode ierr;
Vec resid;
PetscReal rmax,pwork;
PetscInt i,n,N;
PetscScalar *r;
PetscFunctionBegin;
ierr = SNESGetFunction(snes,&resid,0,0);CHKERRQ(ierr);
ierr = VecNorm(resid,NORM_INFINITY,&rmax);CHKERRQ(ierr);
ierr = VecGetLocalSize(resid,&n);CHKERRQ(ierr);
ierr = VecGetSize(resid,&N);CHKERRQ(ierr);
ierr = VecGetArray(resid,&r);CHKERRQ(ierr);
pwork = 0.0;
for (i=0; i<n; i++) {
pwork += (PetscAbsScalar(r[i]) > .20*rmax);
}
ierr = MPI_Allreduce(&pwork,per,1,MPIU_REAL,MPIU_SUM,PetscObjectComm((PetscObject)snes));CHKERRQ(ierr);
ierr = VecRestoreArray(resid,&r);CHKERRQ(ierr);
*per = *per/N;
PetscFunctionReturn(0);
}
void ReplicatableVector::ReplicatePetscVector(Vec vec)
{
// If the size has changed then we'll need to make a new context
PetscInt isize;
VecGetSize(vec, &isize);
unsigned size = isize;
if (this->GetSize() != size)
{
Resize(size);
}
if (mReplicated == NULL)
{
// This creates mToAll (the scatter context) and mReplicated (to store values)
VecScatterCreateToAll(vec, &mToAll, &mReplicated);
}
// Replicate the data
//PETSc-3.x.x or PETSc-2.3.3
#if ( (PETSC_VERSION_MAJOR == 3) || (PETSC_VERSION_MAJOR == 2 && PETSC_VERSION_MINOR == 3 && PETSC_VERSION_SUBMINOR == 3)) //2.3.3 or 3.x.x
VecScatterBegin(mToAll, vec, mReplicated, INSERT_VALUES, SCATTER_FORWARD);
VecScatterEnd (mToAll, vec, mReplicated, INSERT_VALUES, SCATTER_FORWARD);
#else
//PETSc-2.3.2 or previous
VecScatterBegin(vec, mReplicated, INSERT_VALUES, SCATTER_FORWARD, mToAll);
VecScatterEnd (vec, mReplicated, INSERT_VALUES, SCATTER_FORWARD, mToAll);
#endif
// Information is now in mReplicated PETSc vector
// Copy into mData
double* p_replicated;
VecGetArray(mReplicated, &p_replicated);
for (unsigned i=0; i<size; i++)
{
mpData[i] = p_replicated[i];
}
}
LData::LData(const std::string& name,
Vec vec,
const std::vector<int>& nonlocal_petsc_indices,
const bool manage_petsc_vec)
: d_name(name), d_global_node_count(0), d_local_node_count(0), d_ghost_node_count(0), d_depth(0),
d_nonlocal_petsc_indices(nonlocal_petsc_indices), d_global_vec(vec), d_managing_petsc_vec(manage_petsc_vec),
d_array(NULL), d_boost_array(NULL), d_boost_local_array(NULL), d_boost_vec_array(NULL),
d_boost_local_vec_array(NULL), d_ghosted_local_vec(NULL), d_ghosted_local_array(NULL),
d_boost_ghosted_local_array(NULL), d_boost_vec_ghosted_local_array(NULL)
{
int ierr;
int depth;
ierr = VecGetBlockSize(d_global_vec, &depth);
IBTK_CHKERRQ(ierr);
#if !defined(NDEBUG)
TBOX_ASSERT(depth >= 0);
#endif
d_depth = depth;
int global_node_count;
ierr = VecGetSize(d_global_vec, &global_node_count);
IBTK_CHKERRQ(ierr);
#if !defined(NDEBUG)
TBOX_ASSERT(global_node_count >= 0);
#endif
d_global_node_count = global_node_count;
d_global_node_count /= d_depth;
int local_node_count;
ierr = VecGetLocalSize(d_global_vec, &local_node_count);
IBTK_CHKERRQ(ierr);
#if !defined(NDEBUG)
TBOX_ASSERT(local_node_count >= 0);
#endif
d_local_node_count = local_node_count;
d_local_node_count /= d_depth;
d_ghost_node_count = static_cast<int>(d_nonlocal_petsc_indices.size());
return;
} // LData
PetscErrorCode loadVector(char * type_v,Vec * b){
char file[PETSC_MAX_PATH_LEN];
char err[PETSC_MAX_PATH_LEN];
PetscErrorCode ierr;
PetscBool flag;
PetscViewer fd;
PetscInt size;
// check if there is a vec file, vector is not mandatory
ierr=PetscOptionsGetString(PETSC_NULL,type_v,file,PETSC_MAX_PATH_LEN-1,&flag);CHKERRQ(ierr);
if (!flag) {
PetscPrintf(PETSC_COMM_WORLD,"Error : %s is not properly set\n",type_v);
*b = NULL;
}else{
PetscPrintf(PETSC_COMM_WORLD,"Loading Vector : %s\n",file);
ierr=PetscViewerBinaryOpen(PETSC_COMM_WORLD,file,FILE_MODE_READ,&fd);CHKERRQ(ierr);
ierr=VecLoad(*b,fd);CHKERRQ(ierr);
ierr=PetscViewerDestroy(&fd);CHKERRQ(ierr);
ierr=VecGetSize(*b,&size);CHKERRQ(ierr);
PetscPrintf(PETSC_COMM_WORLD,"Loaded Vector of size : %d\n",size);
}
return 0;
}
PetscErrorCode FormFunction(SNES snes,Vec x,Vec f,void *ctx)
{
Vec g = (Vec)ctx;
const PetscScalar *xx,*gg;
PetscScalar *ff,d;
PetscErrorCode ierr;
PetscInt i,n;
/*
Get pointers to vector data.
- For default PETSc vectors, VecGetArray() returns a pointer to
the data array. Otherwise, the routine is implementation dependent.
- You MUST call VecRestoreArray() when you no longer need access to
the array.
*/
ierr = VecGetArrayRead(x,&xx);CHKERRQ(ierr);
ierr = VecGetArray(f,&ff);CHKERRQ(ierr);
ierr = VecGetArrayRead(g,&gg);CHKERRQ(ierr);
/*
Compute function
*/
ierr = VecGetSize(x,&n);CHKERRQ(ierr);
d = (PetscReal)(n - 1); d = d*d;
ff[0] = xx[0];
for (i=1; i<n-1; i++) ff[i] = d*(xx[i-1] - 2.0*xx[i] + xx[i+1]) + xx[i]*xx[i] - gg[i];
ff[n-1] = xx[n-1] - 1.0;
/*
Restore vectors
*/
ierr = VecRestoreArrayRead(x,&xx);CHKERRQ(ierr);
ierr = VecRestoreArray(f,&ff);CHKERRQ(ierr);
ierr = VecRestoreArrayRead(g,&gg);CHKERRQ(ierr);
return 0;
}
PetscErrorCode gauss_seidel(PC pc,Vec bb,Vec xx,Vec w,PetscReal rtol,PetscReal abstol,PetscReal dtol,PetscInt m,PetscBool guesszero,PetscInt *its,PCRichardsonConvergedReason *reason)
{
PetscInt i,n1;
PetscErrorCode ierr;
PetscScalar *x;
const PetscScalar *b;
PetscFunctionBegin;
*its = m;
*reason = PCRICHARDSON_CONVERGED_ITS;
ierr = VecGetSize(bb,&n1);CHKERRQ(ierr); n1--;
ierr = VecGetArrayRead(bb,&b);CHKERRQ(ierr);
ierr = VecGetArray(xx,&x);CHKERRQ(ierr);
while (m--) {
x[0] = .5*(x[1] + b[0]);
for (i=1; i<n1; i++) x[i] = .5*(x[i+1] + x[i-1] + b[i]);
x[n1] = .5*(x[n1-1] + b[n1]);
for (i=n1-1; i>0; i--) x[i] = .5*(x[i+1] + x[i-1] + b[i]);
x[0] = .5*(x[1] + b[0]);
}
ierr = VecRestoreArrayRead(bb,&b);CHKERRQ(ierr);
ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*@C
TaoDefaultComputeGradient - computes the gradient using finite differences.
Collective on Tao
Input Parameters:
+ tao - the Tao context
. X - compute gradient at this point
- dummy - not used
Output Parameters:
. G - Gradient Vector
Options Database Key:
+ -tao_fd_gradient - Activates TaoDefaultComputeGradient()
- -tao_fd_delta <delta> - change in x used to calculate finite differences
Level: advanced
Note:
This routine is slow and expensive, and is not currently optimized
to take advantage of sparsity in the problem. Although
TaoAppDefaultComputeGradient is not recommended for general use
in large-scale applications, It can be useful in checking the
correctness of a user-provided gradient. Use the tao method TAOTEST
to get an indication of whether your gradient is correct.
Note:
This finite difference gradient evaluation can be set using the routine TaoSetGradientRoutine() or by using the command line option -tao_fd_gradient
.seealso: TaoSetGradientRoutine()
@*/
PetscErrorCode TaoDefaultComputeGradient(Tao tao,Vec X,Vec G,void *dummy)
{
PetscScalar *x,*g;
PetscReal f, f2;
PetscErrorCode ierr;
PetscInt low,high,N,i;
PetscBool flg;
PetscReal h=PETSC_SQRT_MACHINE_EPSILON;
PetscFunctionBegin;
ierr = TaoComputeObjective(tao, X,&f);CHKERRQ(ierr);
ierr = PetscOptionsGetReal(NULL,"-tao_fd_delta",&h,&flg);CHKERRQ(ierr);
ierr = VecGetSize(X,&N);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(X,&low,&high);CHKERRQ(ierr);
ierr = VecGetArray(G,&g);CHKERRQ(ierr);
for (i=0;i<N;i++) {
if (i>=low && i<high) {
ierr = VecGetArray(X,&x);CHKERRQ(ierr);
x[i-low] += h;
ierr = VecRestoreArray(X,&x);CHKERRQ(ierr);
}
ierr = TaoComputeObjective(tao,X,&f2);CHKERRQ(ierr);
if (i>=low && i<high) {
ierr = VecGetArray(X,&x);CHKERRQ(ierr);
x[i-low] -= h;
ierr = VecRestoreArray(X,&x);CHKERRQ(ierr);
}
if (i>=low && i<high) {
g[i-low]=(f2-f)/h;
}
}
ierr = VecRestoreArray(G,&g);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode FormFunction(SNES snes,Vec x,Vec f,void *dummy)
{
const PetscScalar *xx;
PetscScalar *ff,*FF,d,d2;
PetscErrorCode ierr;
PetscInt i,n;
ierr = VecGetArrayRead(x,&xx);CHKERRQ(ierr);
ierr = VecGetArray(f,&ff);CHKERRQ(ierr);
ierr = VecGetArray((Vec)dummy,&FF);CHKERRQ(ierr);
ierr = VecGetSize(x,&n);CHKERRQ(ierr);
d = (PetscReal)(n - 1); d2 = d*d;
if (second_order) ff[0] = d*(0.5*d*(-xx[2] + 4.*xx[1] - 3.*xx[0]) - X0DOT);
else ff[0] = d*(d*(xx[1] - xx[0]) - X0DOT);
for (i=1; i<n-1; i++) ff[i] = d2*(xx[i-1] - 2.*xx[i] + xx[i+1]) + xx[i]*xx[i] - FF[i];
ff[n-1] = d*d*(xx[n-1] - X1);
ierr = VecRestoreArrayRead(x,&xx);CHKERRQ(ierr);
ierr = VecRestoreArray(f,&ff);CHKERRQ(ierr);
ierr = VecRestoreArray((Vec)dummy,&FF);CHKERRQ(ierr);
return 0;
}
PetscErrorCode AddMuAbsorption(double *muinv, Vec muinvpml, double Qabs, int add)
{
//compute muinvpml/(1+i/Qabs)
double Qinv = (add==0) ? 0.0: (1.0/Qabs);
double d=1 + pow(Qinv,2);
PetscErrorCode ierr;
int N;
ierr=VecGetSize(muinvpml,&N);CHKERRQ(ierr);
double *ptmuinvpml;
ierr=VecGetArray(muinvpml, &ptmuinvpml);CHKERRQ(ierr);
int i;
double a,b;
for(i=0;i<N/2;i++)
{
a=ptmuinvpml[i];
b=ptmuinvpml[i+N/2];
muinv[i]= (a+b*Qinv)/d;
muinv[i+N/2]=(b-a*Qinv)/d;
}
ierr=VecRestoreArray(muinvpml,&ptmuinvpml);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscInt main(PetscInt argc,char **args)
{
PetscErrorCode ierr;
PetscMPIInt rank,size;
PetscInt N0=3,N1=3,N2=3,N=N0*N1*N2;
PetscRandom rdm;
PetscScalar a;
PetscReal enorm;
Vec x,y,z,input,output;
PetscBool view=PETSC_FALSE,use_interface=PETSC_TRUE;
Mat A;
PetscInt DIM, dim[3],vsize;
PetscReal fac;
ierr = PetscInitialize(&argc,&args,(char *)0,help);CHKERRQ(ierr);
#if defined(PETSC_USE_COMPLEX)
SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP, "This example requires real numbers");
#endif
ierr = MPI_Comm_size(PETSC_COMM_WORLD, &size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD, &rank);CHKERRQ(ierr);
ierr = PetscRandomCreate(PETSC_COMM_WORLD, &rdm);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rdm);CHKERRQ(ierr);
ierr = VecCreate(PETSC_COMM_WORLD,&input);CHKERRQ(ierr);
ierr = VecSetSizes(input,PETSC_DECIDE,N);CHKERRQ(ierr);
ierr = VecSetFromOptions(input);CHKERRQ(ierr);
ierr = VecSetRandom(input,rdm);CHKERRQ(ierr);
ierr = VecDuplicate(input,&output);
// ierr = VecGetSize(input,&vsize);CHKERRQ(ierr);
// printf("Size of the input Vector is %d\n",vsize);
DIM = 3;
dim[0] = N0; dim[1] = N1; dim[2] = N2;
ierr = MatCreateFFT(PETSC_COMM_WORLD,DIM,dim,MATFFTW,&A);CHKERRQ(ierr);
ierr = MatGetVecs(A,&x,&y);CHKERRQ(ierr);
ierr = MatGetVecs(A,&z,PETSC_NULL);CHKERRQ(ierr);
ierr = VecGetSize(y,&vsize);CHKERRQ(ierr);
printf("The vector size from the main routine is %d\n",vsize);
ierr = InputTransformFFT(A,input,x);CHKERRQ(ierr);
ierr = MatMult(A,x,y);CHKERRQ(ierr);
ierr = MatMultTranspose(A,y,z);CHKERRQ(ierr);
ierr = OutputTransformFFT(A,z,output);CHKERRQ(ierr);
fac = 1.0/(PetscReal)N;
ierr = VecScale(output,fac);CHKERRQ(ierr);
ierr = VecAssemblyBegin(input);CHKERRQ(ierr);
ierr = VecAssemblyEnd(input);CHKERRQ(ierr);
ierr = VecAssemblyBegin(output);CHKERRQ(ierr);
ierr = VecAssemblyEnd(output);CHKERRQ(ierr);
ierr = VecView(input,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = VecView(output,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = VecAXPY(output,-1.0,input);CHKERRQ(ierr);
ierr = VecNorm(output,NORM_1,&enorm);CHKERRQ(ierr);
// if (enorm > 1.e-14){
if (!rank)
ierr = PetscPrintf(PETSC_COMM_SELF," Error norm of |x - z| %e\n",enorm);CHKERRQ(ierr);
// }
// ierr = MatGetVecs(A,&z,PETSC_NULL);CHKERRQ(ierr);
// printf("Vector size from ex148 %d\n",vsize);
// ierr = PetscObjectSetName((PetscObject) x, "Real space vector");CHKERRQ(ierr);
// ierr = PetscObjectSetName((PetscObject) y, "Frequency space vector");CHKERRQ(ierr);
// ierr = PetscObjectSetName((PetscObject) z, "Reconstructed vector");CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
/*
Stokes output:
---------------------------------
Operator summary:
K
G
f,
h
u
p
---------------------------------
Solution summary:
max_u
min_u
average_u
|r_1|
|r_2|
---------------------------------
Solver summary:
name
---------------------------------
Petsc build summary:
*/
PetscErrorCode BSSCR_stokes_output( PetscViewer v, Mat stokes_A, Vec stokes_b, Vec stokes_x, KSP ksp, PetscInt monitor_index )
{
Mat K,G,D,C;
Vec f,h, u,p;
K = G = D = C = PETSC_NULL;
f = h = PETSC_NULL;
u = p = PETSC_NULL;
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 );
PetscViewerASCIIPrintf( v, "Stokes Output:\n");
PetscViewerASCIIPushTab( v );
/*--------------------------------------------------------------------------------------------*/
PetscViewerASCIIPrintf( v, "--------------------------------------------------\n");
PetscViewerASCIIPrintf( v, "Operator summary:\n");
PetscViewerASCIIPushTab( v );
if (K) {
BSSCR_MatInfoLog(v,K, "stokes_A11");
PetscViewerASCIIPrintf( v, "\n");
}
if (G) {
BSSCR_MatInfoLog(v,G, "stokes_A12");
PetscViewerASCIIPrintf( v, "\n");
}
if (D) {
BSSCR_MatInfoLog(v,D, "stokes_A21");
PetscViewerASCIIPrintf( v, "\n");
}
if (C) {
BSSCR_MatInfoLog(v,C, "stokes_A22");
PetscViewerASCIIPrintf( v, "\n");
}
if (f) {
BSSCR_VecInfoLog(v,f,"stokes_b1");
PetscViewerASCIIPrintf( v, "\n");
}
if (h) {
BSSCR_VecInfoLog(v,h,"stokes_b2");
PetscViewerASCIIPrintf( v, "\n");
}
PetscViewerASCIIPopTab( v );
/*--------------------------------------------------------------------------------------------*/
PetscViewerASCIIPrintf( v, "--------------------------------------------------\n");
PetscViewerASCIIPrintf( v, "Solution summary:\n");
PetscViewerASCIIPushTab( v );
if (u) {
BSSCR_VecInfoLog(v,u,"x1");
PetscViewerASCIIPrintf( v, "\n");
}
if (p) {
BSSCR_VecInfoLog(v,p,"x2");
PetscViewerASCIIPrintf( v, "\n");
}
{
PetscScalar s,sum;
PetscReal r,max,min;
PetscInt N, loc;
double r1,r2;
Vec K_d;
PetscInt loc_max, loc_min;
VecGetSize( u, &N );
VecMax( u, &loc, &r );
PetscViewerASCIIPrintf( v, "u_max: %1.12e [%d] \n", r, loc );
VecMin( u, &loc, &r );
PetscViewerASCIIPrintf( v, "u_min: %1.12e [%d] \n", r, loc );
VecDot( u,u, &s );
PetscViewerASCIIPrintf( v, "u_rms: %1.12e \n", sqrt( PetscRealPart(s) )/N );
VecDuplicate( u, &K_d );
MatGetDiagonal( K, K_d );
VecMax( K_d, &loc_max, &max );
VecMin( K_d, &loc_min, &min );
PetscViewerASCIIPrintf( v,"Algebraic contrast: max(K_d)=%.3e [%d] , min(K_d)=%.3e [%d] , max(K_d)/min(K_d) = %.8e \n", max,loc_max, min,loc_min, max/min );
MatGetRowMax( K, K_d, PETSC_NULL );
VecMax( K_d, &loc_max, &max );
MatGetRowMin( K, K_d, PETSC_NULL );
VecAbs( K_d );
VecMin( K_d, &loc_min, &min );
PetscViewerASCIIPrintf( v,"Algebraic contrast: max(K)=%.3e [%d] , |min(K)|=%.3e [%d] , max(K)/|min(K)| = %.8e \n", max,loc_max, min,loc_min, max/min );
Stg_VecDestroy(&K_d );
PetscViewerASCIIPrintf( v, "\n");
VecGetSize( p, &N );
VecMax( p, &loc, &r );
PetscViewerASCIIPrintf( v, "p_max: %1.12e [%d] \n", r, loc );
VecMin( p, &loc, &r );
PetscViewerASCIIPrintf( v, "p_min: %1.12e [%d] \n", r, loc );
VecDot( p,p, &s );
PetscViewerASCIIPrintf( v, "p_rms: %1.12e \n", sqrt( PetscRealPart(s) )/N );
VecSum( p, &sum );
PetscViewerASCIIPrintf( v, "sum(p): %1.12e \n", sum );
PetscViewerASCIIPrintf( v, "\n");
r1 = BSSCR_StokesMomentumResidual( K,G,f, u,p );
PetscViewerASCIIPrintf( v, "|r1| = %1.12e <momentum> \n", r1 );
r2 = BSSCR_StokesContinuityResidual( G,C,h, u,p );
PetscViewerASCIIPrintf( v, "|r2| = %1.12e <continuity> \n", r2 );
PetscViewerASCIIPrintf( v, "\n");
}
PetscViewerASCIIPopTab( v );
/*--------------------------------------------------------------------------------------------*/
if (ksp) {
PetscViewerASCIIPrintf( v, "--------------------------------------------------\n");
PetscViewerASCIIPrintf( v, "Solver summary:\n");
PetscViewerASCIIPushTab( v );
BSSCR_KSPLogSolve( v, monitor_index, ksp );
BSSCR_BSSCR_KSPLogSolveSummary( v, monitor_index, ksp );
PetscViewerASCIIPrintf( v, "\n");
PetscViewerASCIIPopTab( v );
}
/*--------------------------------------------------------------------------------------------*/
PetscViewerASCIIPrintf( v, "--------------------------------------------------\n");
PetscViewerASCIIPrintf( v, "Petsc build summary:\n");
PetscViewerASCIIPushTab( v );
BSSCR_GeneratePetscHeader_for_viewer( v );
PetscViewerASCIIPrintf( v, "\n");
PetscViewerASCIIPopTab( v );
/*--------------------------------------------------------------------------------------------*/
PetscViewerASCIIPopTab(v);
PetscFunctionReturn(0);
}
int main(int argc, char **argv)
{
MPI_Comm comm;
PetscMPIInt rank;
PetscErrorCode ierr;
User user;
PetscLogDouble v1, v2;
PetscInt nplot = 0;
char filename1[2048], fileName[2048];
PetscBool set = PETSC_FALSE;
PetscInt steps_output;
ierr = PetscInitialize(&argc, &argv, (char*) 0, help);CHKERRQ(ierr);
comm = PETSC_COMM_WORLD;
ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
ierr = PetscNew(&user);CHKERRQ(ierr);
ierr = PetscNew(&user->algebra);CHKERRQ(ierr);
ierr = PetscNew(&user->model);CHKERRQ(ierr);
ierr = PetscNew(&user->model->physics);CHKERRQ(ierr);
Algebra algebra = user->algebra;
ierr = LoadOptions(comm, user);CHKERRQ(ierr);
ierr = PetscTime(&v1);CHKERRQ(ierr);
ierr = CreateMesh(comm, user);CHKERRQ(ierr);
ierr = PetscTime(&v2);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,
"Read and Distribute mesh takes %f sec \n", v2 - v1);CHKERRQ(ierr);
ierr = SetUpLocalSpace(user);CHKERRQ(ierr); //Set up the dofs of each element
ierr = ConstructGeometryFVM(&user->facegeom, &user->cellgeom, user);CHKERRQ(ierr);
ierr = LimiterSetup(user);CHKERRQ(ierr);
if(user->output_solution){
// the output file options
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,0,"Options for output solution",0);CHKERRQ(ierr);
ierr = PetscOptionsString("-solutionfile", "solution file", "AeroSim.c", filename1,filename1, 2048, &set);CHKERRQ(ierr);
if(!set){SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_NULL,"please use option -solutionfile to specify solution file name \n");}
ierr = PetscOptionsInt("-steps_output", "the number of time steps between two outputs", "", steps_output, &steps_output, &set);CHKERRQ(ierr);
if(!set){ steps_output = 1;}
ierr = PetscOptionsEnd();CHKERRQ(ierr);
}
if (user->TimeIntegralMethod == EXPLICITMETHOD) {
if(user->myownexplicitmethod){
ierr = PetscPrintf(PETSC_COMM_WORLD,"Using the fully explicit method based on my own routing\n");CHKERRQ(ierr);
user->current_time = user->initial_time;
user->current_step = 1;
ierr = DMCreateGlobalVector(user->dm, &algebra->solution);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) algebra->solution, "solution");CHKERRQ(ierr);
ierr = SetInitialCondition(user->dm, algebra->solution, user);CHKERRQ(ierr);
ierr = VecDuplicate(algebra->solution, &algebra->fn);CHKERRQ(ierr);
ierr = VecDuplicate(algebra->solution, &algebra->oldsolution);CHKERRQ(ierr);
if(user->Explicit_RK2){
ierr = PetscPrintf(PETSC_COMM_WORLD,"Use the second order Runge Kutta method \n");CHKERRQ(ierr);
}else{
ierr = PetscPrintf(PETSC_COMM_WORLD,"Use the first order forward Euler method \n");CHKERRQ(ierr);
}
nplot = 0; //the plot step
while(user->current_time < (user->final_time - 0.05 * user->dt)){
user->current_time = user->current_time + user->dt;
ierr = FormTimeStepFunction(user, algebra, algebra->solution, algebra->fn);CHKERRQ(ierr);
PetscReal fnnorm;
ierr = VecNorm(algebra->fn,NORM_INFINITY,&fnnorm);CHKERRQ(ierr);
if(0){
PetscViewer viewer;
ierr = OutputVTK(user->dm, "function.vtk", &viewer);CHKERRQ(ierr);
ierr = VecView(algebra->fn, viewer);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Step %D at time %g with founction norm = %g \n",
user->current_step, user->current_time, fnnorm);CHKERRQ(ierr);
//break;
}
if(user->Explicit_RK2){
ierr = VecCopy(algebra->solution, algebra->oldsolution);CHKERRQ(ierr);//U^n
ierr = VecAXPY(algebra->solution, user->dt, algebra->fn);CHKERRQ(ierr);//U^{(1)}
ierr = FormTimeStepFunction(user, algebra, algebra->solution, algebra->fn);CHKERRQ(ierr);//f(U^{(1)})
ierr = VecAXPY(algebra->solution, 1.0, algebra->oldsolution);CHKERRQ(ierr);//U^n + U^{(1)}
ierr = VecAXPY(algebra->solution, user->dt, algebra->fn);CHKERRQ(ierr);// + dt*f(U^{(1)})
ierr = VecScale(algebra->solution, 0.5);CHKERRQ(ierr);
}else{
ierr = VecCopy(algebra->solution, algebra->oldsolution);CHKERRQ(ierr);
ierr = VecAXPY(algebra->solution, user->dt, algebra->fn);CHKERRQ(ierr);
}
{// Monitor the solution and function norms
PetscReal norm;
PetscLogDouble space =0;
PetscInt size;
ierr = VecNorm(algebra->solution,NORM_INFINITY,&norm);CHKERRQ(ierr);
ierr = VecGetSize(algebra->solution, &size);CHKERRQ(ierr);
norm = norm/size;
if (norm>1.e5) {
SETERRQ2(PETSC_COMM_WORLD, PETSC_ERR_LIB,
"The norm of the solution is: %f (current time: %f). The explicit method is going to DIVERGE!!!", norm, user->current_time);
}
if (user->current_step%10==0) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"Step %D at time %g with solution norm = %g and founction norm = %g \n",
user->current_step, user->current_time, norm, fnnorm);CHKERRQ(ierr);
}
ierr = PetscMallocGetCurrentUsage(&space);CHKERRQ(ierr);
// if (user->current_step%10==0) {
// ierr = PetscPrintf(PETSC_COMM_WORLD,"Current space PetscMalloc()ed %g M\n",
// space/(1024*1024));CHKERRQ(ierr);
// }
}
{ // Monitor the difference of two steps' solution
PetscReal norm;
ierr = VecAXPY(algebra->oldsolution, -1, algebra->solution);CHKERRQ(ierr);
ierr = VecNorm(algebra->oldsolution,NORM_INFINITY,&norm);CHKERRQ(ierr);
if (user->current_step%10==0) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"Step %D at time %g with ||u_k-u_{k-1}|| = %g \n",
user->current_step, user->current_time, norm);CHKERRQ(ierr);
}
if((norm<1.e-6)||(user->current_step > user->max_time_its)) break;
}
// output the solution
if (user->output_solution && (user->current_step%steps_output==0)){
PetscViewer viewer;
// update file name for the current time step
ierr = PetscSNPrintf(fileName, sizeof(fileName),"%s_%d.vtk",filename1, nplot);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Outputing solution %s (current time %f)\n", fileName, user->current_time);CHKERRQ(ierr);
ierr = OutputVTK(user->dm, fileName, &viewer);CHKERRQ(ierr);
ierr = VecView(algebra->solution, viewer);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
nplot++;
}
user->current_step++;
}
ierr = VecDestroy(&algebra->fn);CHKERRQ(ierr);
}else{
PetscReal ftime;
TS ts;
TSConvergedReason reason;
PetscInt nsteps;
ierr = PetscPrintf(PETSC_COMM_WORLD,"Using the fully explicit method based on the PETSC TS routing\n");CHKERRQ(ierr);
ierr = DMCreateGlobalVector(user->dm, &algebra->solution);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) algebra->solution, "solution");CHKERRQ(ierr);
ierr = SetInitialCondition(user->dm, algebra->solution, user);CHKERRQ(ierr);
ierr = TSCreate(comm, &ts);CHKERRQ(ierr);
ierr = TSSetType(ts, TSEULER);CHKERRQ(ierr);
ierr = TSSetDM(ts, user->dm);CHKERRQ(ierr);
ierr = TSMonitorSet(ts,TSMonitorFunctionError,&user,NULL);CHKERRQ(ierr);
ierr = TSSetRHSFunction(ts, NULL, MyRHSFunction, user);CHKERRQ(ierr);
ierr = TSSetDuration(ts, 1000, user->final_time);CHKERRQ(ierr);
ierr = TSSetInitialTimeStep(ts, user->initial_time, user->dt);CHKERRQ(ierr);
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
ierr = TSSolve(ts, algebra->solution);CHKERRQ(ierr);
ierr = TSGetSolveTime(ts, &ftime);CHKERRQ(ierr);
ierr = TSGetTimeStepNumber(ts, &nsteps);CHKERRQ(ierr);
ierr = TSGetConvergedReason(ts, &reason);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"%s at time %g after %D steps\n",TSConvergedReasons[reason],ftime,nsteps);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
}
if(user->benchmark_couette) {
ierr = DMCreateGlobalVector(user->dm, &algebra->exactsolution);CHKERRQ(ierr);
ierr = ComputeExactSolution(user->dm, user->final_time, algebra->exactsolution, user);CHKERRQ(ierr);
}
if (user->output_solution){
PetscViewer viewer;
ierr = OutputVTK(user->dm, "solution.vtk", &viewer);CHKERRQ(ierr);
ierr = VecView(algebra->solution, viewer);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
}
if(user->benchmark_couette) {
PetscViewer viewer;
PetscReal norm;
ierr = OutputVTK(user->dm, "exact_solution.vtk", &viewer);CHKERRQ(ierr);
ierr = VecView(algebra->exactsolution, viewer);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
ierr = VecAXPY(algebra->exactsolution, -1, algebra->solution);CHKERRQ(ierr);
ierr = VecNorm(algebra->exactsolution,NORM_INFINITY,&norm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Final time at %f, Error: ||u_k-u|| = %g \n", user->final_time, norm);CHKERRQ(ierr);
ierr = OutputVTK(user->dm, "Error.vtk", &viewer);CHKERRQ(ierr);
ierr = VecView(algebra->exactsolution, viewer);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
}
ierr = VecDestroy(&algebra->solution);CHKERRQ(ierr);
ierr = VecDestroy(&algebra->oldsolution);CHKERRQ(ierr);
ierr = DMDestroy(&user->dm);CHKERRQ(ierr);
} else if (user->TimeIntegralMethod == IMPLICITMETHOD) {
ierr = PetscPrintf(PETSC_COMM_WORLD,"Using the fully implicit method\n");CHKERRQ(ierr);
ierr = SNESCreate(comm,&user->snes);CHKERRQ(ierr);
ierr = SNESSetDM(user->snes,user->dm);CHKERRQ(ierr);
ierr = DMCreateGlobalVector(user->dm, &algebra->solution);CHKERRQ(ierr);
ierr = VecDuplicate(algebra->solution, &algebra->oldsolution);CHKERRQ(ierr);
ierr = VecDuplicate(algebra->solution, &algebra->f);CHKERRQ(ierr);
ierr = VecDuplicate(algebra->solution, &algebra->fn);CHKERRQ(ierr);
ierr = VecDuplicate(algebra->solution, &algebra->oldfn);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) algebra->solution, "solution");CHKERRQ(ierr);
ierr = SetInitialCondition(user->dm, algebra->solution, user);CHKERRQ(ierr);
ierr = DMSetMatType(user->dm, MATAIJ);CHKERRQ(ierr);
// ierr = DMCreateMatrix(user->dm, &algebra->A);CHKERRQ(ierr);
ierr = DMCreateMatrix(user->dm, &algebra->J);CHKERRQ(ierr);
if (user->JdiffP) {
/*Set up the preconditioner matrix*/
ierr = DMCreateMatrix(user->dm, &algebra->P);CHKERRQ(ierr);
}else{
algebra->P = algebra->J;
}
ierr = MatSetOption(algebra->J, MAT_NEW_NONZERO_ALLOCATION_ERR, PETSC_FALSE);CHKERRQ(ierr);
/*set nonlinear function */
ierr = SNESSetFunction(user->snes, algebra->f, FormFunction, (void*)user);CHKERRQ(ierr);
/* compute Jacobian */
ierr = SNESSetJacobian(user->snes, algebra->J, algebra->P, FormJacobian, (void*)user);CHKERRQ(ierr);
ierr = SNESSetFromOptions(user->snes);CHKERRQ(ierr);
/* do the solve */
if (user->timestep == TIMESTEP_STEADY_STATE) {
ierr = SolveSteadyState(user);CHKERRQ(ierr);
} else {
ierr = SolveTimeDependent(user);CHKERRQ(ierr);
}
if (user->output_solution){
PetscViewer viewer;
ierr = OutputVTK(user->dm, "solution.vtk", &viewer);CHKERRQ(ierr);
ierr = VecView(algebra->solution, viewer);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
}
if(user->benchmark_couette) {
PetscViewer viewer;
PetscReal norm;
ierr = OutputVTK(user->dm, "exact_solution.vtk", &viewer);CHKERRQ(ierr);
ierr = VecView(algebra->exactsolution, viewer);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
ierr = VecAXPY(algebra->exactsolution, -1, algebra->solution);CHKERRQ(ierr);
ierr = VecNorm(algebra->exactsolution,NORM_INFINITY,&norm);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Error: ||u_k-u|| = %g \n", norm);CHKERRQ(ierr);
ierr = OutputVTK(user->dm, "Error.vtk", &viewer);CHKERRQ(ierr);
ierr = VecView(algebra->exactsolution, viewer);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
}
ierr = VecDestroy(&algebra->solution);CHKERRQ(ierr);
ierr = VecDestroy(&algebra->f);CHKERRQ(ierr);
ierr = VecDestroy(&algebra->oldsolution);CHKERRQ(ierr);
ierr = VecDestroy(&algebra->fn);CHKERRQ(ierr);
ierr = VecDestroy(&algebra->oldfn);CHKERRQ(ierr);
ierr = SNESDestroy(&user->snes);CHKERRQ(ierr);
ierr = DMDestroy(&user->dm);CHKERRQ(ierr);
} else {
SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"WRONG option for the time integral method. Using the option '-time_integral_method 0 or 1'");
}
ierr = VecDestroy(&user->cellgeom);CHKERRQ(ierr);
ierr = VecDestroy(&user->facegeom);CHKERRQ(ierr);
ierr = DMDestroy(&user->dmGrad);CHKERRQ(ierr);
ierr = PetscFunctionListDestroy(&LimitList);CHKERRQ(ierr);
ierr = PetscFree(user->model->physics);CHKERRQ(ierr);
ierr = PetscFree(user->algebra);CHKERRQ(ierr);
ierr = PetscFree(user->model);CHKERRQ(ierr);
ierr = PetscFree(user);CHKERRQ(ierr);
{
PetscLogDouble space =0;
ierr = PetscMallocGetCurrentUsage(&space);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Unfreed space at the End %g M\n", space/(1024*1024));CHKERRQ(ierr);
}
ierr = PetscFinalize();
return(0);
}
static PetscErrorCode KSPSolve_LSQR(KSP ksp)
{
PetscErrorCode ierr;
PetscInt i,size1,size2;
PetscScalar rho,rhobar,phi,phibar,theta,c,s,tmp,tau;
PetscReal beta,alpha,rnorm;
Vec X,B,V,V1,U,U1,TMP,W,W2,SE,Z = NULL;
Mat Amat,Pmat;
MatStructure pflag;
KSP_LSQR *lsqr = (KSP_LSQR*)ksp->data;
PetscBool diagonalscale,nopreconditioner;
PetscFunctionBegin;
ierr = PCGetDiagonalScale(ksp->pc,&diagonalscale);CHKERRQ(ierr);
if (diagonalscale) SETERRQ1(PetscObjectComm((PetscObject)ksp),PETSC_ERR_SUP,"Krylov method %s does not support diagonal scaling",((PetscObject)ksp)->type_name);
ierr = PCGetOperators(ksp->pc,&Amat,&Pmat,&pflag);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)ksp->pc,PCNONE,&nopreconditioner);CHKERRQ(ierr);
/* nopreconditioner =PETSC_FALSE; */
/* Calculate norm of right hand side */
ierr = VecNorm(ksp->vec_rhs,NORM_2,&lsqr->rhs_norm);CHKERRQ(ierr);
/* mark norm of matrix with negative number to indicate it has not yet been computed */
lsqr->anorm = -1.0;
/* vectors of length m, where system size is mxn */
B = ksp->vec_rhs;
U = lsqr->vwork_m[0];
U1 = lsqr->vwork_m[1];
/* vectors of length n */
X = ksp->vec_sol;
W = lsqr->vwork_n[0];
V = lsqr->vwork_n[1];
V1 = lsqr->vwork_n[2];
W2 = lsqr->vwork_n[3];
if (!nopreconditioner) Z = lsqr->vwork_n[4];
/* standard error vector */
SE = lsqr->se;
if (SE) {
ierr = VecGetSize(SE,&size1);CHKERRQ(ierr);
ierr = VecGetSize(X,&size2);CHKERRQ(ierr);
if (size1 != size2) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Standard error vector (size %d) does not match solution vector (size %d)",size1,size2);
ierr = VecSet(SE,0.0);CHKERRQ(ierr);
}
/* Compute initial residual, temporarily use work vector u */
if (!ksp->guess_zero) {
ierr = KSP_MatMult(ksp,Amat,X,U);CHKERRQ(ierr); /* u <- b - Ax */
ierr = VecAYPX(U,-1.0,B);CHKERRQ(ierr);
} else {
ierr = VecCopy(B,U);CHKERRQ(ierr); /* u <- b (x is 0) */
}
/* Test for nothing to do */
ierr = VecNorm(U,NORM_2,&rnorm);CHKERRQ(ierr);
ierr = PetscObjectAMSTakeAccess((PetscObject)ksp);CHKERRQ(ierr);
ksp->its = 0;
ksp->rnorm = rnorm;
ierr = PetscObjectAMSGrantAccess((PetscObject)ksp);CHKERRQ(ierr);
ierr = KSPLogResidualHistory(ksp,rnorm);CHKERRQ(ierr);
ierr = KSPMonitor(ksp,0,rnorm);CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,0,rnorm,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
if (ksp->reason) PetscFunctionReturn(0);
beta = rnorm;
ierr = VecScale(U,1.0/beta);CHKERRQ(ierr);
ierr = KSP_MatMultTranspose(ksp,Amat,U,V);CHKERRQ(ierr);
if (nopreconditioner) {
ierr = VecNorm(V,NORM_2,&alpha);CHKERRQ(ierr);
} else {
ierr = PCApply(ksp->pc,V,Z);CHKERRQ(ierr);
ierr = VecDotRealPart(V,Z,&alpha);CHKERRQ(ierr);
if (alpha <= 0.0) {
ksp->reason = KSP_DIVERGED_BREAKDOWN;
PetscFunctionReturn(0);
}
alpha = PetscSqrtReal(alpha);
ierr = VecScale(Z,1.0/alpha);CHKERRQ(ierr);
}
ierr = VecScale(V,1.0/alpha);CHKERRQ(ierr);
if (nopreconditioner) {
ierr = VecCopy(V,W);CHKERRQ(ierr);
} else {
ierr = VecCopy(Z,W);CHKERRQ(ierr);
}
lsqr->arnorm = alpha * beta;
phibar = beta;
rhobar = alpha;
i = 0;
do {
if (nopreconditioner) {
ierr = KSP_MatMult(ksp,Amat,V,U1);CHKERRQ(ierr);
} else {
ierr = KSP_MatMult(ksp,Amat,Z,U1);CHKERRQ(ierr);
}
ierr = VecAXPY(U1,-alpha,U);CHKERRQ(ierr);
ierr = VecNorm(U1,NORM_2,&beta);CHKERRQ(ierr);
if (beta == 0.0) {
ksp->reason = KSP_DIVERGED_BREAKDOWN;
break;
}
ierr = VecScale(U1,1.0/beta);CHKERRQ(ierr);
ierr = KSP_MatMultTranspose(ksp,Amat,U1,V1);CHKERRQ(ierr);
ierr = VecAXPY(V1,-beta,V);CHKERRQ(ierr);
if (nopreconditioner) {
ierr = VecNorm(V1,NORM_2,&alpha);CHKERRQ(ierr);
} else {
ierr = PCApply(ksp->pc,V1,Z);CHKERRQ(ierr);
ierr = VecDotRealPart(V1,Z,&alpha);CHKERRQ(ierr);
if (alpha <= 0.0) {
ksp->reason = KSP_DIVERGED_BREAKDOWN;
break;
}
alpha = PetscSqrtReal(alpha);
ierr = VecScale(Z,1.0/alpha);CHKERRQ(ierr);
}
ierr = VecScale(V1,1.0/alpha);CHKERRQ(ierr);
rho = PetscSqrtScalar(rhobar*rhobar + beta*beta);
c = rhobar / rho;
s = beta / rho;
theta = s * alpha;
rhobar = -c * alpha;
phi = c * phibar;
phibar = s * phibar;
tau = s * phi;
ierr = VecAXPY(X,phi/rho,W);CHKERRQ(ierr); /* x <- x + (phi/rho) w */
if (SE) {
ierr = VecCopy(W,W2);CHKERRQ(ierr);
ierr = VecSquare(W2);CHKERRQ(ierr);
ierr = VecScale(W2,1.0/(rho*rho));CHKERRQ(ierr);
ierr = VecAXPY(SE, 1.0, W2);CHKERRQ(ierr); /* SE <- SE + (w^2/rho^2) */
}
if (nopreconditioner) {
ierr = VecAYPX(W,-theta/rho,V1);CHKERRQ(ierr); /* w <- v - (theta/rho) w */
} else {
ierr = VecAYPX(W,-theta/rho,Z);CHKERRQ(ierr); /* w <- z - (theta/rho) w */
}
lsqr->arnorm = alpha*PetscAbsScalar(tau);
rnorm = PetscRealPart(phibar);
ierr = PetscObjectAMSTakeAccess((PetscObject)ksp);CHKERRQ(ierr);
ksp->its++;
ksp->rnorm = rnorm;
ierr = PetscObjectAMSGrantAccess((PetscObject)ksp);CHKERRQ(ierr);
ierr = KSPLogResidualHistory(ksp,rnorm);CHKERRQ(ierr);
ierr = KSPMonitor(ksp,i+1,rnorm);CHKERRQ(ierr);
ierr = (*ksp->converged)(ksp,i+1,rnorm,&ksp->reason,ksp->cnvP);CHKERRQ(ierr);
if (ksp->reason) break;
SWAP(U1,U,TMP);
SWAP(V1,V,TMP);
i++;
} while (i<ksp->max_it);
if (i >= ksp->max_it && !ksp->reason) ksp->reason = KSP_DIVERGED_ITS;
/* Finish off the standard error estimates */
if (SE) {
tmp = 1.0;
ierr = MatGetSize(Amat,&size1,&size2);CHKERRQ(ierr);
if (size1 > size2) tmp = size1 - size2;
tmp = rnorm / PetscSqrtScalar(tmp);
ierr = VecSqrtAbs(SE);CHKERRQ(ierr);
ierr = VecScale(SE,tmp);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode VecLoad_Binary(Vec vec, PetscViewer viewer)
{
PetscMPIInt size,rank,tag;
int fd;
PetscInt i,rows = 0,n,*range,N,bs;
PetscErrorCode ierr;
PetscBool flag;
PetscScalar *avec,*avecwork;
MPI_Comm comm;
MPI_Request request;
MPI_Status status;
#if defined(PETSC_HAVE_MPIIO)
PetscBool useMPIIO;
#endif
PetscFunctionBegin;
ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr);
ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
ierr = PetscViewerBinaryGetDescriptor(viewer,&fd);CHKERRQ(ierr);
ierr = PetscViewerBinaryReadVecHeader_Private(viewer,&rows);CHKERRQ(ierr);
/* Set Vec sizes,blocksize,and type if not already set. Block size first so that local sizes will be compatible. */
ierr = PetscOptionsGetInt(((PetscObject)vec)->prefix, "-vecload_block_size", &bs, &flag);CHKERRQ(ierr);
if (flag) {
ierr = VecSetBlockSize(vec, bs);CHKERRQ(ierr);
}
if (vec->map->n < 0 && vec->map->N < 0) {
ierr = VecSetSizes(vec,PETSC_DECIDE,rows);CHKERRQ(ierr);
}
/* If sizes and type already set,check if the vector global size is correct */
ierr = VecGetSize(vec, &N);CHKERRQ(ierr);
if (N != rows) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED, "Vector in file different length (%d) then input vector (%d)", rows, N);
#if defined(PETSC_HAVE_MPIIO)
ierr = PetscViewerBinaryGetMPIIO(viewer,&useMPIIO);CHKERRQ(ierr);
if (useMPIIO) {
ierr = VecLoad_Binary_MPIIO(vec, viewer);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
#endif
ierr = VecGetLocalSize(vec,&n);CHKERRQ(ierr);
ierr = PetscObjectGetNewTag((PetscObject)viewer,&tag);CHKERRQ(ierr);
ierr = VecGetArray(vec,&avec);CHKERRQ(ierr);
if (!rank) {
ierr = PetscBinaryRead(fd,avec,n,PETSC_SCALAR);CHKERRQ(ierr);
if (size > 1) {
/* read in other chuncks and send to other processors */
/* determine maximum chunck owned by other */
range = vec->map->range;
n = 1;
for (i=1; i<size; i++) n = PetscMax(n,range[i+1] - range[i]);
ierr = PetscMalloc(n*sizeof(PetscScalar),&avecwork);CHKERRQ(ierr);
for (i=1; i<size; i++) {
n = range[i+1] - range[i];
ierr = PetscBinaryRead(fd,avecwork,n,PETSC_SCALAR);CHKERRQ(ierr);
ierr = MPI_Isend(avecwork,n,MPIU_SCALAR,i,tag,comm,&request);CHKERRQ(ierr);
ierr = MPI_Wait(&request,&status);CHKERRQ(ierr);
}
ierr = PetscFree(avecwork);CHKERRQ(ierr);
}
} else {
ierr = MPI_Recv(avec,n,MPIU_SCALAR,0,tag,comm,&status);CHKERRQ(ierr);
}
ierr = VecRestoreArray(vec,&avec);CHKERRQ(ierr);
ierr = VecAssemblyBegin(vec);CHKERRQ(ierr);
ierr = VecAssemblyEnd(vec);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode TaoLineSearchApply_MT(TaoLineSearch ls, Vec x, PetscReal *f, Vec g, Vec s)
{
PetscErrorCode ierr;
TaoLineSearch_MT *mt;
PetscReal xtrapf = 4.0;
PetscReal finit, width, width1, dginit, fm, fxm, fym, dgm, dgxm, dgym;
PetscReal dgx, dgy, dg, dg2, fx, fy, stx, sty, dgtest;
PetscReal ftest1=0.0, ftest2=0.0;
PetscInt i, stage1,n1,n2,nn1,nn2;
PetscReal bstepmin1, bstepmin2, bstepmax;
PetscBool g_computed=PETSC_FALSE; /* to prevent extra gradient computation */
PetscFunctionBegin;
PetscValidHeaderSpecific(ls,TAOLINESEARCH_CLASSID,1);
PetscValidHeaderSpecific(x,VEC_CLASSID,2);
PetscValidScalarPointer(f,3);
PetscValidHeaderSpecific(g,VEC_CLASSID,4);
PetscValidHeaderSpecific(s,VEC_CLASSID,5);
/* comm,type,size checks are done in interface TaoLineSearchApply */
mt = (TaoLineSearch_MT*)(ls->data);
ls->reason = TAOLINESEARCH_CONTINUE_ITERATING;
/* Check work vector */
if (!mt->work) {
ierr = VecDuplicate(x,&mt->work);CHKERRQ(ierr);
mt->x = x;
ierr = PetscObjectReference((PetscObject)mt->x);CHKERRQ(ierr);
} else if (x != mt->x) {
ierr = VecDestroy(&mt->work);CHKERRQ(ierr);
ierr = VecDuplicate(x,&mt->work);CHKERRQ(ierr);
ierr = PetscObjectDereference((PetscObject)mt->x);CHKERRQ(ierr);
mt->x = x;
ierr = PetscObjectReference((PetscObject)mt->x);CHKERRQ(ierr);
}
if (ls->bounded) {
/* Compute step length needed to make all variables equal a bound */
/* Compute the smallest steplength that will make one nonbinding variable
equal the bound */
ierr = VecGetLocalSize(ls->upper,&n1);CHKERRQ(ierr);
ierr = VecGetLocalSize(mt->x, &n2);CHKERRQ(ierr);
ierr = VecGetSize(ls->upper,&nn1);CHKERRQ(ierr);
ierr = VecGetSize(mt->x,&nn2);CHKERRQ(ierr);
if (n1 != n2 || nn1 != nn2) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Variable vector not compatible with bounds vector");
ierr = VecScale(s,-1.0);CHKERRQ(ierr);
ierr = VecBoundGradientProjection(s,x,ls->lower,ls->upper,s);CHKERRQ(ierr);
ierr = VecScale(s,-1.0);CHKERRQ(ierr);
ierr = VecStepBoundInfo(x,s,ls->lower,ls->upper,&bstepmin1,&bstepmin2,&bstepmax);CHKERRQ(ierr);
ls->stepmax = PetscMin(bstepmax,1.0e15);
}
ierr = VecDot(g,s,&dginit);CHKERRQ(ierr);
if (PetscIsInfOrNanReal(dginit)) {
ierr = PetscInfo1(ls,"Initial Line Search step * g is Inf or Nan (%g)\n",(double)dginit);CHKERRQ(ierr);
ls->reason=TAOLINESEARCH_FAILED_INFORNAN;
PetscFunctionReturn(0);
}
if (dginit >= 0.0) {
ierr = PetscInfo1(ls,"Initial Line Search step * g is not descent direction (%g)\n",(double)dginit);CHKERRQ(ierr);
ls->reason = TAOLINESEARCH_FAILED_ASCENT;
PetscFunctionReturn(0);
}
/* Initialization */
mt->bracket = 0;
stage1 = 1;
finit = *f;
dgtest = ls->ftol * dginit;
width = ls->stepmax - ls->stepmin;
width1 = width * 2.0;
ierr = VecCopy(x,mt->work);CHKERRQ(ierr);
/* Variable dictionary:
stx, fx, dgx - the step, function, and derivative at the best step
sty, fy, dgy - the step, function, and derivative at the other endpoint
of the interval of uncertainty
step, f, dg - the step, function, and derivative at the current step */
stx = 0.0;
fx = finit;
dgx = dginit;
sty = 0.0;
fy = finit;
dgy = dginit;
ls->step=ls->initstep;
for (i=0; i< ls->max_funcs; i++) {
/* Set min and max steps to correspond to the interval of uncertainty */
if (mt->bracket) {
ls->stepmin = PetscMin(stx,sty);
ls->stepmax = PetscMax(stx,sty);
} else {
ls->stepmin = stx;
ls->stepmax = ls->step + xtrapf * (ls->step - stx);
}
/* Force the step to be within the bounds */
ls->step = PetscMax(ls->step,ls->stepmin);
ls->step = PetscMin(ls->step,ls->stepmax);
/* If an unusual termination is to occur, then let step be the lowest
point obtained thus far */
if ((stx!=0) && (((mt->bracket) && (ls->step <= ls->stepmin || ls->step >= ls->stepmax)) || ((mt->bracket) && (ls->stepmax - ls->stepmin <= ls->rtol * ls->stepmax)) ||
((ls->nfeval+ls->nfgeval) >= ls->max_funcs - 1) || (mt->infoc == 0))) {
ls->step = stx;
}
ierr = VecCopy(x,mt->work);CHKERRQ(ierr);
ierr = VecAXPY(mt->work,ls->step,s);CHKERRQ(ierr); /* W = X + step*S */
if (ls->bounded) {
ierr = VecMedian(ls->lower, mt->work, ls->upper, mt->work);CHKERRQ(ierr);
}
if (ls->usegts) {
ierr = TaoLineSearchComputeObjectiveAndGTS(ls,mt->work,f,&dg);CHKERRQ(ierr);
g_computed=PETSC_FALSE;
} else {
ierr = TaoLineSearchComputeObjectiveAndGradient(ls,mt->work,f,g);CHKERRQ(ierr);
g_computed=PETSC_TRUE;
if (ls->bounded) {
ierr = VecDot(g,x,&dg);CHKERRQ(ierr);
ierr = VecDot(g,mt->work,&dg2);CHKERRQ(ierr);
dg = (dg2 - dg)/ls->step;
} else {
ierr = VecDot(g,s,&dg);CHKERRQ(ierr);
}
}
if (0 == i) {
ls->f_fullstep=*f;
}
if (PetscIsInfOrNanReal(*f) || PetscIsInfOrNanReal(dg)) {
/* User provided compute function generated Not-a-Number, assume
domain violation and set function value and directional
derivative to infinity. */
*f = PETSC_INFINITY;
dg = PETSC_INFINITY;
}
ftest1 = finit + ls->step * dgtest;
if (ls->bounded) {
ftest2 = finit + ls->step * dgtest * ls->ftol;
}
/* Convergence testing */
if (((*f - ftest1 <= 1.0e-10 * PetscAbsReal(finit)) && (PetscAbsReal(dg) + ls->gtol*dginit <= 0.0))) {
ierr = PetscInfo(ls, "Line search success: Sufficient decrease and directional deriv conditions hold\n");CHKERRQ(ierr);
ls->reason = TAOLINESEARCH_SUCCESS;
break;
}
/* Check Armijo if beyond the first breakpoint */
if (ls->bounded && (*f <= ftest2) && (ls->step >= bstepmin2)) {
ierr = PetscInfo(ls,"Line search success: Sufficient decrease.\n");CHKERRQ(ierr);
ls->reason = TAOLINESEARCH_SUCCESS;
break;
}
/* Checks for bad cases */
if (((mt->bracket) && (ls->step <= ls->stepmin||ls->step >= ls->stepmax)) || (!mt->infoc)) {
ierr = PetscInfo(ls,"Rounding errors may prevent further progress. May not be a step satisfying\n");CHKERRQ(ierr);
ierr = PetscInfo(ls,"sufficient decrease and curvature conditions. Tolerances may be too small.\n");CHKERRQ(ierr);
ls->reason = TAOLINESEARCH_HALTED_OTHER;
break;
}
if ((ls->step == ls->stepmax) && (*f <= ftest1) && (dg <= dgtest)) {
ierr = PetscInfo1(ls,"Step is at the upper bound, stepmax (%g)\n",(double)ls->stepmax);CHKERRQ(ierr);
ls->reason = TAOLINESEARCH_HALTED_UPPERBOUND;
break;
}
if ((ls->step == ls->stepmin) && (*f >= ftest1) && (dg >= dgtest)) {
ierr = PetscInfo1(ls,"Step is at the lower bound, stepmin (%g)\n",(double)ls->stepmin);CHKERRQ(ierr);
ls->reason = TAOLINESEARCH_HALTED_LOWERBOUND;
break;
}
if ((mt->bracket) && (ls->stepmax - ls->stepmin <= ls->rtol*ls->stepmax)){
ierr = PetscInfo1(ls,"Relative width of interval of uncertainty is at most rtol (%g)\n",(double)ls->rtol);CHKERRQ(ierr);
ls->reason = TAOLINESEARCH_HALTED_RTOL;
break;
}
/* In the first stage, we seek a step for which the modified function
has a nonpositive value and nonnegative derivative */
if ((stage1) && (*f <= ftest1) && (dg >= dginit * PetscMin(ls->ftol, ls->gtol))) {
stage1 = 0;
}
/* A modified function is used to predict the step only if we
have not obtained a step for which the modified function has a
nonpositive function value and nonnegative derivative, and if a
lower function value has been obtained but the decrease is not
sufficient */
if ((stage1) && (*f <= fx) && (*f > ftest1)) {
fm = *f - ls->step * dgtest; /* Define modified function */
fxm = fx - stx * dgtest; /* and derivatives */
fym = fy - sty * dgtest;
dgm = dg - dgtest;
dgxm = dgx - dgtest;
dgym = dgy - dgtest;
/* if (dgxm * (ls->step - stx) >= 0.0) */
/* Update the interval of uncertainty and compute the new step */
ierr = Tao_mcstep(ls,&stx,&fxm,&dgxm,&sty,&fym,&dgym,&ls->step,&fm,&dgm);CHKERRQ(ierr);
fx = fxm + stx * dgtest; /* Reset the function and */
fy = fym + sty * dgtest; /* gradient values */
dgx = dgxm + dgtest;
dgy = dgym + dgtest;
} else {
/* Update the interval of uncertainty and compute the new step */
ierr = Tao_mcstep(ls,&stx,&fx,&dgx,&sty,&fy,&dgy,&ls->step,f,&dg);CHKERRQ(ierr);
}
/* Force a sufficient decrease in the interval of uncertainty */
if (mt->bracket) {
if (PetscAbsReal(sty - stx) >= 0.66 * width1) ls->step = stx + 0.5*(sty - stx);
width1 = width;
width = PetscAbsReal(sty - stx);
}
}
if ((ls->nfeval+ls->nfgeval) > ls->max_funcs) {
ierr = PetscInfo2(ls,"Number of line search function evals (%D) > maximum (%D)\n",(ls->nfeval+ls->nfgeval),ls->max_funcs);CHKERRQ(ierr);
ls->reason = TAOLINESEARCH_HALTED_MAXFCN;
}
/* Finish computations */
ierr = PetscInfo2(ls,"%D function evals in line search, step = %g\n",(ls->nfeval+ls->nfgeval),(double)ls->step);CHKERRQ(ierr);
/* Set new solution vector and compute gradient if needed */
ierr = VecCopy(mt->work,x);CHKERRQ(ierr);
if (!g_computed) {
ierr = TaoLineSearchComputeGradient(ls,mt->work,g);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
int main(int argc, char **argv)
{
TS ts;
Vec x; /*solution vector*/
Mat A; /*Jacobian*/
PetscInt steps,maxsteps,mx;
PetscErrorCode ierr;
PetscReal ftime;
AppCtx user; /* user-defined work context */
PetscInitialize(&argc,&argv,NULL,help);
/* Initialize user application context */
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"Allen-Cahn equation","");
user.param = 9e-4;
user.xleft = -1.;
user.xright = 2.;
user.mx = 400;
ierr = PetscOptionsReal("-eps","parameter","",user.param,&user.param,NULL);CHKERRQ(ierr);
ierr = PetscOptionsEnd();CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/*
* ierr = PetscOptionsGetBool(NULL,"-monitor",&monitor,NULL);CHKERRQ(ierr);
*/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create necessary matrix and vectors, solve same ODE on every process
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,user.mx,user.mx);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = MatGetVecs(A,&x,NULL);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create time stepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetType(ts,TSEIMEX);CHKERRQ(ierr);
ierr = TSSetRHSFunction(ts,NULL,RHSFunction,&user);CHKERRQ(ierr);
ierr = TSSetIFunction(ts,NULL,FormIFunction,&user);CHKERRQ(ierr);
ierr = TSSetIJacobian(ts,A,A,FormIJacobian,&user);CHKERRQ(ierr);
ftime = 142;
maxsteps = 100000;
ierr = TSSetDuration(ts,maxsteps,ftime);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = FormInitialSolution(ts,x,&user);CHKERRQ(ierr);
ierr = TSSetSolution(ts,x);CHKERRQ(ierr);
ierr = VecGetSize(x,&mx);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve nonlinear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,x);CHKERRQ(ierr);
ierr = TSGetTime(ts,&ftime);CHKERRQ(ierr);
ierr = TSGetTimeStepNumber(ts,&steps);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"eps %g, steps %D, ftime %g\n",(double)user.param,steps,(double)ftime);CHKERRQ(ierr);
/* ierr = VecView(x,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);*/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = PetscFinalize();
PetscFunctionReturn(0);
}
PetscErrorCode MatSetUpMultiply_MPIAIJ(Mat mat)
{
Mat_MPIAIJ *aij = (Mat_MPIAIJ*)mat->data;
Mat_SeqAIJ *B = (Mat_SeqAIJ*)(aij->B->data);
PetscErrorCode ierr;
PetscInt i,j,*aj = B->j,ec = 0,*garray;
IS from,to;
Vec gvec;
#if defined(PETSC_USE_CTABLE)
PetscTable gid1_lid1;
PetscTablePosition tpos;
PetscInt gid,lid;
#else
PetscInt N = mat->cmap->N,*indices;
#endif
PetscFunctionBegin;
if (!aij->garray) {
#if defined(PETSC_USE_CTABLE)
/* use a table */
ierr = PetscTableCreate(aij->B->rmap->n,mat->cmap->N+1,&gid1_lid1);CHKERRQ(ierr);
for (i=0; i<aij->B->rmap->n; i++) {
for (j=0; j<B->ilen[i]; j++) {
PetscInt data,gid1 = aj[B->i[i] + j] + 1;
ierr = PetscTableFind(gid1_lid1,gid1,&data);CHKERRQ(ierr);
if (!data) {
/* one based table */
ierr = PetscTableAdd(gid1_lid1,gid1,++ec,INSERT_VALUES);CHKERRQ(ierr);
}
}
}
/* form array of columns we need */
ierr = PetscMalloc1(ec+1,&garray);CHKERRQ(ierr);
ierr = PetscTableGetHeadPosition(gid1_lid1,&tpos);CHKERRQ(ierr);
while (tpos) {
ierr = PetscTableGetNext(gid1_lid1,&tpos,&gid,&lid);CHKERRQ(ierr);
gid--;
lid--;
garray[lid] = gid;
}
ierr = PetscSortInt(ec,garray);CHKERRQ(ierr); /* sort, and rebuild */
ierr = PetscTableRemoveAll(gid1_lid1);CHKERRQ(ierr);
for (i=0; i<ec; i++) {
ierr = PetscTableAdd(gid1_lid1,garray[i]+1,i+1,INSERT_VALUES);CHKERRQ(ierr);
}
/* compact out the extra columns in B */
for (i=0; i<aij->B->rmap->n; i++) {
for (j=0; j<B->ilen[i]; j++) {
PetscInt gid1 = aj[B->i[i] + j] + 1;
ierr = PetscTableFind(gid1_lid1,gid1,&lid);CHKERRQ(ierr);
lid--;
aj[B->i[i] + j] = lid;
}
}
aij->B->cmap->n = aij->B->cmap->N = ec;
aij->B->cmap->bs = 1;
ierr = PetscLayoutSetUp((aij->B->cmap));CHKERRQ(ierr);
ierr = PetscTableDestroy(&gid1_lid1);CHKERRQ(ierr);
#else
/* Make an array as long as the number of columns */
/* mark those columns that are in aij->B */
ierr = PetscCalloc1(N+1,&indices);CHKERRQ(ierr);
for (i=0; i<aij->B->rmap->n; i++) {
for (j=0; j<B->ilen[i]; j++) {
if (!indices[aj[B->i[i] + j]]) ec++;
indices[aj[B->i[i] + j]] = 1;
}
}
/* form array of columns we need */
ierr = PetscMalloc1(ec+1,&garray);CHKERRQ(ierr);
ec = 0;
for (i=0; i<N; i++) {
if (indices[i]) garray[ec++] = i;
}
/* make indices now point into garray */
for (i=0; i<ec; i++) {
indices[garray[i]] = i;
}
/* compact out the extra columns in B */
for (i=0; i<aij->B->rmap->n; i++) {
for (j=0; j<B->ilen[i]; j++) {
aj[B->i[i] + j] = indices[aj[B->i[i] + j]];
}
}
aij->B->cmap->n = aij->B->cmap->N = ec;
aij->B->cmap->bs = 1;
ierr = PetscLayoutSetUp((aij->B->cmap));CHKERRQ(ierr);
ierr = PetscFree(indices);CHKERRQ(ierr);
#endif
} else {
garray = aij->garray;
}
if (!aij->lvec) {
/* create local vector that is used to scatter into */
ierr = VecCreateSeq(PETSC_COMM_SELF,ec,&aij->lvec);CHKERRQ(ierr);
} else {
ierr = VecGetSize(aij->lvec,&ec);CHKERRQ(ierr);
}
/* create two temporary Index sets for build scatter gather */
ierr = ISCreateGeneral(((PetscObject)mat)->comm,ec,garray,PETSC_COPY_VALUES,&from);CHKERRQ(ierr);
ierr = ISCreateStride(PETSC_COMM_SELF,ec,0,1,&to);CHKERRQ(ierr);
/* create temporary global vector to generate scatter context */
/* This does not allocate the array's memory so is efficient */
ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)mat),1,mat->cmap->n,mat->cmap->N,NULL,&gvec);CHKERRQ(ierr);
/* generate the scatter context */
if (aij->Mvctx_mpi1_flg) {
ierr = VecScatterDestroy(&aij->Mvctx_mpi1);CHKERRQ(ierr);
ierr = VecScatterCreate(gvec,from,aij->lvec,to,&aij->Mvctx_mpi1);CHKERRQ(ierr);
ierr = VecScatterSetType(aij->Mvctx_mpi1,VECSCATTERMPI1);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)mat,(PetscObject)aij->Mvctx_mpi1);CHKERRQ(ierr);
} else {
ierr = VecScatterDestroy(&aij->Mvctx);CHKERRQ(ierr);
ierr = VecScatterCreate(gvec,from,aij->lvec,to,&aij->Mvctx);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)mat,(PetscObject)aij->Mvctx);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)mat,(PetscObject)aij->lvec);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)mat,(ec+1)*sizeof(PetscInt));CHKERRQ(ierr);
}
aij->garray = garray;
ierr = PetscLogObjectParent((PetscObject)mat,(PetscObject)from);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)mat,(PetscObject)to);CHKERRQ(ierr);
ierr = ISDestroy(&from);CHKERRQ(ierr);
ierr = ISDestroy(&to);CHKERRQ(ierr);
ierr = VecDestroy(&gvec);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode private_VecView_Swarm_XDMF(Vec x,PetscViewer viewer)
{
long int *bytes = NULL;
PetscContainer container = NULL;
const char *viewername;
char datafile[PETSC_MAX_PATH_LEN];
PetscViewer fviewer;
PetscInt N,bs;
const char *vecname;
char fieldname[PETSC_MAX_PATH_LEN];
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscObjectQuery((PetscObject)viewer,"XDMFViewerContext",(PetscObject*)&container);CHKERRQ(ierr);
if (container) {
ierr = PetscContainerGetPointer(container,(void**)&bytes);CHKERRQ(ierr);
} else SETERRQ(PetscObjectComm((PetscObject)viewer),PETSC_ERR_SUP,"Valid to find attached data XDMFViewerContext");
ierr = PetscViewerFileGetName(viewer,&viewername);CHKERRQ(ierr);
ierr = private_CreateDataFileNameXDMF(viewername,datafile);CHKERRQ(ierr);
/* re-open a sub-viewer for all data fields */
/* name is viewer.name + "_swarm_fields.pbin" */
ierr = PetscViewerCreate(PetscObjectComm((PetscObject)viewer),&fviewer);CHKERRQ(ierr);
ierr = PetscViewerSetType(fviewer,PETSCVIEWERBINARY);CHKERRQ(ierr);
ierr = PetscViewerBinarySetSkipHeader(fviewer,PETSC_TRUE);CHKERRQ(ierr);
ierr = PetscViewerBinarySetSkipInfo(fviewer,PETSC_TRUE);CHKERRQ(ierr);
ierr = PetscViewerFileSetMode(fviewer,FILE_MODE_APPEND);CHKERRQ(ierr);
ierr = PetscViewerFileSetName(fviewer,datafile);CHKERRQ(ierr);
ierr = VecGetSize(x,&N);CHKERRQ(ierr);
ierr = VecGetBlockSize(x,&bs);CHKERRQ(ierr);
N = N/bs;
ierr = PetscObjectGetName((PetscObject)x,&vecname);CHKERRQ(ierr);
if (!vecname) {
ierr = PetscSNPrintf(fieldname,PETSC_MAX_PATH_LEN-1,"swarmfield_%D",((PetscObject)x)->tag);CHKERRQ(ierr);
} else {
ierr = PetscSNPrintf(fieldname,PETSC_MAX_PATH_LEN-1,"%s",vecname);CHKERRQ(ierr);
}
/* write data header */
ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"<Attribute Center=\"Node\" Name=\"%s\" Type=\"None\">\n",fieldname);CHKERRQ(ierr);
ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
if (bs == 1) {
ierr = PetscViewerASCIIPrintf(viewer,"<DataItem Format=\"Binary\" Endian=\"Big\" DataType=\"Float\" Precision=\"8\" Dimensions=\"%D\" Seek=\"%D\">\n",N,bytes[0]);CHKERRQ(ierr);
} else {
ierr = PetscViewerASCIIPrintf(viewer,"<DataItem Format=\"Binary\" Endian=\"Big\" DataType=\"Float\" Precision=\"8\" Dimensions=\"%D %D\" Seek=\"%D\">\n",N,bs,bytes[0]);CHKERRQ(ierr);
}
ierr = PetscViewerASCIIPushTab(viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"%s\n",datafile);CHKERRQ(ierr);
ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"</DataItem>\n");CHKERRQ(ierr);
ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"</Attribute>\n");CHKERRQ(ierr);
ierr = PetscViewerASCIIPopTab(viewer);CHKERRQ(ierr);
/* write data */
ierr = VecView(x,fviewer);CHKERRQ(ierr);
bytes[0] += sizeof(PetscReal) * N * bs;
ierr = PetscViewerDestroy(&fviewer);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **args)
{
Mat Amat;
PetscErrorCode ierr;
SNES snes;
KSP ksp;
MPI_Comm comm;
PetscMPIInt npe,rank;
PetscLogStage stage[7];
PetscBool test_nonzero_cols=PETSC_FALSE,use_nearnullspace=PETSC_TRUE;
Vec xx,bb;
PetscInt iter,i,N,dim=3,cells[3]={1,1,1},max_conv_its,local_sizes[7],run_type=1;
DM dm,distdm,basedm;
PetscBool flg;
char convType[256];
PetscReal Lx,mdisp[10],err[10];
const char * const options[10] = {"-ex56_dm_refine 0",
"-ex56_dm_refine 1",
"-ex56_dm_refine 2",
"-ex56_dm_refine 3",
"-ex56_dm_refine 4",
"-ex56_dm_refine 5",
"-ex56_dm_refine 6",
"-ex56_dm_refine 7",
"-ex56_dm_refine 8",
"-ex56_dm_refine 9"};
PetscFunctionBeginUser;
ierr = PetscInitialize(&argc,&args,(char*)0,help);if (ierr) return ierr;
comm = PETSC_COMM_WORLD;
ierr = MPI_Comm_rank(comm, &rank);CHKERRQ(ierr);
ierr = MPI_Comm_size(comm, &npe);CHKERRQ(ierr);
/* options */
ierr = PetscOptionsBegin(comm,NULL,"3D bilinear Q1 elasticity options","");CHKERRQ(ierr);
{
i = 3;
ierr = PetscOptionsIntArray("-cells", "Number of (flux tube) processor in each dimension", "ex56.c", cells, &i, NULL);CHKERRQ(ierr);
Lx = 1.; /* or ne for rod */
max_conv_its = 3;
ierr = PetscOptionsInt("-max_conv_its","Number of iterations in convergence study","",max_conv_its,&max_conv_its,NULL);CHKERRQ(ierr);
if (max_conv_its<=0 || max_conv_its>7) SETERRQ1(PETSC_COMM_WORLD, PETSC_ERR_USER, "Bad number of iterations for convergence test (%D)",max_conv_its);
ierr = PetscOptionsReal("-lx","Length of domain","",Lx,&Lx,NULL);CHKERRQ(ierr);
ierr = PetscOptionsReal("-alpha","material coefficient inside circle","",s_soft_alpha,&s_soft_alpha,NULL);CHKERRQ(ierr);
ierr = PetscOptionsBool("-test_nonzero_cols","nonzero test","",test_nonzero_cols,&test_nonzero_cols,NULL);CHKERRQ(ierr);
ierr = PetscOptionsBool("-use_mat_nearnullspace","MatNearNullSpace API test","",use_nearnullspace,&use_nearnullspace,NULL);CHKERRQ(ierr);
ierr = PetscOptionsInt("-run_type","0: twisting load on cantalever, 1: 3rd order accurate convergence test","",run_type,&run_type,NULL);CHKERRQ(ierr);
i = 3;
ierr = PetscOptionsInt("-mat_block_size","","",i,&i,&flg);CHKERRQ(ierr);
if (!flg || i!=3) SETERRQ2(PETSC_COMM_WORLD, PETSC_ERR_USER, "'-mat_block_size 3' must be set (%D) and = 3 (%D)",flg,flg? i : 3);
}
ierr = PetscOptionsEnd();CHKERRQ(ierr);
ierr = PetscLogStageRegister("Mesh Setup", &stage[6]);CHKERRQ(ierr);
ierr = PetscLogStageRegister("1st Setup", &stage[0]);CHKERRQ(ierr);
ierr = PetscLogStageRegister("1st Solve", &stage[1]);CHKERRQ(ierr);
/* create DM, Plex calls DMSetup */
ierr = PetscLogStagePush(stage[6]);CHKERRQ(ierr);
ierr = DMPlexCreateHexBoxMesh(comm, dim, cells, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, &dm);CHKERRQ(ierr);
{
DMLabel label;
IS is;
ierr = DMCreateLabel(dm, "boundary");CHKERRQ(ierr);
ierr = DMGetLabel(dm, "boundary", &label);CHKERRQ(ierr);
ierr = DMPlexMarkBoundaryFaces(dm, label);CHKERRQ(ierr);
if (run_type==0) {
ierr = DMGetStratumIS(dm, "boundary", 1, &is);CHKERRQ(ierr);
ierr = DMCreateLabel(dm,"Faces");CHKERRQ(ierr);
if (is) {
PetscInt d, f, Nf;
const PetscInt *faces;
PetscInt csize;
PetscSection cs;
Vec coordinates ;
DM cdm;
ierr = ISGetLocalSize(is, &Nf);CHKERRQ(ierr);
ierr = ISGetIndices(is, &faces);CHKERRQ(ierr);
ierr = DMGetCoordinatesLocal(dm, &coordinates);CHKERRQ(ierr);
ierr = DMGetCoordinateDM(dm, &cdm);CHKERRQ(ierr);
ierr = DMGetDefaultSection(cdm, &cs);CHKERRQ(ierr);
/* Check for each boundary face if any component of its centroid is either 0.0 or 1.0 */
for (f = 0; f < Nf; ++f) {
PetscReal faceCoord;
PetscInt b,v;
PetscScalar *coords = NULL;
PetscInt Nv;
ierr = DMPlexVecGetClosure(cdm, cs, coordinates, faces[f], &csize, &coords);CHKERRQ(ierr);
Nv = csize/dim; /* Calculate mean coordinate vector */
for (d = 0; d < dim; ++d) {
faceCoord = 0.0;
for (v = 0; v < Nv; ++v) faceCoord += PetscRealPart(coords[v*dim+d]);
faceCoord /= Nv;
for (b = 0; b < 2; ++b) {
if (PetscAbs(faceCoord - b) < PETSC_SMALL) { /* domain have not been set yet, still [0,1]^3 */
ierr = DMSetLabelValue(dm, "Faces", faces[f], d*2+b+1);CHKERRQ(ierr);
}
}
}
ierr = DMPlexVecRestoreClosure(cdm, cs, coordinates, faces[f], &csize, &coords);CHKERRQ(ierr);
}
ierr = ISRestoreIndices(is, &faces);CHKERRQ(ierr);
}
ierr = ISDestroy(&is);CHKERRQ(ierr);
ierr = DMGetLabel(dm, "Faces", &label);CHKERRQ(ierr);
ierr = DMPlexLabelComplete(dm, label);CHKERRQ(ierr);
}
}
{
PetscInt dimEmbed, i;
PetscInt nCoords;
PetscScalar *coords,bounds[] = {0,Lx,-.5,.5,-.5,.5,}; /* x_min,x_max,y_min,y_max */
Vec coordinates;
if (run_type==1) {
for (i = 0; i < 2*dim; i++) bounds[i] = (i%2) ? 1 : 0;
}
ierr = DMGetCoordinatesLocal(dm,&coordinates);CHKERRQ(ierr);
ierr = DMGetCoordinateDim(dm,&dimEmbed);CHKERRQ(ierr);
if (dimEmbed != dim) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"dimEmbed != dim %D",dimEmbed);CHKERRQ(ierr);
ierr = VecGetLocalSize(coordinates,&nCoords);CHKERRQ(ierr);
if (nCoords % dimEmbed) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Coordinate vector the wrong size");CHKERRQ(ierr);
ierr = VecGetArray(coordinates,&coords);CHKERRQ(ierr);
for (i = 0; i < nCoords; i += dimEmbed) {
PetscInt j;
PetscScalar *coord = &coords[i];
for (j = 0; j < dimEmbed; j++) {
coord[j] = bounds[2 * j] + coord[j] * (bounds[2 * j + 1] - bounds[2 * j]);
}
}
ierr = VecRestoreArray(coordinates,&coords);CHKERRQ(ierr);
ierr = DMSetCoordinatesLocal(dm,coordinates);CHKERRQ(ierr);
}
/* convert to p4est, and distribute */
ierr = PetscOptionsBegin(comm, "", "Mesh conversion options", "DMPLEX");CHKERRQ(ierr);
ierr = PetscOptionsFList("-dm_type","Convert DMPlex to another format (should not be Plex!)","ex56.c",DMList,DMPLEX,convType,256,&flg);CHKERRQ(ierr);
ierr = PetscOptionsEnd();
if (flg) {
DM newdm;
ierr = DMConvert(dm,convType,&newdm);CHKERRQ(ierr);
if (newdm) {
const char *prefix;
PetscBool isForest;
ierr = PetscObjectGetOptionsPrefix((PetscObject)dm,&prefix);CHKERRQ(ierr);
ierr = PetscObjectSetOptionsPrefix((PetscObject)newdm,prefix);CHKERRQ(ierr);
ierr = DMIsForest(newdm,&isForest);CHKERRQ(ierr);
if (isForest) {
} else SETERRQ(PETSC_COMM_WORLD, PETSC_ERR_USER, "Converted to non Forest?");
ierr = DMDestroy(&dm);CHKERRQ(ierr);
dm = newdm;
} else SETERRQ(PETSC_COMM_WORLD, PETSC_ERR_USER, "Convert failed?");
} else {
/* Plex Distribute mesh over processes */
ierr = DMPlexDistribute(dm, 0, NULL, &distdm);CHKERRQ(ierr);
if (distdm) {
const char *prefix;
ierr = PetscObjectGetOptionsPrefix((PetscObject)dm,&prefix);CHKERRQ(ierr);
ierr = PetscObjectSetOptionsPrefix((PetscObject)distdm,prefix);CHKERRQ(ierr);
ierr = DMDestroy(&dm);CHKERRQ(ierr);
dm = distdm;
}
}
ierr = PetscLogStagePop();CHKERRQ(ierr);
basedm = dm; dm = NULL;
for (iter=0 ; iter<max_conv_its ; iter++) {
ierr = PetscLogStagePush(stage[6]);CHKERRQ(ierr);
/* make new DM */
ierr = DMClone(basedm, &dm);CHKERRQ(ierr);
ierr = PetscObjectSetOptionsPrefix((PetscObject) dm, "ex56_");CHKERRQ(ierr);
ierr = PetscObjectSetName( (PetscObject)dm,"Mesh");CHKERRQ(ierr);
ierr = PetscOptionsClearValue(NULL,"-ex56_dm_refine");CHKERRQ(ierr);
ierr = PetscOptionsInsertString(NULL,options[iter]);CHKERRQ(ierr);
ierr = DMSetFromOptions(dm);CHKERRQ(ierr); /* refinement done here in Plex, p4est */
/* snes */
ierr = SNESCreate(comm, &snes);CHKERRQ(ierr);
ierr = SNESSetDM(snes, dm);CHKERRQ(ierr);
/* fem */
{
const PetscInt Ncomp = dim;
const PetscInt components[] = {0,1,2};
const PetscInt Nfid = 1, Npid = 1;
const PetscInt fid[] = {1}; /* The fixed faces (x=0) */
const PetscInt pid[] = {2}; /* The faces with loading (x=L_x) */
PetscFE fe;
PetscDS prob;
DM cdm = dm;
ierr = PetscFECreateDefault(dm, dim, dim, PETSC_FALSE, NULL, PETSC_DECIDE, &fe);CHKERRQ(ierr); /* elasticity */
ierr = PetscObjectSetName((PetscObject) fe, "deformation");CHKERRQ(ierr);
/* FEM prob */
ierr = DMGetDS(dm, &prob);CHKERRQ(ierr);
ierr = PetscDSSetDiscretization(prob, 0, (PetscObject) fe);CHKERRQ(ierr);
/* setup problem */
if (run_type==1) {
ierr = PetscDSSetJacobian(prob, 0, 0, NULL, NULL, NULL, g3_uu_3d);CHKERRQ(ierr);
ierr = PetscDSSetResidual(prob, 0, f0_u_x4, f1_u_3d);CHKERRQ(ierr);
} else {
ierr = PetscDSSetJacobian(prob, 0, 0, NULL, NULL, NULL, g3_uu_3d_alpha);CHKERRQ(ierr);
ierr = PetscDSSetResidual(prob, 0, f0_u, f1_u_3d_alpha);CHKERRQ(ierr);
ierr = PetscDSSetBdResidual(prob, 0, f0_bd_u_3d, f1_bd_u);CHKERRQ(ierr);
}
/* bcs */
if (run_type==1) {
PetscInt id = 1;
ierr = DMAddBoundary(dm, DM_BC_ESSENTIAL, "wall", "boundary", 0, 0, NULL, (void (*)()) zero, 1, &id, NULL);CHKERRQ(ierr);
} else {
ierr = PetscDSAddBoundary(prob, DM_BC_ESSENTIAL, "fixed", "Faces", 0, Ncomp, components, (void (*)()) zero, Nfid, fid, NULL);CHKERRQ(ierr);
ierr = PetscDSAddBoundary(prob, DM_BC_NATURAL, "traction", "Faces", 0, Ncomp, components, NULL, Npid, pid, NULL);CHKERRQ(ierr);
}
while (cdm) {
ierr = DMSetDS(cdm,prob);CHKERRQ(ierr);
ierr = DMGetCoarseDM(cdm, &cdm);CHKERRQ(ierr);
}
ierr = PetscFEDestroy(&fe);CHKERRQ(ierr);
}
/* vecs & mat */
ierr = DMCreateGlobalVector(dm,&xx);CHKERRQ(ierr);
ierr = VecDuplicate(xx, &bb);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) bb, "b");CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject) xx, "u");CHKERRQ(ierr);
ierr = DMCreateMatrix(dm, &Amat);CHKERRQ(ierr);
ierr = VecGetSize(bb,&N);CHKERRQ(ierr);
local_sizes[iter] = N;
ierr = PetscPrintf(PETSC_COMM_WORLD,"[%d]%s %d global equations, %d vertices\n",rank,PETSC_FUNCTION_NAME,N,N/dim);CHKERRQ(ierr);
if (use_nearnullspace && N/dim > 1) {
/* Set up the near null space (a.k.a. rigid body modes) that will be used by the multigrid preconditioner */
DM subdm;
MatNullSpace nearNullSpace;
PetscInt fields = 0;
PetscObject deformation;
ierr = DMCreateSubDM(dm, 1, &fields, NULL, &subdm);CHKERRQ(ierr);
ierr = DMPlexCreateRigidBody(subdm, &nearNullSpace);CHKERRQ(ierr);
ierr = DMGetField(dm, 0, &deformation);CHKERRQ(ierr);
ierr = PetscObjectCompose(deformation, "nearnullspace", (PetscObject) nearNullSpace);CHKERRQ(ierr);
ierr = DMDestroy(&subdm);CHKERRQ(ierr);
ierr = MatNullSpaceDestroy(&nearNullSpace);CHKERRQ(ierr); /* created by DM and destroyed by Mat */
}
ierr = DMPlexSetSNESLocalFEM(dm,NULL,NULL,NULL);CHKERRQ(ierr);
ierr = SNESSetJacobian(snes, Amat, Amat, NULL, NULL);CHKERRQ(ierr);
ierr = SNESSetFromOptions(snes);CHKERRQ(ierr);
ierr = DMSetUp(dm);CHKERRQ(ierr);
ierr = PetscLogStagePop();CHKERRQ(ierr);
ierr = PetscLogStagePush(stage[0]);CHKERRQ(ierr);
/* ksp */
ierr = SNESGetKSP(snes, &ksp);CHKERRQ(ierr);
ierr = KSPSetComputeSingularValues(ksp,PETSC_TRUE);CHKERRQ(ierr);
/* test BCs */
ierr = VecZeroEntries(xx);CHKERRQ(ierr);
if (test_nonzero_cols) {
if (rank==0) ierr = VecSetValue(xx,0,1.0,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecAssemblyBegin(xx);CHKERRQ(ierr);
ierr = VecAssemblyEnd(xx);CHKERRQ(ierr);
}
ierr = VecZeroEntries(bb);CHKERRQ(ierr);
ierr = VecGetSize(bb,&i);CHKERRQ(ierr);
local_sizes[iter] = i;
ierr = PetscPrintf(PETSC_COMM_WORLD,"[%d]%s %d equations in vector, %d vertices\n",rank,PETSC_FUNCTION_NAME,i,i/dim);CHKERRQ(ierr);
/* setup solver, dummy solve to really setup */
if (0) {
ierr = KSPSetTolerances(ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
ierr = SNESSolve(snes, bb, xx);CHKERRQ(ierr);
ierr = KSPSetTolerances(ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,50);CHKERRQ(ierr);
ierr = VecZeroEntries(xx);CHKERRQ(ierr);
}
ierr = PetscLogStagePop();CHKERRQ(ierr);
/* solve */
ierr = PetscLogStagePush(stage[1]);CHKERRQ(ierr);
ierr = SNESSolve(snes, bb, xx);CHKERRQ(ierr);
ierr = PetscLogStagePop();CHKERRQ(ierr);
ierr = VecNorm(xx,NORM_INFINITY,&mdisp[iter]);CHKERRQ(ierr);
ierr = DMViewFromOptions(dm, NULL, "-dm_view");CHKERRQ(ierr);
{
PetscViewer viewer = NULL;
PetscViewerFormat fmt;
ierr = PetscOptionsGetViewer(comm,"ex56_","-vec_view",&viewer,&fmt,&flg);CHKERRQ(ierr);
if (flg) {
ierr = PetscViewerPushFormat(viewer,fmt);CHKERRQ(ierr);
ierr = VecView(xx,viewer);CHKERRQ(ierr);
ierr = VecView(bb,viewer);CHKERRQ(ierr);
ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
}
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
}
/* Free work space */
ierr = DMDestroy(&dm);CHKERRQ(ierr);
ierr = SNESDestroy(&snes);CHKERRQ(ierr);
ierr = VecDestroy(&xx);CHKERRQ(ierr);
ierr = VecDestroy(&bb);CHKERRQ(ierr);
ierr = MatDestroy(&Amat);CHKERRQ(ierr);
}
ierr = DMDestroy(&basedm);CHKERRQ(ierr);
if (run_type==1) {
err[0] = 59.975208 - mdisp[0]; /* error with what I think is the exact solution */
} else {
err[0] = 171.038 - mdisp[0];
}
for (iter=1 ; iter<max_conv_its ; iter++) {
if (run_type==1) {
err[iter] = 59.975208 - mdisp[iter];
} else {
err[iter] = 171.038 - mdisp[iter];
}
PetscPrintf(PETSC_COMM_WORLD,"[%d]%s %D) N=%12D, max displ=%9.7e, disp diff=%9.2e, error=%4.3e, rate=%3.2g\n",
rank,PETSC_FUNCTION_NAME,iter,local_sizes[iter],mdisp[iter],
mdisp[iter]-mdisp[iter-1],err[iter],log(err[iter-1]/err[iter])/log(2.));
}
ierr = PetscFinalize();
return ierr;
}
/*
A new Strategy can handle large size problem (more than 4G variables)
*/
int BackwardAverageRL(Vec *x, Vec *y, PetscInt *cacheInt, PetscScalar *cacheScalar, PetscInt n, PetscInt npt, PetscInt pmax, PetscInt Istart, PetscInt Iend,PetscScalar c){
PetscInt rank,size;
PetscErrorCode ierr;
PetscInt i, j, k=0, pi, pj, n2,n4 ,m, puse, pgrid,lx;
PetscInt localsizex,localsizey, rowcount=0;
PetscInt k1,k2,pgrid1,pgrid2;
PetscInt *idy,*idp, *NzindJ;
PetscScalar dx,dy,dx2,dy2,CX,CY;
PetscScalar *pty, *pty0;
IS isx1,isx2,isy1,isy2;
VecScatter ctx1,ctx2;
Vec y0;
Vec x1,x2;
PetscScalar *ptx1,*ptx2;
PetscInt size1,size2,col1,col2;
MPI_Comm_size(PETSC_COMM_WORLD,&size);
MPI_Comm_rank(PETSC_COMM_WORLD,&rank);
n2 = (PetscInt)(n*0.5);
n4 = (PetscInt)(n*0.25);
dx = 1.0/n;
dy = 1.0/n;
dx2 = dx/2-dx/1e6;
dy2 = dy/2-dy/1e6;
NzindJ = cacheInt; //pmax
idp = cacheInt; //pmax
idy = cacheInt + pmax;
pty0 = cacheScalar ; //pmax
localsizex = Iend-Istart;
localsizey = (PetscInt)(pmax*1.0/(localsizex+1))-2;
if(localsizey>n2){localsizey =n2;}
ierr = VecGetArray(*x,&ptx1);CHKERRQ(ierr);
ptx2 = ptx1;
if(rank< size*0.5){lx = localsizex*n2;}else{lx =0;}
VecCreateMPIWithArray(PETSC_COMM_WORLD,lx,PETSC_DETERMINE,ptx1,&x1);
if(rank< size*0.5){lx = 0;}else{lx = localsizex*n2; }
VecCreateMPIWithArray(PETSC_COMM_WORLD,lx,PETSC_DETERMINE,ptx2,&x2);
VecGetSize(x1,&size1);
VecGetSize(x2,&size2);
col1 = (PetscInt)(size1*1.0/n2);
col2 = (PetscInt)(size2*1.0/n2);
ierr = VecGetArray(*y,&pty);CHKERRQ(ierr);
ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,(localsizex+1)*(localsizey+1),pty0,&y0);
while(rowcount<n2){
if (n2-rowcount<=localsizey){localsizey =n2-rowcount;}
puse = localsizex*localsizey;
pgrid = (localsizex+1)*(localsizey+1);
k= 0;
k1=0;
k2=0;
for(i=Istart;i<Iend+1;i++){
for(j=rowcount;j<rowcount+localsizey+1;j++){
CX = (PetscScalar)(i*dx);
CY = (PetscScalar)(j*dy);
InverseStandardMap(&CX,&CY,c);
pi = (PetscInt)floor(CX*n);
pj = (PetscInt)floor(CY*n);
if(pj>=n2) {SkewSymmetricPoint(&pi, &pj, n);}
if(pi<col1){
*(NzindJ+k1) = (PetscInt)(n2*pi + pj);
*(idy+k1) = k;
k1++;
}else{
*(NzindJ+pgrid-k2-1) = (PetscInt)(n2*(pi-col1)+pj);
*(idy+pgrid-k2-1) = k;
k2++;
}
k++;
}
}
pgrid1 = k1;
pgrid2 = k2;
ierr = ISCreateGeneralWithArray(PETSC_COMM_SELF,pgrid1,NzindJ,&isx1);CHKERRQ(ierr);
ierr = ISCreateGeneralWithArray(PETSC_COMM_SELF,pgrid2,NzindJ+pgrid1,&isx2);CHKERRQ(ierr);
ierr = ISCreateGeneralWithArray(PETSC_COMM_SELF,pgrid1,idy,&isy1);CHKERRQ(ierr);
ierr = ISCreateGeneralWithArray(PETSC_COMM_SELF,pgrid2,idy+pgrid1,&isy2);CHKERRQ(ierr);
ierr = VecDestroy(y0);CHKERRQ(ierr);
ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,pgrid,pty0,&y0);CHKERRQ(ierr);
ierr = VecScatterCreate(x1,isx1,y0,isy1,&ctx1);CHKERRQ(ierr);
ierr = VecScatterCreate(x2,isx2,y0,isy2,&ctx2);CHKERRQ(ierr);
ierr = VecScatterBegin(x1,y0,INSERT_VALUES,SCATTER_FORWARD,ctx1);CHKERRQ(ierr);
ierr = VecScatterEnd(x1,y0,INSERT_VALUES,SCATTER_FORWARD,ctx1);CHKERRQ(ierr);
ierr = VecScatterBegin(x2,y0,INSERT_VALUES,SCATTER_FORWARD,ctx2);CHKERRQ(ierr);
ierr = VecScatterEnd(x2,y0,INSERT_VALUES,SCATTER_FORWARD,ctx2);CHKERRQ(ierr);
ierr = VecScatterDestroy(ctx1);
ierr = VecScatterDestroy(ctx2);
ierr = VecGetArray(y0,&pty0);CHKERRQ(ierr);
m = 0;
for(i=0;i<localsizex;i++){
for(j=0;j<localsizey;j++){
*(pty+i*n2+j+rowcount) = (*(pty0+i*(localsizey+1)+j)+
*(pty0+i*(localsizey+1)+j+1)+
*(pty0+(i+1)*(localsizey+1)+j)+
*(pty0+(i+1)*(localsizey+1)+j+1))/4;
m++;
}
}
VecRestoreArray(y0,&pty0);
VecRestoreArray(*y,&pty);
rowcount = rowcount + localsizey;
}
VecDestroy(x1);
VecDestroy(x2);
return 0;
}
void PETSC_STDCALL vecgetsize_(Vec x,PetscInt *size, int *__ierr ){
*__ierr = VecGetSize(
(Vec)PetscToPointer((x) ),size);
}
PetscErrorCode InitializeProblem(AppCtx *user)
{
PetscErrorCode ierr;
PetscViewer loader;
MPI_Comm comm;
PetscInt nrows,ncols,i;
PetscScalar one=1.0;
char filebase[128];
char filename[128];
PetscFunctionBegin;
comm = PETSC_COMM_WORLD;
ierr = PetscStrncpy(filebase,user->name,128);CHKERRQ(ierr);
ierr = PetscStrncat(filebase,"/",1);CHKERRQ(ierr);
ierr = PetscStrncpy(filename,filebase,128);CHKERRQ(ierr);
ierr = PetscStrncat(filename,"f",3);CHKERRQ(ierr);
ierr = PetscViewerBinaryOpen(comm,filename,FILE_MODE_READ,&loader);CHKERRQ(ierr);
ierr = VecCreate(comm,&user->d);CHKERRQ(ierr);
ierr = VecLoad(user->d,loader);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&loader);CHKERRQ(ierr);
ierr = VecGetSize(user->d,&nrows);CHKERRQ(ierr);
ierr = VecSetFromOptions(user->d);CHKERRQ(ierr);
user->n = nrows;
ierr = PetscStrncpy(filename,filebase,128);CHKERRQ(ierr);
ierr = PetscStrncat(filename,"H",3);CHKERRQ(ierr);
ierr = PetscViewerBinaryOpen(comm,filename,FILE_MODE_READ,&loader);CHKERRQ(ierr);
ierr = MatCreate(comm,&user->H);CHKERRQ(ierr);
ierr = MatSetSizes(user->H,PETSC_DECIDE,PETSC_DECIDE,nrows,nrows);CHKERRQ(ierr);
ierr = MatLoad(user->H,loader);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&loader);CHKERRQ(ierr);
ierr = MatGetSize(user->H,&nrows,&ncols);CHKERRQ(ierr);
if (nrows != user->n) SETERRQ(comm,0,"H: nrows != n\n");
if (ncols != user->n) SETERRQ(comm,0,"H: ncols != n\n");
ierr = MatSetFromOptions(user->H);CHKERRQ(ierr);
ierr = PetscStrncpy(filename,filebase,128);CHKERRQ(ierr);
ierr = PetscStrncat(filename,"Aeq",3);CHKERRQ(ierr);
ierr = PetscViewerBinaryOpen(comm,filename,FILE_MODE_READ,&loader);
if (ierr) {
user->Aeq = NULL;
user->me = 0;
} else {
ierr = MatCreate(comm,&user->Aeq);CHKERRQ(ierr);
ierr = MatLoad(user->Aeq,loader);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&loader);CHKERRQ(ierr);
ierr = MatGetSize(user->Aeq,&nrows,&ncols);CHKERRQ(ierr);
if (ncols != user->n) SETERRQ(comm,0,"Aeq ncols != H nrows\n");
ierr = MatSetFromOptions(user->Aeq);CHKERRQ(ierr);
user->me = nrows;
}
ierr = PetscStrncpy(filename,filebase,128);CHKERRQ(ierr);
ierr = PetscStrncat(filename,"Beq",3);CHKERRQ(ierr);
ierr = PetscViewerBinaryOpen(comm,filename,FILE_MODE_READ,&loader);CHKERRQ(ierr);
if (ierr) {
user->beq = 0;
} else {
ierr = VecCreate(comm,&user->beq);CHKERRQ(ierr);
ierr = VecLoad(user->beq,loader);CHKERRQ(ierr);
ierr = PetscViewerDestroy(&loader);CHKERRQ(ierr);
ierr = VecGetSize(user->beq,&nrows);CHKERRQ(ierr);
if (nrows != user->me) SETERRQ(comm,0,"Aeq nrows != Beq n\n");
ierr = VecSetFromOptions(user->beq);CHKERRQ(ierr);
}
user->mi = user->n;
/* Ain = eye(n,n) */
ierr = MatCreate(comm,&user->Ain);CHKERRQ(ierr);
ierr = MatSetType(user->Ain,MATAIJ);CHKERRQ(ierr);
ierr = MatSetSizes(user->Ain,PETSC_DECIDE,PETSC_DECIDE,user->mi,user->mi);CHKERRQ(ierr);
ierr = MatMPIAIJSetPreallocation(user->Ain,1,NULL,0,NULL);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(user->Ain,1,NULL);CHKERRQ(ierr);
for (i=0;i<user->mi;i++) {
ierr = MatSetValues(user->Ain,1,&i,1,&i,&one,INSERT_VALUES);CHKERRQ(ierr);
}
ierr = MatAssemblyBegin(user->Ain,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(user->Ain,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatSetFromOptions(user->Ain);CHKERRQ(ierr);
/* bin = [0,0 ... 0]' */
ierr = VecCreate(comm,&user->bin);CHKERRQ(ierr);
ierr = VecSetType(user->bin,VECMPI);CHKERRQ(ierr);
ierr = VecSetSizes(user->bin,PETSC_DECIDE,user->mi);CHKERRQ(ierr);
ierr = VecSet(user->bin,0.0);CHKERRQ(ierr);
ierr = VecSetFromOptions(user->bin);CHKERRQ(ierr);
user->m = user->me + user->mi;
PetscFunctionReturn(0);
}
int main(int argc,char **argv)
{
TS ts; /* time integrator */
SNES snes; /* nonlinear solver */
SNESLineSearch linesearch; /* line search */
Vec X; /* solution, residual vectors */
Mat J; /* Jacobian matrix */
PetscInt steps,maxsteps,mx;
PetscErrorCode ierr;
DM da;
PetscReal ftime,dt;
struct _User user; /* user-defined work context */
TSConvergedReason reason;
PetscInitialize(&argc,&argv,(char*)0,help);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create distributed array (DMDA) to manage parallel grid and vectors
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMDACreate1d(PETSC_COMM_WORLD,DMDA_BOUNDARY_NONE,-11,2,2,NULL,&da);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Extract global vectors from DMDA;
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMCreateGlobalVector(da,&X);CHKERRQ(ierr);
/* Initialize user application context */
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,NULL,"Advection-reaction options","");
{
user.a[0] = 1; ierr = PetscOptionsReal("-a0","Advection rate 0","",user.a[0],&user.a[0],NULL);CHKERRQ(ierr);
user.a[1] = 0; ierr = PetscOptionsReal("-a1","Advection rate 1","",user.a[1],&user.a[1],NULL);CHKERRQ(ierr);
user.k[0] = 1e6; ierr = PetscOptionsReal("-k0","Reaction rate 0","",user.k[0],&user.k[0],NULL);CHKERRQ(ierr);
user.k[1] = 2*user.k[0]; ierr = PetscOptionsReal("-k1","Reaction rate 1","",user.k[1],&user.k[1],NULL);CHKERRQ(ierr);
user.s[0] = 0; ierr = PetscOptionsReal("-s0","Source 0","",user.s[0],&user.s[0],NULL);CHKERRQ(ierr);
user.s[1] = 1; ierr = PetscOptionsReal("-s1","Source 1","",user.s[1],&user.s[1],NULL);CHKERRQ(ierr);
}
ierr = PetscOptionsEnd();CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create timestepping solver context
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetDM(ts,da);CHKERRQ(ierr);
ierr = TSSetType(ts,TSARKIMEX);CHKERRQ(ierr);
ierr = TSSetRHSFunction(ts,NULL,FormRHSFunction,&user);CHKERRQ(ierr);
ierr = TSSetIFunction(ts,NULL,FormIFunction,&user);CHKERRQ(ierr);
ierr = DMCreateMatrix(da,MATAIJ,&J);CHKERRQ(ierr);
ierr = TSSetIJacobian(ts,J,J,FormIJacobian,&user);CHKERRQ(ierr);
/* A line search in the nonlinear solve can fail due to ill-conditioning unless an absolute tolerance is set. Since
* this problem is linear, we deactivate the line search. For a linear problem, it is usually recommended to also use
* SNESSetType(snes,SNESKSPONLY). */
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
ierr = SNESGetLineSearch(snes,&linesearch);CHKERRQ(ierr);
ierr = SNESLineSearchSetType(linesearch,SNESLINESEARCHBASIC);CHKERRQ(ierr);
ftime = 1.0;
maxsteps = 10000;
ierr = TSSetDuration(ts,maxsteps,ftime);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set initial conditions
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = FormInitialSolution(ts,X,&user);CHKERRQ(ierr);
ierr = TSSetSolution(ts,X);CHKERRQ(ierr);
ierr = VecGetSize(X,&mx);CHKERRQ(ierr);
dt = .1 * PetscMax(user.a[0],user.a[1]) / mx; /* Advective CFL, I don't know why it needs so much safety factor. */
ierr = TSSetInitialTimeStep(ts,0.0,dt);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve nonlinear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,X);CHKERRQ(ierr);
ierr = TSGetSolveTime(ts,&ftime);CHKERRQ(ierr);
ierr = TSGetTimeStepNumber(ts,&steps);CHKERRQ(ierr);
ierr = TSGetConvergedReason(ts,&reason);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"%s at time %G after %D steps\n",TSConvergedReasons[reason],ftime,steps);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = MatDestroy(&J);CHKERRQ(ierr);
ierr = VecDestroy(&X);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = DMDestroy(&da);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
PetscErrorCode TSSetUp_Sundials(TS ts)
{
TS_Sundials *cvode = (TS_Sundials*)ts->data;
PetscErrorCode ierr;
PetscInt glosize,locsize,i,flag;
PetscScalar *y_data,*parray;
void *mem;
PC pc;
PCType pctype;
PetscBool pcnone;
PetscFunctionBegin;
/* get the vector size */
ierr = VecGetSize(ts->vec_sol,&glosize);CHKERRQ(ierr);
ierr = VecGetLocalSize(ts->vec_sol,&locsize);CHKERRQ(ierr);
/* allocate the memory for N_Vec y */
cvode->y = N_VNew_Parallel(cvode->comm_sundials,locsize,glosize);
if (!cvode->y) SETERRQ(PETSC_COMM_SELF,1,"cvode->y is not allocated");
/* initialize N_Vec y: copy ts->vec_sol to cvode->y */
ierr = VecGetArray(ts->vec_sol,&parray);CHKERRQ(ierr);
y_data = (PetscScalar*) N_VGetArrayPointer(cvode->y);
for (i = 0; i < locsize; i++) y_data[i] = parray[i];
ierr = VecRestoreArray(ts->vec_sol,NULL);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&cvode->update);CHKERRQ(ierr);
ierr = VecDuplicate(ts->vec_sol,&cvode->ydot);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)ts,(PetscObject)cvode->update);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)ts,(PetscObject)cvode->ydot);CHKERRQ(ierr);
/*
Create work vectors for the TSPSolve_Sundials() routine. Note these are
allocated with zero space arrays because the actual array space is provided
by Sundials and set using VecPlaceArray().
*/
ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)ts),1,locsize,PETSC_DECIDE,0,&cvode->w1);CHKERRQ(ierr);
ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)ts),1,locsize,PETSC_DECIDE,0,&cvode->w2);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)ts,(PetscObject)cvode->w1);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)ts,(PetscObject)cvode->w2);CHKERRQ(ierr);
/* Call CVodeCreate to create the solver memory and the use of a Newton iteration */
mem = CVodeCreate(cvode->cvode_type, CV_NEWTON);
if (!mem) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"CVodeCreate() fails");
cvode->mem = mem;
/* Set the pointer to user-defined data */
flag = CVodeSetUserData(mem, ts);
if (flag) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVodeSetUserData() fails");
/* Sundials may choose to use a smaller initial step, but will never use a larger step. */
flag = CVodeSetInitStep(mem,(realtype)ts->time_step);
if (flag) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_LIB,"CVodeSetInitStep() failed");
if (cvode->mindt > 0) {
flag = CVodeSetMinStep(mem,(realtype)cvode->mindt);
if (flag) {
if (flag == CV_MEM_NULL) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_LIB,"CVodeSetMinStep() failed, cvode_mem pointer is NULL");
else if (flag == CV_ILL_INPUT) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_LIB,"CVodeSetMinStep() failed, hmin is nonpositive or it exceeds the maximum allowable step size");
else SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_LIB,"CVodeSetMinStep() failed");
}
}
if (cvode->maxdt > 0) {
flag = CVodeSetMaxStep(mem,(realtype)cvode->maxdt);
if (flag) SETERRQ(PetscObjectComm((PetscObject)ts),PETSC_ERR_LIB,"CVodeSetMaxStep() failed");
}
/* Call CVodeInit to initialize the integrator memory and specify the
* user's right hand side function in u'=f(t,u), the inital time T0, and
* the initial dependent variable vector cvode->y */
flag = CVodeInit(mem,TSFunction_Sundials,ts->ptime,cvode->y);
if (flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVodeInit() fails, flag %d",flag);
/* specifies scalar relative and absolute tolerances */
flag = CVodeSStolerances(mem,cvode->reltol,cvode->abstol);
if (flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVodeSStolerances() fails, flag %d",flag);
/* Specify max num of steps to be taken by cvode in its attempt to reach the next output time */
flag = CVodeSetMaxNumSteps(mem,ts->max_steps);
/* call CVSpgmr to use GMRES as the linear solver. */
/* setup the ode integrator with the given preconditioner */
ierr = TSSundialsGetPC(ts,&pc);CHKERRQ(ierr);
ierr = PCGetType(pc,&pctype);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)pc,PCNONE,&pcnone);CHKERRQ(ierr);
if (pcnone) {
flag = CVSpgmr(mem,PREC_NONE,0);
if (flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVSpgmr() fails, flag %d",flag);
} else {
flag = CVSpgmr(mem,PREC_LEFT,cvode->maxl);
if (flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVSpgmr() fails, flag %d",flag);
/* Set preconditioner and solve routines Precond and PSolve,
and the pointer to the user-defined block data */
flag = CVSpilsSetPreconditioner(mem,TSPrecond_Sundials,TSPSolve_Sundials);
if (flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVSpilsSetPreconditioner() fails, flag %d", flag);
}
flag = CVSpilsSetGSType(mem, MODIFIED_GS);
if (flag) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"CVSpgmrSetGSType() fails, flag %d",flag);
PetscFunctionReturn(0);
}
PetscInt main(PetscInt argc,char **args)
{
PetscErrorCode ierr;
PetscMPIInt rank,size;
PetscInt N0=10,N1=10,N2=10,N3=10,N4=10,N=N0*N1*N2*N3*N4;
PetscRandom rdm;
PetscReal enorm;
Vec x,y,z,input,output;
Mat A;
PetscInt DIM, dim[5],vsize;
PetscReal fac;
ierr = PetscInitialize(&argc,&args,(char *)0,help);CHKERRQ(ierr);
ierr = MPI_Comm_size(PETSC_COMM_WORLD, &size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD, &rank);CHKERRQ(ierr);
if (size!=1)
SETERRQ(PETSC_COMM_WORLD,PETSC_ERR_SUP, "This is a uni-processor example only");
ierr = PetscRandomCreate(PETSC_COMM_SELF, &rdm);CHKERRQ(ierr);
ierr = PetscRandomSetFromOptions(rdm);CHKERRQ(ierr);
ierr = VecCreate(PETSC_COMM_SELF,&input);CHKERRQ(ierr);
ierr = VecSetSizes(input,N,N);CHKERRQ(ierr);
ierr = VecSetFromOptions(input);CHKERRQ(ierr);
ierr = VecSetRandom(input,rdm);CHKERRQ(ierr);
ierr = VecDuplicate(input,&output);
DIM = 5; dim[0] = N0; dim[1] = N1; dim[2] = N2; dim[3] = N3; dim[4] = N4;
ierr = MatCreateFFT(PETSC_COMM_SELF,DIM,dim,MATFFTW,&A);CHKERRQ(ierr);
ierr = MatGetVecs(A,&x,&y);CHKERRQ(ierr);
ierr = MatGetVecs(A,&z,PETSC_NULL);CHKERRQ(ierr);
ierr = VecGetSize(x,&vsize);CHKERRQ(ierr);
printf("The vector size of input from the main routine is %d\n",vsize);
ierr = VecGetSize(z,&vsize);CHKERRQ(ierr);
printf("The vector size of output from the main routine is %d\n",vsize);
ierr = InputTransformFFT(A,input,x);CHKERRQ(ierr);
ierr = MatMult(A,x,y);CHKERRQ(ierr);
ierr = MatMultTranspose(A,y,z);CHKERRQ(ierr);
ierr = OutputTransformFFT(A,z,output);CHKERRQ(ierr);
fac = 1.0/(PetscReal)N;
ierr = VecScale(output,fac);CHKERRQ(ierr);
/*
ierr = VecAssemblyBegin(input);CHKERRQ(ierr);
ierr = VecAssemblyEnd(input);CHKERRQ(ierr);
ierr = VecAssemblyBegin(output);CHKERRQ(ierr);
ierr = VecAssemblyEnd(output);CHKERRQ(ierr);
ierr = VecView(input,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = VecView(output,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
*/
ierr = VecAXPY(output,-1.0,input);CHKERRQ(ierr);
ierr = VecNorm(output,NORM_1,&enorm);CHKERRQ(ierr);
// if (enorm > 1.e-14){
ierr = PetscPrintf(PETSC_COMM_SELF," Error norm of |x - z| %e\n",enorm);CHKERRQ(ierr);
// }
ierr = VecDestroy(&output);CHKERRQ(ierr);
ierr = VecDestroy(&input);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&y);CHKERRQ(ierr);
ierr = VecDestroy(&z);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = PetscRandomDestroy(&rdm);CHKERRQ(ierr);
PetscFinalize();
return 0;
}
Vec SimpleNewtonNonlinearSolver::Solve(PetscErrorCode (*pComputeResidual)(SNES,Vec,Vec,void*),
PetscErrorCode (*pComputeJacobian)(SNES,Vec,Mat*,Mat*,MatStructure*,void*),
Vec initialGuess,
unsigned fill,
void* pContext)
{
PetscInt size;
VecGetSize(initialGuess, &size);
Vec current_solution;
VecDuplicate(initialGuess, ¤t_solution);
VecCopy(initialGuess, current_solution);
// The "false" says that we are allowed to do new mallocs without PETSc 3.3 causing an error
LinearSystem linear_system(current_solution, fill, false);
(*pComputeResidual)(NULL, current_solution, linear_system.rGetRhsVector(), pContext);
double residual_norm;
VecNorm(linear_system.rGetRhsVector(), NORM_2, &residual_norm);
double scaled_residual_norm = residual_norm/size;
if (mWriteStats)
{
std::cout << "Newton's method:\n Initial ||residual||/N = " << scaled_residual_norm
<< "\n Attempting to solve to tolerance " << mTolerance << "..\n";
}
double old_scaled_residual_norm;
unsigned counter = 0;
while (scaled_residual_norm > mTolerance)
{
counter++;
// Store the old norm to check with the new later
old_scaled_residual_norm = scaled_residual_norm;
// Compute Jacobian and solve J dx = f for the (negative) update dx, (J the jacobian, f the residual)
(*pComputeJacobian)(NULL, current_solution, &(linear_system.rGetLhsMatrix()), NULL, NULL, pContext);
Vec negative_update = linear_system.Solve();
Vec test_vec;
VecDuplicate(initialGuess, &test_vec);
double best_damping_factor = 1.0;
double best_scaled_residual = 1e20; // large
// Loop over all the possible damping value and determine which gives smallest residual
for (unsigned i=0; i<mTestDampingValues.size(); i++)
{
// Note: WAXPY calls VecWAXPY(w,a,x,y) which computes w = ax+y
PetscVecTools::WAXPY(test_vec,-mTestDampingValues[i],negative_update,current_solution);
// Compute new residual
linear_system.ZeroLinearSystem();
(*pComputeResidual)(NULL, test_vec, linear_system.rGetRhsVector(), pContext);
VecNorm(linear_system.rGetRhsVector(), NORM_2, &residual_norm);
scaled_residual_norm = residual_norm/size;
if (scaled_residual_norm < best_scaled_residual)
{
best_scaled_residual = scaled_residual_norm;
best_damping_factor = mTestDampingValues[i];
}
}
PetscTools::Destroy(test_vec);
// Check the smallest residual was actually smaller than the previous; if not, quit
if (best_scaled_residual > old_scaled_residual_norm)
{
// Free memory
PetscTools::Destroy(current_solution);
PetscTools::Destroy(negative_update);
// Raise error
EXCEPTION("Iteration " << counter << ", unable to find damping factor such that residual decreases in update direction");
}
if (mWriteStats)
{
std::cout << " Best damping factor = " << best_damping_factor << "\n";
}
// Update solution: current_guess = current_solution - best_damping_factor*negative_update
PetscVecTools::AddScaledVector(current_solution, negative_update, -best_damping_factor);
scaled_residual_norm = best_scaled_residual;
PetscTools::Destroy(negative_update);
// Compute best residual vector again and store in linear_system for next Solve()
linear_system.ZeroLinearSystem();
(*pComputeResidual)(NULL, current_solution, linear_system.rGetRhsVector(), pContext);
if (mWriteStats)
{
std::cout << " Iteration " << counter << ": ||residual||/N = " << scaled_residual_norm << "\n";
}
}
if (mWriteStats)
{
std::cout << " ..solved!\n\n";
}
return current_solution;
}
/*@C
SNESObjectiveComputeFunctionDefaultFD - Computes the gradient of a user provided objective
Collective on SNES
Input Parameter:
+ snes - the SNES context
. X - the state vector
- ctx - the (ignored) function context
Output Parameter:
. F - the function value
Options Database Key:
+ -snes_fd_function_eps - The differencing parameter
- -snes_fd_function - Compute function from user provided objective with finite difference
Notes:
SNESObjectiveComputeFunctionDefaultFD is similar in character to SNESComputeJacobianDefault.
Therefore, it should be used for debugging purposes only. Using it in conjunction with
SNESComputeJacobianDefault is excessively costly and produces a Jacobian that is quite
noisy. This is often necessary, but should be done with a grain of salt, even when debugging
small problems.
Note that this uses quadratic interpolation of the objective to form each value in the function.
Level: advanced
.keywords: SNES, objective, debugging, finite differences, function
.seealso: SNESSetFunction(), SNESComputeObjective(), SNESComputeJacobianDefault()
@*/
PetscErrorCode SNESObjectiveComputeFunctionDefaultFD(SNES snes,Vec X,Vec F,void *ctx)
{
Vec Xh;
PetscErrorCode ierr;
PetscInt i,N,start,end;
PetscReal ob,ob1,ob2,ob3,fob,dx,eps=1e-6;
PetscScalar fv,xv;
PetscFunctionBegin;
ierr = VecDuplicate(X,&Xh);CHKERRQ(ierr);
ierr = PetscOptionsReal("-snes_fd_function_eps","Tolerance for nonzero entries in fd function","None",eps,&eps,NULL);CHKERRQ(ierr);
ierr = VecSet(F,0.);CHKERRQ(ierr);
ierr = VecNorm(X,NORM_2,&fob);CHKERRQ(ierr);
ierr = VecGetSize(X,&N);CHKERRQ(ierr);
ierr = VecGetOwnershipRange(X,&start,&end);CHKERRQ(ierr);
ierr = SNESComputeObjective(snes,X,&ob);CHKERRQ(ierr);
if (fob > 0.) dx =1e-6*fob;
else dx = 1e-6;
for (i=0; i<N; i++) {
/* compute the 1st value */
ierr = VecCopy(X,Xh);CHKERRQ(ierr);
if (i>= start && i<end) {
xv = dx;
ierr = VecSetValues(Xh,1,&i,&xv,ADD_VALUES);CHKERRQ(ierr);
}
ierr = VecAssemblyBegin(Xh);CHKERRQ(ierr);
ierr = VecAssemblyEnd(Xh);CHKERRQ(ierr);
ierr = SNESComputeObjective(snes,Xh,&ob1);CHKERRQ(ierr);
/* compute the 2nd value */
ierr = VecCopy(X,Xh);CHKERRQ(ierr);
if (i>= start && i<end) {
xv = 2.*dx;
ierr = VecSetValues(Xh,1,&i,&xv,ADD_VALUES);CHKERRQ(ierr);
}
ierr = VecAssemblyBegin(Xh);CHKERRQ(ierr);
ierr = VecAssemblyEnd(Xh);CHKERRQ(ierr);
ierr = SNESComputeObjective(snes,Xh,&ob2);CHKERRQ(ierr);
/* compute the 3rd value */
ierr = VecCopy(X,Xh);CHKERRQ(ierr);
if (i>= start && i<end) {
xv = -dx;
ierr = VecSetValues(Xh,1,&i,&xv,ADD_VALUES);CHKERRQ(ierr);
}
ierr = VecAssemblyBegin(Xh);CHKERRQ(ierr);
ierr = VecAssemblyEnd(Xh);CHKERRQ(ierr);
ierr = SNESComputeObjective(snes,Xh,&ob3);CHKERRQ(ierr);
if (i >= start && i<end) {
/* set this entry to be the gradient of the objective */
fv = (-ob2 + 6.*ob1 - 3.*ob -2.*ob3) / (6.*dx);
if (PetscAbsScalar(fv) > eps) {
ierr = VecSetValues(F,1,&i,&fv,INSERT_VALUES);CHKERRQ(ierr);
} else {
fv = 0.;
ierr = VecSetValues(F,1,&i,&fv,INSERT_VALUES);CHKERRQ(ierr);
}
}
}
ierr = VecDestroy(&Xh);CHKERRQ(ierr);
ierr = VecAssemblyBegin(F);CHKERRQ(ierr);
ierr = VecAssemblyEnd(F);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
/*
Takes the local part of an already assembled MPIAIJ matrix
and disassembles it. This is to allow new nonzeros into the matrix
that require more communication in the matrix vector multiply.
Thus certain data-structures must be rebuilt.
Kind of slow! But that's what application programmers get when
they are sloppy.
*/
PetscErrorCode MatDisAssemble_MPIAIJ(Mat A)
{
Mat_MPIAIJ *aij = (Mat_MPIAIJ*)A->data;
Mat B = aij->B,Bnew;
Mat_SeqAIJ *Baij = (Mat_SeqAIJ*)B->data;
PetscErrorCode ierr;
PetscInt i,j,m = B->rmap->n,n = A->cmap->N,col,ct = 0,*garray = aij->garray,*nz,ec;
PetscScalar v;
PetscFunctionBegin;
/* free stuff related to matrix-vec multiply */
ierr = VecGetSize(aij->lvec,&ec);CHKERRQ(ierr); /* needed for PetscLogObjectMemory below */
ierr = VecDestroy(&aij->lvec);CHKERRQ(ierr);
if (aij->colmap) {
#if defined(PETSC_USE_CTABLE)
ierr = PetscTableDestroy(&aij->colmap);CHKERRQ(ierr);
#else
ierr = PetscFree(aij->colmap);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)A,-aij->B->cmap->n*sizeof(PetscInt));CHKERRQ(ierr);
#endif
}
/* make sure that B is assembled so we can access its values */
ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* invent new B and copy stuff over */
ierr = PetscMalloc1(m+1,&nz);CHKERRQ(ierr);
for (i=0; i<m; i++) {
nz[i] = Baij->i[i+1] - Baij->i[i];
}
ierr = MatCreate(PETSC_COMM_SELF,&Bnew);CHKERRQ(ierr);
ierr = MatSetSizes(Bnew,m,n,m,n);CHKERRQ(ierr);
ierr = MatSetBlockSizesFromMats(Bnew,A,A);CHKERRQ(ierr);
ierr = MatSetType(Bnew,((PetscObject)B)->type_name);CHKERRQ(ierr);
ierr = MatSeqAIJSetPreallocation(Bnew,0,nz);CHKERRQ(ierr);
if (Baij->nonew >= 0) { /* Inherit insertion error options (if positive). */
((Mat_SeqAIJ*)Bnew->data)->nonew = Baij->nonew;
}
/*
Ensure that B's nonzerostate is monotonically increasing.
Or should this follow the MatSetValues() loop to preserve B's nonzerstate across a MatDisAssemble() call?
*/
Bnew->nonzerostate = B->nonzerostate;
ierr = PetscFree(nz);CHKERRQ(ierr);
for (i=0; i<m; i++) {
for (j=Baij->i[i]; j<Baij->i[i+1]; j++) {
col = garray[Baij->j[ct]];
v = Baij->a[ct++];
ierr = MatSetValues(Bnew,1,&i,1,&col,&v,B->insertmode);CHKERRQ(ierr);
}
}
ierr = PetscFree(aij->garray);CHKERRQ(ierr);
ierr = PetscLogObjectMemory((PetscObject)A,-ec*sizeof(PetscInt));CHKERRQ(ierr);
ierr = MatDestroy(&B);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)A,(PetscObject)Bnew);CHKERRQ(ierr);
aij->B = Bnew;
A->was_assembled = PETSC_FALSE;
PetscFunctionReturn(0);
}
/*
This should handle properly the cases where PetscInt is 32 or 64 and hsize_t is 32 or 64. These means properly casting with
checks back and forth between the two types of variables.
*/
PetscErrorCode VecLoad_HDF5(Vec xin, PetscViewer viewer)
{
hid_t file_id, group, dset_id, filespace, memspace, plist_id;
hsize_t rdim, dim;
hsize_t dims[4], count[4], offset[4];
herr_t status;
PetscInt n, N, bs = 1, bsInd, lenInd, low, timestep;
PetscScalar *x;
const char *vecname;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = PetscViewerHDF5OpenGroup(viewer, &file_id, &group);CHKERRQ(ierr);
ierr = PetscViewerHDF5GetTimestep(viewer, ×tep);CHKERRQ(ierr);
ierr = VecGetBlockSize(xin,&bs);CHKERRQ(ierr);
/* Create the dataset with default properties and close filespace */
ierr = PetscObjectGetName((PetscObject)xin,&vecname);CHKERRQ(ierr);
#if (H5_VERS_MAJOR * 10000 + H5_VERS_MINOR * 100 + H5_VERS_RELEASE >= 10800)
dset_id = H5Dopen2(group, vecname, H5P_DEFAULT);
#else
dset_id = H5Dopen(group, vecname);
#endif
if (dset_id == -1) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Could not H5Dopen() with Vec named %s",vecname);
/* Retrieve the dataspace for the dataset */
filespace = H5Dget_space(dset_id);
if (filespace == -1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Could not H5Dget_space()");
dim = 0;
if (timestep >= 0) ++dim;
++dim;
if (bs >= 1) ++dim;
#if defined(PETSC_USE_COMPLEX)
++dim;
#endif
rdim = H5Sget_simple_extent_dims(filespace, dims, NULL);
#if defined(PETSC_USE_COMPLEX)
bsInd = rdim-2;
#else
bsInd = rdim-1;
#endif
lenInd = timestep >= 0 ? 1 : 0;
if (rdim != dim) {
if (rdim == dim+1 && bs == -1) bs = dims[bsInd];
else SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED, "Dimension of array in file %d not %d as expected",rdim,dim);
} else if (bs >= 1 && bs != (PetscInt) dims[bsInd]) SETERRQ2(PETSC_COMM_SELF, PETSC_ERR_FILE_UNEXPECTED, "Block size %d specified for vector does not match blocksize in file %d",bs,dims[bsInd]);
/* Set Vec sizes,blocksize,and type if not already set */
if ((xin)->map->n < 0 && (xin)->map->N < 0) {
ierr = VecSetSizes(xin, PETSC_DECIDE, dims[lenInd]*bs);CHKERRQ(ierr);
}
/* If sizes and type already set,check if the vector global size is correct */
ierr = VecGetSize(xin, &N);CHKERRQ(ierr);
if (N/bs != (PetscInt) dims[lenInd]) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED, "Vector in file different length (%d) then input vector (%d)", (PetscInt) dims[lenInd], N/bs);
/* Each process defines a dataset and reads it from the hyperslab in the file */
ierr = VecGetLocalSize(xin, &n);CHKERRQ(ierr);
dim = 0;
if (timestep >= 0) {
count[dim] = 1;
++dim;
}
ierr = PetscHDF5IntCast(n/bs,count + dim);CHKERRQ(ierr);
++dim;
if (bs >= 1) {
count[dim] = bs;
++dim;
}
#if defined(PETSC_USE_COMPLEX)
count[dim] = 2;
++dim;
#endif
memspace = H5Screate_simple(dim, count, NULL);
if (memspace == -1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Could not H5Screate_simple()");
/* Select hyperslab in the file */
ierr = VecGetOwnershipRange(xin, &low, NULL);CHKERRQ(ierr);
dim = 0;
if (timestep >= 0) {
offset[dim] = timestep;
++dim;
}
ierr = PetscHDF5IntCast(low/bs,offset + dim);CHKERRQ(ierr);
++dim;
if (bs >= 1) {
offset[dim] = 0;
++dim;
}
#if defined(PETSC_USE_COMPLEX)
offset[dim] = 0;
++dim;
#endif
status = H5Sselect_hyperslab(filespace, H5S_SELECT_SET, offset, NULL, count, NULL);CHKERRQ(status);
/* Create property list for collective dataset read */
plist_id = H5Pcreate(H5P_DATASET_XFER);
if (plist_id == -1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Could not H5Pcreate()");
#if defined(PETSC_HAVE_H5PSET_FAPL_MPIO)
status = H5Pset_dxpl_mpio(plist_id, H5FD_MPIO_COLLECTIVE);CHKERRQ(status);
#endif
/* To write dataset independently use H5Pset_dxpl_mpio(plist_id, H5FD_MPIO_INDEPENDENT) */
ierr = VecGetArray(xin, &x);CHKERRQ(ierr);
status = H5Dread(dset_id, H5T_NATIVE_DOUBLE, memspace, filespace, plist_id, x);CHKERRQ(status);
ierr = VecRestoreArray(xin, &x);CHKERRQ(ierr);
/* Close/release resources */
if (group != file_id) {
status = H5Gclose(group);CHKERRQ(status);
}
status = H5Pclose(plist_id);CHKERRQ(status);
status = H5Sclose(filespace);CHKERRQ(status);
status = H5Sclose(memspace);CHKERRQ(status);
status = H5Dclose(dset_id);CHKERRQ(status);
ierr = VecAssemblyBegin(xin);CHKERRQ(ierr);
ierr = VecAssemblyEnd(xin);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
