xref: /petsc/src/dm/ftn-mod/petscdmmod.F90 (revision feaf08ea36ffe4fb16da05e2fed575fa424e5b40) 
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        interface PetscDSGetTabulationSetSizes
61        subroutine PetscDSGetTabulationSetSizes(ds,i, tab,ierr)
62          import tPetscDS, ttPetscTabulation
63          PetscErrorCode              ierr
64          type(ttPetscTabulation)     tab
65          PetscDS                     ds
66          PetscInt                    i
67        end subroutine
68        end interface
69
70        interface PetscDSGetTabulationSetPointers
71        subroutine PetscDSGetTabulationSetPointers(ds,i, T,ierr)
72          import tPetscDS, ttPetscTabulation,tPetscReal2d
73          PetscErrorCode              ierr
74          type(tPetscReal2d), pointer :: T(:)
75          PetscDS                     ds
76          PetscInt                    i
77        end subroutine
78        end interface
79
80        interface PetscDSGetTabulation
81          module procedure PetscDSGetTabulation
82       end interface
83
84        interface PetscDSRestoreTabulation
85          module procedure PetscDSRestoreTabulation
86       end interface
87
88       contains
89
90#include <../ftn/dm/petscall.hf90>
91#include <../ftn/dm/petscspace.hf90>
92#include <../ftn/dm/petscdualspace.hf90>
93
94        Subroutine PetscDSGetTabulation(ds,tab,ierr)
95          PetscErrorCode              ierr
96          PetscTabulation, pointer :: tab(:)
97          PetscDS                     ds
98
99          PetscInt  Nf, i
100          call PetscDSGetNumFields(ds, Nf, ierr)
101          allocate(tab(Nf))
102          do i=1,Nf
103             allocate(tab(i)%ptr)
104             CHKMEMQ
105             call PetscDSGetTabulationSetSizes(ds, i, tab(i)%ptr, ierr)
106             CHKMEMQ
107             allocate(tab(i)%ptr%T(tab(i)%ptr%K+1))
108             call PetscDSGetTabulationSetPointers(ds, i, tab(i)%ptr%T, ierr)
109             CHKMEMQ
110          enddo
111        End Subroutine PetscDSGetTabulation
112
113        Subroutine PetscDSRestoreTabulation(ds,tab,ierr)
114          PetscErrorCode              ierr
115          PetscTabulation, pointer :: tab(:)
116          PetscDS                     ds
117
118          PetscInt  Nf, i
119          call PetscDSGetNumFields(ds, Nf, ierr)
120          do i=1,Nf
121             deallocate(tab(i)%ptr%T)
122             deallocate(tab(i)%ptr)
123          enddo
124          deallocate(tab)
125        End Subroutine PetscDSRestoreTabulation
126
127        end module petscdm
128
129!     ----------------------------------------------
130
131        module petscdmdadef
132        use petscdmdef
133        use petscaodef
134        use petscpfdef
135#include <petsc/finclude/petscao.h>
136#include <petsc/finclude/petscdmda.h>
137#include <../ftn/dm/petscdmda.h>
138        end module petscdmdadef
139
140        module petscdmda
141        use petscdm
142        use petscdmdadef
143
144#include <../src/dm/ftn-mod/petscdmda.h90>
145#include <../ftn/dm/petscdmda.h90>
146
147        contains
148
149#include <../ftn/dm/petscdmda.hf90>
150        end module petscdmda
151
152!     ----------------------------------------------
153
154        module petscdmplex
155        use petscdm
156        use petscdmdef
157#include <petsc/finclude/petscfv.h>
158#include <petsc/finclude/petscdmplex.h>
159#include <petsc/finclude/petscdmplextransform.h>
160#include <../src/dm/ftn-mod/petscdmplex.h90>
161#include <../ftn/dm/petscfv.h>
162#include <../ftn/dm/petscdmplex.h>
163#include <../ftn/dm/petscdmplextransform.h>
164
165#include <../ftn/dm/petscfv.h90>
166#include <../ftn/dm/petscdmplex.h90>
167#include <../ftn/dm/petscdmplextransform.h90>
168
169        contains
170
171#include <../ftn/dm/petscfv.hf90>
172#include <../ftn/dm/petscdmplex.hf90>
173#include <../ftn/dm/petscdmplextransform.hf90>
174        end module petscdmplex
175
176!     ----------------------------------------------
177
178        module petscdmstag
179        use petscdmdef
180#include <petsc/finclude/petscdmstag.h>
181#include <../ftn/dm/petscdmstag.h>
182
183#include <../ftn/dm/petscdmstag.h90>
184
185        contains
186
187#include <../ftn/dm/petscdmstag.hf90>
188        end module petscdmstag
189
190!     ----------------------------------------------
191
192        module petscdmswarm
193        use petscdm
194        use petscdmdef
195#include <petsc/finclude/petscdmswarm.h>
196#include <../ftn/dm/petscdmswarm.h>
197
198#include <../src/dm/ftn-mod/petscdmswarm.h90>
199#include <../ftn/dm/petscdmswarm.h90>
200
201        contains
202
203#include <../ftn/dm/petscdmswarm.hf90>
204        end module petscdmswarm
205
206!     ----------------------------------------------
207
208        module petscdmcomposite
209        use petscdm
210#include <petsc/finclude/petscdmcomposite.h>
211
212#include <../src/dm/ftn-mod/petscdmcomposite.h90>
213#include <../ftn/dm/petscdmcomposite.h90>
214        end module petscdmcomposite
215
216!     ----------------------------------------------
217
218        module petscdmforest
219        use petscdm
220#include <petsc/finclude/petscdmforest.h>
221#include <../ftn/dm/petscdmforest.h>
222#include <../ftn/dm/petscdmforest.h90>
223        end module petscdmforest
224
225!     ----------------------------------------------
226
227        module petscdmnetwork
228        use petscdm
229#include <petsc/finclude/petscdmnetwork.h>
230#include <../ftn/dm/petscdmnetwork.h>
231
232#include <../ftn/dm/petscdmnetwork.h90>
233
234        contains
235
236#include <../ftn/dm/petscdmnetwork.hf90>
237        end module petscdmnetwork
238
239!     ----------------------------------------------
240
241        module petscdmadaptor
242        use petscdm
243        use petscdmdef
244!        use petscsnes
245#include <petsc/finclude/petscdmadaptor.h>
246#include <../ftn/dm/petscdmadaptor.h>
247
248!#include <../ftn/dm/petscdmadaptor.h90>
249
250        contains
251
252!#include <../ftn/dm/petscdmadaptor.hf90>
253        end module petscdmadaptor
254