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
25: ! ----------------------------------------------
27: module petscdm
28: use, intrinsic :: ISO_C_binding
29: use petscmat
30: use petscdmdef
31: #include <../src/dm/ftn-mod/petscdm.h90>
32: #include <../src/dm/ftn-mod/petscdt.h90>
33: #include <../ftn/dm/petscall.h90>
34: #include <../ftn/dm/petscspace.h90>
35: #include <../ftn/dm/petscdualspace.h90>
37: ! C stub utility
38: interface PetscDSGetTabulationSetSizes
39: subroutine PetscDSGetTabulationSetSizes(ds,i, tab,ierr)
40: use, intrinsic :: ISO_C_binding
41: import tPetscDS, ttPetscTabulation
42: PetscErrorCode ierr
43: type(ttPetscTabulation) tab
44: PetscDS ds
45: PetscInt i
46: end subroutine
47: end interface
49: ! C stub utility
50: interface PetscDSGetTabulationSetPointers
51: subroutine PetscDSGetTabulationSetPointers(ds,i, T,ierr)
52: use, intrinsic :: ISO_C_binding
53: import tPetscDS, ttPetscTabulation,tPetscReal2d
54: PetscErrorCode ierr
55: type(tPetscReal2d), pointer :: T(:)
56: PetscDS ds
57: PetscInt i
58: end subroutine
59: end interface
61: ! C stub utility
62: interface DMCreateFieldDecompositionGetName
63: subroutine DMCreateFieldDecompositionGetName(dm, i, name, ierr)
64: use, intrinsic :: ISO_C_binding
65: import tDM
66: PetscErrorCode ierr
67: DM dm
68: character(*) name
69: PetscInt i
70: end subroutine
71: end interface
73: ! C stub utility
74: interface DMCreateFieldDecompositionGetISDM
75: subroutine DMCreateFieldDecompositionGetISDM(dm, iss, dms, ierr)
76: use, intrinsic :: ISO_C_binding
77: import tIS, tDM
78: PetscErrorCode ierr
79: DM dm
80: IS, pointer :: iss(:)
81: DM, pointer :: dms(:)
82: end subroutine
83: end interface
85: ! C stub utility
86: interface DMCreateFieldDecompositionRestoreISDM
87: subroutine DMCreateFieldDecompositionRestoreISDM(dm, iss, dms, ierr)
88: use, intrinsic :: ISO_C_binding
89: import tIS, tDM
90: PetscErrorCode ierr
91: DM dm
92: IS, pointer :: iss(:)
93: DM, pointer :: dms(:)
94: end subroutine
95: end interface
97: interface PetscDSGetTabulation
98: module procedure PetscDSGetTabulation
99: end interface
101: interface PetscDSRestoreTabulation
102: module procedure PetscDSRestoreTabulation
103: end interface
105: contains
107: #include <../ftn/dm/petscall.hf90>
108: #include <../ftn/dm/petscspace.hf90>
109: #include <../ftn/dm/petscdualspace.hf90>
111: Subroutine PetscDSGetTabulation(ds,tab,ierr)
112: PetscErrorCode ierr
113: PetscTabulation, pointer :: tab(:)
114: PetscDS ds
116: PetscInt Nf, i
117: call PetscDSGetNumFields(ds, Nf, ierr)
118: allocate(tab(Nf))
119: do i=1,Nf
120: allocate(tab(i)%ptr)
121: CHKMEMQ
122: call PetscDSGetTabulationSetSizes(ds, i, tab(i)%ptr, ierr)
123: CHKMEMQ
124: allocate(tab(i)%ptr%T(tab(i)%ptr%K+1))
125: call PetscDSGetTabulationSetPointers(ds, i, tab(i)%ptr%T, ierr)
126: CHKMEMQ
127: enddo
128: End Subroutine PetscDSGetTabulation
130: Subroutine PetscDSRestoreTabulation(ds,tab,ierr)
131: PetscErrorCode ierr
132: PetscTabulation, pointer :: tab(:)
133: PetscDS ds
135: PetscInt Nf, i
136: call PetscDSGetNumFields(ds, Nf, ierr)
137: do i=1,Nf
138: deallocate(tab(i)%ptr%T)
139: deallocate(tab(i)%ptr)
140: enddo
141: deallocate(tab)
142: End Subroutine PetscDSRestoreTabulation
144: Subroutine DMCreateFieldDecomposition(dm, n, names, iss, dms, ierr)
145: PetscErrorCode ierr
146: character(80), pointer :: names(:)
147: IS, pointer :: iss(:)
148: DM, pointer :: dms(:)
149: DM dm
150: PetscInt i,n
152: call DMGetNumFields(dm, n, ierr)
153: ! currently requires that names is requested
154: allocate(names(n))
155: do i=1,n
156: call DMCreateFieldDecompositionGetName(dm,i,names(i),ierr)
157: enddo
158: call DMCreateFieldDecompositionGetISDM(dm,iss,dms,ierr)
159: End Subroutine DMCreateFieldDecomposition
161: Subroutine DMDestroyFieldDecomposition(dm, n, names, iss, dms, ierr)
162: PetscErrorCode ierr
163: character(80), pointer :: names(:)
164: IS, pointer :: iss(:)
165: DM, pointer :: dms(:)
166: DM dm
167: PetscInt n
169: ! currently requires that names is requested
170: deallocate(names)
171: if (.false.) n = 0
172: call DMCreateFieldDecompositionRestoreISDM(dm,iss,dms,ierr)
173: End Subroutine DMDestroyFieldDecomposition
175: end module petscdm
177: ! ----------------------------------------------
179: module petscdmdadef
180: use, intrinsic :: ISO_C_binding
181: use petscdmdef
182: use petscaodef
183: use petscpfdef
184: #include <petsc/finclude/petscao.h>
185: #include <petsc/finclude/petscdmda.h>
186: #include <../ftn/dm/petscdmda.h>
187: end module petscdmdadef
189: module petscdmda
190: use, intrinsic :: ISO_C_binding
191: use petscdm
192: use petscdmdadef
194: #include <../src/dm/ftn-mod/petscdmda.h90>
195: #include <../ftn/dm/petscdmda.h90>
197: contains
199: #include <../ftn/dm/petscdmda.hf90>
200: end module petscdmda
202: ! ----------------------------------------------
204: module petscdmplex
205: use, intrinsic :: ISO_C_binding
206: use petscdm
207: use petscdmdef
208: #include <petsc/finclude/petscfv.h>
209: #include <petsc/finclude/petscdmplex.h>
210: #include <petsc/finclude/petscdmplextransform.h>
211: #include <../src/dm/ftn-mod/petscdmplex.h90>
212: #include <../ftn/dm/petscfv.h>
213: #include <../ftn/dm/petscdmplex.h>
214: #include <../ftn/dm/petscdmplextransform.h>
216: #include <../ftn/dm/petscfv.h90>
217: #include <../ftn/dm/petscdmplex.h90>
218: #include <../ftn/dm/petscdmplextransform.h90>
220: contains
222: #include <../ftn/dm/petscfv.hf90>
223: #include <../ftn/dm/petscdmplex.hf90>
224: #include <../ftn/dm/petscdmplextransform.hf90>
225: end module petscdmplex
227: ! ----------------------------------------------
229: module petscdmstag
230: use, intrinsic :: ISO_C_binding
231: use petscdmdef
232: #include <petsc/finclude/petscdmstag.h>
233: #include <../ftn/dm/petscdmstag.h>
235: #include <../ftn/dm/petscdmstag.h90>
237: contains
239: #include <../ftn/dm/petscdmstag.hf90>
240: end module petscdmstag
242: ! ----------------------------------------------
244: module petscdmswarm
245: use, intrinsic :: ISO_C_binding
246: use petscdm
247: use petscdmdef
248: #include <petsc/finclude/petscdmswarm.h>
249: #include <../ftn/dm/petscdmswarm.h>
251: #include <../src/dm/ftn-mod/petscdmswarm.h90>
252: #include <../ftn/dm/petscdmswarm.h90>
254: contains
256: #include <../ftn/dm/petscdmswarm.hf90>
257: end module petscdmswarm
259: ! ----------------------------------------------
261: module petscdmcomposite
262: use, intrinsic :: ISO_C_binding
263: use petscdm
264: #include <petsc/finclude/petscdmcomposite.h>
266: #include <../src/dm/ftn-mod/petscdmcomposite.h90>
267: #include <../ftn/dm/petscdmcomposite.h90>
268: end module petscdmcomposite
270: ! ----------------------------------------------
272: module petscdmforest
273: use, intrinsic :: ISO_C_binding
274: use petscdm
275: #include <petsc/finclude/petscdmforest.h>
276: #include <../ftn/dm/petscdmforest.h>
277: #include <../ftn/dm/petscdmforest.h90>
278: end module petscdmforest
280: ! ----------------------------------------------
282: module petscdmnetwork
283: use, intrinsic :: ISO_C_binding
284: use petscdm
285: #include <petsc/finclude/petscdmnetwork.h>
286: #include <../ftn/dm/petscdmnetwork.h>
288: #include <../ftn/dm/petscdmnetwork.h90>
290: contains
292: #include <../ftn/dm/petscdmnetwork.hf90>
293: end module petscdmnetwork
295: ! ----------------------------------------------
297: module petscdmadaptor
298: use, intrinsic :: ISO_C_binding
299: use petscdm
300: use petscdmdef
301: ! use petscsnes
302: #include <petsc/finclude/petscdmadaptor.h>
303: #include <../ftn/dm/petscdmadaptor.h>
305: !#include <../ftn/dm/petscdmadaptor.h90>
307: contains
309: !#include <../ftn/dm/petscdmadaptor.hf90>
310: end module petscdmadaptor
312: ! ----------------------------------------------
314: module petscdmshell
315: use petscdm
316: #include <petsc/finclude/petscdmshell.h>
317: #include <../ftn/dm/petscdmshell.h90>
318: end module petscdmshell