Actual source code: petscdmmod.F90
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>
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
19: type tPetscTabulation
20: type(ttPetscTabulation), pointer :: ptr
21: end type tPetscTabulation
23: end module petscdmdef
24: ! ----------------------------------------------
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>
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
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
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
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
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
90: interface PetscDSGetTabulation
91: module procedure PetscDSGetTabulation
92: end interface
94: interface PetscDSRestoreTabulation
95: module procedure PetscDSRestoreTabulation
96: end interface
98: contains
100: #include <../ftn/dm/petscall.hf90>
101: #include <../ftn/dm/petscspace.hf90>
102: #include <../ftn/dm/petscdualspace.hf90>
104: Subroutine PetscDSGetTabulation(ds,tab,ierr)
105: PetscErrorCode ierr
106: PetscTabulation, pointer :: tab(:)
107: PetscDS ds
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
123: Subroutine PetscDSRestoreTabulation(ds,tab,ierr)
124: PetscErrorCode ierr
125: PetscTabulation, pointer :: tab(:)
126: PetscDS ds
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
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
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
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
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
168: end module petscdm
170: ! ----------------------------------------------
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
181: module petscdmda
182: use petscdm
183: use petscdmdadef
185: #include <../src/dm/ftn-mod/petscdmda.h90>
186: #include <../ftn/dm/petscdmda.h90>
188: contains
190: #include <../ftn/dm/petscdmda.hf90>
191: end module petscdmda
193: ! ----------------------------------------------
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>
206: #include <../ftn/dm/petscfv.h90>
207: #include <../ftn/dm/petscdmplex.h90>
208: #include <../ftn/dm/petscdmplextransform.h90>
210: contains
212: #include <../ftn/dm/petscfv.hf90>
213: #include <../ftn/dm/petscdmplex.hf90>
214: #include <../ftn/dm/petscdmplextransform.hf90>
215: end module petscdmplex
217: ! ----------------------------------------------
219: module petscdmstag
220: use petscdmdef
221: #include <petsc/finclude/petscdmstag.h>
222: #include <../ftn/dm/petscdmstag.h>
224: #include <../ftn/dm/petscdmstag.h90>
226: contains
228: #include <../ftn/dm/petscdmstag.hf90>
229: end module petscdmstag
231: ! ----------------------------------------------
233: module petscdmswarm
234: use petscdm
235: use petscdmdef
236: #include <petsc/finclude/petscdmswarm.h>
237: #include <../ftn/dm/petscdmswarm.h>
239: #include <../src/dm/ftn-mod/petscdmswarm.h90>
240: #include <../ftn/dm/petscdmswarm.h90>
242: contains
244: #include <../ftn/dm/petscdmswarm.hf90>
245: end module petscdmswarm
247: ! ----------------------------------------------
249: module petscdmcomposite
250: use petscdm
251: #include <petsc/finclude/petscdmcomposite.h>
253: #include <../src/dm/ftn-mod/petscdmcomposite.h90>
254: #include <../ftn/dm/petscdmcomposite.h90>
255: end module petscdmcomposite
257: ! ----------------------------------------------
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
266: ! ----------------------------------------------
268: module petscdmnetwork
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: ! ----------------------------------------------
282: module petscdmadaptor
283: use petscdm
284: use petscdmdef
285: ! use petscsnes
286: #include <petsc/finclude/petscdmadaptor.h>
287: #include <../ftn/dm/petscdmadaptor.h>
289: !#include <../ftn/dm/petscdmadaptor.h90>
291: contains
293: !#include <../ftn/dm/petscdmadaptor.hf90>
294: end module petscdmadaptor