xref: /petsc/src/snes/tutorials/ex40f90.F90 (revision 749c190bad46ba447444c173d8c7a4080c70750e)
1c4762a1bSJed Brown!
2c4762a1bSJed Brown!  Demonstrates use of DMDASNESSetFunctionLocal() from Fortran
3c4762a1bSJed Brown!
4c4762a1bSJed Brown!    Note: the access to the entries of the local arrays below use the Fortran
5c4762a1bSJed Brown!   convention of starting at zero. However calls to MatSetValues()  start at 0.
6c4762a1bSJed Brown!   Also note that you will have to map the i,j,k coordinates to the local PETSc ordering
7c4762a1bSJed Brown!   before calling MatSetValuesLocal(). Often you will find that using PETSc's default
8c4762a1bSJed Brown!   code for computing the Jacobian works fine and you will not need to implement
9c4762a1bSJed Brown!   your own FormJacobianLocal().
10c4762a1bSJed Brown#include <petsc/finclude/petscsnes.h>
11c4762a1bSJed Brown#include <petsc/finclude/petscdmda.h>
12*b06eb4cdSBarry Smithmodule ex40module
13e7a95102SMartin Diehl  use petscdmda
14e7a95102SMartin Diehl  implicit none
15e7a95102SMartin Diehlcontains
16e7a95102SMartin Diehl  subroutine FormFunctionLocal(in, x, f, dummy, ierr)
17e7a95102SMartin Diehl    PetscInt i, j, k, dummy
18e7a95102SMartin Diehl    DMDALocalInfo in
19e7a95102SMartin Diehl    PetscScalar x(in%DOF, in%GXS + 1:in%GXS + in%GXM, in%GYS + 1:in%GYS + in%GYM)
20e7a95102SMartin Diehl    PetscScalar f(in%DOF, in%XS + 1:in%XS + in%XM, in%YS + 1:in%YS + in%YM)
21e7a95102SMartin Diehl    PetscErrorCode ierr
22e7a95102SMartin Diehl
23e7a95102SMartin Diehl    do i = in%XS + 1, in%XS + in%XM
24e7a95102SMartin Diehl      do j = in%YS + 1, in%YS + in%YM
25e7a95102SMartin Diehl        do k = 1, in%DOF
26e7a95102SMartin Diehl          f(k, i, j) = x(k, i, j)*x(k, i, j) - 2.0
27e7a95102SMartin Diehl        end do
28e7a95102SMartin Diehl      end do
29e7a95102SMartin Diehl    end do
30e7a95102SMartin Diehl
31e7a95102SMartin Diehl  end
32*b06eb4cdSBarry Smithend module ex40module
33e7a95102SMartin Diehl
34c5e229c2SMartin Diehlprogram ex40f90
35c4762a1bSJed Brown  use petscdmda
36ce78bad3SBarry Smith  use petscsnes
37*b06eb4cdSBarry Smith  use ex40module
38c4762a1bSJed Brown  implicit none
39c4762a1bSJed Brown
40c4762a1bSJed Brown  SNES snes
41c4762a1bSJed Brown  PetscErrorCode ierr
42c4762a1bSJed Brown  DM da
43c4762a1bSJed Brown  PetscInt ten, two, one
4465ca196fSBarry Smith  PetscScalar sone
4565ca196fSBarry Smith  Vec x
46c4762a1bSJed Brown
47d8606c27SBarry Smith  PetscCallA(PetscInitialize(ierr))
48c4762a1bSJed Brown  ten = 10
49c4762a1bSJed Brown  one = 1
50c4762a1bSJed Brown  two = 2
5165ca196fSBarry Smith  sone = 1.0
52c4762a1bSJed Brown
535d83a8b1SBarry Smith  PetscCallA(DMDACreate2d(PETSC_COMM_WORLD, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DMDA_STENCIL_BOX, ten, ten, PETSC_DECIDE, PETSC_DECIDE, two, one, PETSC_NULL_INTEGER_ARRAY, PETSC_NULL_INTEGER_ARRAY, da, ierr))
54d8606c27SBarry Smith  PetscCallA(DMSetFromOptions(da, ierr))
55d8606c27SBarry Smith  PetscCallA(DMSetUp(da, ierr))
56c4762a1bSJed Brown
57c4762a1bSJed Brown!       Create solver object and associate it with the unknowns (on the grid)
58c4762a1bSJed Brown
59d8606c27SBarry Smith  PetscCallA(SNESCreate(PETSC_COMM_WORLD, snes, ierr))
60d8606c27SBarry Smith  PetscCallA(SNESSetDM(snes, da, ierr))
61c4762a1bSJed Brown
62d8606c27SBarry Smith  PetscCallA(DMDASNESSetFunctionLocal(da, INSERT_VALUES, FormFunctionLocal, 0, ierr))
63d8606c27SBarry Smith  PetscCallA(SNESSetFromOptions(snes, ierr))
64c4762a1bSJed Brown
65c4762a1bSJed Brown!      Solve the nonlinear system
66c4762a1bSJed Brown!
6765ca196fSBarry Smith  PetscCallA(DMCreateGlobalVector(da, x, ierr))
6865ca196fSBarry Smith  PetscCallA(VecSet(x, sone, ierr))
6965ca196fSBarry Smith  PetscCallA(SNESSolve(snes, PETSC_NULL_VEC, x, ierr))
70c4762a1bSJed Brown
7165ca196fSBarry Smith  PetscCallA(VecDestroy(x, ierr))
72d8606c27SBarry Smith  PetscCallA(SNESDestroy(snes, ierr))
73d8606c27SBarry Smith  PetscCallA(DMDestroy(da, ierr))
74d8606c27SBarry Smith  PetscCallA(PetscFinalize(ierr))
75c4762a1bSJed Brownend
76c4762a1bSJed Brown
77c4762a1bSJed Brown!/*TEST
78c4762a1bSJed Brown!
79c4762a1bSJed Brown!   test:
80c4762a1bSJed Brown!     args: -snes_monitor_short -snes_view -da_refine 1 -pc_type mg -pc_mg_type full -ksp_type fgmres -pc_mg_galerkin pmat
81c4762a1bSJed Brown!     requires: !single
82c4762a1bSJed Brown!
83c4762a1bSJed Brown!TEST*/
84