Actual source code: ex2f90.F90

petsc-3.9.2 2018-05-20
Report Typos and Errors
  1:       program main
  2:  #include <petsc/finclude/petscdmplex.h>
  3:       use petscdmplex
  4:       implicit none

  6:       DM dm
  7:       PetscInt, target, dimension(3) :: EC
  8:       PetscInt, target, dimension(2) :: VE
  9:       PetscInt, pointer :: pEC(:), pVE(:)
 10:       PetscInt, pointer :: nClosure(:)
 11:       PetscInt, pointer :: nJoin(:)
 12:       PetscInt, pointer :: nMeet(:)
 13:       PetscInt       dim, cell, size
 14:       PetscInt i0,i1,i2,i3,i4,i5,i6,i7
 15:       PetscInt i8,i9,i10,i11
 16:       PetscErrorCode ierr

 18:       i0 = 0
 19:       i1 = 1
 20:       i2 = 2
 21:       i3 = 3
 22:       i4 = 4
 23:       i5 = 5
 24:       i6 = 6
 25:       i7 = 7
 26:       i8 = 8
 27:       i9 = 9
 28:       i10 = 10
 29:       i11 = 11

 31:       call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
 32:       if (ierr .ne. 0) then
 33:         print*,'Unable to initialize PETSc'
 34:         stop
 35:       endif

 37:       call DMPlexCreate(PETSC_COMM_WORLD, dm, ierr);CHKERRA(ierr)
 38:       call PetscObjectSetName(dm, 'Mesh', ierr);CHKERRA(ierr)
 39:       dim = 2
 40:       call DMSetDimension(dm, dim, ierr);CHKERRA(ierr)

 42: ! Make Doublet Mesh from Fig 2 of Flexible Representation of Computational Meshes,
 43: ! except indexing is from 0 instead of 1 and we obey the new restrictions on
 44: ! numbering: cells, vertices, faces, edges
 45:       call DMPlexSetChart(dm, i0, i11, ierr);CHKERRA(ierr)
 46: !     cells
 47:       call DMPlexSetConeSize(dm, i0, i3, ierr);CHKERRA(ierr)
 48:       call DMPlexSetConeSize(dm, i1, i3, ierr);CHKERRA(ierr)
 49: !     edges
 50:       call DMPlexSetConeSize(dm,  i6, i2, ierr);CHKERRA(ierr)
 51:       call DMPlexSetConeSize(dm,  i7, i2, ierr);CHKERRA(ierr)
 52:       call DMPlexSetConeSize(dm,  i8, i2, ierr);CHKERRA(ierr)
 53:       call DMPlexSetConeSize(dm,  i9, i2, ierr);CHKERRA(ierr)
 54:       call DMPlexSetConeSize(dm, i10, i2, ierr);CHKERRA(ierr)

 56:       call DMSetUp(dm, ierr);CHKERRA(ierr)

 58:       EC(1) = 6
 59:       EC(2) = 7
 60:       EC(3) = 8
 61:       pEC => EC
 62:       call DMPlexSetCone(dm, i0, pEC, ierr);CHKERRA(ierr)
 63:       EC(1) = 7
 64:       EC(2) = 9
 65:       EC(3) = 10
 66:       pEC => EC
 67:       call DMPlexSetCone(dm, i1 , pEC, ierr);CHKERRA(ierr)

 69:       VE(1) = 2
 70:       VE(2) = 3
 71:       pVE => VE
 72:       call DMPlexSetCone(dm, i6 , pVE, ierr);CHKERRA(ierr)
 73:       VE(1) = 3
 74:       VE(2) = 4
 75:       pVE => VE
 76:       call DMPlexSetCone(dm, i7 , pVE, ierr);CHKERRA(ierr)
 77:       VE(1) = 4
 78:       VE(2) = 2
 79:       pVE => VE
 80:       call DMPlexSetCone(dm, i8 , pVE, ierr);CHKERRA(ierr)
 81:       VE(1) = 3
 82:       VE(2) = 5
 83:       pVE => VE
 84:       call DMPlexSetCone(dm, i9 , pVE, ierr);CHKERRA(ierr)
 85:       VE(1) = 5
 86:       VE(2) = 4
 87:       pVE => VE
 88:       call DMPlexSetCone(dm, i10 , pVE, ierr);CHKERRA(ierr)

 90:       call DMPlexSymmetrize(dm,ierr);CHKERRA(ierr)
 91:       call DMPlexStratify(dm,ierr);CHKERRA(ierr)
 92:       call DMView(dm, PETSC_VIEWER_STDOUT_WORLD, ierr);CHKERRA(ierr)

 94: !     Test Closure
 95:       do cell = 0,1
 96:          call DMPlexGetTransitiveClosure(dm,cell,PETSC_TRUE,nClosure,ierr);CHKERRA(ierr)
 97: !     Different Fortran compilers print a different number of columns
 98: !     per row producing different outputs in the test runs hence
 99: !     do not print the nClosure
100: !       write(*,*) nClosure
101:        call DMPlexRestoreTransitiveClosure(dm,cell,PETSC_TRUE,nClosure,ierr);CHKERRA(ierr)
102:       end do

104: !     Test Join
105:       size  = 2
106:       VE(1) = 6
107:       VE(2) = 7
108:       pVE => VE
109:       call DMPlexGetJoin(dm, size, pVE, nJoin, ierr);CHKERRA(ierr)
110:       write(*,*) 'Join of',pVE,'is',nJoin
111:       call DMPlexRestoreJoin(dm, size, pVE, nJoin, ierr);CHKERRA(ierr)
112:       size  = 2
113:       VE(1) = 9
114:       VE(2) = 7
115:       pVE => VE
116:       call DMPlexGetJoin(dm, size, pVE, nJoin, ierr);CHKERRA(ierr)
117:       write(*,*) 'Join of',pVE,'is',nJoin
118:       call DMPlexRestoreJoin(dm, size, pVE, nJoin, ierr);CHKERRA(ierr)
119: !     Test Full Join
120:       size  = 3
121:       EC(1) = 3
122:       EC(2) = 4
123:       EC(3) = 5
124:       pEC => EC
125:       call DMPlexGetFullJoin(dm, size, pEC, nJoin, ierr);CHKERRA(ierr)
126:       write(*,*) 'Full Join of',pEC,'is',nJoin
127:       call DMPlexRestoreJoin(dm, size, pEC, nJoin, ierr);CHKERRA(ierr)
128: !     Test Meet
129:       size  = 2
130:       VE(1) = 0
131:       VE(2) = 1
132:       pVE => VE
133:       call DMPlexGetMeet(dm, size, pVE, nMeet, ierr);CHKERRA(ierr)
134:       write(*,*) 'Meet of',pVE,'is',nMeet
135:       call DMPlexRestoreMeet(dm, size, pVE, nMeet, ierr);CHKERRA(ierr)
136:       size  = 2
137:       VE(1) = 6
138:       VE(2) = 7
139:       pVE => VE
140:       call DMPlexGetMeet(dm, size, pVE, nMeet, ierr);CHKERRA(ierr)
141:       write(*,*) 'Meet of',pVE,'is',nMeet
142:       call DMPlexRestoreMeet(dm, size, pVE, nMeet, ierr);CHKERRA(ierr)

144:       call DMDestroy(dm, ierr);CHKERRA(ierr)
145:       call PetscFinalize(ierr)
146:       end
147: !
148: !/*TEST
149: !
150: !   test:
151: !     suffix: 0
152: !
153: !TEST*/