Actual source code: ex48f90.F90

  1: program ex47f90
  2: #include "petsc/finclude/petsc.h"
  3: #include "petsc/finclude/petscvec.h"
  4:   use petsc
  5:   use petscvec
  6:   implicit none

  8:   Type(tDM)                         :: dm
  9:   Type(tPetscSection)               :: section
 10:   Character(len=PETSC_MAX_PATH_LEN) :: IOBuffer
 11:   PetscInt                          :: dof, p, pStart, pEnd, d
 12:   Type(tVec)                        :: v
 13:   PetscInt                          :: zero = 0
 14:   PetscInt                          :: one = 1
 15:   PetscInt                          :: two = 2
 16:   PetscScalar, Dimension(:), Pointer  :: val
 17:   PetscScalar, pointer              :: x(:)
 18:   PetscErrorCode                    :: ierr

 20:   PetscCallA(PetscInitialize(ierr))

 22:   PetscCallA(DMCreate(PETSC_COMM_WORLD, dm, ierr))
 23:   PetscCallA(DMSetType(dm, DMPLEX, ierr))
 24:   PetscCallA(DMSetFromOptions(dm, ierr))
 25:   PetscCallA(DMViewFromOptions(dm, PETSC_NULL_OBJECT, '-d_view', ierr))

 27:   PetscCallA(PetscSectionCreate(PETSC_COMM_WORLD, section, ierr))
 28:   PetscCallA(DMPlexGetChart(dm, pStart, pEnd, ierr))
 29:   PetscCallA(PetscSectionSetChart(section, pStart, pEnd, ierr))
 30:   PetscCallA(DMPlexGetHeightStratum(dm, zero, pStart, pEnd, ierr))
 31:   Do p = pStart, pEnd - 1
 32:     PetscCallA(PetscSectionSetDof(section, p, one, ierr))
 33:   End Do
 34:   PetscCallA(DMPlexGetDepthStratum(dm, zero, pStart, pEnd, ierr))
 35:   Do p = pStart, pEnd - 1
 36:     PetscCallA(PetscSectionSetDof(section, p, two, ierr))
 37:   End Do
 38:   PetscCallA(PetscSectionSetUp(section, ierr))
 39:   PetscCallA(DMSetLocalSection(dm, section, ierr))
 40:   PetscCallA(PetscSectionViewFromOptions(section, PETSC_NULL_OBJECT, '-s_view', ierr))

 42:   PetscCallA(DMCreateGlobalVector(dm, v, ierr))

 44:   PetscCallA(DMPlexGetChart(dm, pStart, pEnd, ierr))
 45:   Do p = pStart, pEnd - 1
 46:     PetscCallA(PetscSectionGetDof(section, p, dof, ierr))
 47:     Allocate (val(dof))
 48:     Do d = 1, dof
 49:       val(d) = 100*p + d - 1
 50:     End Do
 51:     PetscCallA(VecSetValuesSection(v, section, p, val, INSERT_VALUES, ierr))
 52:     DeAllocate (val)
 53:   End Do
 54:   PetscCallA(VecView(v, PETSC_VIEWER_STDOUT_WORLD, ierr))

 56:   Do p = pStart, pEnd - 1
 57:     PetscCallA(PetscSectionGetDof(section, p, dof, ierr))
 58:     PetscCallA(VecGetValuesSection(v, section, p, x, ierr))
 59:     write (IOBuffer, *) 'Point ', p, ' dof ', dof, '\n'
 60:     PetscCallA(PetscPrintf(PETSC_COMM_SELF, IOBuffer, ierr))
 61:     PetscCallA(VecRestoreValuesSection(v, section, p, x, ierr))
 62:   End Do

 64:   PetscCallA(PetscSectionDestroy(section, ierr))
 65:   PetscCallA(VecDestroy(v, ierr))
 66:   PetscCallA(DMDestroy(dm, ierr))
 67:   PetscCallA(PetscFinalize(ierr))
 68: end program ex47f90

 70: !/*TEST
 71: !
 72: !  test:
 73: !    suffix: 0
 74: !    args: -dm_plex_filename ${wPETSC_DIR}/share/petsc/datafiles/meshes/quads-q2.msh
 75: !
 76: !TEST*/