Actual source code: petscdmmod.F90
1: module 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>
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
20: type tPetscTabulation
21: type(ttPetscTabulation), pointer :: ptr
22: end type tPetscTabulation
24: end module petscdmdef
26: module 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>
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
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
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
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
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
96: interface PetscDSGetTabulation
97: module procedure PetscDSGetTabulation
98: end interface
100: interface PetscDSRestoreTabulation
101: module procedure PetscDSRestoreTabulation
102: end interface
104: contains
106: #include <../ftn/dm/petscall.hf90>
107: #include <../ftn/dm/petscspace.hf90>
108: #include <../ftn/dm/petscdualspace.hf90>
110: subroutine PetscDSGetTabulation(ds, tab, ierr)
111: PetscErrorCode ierr
112: PetscTabulation, pointer :: tab(:)
113: PetscDS ds
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
129: subroutine PetscDSRestoreTabulation(ds, tab, ierr)
130: PetscErrorCode ierr
131: PetscTabulation, pointer :: tab(:)
132: PetscDS ds
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
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
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
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
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
174: end module petscdm
176: module 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>
184: end module petscdmdadef
186: module petscdmda
187: use, intrinsic :: ISO_C_binding
188: use petscdm
189: use petscdmdadef
191: #include <../src/dm/ftn-mod/petscdmda.h90>
192: #include <../ftn/dm/petscdmda.h90>
194: contains
196: #include <../ftn/dm/petscdmda.hf90>
197: end module petscdmda
199: module petscdmplex
200: use, intrinsic :: ISO_C_binding
201: use petscdraw
202: use petscdm
203: use petscdmdef
204: #include <petsc/finclude/petscdraw.h>
205: #include <petsc/finclude/petscfv.h>
206: #include <petsc/finclude/petscdmplex.h>
207: #include <petsc/finclude/petscdmplextransform.h>
208: #include <../src/dm/ftn-mod/petscdmplex.h90>
209: #include <../ftn/dm/petscfv.h>
210: #include <../ftn/dm/petscdmplex.h>
211: #include <../ftn/dm/petscdmplextransform.h>
213: #include <../ftn/dm/petscfv.h90>
214: #include <../ftn/dm/petscdmplex.h90>
215: #include <../ftn/dm/petscdmplextransform.h90>
217: contains
219: #include <../ftn/dm/petscfv.hf90>
220: #include <../ftn/dm/petscdmplex.hf90>
221: #include <../ftn/dm/petscdmplextransform.hf90>
222: end module petscdmplex
224: module petscdmstag
225: use, intrinsic :: ISO_C_binding
226: use petscdmdef
227: #include <petsc/finclude/petscdmstag.h>
228: #include <../ftn/dm/petscdmstag.h>
230: #include <../ftn/dm/petscdmstag.h90>
232: contains
234: #include <../ftn/dm/petscdmstag.hf90>
235: end module petscdmstag
237: module petscdmswarm
238: use, intrinsic :: ISO_C_binding
239: use petscdm
240: use petscdmdef
241: #include <petsc/finclude/petscdmswarm.h>
242: #include <../ftn/dm/petscdmswarm.h>
244: #include <../src/dm/ftn-mod/petscdmswarm.h90>
245: #include <../ftn/dm/petscdmswarm.h90>
247: contains
249: #include <../ftn/dm/petscdmswarm.hf90>
250: end module petscdmswarm
252: module petscdmcomposite
253: use, intrinsic :: ISO_C_binding
254: use petscdm
255: #include <petsc/finclude/petscdmcomposite.h>
257: #include <../src/dm/ftn-mod/petscdmcomposite.h90>
258: #include <../ftn/dm/petscdmcomposite.h90>
259: end module petscdmcomposite
261: module petscdmforest
262: use, intrinsic :: ISO_C_binding
263: use petscdm
264: #include <petsc/finclude/petscdmforest.h>
265: #include <../ftn/dm/petscdmforest.h>
266: #include <../ftn/dm/petscdmforest.h90>
267: end module petscdmforest
269: module petscdmnetwork
270: use, intrinsic :: ISO_C_binding
271: use petscdm
272: #include <petsc/finclude/petscdmnetwork.h>
273: #include <../ftn/dm/petscdmnetwork.h>
275: #include <../ftn/dm/petscdmnetwork.h90>
277: contains
279: #include <../ftn/dm/petscdmnetwork.hf90>
280: end module petscdmnetwork
282: module petscdmadaptor
283: use, intrinsic :: ISO_C_binding
284: use petscdm
285: use petscdmdef
286: ! use petscsnes
287: #include <petsc/finclude/petscdmadaptor.h>
288: #include <../ftn/dm/petscdmadaptor.h>
290: !#include <../ftn/dm/petscdmadaptor.h90>
292: contains
294: !#include <../ftn/dm/petscdmadaptor.hf90>
295: end module petscdmadaptor
297: module petscdmshell
298: use petscdm
299: #include <petsc/finclude/petscdmshell.h>
300: #include <../ftn/dm/petscdmshell.h90>
301: end module petscdmshell