1: ! test verifies DMShellSetCreateFieldDecomposition interface in Fortran
  2: #include "petsc/finclude/petsc.h"

  4: module ex54fmodule
  5:   use petsc
  6:   implicit none

  8: contains
  9:   ! a simple Fortran callback for field decomposition.
 10:   subroutine myFieldDecomp(dm, nfields, fieldNames, isFields, subDms, ierr)
 11:     type(tDM), intent(in) :: dm
 12:     PetscInt, intent(out) :: nfields
 13:     character(len=30), allocatable, intent(out) :: fieldNames(:)
 14:     type(tIS), allocatable, intent(out) :: isFields(:)
 15:     type(tDM), allocatable, intent(out) :: subDms(:)
 16:     PetscErrorCode, intent(out) :: ierr
 17:     ! defining a simple decomposition with two fields
 18:     nfields = 2
 19:     allocate (fieldNames(nfields))
 20:     allocate (isFields(nfields))
 21:     allocate (subDms(nfields))
 22:     fieldNames(1) = 'field1'
 23:     fieldNames(2) = 'field2'
 24:     ! set the pointer arrays to NULL (using pointer assignment)
 25:     isFields(1:nfields) = PETSC_NULL_IS
 26:     subDms(1:nfields) = PETSC_NULL_DM
 27:     ierr = 0
 28:     print *, 'myFieldDecomp callback invoked.'
 29:   end subroutine myFieldDecomp
 30: end module ex54fmodule

 32: program ex54f
 33:   use petsc
 34:   use ex54fmodule
 35:   implicit none
 36:   type(tDM)          :: dm
 37:   PetscErrorCode     :: ierr
 38:   ! initializing PETSc
 39:   PetscCallA(PetscInitialize(PETSC_NULL_CHARACTER, ierr))
 40:   ! creating a DMShell object
 41:   PetscCallA(DMShellCreate(PETSC_COMM_WORLD, dm, ierr))
 42:   ! registering the Fortran field decomposition callback
 43:   PetscCallA(DMShellSetCreateFieldDecomposition(dm, myFieldDecomp, ierr))
 44:   ! for this minimal test, we simply print a success message to the console
 45:   print *, 'DMShellSetCreateFieldDecomposition set successfully.'
 46:   ! cleanup
 47:   PetscCallA(DMDestroy(dm, ierr))
 48:   PetscCallA(PetscFinalize(ierr))
 49: end program ex54f

 51: !/*TEST
 52: !
 53: !   test:
 54: !TEST*/