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_OPTIONS,"-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_OPTIONS,"-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(VecSetValuesSectionF90(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(VecGetValuesSectionF90(v,section,p,x,ierr))
 59:         Write(IOBuffer,*) "Point ",p," dof ",dof,"\n"
 60:         PetscCallA(PetscPrintf(PETSC_COMM_SELF,IOBuffer,ierr))
 61:         PetscCallA(VecRestoreValuesSectionF90(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

 72:   test:
 73:     suffix: 0
 74:     args: -dm_plex_filename ${wPETSC_DIR}/share/petsc/datafiles/meshes/quads-q2.msh

 76: TEST*/