1module petscdmdef 2 use, intrinsic :: ISO_C_binding 3 use petscvecdef 4 use petscmatdef 5#include <../ftn/dm/petscall.h> 6#include <../ftn/dm/petscspace.h> 7#include <../ftn/dm/petscdualspace.h> 8 9 type ttPetscTabulation 10 sequence 11 PetscInt K 12 PetscInt Nr 13 PetscInt Np 14 PetscInt Nb 15 PetscInt Nc 16 PetscInt cdim 17 PetscReal2d, pointer :: T(:) 18 end type ttPetscTabulation 19 20 type tPetscTabulation 21 type(ttPetscTabulation), pointer :: ptr 22 end type tPetscTabulation 23 24end module petscdmdef 25 26module petscdm 27 use, intrinsic :: ISO_C_binding 28 use petscmat 29 use petscdmdef 30#include <../src/dm/ftn-mod/petscdm.h90> 31#include <../src/dm/ftn-mod/petscdt.h90> 32#include <../ftn/dm/petscall.h90> 33#include <../ftn/dm/petscspace.h90> 34#include <../ftn/dm/petscdualspace.h90> 35 36 ! C stub utility 37 interface PetscDSGetTabulationSetSizes 38 subroutine PetscDSGetTabulationSetSizes(ds, i, tab, ierr) 39 use, intrinsic :: ISO_C_binding 40 import tPetscDS, ttPetscTabulation 41 PetscErrorCode ierr 42 type(ttPetscTabulation) tab 43 PetscDS ds 44 PetscInt i 45 end subroutine 46 end interface 47 48 ! C stub utility 49 interface PetscDSGetTabulationSetPointers 50 subroutine PetscDSGetTabulationSetPointers(ds, i, T, ierr) 51 use, intrinsic :: ISO_C_binding 52 import tPetscDS, ttPetscTabulation, tPetscReal2d 53 PetscErrorCode ierr 54 type(tPetscReal2d), pointer :: T(:) 55 PetscDS ds 56 PetscInt i 57 end subroutine 58 end interface 59 60 ! C stub utility 61 interface DMCreateFieldDecompositionGetName 62 subroutine DMCreateFieldDecompositionGetName(dm, i, name, ierr) 63 use, intrinsic :: ISO_C_binding 64 import tDM 65 PetscErrorCode ierr 66 DM dm 67 character(*) name 68 PetscInt i 69 end subroutine 70 end interface 71 72 ! C stub utility 73 interface DMCreateFieldDecompositionGetISDM 74 subroutine DMCreateFieldDecompositionGetISDM(dm, iss, dms, ierr) 75 use, intrinsic :: ISO_C_binding 76 import tIS, tDM 77 PetscErrorCode ierr 78 DM dm 79 IS, pointer :: iss(:) 80 DM, pointer :: dms(:) 81 end subroutine 82 end interface 83 84 ! C stub utility 85 interface DMCreateFieldDecompositionRestoreISDM 86 subroutine DMCreateFieldDecompositionRestoreISDM(dm, iss, dms, ierr) 87 use, intrinsic :: ISO_C_binding 88 import tIS, tDM 89 PetscErrorCode ierr 90 DM dm 91 IS, pointer :: iss(:) 92 DM, pointer :: dms(:) 93 end subroutine 94 end interface 95 96 interface PetscDSGetTabulation 97 module procedure PetscDSGetTabulation 98 end interface 99 100 interface PetscDSRestoreTabulation 101 module procedure PetscDSRestoreTabulation 102 end interface 103 104contains 105 106#include <../ftn/dm/petscall.hf90> 107#include <../ftn/dm/petscspace.hf90> 108#include <../ftn/dm/petscdualspace.hf90> 109 110 subroutine PetscDSGetTabulation(ds, tab, ierr) 111 PetscErrorCode ierr 112 PetscTabulation, pointer :: tab(:) 113 PetscDS ds 114 115 PetscInt Nf, i 116 call PetscDSGetNumFields(ds, Nf, ierr) 117 allocate (tab(Nf)) 118 do i = 1, Nf 119 allocate (tab(i)%ptr) 120 CHKMEMQ 121 call PetscDSGetTabulationSetSizes(ds, i, tab(i)%ptr, ierr) 122 CHKMEMQ 123 allocate (tab(i)%ptr%T(tab(i)%ptr%K + 1)) 124 call PetscDSGetTabulationSetPointers(ds, i, tab(i)%ptr%T, ierr) 125 CHKMEMQ 126 end do 127 end subroutine PetscDSGetTabulation 128 129 subroutine PetscDSRestoreTabulation(ds, tab, ierr) 130 PetscErrorCode ierr 131 PetscTabulation, pointer :: tab(:) 132 PetscDS ds 133 134 PetscInt Nf, i 135 call PetscDSGetNumFields(ds, Nf, ierr) 136 do i = 1, Nf 137 deallocate (tab(i)%ptr%T) 138 deallocate (tab(i)%ptr) 139 end do 140 deallocate (tab) 141 end subroutine PetscDSRestoreTabulation 142 143 subroutine DMCreateFieldDecomposition(dm, n, names, iss, dms, ierr) 144 PetscErrorCode ierr 145 character(80), pointer :: names(:) 146 IS, pointer :: iss(:) 147 DM, pointer :: dms(:) 148 DM dm 149 PetscInt i, n 150 151 call DMGetNumFields(dm, n, ierr) 152 ! currently requires that names is requested 153 allocate (names(n)) 154 do i = 1, n 155 call DMCreateFieldDecompositionGetName(dm, i, names(i), ierr) 156 end do 157 call DMCreateFieldDecompositionGetISDM(dm, iss, dms, ierr) 158 end subroutine DMCreateFieldDecomposition 159 160 subroutine DMDestroyFieldDecomposition(dm, n, names, iss, dms, ierr) 161 PetscErrorCode ierr 162 character(80), pointer :: names(:) 163 IS, pointer :: iss(:) 164 DM, pointer :: dms(:) 165 DM dm 166 PetscInt n 167 168 ! currently requires that names is requested 169 deallocate (names) 170 if (.false.) n = 0 171 call DMCreateFieldDecompositionRestoreISDM(dm, iss, dms, ierr) 172 end subroutine DMDestroyFieldDecomposition 173 174end module petscdm 175 176module petscdmdadef 177 use, intrinsic :: ISO_C_binding 178 use petscdmdef 179 use petscaodef 180 use petscpfdef 181#include <petsc/finclude/petscao.h> 182#include <petsc/finclude/petscdmda.h> 183#include <../ftn/dm/petscdmda.h> 184end module petscdmdadef 185 186module petscdmda 187 use, intrinsic :: ISO_C_binding 188 use petscdm 189 use petscdmdadef 190 191#include <../src/dm/ftn-mod/petscdmda.h90> 192#include <../ftn/dm/petscdmda.h90> 193 194contains 195 196#include <../ftn/dm/petscdmda.hf90> 197end module petscdmda 198 199module petscdmplex 200 use, intrinsic :: ISO_C_binding 201 use petscdm 202 use petscdmdef 203#include <petsc/finclude/petscfv.h> 204#include <petsc/finclude/petscdmplex.h> 205#include <petsc/finclude/petscdmplextransform.h> 206#include <../src/dm/ftn-mod/petscdmplex.h90> 207#include <../ftn/dm/petscfv.h> 208#include <../ftn/dm/petscdmplex.h> 209#include <../ftn/dm/petscdmplextransform.h> 210 211#include <../ftn/dm/petscfv.h90> 212#include <../ftn/dm/petscdmplex.h90> 213#include <../ftn/dm/petscdmplextransform.h90> 214 215contains 216 217#include <../ftn/dm/petscfv.hf90> 218#include <../ftn/dm/petscdmplex.hf90> 219#include <../ftn/dm/petscdmplextransform.hf90> 220end module petscdmplex 221 222module petscdmstag 223 use, intrinsic :: ISO_C_binding 224 use petscdmdef 225#include <petsc/finclude/petscdmstag.h> 226#include <../ftn/dm/petscdmstag.h> 227 228#include <../ftn/dm/petscdmstag.h90> 229 230contains 231 232#include <../ftn/dm/petscdmstag.hf90> 233end module petscdmstag 234 235module petscdmswarm 236 use, intrinsic :: ISO_C_binding 237 use petscdm 238 use petscdmdef 239#include <petsc/finclude/petscdmswarm.h> 240#include <../ftn/dm/petscdmswarm.h> 241 242#include <../src/dm/ftn-mod/petscdmswarm.h90> 243#include <../ftn/dm/petscdmswarm.h90> 244 245contains 246 247#include <../ftn/dm/petscdmswarm.hf90> 248end module petscdmswarm 249 250module petscdmcomposite 251 use, intrinsic :: ISO_C_binding 252 use petscdm 253#include <petsc/finclude/petscdmcomposite.h> 254 255#include <../src/dm/ftn-mod/petscdmcomposite.h90> 256#include <../ftn/dm/petscdmcomposite.h90> 257end module petscdmcomposite 258 259module petscdmforest 260 use, intrinsic :: ISO_C_binding 261 use petscdm 262#include <petsc/finclude/petscdmforest.h> 263#include <../ftn/dm/petscdmforest.h> 264#include <../ftn/dm/petscdmforest.h90> 265end module petscdmforest 266 267module petscdmnetwork 268 use, intrinsic :: ISO_C_binding 269 use petscdm 270#include <petsc/finclude/petscdmnetwork.h> 271#include <../ftn/dm/petscdmnetwork.h> 272 273#include <../ftn/dm/petscdmnetwork.h90> 274 275contains 276 277#include <../ftn/dm/petscdmnetwork.hf90> 278end module petscdmnetwork 279 280module petscdmadaptor 281 use, intrinsic :: ISO_C_binding 282 use petscdm 283 use petscdmdef 284! use petscsnes 285#include <petsc/finclude/petscdmadaptor.h> 286#include <../ftn/dm/petscdmadaptor.h> 287 288!#include <../ftn/dm/petscdmadaptor.h90> 289 290contains 291 292!#include <../ftn/dm/petscdmadaptor.hf90> 293end module petscdmadaptor 294 295module petscdmshell 296 use petscdm 297#include <petsc/finclude/petscdmshell.h> 298#include <../ftn/dm/petscdmshell.h90> 299end module petscdmshell 300