xref: /petsc/src/snes/tutorials/ex5f90t.F90 (revision e7a95102f46630f317be643b805dc1c3f4655aeb)
1c4762a1bSJed Brown!
2c4762a1bSJed Brown!  Description: Solves a nonlinear system in parallel with SNES.
3c4762a1bSJed Brown!  We solve the  Bratu (SFI - solid fuel ignition) problem in a 2D rectangular
4c4762a1bSJed Brown!  domain, using distributed arrays (DMDAs) to partition the parallel grid.
5c4762a1bSJed Brown!  The command line options include:
6c4762a1bSJed Brown!    -par <parameter>, where <parameter> indicates the nonlinearity of the problem
7c4762a1bSJed Brown!       problem SFI:  <parameter> = Bratu parameter (0 <= par <= 6.81)
8c4762a1bSJed Brown!
9c4762a1bSJed Brown!
10c4762a1bSJed Brown!  --------------------------------------------------------------------------
11c4762a1bSJed Brown!
12c4762a1bSJed Brown!  Solid Fuel Ignition (SFI) problem.  This problem is modeled by
13c4762a1bSJed Brown!  the partial differential equation
14c4762a1bSJed Brown!
15c4762a1bSJed Brown!          -Laplacian u - lambda*exp(u) = 0,  0 < x,y < 1,
16c4762a1bSJed Brown!
17c4762a1bSJed Brown!  with boundary conditions
18c4762a1bSJed Brown!
19c4762a1bSJed Brown!           u = 0  for  x = 0, x = 1, y = 0, y = 1.
20c4762a1bSJed Brown!
21c4762a1bSJed Brown!  A finite difference approximation with the usual 5-point stencil
22c4762a1bSJed Brown!  is used to discretize the boundary value problem to obtain a nonlinear
23c4762a1bSJed Brown!  system of equations.
24c4762a1bSJed Brown!
25c4762a1bSJed Brown!  The uniprocessor version of this code is snes/tutorials/ex4f.F
26c4762a1bSJed Brown!
27c4762a1bSJed Brown!  --------------------------------------------------------------------------
28c4762a1bSJed Brown!  The following define must be used before including any PETSc include files
29c4762a1bSJed Brown!  into a module or interface. This is because they can't handle declarations
30c4762a1bSJed Brown!  in them
31c4762a1bSJed Brown!
32ce78bad3SBarry Smith#include <petsc/finclude/petscdmda.h>
33c5e229c2SMartin Diehl#include <petsc/finclude/petscsnes.h>
34c5e229c2SMartin Diehl#include <petsc/finclude/petscsys.h>
35c5e229c2SMartin Diehl#include <petsc/finclude/petscmat.h>
36c5e229c2SMartin Diehlmodule ex5f90tmodule
37*e7a95102SMartin Diehl  use petscsnes
38ce78bad3SBarry Smith  use petscdmda
39*e7a95102SMartin Diehl  implicit none
40c4762a1bSJed Brown  type userctx
41c4762a1bSJed Brown    type(tDM) da
42c4762a1bSJed Brown    PetscInt xs, xe, xm, gxs, gxe, gxm
43c4762a1bSJed Brown    PetscInt ys, ye, ym, gys, gye, gym
44c4762a1bSJed Brown    PetscInt mx, my
45c4762a1bSJed Brown    PetscMPIInt rank
46c4762a1bSJed Brown    PetscReal lambda
47c4762a1bSJed Brown  end type userctx
48c4762a1bSJed Brown
49*e7a95102SMartin Diehl  interface
50*e7a95102SMartin Diehl    subroutine SNESSetApplicationContext(snesIn, ctx, ierr)
51*e7a95102SMartin Diehl      use petscsnes
52*e7a95102SMartin Diehl      import userctx
53*e7a95102SMartin Diehl      type(tSNES) snesIn
54*e7a95102SMartin Diehl      type(userctx) ctx
55*e7a95102SMartin Diehl      PetscErrorCode ierr
56*e7a95102SMartin Diehl    end subroutine
57*e7a95102SMartin Diehl    subroutine SNESGetApplicationContext(snesIn, ctx, ierr)
58*e7a95102SMartin Diehl      use petscsnes
59*e7a95102SMartin Diehl      import userctx
60*e7a95102SMartin Diehl      type(tSNES) snesIn
61*e7a95102SMartin Diehl      type(userctx), pointer :: ctx
62*e7a95102SMartin Diehl      PetscErrorCode ierr
63*e7a95102SMartin Diehl    end subroutine
64*e7a95102SMartin Diehl  end interface
65*e7a95102SMartin Diehl
66c4762a1bSJed Browncontains
67c4762a1bSJed Brown! ---------------------------------------------------------------------
68c4762a1bSJed Brown!
69c4762a1bSJed Brown!  FormFunction - Evaluates nonlinear function, F(x).
70c4762a1bSJed Brown!
71c4762a1bSJed Brown!  Input Parameters:
72c4762a1bSJed Brown!  snes - the SNES context
73c4762a1bSJed Brown!  X - input vector
74c4762a1bSJed Brown!  dummy - optional user-defined context, as set by SNESSetFunction()
75c4762a1bSJed Brown!          (not used here)
76c4762a1bSJed Brown!
77c4762a1bSJed Brown!  Output Parameter:
78c4762a1bSJed Brown!  F - function vector
79c4762a1bSJed Brown!
80c4762a1bSJed Brown!  Notes:
81c4762a1bSJed Brown!  This routine serves as a wrapper for the lower-level routine
82c4762a1bSJed Brown!  "FormFunctionLocal", where the actual computations are
83c4762a1bSJed Brown!  done using the standard Fortran style of treating the local
84c4762a1bSJed Brown!  vector data as a multidimensional array over the local mesh.
85c4762a1bSJed Brown!  This routine merely handles ghost point scatters and accesses
86ce78bad3SBarry Smith!  the local vector data via VecGetArray() and VecRestoreArray().
87c4762a1bSJed Brown!
88c4762a1bSJed Brown  subroutine FormFunction(snesIn, X, F, user, ierr)
89c4762a1bSJed Brown!  Input/output variables:
90c4762a1bSJed Brown    type(tSNES) snesIn
91c4762a1bSJed Brown    type(tVec) X, F
92c4762a1bSJed Brown    PetscErrorCode ierr
93c4762a1bSJed Brown    type(userctx) user
94c4762a1bSJed Brown
95c4762a1bSJed Brown!  Declarations for use with local arrays:
96c4762a1bSJed Brown    PetscScalar, pointer :: lx_v(:), lf_v(:)
97c4762a1bSJed Brown    type(tVec) localX
98c4762a1bSJed Brown
99c4762a1bSJed Brown!  Scatter ghost points to local vector, using the 2-step process
100c4762a1bSJed Brown!     DMGlobalToLocalBegin(), DMGlobalToLocalEnd().
101c4762a1bSJed Brown!  By placing code between these two statements, computations can
102c4762a1bSJed Brown!  be done while messages are in transition.
103d8606c27SBarry Smith    PetscCall(DMGetLocalVector(user%da, localX, ierr))
104d8606c27SBarry Smith    PetscCall(DMGlobalToLocalBegin(user%da, X, INSERT_VALUES, localX, ierr))
105d8606c27SBarry Smith    PetscCall(DMGlobalToLocalEnd(user%da, X, INSERT_VALUES, localX, ierr))
106c4762a1bSJed Brown
107c4762a1bSJed Brown!  Get a pointer to vector data.
10842ce371bSBarry Smith!    - VecGetArray90() returns a pointer to the data array.
109ce78bad3SBarry Smith!    - You MUST call VecRestoreArray() when you no longer need access to
110c4762a1bSJed Brown!      the array.
111c4762a1bSJed Brown
112ce78bad3SBarry Smith    PetscCall(VecGetArray(localX, lx_v, ierr))
113ce78bad3SBarry Smith    PetscCall(VecGetArray(F, lf_v, ierr))
114c4762a1bSJed Brown
115c4762a1bSJed Brown!  Compute function over the locally owned part of the grid
116d8606c27SBarry Smith    PetscCall(FormFunctionLocal(lx_v, lf_v, user, ierr))
117c4762a1bSJed Brown
118c4762a1bSJed Brown!  Restore vectors
119ce78bad3SBarry Smith    PetscCall(VecRestoreArray(localX, lx_v, ierr))
120ce78bad3SBarry Smith    PetscCall(VecRestoreArray(F, lf_v, ierr))
121c4762a1bSJed Brown
122c4762a1bSJed Brown!  Insert values into global vector
123c4762a1bSJed Brown
124d8606c27SBarry Smith    PetscCall(DMRestoreLocalVector(user%da, localX, ierr))
125d8606c27SBarry Smith    PetscCall(PetscLogFlops(11.0d0*user%ym*user%xm, ierr))
126c4762a1bSJed Brown
127d8606c27SBarry Smith!      PetscCall(VecView(X,PETSC_VIEWER_STDOUT_WORLD,ierr))
128d8606c27SBarry Smith!      PetscCall(VecView(F,PETSC_VIEWER_STDOUT_WORLD,ierr))
129c4762a1bSJed Brown  end subroutine formfunction
130c4762a1bSJed Brown
131*e7a95102SMartin Diehl! ---------------------------------------------------------------------
132*e7a95102SMartin Diehl!
133*e7a95102SMartin Diehl!  FormInitialGuess - Forms initial approximation.
134*e7a95102SMartin Diehl!
135*e7a95102SMartin Diehl!  Input Parameters:
136*e7a95102SMartin Diehl!  X - vector
137*e7a95102SMartin Diehl!
138*e7a95102SMartin Diehl!  Output Parameter:
139*e7a95102SMartin Diehl!  X - vector
140*e7a95102SMartin Diehl!
141*e7a95102SMartin Diehl!  Notes:
142*e7a95102SMartin Diehl!  This routine serves as a wrapper for the lower-level routine
143*e7a95102SMartin Diehl!  "InitialGuessLocal", where the actual computations are
144*e7a95102SMartin Diehl!  done using the standard Fortran style of treating the local
145*e7a95102SMartin Diehl!  vector data as a multidimensional array over the local mesh.
146*e7a95102SMartin Diehl!  This routine merely handles ghost point scatters and accesses
147*e7a95102SMartin Diehl!  the local vector data via VecGetArray() and VecRestoreArray().
148*e7a95102SMartin Diehl!
149*e7a95102SMartin Diehl  subroutine FormInitialGuess(mysnes, X, ierr)
150*e7a95102SMartin Diehl!  Input/output variables:
151*e7a95102SMartin Diehl    type(tSNES) mysnes
152*e7a95102SMartin Diehl    type(userctx), pointer:: puser
153*e7a95102SMartin Diehl    type(tVec) X
154c4762a1bSJed Brown    PetscErrorCode ierr
155c4762a1bSJed Brown
156*e7a95102SMartin Diehl!  Declarations for use with local arrays:
157*e7a95102SMartin Diehl    PetscScalar, pointer :: lx_v(:)
158*e7a95102SMartin Diehl
159*e7a95102SMartin Diehl    ierr = 0
160*e7a95102SMartin Diehl    PetscCallA(SNESGetApplicationContext(mysnes, puser, ierr))
161*e7a95102SMartin Diehl!  Get a pointer to vector data.
162*e7a95102SMartin Diehl!    - VecGetArray90() returns a pointer to the data array.
163*e7a95102SMartin Diehl!    - You MUST call VecRestoreArray() when you no longer need access to
164*e7a95102SMartin Diehl!      the array.
165*e7a95102SMartin Diehl
166*e7a95102SMartin Diehl    PetscCallA(VecGetArray(X, lx_v, ierr))
167*e7a95102SMartin Diehl
168*e7a95102SMartin Diehl!  Compute initial guess over the locally owned part of the grid
169*e7a95102SMartin Diehl    PetscCallA(InitialGuessLocal(puser, lx_v, ierr))
170*e7a95102SMartin Diehl
171*e7a95102SMartin Diehl!  Restore vector
172*e7a95102SMartin Diehl    PetscCallA(VecRestoreArray(X, lx_v, ierr))
173*e7a95102SMartin Diehl
174*e7a95102SMartin Diehl!  Insert values into global vector
175*e7a95102SMartin Diehl
176*e7a95102SMartin Diehl  end
177*e7a95102SMartin Diehl
178*e7a95102SMartin Diehl! ---------------------------------------------------------------------
179*e7a95102SMartin Diehl!
180*e7a95102SMartin Diehl!  InitialGuessLocal - Computes initial approximation, called by
181*e7a95102SMartin Diehl!  the higher level routine FormInitialGuess().
182*e7a95102SMartin Diehl!
183*e7a95102SMartin Diehl!  Input Parameter:
184*e7a95102SMartin Diehl!  x - local vector data
185*e7a95102SMartin Diehl!
186*e7a95102SMartin Diehl!  Output Parameters:
187*e7a95102SMartin Diehl!  x - local vector data
188*e7a95102SMartin Diehl!  ierr - error code
189*e7a95102SMartin Diehl!
190*e7a95102SMartin Diehl!  Notes:
191*e7a95102SMartin Diehl!  This routine uses standard Fortran-style computations over a 2-dim array.
192*e7a95102SMartin Diehl!
193*e7a95102SMartin Diehl  subroutine InitialGuessLocal(user, x, ierr)
194*e7a95102SMartin Diehl!  Input/output variables:
195*e7a95102SMartin Diehl    type(userctx) user
196*e7a95102SMartin Diehl    PetscScalar x(user%xs:user%xe, user%ys:user%ye)
197c4762a1bSJed Brown    PetscErrorCode ierr
198*e7a95102SMartin Diehl
199*e7a95102SMartin Diehl!  Local variables:
200*e7a95102SMartin Diehl    PetscInt i, j
201*e7a95102SMartin Diehl    PetscScalar temp1, temp, hx, hy
202*e7a95102SMartin Diehl    PetscScalar one
203*e7a95102SMartin Diehl
204*e7a95102SMartin Diehl!  Set parameters
205*e7a95102SMartin Diehl
206*e7a95102SMartin Diehl    ierr = 0
207*e7a95102SMartin Diehl    one = 1.0
208*e7a95102SMartin Diehl    hx = one/(PetscIntToReal(user%mx - 1))
209*e7a95102SMartin Diehl    hy = one/(PetscIntToReal(user%my - 1))
210*e7a95102SMartin Diehl    temp1 = user%lambda/(user%lambda + one)
211*e7a95102SMartin Diehl
212*e7a95102SMartin Diehl    do j = user%ys, user%ye
213*e7a95102SMartin Diehl      temp = PetscIntToReal(min(j - 1, user%my - j))*hy
214*e7a95102SMartin Diehl      do i = user%xs, user%xe
215*e7a95102SMartin Diehl        if (i == 1 .or. j == 1 .or. i == user%mx .or. j == user%my) then
216*e7a95102SMartin Diehl          x(i, j) = 0.0
217*e7a95102SMartin Diehl        else
218*e7a95102SMartin Diehl          x(i, j) = temp1*sqrt(min(PetscIntToReal(min(i - 1, user%mx - i)*hx), PetscIntToReal(temp)))
219*e7a95102SMartin Diehl        end if
220*e7a95102SMartin Diehl      end do
221*e7a95102SMartin Diehl    end do
222*e7a95102SMartin Diehl
223*e7a95102SMartin Diehl  end
224*e7a95102SMartin Diehl
225*e7a95102SMartin Diehl! ---------------------------------------------------------------------
226*e7a95102SMartin Diehl!
227*e7a95102SMartin Diehl!  FormFunctionLocal - Computes nonlinear function, called by
228*e7a95102SMartin Diehl!  the higher level routine FormFunction().
229*e7a95102SMartin Diehl!
230*e7a95102SMartin Diehl!  Input Parameter:
231*e7a95102SMartin Diehl!  x - local vector data
232*e7a95102SMartin Diehl!
233*e7a95102SMartin Diehl!  Output Parameters:
234*e7a95102SMartin Diehl!  f - local vector data, f(x)
235*e7a95102SMartin Diehl!  ierr - error code
236*e7a95102SMartin Diehl!
237*e7a95102SMartin Diehl!  Notes:
238*e7a95102SMartin Diehl!  This routine uses standard Fortran-style computations over a 2-dim array.
239*e7a95102SMartin Diehl!
240*e7a95102SMartin Diehl  subroutine FormFunctionLocal(x, f, user, ierr)
241*e7a95102SMartin Diehl!  Input/output variables:
242*e7a95102SMartin Diehl    type(userctx) user
243*e7a95102SMartin Diehl    PetscScalar x(user%gxs:user%gxe, user%gys:user%gye)
244*e7a95102SMartin Diehl    PetscScalar f(user%xs:user%xe, user%ys:user%ye)
245*e7a95102SMartin Diehl    PetscErrorCode ierr
246*e7a95102SMartin Diehl
247*e7a95102SMartin Diehl!  Local variables:
248*e7a95102SMartin Diehl    PetscScalar two, one, hx, hy, hxdhy, hydhx, sc
249*e7a95102SMartin Diehl    PetscScalar u, uxx, uyy
250*e7a95102SMartin Diehl    PetscInt i, j
251*e7a95102SMartin Diehl
252*e7a95102SMartin Diehl    one = 1.0
253*e7a95102SMartin Diehl    two = 2.0
254*e7a95102SMartin Diehl    hx = one/PetscIntToReal(user%mx - 1)
255*e7a95102SMartin Diehl    hy = one/PetscIntToReal(user%my - 1)
256*e7a95102SMartin Diehl    sc = hx*hy*user%lambda
257*e7a95102SMartin Diehl    hxdhy = hx/hy
258*e7a95102SMartin Diehl    hydhx = hy/hx
259*e7a95102SMartin Diehl
260*e7a95102SMartin Diehl!  Compute function over the locally owned part of the grid
261*e7a95102SMartin Diehl
262*e7a95102SMartin Diehl    do j = user%ys, user%ye
263*e7a95102SMartin Diehl      do i = user%xs, user%xe
264*e7a95102SMartin Diehl        if (i == 1 .or. j == 1 .or. i == user%mx .or. j == user%my) then
265*e7a95102SMartin Diehl          f(i, j) = x(i, j)
266*e7a95102SMartin Diehl        else
267*e7a95102SMartin Diehl          u = x(i, j)
268*e7a95102SMartin Diehl          uxx = hydhx*(two*u - x(i - 1, j) - x(i + 1, j))
269*e7a95102SMartin Diehl          uyy = hxdhy*(two*u - x(i, j - 1) - x(i, j + 1))
270*e7a95102SMartin Diehl          f(i, j) = uxx + uyy - sc*exp(u)
271*e7a95102SMartin Diehl        end if
272*e7a95102SMartin Diehl      end do
273*e7a95102SMartin Diehl    end do
274*e7a95102SMartin Diehl    ierr = 0
275*e7a95102SMartin Diehl  end
276*e7a95102SMartin Diehl
277*e7a95102SMartin Diehl! ---------------------------------------------------------------------
278*e7a95102SMartin Diehl!
279*e7a95102SMartin Diehl!  FormJacobian - Evaluates Jacobian matrix.
280*e7a95102SMartin Diehl!
281*e7a95102SMartin Diehl!  Input Parameters:
282*e7a95102SMartin Diehl!  snes     - the SNES context
283*e7a95102SMartin Diehl!  x        - input vector
284*e7a95102SMartin Diehl!  dummy    - optional user-defined context, as set by SNESSetJacobian()
285*e7a95102SMartin Diehl!             (not used here)
286*e7a95102SMartin Diehl!
287*e7a95102SMartin Diehl!  Output Parameters:
288*e7a95102SMartin Diehl!  jac      - Jacobian matrix
289*e7a95102SMartin Diehl!  jac_prec - optionally different matrix used to construct the preconditioner (not used here)
290*e7a95102SMartin Diehl!
291*e7a95102SMartin Diehl!  Notes:
292*e7a95102SMartin Diehl!  This routine serves as a wrapper for the lower-level routine
293*e7a95102SMartin Diehl!  "FormJacobianLocal", where the actual computations are
294*e7a95102SMartin Diehl!  done using the standard Fortran style of treating the local
295*e7a95102SMartin Diehl!  vector data as a multidimensional array over the local mesh.
296*e7a95102SMartin Diehl!  This routine merely accesses the local vector data via
297*e7a95102SMartin Diehl!  VecGetArray() and VecRestoreArray().
298*e7a95102SMartin Diehl!
299*e7a95102SMartin Diehl!  Notes:
300*e7a95102SMartin Diehl!  Due to grid point reordering with DMDAs, we must always work
301*e7a95102SMartin Diehl!  with the local grid points, and then transform them to the new
302*e7a95102SMartin Diehl!  global numbering with the "ltog" mapping
303*e7a95102SMartin Diehl!  We cannot work directly with the global numbers for the original
304*e7a95102SMartin Diehl!  uniprocessor grid!
305*e7a95102SMartin Diehl!
306*e7a95102SMartin Diehl!  Two methods are available for imposing this transformation
307*e7a95102SMartin Diehl!  when setting matrix entries:
308*e7a95102SMartin Diehl!    (A) MatSetValuesLocal(), using the local ordering (including
309*e7a95102SMartin Diehl!        ghost points!)
310*e7a95102SMartin Diehl!        - Set matrix entries using the local ordering
311*e7a95102SMartin Diehl!          by calling MatSetValuesLocal()
312*e7a95102SMartin Diehl!    (B) MatSetValues(), using the global ordering
313*e7a95102SMartin Diehl!        - Use DMGetLocalToGlobalMapping() then
314*e7a95102SMartin Diehl!          ISLocalToGlobalMappingGetIndices() to extract the local-to-global map
315*e7a95102SMartin Diehl!        - Then apply this map explicitly yourself
316*e7a95102SMartin Diehl!        - Set matrix entries using the global ordering by calling
317*e7a95102SMartin Diehl!          MatSetValues()
318*e7a95102SMartin Diehl!  Option (A) seems cleaner/easier in many cases, and is the procedure
319*e7a95102SMartin Diehl!  used in this example.
320*e7a95102SMartin Diehl!
321*e7a95102SMartin Diehl  subroutine FormJacobian(mysnes, X, jac, jac_prec, user, ierr)
322*e7a95102SMartin Diehl!  Input/output variables:
323*e7a95102SMartin Diehl    type(tSNES) mysnes
324*e7a95102SMartin Diehl    type(tVec) X
325*e7a95102SMartin Diehl    type(tMat) jac, jac_prec
326*e7a95102SMartin Diehl    type(userctx) user
327*e7a95102SMartin Diehl    PetscErrorCode ierr
328*e7a95102SMartin Diehl
329*e7a95102SMartin Diehl!  Declarations for use with local arrays:
330*e7a95102SMartin Diehl    PetscScalar, pointer :: lx_v(:)
331*e7a95102SMartin Diehl    type(tVec) localX
332*e7a95102SMartin Diehl
333*e7a95102SMartin Diehl!  Scatter ghost points to local vector, using the 2-step process
334*e7a95102SMartin Diehl!     DMGlobalToLocalBegin(), DMGlobalToLocalEnd()
335*e7a95102SMartin Diehl!  Computations can be done while messages are in transition,
336*e7a95102SMartin Diehl!  by placing code between these two statements.
337*e7a95102SMartin Diehl
338*e7a95102SMartin Diehl    PetscCallA(DMGetLocalVector(user%da, localX, ierr))
339*e7a95102SMartin Diehl    PetscCallA(DMGlobalToLocalBegin(user%da, X, INSERT_VALUES, localX, ierr))
340*e7a95102SMartin Diehl    PetscCallA(DMGlobalToLocalEnd(user%da, X, INSERT_VALUES, localX, ierr))
341*e7a95102SMartin Diehl
342*e7a95102SMartin Diehl!  Get a pointer to vector data
343*e7a95102SMartin Diehl    PetscCallA(VecGetArray(localX, lx_v, ierr))
344*e7a95102SMartin Diehl
345*e7a95102SMartin Diehl!  Compute entries for the locally owned part of the Jacobian preconditioner.
346*e7a95102SMartin Diehl    PetscCallA(FormJacobianLocal(lx_v, jac_prec, user, ierr))
347*e7a95102SMartin Diehl
348*e7a95102SMartin Diehl!  Assemble matrix, using the 2-step process:
349*e7a95102SMartin Diehl!     MatAssemblyBegin(), MatAssemblyEnd()
350*e7a95102SMartin Diehl!  Computations can be done while messages are in transition,
351*e7a95102SMartin Diehl!  by placing code between these two statements.
352*e7a95102SMartin Diehl
353*e7a95102SMartin Diehl    PetscCallA(MatAssemblyBegin(jac, MAT_FINAL_ASSEMBLY, ierr))
354*e7a95102SMartin Diehl!      if (jac .ne. jac_prec) then
355*e7a95102SMartin Diehl    PetscCallA(MatAssemblyBegin(jac_prec, MAT_FINAL_ASSEMBLY, ierr))
356*e7a95102SMartin Diehl!      endif
357*e7a95102SMartin Diehl    PetscCallA(VecRestoreArray(localX, lx_v, ierr))
358*e7a95102SMartin Diehl    PetscCallA(DMRestoreLocalVector(user%da, localX, ierr))
359*e7a95102SMartin Diehl    PetscCallA(MatAssemblyEnd(jac, MAT_FINAL_ASSEMBLY, ierr))
360*e7a95102SMartin Diehl!      if (jac .ne. jac_prec) then
361*e7a95102SMartin Diehl    PetscCallA(MatAssemblyEnd(jac_prec, MAT_FINAL_ASSEMBLY, ierr))
362*e7a95102SMartin Diehl!      endif
363*e7a95102SMartin Diehl
364*e7a95102SMartin Diehl!  Tell the matrix we will never add a new nonzero location to the
365*e7a95102SMartin Diehl!  matrix. If we do it will generate an error.
366*e7a95102SMartin Diehl
367*e7a95102SMartin Diehl    PetscCallA(MatSetOption(jac, MAT_NEW_NONZERO_LOCATION_ERR, PETSC_TRUE, ierr))
368*e7a95102SMartin Diehl
369*e7a95102SMartin Diehl  end
370*e7a95102SMartin Diehl
371*e7a95102SMartin Diehl! ---------------------------------------------------------------------
372*e7a95102SMartin Diehl!
373*e7a95102SMartin Diehl!  FormJacobianLocal - Computes Jacobian matrix used to compute the preconditioner,
374*e7a95102SMartin Diehl!  called by the higher level routine FormJacobian().
375*e7a95102SMartin Diehl!
376*e7a95102SMartin Diehl!  Input Parameters:
377*e7a95102SMartin Diehl!  x        - local vector data
378*e7a95102SMartin Diehl!
379*e7a95102SMartin Diehl!  Output Parameters:
380*e7a95102SMartin Diehl!  jac_prec - Jacobian matrix used to compute the preconditioner
381*e7a95102SMartin Diehl!  ierr     - error code
382*e7a95102SMartin Diehl!
383*e7a95102SMartin Diehl!  Notes:
384*e7a95102SMartin Diehl!  This routine uses standard Fortran-style computations over a 2-dim array.
385*e7a95102SMartin Diehl!
386*e7a95102SMartin Diehl!  Notes:
387*e7a95102SMartin Diehl!  Due to grid point reordering with DMDAs, we must always work
388*e7a95102SMartin Diehl!  with the local grid points, and then transform them to the new
389*e7a95102SMartin Diehl!  global numbering with the "ltog" mapping
390*e7a95102SMartin Diehl!  We cannot work directly with the global numbers for the original
391*e7a95102SMartin Diehl!  uniprocessor grid!
392*e7a95102SMartin Diehl!
393*e7a95102SMartin Diehl!  Two methods are available for imposing this transformation
394*e7a95102SMartin Diehl!  when setting matrix entries:
395*e7a95102SMartin Diehl!    (A) MatSetValuesLocal(), using the local ordering (including
396*e7a95102SMartin Diehl!        ghost points!)
397*e7a95102SMartin Diehl!        - Set matrix entries using the local ordering
398*e7a95102SMartin Diehl!          by calling MatSetValuesLocal()
399*e7a95102SMartin Diehl!    (B) MatSetValues(), using the global ordering
400*e7a95102SMartin Diehl!        - Set matrix entries using the global ordering by calling
401*e7a95102SMartin Diehl!          MatSetValues()
402*e7a95102SMartin Diehl!  Option (A) seems cleaner/easier in many cases, and is the procedure
403*e7a95102SMartin Diehl!  used in this example.
404*e7a95102SMartin Diehl!
405*e7a95102SMartin Diehl  subroutine FormJacobianLocal(x, jac_prec, user, ierr)
406*e7a95102SMartin Diehl!  Input/output variables:
407*e7a95102SMartin Diehl    type(userctx) user
408*e7a95102SMartin Diehl    PetscScalar x(user%gxs:user%gxe, user%gys:user%gye)
409*e7a95102SMartin Diehl    type(tMat) jac_prec
410*e7a95102SMartin Diehl    PetscErrorCode ierr
411*e7a95102SMartin Diehl
412*e7a95102SMartin Diehl!  Local variables:
413*e7a95102SMartin Diehl    PetscInt row, col(5), i, j
414*e7a95102SMartin Diehl    PetscInt ione, ifive
415*e7a95102SMartin Diehl    PetscScalar two, one, hx, hy, hxdhy
416*e7a95102SMartin Diehl    PetscScalar hydhx, sc, v(5)
417*e7a95102SMartin Diehl
418*e7a95102SMartin Diehl!  Set parameters
419*e7a95102SMartin Diehl    ione = 1
420*e7a95102SMartin Diehl    ifive = 5
421*e7a95102SMartin Diehl    one = 1.0
422*e7a95102SMartin Diehl    two = 2.0
423*e7a95102SMartin Diehl    hx = one/PetscIntToReal(user%mx - 1)
424*e7a95102SMartin Diehl    hy = one/PetscIntToReal(user%my - 1)
425*e7a95102SMartin Diehl    sc = hx*hy
426*e7a95102SMartin Diehl    hxdhy = hx/hy
427*e7a95102SMartin Diehl    hydhx = hy/hx
428*e7a95102SMartin Diehl
429*e7a95102SMartin Diehl!  Compute entries for the locally owned part of the Jacobian.
430*e7a95102SMartin Diehl!   - Currently, all PETSc parallel matrix formats are partitioned by
431*e7a95102SMartin Diehl!     contiguous chunks of rows across the processors.
432*e7a95102SMartin Diehl!   - Each processor needs to insert only elements that it owns
433*e7a95102SMartin Diehl!     locally (but any non-local elements will be sent to the
434*e7a95102SMartin Diehl!     appropriate processor during matrix assembly).
435*e7a95102SMartin Diehl!   - Here, we set all entries for a particular row at once.
436*e7a95102SMartin Diehl!   - We can set matrix entries either using either
437*e7a95102SMartin Diehl!     MatSetValuesLocal() or MatSetValues(), as discussed above.
438*e7a95102SMartin Diehl!   - Note that MatSetValues() uses 0-based row and column numbers
439*e7a95102SMartin Diehl!     in Fortran as well as in C.
440*e7a95102SMartin Diehl
441*e7a95102SMartin Diehl    do j = user%ys, user%ye
442*e7a95102SMartin Diehl      row = (j - user%gys)*user%gxm + user%xs - user%gxs - 1
443*e7a95102SMartin Diehl      do i = user%xs, user%xe
444*e7a95102SMartin Diehl        row = row + 1
445*e7a95102SMartin Diehl!           boundary points
446*e7a95102SMartin Diehl        if (i == 1 .or. j == 1 .or. i == user%mx .or. j == user%my) then
447*e7a95102SMartin Diehl          col(1) = row
448*e7a95102SMartin Diehl          v(1) = one
449*e7a95102SMartin Diehl          PetscCallA(MatSetValuesLocal(jac_prec, ione, [row], ione, col, v, INSERT_VALUES, ierr))
450*e7a95102SMartin Diehl!           interior grid points
451*e7a95102SMartin Diehl        else
452*e7a95102SMartin Diehl          v(1) = -hxdhy
453*e7a95102SMartin Diehl          v(2) = -hydhx
454*e7a95102SMartin Diehl          v(3) = two*(hydhx + hxdhy) - sc*user%lambda*exp(x(i, j))
455*e7a95102SMartin Diehl          v(4) = -hydhx
456*e7a95102SMartin Diehl          v(5) = -hxdhy
457*e7a95102SMartin Diehl          col(1) = row - user%gxm
458*e7a95102SMartin Diehl          col(2) = row - 1
459*e7a95102SMartin Diehl          col(3) = row
460*e7a95102SMartin Diehl          col(4) = row + 1
461*e7a95102SMartin Diehl          col(5) = row + user%gxm
462*e7a95102SMartin Diehl          PetscCallA(MatSetValuesLocal(jac_prec, ione, [row], ifive, col, v, INSERT_VALUES, ierr))
463*e7a95102SMartin Diehl        end if
464*e7a95102SMartin Diehl      end do
465*e7a95102SMartin Diehl    end do
466*e7a95102SMartin Diehl  end
467*e7a95102SMartin Diehl
468*e7a95102SMartin Diehlend module
469c4762a1bSJed Brown
470c4762a1bSJed Brownprogram main
471c4762a1bSJed Brown  use petscdmda
472c4762a1bSJed Brown  use petscsnes
47377d968b7SBarry Smith  use ex5f90tmodule
474c4762a1bSJed Brown  implicit none
475c4762a1bSJed Brown! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
476c4762a1bSJed Brown!                   Variable declarations
477c4762a1bSJed Brown! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
478c4762a1bSJed Brown!
479c4762a1bSJed Brown!  Variables:
480c4762a1bSJed Brown!     mysnes      - nonlinear solver
481c4762a1bSJed Brown!     x, r        - solution, residual vectors
482c4762a1bSJed Brown!     J           - Jacobian matrix
483c4762a1bSJed Brown!     its         - iterations for convergence
484c4762a1bSJed Brown!     Nx, Ny      - number of preocessors in x- and y- directions
485c4762a1bSJed Brown!     matrix_free - flag - 1 indicates matrix-free version
486c4762a1bSJed Brown!
487c4762a1bSJed Brown  type(tSNES) mysnes
488c4762a1bSJed Brown  type(tVec) x, r
489c4762a1bSJed Brown  type(tMat) J
490c4762a1bSJed Brown  PetscErrorCode ierr
491c4762a1bSJed Brown  PetscInt its
492c4762a1bSJed Brown  PetscBool flg, matrix_free, set
493c4762a1bSJed Brown  PetscInt ione, nfour
494c4762a1bSJed Brown  PetscReal lambda_max, lambda_min
495c4762a1bSJed Brown  type(userctx) user
496c4762a1bSJed Brown  type(userctx), pointer:: puser
497c4762a1bSJed Brown  type(tPetscOptions) :: options
498c4762a1bSJed Brown
499c4762a1bSJed Brown! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
500c4762a1bSJed Brown!  Initialize program
501c4762a1bSJed Brown! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
502d8606c27SBarry Smith  PetscCallA(PetscInitialize(ierr))
503d8606c27SBarry Smith  PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD, user%rank, ierr))
504c4762a1bSJed Brown
505c4762a1bSJed Brown!  Initialize problem parameters
506c4762a1bSJed Brown  options%v = 0
507c4762a1bSJed Brown  lambda_max = 6.81
508c4762a1bSJed Brown  lambda_min = 0.0
509c4762a1bSJed Brown  user%lambda = 6.0
510c4762a1bSJed Brown  ione = 1
511c4762a1bSJed Brown  nfour = 4
512d8606c27SBarry Smith  PetscCallA(PetscOptionsGetReal(options, PETSC_NULL_CHARACTER, '-par', user%lambda, flg, ierr))
5134820e4eaSBarry Smith  PetscCheckA(user%lambda < lambda_max .and. user%lambda > lambda_min, PETSC_COMM_SELF, PETSC_ERR_USER, 'Lambda provided with -par is out of range')
514c4762a1bSJed Brown
515c4762a1bSJed Brown! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
516c4762a1bSJed Brown!  Create nonlinear solver context
517c4762a1bSJed Brown! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
518d8606c27SBarry Smith  PetscCallA(SNESCreate(PETSC_COMM_WORLD, mysnes, ierr))
519c4762a1bSJed Brown
520c4762a1bSJed Brown! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
521c4762a1bSJed Brown!  Create vector data structures; set function evaluation routine
522c4762a1bSJed Brown! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
523c4762a1bSJed Brown
524c4762a1bSJed Brown!  Create distributed array (DMDA) to manage parallel grid and vectors
525c4762a1bSJed Brown
526c4762a1bSJed Brown! This really needs only the star-type stencil, but we use the box
527c4762a1bSJed Brown! stencil temporarily.
5285d83a8b1SBarry Smith  PetscCallA(DMDACreate2d(PETSC_COMM_WORLD, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DMDA_STENCIL_BOX, nfour, nfour, PETSC_DECIDE, PETSC_DECIDE, ione, ione, PETSC_NULL_INTEGER_ARRAY, PETSC_NULL_INTEGER_ARRAY, user%da, ierr))
529d8606c27SBarry Smith  PetscCallA(DMSetFromOptions(user%da, ierr))
530d8606c27SBarry Smith  PetscCallA(DMSetUp(user%da, ierr))
531ce78bad3SBarry Smith  PetscCallA(DMDAGetInfo(user%da, PETSC_NULL_INTEGER, user%mx, user%my, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, PETSC_NULL_DMBOUNDARYTYPE, PETSC_NULL_DMBOUNDARYTYPE, PETSC_NULL_DMBOUNDARYTYPE, PETSC_NULL_DMDASTENCILTYPE, ierr))
532c4762a1bSJed Brown
533c4762a1bSJed Brown!
534c4762a1bSJed Brown!   Visualize the distribution of the array across the processors
535c4762a1bSJed Brown!
536d8606c27SBarry Smith!     PetscCallA(DMView(user%da,PETSC_VIEWER_DRAW_WORLD,ierr))
537c4762a1bSJed Brown
538c4762a1bSJed Brown!  Extract global and local vectors from DMDA; then duplicate for remaining
539c4762a1bSJed Brown!  vectors that are the same types
540d8606c27SBarry Smith  PetscCallA(DMCreateGlobalVector(user%da, x, ierr))
541d8606c27SBarry Smith  PetscCallA(VecDuplicate(x, r, ierr))
542c4762a1bSJed Brown
543c4762a1bSJed Brown!  Get local grid boundaries (for 2-dimensional DMDA)
544d8606c27SBarry Smith  PetscCallA(DMDAGetCorners(user%da, user%xs, user%ys, PETSC_NULL_INTEGER, user%xm, user%ym, PETSC_NULL_INTEGER, ierr))
545d8606c27SBarry Smith  PetscCallA(DMDAGetGhostCorners(user%da, user%gxs, user%gys, PETSC_NULL_INTEGER, user%gxm, user%gym, PETSC_NULL_INTEGER, ierr))
546c4762a1bSJed Brown
547c4762a1bSJed Brown!  Here we shift the starting indices up by one so that we can easily
548c4762a1bSJed Brown!  use the Fortran convention of 1-based indices (rather 0-based indices).
549c4762a1bSJed Brown  user%xs = user%xs + 1
550c4762a1bSJed Brown  user%ys = user%ys + 1
551c4762a1bSJed Brown  user%gxs = user%gxs + 1
552c4762a1bSJed Brown  user%gys = user%gys + 1
553c4762a1bSJed Brown
554c4762a1bSJed Brown  user%ye = user%ys + user%ym - 1
555c4762a1bSJed Brown  user%xe = user%xs + user%xm - 1
556c4762a1bSJed Brown  user%gye = user%gys + user%gym - 1
557c4762a1bSJed Brown  user%gxe = user%gxs + user%gxm - 1
558c4762a1bSJed Brown
559d8606c27SBarry Smith  PetscCallA(SNESSetApplicationContext(mysnes, user, ierr))
560c4762a1bSJed Brown
561c4762a1bSJed Brown!  Set function evaluation routine and vector
562d8606c27SBarry Smith  PetscCallA(SNESSetFunction(mysnes, r, FormFunction, user, ierr))
563c4762a1bSJed Brown
564c4762a1bSJed Brown! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
565c4762a1bSJed Brown!  Create matrix data structure; set Jacobian evaluation routine
566c4762a1bSJed Brown! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
567c4762a1bSJed Brown
568c4762a1bSJed Brown!  Set Jacobian matrix data structure and default Jacobian evaluation
569c4762a1bSJed Brown!  routine. User can override with:
570c4762a1bSJed Brown!     -snes_fd : default finite differencing approximation of Jacobian
571c4762a1bSJed Brown!     -snes_mf : matrix-free Newton-Krylov method with no preconditioning
572c4762a1bSJed Brown!                (unless user explicitly sets preconditioner)
5737addb90fSBarry Smith!     -snes_mf_operator : form matrix used to construct the preconditioner as set by the user,
574c4762a1bSJed Brown!                         but use matrix-free approx for Jacobian-vector
575c4762a1bSJed Brown!                         products within Newton-Krylov method
576c4762a1bSJed Brown!
577c4762a1bSJed Brown!  Note:  For the parallel case, vectors and matrices MUST be partitioned
578c4762a1bSJed Brown!     accordingly.  When using distributed arrays (DMDAs) to create vectors,
579c4762a1bSJed Brown!     the DMDAs determine the problem partitioning.  We must explicitly
580c4762a1bSJed Brown!     specify the local matrix dimensions upon its creation for compatibility
581c4762a1bSJed Brown!     with the vector distribution.  Thus, the generic MatCreate() routine
582c4762a1bSJed Brown!     is NOT sufficient when working with distributed arrays.
583c4762a1bSJed Brown!
584c4762a1bSJed Brown!     Note: Here we only approximately preallocate storage space for the
585c4762a1bSJed Brown!     Jacobian.  See the users manual for a discussion of better techniques
586c4762a1bSJed Brown!     for preallocating matrix memory.
587c4762a1bSJed Brown
588d8606c27SBarry Smith  PetscCallA(PetscOptionsHasName(options, PETSC_NULL_CHARACTER, '-snes_mf', matrix_free, ierr))
589c4762a1bSJed Brown  if (.not. matrix_free) then
590d8606c27SBarry Smith    PetscCallA(DMSetMatType(user%da, MATAIJ, ierr))
591d8606c27SBarry Smith    PetscCallA(DMCreateMatrix(user%da, J, ierr))
592d8606c27SBarry Smith    PetscCallA(SNESSetJacobian(mysnes, J, J, FormJacobian, user, ierr))
593c4762a1bSJed Brown  end if
594c4762a1bSJed Brown
595c4762a1bSJed Brown! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
596c4762a1bSJed Brown!  Customize nonlinear solver; set runtime options
597c4762a1bSJed Brown! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
598c4762a1bSJed Brown!  Set runtime options (e.g., -snes_monitor -snes_rtol <rtol> -ksp_type <type>)
599d8606c27SBarry Smith  PetscCallA(SNESSetFromOptions(mysnes, ierr))
600c4762a1bSJed Brown
601c4762a1bSJed Brown!     Test Fortran90 wrapper for SNESSet/Get ApplicationContext()
602d8606c27SBarry Smith  PetscCallA(PetscOptionsGetBool(options, PETSC_NULL_CHARACTER, '-test_appctx', flg, set, ierr))
603c4762a1bSJed Brown  if (flg) then
604d8606c27SBarry Smith    PetscCallA(SNESGetApplicationContext(mysnes, puser, ierr))
605c4762a1bSJed Brown  end if
606c4762a1bSJed Brown
607c4762a1bSJed Brown! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
608c4762a1bSJed Brown!  Evaluate initial guess; then solve nonlinear system.
609c4762a1bSJed Brown! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
610c4762a1bSJed Brown!  Note: The user should initialize the vector, x, with the initial guess
611c4762a1bSJed Brown!  for the nonlinear solver prior to calling SNESSolve().  In particular,
612c4762a1bSJed Brown!  to employ an initial guess of zero, the user should explicitly set
613c4762a1bSJed Brown!  this vector to zero by calling VecSet().
614c4762a1bSJed Brown
615d8606c27SBarry Smith  PetscCallA(FormInitialGuess(mysnes, x, ierr))
616d8606c27SBarry Smith  PetscCallA(SNESSolve(mysnes, PETSC_NULL_VEC, x, ierr))
617d8606c27SBarry Smith  PetscCallA(SNESGetIterationNumber(mysnes, its, ierr))
6184820e4eaSBarry Smith  if (user%rank == 0) then
619c4762a1bSJed Brown    write (6, 100) its
620c4762a1bSJed Brown  end if
621c4762a1bSJed Brown100 format('Number of SNES iterations = ', i5)
622c4762a1bSJed Brown
623c4762a1bSJed Brown! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
624c4762a1bSJed Brown!  Free work space.  All PETSc objects should be destroyed when they
625c4762a1bSJed Brown!  are no longer needed.
626c4762a1bSJed Brown! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
627d8606c27SBarry Smith  if (.not. matrix_free) PetscCallA(MatDestroy(J, ierr))
628d8606c27SBarry Smith  PetscCallA(VecDestroy(x, ierr))
629d8606c27SBarry Smith  PetscCallA(VecDestroy(r, ierr))
630d8606c27SBarry Smith  PetscCallA(SNESDestroy(mysnes, ierr))
631d8606c27SBarry Smith  PetscCallA(DMDestroy(user%da, ierr))
632c4762a1bSJed Brown
633d8606c27SBarry Smith  PetscCallA(PetscFinalize(ierr))
634c4762a1bSJed Brownend
635c4762a1bSJed Brown!/*TEST
636c4762a1bSJed Brown!
637c4762a1bSJed Brown!   test:
638c4762a1bSJed Brown!      nsize: 4
639c4762a1bSJed Brown!      args: -snes_mf -pc_type none -da_processors_x 4 -da_processors_y 1 -snes_monitor_short -ksp_gmres_cgs_refinement_type refine_always
640c4762a1bSJed Brown!
641c4762a1bSJed Brown!TEST*/
642