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