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