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: !     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

 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

 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>

 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

 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

 80:         interface PetscDSGetTabulation
 81:           module procedure PetscDSGetTabulation
 82:        end interface

 84:         interface PetscDSRestoreTabulation
 85:           module procedure PetscDSRestoreTabulation
 86:        end interface

 88:        contains

 90: #include <../ftn/dm/petscall.hf90>
 91: #include <../ftn/dm/petscspace.hf90>
 92: #include <../ftn/dm/petscdualspace.hf90>

 94:         Subroutine PetscDSGetTabulation(ds,tab,ierr)
 95:           PetscErrorCode              ierr
 96:           PetscTabulation, pointer :: tab(:)
 97:           PetscDS                     ds

 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

113:         Subroutine PetscDSRestoreTabulation(ds,tab,ierr)
114:           PetscErrorCode              ierr
115:           PetscTabulation, pointer :: tab(:)
116:           PetscDS                     ds

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

127:         end module petscdm

129: !     ----------------------------------------------

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

140:         module petscdmda
141:         use petscdm
142:         use petscdmdadef

144: #include <../src/dm/ftn-mod/petscdmda.h90>
145: #include <../ftn/dm/petscdmda.h90>

147:         contains

149: #include <../ftn/dm/petscdmda.hf90>
150:         end module petscdmda

152: !     ----------------------------------------------

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>

165: #include <../ftn/dm/petscfv.h90>
166: #include <../ftn/dm/petscdmplex.h90>
167: #include <../ftn/dm/petscdmplextransform.h90>

169:         contains

171: #include <../ftn/dm/petscfv.hf90>
172: #include <../ftn/dm/petscdmplex.hf90>
173: #include <../ftn/dm/petscdmplextransform.hf90>
174:         end module petscdmplex

176: !     ----------------------------------------------

178:         module petscdmstag
179:         use petscdmdef
180: #include <petsc/finclude/petscdmstag.h>
181: #include <../ftn/dm/petscdmstag.h>

183: #include <../ftn/dm/petscdmstag.h90>

185:         contains

187: #include <../ftn/dm/petscdmstag.hf90>
188:         end module petscdmstag

190: !     ----------------------------------------------

192:         module petscdmswarm
193:         use petscdm
194:         use petscdmdef
195: #include <petsc/finclude/petscdmswarm.h>
196: #include <../ftn/dm/petscdmswarm.h>

198: #include <../src/dm/ftn-mod/petscdmswarm.h90>
199: #include <../ftn/dm/petscdmswarm.h90>

201:         contains

203: #include <../ftn/dm/petscdmswarm.hf90>
204:         end module petscdmswarm

206: !     ----------------------------------------------

208:         module petscdmcomposite
209:         use petscdm
210: #include <petsc/finclude/petscdmcomposite.h>

212: #include <../src/dm/ftn-mod/petscdmcomposite.h90>
213: #include <../ftn/dm/petscdmcomposite.h90>
214:         end module petscdmcomposite

216: !     ----------------------------------------------

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

225: !     ----------------------------------------------

227:         module petscdmnetwork
228:         use petscdm
229: #include <petsc/finclude/petscdmnetwork.h>
230: #include <../ftn/dm/petscdmnetwork.h>

232: #include <../ftn/dm/petscdmnetwork.h90>

234:         contains

236: #include <../ftn/dm/petscdmnetwork.hf90>
237:         end module petscdmnetwork

239: !     ----------------------------------------------

241:         module petscdmadaptor
242:         use petscdm
243:         use petscdmdef
244: !        use petscsnes
245: #include <petsc/finclude/petscdmadaptor.h>
246: #include <../ftn/dm/petscdmadaptor.h>

248: !#include <../ftn/dm/petscdmadaptor.h90>

250:         contains

252: !#include <../ftn/dm/petscdmadaptor.hf90>
253:         end module petscdmadaptor