Actual source code: ex22f.F
petsc-dev 2014-02-02
1: ! Time-dependent advection-reaction PDE in 1d. Demonstrates IMEX methods
2: !
3: ! u_t + a1*u_x = -k1*u + k2*v + s1
4: ! v_t + a2*v_x = k1*u - k2*v + s2
5: ! 0 < x < 1;
6: ! a1 = 1, k1 = 10^6, s1 = 0,
7: ! a2 = 0, k2 = 2*k1, s2 = 1
8: !
9: ! Initial conditions:
10: ! u(x,0) = 1 + s2*x
11: ! v(x,0) = k0/k1*u(x,0) + s1/k1
12: !
13: ! Upstream boundary conditions:
14: ! u(0,t) = 1-sin(12*t)^4
15: !
17: program main
18: implicit none
19: #include <finclude/petscsys.h>
20: #include <finclude/petscvec.h>
21: #include <finclude/petscmat.h>
22: #include <finclude/petscsnes.h>
23: #include <finclude/petscts.h>
24: #include <finclude/petscdmda.h>
25: !
26: ! Create an application context to contain data needed by the
27: ! application-provided call-back routines, FormJacobian() and
28: ! FormFunction(). We use a double precision array with six
29: ! entries, two for each problem parameter a, k, s.
30: !
31: PetscReal user(6)
32: integer user_a,user_k,user_s
33: parameter (user_a = 0,user_k = 2,user_s = 4)
35: external FormRHSFunction,FormIFunction,FormIJacobian
36: external FormInitialSolution
38: TS ts
39: SNES snes
40: SNESLineSearch linesearch
41: Vec X
42: Mat J
43: PetscInt steps,maxsteps,mx
44: PetscErrorCode ierr
45: DM da
46: PetscReal ftime,dt
47: PetscReal zero,one,pone
48: PetscInt im11,i2
49: PetscBool flg
51: im11 = -11
52: i2 = 2
53: zero = 0.0
54: one = 1.0
55: pone = one / 10
57: call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
59: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
60: ! Create distributed array (DMDA) to manage parallel grid and vectors
61: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
62: call DMDACreate1d(PETSC_COMM_WORLD,DMDA_BOUNDARY_NONE,im11,i2,i2, &
63: & PETSC_NULL_INTEGER,da,ierr)
65: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
66: ! Extract global vectors from DMDA;
67: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
68: call DMCreateGlobalVector(da,X,ierr)
70: ! Initialize user application context
71: ! Use zero-based indexing for command line parameters to match ex22.c
72: user(user_a+1) = 1.0
73: call PetscOptionsGetReal(PETSC_NULL_CHARACTER,'-a0', &
74: & user(user_a+1),flg,ierr)
75: user(user_a+2) = 0.0
76: call PetscOptionsGetReal(PETSC_NULL_CHARACTER,'-a1', &
77: & user(user_a+2),flg,ierr)
78: user(user_k+1) = 1000000.0
79: call PetscOptionsGetReal(PETSC_NULL_CHARACTER,'-k0', &
80: & user(user_k+1),flg,ierr)
81: user(user_k+2) = 2*user(user_k+1)
82: call PetscOptionsGetReal(PETSC_NULL_CHARACTER,'-k1', &
83: & user(user_k+2),flg,ierr)
84: user(user_s+1) = 0.0
85: call PetscOptionsGetReal(PETSC_NULL_CHARACTER,'-s0', &
86: & user(user_s+1),flg,ierr)
87: user(user_s+2) = 1.0
88: call PetscOptionsGetReal(PETSC_NULL_CHARACTER,'-s1', &
89: & user(user_s+2),flg,ierr)
91: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
92: ! Create timestepping solver context
93: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
94: call TSCreate(PETSC_COMM_WORLD,ts,ierr)
95: call TSSetDM(ts,da,ierr)
96: call TSSetType(ts,TSARKIMEX,ierr)
97: call TSSetRHSFunction(ts,PETSC_NULL_OBJECT,FormRHSFunction, &
98: & user,ierr)
99: call TSSetIFunction(ts,PETSC_NULL_OBJECT,FormIFunction,user,ierr)
100: call DMSetMatType(da,MATAIJ,ierr)
101: call DMCreateMatrix(da,J,ierr)
102: call TSSetIJacobian(ts,J,J,FormIJacobian,user,ierr)
104: call TSGetSNES(ts,snes,ierr)
105: call SNESGetLineSearch(snes,linesearch,ierr)
106: call SNESLineSearchSetType(linesearch,SNESLINESEARCHBASIC,ierr)
108: ftime = 1.0
109: maxsteps = 10000
110: call TSSetDuration(ts,maxsteps,ftime,ierr)
112: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
113: ! Set initial conditions
114: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
115: call FormInitialSolution(ts,X,user,ierr)
116: call TSSetSolution(ts,X,ierr)
117: call VecGetSize(X,mx,ierr)
118: ! Advective CFL, I don't know why it needs so much safety factor.
119: dt = pone * max(user(user_a+1),user(user_a+2)) / mx;
120: call TSSetInitialTimeStep(ts,zero,dt,ierr)
122: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
123: ! Set runtime options
124: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
125: call TSSetFromOptions(ts,ierr)
127: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
128: ! Solve nonlinear system
129: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
130: call TSSolve(ts,X,ierr)
132: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
133: ! Free work space.
134: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
135: call MatDestroy(J,ierr)
136: call VecDestroy(X,ierr)
137: call TSDestroy(ts,ierr)
138: call DMDestroy(da,ierr)
139: call PetscFinalize(ierr)
140: end program
142: ! Small helper to extract the layout, result uses 1-based indexing.
143: subroutine GetLayout(da,mx,xs,xe,gxs,gxe,ierr)
144: implicit none
145: #include <finclude/petscsys.h>
146: #include <finclude/petscdmda.h>
147: DM da
148: PetscInt mx,xs,xe,gxs,gxe
149: PetscErrorCode ierr
150: PetscInt xm,gxm
151: call DMDAGetInfo(da,PETSC_NULL_INTEGER, &
152: & mx,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER, &
153: & PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER, &
154: & PETSC_NULL_INTEGER,PETSC_NULL_INTEGER, &
155: & PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER, &
156: & PETSC_NULL_INTEGER,ierr)
157: call DMDAGetCorners(da,xs,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER, &
158: & xm,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,ierr)
159: call DMDAGetGhostCorners(da, &
160: & gxs,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER, &
161: & gxm,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,ierr)
162: xs = xs + 1
163: gxs = gxs + 1
164: xe = xs + xm - 1
165: gxe = gxs + gxm - 1
166: end subroutine
168: subroutine FormIFunctionLocal(mx,xs,xe,gxs,gxe,x,xdot,f, &
169: & a,k,s,ierr)
170: implicit none
171: PetscInt mx,xs,xe,gxs,gxe
172: PetscScalar x(2,xs:xe)
173: PetscScalar xdot(2,xs:xe)
174: PetscScalar f(2,xs:xe)
175: PetscReal a(2),k(2),s(2)
176: PetscErrorCode ierr
177: PetscInt i
178: do 10 i = xs,xe
179: f(1,i) = xdot(1,i) + k(1)*x(1,i) - k(2)*x(2,i) - s(1)
180: f(2,i) = xdot(2,i) - k(1)*x(1,i) + k(2)*x(2,i) - s(2)
181: 10 continue
182: end subroutine
184: subroutine FormIFunction(ts,t,X,Xdot,F,user,ierr)
185: implicit none
186: #include <finclude/petscsys.h>
187: #include <finclude/petscvec.h>
188: #include <finclude/petscmat.h>
189: #include <finclude/petscsnes.h>
190: #include <finclude/petscts.h>
191: #include <finclude/petscdmda.h>
192: TS ts
193: PetscReal t
194: Vec X,Xdot,F
195: PetscReal user(6)
196: PetscErrorCode ierr
197: integer user_a,user_k,user_s
198: parameter (user_a = 1,user_k = 3,user_s = 5)
200: DM da
201: PetscInt mx,xs,xe,gxs,gxe
202: PetscOffset ixx,ixxdot,iff
203: PetscScalar xx(0:1),xxdot(0:1),ff(0:1)
205: call TSGetDM(ts,da,ierr)
206: call GetLayout(da,mx,xs,xe,gxs,gxe,ierr)
208: ! Get access to vector data
209: call VecGetArray(X,xx,ixx,ierr)
210: call VecGetArray(Xdot,xxdot,ixxdot,ierr)
211: call VecGetArray(F,ff,iff,ierr)
213: call FormIFunctionLocal(mx,xs,xe,gxs,gxe, &
214: & xx(ixx),xxdot(ixxdot),ff(iff), &
215: & user(user_a),user(user_k),user(user_s),ierr)
217: call VecRestoreArray(X,xx,ixx,ierr)
218: call VecRestoreArray(Xdot,xxdot,ixxdot,ierr)
219: call VecRestoreArray(F,ff,iff,ierr)
220: end subroutine
222: subroutine FormRHSFunctionLocal(mx,xs,xe,gxs,gxe,t,x,f, &
223: & a,k,s,ierr)
224: implicit none
225: PetscInt mx,xs,xe,gxs,gxe
226: PetscReal t
227: PetscScalar x(2,gxs:gxe),f(2,xs:xe)
228: PetscReal a(2),k(2),s(2)
229: PetscErrorCode ierr
230: PetscInt i,j
231: PetscReal hx,u0t(2)
232: PetscReal one,two,three,four,six,twelve
233: PetscReal half,third,twothird,sixth
234: PetscReal twelfth
236: one = 1.0
237: two = 2.0
238: three = 3.0
239: four = 4.0
240: six = 6.0
241: twelve = 12.0
242: hx = one / mx
243: u0t(1) = one - sin(twelve*t)**four
244: u0t(2) = 0.0
245: half = one/two
246: third = one / three
247: twothird = two / three
248: sixth = one / six
249: twelfth = one / twelve
250: do 20 i = xs,xe
251: do 10 j = 1,2
252: if (i .eq. 1) then
253: f(j,i) = a(j)/hx*(third*u0t(j) + half*x(j,i) - x(j,i+1) &
254: & + sixth*x(j,i+2))
255: else if (i .eq. 2) then
256: f(j,i) = a(j)/hx*(-twelfth*u0t(j) + twothird*x(j,i-1) &
257: & - twothird*x(j,i+1) + twelfth*x(j,i+2))
258: else if (i .eq. mx-1) then
259: f(j,i) = a(j)/hx*(-sixth*x(j,i-2) + x(j,i-1) &
260: & - half*x(j,i) -third*x(j,i+1))
261: else if (i .eq. mx) then
262: f(j,i) = a(j)/hx*(-x(j,i) + x(j,i-1))
263: else
264: f(j,i) = a(j)/hx*(-twelfth*x(j,i-2) &
265: & + twothird*x(j,i-1) &
266: & - twothird*x(j,i+1) + twelfth*x(j,i+2))
267: end if
268: 10 continue
269: 20 continue
270: end subroutine
272: subroutine FormRHSFunction(ts,t,X,F,user,ierr)
273: implicit none
274: #include <finclude/petscsys.h>
275: #include <finclude/petscvec.h>
276: #include <finclude/petscmat.h>
277: #include <finclude/petscsnes.h>
278: #include <finclude/petscts.h>
279: #include <finclude/petscdmda.h>
280: TS ts
281: PetscReal t
282: Vec X,F
283: PetscReal user(6)
284: PetscErrorCode ierr
285: integer user_a,user_k,user_s
286: parameter (user_a = 1,user_k = 3,user_s = 5)
287: DM da
288: Vec Xloc
289: PetscInt mx,xs,xe,gxs,gxe
290: PetscOffset ixx,iff
291: PetscScalar xx(0:1),ff(0:1)
293: call TSGetDM(ts,da,ierr)
294: call GetLayout(da,mx,xs,xe,gxs,gxe,ierr)
296: ! Scatter ghost points to local vector,using the 2-step process
297: ! DMGlobalToLocalBegin(),DMGlobalToLocalEnd().
298: ! By placing code between these two statements, computations can be
299: ! done while messages are in transition.
300: call DMGetLocalVector(da,Xloc,ierr)
301: call DMGlobalToLocalBegin(da,X,INSERT_VALUES,Xloc,ierr)
302: call DMGlobalToLocalEnd(da,X,INSERT_VALUES,Xloc,ierr)
304: ! Get access to vector data
305: call VecGetArray(Xloc,xx,ixx,ierr)
306: call VecGetArray(F,ff,iff,ierr)
308: call FormRHSFunctionLocal(mx,xs,xe,gxs,gxe, &
309: & t,xx(ixx),ff(iff), &
310: & user(user_a),user(user_k),user(user_s),ierr)
312: call VecRestoreArray(Xloc,xx,ixx,ierr)
313: call VecRestoreArray(F,ff,iff,ierr)
314: call DMRestoreLocalVector(da,Xloc,ierr)
315: end subroutine
317: ! ---------------------------------------------------------------------
318: !
319: ! IJacobian - Compute IJacobian = dF/dU + shift*dF/dUdot
320: !
321: subroutine FormIJacobian(ts,t,X,Xdot,shift,J,Jpre,mstr,user,ierr)
322: implicit none
323: #include <finclude/petscsys.h>
324: #include <finclude/petscvec.h>
325: #include <finclude/petscmat.h>
326: #include <finclude/petscsnes.h>
327: #include <finclude/petscts.h>
328: #include <finclude/petscdmda.h>
329: TS ts
330: PetscReal t,shift
331: Vec X,Xdot
332: Mat J,Jpre
333: MatStructure mstr
334: PetscReal user(6)
335: PetscErrorCode ierr
336: integer user_a,user_k,user_s
337: parameter (user_a = 0,user_k = 2,user_s = 4)
339: DM da
340: PetscInt mx,xs,xe,gxs,gxe
341: PetscInt i,i1,row,col
342: PetscReal k1,k2;
343: PetscScalar val(4)
345: call TSGetDM(ts,da,ierr)
346: call GetLayout(da,mx,xs,xe,gxs,gxe,ierr)
348: i1 = 1
349: k1 = user(user_k+1)
350: k2 = user(user_k+2)
351: do 10 i = xs,xe
352: row = i-gxs
353: col = i-gxs
354: val(1) = shift + k1
355: val(2) = -k2
356: val(3) = -k1
357: val(4) = shift + k2
358: call MatSetValuesBlockedLocal(Jpre,i1,row,i1,col,val, &
359: & INSERT_VALUES,ierr)
360: 10 continue
361: call MatAssemblyBegin(Jpre,MAT_FINAL_ASSEMBLY,ierr)
362: call MatAssemblyEnd(Jpre,MAT_FINAL_ASSEMBLY,ierr)
363: if (J /= Jpre) then
364: call MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY,ierr)
365: call MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY,ierr)
366: end if
367: mstr = SAME_NONZERO_PATTERN
368: end subroutine
370: subroutine FormInitialSolutionLocal(mx,xs,xe,gxs,gxe,x,a,k,s,ierr)
371: implicit none
372: PetscInt mx,xs,xe,gxs,gxe
373: PetscScalar x(2,xs:xe)
374: PetscReal a(2),k(2),s(2)
375: PetscErrorCode ierr
377: PetscInt i
378: PetscReal one,hx,r,ik
379: one = 1.0
380: hx = one / mx
381: do 10 i=xs,xe
382: r = i*hx
383: if (k(2) .ne. 0.0) then
384: ik = one/k(2)
385: else
386: ik = one
387: end if
388: x(1,i) = one + s(2)*r
389: x(2,i) = k(1)*ik*x(1,i) + s(2)*ik
390: 10 continue
391: end subroutine
393: subroutine FormInitialSolution(ts,X,user,ierr)
394: implicit none
395: #include <finclude/petscsys.h>
396: #include <finclude/petscvec.h>
397: #include <finclude/petscmat.h>
398: #include <finclude/petscsnes.h>
399: #include <finclude/petscts.h>
400: #include <finclude/petscdmda.h>
401: TS ts
402: Vec X
403: PetscReal user(6)
404: PetscErrorCode ierr
405: integer user_a,user_k,user_s
406: parameter (user_a = 1,user_k = 3,user_s = 5)
408: DM da
409: PetscInt mx,xs,xe,gxs,gxe
410: PetscOffset ixx
411: PetscScalar xx(0:1)
413: call TSGetDM(ts,da,ierr)
414: call GetLayout(da,mx,xs,xe,gxs,gxe,ierr)
416: ! Get access to vector data
417: call VecGetArray(X,xx,ixx,ierr)
419: call FormInitialSolutionLocal(mx,xs,xe,gxs,gxe, &
420: & xx(ixx),user(user_a),user(user_k),user(user_s),ierr)
422: call VecRestoreArray(X,xx,ixx,ierr)
423: end subroutine