int main(int argc,char **argv)
{
PetscErrorCode ierr;
int time; /* amount of loops */
struct in put;
PetscScalar rh; /* relative humidity */
PetscScalar x; /* memory varialbe for relative humidity calculation */
PetscScalar deep_grnd_temp; /* temperature of ground under top soil surface layer */
PetscScalar emma; /* absorption-emission constant for air */
PetscScalar pressure1 = 101300; /* surface pressure */
PetscScalar mixratio; /* mixing ratio */
PetscScalar airtemp; /* temperature of air near boundary layer inversion */
PetscScalar dewtemp; /* dew point temperature */
PetscScalar sfctemp; /* temperature at surface */
PetscScalar pwat; /* total column precipitable water */
PetscScalar cloudTemp; /* temperature at base of cloud */
AppCtx user; /* user-defined work context */
MonitorCtx usermonitor; /* user-defined monitor context */
PetscMPIInt rank,size;
TS ts;
SNES snes;
DM da;
Vec T,rhs; /* solution vector */
Mat J; /* Jacobian matrix */
PetscReal ftime,dt;
PetscInt steps,dof = 5;
PetscBool use_coloring = PETSC_TRUE;
MatFDColoring matfdcoloring = 0;
PetscBool monitor_off = PETSC_FALSE;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
/* Inputs */
readinput(&put);
sfctemp = put.Ts;
dewtemp = put.Td;
cloudTemp = put.Tc;
airtemp = put.Ta;
pwat = put.pwt;
if (!rank) PetscPrintf(PETSC_COMM_SELF,"Initial Temperature = %g\n",(double)sfctemp); /* input surface temperature */
deep_grnd_temp = sfctemp - 10; /* set underlying ground layer temperature */
emma = emission(pwat); /* accounts for radiative effects of water vapor */
/* Converts from Fahrenheit to Celsuis */
sfctemp = fahr_to_cel(sfctemp);
airtemp = fahr_to_cel(airtemp);
dewtemp = fahr_to_cel(dewtemp);
cloudTemp = fahr_to_cel(cloudTemp);
deep_grnd_temp = fahr_to_cel(deep_grnd_temp);
/* Converts from Celsius to Kelvin */
sfctemp += 273;
airtemp += 273;
dewtemp += 273;
cloudTemp += 273;
deep_grnd_temp += 273;
/* Calculates initial relative humidity */
x = calcmixingr(dewtemp,pressure1);
mixratio = calcmixingr(sfctemp,pressure1);
rh = (x/mixratio)*100;
if (!rank) printf("Initial RH = %.1f percent\n\n",(double)rh); /* prints initial relative humidity */
time = 3600*put.time; /* sets amount of timesteps to run model */
/* Configure PETSc TS solver */
/*------------------------------------------*/
/* Create grid */
ierr = DMDACreate2d(PETSC_COMM_WORLD,DM_BOUNDARY_PERIODIC,DM_BOUNDARY_PERIODIC,DMDA_STENCIL_STAR,-20,-20,
PETSC_DECIDE,PETSC_DECIDE,dof,1,NULL,NULL,&da);CHKERRQ(ierr);
ierr = DMDASetUniformCoordinates(da, 0.0, 1.0, 0.0, 1.0, 0.0, 1.0);CHKERRQ(ierr);
/* Define output window for each variable of interest */
ierr = DMDASetFieldName(da,0,"Ts");CHKERRQ(ierr);
ierr = DMDASetFieldName(da,1,"Ta");CHKERRQ(ierr);
ierr = DMDASetFieldName(da,2,"u");CHKERRQ(ierr);
ierr = DMDASetFieldName(da,3,"v");CHKERRQ(ierr);
ierr = DMDASetFieldName(da,4,"p");CHKERRQ(ierr);
/* set values for appctx */
user.da = da;
user.Ts = sfctemp;
user.fract = put.fr; /* fraction of sky covered by clouds */
user.dewtemp = dewtemp; /* dew point temperature (mositure in air) */
user.csoil = 2000000; /* heat constant for layer */
user.dzlay = 0.08; /* thickness of top soil layer */
user.emma = emma; /* emission parameter */
user.wind = put.wnd; /* wind spped */
user.pressure1 = pressure1; /* sea level pressure */
user.airtemp = airtemp; /* temperature of air near boundar layer inversion */
user.Tc = cloudTemp; /* temperature at base of lowest cloud layer */
user.init = put.init; /* user chosen initiation scenario */
user.lat = 70*0.0174532; /* converts latitude degrees to latitude in radians */
user.deep_grnd_temp = deep_grnd_temp; /* temp in lowest ground layer */
/* set values for MonitorCtx */
usermonitor.drawcontours = PETSC_FALSE;
ierr = PetscOptionsHasName(NULL,NULL,"-drawcontours",&usermonitor.drawcontours);CHKERRQ(ierr);
if (usermonitor.drawcontours) {
PetscReal bounds[] = {1000.0,-1000., -1000.,-1000., 1000.,-1000., 1000.,-1000., 1000,-1000, 100700,100800};
ierr = PetscViewerDrawOpen(PETSC_COMM_WORLD,0,0,0,0,300,300,&usermonitor.drawviewer);CHKERRQ(ierr);
ierr = PetscViewerDrawSetBounds(usermonitor.drawviewer,dof,bounds);CHKERRQ(ierr);
}
usermonitor.interval = 1;
ierr = PetscOptionsGetInt(NULL,NULL,"-monitor_interval",&usermonitor.interval,NULL);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Extract global vectors from DA;
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMCreateGlobalVector(da,&T);CHKERRQ(ierr);
ierr = VecDuplicate(T,&rhs);CHKERRQ(ierr); /* r: vector to put the computed right hand side */
ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr);
ierr = TSSetProblemType(ts,TS_NONLINEAR);CHKERRQ(ierr);
ierr = TSSetType(ts,TSBEULER);CHKERRQ(ierr);
ierr = TSSetRHSFunction(ts,rhs,RhsFunc,&user);CHKERRQ(ierr);
/* Set Jacobian evaluation routine - use coloring to compute finite difference Jacobian efficiently */
ierr = DMSetMatType(da,MATAIJ);CHKERRQ(ierr);
ierr = DMCreateMatrix(da,&J);CHKERRQ(ierr);
ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr);
if (use_coloring) {
ISColoring iscoloring;
ierr = DMCreateColoring(da,IS_COLORING_GLOBAL,&iscoloring);CHKERRQ(ierr);
ierr = MatFDColoringCreate(J,iscoloring,&matfdcoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetFromOptions(matfdcoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetUp(J,iscoloring,matfdcoloring);CHKERRQ(ierr);
ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr);
ierr = MatFDColoringSetFunction(matfdcoloring,(PetscErrorCode (*)(void))SNESTSFormFunction,ts);CHKERRQ(ierr);
ierr = SNESSetJacobian(snes,J,J,SNESComputeJacobianDefaultColor,matfdcoloring);CHKERRQ(ierr);
} else {
ierr = SNESSetJacobian(snes,J,J,SNESComputeJacobianDefault,NULL);CHKERRQ(ierr);
}
/* Define what to print for ts_monitor option */
ierr = PetscOptionsHasName(NULL,NULL,"-monitor_off",&monitor_off);CHKERRQ(ierr);
if (!monitor_off) {
ierr = TSMonitorSet(ts,Monitor,&usermonitor,NULL);CHKERRQ(ierr);
}
ierr = FormInitialSolution(da,T,&user);CHKERRQ(ierr);
dt = TIMESTEP; /* initial time step */
ftime = TIMESTEP*time;
if (!rank) printf("time %d, ftime %g hour, TIMESTEP %g\n",time,(double)(ftime/3600),(double)dt);
ierr = TSSetInitialTimeStep(ts,0.0,dt);CHKERRQ(ierr);
ierr = TSSetDuration(ts,time,ftime);CHKERRQ(ierr);
ierr = TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);CHKERRQ(ierr);
ierr = TSSetSolution(ts,T);CHKERRQ(ierr);
ierr = TSSetDM(ts,da);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSetFromOptions(ts);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve nonlinear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = TSSolve(ts,T);CHKERRQ(ierr);
ierr = TSGetSolveTime(ts,&ftime);CHKERRQ(ierr);
ierr = TSGetTimeStepNumber(ts,&steps);CHKERRQ(ierr);
if (!rank) PetscPrintf(PETSC_COMM_WORLD,"Solution T after %g hours %d steps\n",(double)(ftime/3600),steps);
if (matfdcoloring) {ierr = MatFDColoringDestroy(&matfdcoloring);CHKERRQ(ierr);}
if (usermonitor.drawcontours) {
ierr = PetscViewerDestroy(&usermonitor.drawviewer);CHKERRQ(ierr);
}
ierr = MatDestroy(&J);CHKERRQ(ierr);
ierr = VecDestroy(&T);CHKERRQ(ierr);
ierr = VecDestroy(&rhs);CHKERRQ(ierr);
ierr = TSDestroy(&ts);CHKERRQ(ierr);
ierr = DMDestroy(&da);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
int main(int argc,char **argv)
{
PetscErrorCode ierr;
SNES snes; /* nonlinear solver */
Vec Hu; /* solution vector */
AppCtx user; /* user-defined work context */
ExactCtx exact;
PetscInt its; /* snes reports iteration count */
SNESConvergedReason reason; /* snes reports convergence */
PetscReal tmp1, tmp2, tmp3,
errnorms[2], scaleNode[2], descaleNode[2];
PetscInt i;
char dumpfile[80],dxdocstr[80];
PetscBool eps_set = PETSC_FALSE,
dump = PETSC_FALSE,
exactinitial = PETSC_FALSE,
snes_mf_set, snes_fd_set, dx_set;
PetscInitialize(&argc,&argv,(char *)0,help);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD, &user.rank); CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,
"MARINE solves for thickness and velocity in 1D, steady marine ice sheet\n"
" [run with -help for info and options]\n");CHKERRQ(ierr);
user.n = 3.0; /* Glen flow law exponent */
user.secpera = 31556926.0;
user.rho = 910.0; /* kg m^-3 */
user.rhow = 1028.0; /* kg m^-3 */
user.omega = 1.0 - user.rho / user.rhow;
user.g = 9.81; /* m s^-2 */
/* get parameters of exact solution */
ierr = params_exactBod(&tmp1, &(exact.L0), &(exact.xg), &tmp2, &tmp3, &(user.k)); CHKERRQ(ierr);
ierr = exactBod(exact.xg,&(exact.Hg),&tmp2,&(exact.Mg)); CHKERRQ(ierr);
ierr = exactBodBueler(exact.xg,&tmp1,&(exact.Bg)); CHKERRQ(ierr);
user.zocean = user.rho * exact.Hg / user.rhow;
/* see ../marineshoot.py: */
#define xa_default 0.2
#define xc_default 0.98
/* define interval [xa,xc] */
user.xa = xa_default * exact.L0;
user.xc = xc_default * exact.L0;
/* get Dirichlet boundary conditions, and mass balance on shelf */
ierr = exactBod(user.xa, &(user.Ha), &(user.ua), &tmp1); CHKERRQ(ierr);
/* regularize using strain rate of 1/(length) per year */
user.epsilon = (1.0 / user.secpera) / (user.xc - user.xa);
/*user.epsilon = 0.0;*/
user.Hscale = 1000.0;
user.uscale = 100.0 / user.secpera;
user.noscale = PETSC_FALSE;
user.dx = 10000.0; /* default to coarse 10 km grid */
ierr = PetscOptionsBegin(PETSC_COMM_WORLD,
"","options to marine (steady marine ice sheet solver)","");CHKERRQ(ierr);
{
ierr = PetscOptionsBool("-snes_mf","","",PETSC_FALSE,&snes_mf_set,NULL);CHKERRQ(ierr);
ierr = PetscOptionsBool("-snes_fd","","",PETSC_FALSE,&snes_fd_set,NULL);CHKERRQ(ierr);
ierr = PetscOptionsBool("-noscale","","",PETSC_FALSE,&user.noscale,NULL);CHKERRQ(ierr);
snprintf(dxdocstr,80,"target grid spacing (m) on interval of length %.0f m",
user.xc-user.xa);
ierr = PetscOptionsReal("-dx",dxdocstr,"",user.dx,&user.dx,&dx_set);CHKERRQ(ierr);
ierr = PetscOptionsBool("-exactinit",
"initialize using exact solution instead of default linear function","",
PETSC_FALSE,&exactinitial,NULL);CHKERRQ(ierr);
ierr = PetscOptionsString("-dump",
"dump approx and exact solution into given file (as ascii matlab format)","",
NULL,dumpfile,80,&dump);CHKERRQ(ierr);
ierr = PetscOptionsReal("-epsilon","regularizing strain rate for stress computation (a-1)","",
user.epsilon * user.secpera,&user.epsilon,&eps_set);CHKERRQ(ierr);
if (eps_set) user.epsilon *= 1.0 / user.secpera;
}
ierr = PetscOptionsEnd();CHKERRQ(ierr);
if (snes_fd_set) {
ierr = PetscPrintf(PETSC_COMM_WORLD,
" using approximate Jacobian; finite-differencing using coloring\n");
CHKERRQ(ierr);
} else if (snes_mf_set) {
ierr = PetscPrintf(PETSC_COMM_WORLD,
" matrix free; no preconditioner\n"); CHKERRQ(ierr);
} else {
ierr = PetscPrintf(PETSC_COMM_WORLD,
" true Jacobian\n"); CHKERRQ(ierr);
}
if (dx_set && (user.dx <= 0.0)) {
PetscPrintf(PETSC_COMM_WORLD,
"\n***ERROR: -dx value must be positive ... USAGE FOLLOWS ...\n\n%s",help);
PetscEnd();
}
user.N = (int)ceil( ((user.xc - user.xa) / user.dx) - 0.5 );
user.Mx = user.N + 2;
user.dx = (user.xc - user.xa) / ((PetscReal)(user.N) + 0.5); /* recompute so dx * (N+1/2) = xc - xa */
if (dx_set && (user.dx < 1.0)) {
PetscPrintf(PETSC_COMM_WORLD,
"\n***WARNING: '-dx %.3f' meters is below one meter and creates grid of %d points\n"
" ... probably uncomputable!\n\n",
user.dx,user.Mx);
}
/* residual scaling coeffs; motivation at right */
user.rscHa = 1.0 / user.Hscale, /* Dirichlet cond for H */
user.rscua = 1.0 / user.uscale, /* Dirichlet cond for u */
user.rscuH = user.dx / (user.Hscale * user.uscale), /* flux derivative d(uH)/dx */
user.rscstress = 1.0 / (user.k * user.rho * user.g * user.Hscale * user.uscale), /* beta term in SSA */
user.rsccalv = 1.0 / (0.025 * user.rho * user.g * user.Hscale); /* 0.5 * omega * overburden */
/* Create machinery for parallel grid management (DMDA), nonlinear solver (SNES),
and Vecs for fields (solution, RHS). Degrees of freedom = 2 (thickness and
velocity at each point). */
ierr = DMDACreate1d(PETSC_COMM_WORLD,DMDA_BOUNDARY_NONE,user.Mx,2,1,PETSC_NULL,&user.da);
CHKERRQ(ierr);
ierr = DMSetApplicationContext(user.da,&user);CHKERRQ(ierr);
ierr = DMDASetFieldName(user.da,0,"ice thickness [non-dimensional]"); CHKERRQ(ierr);
ierr = DMDASetFieldName(user.da,1,"ice velocity [non-dimensional]"); CHKERRQ(ierr);
ierr = DMSetFromOptions(user.da); CHKERRQ(ierr);
ierr = DMDAGetInfo(user.da,PETSC_IGNORE,&user.Mx,PETSC_IGNORE,
PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,
PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE,
PETSC_IGNORE,PETSC_IGNORE,PETSC_IGNORE);CHKERRQ(ierr);
ierr = DMDAGetCorners(user.da,&user.xs,PETSC_NULL,PETSC_NULL,&user.xm,PETSC_NULL,PETSC_NULL);
CHKERRQ(ierr);
/* another DMDA for scalar staggered parameters; one fewer point */
ierr = DMDACreate1d(PETSC_COMM_WORLD,DMDA_BOUNDARY_NONE,user.Mx-1,1,1,PETSC_NULL,&user.stagda);
CHKERRQ(ierr);
/* establish geometry on grid; note xa = x_0 and xc = x_{N+1/2} */
ierr = DMDASetUniformCoordinates(user.da, user.xa, user.xc+0.5*user.dx,
0.0,1.0,0.0,1.0);CHKERRQ(ierr);
ierr = DMDASetUniformCoordinates(user.stagda,user.xa+0.5*user.dx,user.xc,
0.0,1.0,0.0,1.0);CHKERRQ(ierr);
/* report on current grid */
ierr = PetscPrintf(PETSC_COMM_WORLD,
" grid: Mx = N+2 = %D regular points, dx = %.3f m, xa = %.2f km, xc = %.2f km\n",
user.Mx, user.dx, user.xa/1000.0, user.xc/1000.0);CHKERRQ(ierr);
/* Extract/allocate global vectors from DMDAs and duplicate for remaining same types */
ierr = DMCreateGlobalVector(user.da,&Hu);CHKERRQ(ierr);
ierr = VecSetBlockSize(Hu,2);CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject)Hu,"Hu");CHKERRQ(ierr);
ierr = VecDuplicate(Hu,&exact.Hu);CHKERRQ(ierr); /* inherits block size */
ierr = PetscObjectSetName((PetscObject)exact.Hu,"exactHu");CHKERRQ(ierr);
ierr = DMCreateGlobalVector(user.stagda,&user.Mstag);CHKERRQ(ierr);
ierr = VecDuplicate(user.Mstag,&user.Bstag);CHKERRQ(ierr);
/* set up snes */
ierr = SNESCreate(PETSC_COMM_WORLD,&snes);CHKERRQ(ierr);
ierr = SNESSetDM(snes,user.da);CHKERRQ(ierr);
ierr = DMDASNESSetFunctionLocal(user.da,INSERT_VALUES,(DMDASNESFunction)scshell,&user);CHKERRQ(ierr);
ierr = DMDASNESSetJacobianLocal(user.da,(DMDASNESJacobian)JacobianMatrixLocal,&user);CHKERRQ(ierr);
ierr = SNESSetFromOptions(snes);CHKERRQ(ierr);
/* the exact thickness and exact ice velocity (user.uHexact) are known */
ierr = FillExactSoln(&exact, &user); CHKERRQ(ierr);
/* the exact solution allows setting M(x), B(x) */
ierr = FillDistributedParams(&exact, &user);CHKERRQ(ierr);
if (exactinitial) {
ierr = PetscPrintf(PETSC_COMM_WORLD," using exact solution as initial guess\n"); CHKERRQ(ierr);
/* the initial guess is the exact continuum solution */
ierr = VecCopy(exact.Hu,Hu); CHKERRQ(ierr);
} else {
/* the initial guess is a linear solution */
ierr = FillInitial(&user, &Hu); CHKERRQ(ierr);
}
/************ SOLVE NONLINEAR SYSTEM ************/
/* recall that RHS r is used internally by KSP, and is set by the SNES */
if (user.noscale) {
user.Hscale = 1.0;
user.uscale = 1.0;
}
scaleNode[0] = user.Hscale;
scaleNode[1] = user.uscale;
for (i = 0; i < 2; i++) descaleNode[i] = 1.0 / scaleNode[i];
ierr = VecStrideScaleAll(Hu,descaleNode); CHKERRQ(ierr); /* de-dimensionalize initial guess */
ierr = SNESSolve(snes,PETSC_NULL,Hu);CHKERRQ(ierr);
ierr = VecStrideScaleAll(Hu,scaleNode); CHKERRQ(ierr); /* put back in "real" scale */
/* minimal report on solve */
ierr = SNESGetIterationNumber(snes,&its);CHKERRQ(ierr);
ierr = SNESGetConvergedReason(snes,&reason);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,
" %s Number of Newton iterations = %D\n",
SNESConvergedReasons[reason],its);CHKERRQ(ierr);
if (dump) {
ierr = PetscPrintf(PETSC_COMM_WORLD,
"dumping results in ascii matlab format to file '%s' ...\n",dumpfile);CHKERRQ(ierr);
PetscViewer viewer;
ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,dumpfile,&viewer);CHKERRQ(ierr);
ierr = PetscViewerSetFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
DM coord_da;
Vec coord_x;
ierr = DMGetCoordinateDM(user.da, &coord_da); CHKERRQ(ierr);
ierr = DMGetCoordinates(user.da, &coord_x); CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"%% START MATLAB\n"); CHKERRQ(ierr);
ierr = PetscObjectSetName((PetscObject)coord_x,"x");CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"%% viewing coordinate vector x \n");CHKERRQ(ierr);
ierr = VecView(coord_x,viewer); CHKERRQ(ierr);
ierr = VecView(Hu,viewer); CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"%% viewing combined result Hu\n");CHKERRQ(ierr);
ierr = VecView(Hu,viewer); CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"%% viewing combined exact result exactHu\n");CHKERRQ(ierr);
ierr = VecView(exact.Hu,viewer); CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,
"%% defining plottable variables and plotting in Matlab\n"
"Mx = %d; secpera = 31556926.0;\n"
"H = Hu(1:2:2*Mx-1);\n"
"u = Hu(2:2:2*Mx);\n"
"exactH = exactHu(1:2:2*Mx-1);\n"
"exactu = exactHu(2:2:2*Mx);\n"
"figure, plot(x,H,x,exactH);\n"
"legend('numerical','exact'), xlabel x, ylabel('H (m)')\n"
"figure, plot(x,u*secpera,x,exactu*secpera);\n"
"legend('numerical','exact'), xlabel x, ylabel('u (m/a)')\n"
"figure, subplot(2,1,1), semilogy(x,abs(H-exactH));\n"
"ylabel('H error (m)'), grid\n"
"subplot(2,1,2), semilogy(x,abs(u-exactu)*secpera);\n"
"xlabel x, ylabel('u error (m/a)'), grid\n",
user.Mx); CHKERRQ(ierr);
ierr = PetscViewerASCIIPrintf(viewer,"%% END MATLAB\n"); CHKERRQ(ierr);
ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
}
/* evaluate error relative to exact solution */
ierr = VecAXPY(Hu,-1.0,exact.Hu); CHKERRQ(ierr); /* Hu = - Huexact + Hu */
ierr = VecStrideNormAll(Hu,NORM_INFINITY,errnorms); CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,
"(dx,errHinf,erruinf) %.3f %.4e %.4e\n",
user.dx,errnorms[0],errnorms[1]*user.secpera);CHKERRQ(ierr);
ierr = VecDestroy(&Hu);CHKERRQ(ierr);
ierr = VecDestroy(&(exact.Hu));CHKERRQ(ierr);
ierr = VecDestroy(&(user.Mstag));CHKERRQ(ierr);
ierr = VecDestroy(&(user.Bstag));CHKERRQ(ierr);
ierr = SNESDestroy(&snes);CHKERRQ(ierr);
ierr = DMDestroy(&(user.da));CHKERRQ(ierr);
ierr = DMDestroy(&(user.stagda));CHKERRQ(ierr);
ierr = PetscFinalize();CHKERRQ(ierr);
return 0;
}
int main(int argc,char **argv)
{
PetscErrorCode ierr;
ObsCtx user;
SNES snes;
DM da;
Vec u, /* solution */
Xu; /* upper bound */
DMDALocalInfo info;
PetscReal error1,errorinf;
ierr = PetscInitialize(&argc,&argv,(char*)0,help);if (ierr) return ierr;
ierr = DMDACreate2d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE, DM_BOUNDARY_NONE,DMDA_STENCIL_STAR,11,11,/* default to 10x10 grid */
PETSC_DECIDE,PETSC_DECIDE, /* number of processors in each dimension */1,/* dof = 1 */1,/* s = 1; stencil extends out one cell */
NULL,NULL,/* do not specify processor decomposition */&da);CHKERRQ(ierr);
ierr = DMSetFromOptions(da);CHKERRQ(ierr);
ierr = DMSetUp(da);CHKERRQ(ierr);
ierr = DMCreateGlobalVector(da,&u);CHKERRQ(ierr);
ierr = VecDuplicate(u,&(user.uexact));CHKERRQ(ierr);
ierr = VecDuplicate(u,&(user.psi));CHKERRQ(ierr);
ierr = DMDASetUniformCoordinates(da,-2.0,2.0,-2.0,2.0,0.0,1.0);CHKERRQ(ierr);
ierr = DMSetApplicationContext(da,&user);CHKERRQ(ierr);
ierr = FormPsiAndExactSoln(da);CHKERRQ(ierr);
ierr = VecSet(u,0.0);CHKERRQ(ierr);
ierr = SNESCreate(PETSC_COMM_WORLD,&snes);CHKERRQ(ierr);
ierr = SNESSetDM(snes,da);CHKERRQ(ierr);
ierr = SNESSetApplicationContext(snes,&user);CHKERRQ(ierr);
ierr = SNESSetType(snes,SNESVINEWTONRSLS);CHKERRQ(ierr);
/* set upper and lower bound constraints for VI */
ierr = VecDuplicate(u,&Xu);CHKERRQ(ierr);
ierr = VecSet(Xu,PETSC_INFINITY);CHKERRQ(ierr);
ierr = SNESVISetVariableBounds(snes,user.psi,Xu);CHKERRQ(ierr);
ierr = VecDestroy(&Xu);CHKERRQ(ierr);
ierr = DMDASNESSetFunctionLocal(da,INSERT_VALUES,(PetscErrorCode (*)(DMDALocalInfo*,void*,void*,void*))FormFunctionLocal,&user);CHKERRQ(ierr);
ierr = DMDASNESSetJacobianLocal(da,(PetscErrorCode (*)(DMDALocalInfo*,void*,Mat,Mat,void*))FormJacobianLocal,&user);CHKERRQ(ierr);
ierr = SNESSetFromOptions(snes);CHKERRQ(ierr);
/* report on setup */
ierr = DMDAGetLocalInfo(da,&info); CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"setup done: grid Mx,My = %D,%D with spacing dx,dy = %.4f,%.4f\n",
info.mx,info.my,(double)(4.0/(PetscReal)(info.mx-1)),(double)(4.0/(PetscReal)(info.my-1)));CHKERRQ(ierr);
/* solve nonlinear system */
ierr = SNESSolve(snes,NULL,u);CHKERRQ(ierr);
/* compare to exact */
ierr = VecAXPY(u,-1.0,user.uexact);CHKERRQ(ierr); /* u <- u - uexact */
ierr = VecNorm(u,NORM_1,&error1);CHKERRQ(ierr);
error1 /= (PetscReal)info.mx * (PetscReal)info.my;
ierr = VecNorm(u,NORM_INFINITY,&errorinf);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"errors: av |u-uexact| = %.3e |u-uexact|_inf = %.3e\n",(double)error1,(double)errorinf);CHKERRQ(ierr);
/* Free work space. */
ierr = VecDestroy(&u);CHKERRQ(ierr);
ierr = VecDestroy(&(user.psi));CHKERRQ(ierr);
ierr = VecDestroy(&(user.uexact));CHKERRQ(ierr);
ierr = SNESDestroy(&snes);CHKERRQ(ierr);
ierr = DMDestroy(&da);CHKERRQ(ierr);
ierr = PetscFinalize();CHKERRQ(ierr);
return 0;
}
int main(int argc,char **argv)
{
SNES snes; /* nonlinear solver */
AppCtx user; /* user-defined work context */
PetscInt its; /* iterations for convergence */
PetscErrorCode ierr;
DM da;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Initialize program
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
PetscInitialize(&argc,&argv,(char*)0,help);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Initialize problem parameters
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PetscOptionsBegin(PETSC_COMM_WORLD, "", "Surface Process Problem Options", "SNES");CHKERRQ(ierr);
user.D = 1.0;
ierr = PetscOptionsReal("-D", "The diffusion coefficient D", __FILE__, user.D, &user.D, NULL);CHKERRQ(ierr);
user.K = 1.0;
ierr = PetscOptionsReal("-K", "The advection coefficient K", __FILE__, user.K, &user.K, NULL);CHKERRQ(ierr);
user.m = 1;
ierr = PetscOptionsInt("-m", "The exponent for A", __FILE__, user.m, &user.m, NULL);CHKERRQ(ierr);
ierr = PetscOptionsEnd();CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create distributed array (DMDA) to manage parallel grid and vectors
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMDACreate2d(PETSC_COMM_WORLD, DMDA_BOUNDARY_NONE, DMDA_BOUNDARY_NONE,DMDA_STENCIL_STAR,-4,-4,PETSC_DECIDE,PETSC_DECIDE,1,1,NULL,NULL,&da);CHKERRQ(ierr);
ierr = DMDASetUniformCoordinates(da, 0.0, 1.0, 0.0, 1.0, 0.0, 1.0);CHKERRQ(ierr);
ierr = DMSetApplicationContext(da,&user);CHKERRQ(ierr);
ierr = SNESCreate(PETSC_COMM_WORLD, &snes);CHKERRQ(ierr);
ierr = SNESSetDM(snes, da);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Set local function evaluation routine
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = DMDASNESSetFunctionLocal(da,INSERT_VALUES,(PetscErrorCode (*)(DMDALocalInfo*,void*,void*,void*))FormFunctionLocal,&user);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Customize solver; set runtime options
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = SNESSetFromOptions(snes);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Solve nonlinear system
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = SNESSolve(snes,0,0);CHKERRQ(ierr);
ierr = SNESGetIterationNumber(snes,&its);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = PetscPrintf(PETSC_COMM_WORLD,"Number of SNES iterations = %D\n",its);CHKERRQ(ierr);
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Free work space. All PETSc objects should be destroyed when they
are no longer needed.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
ierr = SNESDestroy(&snes);CHKERRQ(ierr);
ierr = DMDestroy(&da);CHKERRQ(ierr);
ierr = PetscFinalize();
PetscFunctionReturn(0);
}
