1! test verifies DMShellSetCreateFieldDecomposition interface in Fortran 2#include "petsc/finclude/petsc.h" 3program 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)) 31end program main 32 33! a simple Fortran callback for field decomposition. 34subroutine 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.' 58end subroutine myFieldDecomp 59!/*TEST 60! 61! test: 62!TEST*/ 63