1: ! test verifies DMShellSetCreateFieldDecomposition interface in Fortran
  2: #include "petsc/finclude/petsc.h"
  3: program main
  4:   use petsc
  5:   implicit none
  6:   type(tDM)          :: dm
  7:   PetscErrorCode     :: ierr
  8:   interface
  9:     subroutine myFieldDecomp(dm, nfields, fieldNames, isFields, subDms, ierr)
 10:       use petsc
 11:       implicit none
 12:       type(tDM), intent(in) :: dm
 13:       PetscInt, intent(out) :: nfields
 14:       character(len=30), allocatable, intent(out) :: fieldNames(:)
 15:       type(tIS), allocatable, intent(out) :: isFields(:)
 16:       type(tDM), allocatable, intent(out) :: subDms(:)
 17:       PetscErrorCode, intent(out) :: ierr
 18:     end subroutine myFieldDecomp
 19:   end interface
 20:   ! initializing PETSc
 21:   PetscCallA(PetscInitialize(PETSC_NULL_CHARACTER, ierr))
 22:   ! creating a DMShell object
 23:   PetscCallA(DMShellCreate(PETSC_COMM_WORLD, dm, ierr))
 24:   ! registering the Fortran field decomposition callback
 25:   PetscCallA(DMShellSetCreateFieldDecomposition(dm, myFieldDecomp, ierr))
 26:   ! for this minimal test, we simply print a success message to the console
 27:   print *, 'DMShellSetCreateFieldDecomposition set successfully.'
 28:   ! cleanup
 29:   PetscCallA(DMDestroy(dm, ierr))
 30:   PetscCallA(PetscFinalize(ierr))
 31: end program main

 33: ! a simple Fortran callback for field decomposition.
 34: subroutine myFieldDecomp(dm, nfields, fieldNames, isFields, subDms, ierr)
 35:   use petsc
 36:   implicit none
 37:   type(tDM), intent(in) :: dm
 38:   PetscInt, intent(out) :: nfields
 39:   character(len=30), allocatable, intent(out) :: fieldNames(:)
 40:   type(tIS), allocatable, intent(out) :: isFields(:)
 41:   type(tDM), allocatable, intent(out) :: subDms(:)
 42:   PetscErrorCode, intent(out) :: ierr
 43:   PetscInt :: i
 44:   ! defining a simple decomposition with two fields
 45:   nfields = 2
 46:   allocate (fieldNames(nfields))
 47:   allocate (isFields(nfields))
 48:   allocate (subDms(nfields))
 49:   fieldNames(1) = 'field1'
 50:   fieldNames(2) = 'field2'
 51:   ! set the pointer arrays to NULL (using pointer assignment)
 52:   do i = 1, nfields
 53:     isFields(i) = PETSC_NULL_IS
 54:     subDms(i) = PETSC_NULL_DM
 55:   end do
 56:   ierr = 0
 57:   print *, 'myFieldDecomp callback invoked.'
 58: end subroutine myFieldDecomp
 59: !/*TEST
 60: !
 61: !   test:
 62: !TEST*/