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*e7a95102SMartin Diehlmodule ex40f90_mod 13*e7a95102SMartin Diehl use petscdmda 14*e7a95102SMartin Diehl implicit none 15*e7a95102SMartin Diehlcontains 16*e7a95102SMartin Diehl subroutine FormFunctionLocal(in, x, f, dummy, ierr) 17*e7a95102SMartin Diehl PetscInt i, j, k, dummy 18*e7a95102SMartin Diehl DMDALocalInfo in 19*e7a95102SMartin Diehl PetscScalar x(in%DOF, in%GXS + 1:in%GXS + in%GXM, in%GYS + 1:in%GYS + in%GYM) 20*e7a95102SMartin Diehl PetscScalar f(in%DOF, in%XS + 1:in%XS + in%XM, in%YS + 1:in%YS + in%YM) 21*e7a95102SMartin Diehl PetscErrorCode ierr 22*e7a95102SMartin Diehl 23*e7a95102SMartin Diehl do i = in%XS + 1, in%XS + in%XM 24*e7a95102SMartin Diehl do j = in%YS + 1, in%YS + in%YM 25*e7a95102SMartin Diehl do k = 1, in%DOF 26*e7a95102SMartin Diehl f(k, i, j) = x(k, i, j)*x(k, i, j) - 2.0 27*e7a95102SMartin Diehl end do 28*e7a95102SMartin Diehl end do 29*e7a95102SMartin Diehl end do 30*e7a95102SMartin Diehl 31*e7a95102SMartin Diehl end 32*e7a95102SMartin Diehlend module ex40f90_mod 33*e7a95102SMartin Diehl 34c5e229c2SMartin Diehlprogram ex40f90 35c4762a1bSJed Brown use petscdmda 36ce78bad3SBarry Smith use petscsnes 37*e7a95102SMartin Diehl use ex40f90_mod 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