Actual source code: ex1f.F

  1: !
  2: ! "$Id: ex1f.F,v 1.32 2001/04/06 19:54:59 balay Exp $";
  3: !
  4: !/*T
  5: !  Concepts: SNES^basic uniprocessor example
  6: !  Processors: 1
  7: !T*/
  8: !
  9: !  Description: Uses the Newton method to solve a two-variable system.
 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:       Scalar   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:       Scalar       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:       Scalar       A(4)
270:       integer      ierr,idx(2),dummy(*)

272: !  Declarations for use with local arrays

274:       Scalar      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:       Scalar     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