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