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 petscdm
202: use petscdmdef
203: #include <petsc/finclude/petscfv.h>
204: #include <petsc/finclude/petscdmplex.h>
205: #include <petsc/finclude/petscdmplextransform.h>
206: #include <../src/dm/ftn-mod/petscdmplex.h90>
207: #include <../ftn/dm/petscfv.h>
208: #include <../ftn/dm/petscdmplex.h>
209: #include <../ftn/dm/petscdmplextransform.h>
211: #include <../ftn/dm/petscfv.h90>
212: #include <../ftn/dm/petscdmplex.h90>
213: #include <../ftn/dm/petscdmplextransform.h90>
215: contains
217: #include <../ftn/dm/petscfv.hf90>
218: #include <../ftn/dm/petscdmplex.hf90>
219: #include <../ftn/dm/petscdmplextransform.hf90>
220: end module petscdmplex
222: module petscdmstag
223: use, intrinsic :: ISO_C_binding
224: use petscdmdef
225: #include <petsc/finclude/petscdmstag.h>
226: #include <../ftn/dm/petscdmstag.h>
228: #include <../ftn/dm/petscdmstag.h90>
230: contains
232: #include <../ftn/dm/petscdmstag.hf90>
233: end module petscdmstag
235: module petscdmswarm
236: use, intrinsic :: ISO_C_binding
237: use petscdm
238: use petscdmdef
239: #include <petsc/finclude/petscdmswarm.h>
240: #include <../ftn/dm/petscdmswarm.h>
242: #include <../src/dm/ftn-mod/petscdmswarm.h90>
243: #include <../ftn/dm/petscdmswarm.h90>
245: contains
247: #include <../ftn/dm/petscdmswarm.hf90>
248: end module petscdmswarm
250: module petscdmcomposite
251: use, intrinsic :: ISO_C_binding
252: use petscdm
253: #include <petsc/finclude/petscdmcomposite.h>
255: #include <../src/dm/ftn-mod/petscdmcomposite.h90>
256: #include <../ftn/dm/petscdmcomposite.h90>
257: end module petscdmcomposite
259: module petscdmforest
260: use, intrinsic :: ISO_C_binding
261: use petscdm
262: #include <petsc/finclude/petscdmforest.h>
263: #include <../ftn/dm/petscdmforest.h>
264: #include <../ftn/dm/petscdmforest.h90>
265: end module petscdmforest
267: module petscdmnetwork
268: use, intrinsic :: ISO_C_binding
269: use petscdm
270: #include <petsc/finclude/petscdmnetwork.h>
271: #include <../ftn/dm/petscdmnetwork.h>
273: #include <../ftn/dm/petscdmnetwork.h90>
275: contains
277: #include <../ftn/dm/petscdmnetwork.hf90>
278: end module petscdmnetwork
280: module petscdmadaptor
281: use, intrinsic :: ISO_C_binding
282: use petscdm
283: use petscdmdef
284: ! use petscsnes
285: #include <petsc/finclude/petscdmadaptor.h>
286: #include <../ftn/dm/petscdmadaptor.h>
288: !#include <../ftn/dm/petscdmadaptor.h90>
290: contains
292: !#include <../ftn/dm/petscdmadaptor.hf90>
293: end module petscdmadaptor
295: module petscdmshell
296: use petscdm
297: #include <petsc/finclude/petscdmshell.h>
298: #include <../ftn/dm/petscdmshell.h90>
299: end module petscdmshell