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