module petscdmdef use, intrinsic :: ISO_C_binding use petscvecdef use petscmatdef #include <../ftn/dm/petscall.h> #include <../ftn/dm/petscspace.h> #include <../ftn/dm/petscdualspace.h> type ttPetscTabulation sequence PetscInt K PetscInt Nr PetscInt Np PetscInt Nb PetscInt Nc PetscInt cdim PetscReal2d, pointer :: T(:) end type ttPetscTabulation type tPetscTabulation type(ttPetscTabulation), pointer :: ptr end type tPetscTabulation end module petscdmdef module petscdm use, intrinsic :: ISO_C_binding use petscmat use petscdmdef #include <../src/dm/ftn-mod/petscdm.h90> #include <../src/dm/ftn-mod/petscdt.h90> #include <../ftn/dm/petscall.h90> #include <../ftn/dm/petscspace.h90> #include <../ftn/dm/petscdualspace.h90> ! C stub utility interface PetscDSGetTabulationSetSizes subroutine PetscDSGetTabulationSetSizes(ds, i, tab, ierr) use, intrinsic :: ISO_C_binding import tPetscDS, ttPetscTabulation PetscErrorCode ierr type(ttPetscTabulation) tab PetscDS ds PetscInt i end subroutine end interface ! C stub utility interface PetscDSGetTabulationSetPointers subroutine PetscDSGetTabulationSetPointers(ds, i, T, ierr) use, intrinsic :: ISO_C_binding import tPetscDS, ttPetscTabulation, tPetscReal2d PetscErrorCode ierr type(tPetscReal2d), pointer :: T(:) PetscDS ds PetscInt i end subroutine end interface ! C stub utility interface DMCreateFieldDecompositionGetName subroutine DMCreateFieldDecompositionGetName(dm, i, name, ierr) use, intrinsic :: ISO_C_binding import tDM PetscErrorCode ierr DM dm character(*) name PetscInt i end subroutine end interface ! C stub utility interface DMCreateFieldDecompositionGetISDM subroutine DMCreateFieldDecompositionGetISDM(dm, iss, dms, ierr) use, intrinsic :: ISO_C_binding import tIS, tDM PetscErrorCode ierr DM dm IS, pointer :: iss(:) DM, pointer :: dms(:) end subroutine end interface ! C stub utility interface DMCreateFieldDecompositionRestoreISDM subroutine DMCreateFieldDecompositionRestoreISDM(dm, iss, dms, ierr) use, intrinsic :: ISO_C_binding import tIS, tDM PetscErrorCode ierr DM dm IS, pointer :: iss(:) DM, pointer :: dms(:) end subroutine end interface interface PetscDSGetTabulation module procedure PetscDSGetTabulation end interface interface PetscDSRestoreTabulation module procedure PetscDSRestoreTabulation end interface contains #include <../ftn/dm/petscall.hf90> #include <../ftn/dm/petscspace.hf90> #include <../ftn/dm/petscdualspace.hf90> subroutine PetscDSGetTabulation(ds, tab, ierr) PetscErrorCode ierr PetscTabulation, pointer :: tab(:) PetscDS ds PetscInt Nf, i call PetscDSGetNumFields(ds, Nf, ierr) allocate (tab(Nf)) do i = 1, Nf allocate (tab(i)%ptr) CHKMEMQ call PetscDSGetTabulationSetSizes(ds, i, tab(i)%ptr, ierr) CHKMEMQ allocate (tab(i)%ptr%T(tab(i)%ptr%K + 1)) call PetscDSGetTabulationSetPointers(ds, i, tab(i)%ptr%T, ierr) CHKMEMQ end do end subroutine PetscDSGetTabulation subroutine PetscDSRestoreTabulation(ds, tab, ierr) PetscErrorCode ierr PetscTabulation, pointer :: tab(:) PetscDS ds PetscInt Nf, i call PetscDSGetNumFields(ds, Nf, ierr) do i = 1, Nf deallocate (tab(i)%ptr%T) deallocate (tab(i)%ptr) end do deallocate (tab) end subroutine PetscDSRestoreTabulation subroutine DMCreateFieldDecomposition(dm, n, names, iss, dms, ierr) PetscErrorCode ierr character(80), pointer :: names(:) IS, pointer :: iss(:) DM, pointer :: dms(:) DM dm PetscInt i, n call DMGetNumFields(dm, n, ierr) ! currently requires that names is requested allocate (names(n)) do i = 1, n call DMCreateFieldDecompositionGetName(dm, i, names(i), ierr) end do call DMCreateFieldDecompositionGetISDM(dm, iss, dms, ierr) end subroutine DMCreateFieldDecomposition subroutine DMDestroyFieldDecomposition(dm, n, names, iss, dms, ierr) PetscErrorCode ierr character(80), pointer :: names(:) IS, pointer :: iss(:) DM, pointer :: dms(:) DM dm PetscInt n ! currently requires that names is requested deallocate (names) if (.false.) n = 0 call DMCreateFieldDecompositionRestoreISDM(dm, iss, dms, ierr) end subroutine DMDestroyFieldDecomposition end module petscdm module petscdmdadef use, intrinsic :: ISO_C_binding use petscdmdef use petscaodef use petscpfdef #include #include #include <../ftn/dm/petscdmda.h> end module petscdmdadef module petscdmda use, intrinsic :: ISO_C_binding use petscdm use petscdmdadef #include <../src/dm/ftn-mod/petscdmda.h90> #include <../ftn/dm/petscdmda.h90> contains #include <../ftn/dm/petscdmda.hf90> end module petscdmda module petscdmplex use, intrinsic :: ISO_C_binding use petscdm use petscdmdef #include #include #include #include <../src/dm/ftn-mod/petscdmplex.h90> #include <../ftn/dm/petscfv.h> #include <../ftn/dm/petscdmplex.h> #include <../ftn/dm/petscdmplextransform.h> #include <../ftn/dm/petscfv.h90> #include <../ftn/dm/petscdmplex.h90> #include <../ftn/dm/petscdmplextransform.h90> contains #include <../ftn/dm/petscfv.hf90> #include <../ftn/dm/petscdmplex.hf90> #include <../ftn/dm/petscdmplextransform.hf90> end module petscdmplex module petscdmstag use, intrinsic :: ISO_C_binding use petscdmdef #include #include <../ftn/dm/petscdmstag.h> #include <../ftn/dm/petscdmstag.h90> contains #include <../ftn/dm/petscdmstag.hf90> end module petscdmstag module petscdmswarm use, intrinsic :: ISO_C_binding use petscdm use petscdmdef #include #include <../ftn/dm/petscdmswarm.h> #include <../src/dm/ftn-mod/petscdmswarm.h90> #include <../ftn/dm/petscdmswarm.h90> contains #include <../ftn/dm/petscdmswarm.hf90> end module petscdmswarm module petscdmcomposite use, intrinsic :: ISO_C_binding use petscdm #include #include <../src/dm/ftn-mod/petscdmcomposite.h90> #include <../ftn/dm/petscdmcomposite.h90> end module petscdmcomposite module petscdmforest use, intrinsic :: ISO_C_binding use petscdm #include #include <../ftn/dm/petscdmforest.h> #include <../ftn/dm/petscdmforest.h90> end module petscdmforest module petscdmnetwork use, intrinsic :: ISO_C_binding use petscdm #include #include <../ftn/dm/petscdmnetwork.h> #include <../ftn/dm/petscdmnetwork.h90> contains #include <../ftn/dm/petscdmnetwork.hf90> end module petscdmnetwork module petscdmadaptor use, intrinsic :: ISO_C_binding use petscdm use petscdmdef ! use petscsnes #include #include <../ftn/dm/petscdmadaptor.h> !#include <../ftn/dm/petscdmadaptor.h90> contains !#include <../ftn/dm/petscdmadaptor.hf90> end module petscdmadaptor module petscdmshell use petscdm #include #include <../ftn/dm/petscdmshell.h90> end module petscdmshell