xref: /petsc/src/snes/tutorials/ex5f.F90 (revision ccfd86f17c20321558100f6af55b03dc7cd752d2)
1c4762a1bSJed Brown!
242ce371bSBarry Smith!  This example shows how to avoid Fortran line lengths larger than 132 characters.
3dcb3e689SBarry Smith!  It avoids used of certain macros such as PetscCallA() and PetscCheckA() that
4dcb3e689SBarry Smith!  generate very long lines
5dcb3e689SBarry Smith!
642ce371bSBarry Smith!  We recommend starting from src/snes/tutorials/ex5f90.F90 instead of this example
7dcb3e689SBarry Smith!  because that does not have the restricted formatting that makes this version
8dcb3e689SBarry Smith!  more difficult to read
942ce371bSBarry Smith!
10c4762a1bSJed Brown!  Description: This example solves a nonlinear system in parallel with SNES.
11c4762a1bSJed Brown!  We solve the  Bratu (SFI - solid fuel ignition) problem in a 2D rectangular
12c4762a1bSJed Brown!  domain, using distributed arrays (DMDAs) to partition the parallel grid.
13c4762a1bSJed Brown!  The command line options include:
14c4762a1bSJed Brown!    -par <param>, where <param> indicates the nonlinearity of the problem
15c4762a1bSJed Brown!       problem SFI:  <parameter> = Bratu parameter (0 <= par <= 6.81)
16c4762a1bSJed Brown!
17c4762a1bSJed Brown!  --------------------------------------------------------------------------
18c4762a1bSJed Brown!
19c4762a1bSJed Brown!  Solid Fuel Ignition (SFI) problem.  This problem is modeled by
20c4762a1bSJed Brown!  the partial differential equation
21c4762a1bSJed Brown!
22c4762a1bSJed Brown!          -Laplacian u - lambda*exp(u) = 0,  0 < x,y < 1,
23c4762a1bSJed Brown!
24c4762a1bSJed Brown!  with boundary conditions
25c4762a1bSJed Brown!
26c4762a1bSJed Brown!           u = 0  for  x = 0, x = 1, y = 0, y = 1.
27c4762a1bSJed Brown!
28c4762a1bSJed Brown!  A finite difference approximation with the usual 5-point stencil
29c4762a1bSJed Brown!  is used to discretize the boundary value problem to obtain a nonlinear
30c4762a1bSJed Brown!  system of equations.
31c4762a1bSJed Brown!
32c4762a1bSJed Brown!  --------------------------------------------------------------------------
33dfbbaf82SBarry Smith      module ex5fmodule
34dfbbaf82SBarry Smith      use petscsnes
35dfbbaf82SBarry Smith      use petscdmda
36dfbbaf82SBarry Smith#include <petsc/finclude/petscsnes.h>
37dfbbaf82SBarry Smith#include <petsc/finclude/petscdmda.h>
38dfbbaf82SBarry Smith      PetscInt xs,xe,xm,gxs,gxe,gxm
39dfbbaf82SBarry Smith      PetscInt ys,ye,ym,gys,gye,gym
40dfbbaf82SBarry Smith      PetscInt mx,my
41dfbbaf82SBarry Smith      PetscMPIInt rank,size
42dfbbaf82SBarry Smith      PetscReal lambda
43dfbbaf82SBarry Smith      end module ex5fmodule
44c4762a1bSJed Brown
45c4762a1bSJed Brown      program main
46dfbbaf82SBarry Smith      use ex5fmodule
47c4762a1bSJed Brown      implicit none
48c4762a1bSJed Brown
49c4762a1bSJed Brown! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
50c4762a1bSJed Brown!                   Variable declarations
51c4762a1bSJed Brown! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
52c4762a1bSJed Brown!
53c4762a1bSJed Brown!  Variables:
54c4762a1bSJed Brown!     snes        - nonlinear solver
55c4762a1bSJed Brown!     x, r        - solution, residual vectors
56c4762a1bSJed Brown!     its         - iterations for convergence
57c4762a1bSJed Brown!
58c4762a1bSJed Brown!  See additional variable declarations in the file ex5f.h
59c4762a1bSJed Brown!
60c4762a1bSJed Brown      SNES           snes
61c4762a1bSJed Brown      Vec            x,r
62c4762a1bSJed Brown      PetscInt       its,i1,i4
63c4762a1bSJed Brown      PetscErrorCode ierr
64c4762a1bSJed Brown      PetscReal      lambda_max,lambda_min
65c4762a1bSJed Brown      PetscBool      flg
66c4762a1bSJed Brown      DM             da
67c4762a1bSJed Brown
68c4762a1bSJed Brown!  Note: Any user-defined Fortran routines (such as FormJacobianLocal)
69c4762a1bSJed Brown!  MUST be declared as external.
70c4762a1bSJed Brown
71c4762a1bSJed Brown      external FormInitialGuess
72c4762a1bSJed Brown      external FormFunctionLocal,FormJacobianLocal
73c4762a1bSJed Brown      external MySNESConverged
74c4762a1bSJed Brown
75c4762a1bSJed Brown! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
76c4762a1bSJed Brown!  Initialize program
77c4762a1bSJed Brown! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
78c4762a1bSJed Brown
7965afa91aSSatish Balay      call PetscInitialize(ierr)
8065afa91aSSatish Balay      CHKERRA(ierr)
8165afa91aSSatish Balay      call MPI_Comm_size(PETSC_COMM_WORLD,size,ierr)
8265afa91aSSatish Balay      CHKERRMPIA(ierr)
8365afa91aSSatish Balay      call MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr)
8465afa91aSSatish Balay      CHKERRMPIA(ierr)
85c4762a1bSJed Brown!  Initialize problem parameters
86c4762a1bSJed Brown
87c4762a1bSJed Brown      i1 = 1
88c4762a1bSJed Brown      i4 = 4
89c4762a1bSJed Brown      lambda_max = 6.81
90c4762a1bSJed Brown      lambda_min = 0.0
91c4762a1bSJed Brown      lambda     = 6.0
9265afa91aSSatish Balay      call PetscOptionsGetReal(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-par',lambda,PETSC_NULL_BOOL,ierr)
9365afa91aSSatish Balay      CHKERRA(ierr)
9465afa91aSSatish Balay
95c4762a1bSJed Brown! this statement is split into multiple-lines to keep lines under 132 char limit - required by 'make check'
96c4762a1bSJed Brown      if (lambda .ge. lambda_max .or. lambda .le. lambda_min) then
97*ccfd86f1SBarry Smith         ierr = PETSC_ERR_ARG_OUTOFRANGE
98dcb3e689SBarry Smith         SETERRA(PETSC_COMM_WORLD,ierr,'Lambda')
99c4762a1bSJed Brown      endif
100c4762a1bSJed Brown
101c4762a1bSJed Brown! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
102c4762a1bSJed Brown!  Create nonlinear solver context
103c4762a1bSJed Brown! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
104c4762a1bSJed Brown
10565afa91aSSatish Balay      call SNESCreate(PETSC_COMM_WORLD,snes,ierr)
10665afa91aSSatish Balay      CHKERRA(ierr)
107c4762a1bSJed Brown
108c4762a1bSJed Brown!  Set convergence test routine if desired
109c4762a1bSJed Brown
11065afa91aSSatish Balay      call PetscOptionsHasName(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-my_snes_convergence',flg,ierr)
11165afa91aSSatish Balay      CHKERRA(ierr)
112c4762a1bSJed Brown      if (flg) then
11365afa91aSSatish Balay        call SNESSetConvergenceTest(snes,MySNESConverged,0,PETSC_NULL_FUNCTION,ierr)
11465afa91aSSatish Balay        CHKERRA(ierr)
115c4762a1bSJed Brown      endif
116c4762a1bSJed Brown
117c4762a1bSJed Brown! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
118c4762a1bSJed Brown!  Create vector data structures; set function evaluation routine
119c4762a1bSJed Brown! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
120c4762a1bSJed Brown
121c4762a1bSJed Brown!  Create distributed array (DMDA) to manage parallel grid and vectors
122c4762a1bSJed Brown
12342ce371bSBarry Smith!     This really needs only the star-type stencil, but we use the box stencil
12460cf0239SBarry Smith
12565afa91aSSatish Balay      call DMDACreate2d(PETSC_COMM_WORLD,DM_BOUNDARY_NONE,DM_BOUNDARY_NONE,DMDA_STENCIL_STAR,i4,i4,PETSC_DECIDE,PETSC_DECIDE, &
1265d83a8b1SBarry Smith                        i1,i1, PETSC_NULL_INTEGER_ARRAY,PETSC_NULL_INTEGER_ARRAY,da,ierr)
12765afa91aSSatish Balay      CHKERRA(ierr)
12865afa91aSSatish Balay      call DMSetFromOptions(da,ierr)
12965afa91aSSatish Balay      CHKERRA(ierr)
13065afa91aSSatish Balay      call DMSetUp(da,ierr)
13165afa91aSSatish Balay      CHKERRA(ierr)
132c4762a1bSJed Brown
133c4762a1bSJed Brown!  Extract global and local vectors from DMDA; then duplicate for remaining
134c4762a1bSJed Brown!  vectors that are the same types
135c4762a1bSJed Brown
13665afa91aSSatish Balay      call DMCreateGlobalVector(da,x,ierr)
13765afa91aSSatish Balay      CHKERRA(ierr)
13865afa91aSSatish Balay      call VecDuplicate(x,r,ierr)
13965afa91aSSatish Balay      CHKERRA(ierr)
140c4762a1bSJed Brown
141c4762a1bSJed Brown!  Get local grid boundaries (for 2-dimensional DMDA)
142c4762a1bSJed Brown
14360cf0239SBarry Smith      call DMDAGetInfo(da,PETSC_NULL_INTEGER,mx,my,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER, &
144ce78bad3SBarry Smith                       PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,PETSC_NULL_DMBOUNDARYTYPE,PETSC_NULL_DMBOUNDARYTYPE, &
145ce78bad3SBarry Smith                       PETSC_NULL_DMBOUNDARYTYPE,PETSC_NULL_DMDASTENCILTYPE,ierr)
14665afa91aSSatish Balay      CHKERRA(ierr)
14765afa91aSSatish Balay      call DMDAGetCorners(da,xs,ys,PETSC_NULL_INTEGER,xm,ym,PETSC_NULL_INTEGER,ierr)
14865afa91aSSatish Balay      CHKERRA(ierr)
14965afa91aSSatish Balay      call DMDAGetGhostCorners(da,gxs,gys,PETSC_NULL_INTEGER,gxm,gym,PETSC_NULL_INTEGER,ierr)
15065afa91aSSatish Balay      CHKERRA(ierr)
151c4762a1bSJed Brown
152c4762a1bSJed Brown!  Here we shift the starting indices up by one so that we can easily
153c4762a1bSJed Brown!  use the Fortran convention of 1-based indices (rather 0-based indices).
154c4762a1bSJed Brown
155c4762a1bSJed Brown      xs  = xs+1
156c4762a1bSJed Brown      ys  = ys+1
157c4762a1bSJed Brown      gxs = gxs+1
158c4762a1bSJed Brown      gys = gys+1
159c4762a1bSJed Brown
160c4762a1bSJed Brown      ye  = ys+ym-1
161c4762a1bSJed Brown      xe  = xs+xm-1
162c4762a1bSJed Brown      gye = gys+gym-1
163c4762a1bSJed Brown      gxe = gxs+gxm-1
164c4762a1bSJed Brown
165c4762a1bSJed Brown!  Set function evaluation routine and vector
166c4762a1bSJed Brown
16765afa91aSSatish Balay      call DMDASNESSetFunctionLocal(da,INSERT_VALUES,FormFunctionLocal,da,ierr)
16865afa91aSSatish Balay      CHKERRA(ierr)
16965afa91aSSatish Balay      call DMDASNESSetJacobianLocal(da,FormJacobianLocal,da,ierr)
17065afa91aSSatish Balay      CHKERRA(ierr)
17165afa91aSSatish Balay      call SNESSetDM(snes,da,ierr)
17265afa91aSSatish Balay      CHKERRA(ierr)
173c4762a1bSJed Brown
174c4762a1bSJed Brown! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
175c4762a1bSJed Brown!  Customize nonlinear solver; set runtime options
176c4762a1bSJed Brown! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
177c4762a1bSJed Brown
178c4762a1bSJed Brown!  Set runtime options (e.g., -snes_monitor -snes_rtol <rtol> -ksp_type <type>)
179c4762a1bSJed Brown
18065afa91aSSatish Balay      call SNESSetFromOptions(snes,ierr)
18165afa91aSSatish Balay      CHKERRA(ierr)
182c4762a1bSJed Brown! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
183c4762a1bSJed Brown!  Evaluate initial guess; then solve nonlinear system.
184c4762a1bSJed Brown! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
185c4762a1bSJed Brown
186c4762a1bSJed Brown!  Note: The user should initialize the vector, x, with the initial guess
187c4762a1bSJed Brown!  for the nonlinear solver prior to calling SNESSolve().  In particular,
188c4762a1bSJed Brown!  to employ an initial guess of zero, the user should explicitly set
189c4762a1bSJed Brown!  this vector to zero by calling VecSet().
190c4762a1bSJed Brown
19165afa91aSSatish Balay      call FormInitialGuess(x,ierr)
19265afa91aSSatish Balay      CHKERRA(ierr)
19365afa91aSSatish Balay      call SNESSolve(snes,PETSC_NULL_VEC,x,ierr)
19465afa91aSSatish Balay      CHKERRA(ierr)
19565afa91aSSatish Balay      call SNESGetIterationNumber(snes,its,ierr)
19665afa91aSSatish Balay      CHKERRA(ierr)
197c4762a1bSJed Brown      if (rank .eq. 0) then
198c4762a1bSJed Brown         write(6,100) its
199c4762a1bSJed Brown      endif
200c4762a1bSJed Brown  100 format('Number of SNES iterations = ',i5)
201c4762a1bSJed Brown
202c4762a1bSJed Brown! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
203c4762a1bSJed Brown!  Free work space.  All PETSc objects should be destroyed when they
204c4762a1bSJed Brown!  are no longer needed.
205c4762a1bSJed Brown! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
206c4762a1bSJed Brown
20765afa91aSSatish Balay      call VecDestroy(x,ierr)
20865afa91aSSatish Balay      CHKERRA(ierr)
20965afa91aSSatish Balay      call VecDestroy(r,ierr)
21065afa91aSSatish Balay      CHKERRA(ierr)
21165afa91aSSatish Balay      call SNESDestroy(snes,ierr)
21265afa91aSSatish Balay      CHKERRA(ierr)
21365afa91aSSatish Balay      call DMDestroy(da,ierr)
21465afa91aSSatish Balay      CHKERRA(ierr)
21565afa91aSSatish Balay      call PetscFinalize(ierr)
21665afa91aSSatish Balay      CHKERRA(ierr)
217c4762a1bSJed Brown      end
218c4762a1bSJed Brown
219c4762a1bSJed Brown! ---------------------------------------------------------------------
220c4762a1bSJed Brown!
221c4762a1bSJed Brown!  FormInitialGuess - Forms initial approximation.
222c4762a1bSJed Brown!
223c4762a1bSJed Brown!  Input Parameters:
224c4762a1bSJed Brown!  X - vector
225c4762a1bSJed Brown!
226c4762a1bSJed Brown!  Output Parameter:
227c4762a1bSJed Brown!  X - vector
228c4762a1bSJed Brown!
229c4762a1bSJed Brown!  Notes:
230c4762a1bSJed Brown!  This routine serves as a wrapper for the lower-level routine
231c4762a1bSJed Brown!  "ApplicationInitialGuess", where the actual computations are
232c4762a1bSJed Brown!  done using the standard Fortran style of treating the local
233c4762a1bSJed Brown!  vector data as a multidimensional array over the local mesh.
234c4762a1bSJed Brown!  This routine merely handles ghost point scatters and accesses
235ce78bad3SBarry Smith!  the local vector data via VecGetArray() and VecRestoreArray().
236c4762a1bSJed Brown!
237c4762a1bSJed Brown      subroutine FormInitialGuess(X,ierr)
238dfbbaf82SBarry Smith      use ex5fmodule
239c4762a1bSJed Brown      implicit none
240c4762a1bSJed Brown
241c4762a1bSJed Brown!  Input/output variables:
242c4762a1bSJed Brown      Vec      X
243c4762a1bSJed Brown      PetscErrorCode  ierr
244c4762a1bSJed Brown!  Declarations for use with local arrays:
24542ce371bSBarry Smith      PetscScalar, pointer :: lx_v(:)
246c4762a1bSJed Brown
247c4762a1bSJed Brown      ierr = 0
248c4762a1bSJed Brown
249c4762a1bSJed Brown!  Get a pointer to vector data.
250c4762a1bSJed Brown!    - For default PETSc vectors, VecGetArray() returns a pointer to
251c4762a1bSJed Brown!      the data array.  Otherwise, the routine is implementation dependent.
252c4762a1bSJed Brown!    - You MUST call VecRestoreArray() when you no longer need access to
253c4762a1bSJed Brown!      the array.
254c4762a1bSJed Brown!    - Note that the Fortran interface to VecGetArray() differs from the
255c4762a1bSJed Brown!      C version.  See the users manual for details.
256c4762a1bSJed Brown
257ce78bad3SBarry Smith       call VecGetArray(X,lx_v,ierr)
25865afa91aSSatish Balay      CHKERRQ(ierr)
259c4762a1bSJed Brown
260c4762a1bSJed Brown!  Compute initial guess over the locally owned part of the grid
261c4762a1bSJed Brown
26242ce371bSBarry Smith      call InitialGuessLocal(lx_v,ierr)
26365afa91aSSatish Balay      CHKERRQ(ierr)
264c4762a1bSJed Brown
265c4762a1bSJed Brown!  Restore vector
266c4762a1bSJed Brown
267ce78bad3SBarry Smith      call VecRestoreArray(X,lx_v,ierr)
26865afa91aSSatish Balay      CHKERRQ(ierr)
269c4762a1bSJed Brown
270c4762a1bSJed Brown      end
271c4762a1bSJed Brown
272c4762a1bSJed Brown! ---------------------------------------------------------------------
273c4762a1bSJed Brown!
274c4762a1bSJed Brown!  InitialGuessLocal - Computes initial approximation, called by
275c4762a1bSJed Brown!  the higher level routine FormInitialGuess().
276c4762a1bSJed Brown!
277c4762a1bSJed Brown!  Input Parameter:
278c4762a1bSJed Brown!  x - local vector data
279c4762a1bSJed Brown!
280c4762a1bSJed Brown!  Output Parameters:
281c4762a1bSJed Brown!  x - local vector data
282c4762a1bSJed Brown!  ierr - error code
283c4762a1bSJed Brown!
284c4762a1bSJed Brown!  Notes:
285c4762a1bSJed Brown!  This routine uses standard Fortran-style computations over a 2-dim array.
286c4762a1bSJed Brown!
287c4762a1bSJed Brown      subroutine InitialGuessLocal(x,ierr)
288dfbbaf82SBarry Smith      use ex5fmodule
289c4762a1bSJed Brown      implicit none
290c4762a1bSJed Brown
291c4762a1bSJed Brown!  Input/output variables:
292c4762a1bSJed Brown      PetscScalar    x(xs:xe,ys:ye)
293c4762a1bSJed Brown      PetscErrorCode ierr
294c4762a1bSJed Brown
295c4762a1bSJed Brown!  Local variables:
296c4762a1bSJed Brown      PetscInt  i,j
297c4762a1bSJed Brown      PetscReal temp1,temp,one,hx,hy
298c4762a1bSJed Brown
299c4762a1bSJed Brown!  Set parameters
300c4762a1bSJed Brown
301c4762a1bSJed Brown      ierr   = 0
302c4762a1bSJed Brown      one    = 1.0
303bb060b03SBarry Smith      hx     = one/((real(mx)-1))
304bb060b03SBarry Smith      hy     = one/((real(my)-1))
305c4762a1bSJed Brown      temp1  = lambda/(lambda + one)
306c4762a1bSJed Brown
307c4762a1bSJed Brown      do 20 j=ys,ye
308bb060b03SBarry Smith         temp = (real(min(j-1,my-j)))*hy
309c4762a1bSJed Brown         do 10 i=xs,xe
310c4762a1bSJed Brown            if (i .eq. 1 .or. j .eq. 1 .or. i .eq. mx .or. j .eq. my) then
311c4762a1bSJed Brown              x(i,j) = 0.0
312c4762a1bSJed Brown            else
313bb060b03SBarry Smith              x(i,j) = temp1 * sqrt(min(real(min(i-1,mx-i))*hx,(temp)))
314c4762a1bSJed Brown            endif
315c4762a1bSJed Brown 10      continue
316c4762a1bSJed Brown 20   continue
317c4762a1bSJed Brown
318c4762a1bSJed Brown      end
319c4762a1bSJed Brown
320c4762a1bSJed Brown! ---------------------------------------------------------------------
321c4762a1bSJed Brown!
322c4762a1bSJed Brown!  FormFunctionLocal - Computes nonlinear function, called by
323c4762a1bSJed Brown!  the higher level routine FormFunction().
324c4762a1bSJed Brown!
325c4762a1bSJed Brown!  Input Parameter:
326c4762a1bSJed Brown!  x - local vector data
327c4762a1bSJed Brown!
328c4762a1bSJed Brown!  Output Parameters:
329c4762a1bSJed Brown!  f - local vector data, f(x)
330c4762a1bSJed Brown!  ierr - error code
331c4762a1bSJed Brown!
332c4762a1bSJed Brown!  Notes:
333c4762a1bSJed Brown!  This routine uses standard Fortran-style computations over a 2-dim array.
334c4762a1bSJed Brown!
335c4762a1bSJed Brown!
336c4762a1bSJed Brown      subroutine FormFunctionLocal(info,x,f,da,ierr)
337dfbbaf82SBarry Smith      use ex5fmodule
338c4762a1bSJed Brown      implicit none
339c4762a1bSJed Brown
340c4762a1bSJed Brown      DM da
341c4762a1bSJed Brown
342c4762a1bSJed Brown!  Input/output variables:
343ce78bad3SBarry Smith      DMDALocalInfo info
344c4762a1bSJed Brown      PetscScalar x(gxs:gxe,gys:gye)
345c4762a1bSJed Brown      PetscScalar f(xs:xe,ys:ye)
346c4762a1bSJed Brown      PetscErrorCode     ierr
347c4762a1bSJed Brown
348c4762a1bSJed Brown!  Local variables:
349c4762a1bSJed Brown      PetscScalar two,one,hx,hy
350c4762a1bSJed Brown      PetscScalar hxdhy,hydhx,sc
351c4762a1bSJed Brown      PetscScalar u,uxx,uyy
352c4762a1bSJed Brown      PetscInt  i,j
353c4762a1bSJed Brown
354ce78bad3SBarry Smith      xs     = info%XS+1
355ce78bad3SBarry Smith      xe     = xs+info%XM-1
356ce78bad3SBarry Smith      ys     = info%YS+1
357ce78bad3SBarry Smith      ye     = ys+info%YM-1
358ce78bad3SBarry Smith      mx     = info%MX
359ce78bad3SBarry Smith      my     = info%MY
360c4762a1bSJed Brown
361c4762a1bSJed Brown      one    = 1.0
362c4762a1bSJed Brown      two    = 2.0
363bb060b03SBarry Smith      hx     = one/(real(mx)-1)
364bb060b03SBarry Smith      hy     = one/(real(my)-1)
365c4762a1bSJed Brown      sc     = hx*hy*lambda
366c4762a1bSJed Brown      hxdhy  = hx/hy
367c4762a1bSJed Brown      hydhx  = hy/hx
368c4762a1bSJed Brown
369c4762a1bSJed Brown!  Compute function over the locally owned part of the grid
370c4762a1bSJed Brown
371c4762a1bSJed Brown      do 20 j=ys,ye
372c4762a1bSJed Brown         do 10 i=xs,xe
373c4762a1bSJed Brown            if (i .eq. 1 .or. j .eq. 1 .or. i .eq. mx .or. j .eq. my) then
374c4762a1bSJed Brown               f(i,j) = x(i,j)
375c4762a1bSJed Brown            else
376c4762a1bSJed Brown               u = x(i,j)
377c4762a1bSJed Brown               uxx = hydhx * (two*u - x(i-1,j) - x(i+1,j))
378c4762a1bSJed Brown               uyy = hxdhy * (two*u - x(i,j-1) - x(i,j+1))
379c4762a1bSJed Brown               f(i,j) = uxx + uyy - sc*exp(u)
380c4762a1bSJed Brown            endif
381c4762a1bSJed Brown 10      continue
382c4762a1bSJed Brown 20   continue
383c4762a1bSJed Brown
38465afa91aSSatish Balay      call PetscLogFlops(11.0d0*ym*xm,ierr)
38565afa91aSSatish Balay      CHKERRQ(ierr)
386c4762a1bSJed Brown
387c4762a1bSJed Brown      end
388c4762a1bSJed Brown
389c4762a1bSJed Brown! ---------------------------------------------------------------------
390c4762a1bSJed Brown!
391c4762a1bSJed Brown!  FormJacobianLocal - Computes Jacobian matrix, called by
392c4762a1bSJed Brown!  the higher level routine FormJacobian().
393c4762a1bSJed Brown!
394c4762a1bSJed Brown!  Input Parameters:
395c4762a1bSJed Brown!  x        - local vector data
396c4762a1bSJed Brown!
397c4762a1bSJed Brown!  Output Parameters:
398c4762a1bSJed Brown!  jac      - Jacobian matrix
3997addb90fSBarry Smith!  jac_prec - optionally different matrix used to construct the preconditioner (not used here)
400c4762a1bSJed Brown!  ierr     - error code
401c4762a1bSJed Brown!
402c4762a1bSJed Brown!  Notes:
403c4762a1bSJed Brown!  This routine uses standard Fortran-style computations over a 2-dim array.
404c4762a1bSJed Brown!
405c4762a1bSJed Brown!  Notes:
406c4762a1bSJed Brown!  Due to grid point reordering with DMDAs, we must always work
407c4762a1bSJed Brown!  with the local grid points, and then transform them to the new
408c4762a1bSJed Brown!  global numbering with the "ltog" mapping
409c4762a1bSJed Brown!  We cannot work directly with the global numbers for the original
410c4762a1bSJed Brown!  uniprocessor grid!
411c4762a1bSJed Brown!
412c4762a1bSJed Brown!  Two methods are available for imposing this transformation
413c4762a1bSJed Brown!  when setting matrix entries:
414c4762a1bSJed Brown!    (A) MatSetValuesLocal(), using the local ordering (including
415c4762a1bSJed Brown!        ghost points!)
416c4762a1bSJed Brown!          by calling MatSetValuesLocal()
417c4762a1bSJed Brown!    (B) MatSetValues(), using the global ordering
418c4762a1bSJed Brown!        - Use DMDAGetGlobalIndices() to extract the local-to-global map
419c4762a1bSJed Brown!        - Then apply this map explicitly yourself
420c4762a1bSJed Brown!        - Set matrix entries using the global ordering by calling
421c4762a1bSJed Brown!          MatSetValues()
422c4762a1bSJed Brown!  Option (A) seems cleaner/easier in many cases, and is the procedure
423c4762a1bSJed Brown!  used in this example.
424c4762a1bSJed Brown!
425c4762a1bSJed Brown      subroutine FormJacobianLocal(info,x,A,jac,da,ierr)
426dfbbaf82SBarry Smith      use ex5fmodule
427c4762a1bSJed Brown      implicit none
428c4762a1bSJed Brown
429c4762a1bSJed Brown      DM da
430c4762a1bSJed Brown
431c4762a1bSJed Brown!  Input/output variables:
432c4762a1bSJed Brown      PetscScalar x(gxs:gxe,gys:gye)
433c4762a1bSJed Brown      Mat         A,jac
434c4762a1bSJed Brown      PetscErrorCode  ierr
435ce78bad3SBarry Smith      DMDALocalInfo info
436c4762a1bSJed Brown
437c4762a1bSJed Brown!  Local variables:
438c4762a1bSJed Brown      PetscInt  row,col(5),i,j,i1,i5
439c4762a1bSJed Brown      PetscScalar two,one,hx,hy,v(5)
440c4762a1bSJed Brown      PetscScalar hxdhy,hydhx,sc
441c4762a1bSJed Brown
442c4762a1bSJed Brown!  Set parameters
443c4762a1bSJed Brown
444c4762a1bSJed Brown      i1     = 1
445c4762a1bSJed Brown      i5     = 5
446c4762a1bSJed Brown      one    = 1.0
447c4762a1bSJed Brown      two    = 2.0
448bb060b03SBarry Smith      hx     = one/(real(mx)-1)
449bb060b03SBarry Smith      hy     = one/(real(my)-1)
450c4762a1bSJed Brown      sc     = hx*hy
451c4762a1bSJed Brown      hxdhy  = hx/hy
452c4762a1bSJed Brown      hydhx  = hy/hx
453e0b71005SStefano Zampini! -Wmaybe-uninitialized
454e0b71005SStefano Zampini      v      = 0.0
455e0b71005SStefano Zampini      col    = 0
456c4762a1bSJed Brown
457c4762a1bSJed Brown!  Compute entries for the locally owned part of the Jacobian.
458c4762a1bSJed Brown!   - Currently, all PETSc parallel matrix formats are partitioned by
459c4762a1bSJed Brown!     contiguous chunks of rows across the processors.
460c4762a1bSJed Brown!   - Each processor needs to insert only elements that it owns
461c4762a1bSJed Brown!     locally (but any non-local elements will be sent to the
462c4762a1bSJed Brown!     appropriate processor during matrix assembly).
463c4762a1bSJed Brown!   - Here, we set all entries for a particular row at once.
464c4762a1bSJed Brown!   - We can set matrix entries either using either
465c4762a1bSJed Brown!     MatSetValuesLocal() or MatSetValues(), as discussed above.
466c4762a1bSJed Brown!   - Note that MatSetValues() uses 0-based row and column numbers
467c4762a1bSJed Brown!     in Fortran as well as in C.
468c4762a1bSJed Brown
469c4762a1bSJed Brown      do 20 j=ys,ye
470c4762a1bSJed Brown         row = (j - gys)*gxm + xs - gxs - 1
471c4762a1bSJed Brown         do 10 i=xs,xe
472c4762a1bSJed Brown            row = row + 1
473c4762a1bSJed Brown!           boundary points
474c4762a1bSJed Brown            if (i .eq. 1 .or. j .eq. 1 .or. i .eq. mx .or. j .eq. my) then
475c4762a1bSJed Brown!       Some f90 compilers need 4th arg to be of same type in both calls
476c4762a1bSJed Brown               col(1) = row
477c4762a1bSJed Brown               v(1)   = one
4785d83a8b1SBarry Smith               call MatSetValuesLocal(jac,i1,[row],i1,[col],[v],INSERT_VALUES,ierr)
47965afa91aSSatish Balay               CHKERRQ(ierr)
480c4762a1bSJed Brown!           interior grid points
481c4762a1bSJed Brown            else
482c4762a1bSJed Brown               v(1) = -hxdhy
483c4762a1bSJed Brown               v(2) = -hydhx
484c4762a1bSJed Brown               v(3) = two*(hydhx + hxdhy) - sc*lambda*exp(x(i,j))
485c4762a1bSJed Brown               v(4) = -hydhx
486c4762a1bSJed Brown               v(5) = -hxdhy
487c4762a1bSJed Brown               col(1) = row - gxm
488c4762a1bSJed Brown               col(2) = row - 1
489c4762a1bSJed Brown               col(3) = row
490c4762a1bSJed Brown               col(4) = row + 1
491c4762a1bSJed Brown               col(5) = row + gxm
4925d83a8b1SBarry Smith               call MatSetValuesLocal(jac,i1,[row],i5,[col],[v], INSERT_VALUES,ierr)
49365afa91aSSatish Balay               CHKERRQ(ierr)
494c4762a1bSJed Brown            endif
495c4762a1bSJed Brown 10      continue
496c4762a1bSJed Brown 20   continue
49765afa91aSSatish Balay      call MatAssemblyBegin(jac,MAT_FINAL_ASSEMBLY,ierr)
49865afa91aSSatish Balay      CHKERRQ(ierr)
49965afa91aSSatish Balay      call MatAssemblyEnd(jac,MAT_FINAL_ASSEMBLY,ierr)
50065afa91aSSatish Balay      CHKERRQ(ierr)
501c4762a1bSJed Brown      if (A .ne. jac) then
50265afa91aSSatish Balay         call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr)
50365afa91aSSatish Balay         CHKERRQ(ierr)
50465afa91aSSatish Balay         call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr)
50565afa91aSSatish Balay         CHKERRQ(ierr)
506c4762a1bSJed Brown      endif
507c4762a1bSJed Brown      end
508c4762a1bSJed Brown
509c4762a1bSJed Brown!
510c4762a1bSJed Brown!     Simple convergence test based on the infinity norm of the residual being small
511c4762a1bSJed Brown!
512c4762a1bSJed Brown      subroutine MySNESConverged(snes,it,xnorm,snorm,fnorm,reason,dummy,ierr)
513dfbbaf82SBarry Smith      use ex5fmodule
514c4762a1bSJed Brown      implicit none
515c4762a1bSJed Brown
516c4762a1bSJed Brown      SNES snes
517c4762a1bSJed Brown      PetscInt it,dummy
518c4762a1bSJed Brown      PetscReal xnorm,snorm,fnorm,nrm
519c4762a1bSJed Brown      SNESConvergedReason reason
520c4762a1bSJed Brown      Vec f
521c4762a1bSJed Brown      PetscErrorCode ierr
522c4762a1bSJed Brown
52365afa91aSSatish Balay      call SNESGetFunction(snes,f,PETSC_NULL_FUNCTION,dummy,ierr)
52465afa91aSSatish Balay      CHKERRQ(ierr)
52565afa91aSSatish Balay      call VecNorm(f,NORM_INFINITY,nrm,ierr)
52665afa91aSSatish Balay      CHKERRQ(ierr)
527c4762a1bSJed Brown      if (nrm .le. 1.e-5) reason = SNES_CONVERGED_FNORM_ABS
528c4762a1bSJed Brown
529c4762a1bSJed Brown      end
530c4762a1bSJed Brown
531c4762a1bSJed Brown!/*TEST
532c4762a1bSJed Brown!
533c4762a1bSJed Brown!   build:
534c4762a1bSJed Brown!      requires: !complex !single
535c4762a1bSJed Brown!
536c4762a1bSJed Brown!   test:
537c4762a1bSJed Brown!      nsize: 4
5388f8b3c79SStefano Zampini!      args: -snes_mf -pc_type none -da_processors_x 4 -da_processors_y 1 -snes_monitor_short \
5398f8b3c79SStefano Zampini!            -ksp_gmres_cgs_refinement_type refine_always
540c4762a1bSJed Brown!
541c4762a1bSJed Brown!   test:
542c4762a1bSJed Brown!      suffix: 2
543c4762a1bSJed Brown!      nsize: 4
544c4762a1bSJed Brown!      args: -da_processors_x 2 -da_processors_y 2 -snes_monitor_short -ksp_gmres_cgs_refinement_type refine_always
545c4762a1bSJed Brown!
546c4762a1bSJed Brown!   test:
547c4762a1bSJed Brown!      suffix: 3
548c4762a1bSJed Brown!      nsize: 3
549c4762a1bSJed Brown!      args: -snes_fd -snes_monitor_short -ksp_gmres_cgs_refinement_type refine_always
550c4762a1bSJed Brown!
551c4762a1bSJed Brown!   test:
552c4762a1bSJed Brown!      suffix: 6
553c4762a1bSJed Brown!      nsize: 1
554c4762a1bSJed Brown!      args: -snes_monitor_short -my_snes_convergence
555c4762a1bSJed Brown!
556c4762a1bSJed Brown!TEST*/
557