1: !
  2: !  Description: Test setting several callback functions from Fortran.
  3: !
  4: #include <petsc/finclude/petsc.h>
  5: module ex2fmodule
  6:   use petscsnes
  7:   implicit none

  9: contains
 10: !
 11: ! ------------------------------------------------------------------------
 12: !
 13: !  FormFunction - Evaluates nonlinear function, F(x).
 14: !
 15: !  Input Parameters:
 16: !  snes - the SNES context
 17: !  x - input vector
 18: !  dummy - optional user-defined context (not used here)
 19: !
 20: !  Output Parameter:
 21: !  f - function vector
 22: !
 23:   subroutine FormFunction(snes, x, f, dummy, ierr)
 24:     SNES snes
 25:     Vec x, f
 26:     PetscErrorCode, intent(out) :: ierr
 27:     integer dummy(*)

 29: !  Declarations for use with local arrays
 30:     PetscScalar, pointer :: lx_v(:), lf_v(:)

 32: !  Get pointers to vector data.
 33: !    - VecGetArray() returns a pointer to the data array.
 34: !    - You MUST call VecRestoreArray() when you no longer need access to
 35: !      the array.

 37:     PetscCall(VecGetArrayRead(x, lx_v, ierr))
 38:     PetscCall(VecGetArray(f, lf_v, ierr))

 40: !  Compute function

 42:     lf_v(1) = lx_v(1)*lx_v(1) + lx_v(1)*lx_v(2) - 3.0
 43:     lf_v(2) = lx_v(1)*lx_v(2) + lx_v(2)*lx_v(2) - 6.0

 45: !  Restore vectors

 47:     PetscCall(VecRestoreArrayRead(x, lx_v, ierr))
 48:     PetscCall(VecRestoreArray(f, lf_v, ierr))
 49:   end

 51: ! ---------------------------------------------------------------------
 52: !
 53: !  MonitorDummy - Does nothing, used to test setting several callback functions in Fortran
 54: !
 55:   subroutine MonitorDummy(snes, its, norm, mctx, ierr)
 56:     SNES, intent(in)  :: snes
 57:     PetscInt, intent(in)  :: its
 58:     PetscReal, intent(in)  :: norm
 59:     integer, intent(in)  :: mctx
 60:     PetscErrorCode, intent(out) :: ierr
 61:     ierr = 0
 62:   end subroutine MonitorDummy

 64: end module

 66: program main
 67:   use ex2fmodule
 68:   implicit none

 70: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 71: !                   Variable declarations
 72: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 73: !
 74: !  Variables:
 75: !     snes        - nonlinear solver
 76: !     x, r        - solution, residual vectors
 77: !     its         - iterations for convergence
 78: !
 79:   SNES snes
 80:   Vec x, r
 81:   PetscErrorCode ierr
 82:   PetscInt its
 83:   PetscMPIInt size
 84:   PetscScalar, parameter :: pfive = 0.5
 85:   character(len=256) :: outputString

 87: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 88: !                 Beginning of program
 89: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

 91:   PetscCallA(PetscInitialize(ierr))
 92:   PetscCallMPIA(MPI_Comm_size(PETSC_COMM_WORLD, size, ierr))
 93:   PetscCheckA(size == 1, PETSC_COMM_SELF, PETSC_ERR_WRONG_MPI_SIZE, 'Uniprocessor example')

 95: ! - - - - - - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - -
 96: !  Create nonlinear solver context
 97: ! - - - - - - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - -

 99:   PetscCallA(SNESCreate(PETSC_COMM_WORLD, snes, ierr))

101:   PetscCallA(VecCreateSeq(PETSC_COMM_SELF, 2_PETSC_INT_KIND, x, ierr))
102:   PetscCallA(VecDuplicate(x, r, ierr))

104:   PetscCallA(SNESSetFunction(snes, r, FormFunction, 0, ierr))

106: !  Test setting two more callback functions
107:   PetscCallA(SNESMonitorSet(snes, MonitorDummy, 0, PETSC_NULL_FUNCTION, ierr))

109:   PetscCallA(SNESSetFromOptions(snes, ierr))

111: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
112: !  Evaluate initial guess; then solve nonlinear system
113: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

115:   PetscCallA(VecSet(x, pfive, ierr))
116:   PetscCallA(SNESSolve(snes, PETSC_NULL_VEC, x, ierr))

118: ! View solver converged reason; we could instead use the option -snes_converged_reason
119:   PetscCallA(SNESConvergedReasonView(snes, PETSC_VIEWER_STDOUT_WORLD, ierr))

121:   PetscCallA(SNESGetIterationNumber(snes, its, ierr))
122:   write (outputString, '("Number of SNES iterations = ",i5,"\n")') its
123:   PetscCallA(PetscPrintf(PETSC_COMM_WORLD, outputString, ierr))

125:   PetscCallA(VecDestroy(x, ierr))
126:   PetscCallA(VecDestroy(r, ierr))
127:   PetscCallA(SNESDestroy(snes, ierr))
128:   PetscCallA(PetscFinalize(ierr))
129: end

131: !/*TEST
132: !
133: !   test:
134: !      args: -snes_type composite -snes_composite_type additiveoptimal -snes_composite_sneses anderson,nrichardson
135: !      requires: !single
136: !
137: !TEST*/