xref: /petsc/src/snes/tutorials/ex40f90.F90 (revision 65ca196f71be2b3914d978be5540ab32f4adb834)
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
11c4762a1bSJed Brown      program ex40f90
12c4762a1bSJed Brown
13c4762a1bSJed Brown#include <petsc/finclude/petscsnes.h>
14c4762a1bSJed Brown#include <petsc/finclude/petscdmda.h>
15c4762a1bSJed Brown      use petscsnes
16c4762a1bSJed Brown      use petscdmda
17c4762a1bSJed Brown      implicit none
18c4762a1bSJed Brown
19c4762a1bSJed Brown      SNES             snes
20c4762a1bSJed Brown      PetscErrorCode   ierr
21c4762a1bSJed Brown      DM               da
22c4762a1bSJed Brown      PetscInt         ten,two,one
23*65ca196fSBarry Smith      PetscScalar      sone
24*65ca196fSBarry Smith      Vec              x
25c4762a1bSJed Brown      external         FormFunctionLocal
26c4762a1bSJed Brown
27d8606c27SBarry Smith      PetscCallA(PetscInitialize(ierr))
28c4762a1bSJed Brown      ten = 10
29c4762a1bSJed Brown      one = 1
30c4762a1bSJed Brown      two = 2
31*65ca196fSBarry Smith      sone = 1.0
32c4762a1bSJed Brown
33d8606c27SBarry 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,PETSC_NULL_INTEGER,da,ierr))
34d8606c27SBarry Smith      PetscCallA(DMSetFromOptions(da,ierr))
35d8606c27SBarry Smith      PetscCallA(DMSetUp(da,ierr))
36c4762a1bSJed Brown
37c4762a1bSJed Brown!       Create solver object and associate it with the unknowns (on the grid)
38c4762a1bSJed Brown
39d8606c27SBarry Smith      PetscCallA(SNESCreate(PETSC_COMM_WORLD,snes,ierr))
40d8606c27SBarry Smith      PetscCallA(SNESSetDM(snes,da,ierr))
41c4762a1bSJed Brown
42d8606c27SBarry Smith      PetscCallA(DMDASNESSetFunctionLocal(da,INSERT_VALUES,FormFunctionLocal,0,ierr))
43d8606c27SBarry Smith      PetscCallA(SNESSetFromOptions(snes,ierr))
44c4762a1bSJed Brown
45c4762a1bSJed Brown!      Solve the nonlinear system
46c4762a1bSJed Brown!
47*65ca196fSBarry Smith      PetscCallA(DMCreateGlobalVector(da,x,ierr))
48*65ca196fSBarry Smith      PetscCallA(VecSet(x,sone,ierr))
49*65ca196fSBarry Smith      PetscCallA(SNESSolve(snes,PETSC_NULL_VEC,x,ierr))
50c4762a1bSJed Brown
51*65ca196fSBarry Smith      PetscCallA(VecDestroy(x,ierr))
52d8606c27SBarry Smith      PetscCallA(SNESDestroy(snes,ierr))
53d8606c27SBarry Smith      PetscCallA(DMDestroy(da,ierr))
54d8606c27SBarry Smith      PetscCallA(PetscFinalize(ierr))
55c4762a1bSJed Brown      end
56c4762a1bSJed Brown
57c4762a1bSJed Brown      subroutine FormFunctionLocal(in,x,f,dummy,ierr)
58c4762a1bSJed Brown      implicit none
59c4762a1bSJed Brown      PetscInt i,j,k,dummy
60c4762a1bSJed Brown      DMDALocalInfo in(DMDA_LOCAL_INFO_SIZE)
61c4762a1bSJed Brown      PetscScalar x(in(DMDA_LOCAL_INFO_DOF),XG_RANGE,YG_RANGE)
62c4762a1bSJed Brown      PetscScalar f(in(DMDA_LOCAL_INFO_DOF),X_RANGE,Y_RANGE)
63c4762a1bSJed Brown      PetscErrorCode ierr
64c4762a1bSJed Brown
65c4762a1bSJed Brown      do i=in(DMDA_LOCAL_INFO_XS)+1,in(DMDA_LOCAL_INFO_XS)+in(DMDA_LOCAL_INFO_XM)
66c4762a1bSJed Brown         do j=in(DMDA_LOCAL_INFO_YS)+1,in(DMDA_LOCAL_INFO_YS)+in(DMDA_LOCAL_INFO_YM)
67c4762a1bSJed Brown            do k=1,in(DMDA_LOCAL_INFO_DOF)
68c4762a1bSJed Brown               f(k,i,j) = x(k,i,j)*x(k,i,j) - 2.0
69c4762a1bSJed Brown            enddo
70c4762a1bSJed Brown         enddo
71c4762a1bSJed Brown      enddo
72c4762a1bSJed Brown
73c4762a1bSJed Brown      return
74c4762a1bSJed Brown      end
75c4762a1bSJed Brown
76c4762a1bSJed Brown!/*TEST
77c4762a1bSJed Brown!
78c4762a1bSJed Brown!   test:
79c4762a1bSJed Brown!     args: -snes_monitor_short -snes_view -da_refine 1 -pc_type mg -pc_mg_type full -ksp_type fgmres -pc_mg_galerkin pmat
80c4762a1bSJed Brown!     requires: !single
81c4762a1bSJed Brown!
82c4762a1bSJed Brown!TEST*/
83