Actual source code: ex12f.F
1: !
2: !
3: ! This example demonstrates basic use of the SNES Fortran interface.
4: !
5: ! Note: The program ex10.f is the same as this example, except that it
6: ! uses the Fortran .f suffix rather than the .F suffix.
7: !
8: ! In this example the application context is a Fortran integer array:
9: ! ctx(1) = da - distributed array
10: ! 2 = F - global vector where the function is stored
11: ! 3 = xl - local work vector
12: ! 4 = rank - processor rank
13: ! 5 = size - number of processors
14: ! 6 = N - system size
15: !
16: ! Note: Any user-defined Fortran routines (such as FormJacobian)
17: ! MUST be declared as external.
18: !
19: !
20: ! Macros to make setting/getting values into vector clearer.
21: ! The element xx(ib) is the ibth element in the vector indicated by ctx(3)
22: #define xx(ib) vxx(ixx + (ib))
23: #define ff(ib) vff(iff + (ib))
24: #define F2(ib) vF2(iF2 + (ib))
25: program main
26: implicit none
28: #include include/finclude/petsc.h
29: #include include/finclude/petscvec.h
30: #include include/finclude/petscda.h
31: #include include/finclude/petscmat.h
32: #include include/finclude/petscsnes.h
34: PetscFortranAddr ctx(6)
35: PetscMPIInt rank,size
36: PetscErrorCode ierr
37: PetscInt N,start,end,nn,i,ii,its,i1,i0,i3
38: PetscTruth flg
39: SNES snes
40: Mat J
41: Vec x,r,u
42: PetscScalar xp,FF,UU,h
43: character*(10) matrixname
44: external FormJacobian,FormFunction
46: call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
47: i1 = 1
48: i0 = 0
49: i3 = 3
50: N = 10
51: call PetscOptionsGetInt(PETSC_NULL_CHARACTER,'-n',N,flg,ierr)
52: h = 1.d0/(N-1.d0)
53: ctx(6) = N
55: call MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr)
56: call MPI_Comm_size(PETSC_COMM_WORLD,size,ierr)
57: ctx(4) = rank
58: ctx(5) = size
60: ! Set up data structures
61: call DACreate1d(PETSC_COMM_WORLD,DA_NONPERIODIC,N,i1,i1, &
62: & PETSC_NULL_INTEGER,ctx(1),ierr)
64: call DACreateGlobalVector(ctx(1),x,ierr)
65: call DACreateLocalVector(ctx(1),ctx(3),ierr)
67: call PetscObjectSetName(x,'Approximate Solution',ierr)
68: call VecDuplicate(x,r,ierr)
69: call VecDuplicate(x,ctx(2),ierr)
70: call VecDuplicate(x,U,ierr)
71: call PetscObjectSetName(U,'Exact Solution',ierr)
73: call MatCreateMPIAIJ(PETSC_COMM_WORLD,PETSC_DECIDE,PETSC_DECIDE,N, &
74: & N,i3,PETSC_NULL_INTEGER,i0,PETSC_NULL_INTEGER,J,ierr)
76: call MatGetType(J,matrixname,ierr)
78: ! Store right-hand-side of PDE and exact solution
79: call VecGetOwnershipRange(x,start,end,ierr)
80: xp = h*start
81: nn = end - start
82: ii = start
83: do 10, i=0,nn-1
84: FF = 6.0*xp + (xp+1.e-12)**6.e0
85: UU = xp*xp*xp
86: call VecSetValues(ctx(2),i1,ii,FF,INSERT_VALUES,ierr)
87: call VecSetValues(U,i1,ii,UU,INSERT_VALUES,ierr)
88: xp = xp + h
89: ii = ii + 1
90: 10 continue
91: call VecAssemblyBegin(ctx(2),ierr)
92: call VecAssemblyEnd(ctx(2),ierr)
93: call VecAssemblyBegin(U,ierr)
94: call VecAssemblyEnd(U,ierr)
96: ! Create nonlinear solver
97: call SNESCreate(PETSC_COMM_WORLD,snes,ierr)
99: ! Set various routines and options
100: call SNESSetFunction(snes,r,FormFunction,ctx,ierr)
101: call SNESSetJacobian(snes,J,J,FormJacobian,ctx,ierr)
102: call SNESSetFromOptions(snes,ierr)
104: ! Solve nonlinear system
105: call FormInitialGuess(snes,x,ierr)
106: call SNESSolve(snes,PETSC_NULL_OBJECT,x,ierr)
107: call SNESGetIterationNumber(snes,its,ierr);
109: ! Write results if first processor
110: if (ctx(4) .eq. 0) then
111: write(6,100) its
112: endif
113: 100 format('Number of Newton iterations = ',i5)
115: ! Free work space. All PETSc objects should be destroyed when they
116: ! are no longer needed.
117: call VecDestroy(x,ierr)
118: call VecDestroy(ctx(3),ierr)
119: call VecDestroy(r,ierr)
120: call VecDestroy(U,ierr)
121: call VecDestroy(ctx(2),ierr)
122: call MatDestroy(J,ierr)
123: call SNESDestroy(snes,ierr)
124: call DADestroy(ctx(1),ierr)
125: call PetscFinalize(ierr)
126: end
129: ! -------------------- Evaluate Function F(x) ---------------------
131: subroutine FormFunction(snes,x,f,ctx,ierr)
132: implicit none
133: SNES snes
134: Vec x,f
135: PetscFortranAddr ctx(*)
136: PetscMPIInt rank,size
137: PetscInt i,s,n
138: PetscErrorCode ierr
139: PetscOffset ixx,iff,iF2
140: PetscScalar h,d,vf2(1),vxx(1),vff(1)
141: #include include/finclude/petsc.h
142: #include include/finclude/petscvec.h
143: #include include/finclude/petscda.h
144: #include include/finclude/petscmat.h
145: #include include/finclude/petscsnes.h
148: rank = ctx(4)
149: size = ctx(5)
150: h = 1.d0/(ctx(6) - 1.d0)
151: call DAGlobalToLocalBegin(ctx(1),x,INSERT_VALUES,ctx(3),ierr)
152: call DAGlobalToLocalEnd(ctx(1),x,INSERT_VALUES,ctx(3),ierr)
154: call VecGetLocalSize(ctx(3),n,ierr)
155: if (n .gt. 1000) then
156: print*, 'Local work array not big enough'
157: call MPI_Abort(PETSC_COMM_WORLD,0,ierr)
158: endif
160: !
161: ! This sets the index ixx so that vxx(ixx+1) is the first local
162: ! element in the vector indicated by ctx(3).
163: !
164: call VecGetArray(ctx(3),vxx,ixx,ierr)
165: call VecGetArray(f,vff,iff,ierr)
166: call VecGetArray(ctx(2),vF2,iF2,ierr)
168: d = h*h
170: !
171: ! Note that the array vxx() was obtained from a ghosted local vector
172: ! ctx(3) while the array vff() was obtained from the non-ghosted parallel
173: ! vector F. This is why there is a need for shift variable s. Since vff()
174: ! does not have locations for the ghost variables we need to index in it
175: ! slightly different then indexing into vxx(). For example on processor
176: ! 1 (the second processor)
177: !
178: ! xx(1) xx(2) xx(3) .....
179: ! ^^^^^^^ ^^^^^ ^^^^^
180: ! ghost value 1st local value 2nd local value
181: !
182: ! ff(1) ff(2)
183: ! ^^^^^^^ ^^^^^^^
184: ! 1st local value 2nd local value
185: !
186: if (rank .eq. 0) then
187: s = 0
188: ff(1) = xx(1)
189: else
190: s = 1
191: endif
193: do 10 i=1,n-2
194: ff(i-s+1) = d*(xx(i) - 2.d0*xx(i+1) &
195: & + xx(i+2)) + xx(i+1)*xx(i+1) &
196: & - F2(i-s+1)
197: 10 continue
199: if (rank .eq. size-1) then
200: ff(n-s) = xx(n) - 1.d0
201: endif
203: call VecRestoreArray(f,vff,iff,ierr)
204: call VecRestoreArray(ctx(3),vxx,ixx,ierr)
205: call VecRestoreArray(ctx(2),vF2,iF2,ierr)
206: return
207: end
209: ! -------------------- Form initial approximation -----------------
211: subroutine FormInitialGuess(snes,x,ierr)
212: implicit none
213: #include include/finclude/petsc.h
214: #include include/finclude/petscvec.h
215: #include include/finclude/petscsnes.h
216: PetscErrorCode ierr
217: Vec x
218: SNES snes
219: PetscScalar five
221: five = 5.d-1
222: call VecSet(x,five,ierr)
223: return
224: end
226: ! -------------------- Evaluate Jacobian --------------------
228: subroutine FormJacobian(snes,x,jac,B,flag,ctx,ierr)
229: implicit none
230: #include include/finclude/petsc.h
231: #include include/finclude/petscvec.h
232: #include include/finclude/petscda.h
233: #include include/finclude/petscmat.h
234: #include include/finclude/petscsnes.h
235: SNES snes
236: Vec x
237: Mat jac,B
238: PetscFortranAddr ctx(*)
239: PetscTruth flag
240: PetscInt ii,istart,iend,i,j,n,end,start,i1
241: PetscErrorCode ierr
242: PetscMPIInt rank,size
243: PetscOffset ixx
244: PetscScalar d,A,h,vxx(1)
246: i1 = 1
247: h = 1.d0/(ctx(6) - 1.d0)
248: d = h*h
249: rank = ctx(4)
250: size = ctx(5)
252: call VecGetArray(x,vxx,ixx,ierr)
253: call VecGetOwnershipRange(x,start,end,ierr)
254: n = end - start
256: if (rank .eq. 0) then
257: A = 1.0
258: call MatSetValues(jac,i1,start,i1,start,A,INSERT_VALUES,ierr)
259: istart = 1
260: else
261: istart = 0
262: endif
263: if (rank .eq. size-1) then
264: i = ctx(6)-1
265: A = 1.0
266: call MatSetValues(jac,i1,i,i1,i,A,INSERT_VALUES,ierr)
267: iend = n-1
268: else
269: iend = n
270: endif
271: do 10 i=istart,iend-1
272: ii = i + start
273: j = start + i - 1
274: call MatSetValues(jac,i1,ii,i1,j,d,INSERT_VALUES,ierr)
275: j = start + i + 1
276: call MatSetValues(jac,i1,ii,i1,j,d,INSERT_VALUES,ierr)
277: A = -2.0*d + 2.0*xx(i+1)
278: call MatSetValues(jac,i1,ii,i1,ii,A,INSERT_VALUES,ierr)
279: 10 continue
280: call VecRestoreArray(x,vxx,ixx,ierr)
281: call MatAssemblyBegin(jac,MAT_FINAL_ASSEMBLY,ierr)
282: call MatAssemblyEnd(jac,MAT_FINAL_ASSEMBLY,ierr)
283: return
284: end