Actual source code: ex1f.F
1: !
2: ! "$Id: ex1f.F,v 1.33 2001/08/07 03:04:16 balay Exp $";
3: !
4: ! Description: Uses the Newton method to solve a two-variable system.
5: !
6: !/*T
7: ! Concepts: SNES^basic uniprocessor example
8: ! Processors: 1
9: !T*/
10: !
11: ! -----------------------------------------------------------------------
13: program main
14: implicit none
16: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
17: ! Include files
18: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
19: !
20: ! The following include statements are generally used in SNES Fortran
21: ! programs:
22: ! petsc.h - base PETSc routines
23: ! petscvec.h - vectors
24: ! petscmat.h - matrices
25: ! petscksp.h - Krylov subspace methods
26: ! petscpc.h - preconditioners
27: ! petscsles.h - SLES interface
28: ! petscsnes.h - SNES interface
29: ! Other include statements may be needed if using additional PETSc
30: ! routines in a Fortran program, e.g.,
31: ! petscviewer.h - viewers
32: ! petscis.h - index sets
33: !
34: #include include/finclude/petsc.h
35: #include include/finclude/petscvec.h
36: #include include/finclude/petscmat.h
37: #include include/finclude/petscksp.h
38: #include include/finclude/petscpc.h
39: #include include/finclude/petscsles.h
40: #include include/finclude/petscsnes.h
41: !
42: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
43: ! Variable declarations
44: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
45: !
46: ! Variables:
47: ! snes - nonlinear solver
48: ! sles - linear solver
49: ! pc - preconditioner context
50: ! ksp - Krylov subspace method context
51: ! x, r - solution, residual vectors
52: ! J - Jacobian matrix
53: ! its - iterations for convergence
54: !
55: SNES snes
56: SLES sles
57: PC pc
58: KSP ksp
59: Vec x,r
60: Mat J
61: integer ierr,its,size,rank
62: PetscScalar pfive
63: double precision tol
64: PetscTruth setls
66: ! Note: Any user-defined Fortran routines (such as FormJacobian)
67: ! MUST be declared as external.
69: external FormFunction, FormJacobian, MyLineSearch
71: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
72: ! Macro definitions
73: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
74: !
75: ! Macros to make clearer the process of setting values in vectors and
76: ! getting values from vectors. These vectors are used in the routines
77: ! FormFunction() and FormJacobian().
78: ! - The element lx_a(ib) is element ib in the vector x
79: !
80: #define lx_a(ib) lx_v(lx_i + (ib))
81: #define lf_a(ib) lf_v(lf_i + (ib))
82: !
83: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
84: ! Beginning of program
85: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
87: call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
88: call MPI_Comm_size(PETSC_COMM_WORLD,size,ierr)
89: call MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr)
90: if (size .ne. 1) then
91: if (rank .eq. 0) then
92: write(6,*) 'This is a uniprocessor example only!'
93: endif
94: SETERRQ(1,' ',ierr)
95: endif
97: ! - - - - - - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - -
98: ! Create nonlinear solver context
99: ! - - - - - - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - -
101: call SNESCreate(PETSC_COMM_WORLD,SNES_NONLINEAR_EQUATIONS, &
102: & snes,ierr)
104: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
105: ! Create matrix and vector data structures; set corresponding routines
106: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
108: ! Create vectors for solution and nonlinear function
110: call VecCreateSeq(PETSC_COMM_SELF,2,x,ierr)
111: call VecDuplicate(x,r,ierr)
113: ! Create Jacobian matrix data structure
115: call MatCreate(PETSC_COMM_SELF,PETSC_DECIDE,PETSC_DECIDE,2,2,J, &
116: & ierr)
117: call MatSetFromOptions(J,ierr)
119: ! Set function evaluation routine and vector
121: call SNESSetFunction(snes,r,FormFunction,PETSC_NULL_OBJECT,ierr)
123: ! Set Jacobian matrix data structure and Jacobian evaluation routine
125: call SNESSetJacobian(snes,J,J,FormJacobian,PETSC_NULL_OBJECT, &
126: & ierr)
128: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
129: ! Customize nonlinear solver; set runtime options
130: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
132: ! Set linear solver defaults for this problem. By extracting the
133: ! SLES, KSP, and PC contexts from the SNES context, we can then
134: ! directly call any SLES, KSP, and PC routines to set various options.
136: call SNESGetSLES(snes,sles,ierr)
137: call SLESGetKSP(sles,ksp,ierr)
138: call SLESGetPC(sles,pc,ierr)
139: call PCSetType(pc,PCNONE,ierr)
140: tol = 1.e-4
141: call KSPSetTolerances(ksp,tol,PETSC_DEFAULT_DOUBLE_PRECISION, &
142: & PETSC_DEFAULT_DOUBLE_PRECISION,20,ierr)
144: ! Set SNES/SLES/KSP/PC runtime options, e.g.,
145: ! -snes_view -snes_monitor -ksp_type <ksp> -pc_type <pc>
146: ! These options will override those specified above as long as
147: ! SNESSetFromOptions() is called _after_ any other customization
148: ! routines.
151: call SNESSetFromOptions(snes,ierr)
153: call PetscOptionsHasName(PETSC_NULL_CHARACTER,'-setls',setls,ierr)
155: if (setls .eq. PETSC_TRUE) then
156: call SNESSetLineSearch(snes,MyLineSearch, &
157: & PETSC_NULL_OBJECT,ierr)
158: endif
160: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
161: ! Evaluate initial guess; then solve nonlinear system
162: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
164: ! Note: The user should initialize the vector, x, with the initial guess
165: ! for the nonlinear solver prior to calling SNESSolve(). In particular,
166: ! to employ an initial guess of zero, the user should explicitly set
167: ! this vector to zero by calling VecSet().
169: pfive = 0.5
170: call VecSet(pfive,x,ierr)
171: call SNESSolve(snes,x,its,ierr)
172: if (rank .eq. 0) then
173: write(6,100) its
174: endif
175: 100 format('Number of Newton iterations = ',i5)
177: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
178: ! Free work space. All PETSc objects should be destroyed when they
179: ! are no longer needed.
180: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
182: call VecDestroy(x,ierr)
183: call VecDestroy(r,ierr)
184: call MatDestroy(J,ierr)
185: call SNESDestroy(snes,ierr)
186: call PetscFinalize(ierr)
187: end
188: ! ---------------------------------------------------------------------
189: !
190: ! FormFunction - Evaluates nonlinear function, F(x).
191: !
192: ! Input Parameters:
193: ! snes - the SNES context
194: ! x - input vector
195: ! dummy - optional user-defined context (not used here)
196: !
197: ! Output Parameter:
198: ! f - function vector
199: !
200: subroutine FormFunction(snes,x,f,dummy,ierr)
201: implicit none
203: #include include/finclude/petsc.h
204: #include include/finclude/petscvec.h
205: #include include/finclude/petscsnes.h
207: SNES snes
208: Vec x,f
209: integer ierr,dummy(*)
211: ! Declarations for use with local arrays
213: PetscScalar lx_v(1),lf_v(1)
214: PetscOffset lx_i,lf_i
216: ! Get pointers to vector data.
217: ! - For default PETSc vectors, VecGetArray() returns a pointer to
218: ! the data array. Otherwise, the routine is implementation dependent.
219: ! - You MUST call VecRestoreArray() when you no longer need access to
220: ! the array.
221: ! - Note that the Fortran interface to VecGetArray() differs from the
222: ! C version. See the Fortran chapter of the users manual for details.
224: call VecGetArray(x,lx_v,lx_i,ierr)
225: call VecGetArray(f,lf_v,lf_i,ierr)
227: ! Compute function
229: lf_a(1) = lx_a(1)*lx_a(1) &
230: & + lx_a(1)*lx_a(2) - 3.0
231: lf_a(2) = lx_a(1)*lx_a(2) &
232: & + lx_a(2)*lx_a(2) - 6.0
234: ! Restore vectors
236: call VecRestoreArray(x,lx_v,lx_i,ierr)
237: call VecRestoreArray(f,lf_v,lf_i,ierr)
239: return
240: end
242: ! ---------------------------------------------------------------------
243: !
244: ! FormJacobian - Evaluates Jacobian matrix.
245: !
246: ! Input Parameters:
247: ! snes - the SNES context
248: ! x - input vector
249: ! dummy - optional user-defined context (not used here)
250: !
251: ! Output Parameters:
252: ! A - Jacobian matrix
253: ! B - optionally different preconditioning matrix
254: ! flag - flag indicating matrix structure
255: !
256: subroutine FormJacobian(snes,X,jac,B,flag,dummy,ierr)
257: implicit none
259: #include include/finclude/petsc.h
260: #include include/finclude/petscvec.h
261: #include include/finclude/petscmat.h
262: #include include/finclude/petscpc.h
263: #include include/finclude/petscsnes.h
265: SNES snes
266: Vec X
267: Mat jac,B
268: MatStructure flag
269: PetscScalar A(4)
270: integer ierr,idx(2),dummy(*)
272: ! Declarations for use with local arrays
274: PetscScalar lx_v(1)
275: PetscOffset lx_i
277: ! Get pointer to vector data
279: call VecGetArray(x,lx_v,lx_i,ierr)
281: ! Compute Jacobian entries and insert into matrix.
282: ! - Since this is such a small problem, we set all entries for
283: ! the matrix at once.
284: ! - Note that MatSetValues() uses 0-based row and column numbers
285: ! in Fortran as well as in C (as set here in the array idx).
287: idx(1) = 0
288: idx(2) = 1
289: A(1) = 2.0*lx_a(1) + lx_a(2)
290: A(2) = lx_a(1)
291: A(3) = lx_a(2)
292: A(4) = lx_a(1) + 2.0*lx_a(2)
293: call MatSetValues(jac,2,idx,2,idx,A,INSERT_VALUES,ierr)
294: flag = SAME_NONZERO_PATTERN
296: ! Restore vector
298: call VecRestoreArray(x,lx_v,lx_i,ierr)
300: ! Assemble matrix
302: call MatAssemblyBegin(jac,MAT_FINAL_ASSEMBLY,ierr)
303: call MatAssemblyEnd(jac,MAT_FINAL_ASSEMBLY,ierr)
305: return
306: end
309: subroutine MyLineSearch(snes,lctx,x,f,g,y,w,fnorm,ynorm,gnorm, &
310: & flag,ierr)
311: #include include/finclude/petsc.h
312: #include include/finclude/petscvec.h
313: #include include/finclude/petscmat.h
314: #include include/finclude/petscksp.h
315: #include include/finclude/petscpc.h
316: #include include/finclude/petscsles.h
317: #include include/finclude/petscsnes.h
319: SNES snes
320: integer lctx
321: Vec x, f,g, y, w
322: double precision fnorm,ynorm,gnorm
323: integer flag,ierr
325: PetscScalar mone
327: mone = -1.0d0
328: flag = 0
329: call VecNorm(y,NORM_2,ynorm,ierr)
330: call VecAYPX(mone,x,y,ierr)
331: call SNESComputeFunction(snes,y,g,ierr)
332: call VecNorm(g,NORM_2,gnorm,ierr)
333: return
334: end