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 if (.false.) n = 0 165 call DMCreateFieldDecompositionRestoreISDM(dm,iss,dms,ierr) 166 End Subroutine DMDestroyFieldDecomposition 167 168 end module petscdm 169 170! ---------------------------------------------- 171 172 module petscdmdadef 173 use petscdmdef 174 use petscaodef 175 use petscpfdef 176#include <petsc/finclude/petscao.h> 177#include <petsc/finclude/petscdmda.h> 178#include <../ftn/dm/petscdmda.h> 179 end module petscdmdadef 180 181 module petscdmda 182 use petscdm 183 use petscdmdadef 184 185#include <../src/dm/ftn-mod/petscdmda.h90> 186#include <../ftn/dm/petscdmda.h90> 187 188 contains 189 190#include <../ftn/dm/petscdmda.hf90> 191 end module petscdmda 192 193! ---------------------------------------------- 194 195 module petscdmplex 196 use petscdm 197 use petscdmdef 198#include <petsc/finclude/petscfv.h> 199#include <petsc/finclude/petscdmplex.h> 200#include <petsc/finclude/petscdmplextransform.h> 201#include <../src/dm/ftn-mod/petscdmplex.h90> 202#include <../ftn/dm/petscfv.h> 203#include <../ftn/dm/petscdmplex.h> 204#include <../ftn/dm/petscdmplextransform.h> 205 206#include <../ftn/dm/petscfv.h90> 207#include <../ftn/dm/petscdmplex.h90> 208#include <../ftn/dm/petscdmplextransform.h90> 209 210 contains 211 212#include <../ftn/dm/petscfv.hf90> 213#include <../ftn/dm/petscdmplex.hf90> 214#include <../ftn/dm/petscdmplextransform.hf90> 215 end module petscdmplex 216 217! ---------------------------------------------- 218 219 module petscdmstag 220 use petscdmdef 221#include <petsc/finclude/petscdmstag.h> 222#include <../ftn/dm/petscdmstag.h> 223 224#include <../ftn/dm/petscdmstag.h90> 225 226 contains 227 228#include <../ftn/dm/petscdmstag.hf90> 229 end module petscdmstag 230 231! ---------------------------------------------- 232 233 module petscdmswarm 234 use petscdm 235 use petscdmdef 236#include <petsc/finclude/petscdmswarm.h> 237#include <../ftn/dm/petscdmswarm.h> 238 239#include <../src/dm/ftn-mod/petscdmswarm.h90> 240#include <../ftn/dm/petscdmswarm.h90> 241 242 contains 243 244#include <../ftn/dm/petscdmswarm.hf90> 245 end module petscdmswarm 246 247! ---------------------------------------------- 248 249 module petscdmcomposite 250 use petscdm 251#include <petsc/finclude/petscdmcomposite.h> 252 253#include <../src/dm/ftn-mod/petscdmcomposite.h90> 254#include <../ftn/dm/petscdmcomposite.h90> 255 end module petscdmcomposite 256 257! ---------------------------------------------- 258 259 module petscdmforest 260 use petscdm 261#include <petsc/finclude/petscdmforest.h> 262#include <../ftn/dm/petscdmforest.h> 263#include <../ftn/dm/petscdmforest.h90> 264 end module petscdmforest 265 266! ---------------------------------------------- 267 268 module petscdmnetwork 269 use petscdm 270#include <petsc/finclude/petscdmnetwork.h> 271#include <../ftn/dm/petscdmnetwork.h> 272 273#include <../ftn/dm/petscdmnetwork.h90> 274 275 contains 276 277#include <../ftn/dm/petscdmnetwork.hf90> 278 end module petscdmnetwork 279 280! ---------------------------------------------- 281 282 module petscdmadaptor 283 use petscdm 284 use petscdmdef 285! use petscsnes 286#include <petsc/finclude/petscdmadaptor.h> 287#include <../ftn/dm/petscdmadaptor.h> 288 289!#include <../ftn/dm/petscdmadaptor.h90> 290 291 contains 292 293!#include <../ftn/dm/petscdmadaptor.hf90> 294 end module petscdmadaptor 295