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:     end do
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:     end do
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:     end do
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