xref: /petsc/src/snes/tutorials/ex40f90.F90 (revision c5e229c2f66f66995aed5443a26600af2aec4a3f)
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*c5e229c2SMartin Diehlprogram ex40f90
13c4762a1bSJed Brown  use petscdmda
14ce78bad3SBarry Smith  use petscsnes
15c4762a1bSJed Brown  implicit none
16c4762a1bSJed Brown
17c4762a1bSJed Brown  SNES snes
18c4762a1bSJed Brown  PetscErrorCode ierr
19c4762a1bSJed Brown  DM da
20c4762a1bSJed Brown  PetscInt ten, two, one
2165ca196fSBarry Smith  PetscScalar sone
2265ca196fSBarry Smith  Vec x
23c4762a1bSJed Brown  external FormFunctionLocal
24c4762a1bSJed Brown
25d8606c27SBarry Smith  PetscCallA(PetscInitialize(ierr))
26c4762a1bSJed Brown  ten = 10
27c4762a1bSJed Brown  one = 1
28c4762a1bSJed Brown  two = 2
2965ca196fSBarry Smith  sone = 1.0
30c4762a1bSJed Brown
315d83a8b1SBarry 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))
32d8606c27SBarry Smith  PetscCallA(DMSetFromOptions(da, ierr))
33d8606c27SBarry Smith  PetscCallA(DMSetUp(da, ierr))
34c4762a1bSJed Brown
35c4762a1bSJed Brown!       Create solver object and associate it with the unknowns (on the grid)
36c4762a1bSJed Brown
37d8606c27SBarry Smith  PetscCallA(SNESCreate(PETSC_COMM_WORLD, snes, ierr))
38d8606c27SBarry Smith  PetscCallA(SNESSetDM(snes, da, ierr))
39c4762a1bSJed Brown
40d8606c27SBarry Smith  PetscCallA(DMDASNESSetFunctionLocal(da, INSERT_VALUES, FormFunctionLocal, 0, ierr))
41d8606c27SBarry Smith  PetscCallA(SNESSetFromOptions(snes, ierr))
42c4762a1bSJed Brown
43c4762a1bSJed Brown!      Solve the nonlinear system
44c4762a1bSJed Brown!
4565ca196fSBarry Smith  PetscCallA(DMCreateGlobalVector(da, x, ierr))
4665ca196fSBarry Smith  PetscCallA(VecSet(x, sone, ierr))
4765ca196fSBarry Smith  PetscCallA(SNESSolve(snes, PETSC_NULL_VEC, x, ierr))
48c4762a1bSJed Brown
4965ca196fSBarry Smith  PetscCallA(VecDestroy(x, ierr))
50d8606c27SBarry Smith  PetscCallA(SNESDestroy(snes, ierr))
51d8606c27SBarry Smith  PetscCallA(DMDestroy(da, ierr))
52d8606c27SBarry Smith  PetscCallA(PetscFinalize(ierr))
53c4762a1bSJed Brownend
54c4762a1bSJed Brown
55c4762a1bSJed Brownsubroutine FormFunctionLocal(in, x, f, dummy, ierr)
56ce78bad3SBarry Smith  use petscdmda
57c4762a1bSJed Brown  implicit none
58c4762a1bSJed Brown  PetscInt i, j, k, dummy
59ce78bad3SBarry Smith  DMDALocalInfo in
60ce78bad3SBarry Smith  PetscScalar x(in%DOF, in%GXS + 1:in%GXS + in%GXM, in%GYS + 1:in%GYS + in%GYM)
61ce78bad3SBarry Smith  PetscScalar f(in%DOF, in%XS + 1:in%XS + in%XM, in%YS + 1:in%YS + in%YM)
62c4762a1bSJed Brown  PetscErrorCode ierr
63c4762a1bSJed Brown
64ce78bad3SBarry Smith  do i = in%XS + 1, in%XS + in%XM
65ce78bad3SBarry Smith    do j = in%YS + 1, in%YS + in%YM
66ce78bad3SBarry Smith      do k = 1, in%DOF
67c4762a1bSJed Brown        f(k, i, j) = x(k, i, j)*x(k, i, j) - 2.0
68c4762a1bSJed Brown      end do
69c4762a1bSJed Brown    end do
70c4762a1bSJed Brown  end do
71c4762a1bSJed Brown
72c4762a1bSJed Brownend
73c4762a1bSJed Brown
74c4762a1bSJed Brown!/*TEST
75c4762a1bSJed Brown!
76c4762a1bSJed Brown!   test:
77c4762a1bSJed Brown!     args: -snes_monitor_short -snes_view -da_refine 1 -pc_type mg -pc_mg_type full -ksp_type fgmres -pc_mg_galerkin pmat
78c4762a1bSJed Brown!     requires: !single
79c4762a1bSJed Brown!
80c4762a1bSJed Brown!TEST*/
81