Actual source code: ex10.c
1: static const char help[] = "1D nonequilibrium radiation diffusion with Saha ionization model.\n\n";
3: /*
4: This example implements the model described in
6: Rauenzahn, Mousseau, Knoll. "Temporal accuracy of the nonequilibrium radiation diffusion
7: equations employing a Saha ionization model" 2005.
9: The paper discusses three examples, the first two are nondimensional with a simple
10: ionization model. The third example is fully dimensional and uses the Saha ionization
11: model with realistic parameters.
12: */
14: #include <petscts.h>
15: #include <petscdm.h>
16: #include <petscdmda.h>
18: typedef enum {BC_DIRICHLET,BC_NEUMANN,BC_ROBIN} BCType;
19: static const char *const BCTypes[] = {"DIRICHLET","NEUMANN","ROBIN","BCType","BC_",0};
20: typedef enum {JACOBIAN_ANALYTIC,JACOBIAN_MATRIXFREE,JACOBIAN_FD_COLORING,JACOBIAN_FD_FULL} JacobianType;
21: static const char *const JacobianTypes[] = {"ANALYTIC","MATRIXFREE","FD_COLORING","FD_FULL","JacobianType","FD_",0};
22: typedef enum {DISCRETIZATION_FD,DISCRETIZATION_FE} DiscretizationType;
23: static const char *const DiscretizationTypes[] = {"FD","FE","DiscretizationType","DISCRETIZATION_",0};
24: typedef enum {QUADRATURE_GAUSS1,QUADRATURE_GAUSS2,QUADRATURE_GAUSS3,QUADRATURE_GAUSS4,QUADRATURE_LOBATTO2,QUADRATURE_LOBATTO3} QuadratureType;
25: static const char *const QuadratureTypes[] = {"GAUSS1","GAUSS2","GAUSS3","GAUSS4","LOBATTO2","LOBATTO3","QuadratureType","QUADRATURE_",0};
27: typedef struct {
28: PetscScalar E; /* radiation energy */
29: PetscScalar T; /* material temperature */
30: } RDNode;
32: typedef struct {
33: PetscReal meter,kilogram,second,Kelvin; /* Fundamental units */
34: PetscReal Joule,Watt; /* Derived units */
35: } RDUnit;
37: typedef struct _n_RD *RD;
39: struct _n_RD {
40: void (*MaterialEnergy)(RD,const RDNode*,PetscScalar*,RDNode*);
41: DM da;
42: PetscBool monitor_residual;
43: DiscretizationType discretization;
44: QuadratureType quadrature;
45: JacobianType jacobian;
46: PetscInt initial;
47: BCType leftbc;
48: PetscBool view_draw;
49: char view_binary[PETSC_MAX_PATH_LEN];
50: PetscBool test_diff;
51: PetscBool endpoint;
52: PetscBool bclimit;
53: PetscBool bcmidpoint;
54: RDUnit unit;
56: /* model constants, see Table 2 and RDCreate() */
57: PetscReal rho,K_R,K_p,I_H,m_p,m_e,h,k,c,sigma_b,beta,gamma;
59: /* Domain and boundary conditions */
60: PetscReal Eapplied; /* Radiation flux from the left */
61: PetscReal L; /* Length of domain */
62: PetscReal final_time;
63: };
65: static PetscErrorCode RDDestroy(RD *rd)
66: {
70: DMDestroy(&(*rd)->da);
71: PetscFree(*rd);
72: return(0);
73: }
75: /* The paper has a time derivative for material energy (Eq 2) which is a dependent variable (computable from temperature
76: * and density through an uninvertible relation). Computing this derivative is trivial for trapezoid rule (used in the
77: * paper), but does not generalize nicely to higher order integrators. Here we use the implicit form which provides
78: * time derivatives of the independent variables (radiation energy and temperature), so we must compute the time
79: * derivative of material energy ourselves (could be done using AD).
80: *
81: * There are multiple ionization models, this interface dispatches to the one currently in use.
82: */
83: static void RDMaterialEnergy(RD rd,const RDNode *n,PetscScalar *Em,RDNode *dEm) { rd->MaterialEnergy(rd,n,Em,dEm); }
85: /* Solves a quadratic equation while propagating tangents */
86: static void QuadraticSolve(PetscScalar a,PetscScalar a_t,PetscScalar b,PetscScalar b_t,PetscScalar c,PetscScalar c_t,PetscScalar *x,PetscScalar *x_t)
87: {
88: PetscScalar
89: disc = b*b - 4.*a*c,
90: disc_t = 2.*b*b_t - 4.*a_t*c - 4.*a*c_t,
91: num = -b + PetscSqrtScalar(disc), /* choose positive sign */
92: num_t = -b_t + 0.5/PetscSqrtScalar(disc)*disc_t,
93: den = 2.*a,
94: den_t = 2.*a_t;
95: *x = num/den;
96: *x_t = (num_t*den - num*den_t) / PetscSqr(den);
97: }
99: /* The primary model presented in the paper */
100: static void RDMaterialEnergy_Saha(RD rd,const RDNode *n,PetscScalar *inEm,RDNode *dEm)
101: {
102: PetscScalar Em,alpha,alpha_t,
103: T = n->T,
104: T_t = 1.,
105: chi = rd->I_H / (rd->k * T),
106: chi_t = -chi / T * T_t,
107: a = 1.,
108: a_t = 0,
109: b = 4. * rd->m_p / rd->rho * PetscPowScalarReal(2. * PETSC_PI * rd->m_e * rd->I_H / PetscSqr(rd->h),1.5) * PetscExpScalar(-chi) * PetscPowScalarReal(chi,1.5), /* Eq 7 */
110: b_t = -b*chi_t + 1.5*b/chi*chi_t,
111: c = -b,
112: c_t = -b_t;
113: QuadraticSolve(a,a_t,b,b_t,c,c_t,&alpha,&alpha_t); /* Solve Eq 7 for alpha */
114: Em = rd->k * T / rd->m_p * (1.5*(1.+alpha) + alpha*chi); /* Eq 6 */
115: if (inEm) *inEm = Em;
116: if (dEm) {
117: dEm->E = 0;
118: dEm->T = Em / T * T_t + rd->k * T / rd->m_p * (1.5*alpha_t + alpha_t*chi + alpha*chi_t);
119: }
120: }
121: /* Reduced ionization model, Eq 30 */
122: static void RDMaterialEnergy_Reduced(RD rd,const RDNode *n,PetscScalar *Em,RDNode *dEm)
123: {
124: PetscScalar alpha,alpha_t,
125: T = n->T,
126: T_t = 1.,
127: chi = -0.3 / T,
128: chi_t = -chi / T * T_t,
129: a = 1.,
130: a_t = 0.,
131: b = PetscExpScalar(chi),
132: b_t = b*chi_t,
133: c = -b,
134: c_t = -b_t;
135: QuadraticSolve(a,a_t,b,b_t,c,c_t,&alpha,&alpha_t);
136: if (Em) *Em = (1.+alpha)*T + 0.3*alpha;
137: if (dEm) {
138: dEm->E = 0;
139: dEm->T = alpha_t*T + (1.+alpha)*T_t + 0.3*alpha_t;
140: }
141: }
143: /* Eq 5 */
144: static void RDSigma_R(RD rd,RDNode *n,PetscScalar *sigma_R,RDNode *dsigma_R)
145: {
146: *sigma_R = rd->K_R * rd->rho * PetscPowScalar(n->T,-rd->gamma);
147: dsigma_R->E = 0;
148: dsigma_R->T = -rd->gamma * (*sigma_R) / n->T;
149: }
151: /* Eq 4 */
152: static void RDDiffusionCoefficient(RD rd,PetscBool limit,RDNode *n,RDNode *nx,PetscScalar *D_R,RDNode *dD_R,RDNode *dxD_R)
153: {
154: PetscScalar sigma_R,denom;
155: RDNode dsigma_R,ddenom,dxdenom;
157: RDSigma_R(rd,n,&sigma_R,&dsigma_R);
158: denom = 3. * rd->rho * sigma_R + (int)limit * PetscAbsScalar(nx->E) / n->E;
159: ddenom.E = -(int)limit * PetscAbsScalar(nx->E) / PetscSqr(n->E);
160: ddenom.T = 3. * rd->rho * dsigma_R.T;
161: dxdenom.E = (int)limit * (PetscRealPart(nx->E)<0 ? -1. : 1.) / n->E;
162: dxdenom.T = 0;
163: *D_R = rd->c / denom;
164: if (dD_R) {
165: dD_R->E = -rd->c / PetscSqr(denom) * ddenom.E;
166: dD_R->T = -rd->c / PetscSqr(denom) * ddenom.T;
167: }
168: if (dxD_R) {
169: dxD_R->E = -rd->c / PetscSqr(denom) * dxdenom.E;
170: dxD_R->T = -rd->c / PetscSqr(denom) * dxdenom.T;
171: }
172: }
174: static PetscErrorCode RDStateView(RD rd,Vec X,Vec Xdot,Vec F)
175: {
177: DMDALocalInfo info;
178: PetscInt i;
179: const RDNode *x,*xdot,*f;
180: MPI_Comm comm;
183: PetscObjectGetComm((PetscObject)rd->da,&comm);
184: DMDAGetLocalInfo(rd->da,&info);
185: DMDAVecGetArrayRead(rd->da,X,(void*)&x);
186: DMDAVecGetArrayRead(rd->da,Xdot,(void*)&xdot);
187: DMDAVecGetArrayRead(rd->da,F,(void*)&f);
188: for (i=info.xs; i<info.xs+info.xm; i++) {
189: PetscSynchronizedPrintf(comm,"x[%D] (%10.2G,%10.2G) (%10.2G,%10.2G) (%10.2G,%10.2G)\n",i,PetscRealPart(x[i].E),PetscRealPart(x[i].T),
190: PetscRealPart(xdot[i].E),PetscRealPart(xdot[i].T), PetscRealPart(f[i].E),PetscRealPart(f[i].T));
191: }
192: DMDAVecRestoreArrayRead(rd->da,X,(void*)&x);
193: DMDAVecRestoreArrayRead(rd->da,Xdot,(void*)&xdot);
194: DMDAVecRestoreArrayRead(rd->da,F,(void*)&f);
195: PetscSynchronizedFlush(comm,PETSC_STDOUT);
196: return(0);
197: }
199: static PetscScalar RDRadiation(RD rd,const RDNode *n,RDNode *dn)
200: {
201: PetscScalar sigma_p = rd->K_p * rd->rho * PetscPowScalar(n->T,-rd->beta),
202: sigma_p_T = -rd->beta * sigma_p / n->T,
203: tmp = 4.* rd->sigma_b*PetscSqr(PetscSqr(n->T)) / rd->c - n->E,
204: tmp_E = -1.,
205: tmp_T = 4. * rd->sigma_b * 4 * n->T*(PetscSqr(n->T)) / rd->c,
206: rad = sigma_p * rd->c * rd->rho * tmp,
207: rad_E = sigma_p * rd->c * rd->rho * tmp_E,
208: rad_T = rd->c * rd->rho * (sigma_p_T * tmp + sigma_p * tmp_T);
209: if (dn) {
210: dn->E = rad_E;
211: dn->T = rad_T;
212: }
213: return rad;
214: }
216: static PetscScalar RDDiffusion(RD rd,PetscReal hx,const RDNode x[],PetscInt i,RDNode d[])
217: {
218: PetscReal ihx = 1./hx;
219: RDNode n_L,nx_L,n_R,nx_R,dD_L,dxD_L,dD_R,dxD_R,dfluxL[2],dfluxR[2];
220: PetscScalar D_L,D_R,fluxL,fluxR;
222: n_L.E = 0.5*(x[i-1].E + x[i].E);
223: n_L.T = 0.5*(x[i-1].T + x[i].T);
224: nx_L.E = (x[i].E - x[i-1].E)/hx;
225: nx_L.T = (x[i].T - x[i-1].T)/hx;
226: RDDiffusionCoefficient(rd,PETSC_TRUE,&n_L,&nx_L,&D_L,&dD_L,&dxD_L);
227: fluxL = D_L*nx_L.E;
228: dfluxL[0].E = -ihx*D_L + (0.5*dD_L.E - ihx*dxD_L.E)*nx_L.E;
229: dfluxL[1].E = +ihx*D_L + (0.5*dD_L.E + ihx*dxD_L.E)*nx_L.E;
230: dfluxL[0].T = (0.5*dD_L.T - ihx*dxD_L.T)*nx_L.E;
231: dfluxL[1].T = (0.5*dD_L.T + ihx*dxD_L.T)*nx_L.E;
233: n_R.E = 0.5*(x[i].E + x[i+1].E);
234: n_R.T = 0.5*(x[i].T + x[i+1].T);
235: nx_R.E = (x[i+1].E - x[i].E)/hx;
236: nx_R.T = (x[i+1].T - x[i].T)/hx;
237: RDDiffusionCoefficient(rd,PETSC_TRUE,&n_R,&nx_R,&D_R,&dD_R,&dxD_R);
238: fluxR = D_R*nx_R.E;
239: dfluxR[0].E = -ihx*D_R + (0.5*dD_R.E - ihx*dxD_R.E)*nx_R.E;
240: dfluxR[1].E = +ihx*D_R + (0.5*dD_R.E + ihx*dxD_R.E)*nx_R.E;
241: dfluxR[0].T = (0.5*dD_R.T - ihx*dxD_R.T)*nx_R.E;
242: dfluxR[1].T = (0.5*dD_R.T + ihx*dxD_R.T)*nx_R.E;
244: if (d) {
245: d[0].E = -ihx*dfluxL[0].E;
246: d[0].T = -ihx*dfluxL[0].T;
247: d[1].E = ihx*(dfluxR[0].E - dfluxL[1].E);
248: d[1].T = ihx*(dfluxR[0].T - dfluxL[1].T);
249: d[2].E = ihx*dfluxR[1].E;
250: d[2].T = ihx*dfluxR[1].T;
251: }
252: return ihx*(fluxR - fluxL);
253: }
255: static PetscErrorCode RDGetLocalArrays(RD rd,TS ts,Vec X,Vec Xdot,PetscReal *Theta,PetscReal *dt,Vec *X0loc,RDNode **x0,Vec *Xloc,RDNode **x,Vec *Xloc_t,RDNode **xdot)
256: {
258: PetscBool istheta;
261: DMGetLocalVector(rd->da,X0loc);
262: DMGetLocalVector(rd->da,Xloc);
263: DMGetLocalVector(rd->da,Xloc_t);
265: DMGlobalToLocalBegin(rd->da,X,INSERT_VALUES,*Xloc);
266: DMGlobalToLocalEnd(rd->da,X,INSERT_VALUES,*Xloc);
267: DMGlobalToLocalBegin(rd->da,Xdot,INSERT_VALUES,*Xloc_t);
268: DMGlobalToLocalEnd(rd->da,Xdot,INSERT_VALUES,*Xloc_t);
270: /*
271: The following is a hack to subvert TSTHETA which is like an implicit midpoint method to behave more like a trapezoid
272: rule. These methods have equivalent linear stability, but the nonlinear stability is somewhat different. The
273: radiation system is inconvenient to write in explicit form because the ionization model is "on the left".
274: */
275: PetscObjectTypeCompare((PetscObject)ts,TSTHETA,&istheta);
276: if (istheta && rd->endpoint) {
277: TSThetaGetTheta(ts,Theta);
278: } else *Theta = 1.;
280: TSGetTimeStep(ts,dt);
281: VecWAXPY(*X0loc,-(*Theta)*(*dt),*Xloc_t,*Xloc); /* back out the value at the start of this step */
282: if (rd->endpoint) {
283: VecWAXPY(*Xloc,*dt,*Xloc_t,*X0loc); /* move the abscissa to the end of the step */
284: }
286: DMDAVecGetArray(rd->da,*X0loc,x0);
287: DMDAVecGetArray(rd->da,*Xloc,x);
288: DMDAVecGetArray(rd->da,*Xloc_t,xdot);
289: return(0);
290: }
292: static PetscErrorCode RDRestoreLocalArrays(RD rd,Vec *X0loc,RDNode **x0,Vec *Xloc,RDNode **x,Vec *Xloc_t,RDNode **xdot)
293: {
297: DMDAVecRestoreArray(rd->da,*X0loc,x0);
298: DMDAVecRestoreArray(rd->da,*Xloc,x);
299: DMDAVecRestoreArray(rd->da,*Xloc_t,xdot);
300: DMRestoreLocalVector(rd->da,X0loc);
301: DMRestoreLocalVector(rd->da,Xloc);
302: DMRestoreLocalVector(rd->da,Xloc_t);
303: return(0);
304: }
306: static PetscErrorCode RDCheckDomain_Private(RD rd,TS ts,Vec X,PetscBool *in)
307: {
309: PetscInt minloc;
310: PetscReal min;
313: VecMin(X,&minloc,&min);
314: if (min < 0) {
315: SNES snes;
316: *in = PETSC_FALSE;
317: TSGetSNES(ts,&snes);
318: SNESSetFunctionDomainError(snes);
319: PetscInfo3(ts,"Domain violation at %D field %D value %g\n",minloc/2,minloc%2,(double)min);
320: } else *in = PETSC_TRUE;
321: return(0);
322: }
324: /* Energy and temperature must remain positive */
325: #define RDCheckDomain(rd,ts,X) do { \
326: PetscErrorCode _ierr; \
327: PetscBool _in; \
328: _RDCheckDomain_Private(rd,ts,X,&_in);CHKERRQ(_ierr); \
329: if (!_in) return(0); \
330: } while (0)
332: static PetscErrorCode RDIFunction_FD(TS ts,PetscReal t,Vec X,Vec Xdot,Vec F,void *ctx)
333: {
335: RD rd = (RD)ctx;
336: RDNode *x,*x0,*xdot,*f;
337: Vec X0loc,Xloc,Xloc_t;
338: PetscReal hx,Theta,dt;
339: DMDALocalInfo info;
340: PetscInt i;
343: RDCheckDomain(rd,ts,X);
344: RDGetLocalArrays(rd,ts,X,Xdot,&Theta,&dt,&X0loc,&x0,&Xloc,&x,&Xloc_t,&xdot);
345: DMDAVecGetArray(rd->da,F,&f);
346: DMDAGetLocalInfo(rd->da,&info);
347: VecZeroEntries(F);
349: hx = rd->L / (info.mx-1);
351: for (i=info.xs; i<info.xs+info.xm; i++) {
352: PetscReal rho = rd->rho;
353: PetscScalar Em_t,rad;
355: rad = (1.-Theta)*RDRadiation(rd,&x0[i],0) + Theta*RDRadiation(rd,&x[i],0);
356: if (rd->endpoint) {
357: PetscScalar Em0,Em1;
358: RDMaterialEnergy(rd,&x0[i],&Em0,NULL);
359: RDMaterialEnergy(rd,&x[i],&Em1,NULL);
360: Em_t = (Em1 - Em0) / dt;
361: } else {
362: RDNode dEm;
363: RDMaterialEnergy(rd,&x[i],NULL,&dEm);
364: Em_t = dEm.E * xdot[i].E + dEm.T * xdot[i].T;
365: }
366: /* Residuals are multiplied by the volume element (hx). */
367: /* The temperature equation does not have boundary conditions */
368: f[i].T = hx*(rho*Em_t + rad);
370: if (i == 0) { /* Left boundary condition */
371: PetscScalar D_R,bcTheta = rd->bcmidpoint ? Theta : 1.;
372: RDNode n, nx;
374: n.E = (1.-bcTheta)*x0[0].E + bcTheta*x[0].E;
375: n.T = (1.-bcTheta)*x0[0].T + bcTheta*x[0].T;
376: nx.E = ((1.-bcTheta)*(x0[1].E-x0[0].E) + bcTheta*(x[1].E-x[0].E))/hx;
377: nx.T = ((1.-bcTheta)*(x0[1].T-x0[0].T) + bcTheta*(x[1].T-x[0].T))/hx;
378: switch (rd->leftbc) {
379: case BC_ROBIN:
380: RDDiffusionCoefficient(rd,rd->bclimit,&n,&nx,&D_R,0,0);
381: f[0].E = hx*(n.E - 2. * D_R * nx.E - rd->Eapplied);
382: break;
383: case BC_NEUMANN:
384: f[0].E = x[1].E - x[0].E;
385: break;
386: default: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Case %D",rd->initial);
387: }
388: } else if (i == info.mx-1) { /* Right boundary */
389: f[i].E = x[i].E - x[i-1].E; /* Homogeneous Neumann */
390: } else {
391: PetscScalar diff = (1.-Theta)*RDDiffusion(rd,hx,x0,i,0) + Theta*RDDiffusion(rd,hx,x,i,0);
392: f[i].E = hx*(xdot[i].E - diff - rad);
393: }
394: }
395: RDRestoreLocalArrays(rd,&X0loc,&x0,&Xloc,&x,&Xloc_t,&xdot);
396: DMDAVecRestoreArray(rd->da,F,&f);
397: if (rd->monitor_residual) {RDStateView(rd,X,Xdot,F);}
398: return(0);
399: }
401: static PetscErrorCode RDIJacobian_FD(TS ts,PetscReal t,Vec X,Vec Xdot,PetscReal a,Mat A,Mat B,void *ctx)
402: {
404: RD rd = (RD)ctx;
405: RDNode *x,*x0,*xdot;
406: Vec X0loc,Xloc,Xloc_t;
407: PetscReal hx,Theta,dt;
408: DMDALocalInfo info;
409: PetscInt i;
412: RDCheckDomain(rd,ts,X);
413: RDGetLocalArrays(rd,ts,X,Xdot,&Theta,&dt,&X0loc,&x0,&Xloc,&x,&Xloc_t,&xdot);
414: DMDAGetLocalInfo(rd->da,&info);
415: hx = rd->L / (info.mx-1);
416: MatZeroEntries(B);
418: for (i=info.xs; i<info.xs+info.xm; i++) {
419: PetscInt col[3];
420: PetscReal rho = rd->rho;
421: PetscScalar /*Em_t,rad,*/ K[2][6];
422: RDNode dEm_t,drad;
424: /*rad = (1.-Theta)* */ RDRadiation(rd,&x0[i],0); /* + Theta* */ RDRadiation(rd,&x[i],&drad);
426: if (rd->endpoint) {
427: PetscScalar Em0,Em1;
428: RDNode dEm1;
429: RDMaterialEnergy(rd,&x0[i],&Em0,NULL);
430: RDMaterialEnergy(rd,&x[i],&Em1,&dEm1);
431: /*Em_t = (Em1 - Em0) / (Theta*dt);*/
432: dEm_t.E = dEm1.E / (Theta*dt);
433: dEm_t.T = dEm1.T / (Theta*dt);
434: } else {
435: const PetscScalar epsilon = x[i].T * PETSC_SQRT_MACHINE_EPSILON;
436: RDNode n1;
437: RDNode dEm,dEm1;
438: PetscScalar Em_TT;
440: n1.E = x[i].E;
441: n1.T = x[i].T+epsilon;
442: RDMaterialEnergy(rd,&x[i],NULL,&dEm);
443: RDMaterialEnergy(rd,&n1,NULL,&dEm1);
444: /* The Jacobian needs another derivative. We finite difference here instead of
445: * propagating second derivatives through the ionization model. */
446: Em_TT = (dEm1.T - dEm.T) / epsilon;
447: /*Em_t = dEm.E * xdot[i].E + dEm.T * xdot[i].T;*/
448: dEm_t.E = dEm.E * a;
449: dEm_t.T = dEm.T * a + Em_TT * xdot[i].T;
450: }
452: PetscMemzero(K,sizeof(K));
453: /* Residuals are multiplied by the volume element (hx). */
454: if (i == 0) {
455: PetscScalar D,bcTheta = rd->bcmidpoint ? Theta : 1.;
456: RDNode n, nx;
457: RDNode dD,dxD;
459: n.E = (1.-bcTheta)*x0[0].E + bcTheta*x[0].E;
460: n.T = (1.-bcTheta)*x0[0].T + bcTheta*x[0].T;
461: nx.E = ((1.-bcTheta)*(x0[1].E-x0[0].E) + bcTheta*(x[1].E-x[0].E))/hx;
462: nx.T = ((1.-bcTheta)*(x0[1].T-x0[0].T) + bcTheta*(x[1].T-x[0].T))/hx;
463: switch (rd->leftbc) {
464: case BC_ROBIN:
465: RDDiffusionCoefficient(rd,rd->bclimit,&n,&nx,&D,&dD,&dxD);
466: K[0][1*2+0] = (bcTheta/Theta)*hx*(1. -2.*D*(-1./hx) - 2.*nx.E*dD.E + 2.*nx.E*dxD.E/hx);
467: K[0][1*2+1] = (bcTheta/Theta)*hx*(-2.*nx.E*dD.T);
468: K[0][2*2+0] = (bcTheta/Theta)*hx*(-2.*D*(1./hx) - 2.*nx.E*dD.E - 2.*nx.E*dxD.E/hx);
469: break;
470: case BC_NEUMANN:
471: K[0][1*2+0] = -1./Theta;
472: K[0][2*2+0] = 1./Theta;
473: break;
474: default: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Case %D",rd->initial);
475: }
476: } else if (i == info.mx-1) {
477: K[0][0*2+0] = -1./Theta;
478: K[0][1*2+0] = 1./Theta;
479: } else {
480: /*PetscScalar diff;*/
481: RDNode ddiff[3];
482: /*diff = (1.-Theta)*RDDiffusion(rd,hx,x0,i,0) + Theta* */ RDDiffusion(rd,hx,x,i,ddiff);
483: K[0][0*2+0] = -hx*ddiff[0].E;
484: K[0][0*2+1] = -hx*ddiff[0].T;
485: K[0][1*2+0] = hx*(a - ddiff[1].E - drad.E);
486: K[0][1*2+1] = hx*(-ddiff[1].T - drad.T);
487: K[0][2*2+0] = -hx*ddiff[2].E;
488: K[0][2*2+1] = -hx*ddiff[2].T;
489: }
491: K[1][1*2+0] = hx*(rho*dEm_t.E + drad.E);
492: K[1][1*2+1] = hx*(rho*dEm_t.T + drad.T);
494: col[0] = i-1;
495: col[1] = i;
496: col[2] = i+1<info.mx ? i+1 : -1;
497: MatSetValuesBlocked(B,1,&i,3,col,&K[0][0],INSERT_VALUES);
498: }
499: RDRestoreLocalArrays(rd,&X0loc,&x0,&Xloc,&x,&Xloc_t,&xdot);
500: MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);
501: MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);
502: if (A != B) {
503: MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);
504: MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);
505: }
506: return(0);
507: }
509: /* Evaluate interpolants and derivatives at a select quadrature point */
510: static void RDEvaluate(PetscReal interp[][2],PetscReal deriv[][2],PetscInt q,const RDNode x[],PetscInt i,RDNode *n,RDNode *nx)
511: {
512: PetscInt j;
513: n->E = 0; n->T = 0; nx->E = 0; nx->T = 0;
514: for (j=0; j<2; j++) {
515: n->E += interp[q][j] * x[i+j].E;
516: n->T += interp[q][j] * x[i+j].T;
517: nx->E += deriv[q][j] * x[i+j].E;
518: nx->T += deriv[q][j] * x[i+j].T;
519: }
520: }
522: /*
523: Various quadrature rules. The nonlinear terms are non-polynomial so no standard quadrature will be exact.
524: */
525: static PetscErrorCode RDGetQuadrature(RD rd,PetscReal hx,PetscInt *nq,PetscReal weight[],PetscReal interp[][2],PetscReal deriv[][2])
526: {
527: PetscInt q,j;
528: const PetscReal *refweight,(*refinterp)[2],(*refderiv)[2];
531: switch (rd->quadrature) {
532: case QUADRATURE_GAUSS1: {
533: static const PetscReal ww[1] = {1.},ii[1][2] = {{0.5,0.5}},dd[1][2] = {{-1.,1.}};
534: *nq = 1; refweight = ww; refinterp = ii; refderiv = dd;
535: } break;
536: case QUADRATURE_GAUSS2: {
537: static const PetscReal ii[2][2] = {{0.78867513459481287,0.21132486540518713},{0.21132486540518713,0.78867513459481287}},dd[2][2] = {{-1.,1.},{-1.,1.}},ww[2] = {0.5,0.5};
538: *nq = 2; refweight = ww; refinterp = ii; refderiv = dd;
539: } break;
540: case QUADRATURE_GAUSS3: {
541: static const PetscReal ii[3][2] = {{0.8872983346207417,0.1127016653792583},{0.5,0.5},{0.1127016653792583,0.8872983346207417}},
542: dd[3][2] = {{-1,1},{-1,1},{-1,1}},ww[3] = {5./18,8./18,5./18};
543: *nq = 3; refweight = ww; refinterp = ii; refderiv = dd;
544: } break;
545: case QUADRATURE_GAUSS4: {
546: static const PetscReal ii[][2] = {{0.93056815579702623,0.069431844202973658},
547: {0.66999052179242813,0.33000947820757187},
548: {0.33000947820757187,0.66999052179242813},
549: {0.069431844202973658,0.93056815579702623}},
550: dd[][2] = {{-1,1},{-1,1},{-1,1},{-1,1}},ww[] = {0.17392742256872692,0.3260725774312731,0.3260725774312731,0.17392742256872692};
552: *nq = 4; refweight = ww; refinterp = ii; refderiv = dd;
553: } break;
554: case QUADRATURE_LOBATTO2: {
555: static const PetscReal ii[2][2] = {{1.,0.},{0.,1.}},dd[2][2] = {{-1.,1.},{-1.,1.}},ww[2] = {0.5,0.5};
556: *nq = 2; refweight = ww; refinterp = ii; refderiv = dd;
557: } break;
558: case QUADRATURE_LOBATTO3: {
559: static const PetscReal ii[3][2] = {{1,0},{0.5,0.5},{0,1}},dd[3][2] = {{-1,1},{-1,1},{-1,1}},ww[3] = {1./6,4./6,1./6};
560: *nq = 3; refweight = ww; refinterp = ii; refderiv = dd;
561: } break;
562: default: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Unknown quadrature %d",(int)rd->quadrature);
563: }
565: for (q=0; q<*nq; q++) {
566: weight[q] = refweight[q] * hx;
567: for (j=0; j<2; j++) {
568: interp[q][j] = refinterp[q][j];
569: deriv[q][j] = refderiv[q][j] / hx;
570: }
571: }
572: return(0);
573: }
575: /*
576: Finite element version
577: */
578: static PetscErrorCode RDIFunction_FE(TS ts,PetscReal t,Vec X,Vec Xdot,Vec F,void *ctx)
579: {
581: RD rd = (RD)ctx;
582: RDNode *x,*x0,*xdot,*f;
583: Vec X0loc,Xloc,Xloc_t,Floc;
584: PetscReal hx,Theta,dt,weight[5],interp[5][2],deriv[5][2];
585: DMDALocalInfo info;
586: PetscInt i,j,q,nq;
589: RDCheckDomain(rd,ts,X);
590: RDGetLocalArrays(rd,ts,X,Xdot,&Theta,&dt,&X0loc,&x0,&Xloc,&x,&Xloc_t,&xdot);
592: DMGetLocalVector(rd->da,&Floc);
593: VecZeroEntries(Floc);
594: DMDAVecGetArray(rd->da,Floc,&f);
595: DMDAGetLocalInfo(rd->da,&info);
597: /* Set up shape functions and quadrature for elements (assumes a uniform grid) */
598: hx = rd->L / (info.mx-1);
599: RDGetQuadrature(rd,hx,&nq,weight,interp,deriv);
601: for (i=info.xs; i<PetscMin(info.xs+info.xm,info.mx-1); i++) {
602: for (q=0; q<nq; q++) {
603: PetscReal rho = rd->rho;
604: PetscScalar Em_t,rad,D_R,D0_R;
605: RDNode n,n0,nx,n0x,nt,ntx;
606: RDEvaluate(interp,deriv,q,x,i,&n,&nx);
607: RDEvaluate(interp,deriv,q,x0,i,&n0,&n0x);
608: RDEvaluate(interp,deriv,q,xdot,i,&nt,&ntx);
610: rad = (1.-Theta)*RDRadiation(rd,&n0,0) + Theta*RDRadiation(rd,&n,0);
611: if (rd->endpoint) {
612: PetscScalar Em0,Em1;
613: RDMaterialEnergy(rd,&n0,&Em0,NULL);
614: RDMaterialEnergy(rd,&n,&Em1,NULL);
615: Em_t = (Em1 - Em0) / dt;
616: } else {
617: RDNode dEm;
618: RDMaterialEnergy(rd,&n,NULL,&dEm);
619: Em_t = dEm.E * nt.E + dEm.T * nt.T;
620: }
621: RDDiffusionCoefficient(rd,PETSC_TRUE,&n0,&n0x,&D0_R,0,0);
622: RDDiffusionCoefficient(rd,PETSC_TRUE,&n,&nx,&D_R,0,0);
623: for (j=0; j<2; j++) {
624: f[i+j].E += (deriv[q][j] * weight[q] * ((1.-Theta)*D0_R*n0x.E + Theta*D_R*nx.E)
625: + interp[q][j] * weight[q] * (nt.E - rad));
626: f[i+j].T += interp[q][j] * weight[q] * (rho * Em_t + rad);
627: }
628: }
629: }
630: if (info.xs == 0) {
631: switch (rd->leftbc) {
632: case BC_ROBIN: {
633: PetscScalar D_R,D_R_bc;
634: PetscReal ratio,bcTheta = rd->bcmidpoint ? Theta : 1.;
635: RDNode n, nx;
637: n.E = (1-bcTheta)*x0[0].E + bcTheta*x[0].E;
638: n.T = (1-bcTheta)*x0[0].T + bcTheta*x[0].T;
639: nx.E = (x[1].E-x[0].E)/hx;
640: nx.T = (x[1].T-x[0].T)/hx;
641: RDDiffusionCoefficient(rd,PETSC_TRUE,&n,&nx,&D_R,0,0);
642: RDDiffusionCoefficient(rd,rd->bclimit,&n,&nx,&D_R_bc,0,0);
643: ratio = PetscRealPart(D_R/D_R_bc);
644: if (ratio > 1.) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Limited diffusivity is greater than unlimited");
645: if (ratio < 1e-3) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Heavily limited diffusivity");
646: f[0].E += -ratio*0.5*(rd->Eapplied - n.E);
647: } break;
648: case BC_NEUMANN:
649: /* homogeneous Neumann is the natural condition */
650: break;
651: default: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Case %D",rd->initial);
652: }
653: }
655: RDRestoreLocalArrays(rd,&X0loc,&x0,&Xloc,&x,&Xloc_t,&xdot);
656: DMDAVecRestoreArray(rd->da,Floc,&f);
657: VecZeroEntries(F);
658: DMLocalToGlobalBegin(rd->da,Floc,ADD_VALUES,F);
659: DMLocalToGlobalEnd(rd->da,Floc,ADD_VALUES,F);
660: DMRestoreLocalVector(rd->da,&Floc);
662: if (rd->monitor_residual) {RDStateView(rd,X,Xdot,F);}
663: return(0);
664: }
666: static PetscErrorCode RDIJacobian_FE(TS ts,PetscReal t,Vec X,Vec Xdot,PetscReal a,Mat A,Mat B,void *ctx)
667: {
669: RD rd = (RD)ctx;
670: RDNode *x,*x0,*xdot;
671: Vec X0loc,Xloc,Xloc_t;
672: PetscReal hx,Theta,dt,weight[5],interp[5][2],deriv[5][2];
673: DMDALocalInfo info;
674: PetscInt i,j,k,q,nq;
675: PetscScalar K[4][4];
678: RDCheckDomain(rd,ts,X);
679: RDGetLocalArrays(rd,ts,X,Xdot,&Theta,&dt,&X0loc,&x0,&Xloc,&x,&Xloc_t,&xdot);
680: DMDAGetLocalInfo(rd->da,&info);
681: hx = rd->L / (info.mx-1);
682: RDGetQuadrature(rd,hx,&nq,weight,interp,deriv);
683: MatZeroEntries(B);
684: for (i=info.xs; i<PetscMin(info.xs+info.xm,info.mx-1); i++) {
685: PetscInt rc[2];
687: rc[0] = i; rc[1] = i+1;
688: PetscMemzero(K,sizeof(K));
689: for (q=0; q<nq; q++) {
690: PetscScalar D_R;
691: PETSC_UNUSED PetscScalar rad;
692: RDNode n,nx,nt,ntx,drad,dD_R,dxD_R,dEm;
693: RDEvaluate(interp,deriv,q,x,i,&n,&nx);
694: RDEvaluate(interp,deriv,q,xdot,i,&nt,&ntx);
695: rad = RDRadiation(rd,&n,&drad);
696: RDDiffusionCoefficient(rd,PETSC_TRUE,&n,&nx,&D_R,&dD_R,&dxD_R);
697: RDMaterialEnergy(rd,&n,NULL,&dEm);
698: for (j=0; j<2; j++) {
699: for (k=0; k<2; k++) {
700: K[j*2+0][k*2+0] += (+interp[q][j] * weight[q] * (a - drad.E) * interp[q][k]
701: + deriv[q][j] * weight[q] * ((D_R + dxD_R.E * nx.E) * deriv[q][k] + dD_R.E * nx.E * interp[q][k]));
702: K[j*2+0][k*2+1] += (+interp[q][j] * weight[q] * (-drad.T * interp[q][k])
703: + deriv[q][j] * weight[q] * (dxD_R.T * deriv[q][k] + dD_R.T * interp[q][k]) * nx.E);
704: K[j*2+1][k*2+0] += interp[q][j] * weight[q] * drad.E * interp[q][k];
705: K[j*2+1][k*2+1] += interp[q][j] * weight[q] * (a * rd->rho * dEm.T + drad.T) * interp[q][k];
706: }
707: }
708: }
709: MatSetValuesBlocked(B,2,rc,2,rc,&K[0][0],ADD_VALUES);
710: }
711: if (info.xs == 0) {
712: switch (rd->leftbc) {
713: case BC_ROBIN: {
714: PetscScalar D_R,D_R_bc;
715: PetscReal ratio;
716: RDNode n, nx;
718: n.E = (1-Theta)*x0[0].E + Theta*x[0].E;
719: n.T = (1-Theta)*x0[0].T + Theta*x[0].T;
720: nx.E = (x[1].E-x[0].E)/hx;
721: nx.T = (x[1].T-x[0].T)/hx;
722: RDDiffusionCoefficient(rd,PETSC_TRUE,&n,&nx,&D_R,0,0);
723: RDDiffusionCoefficient(rd,rd->bclimit,&n,&nx,&D_R_bc,0,0);
724: ratio = PetscRealPart(D_R/D_R_bc);
725: MatSetValue(B,0,0,ratio*0.5,ADD_VALUES);
726: } break;
727: case BC_NEUMANN:
728: /* homogeneous Neumann is the natural condition */
729: break;
730: default: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Case %D",rd->initial);
731: }
732: }
734: RDRestoreLocalArrays(rd,&X0loc,&x0,&Xloc,&x,&Xloc_t,&xdot);
735: MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);
736: MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);
737: if (A != B) {
738: MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);
739: MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);
740: }
741: return(0);
742: }
744: /* Temperature that is in equilibrium with the radiation density */
745: static PetscScalar RDRadiationTemperature(RD rd,PetscScalar E) { return PetscPowScalar(E*rd->c/(4.*rd->sigma_b),0.25); }
747: static PetscErrorCode RDInitialState(RD rd,Vec X)
748: {
749: DMDALocalInfo info;
750: PetscInt i;
751: RDNode *x;
755: DMDAGetLocalInfo(rd->da,&info);
756: DMDAVecGetArray(rd->da,X,&x);
757: for (i=info.xs; i<info.xs+info.xm; i++) {
758: PetscReal coord = i*rd->L/(info.mx-1);
759: switch (rd->initial) {
760: case 1:
761: x[i].E = 0.001;
762: x[i].T = RDRadiationTemperature(rd,x[i].E);
763: break;
764: case 2:
765: x[i].E = 0.001 + 100.*PetscExpReal(-PetscSqr(coord/0.1));
766: x[i].T = RDRadiationTemperature(rd,x[i].E);
767: break;
768: case 3:
769: x[i].E = 7.56e-2 * rd->unit.Joule / PetscPowScalarInt(rd->unit.meter,3);
770: x[i].T = RDRadiationTemperature(rd,x[i].E);
771: break;
772: default: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"No initial state %D",rd->initial);
773: }
774: }
775: DMDAVecRestoreArray(rd->da,X,&x);
776: return(0);
777: }
779: static PetscErrorCode RDView(RD rd,Vec X,PetscViewer viewer)
780: {
782: Vec Y;
783: const RDNode *x;
784: PetscScalar *y;
785: PetscInt i,m,M;
786: const PetscInt *lx;
787: DM da;
788: MPI_Comm comm;
791: /*
792: Create a DMDA (one dof per node, zero stencil width, same layout) to hold Trad
793: (radiation temperature). It is not necessary to create a DMDA for this, but this way
794: output and visualization will have meaningful variable names and correct scales.
795: */
796: DMDAGetInfo(rd->da,0, &M,0,0, 0,0,0, 0,0,0,0,0,0);
797: DMDAGetOwnershipRanges(rd->da,&lx,0,0);
798: PetscObjectGetComm((PetscObject)rd->da,&comm);
799: DMDACreate1d(comm,DM_BOUNDARY_NONE,M,1,0,lx,&da);
800: DMSetFromOptions(da);
801: DMSetUp(da);
802: DMDASetUniformCoordinates(da,0.,rd->L,0.,0.,0.,0.);
803: DMDASetFieldName(da,0,"T_rad");
804: DMCreateGlobalVector(da,&Y);
806: /* Compute the radiation temperature from the solution at each node */
807: VecGetLocalSize(Y,&m);
808: VecGetArrayRead(X,(const PetscScalar **)&x);
809: VecGetArray(Y,&y);
810: for (i=0; i<m; i++) y[i] = RDRadiationTemperature(rd,x[i].E);
811: VecRestoreArrayRead(X,(const PetscScalar**)&x);
812: VecRestoreArray(Y,&y);
814: VecView(Y,viewer);
815: VecDestroy(&Y);
816: DMDestroy(&da);
817: return(0);
818: }
820: static PetscErrorCode RDTestDifferentiation(RD rd)
821: {
822: MPI_Comm comm;
824: RDNode n,nx;
825: PetscScalar epsilon;
828: PetscObjectGetComm((PetscObject)rd->da,&comm);
829: epsilon = 1e-8;
830: {
831: RDNode dEm,fdEm;
832: PetscScalar T0 = 1000.,T1 = T0*(1.+epsilon),Em0,Em1;
833: n.E = 1.;
834: n.T = T0;
835: rd->MaterialEnergy(rd,&n,&Em0,&dEm);
836: n.E = 1.+epsilon;
837: n.T = T0;
838: rd->MaterialEnergy(rd,&n,&Em1,0);
839: fdEm.E = (Em1-Em0)/epsilon;
840: n.E = 1.;
841: n.T = T1;
842: rd->MaterialEnergy(rd,&n,&Em1,0);
843: fdEm.T = (Em1-Em0)/(T0*epsilon);
844: PetscPrintf(comm,"dEm {%g,%g}, fdEm {%g,%g}, diff {%g,%g}\n",(double)PetscRealPart(dEm.E),(double)PetscRealPart(dEm.T),
845: (double)PetscRealPart(fdEm.E),(double)PetscRealPart(fdEm.T),(double)PetscRealPart(dEm.E-fdEm.E),(double)PetscRealPart(dEm.T-fdEm.T));
846: }
847: {
848: PetscScalar D0,D;
849: RDNode dD,dxD,fdD,fdxD;
850: n.E = 1.; n.T = 1.; nx.E = 1.; n.T = 1.;
851: RDDiffusionCoefficient(rd,rd->bclimit,&n,&nx,&D0,&dD,&dxD);
852: n.E = 1.+epsilon; n.T = 1.; nx.E = 1.; n.T = 1.;
853: RDDiffusionCoefficient(rd,rd->bclimit,&n,&nx,&D,0,0); fdD.E = (D-D0)/epsilon;
854: n.E = 1; n.T = 1.+epsilon; nx.E = 1.; n.T = 1.;
855: RDDiffusionCoefficient(rd,rd->bclimit,&n,&nx,&D,0,0); fdD.T = (D-D0)/epsilon;
856: n.E = 1; n.T = 1.; nx.E = 1.+epsilon; n.T = 1.;
857: RDDiffusionCoefficient(rd,rd->bclimit,&n,&nx,&D,0,0); fdxD.E = (D-D0)/epsilon;
858: n.E = 1; n.T = 1.; nx.E = 1.; n.T = 1.+epsilon;
859: RDDiffusionCoefficient(rd,rd->bclimit,&n,&nx,&D,0,0); fdxD.T = (D-D0)/epsilon;
860: PetscPrintf(comm,"dD {%g,%g}, fdD {%g,%g}, diff {%g,%g}\n",(double)PetscRealPart(dD.E),(double)PetscRealPart(dD.T),
861: (double)PetscRealPart(fdD.E),(double)PetscRealPart(fdD.T),(double)PetscRealPart(dD.E-fdD.E),(double)PetscRealPart(dD.T-fdD.T));
862: PetscPrintf(comm,"dxD {%g,%g}, fdxD {%g,%g}, diffx {%g,%g}\n",(double)PetscRealPart(dxD.E),(double)PetscRealPart(dxD.T),
863: (double)PetscRealPart(fdxD.E),(double)PetscRealPart(fdxD.T),(double)PetscRealPart(dxD.E-fdxD.E),(double)PetscRealPart(dxD.T-fdxD.T));
864: }
865: {
866: PetscInt i;
867: PetscReal hx = 1.;
868: PetscScalar a0;
869: RDNode n0[3],n1[3],d[3],fd[3];
871: n0[0].E = 1.;
872: n0[0].T = 1.;
873: n0[1].E = 5.;
874: n0[1].T = 3.;
875: n0[2].E = 4.;
876: n0[2].T = 2.;
877: a0 = RDDiffusion(rd,hx,n0,1,d);
878: for (i=0; i<3; i++) {
879: PetscMemcpy(n1,n0,sizeof(n0)); n1[i].E += epsilon;
880: fd[i].E = (RDDiffusion(rd,hx,n1,1,0)-a0)/epsilon;
881: PetscMemcpy(n1,n0,sizeof(n0)); n1[i].T += epsilon;
882: fd[i].T = (RDDiffusion(rd,hx,n1,1,0)-a0)/epsilon;
883: PetscPrintf(comm,"ddiff[%D] {%g,%g}, fd {%g %g}, diff {%g,%g}\n",i,(double)PetscRealPart(d[i].E),(double)PetscRealPart(d[i].T),
884: (double)PetscRealPart(fd[i].E),(double)PetscRealPart(fd[i].T),(double)PetscRealPart(d[i].E-fd[i].E),(double)PetscRealPart(d[i].T-fd[i].T));
885: }
886: }
887: {
888: PetscScalar rad0,rad;
889: RDNode drad,fdrad;
890: n.E = 1.; n.T = 1.;
891: rad0 = RDRadiation(rd,&n,&drad);
892: n.E = 1.+epsilon; n.T = 1.;
893: rad = RDRadiation(rd,&n,0); fdrad.E = (rad-rad0)/epsilon;
894: n.E = 1.; n.T = 1.+epsilon;
895: rad = RDRadiation(rd,&n,0); fdrad.T = (rad-rad0)/epsilon;
896: PetscPrintf(comm,"drad {%g,%g}, fdrad {%g,%g}, diff {%g,%g}\n",(double)PetscRealPart(drad.E),(double)PetscRealPart(drad.T),
897: (double)PetscRealPart(fdrad.E),(double)PetscRealPart(fdrad.T),(double)PetscRealPart(drad.E-drad.E),(double)PetscRealPart(drad.T-fdrad.T));
898: }
899: return(0);
900: }
902: static PetscErrorCode RDCreate(MPI_Comm comm,RD *inrd)
903: {
905: RD rd;
906: PetscReal meter=0,kilogram=0,second=0,Kelvin=0,Joule=0,Watt=0;
909: *inrd = 0;
910: PetscNew(&rd);
912: PetscOptionsBegin(comm,NULL,"Options for nonequilibrium radiation-diffusion with RD ionization",NULL);
913: {
914: rd->initial = 1;
915: PetscOptionsInt("-rd_initial","Initial condition (1=Marshak, 2=Blast, 3=Marshak+)","",rd->initial,&rd->initial,0);
916: switch (rd->initial) {
917: case 1:
918: case 2:
919: rd->unit.kilogram = 1.;
920: rd->unit.meter = 1.;
921: rd->unit.second = 1.;
922: rd->unit.Kelvin = 1.;
923: break;
924: case 3:
925: rd->unit.kilogram = 1.e12;
926: rd->unit.meter = 1.;
927: rd->unit.second = 1.e9;
928: rd->unit.Kelvin = 1.;
929: break;
930: default: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Unknown initial condition %d",rd->initial);
931: }
932: /* Fundamental units */
933: PetscOptionsReal("-rd_unit_meter","Length of 1 meter in nondimensional units","",rd->unit.meter,&rd->unit.meter,0);
934: PetscOptionsReal("-rd_unit_kilogram","Mass of 1 kilogram in nondimensional units","",rd->unit.kilogram,&rd->unit.kilogram,0);
935: PetscOptionsReal("-rd_unit_second","Time of a second in nondimensional units","",rd->unit.second,&rd->unit.second,0);
936: PetscOptionsReal("-rd_unit_Kelvin","Temperature of a Kelvin in nondimensional units","",rd->unit.Kelvin,&rd->unit.Kelvin,0);
937: /* Derived units */
938: rd->unit.Joule = rd->unit.kilogram*PetscSqr(rd->unit.meter/rd->unit.second);
939: rd->unit.Watt = rd->unit.Joule/rd->unit.second;
940: /* Local aliases */
941: meter = rd->unit.meter;
942: kilogram = rd->unit.kilogram;
943: second = rd->unit.second;
944: Kelvin = rd->unit.Kelvin;
945: Joule = rd->unit.Joule;
946: Watt = rd->unit.Watt;
948: PetscOptionsBool("-rd_monitor_residual","Display residuals every time they are evaluated","",rd->monitor_residual,&rd->monitor_residual,NULL);
949: PetscOptionsEnum("-rd_discretization","Discretization type","",DiscretizationTypes,(PetscEnum)rd->discretization,(PetscEnum*)&rd->discretization,NULL);
950: if (rd->discretization == DISCRETIZATION_FE) {
951: rd->quadrature = QUADRATURE_GAUSS2;
952: PetscOptionsEnum("-rd_quadrature","Finite element quadrature","",QuadratureTypes,(PetscEnum)rd->quadrature,(PetscEnum*)&rd->quadrature,NULL);
953: }
954: PetscOptionsEnum("-rd_jacobian","Type of finite difference Jacobian","",JacobianTypes,(PetscEnum)rd->jacobian,(PetscEnum*)&rd->jacobian,NULL);
955: switch (rd->initial) {
956: case 1:
957: rd->leftbc = BC_ROBIN;
958: rd->Eapplied = 4 * rd->unit.Joule / PetscPowRealInt(rd->unit.meter,3);
959: rd->L = 1. * rd->unit.meter;
960: rd->beta = 3.0;
961: rd->gamma = 3.0;
962: rd->final_time = 3 * second;
963: break;
964: case 2:
965: rd->leftbc = BC_NEUMANN;
966: rd->Eapplied = 0.;
967: rd->L = 1. * rd->unit.meter;
968: rd->beta = 3.0;
969: rd->gamma = 3.0;
970: rd->final_time = 1 * second;
971: break;
972: case 3:
973: rd->leftbc = BC_ROBIN;
974: rd->Eapplied = 7.503e6 * rd->unit.Joule / PetscPowRealInt(rd->unit.meter,3);
975: rd->L = 5. * rd->unit.meter;
976: rd->beta = 3.5;
977: rd->gamma = 3.5;
978: rd->final_time = 20e-9 * second;
979: break;
980: default: SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Initial %D",rd->initial);
981: }
982: PetscOptionsEnum("-rd_leftbc","Left boundary condition","",BCTypes,(PetscEnum)rd->leftbc,(PetscEnum*)&rd->leftbc,NULL);
983: PetscOptionsReal("-rd_E_applied","Radiation flux at left end of domain","",rd->Eapplied,&rd->Eapplied,NULL);
984: PetscOptionsReal("-rd_beta","Thermal exponent for photon absorption","",rd->beta,&rd->beta,NULL);
985: PetscOptionsReal("-rd_gamma","Thermal exponent for diffusion coefficient","",rd->gamma,&rd->gamma,NULL);
986: PetscOptionsBool("-rd_view_draw","Draw final solution","",rd->view_draw,&rd->view_draw,NULL);
987: PetscOptionsBool("-rd_endpoint","Discretize using endpoints (like trapezoid rule) instead of midpoint","",rd->endpoint,&rd->endpoint,NULL);
988: PetscOptionsBool("-rd_bcmidpoint","Impose the boundary condition at the midpoint (Theta) of the interval","",rd->bcmidpoint,&rd->bcmidpoint,NULL);
989: PetscOptionsBool("-rd_bclimit","Limit diffusion coefficient in definition of Robin boundary condition","",rd->bclimit,&rd->bclimit,NULL);
990: PetscOptionsBool("-rd_test_diff","Test differentiation in constitutive relations","",rd->test_diff,&rd->test_diff,NULL);
991: PetscOptionsString("-rd_view_binary","File name to hold final solution","",rd->view_binary,rd->view_binary,sizeof(rd->view_binary),NULL);
992: }
993: PetscOptionsEnd();
995: switch (rd->initial) {
996: case 1:
997: case 2:
998: rd->rho = 1.;
999: rd->c = 1.;
1000: rd->K_R = 1.;
1001: rd->K_p = 1.;
1002: rd->sigma_b = 0.25;
1003: rd->MaterialEnergy = RDMaterialEnergy_Reduced;
1004: break;
1005: case 3:
1006: /* Table 2 */
1007: rd->rho = 1.17e-3 * kilogram / (meter*meter*meter); /* density */
1008: rd->K_R = 7.44e18 * PetscPowRealInt(meter,5) * PetscPowReal(Kelvin,3.5) * PetscPowRealInt(kilogram,-2); /* */
1009: rd->K_p = 2.33e20 * PetscPowRealInt(meter,5) * PetscPowReal(Kelvin,3.5) * PetscPowRealInt(kilogram,-2); /* */
1010: rd->I_H = 2.179e-18 * Joule; /* Hydrogen ionization potential */
1011: rd->m_p = 1.673e-27 * kilogram; /* proton mass */
1012: rd->m_e = 9.109e-31 * kilogram; /* electron mass */
1013: rd->h = 6.626e-34 * Joule * second; /* Planck's constant */
1014: rd->k = 1.381e-23 * Joule / Kelvin; /* Boltzman constant */
1015: rd->c = 3.00e8 * meter / second; /* speed of light */
1016: rd->sigma_b = 5.67e-8 * Watt * PetscPowRealInt(meter,-2) * PetscPowRealInt(Kelvin,-4); /* Stefan-Boltzman constant */
1017: rd->MaterialEnergy = RDMaterialEnergy_Saha;
1018: break;
1019: }
1021: DMDACreate1d(comm,DM_BOUNDARY_NONE,20,sizeof(RDNode)/sizeof(PetscScalar),1,NULL,&rd->da);
1022: DMSetFromOptions(rd->da);
1023: DMSetUp(rd->da);
1024: DMDASetFieldName(rd->da,0,"E");
1025: DMDASetFieldName(rd->da,1,"T");
1026: DMDASetUniformCoordinates(rd->da,0.,1.,0.,0.,0.,0.);
1028: *inrd = rd;
1029: return(0);
1030: }
1032: int main(int argc, char *argv[])
1033: {
1035: RD rd;
1036: TS ts;
1037: SNES snes;
1038: Vec X;
1039: Mat A,B;
1040: PetscInt steps;
1041: PetscReal ftime;
1043: PetscInitialize(&argc,&argv,0,help);if (ierr) return ierr;
1044: RDCreate(PETSC_COMM_WORLD,&rd);
1045: DMCreateGlobalVector(rd->da,&X);
1046: DMSetMatType(rd->da,MATAIJ);
1047: DMCreateMatrix(rd->da,&B);
1048: RDInitialState(rd,X);
1050: TSCreate(PETSC_COMM_WORLD,&ts);
1051: TSSetProblemType(ts,TS_NONLINEAR);
1052: TSSetType(ts,TSTHETA);
1053: TSSetDM(ts,rd->da);
1054: switch (rd->discretization) {
1055: case DISCRETIZATION_FD:
1056: TSSetIFunction(ts,NULL,RDIFunction_FD,rd);
1057: if (rd->jacobian == JACOBIAN_ANALYTIC) TSSetIJacobian(ts,B,B,RDIJacobian_FD,rd);
1058: break;
1059: case DISCRETIZATION_FE:
1060: TSSetIFunction(ts,NULL,RDIFunction_FE,rd);
1061: if (rd->jacobian == JACOBIAN_ANALYTIC) TSSetIJacobian(ts,B,B,RDIJacobian_FE,rd);
1062: break;
1063: }
1064: TSSetMaxTime(ts,rd->final_time);
1065: TSSetTimeStep(ts,1e-3);
1066: TSSetExactFinalTime(ts,TS_EXACTFINALTIME_STEPOVER);
1067: TSSetFromOptions(ts);
1069: A = B;
1070: TSGetSNES(ts,&snes);
1071: switch (rd->jacobian) {
1072: case JACOBIAN_ANALYTIC:
1073: break;
1074: case JACOBIAN_MATRIXFREE:
1075: break;
1076: case JACOBIAN_FD_COLORING: {
1077: SNESSetJacobian(snes,A,B,SNESComputeJacobianDefaultColor,0);
1078: } break;
1079: case JACOBIAN_FD_FULL:
1080: SNESSetJacobian(snes,A,B,SNESComputeJacobianDefault,ts);
1081: break;
1082: }
1084: if (rd->test_diff) {
1085: RDTestDifferentiation(rd);
1086: }
1087: TSSolve(ts,X);
1088: TSGetSolveTime(ts,&ftime);
1089: TSGetStepNumber(ts,&steps);
1090: PetscPrintf(PETSC_COMM_WORLD,"Steps %D final time %g\n",steps,(double)ftime);
1091: if (rd->view_draw) {
1092: RDView(rd,X,PETSC_VIEWER_DRAW_WORLD);
1093: }
1094: if (rd->view_binary[0]) {
1095: PetscViewer viewer;
1096: PetscViewerBinaryOpen(PETSC_COMM_WORLD,rd->view_binary,FILE_MODE_WRITE,&viewer);
1097: RDView(rd,X,viewer);
1098: PetscViewerDestroy(&viewer);
1099: }
1100: VecDestroy(&X);
1101: MatDestroy(&B);
1102: RDDestroy(&rd);
1103: TSDestroy(&ts);
1104: PetscFinalize();
1105: return ierr;
1106: }
1107: /*TEST
1109: test:
1110: args: -da_grid_x 20 -rd_initial 1 -rd_discretization fd -rd_jacobian fd_coloring -rd_endpoint -ts_max_time 1 -ts_dt 2e-1 -ts_theta_initial_guess_extrapolate 0 -ts_monitor -snes_monitor_short -ksp_monitor_short
1111: requires: !single
1113: test:
1114: suffix: 2
1115: args: -da_grid_x 20 -rd_initial 1 -rd_discretization fe -rd_quadrature lobatto2 -rd_jacobian fd_coloring -rd_endpoint -ts_max_time 1 -ts_dt 2e-1 -ts_theta_initial_guess_extrapolate 0 -ts_monitor -snes_monitor_short -ksp_monitor_short
1116: requires: !single
1118: test:
1119: suffix: 3
1120: nsize: 2
1121: args: -da_grid_x 20 -rd_initial 1 -rd_discretization fd -rd_jacobian analytic -rd_endpoint -ts_max_time 3 -ts_dt 1e-1 -ts_theta_initial_guess_extrapolate 0 -ts_monitor -snes_monitor_short -ksp_monitor_short
1122: requires: !single
1124: TEST*/