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