Actual source code: ex1f.F90

petsc-3.13.6 2020-09-29
Report Typos and Errors
  1: !
  2: !
  3: !  Description: Uses the Newton method to solve a two-variable system.
  4: !
  5: !!/*T
  6: !  Concepts: SNES^basic uniprocessor example
  7: !  Processors: 1
  8: !T*/


 11: !
 12: ! -----------------------------------------------------------------------

 14:       program main
 15:  #include <petsc/finclude/petsc.h>
 16:       use petsc
 17:       implicit none


 20: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 21: !                   Variable declarations
 22: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 23: !
 24: !  Variables:
 25: !     snes        - nonlinear solver
 26: !     ksp        - linear solver
 27: !     pc          - preconditioner context
 28: !     ksp         - Krylov subspace method context
 29: !     x, r        - solution, residual vectors
 30: !     J           - Jacobian matrix
 31: !     its         - iterations for convergence
 32: !
 33:       SNES     snes
 34:       PC       pc
 35:       KSP      ksp
 36:       Vec      x,r
 37:       Mat      J
 38:       SNESLineSearch linesearch
 39:       PetscErrorCode  ierr
 40:       PetscInt its,i2,i20
 41:       PetscMPIInt size,rank
 42:       PetscScalar   pfive
 43:       PetscReal   tol
 44:       PetscBool   setls
 45:       PetscViewer viewer
 46:       double precision threshold,oldthreshold

 48: !  Note: Any user-defined Fortran routines (such as FormJacobian)
 49: !  MUST be declared as external.

 51:       external FormFunction, FormJacobian, MyLineSearch

 53: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 54: !                   Macro definitions
 55: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 56: !
 57: !  Macros to make clearer the process of setting values in vectors and
 58: !  getting values from vectors.  These vectors are used in the routines
 59: !  FormFunction() and FormJacobian().
 60: !   - The element lx_a(ib) is element ib in the vector x
 61: !
 62: #define lx_a(ib) lx_v(lx_i + (ib))
 63: #define lf_a(ib) lf_v(lf_i + (ib))
 64: !
 65: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 66: !                 Beginning of program
 67: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

 69:       call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
 70:       if (ierr .ne. 0) then
 71:         print*,'Unable to initialize PETSc'
 72:         stop
 73:       endif
 74:       call PetscLogNestedBegin(ierr);CHKERRA(ierr)
 75:       threshold = 1.0
 76:       call PetscLogSetThreshold(threshold,oldthreshold,ierr)
 77: ! dummy test of logging a reduction
 78:       PetscAReduce()
 79:       call MPI_Comm_size(PETSC_COMM_WORLD,size,ierr)
 80:       call MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr)
 81:       if (size .ne. 1) then; SETERRA(PETSC_COMM_SELF,PETSC_ERR_WRONG_MPI_SIZE,'Uniprocessor example'); endif

 83:       i2  = 2
 84:       i20 = 20
 85: ! - - - - - - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - -
 86: !  Create nonlinear solver context
 87: ! - - - - - - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - -

 89:       call SNESCreate(PETSC_COMM_WORLD,snes,ierr)

 91: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 92: !  Create matrix and vector data structures; set corresponding routines
 93: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

 95: !  Create vectors for solution and nonlinear function

 97:       call VecCreateSeq(PETSC_COMM_SELF,i2,x,ierr)
 98:       call VecDuplicate(x,r,ierr)

100: !  Create Jacobian matrix data structure

102:       call MatCreate(PETSC_COMM_SELF,J,ierr)
103:       call MatSetSizes(J,PETSC_DECIDE,PETSC_DECIDE,i2,i2,ierr)
104:       call MatSetFromOptions(J,ierr)
105:       call MatSetUp(J,ierr)

107: !  Set function evaluation routine and vector

109:       call SNESSetFunction(snes,r,FormFunction,0,ierr)

111: !  Set Jacobian matrix data structure and Jacobian evaluation routine

113:       call SNESSetJacobian(snes,J,J,FormJacobian,0,ierr)

115: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
116: !  Customize nonlinear solver; set runtime options
117: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

119: !  Set linear solver defaults for this problem. By extracting the
120: !  KSP, KSP, and PC contexts from the SNES context, we can then
121: !  directly call any KSP, KSP, and PC routines to set various options.

123:       call SNESGetKSP(snes,ksp,ierr)
124:       call KSPGetPC(ksp,pc,ierr)
125:       call PCSetType(pc,PCNONE,ierr)
126:       tol = 1.e-4
127:       call KSPSetTolerances(ksp,tol,PETSC_DEFAULT_REAL,                  &
128:      &                      PETSC_DEFAULT_REAL,i20,ierr)

130: !  Set SNES/KSP/KSP/PC runtime options, e.g.,
131: !      -snes_view -snes_monitor -ksp_type <ksp> -pc_type <pc>
132: !  These options will override those specified above as long as
133: !  SNESSetFromOptions() is called _after_ any other customization
134: !  routines.


137:       call SNESSetFromOptions(snes,ierr)

139:       call PetscOptionsHasName(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,   &
140:      &                         '-setls',setls,ierr)

142:       if (setls) then
143:         call SNESGetLineSearch(snes, linesearch, ierr)
144:         call SNESLineSearchSetType(linesearch, 'shell', ierr)
145:         call SNESLineSearchShellSetUserFunc(linesearch, MyLineSearch,   &
146:      &                                      0, ierr)
147:       endif

149: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
150: !  Evaluate initial guess; then solve nonlinear system
151: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

153: !  Note: The user should initialize the vector, x, with the initial guess
154: !  for the nonlinear solver prior to calling SNESSolve().  In particular,
155: !  to employ an initial guess of zero, the user should explicitly set
156: !  this vector to zero by calling VecSet().

158:       pfive = 0.5
159:       call VecSet(x,pfive,ierr)
160:       call SNESSolve(snes,PETSC_NULL_VEC,x,ierr)
161:       call SNESGetIterationNumber(snes,its,ierr);
162:       if (rank .eq. 0) then
163:          write(6,100) its
164:       endif
165:   100 format('Number of SNES iterations = ',i5)

167: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
168: !  Free work space.  All PETSc objects should be destroyed when they
169: !  are no longer needed.
170: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

172:       call VecDestroy(x,ierr)
173:       call VecDestroy(r,ierr)
174:       call MatDestroy(J,ierr)
175:       call SNESDestroy(snes,ierr)
176:       call PetscViewerASCIIOpen(PETSC_COMM_WORLD,'filename.xml',viewer,ierr)
177:       call PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_XML,ierr)
178:       call PetscLogView(viewer,ierr)
179:       call PetscViewerDestroy(viewer,ierr)
180:       call PetscFinalize(ierr)
181:       end
182: !
183: ! ------------------------------------------------------------------------
184: !
185: !  FormFunction - Evaluates nonlinear function, F(x).
186: !
187: !  Input Parameters:
188: !  snes - the SNES context
189: !  x - input vector
190: !  dummy - optional user-defined context (not used here)
191: !
192: !  Output Parameter:
193: !  f - function vector
194: !
195:       subroutine FormFunction(snes,x,f,dummy,ierr)
196:       use petscsnes
197:       implicit none

199:       SNES     snes
200:       Vec      x,f
201:       PetscErrorCode ierr
202:       integer dummy(*)

204: !  Declarations for use with local arrays

206:       PetscScalar  lx_v(2),lf_v(2)
207:       PetscOffset  lx_i,lf_i

209: !  Get pointers to vector data.
210: !    - For default PETSc vectors, VecGetArray() returns a pointer to
211: !      the data array.  Otherwise, the routine is implementation dependent.
212: !    - You MUST call VecRestoreArray() when you no longer need access to
213: !      the array.
214: !    - Note that the Fortran interface to VecGetArray() differs from the
215: !      C version.  See the Fortran chapter of the users manual for details.

217:       call VecGetArrayRead(x,lx_v,lx_i,ierr)
218:       call VecGetArray(f,lf_v,lf_i,ierr)

220: !  Compute function

222:       lf_a(1) = lx_a(1)*lx_a(1)                                         &
223:      &          + lx_a(1)*lx_a(2) - 3.0
224:       lf_a(2) = lx_a(1)*lx_a(2)                                         &
225:      &          + lx_a(2)*lx_a(2) - 6.0

227: !  Restore vectors

229:       call VecRestoreArrayRead(x,lx_v,lx_i,ierr)
230:       call VecRestoreArray(f,lf_v,lf_i,ierr)

232:       return
233:       end

235: ! ---------------------------------------------------------------------
236: !
237: !  FormJacobian - Evaluates Jacobian matrix.
238: !
239: !  Input Parameters:
240: !  snes - the SNES context
241: !  x - input vector
242: !  dummy - optional user-defined context (not used here)
243: !
244: !  Output Parameters:
245: !  A - Jacobian matrix
246: !  B - optionally different preconditioning matrix
247: !  flag - flag indicating matrix structure
248: !
249:       subroutine FormJacobian(snes,X,jac,B,dummy,ierr)
250:       use petscsnes
251:       implicit none

253:       SNES         snes
254:       Vec          X
255:       Mat          jac,B
256:       PetscScalar  A(4)
257:       PetscErrorCode ierr
258:       PetscInt idx(2),i2
259:       integer dummy(*)

261: !  Declarations for use with local arrays

263:       PetscScalar lx_v(2)
264:       PetscOffset lx_i

266: !  Get pointer to vector data

268:       i2 = 2
269:       call VecGetArrayRead(x,lx_v,lx_i,ierr)

271: !  Compute Jacobian entries and insert into matrix.
272: !   - Since this is such a small problem, we set all entries for
273: !     the matrix at once.
274: !   - Note that MatSetValues() uses 0-based row and column numbers
275: !     in Fortran as well as in C (as set here in the array idx).

277:       idx(1) = 0
278:       idx(2) = 1
279:       A(1) = 2.0*lx_a(1) + lx_a(2)
280:       A(2) = lx_a(1)
281:       A(3) = lx_a(2)
282:       A(4) = lx_a(1) + 2.0*lx_a(2)
283:       call MatSetValues(B,i2,idx,i2,idx,A,INSERT_VALUES,ierr)

285: !  Restore vector

287:       call VecRestoreArrayRead(x,lx_v,lx_i,ierr)

289: !  Assemble matrix

291:       call MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY,ierr)
292:       call MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY,ierr)
293:       if (B .ne. jac) then
294:         call MatAssemblyBegin(jac,MAT_FINAL_ASSEMBLY,ierr)
295:         call MatAssemblyEnd(jac,MAT_FINAL_ASSEMBLY,ierr)
296:       endif

298:       return
299:       end


302:       subroutine MyLineSearch(linesearch, lctx, ierr)
303:       use petscsnes
304:       implicit none

306:       SNESLineSearch    linesearch
307:       SNES              snes
308:       integer           lctx
309:       Vec               x, f,g, y, w
310:       PetscReal         ynorm,gnorm,xnorm
311:       PetscBool         flag
312:       PetscErrorCode    ierr

314:       PetscScalar       mone

316:       mone = -1.0
317:       call SNESLineSearchGetSNES(linesearch, snes, ierr)
318:       call SNESLineSearchGetVecs(linesearch, x, f, y, w, g, ierr)
319:       call VecNorm(y,NORM_2,ynorm,ierr)
320:       call VecAXPY(x,mone,y,ierr)
321:       call SNESComputeFunction(snes,x,f,ierr)
322:       call VecNorm(f,NORM_2,gnorm,ierr)
323:       call VecNorm(x,NORM_2,xnorm,ierr)
324:       call VecNorm(y,NORM_2,ynorm,ierr)
325:       call SNESLineSearchSetNorms(linesearch, xnorm, gnorm, ynorm,      &
326:      & ierr)
327:       flag = PETSC_FALSE
328:       return
329:       end

331: !/*TEST
332: !
333: !   test:
334: !      args: -ksp_gmres_cgs_refinement_type refine_always -snes_monitor_short
335: !      requires: !single
336: !
337: !TEST*/