Actual source code: ex1f90.F90
petsc-3.9.4 2018-09-11
1: program DMPlexTestField
2: #include "petsc/finclude/petscdmplex.h"
3: #include "petsc/finclude/petscdmlabel.h"
4: use petscdmplex
5: implicit none
7: DM :: dm
8: DMLabel :: label
9: Vec :: u
10: PetscViewer :: viewer
11: PetscSection :: section
12: PetscInt :: dim,numFields,numBC
13: PetscInt :: i,val
14: PetscInt, target, dimension(3) :: numComp
15: PetscInt, pointer :: pNumComp(:)
16: PetscInt, target, dimension(12) :: numDof
17: PetscInt, pointer :: pNumDof(:)
18: PetscInt, target, dimension(1) :: bcField
19: PetscInt, pointer :: pBcField(:)
20: PetscInt :: zero,eight
21: IS, target, dimension(1) :: bcCompIS
22: IS, target, dimension(1) :: bcPointIS
23: IS, pointer :: pBcCompIS(:)
24: IS, pointer :: pBcPointIS(:)
25: PetscBool :: interpolate
26: PetscErrorCode :: ierr
28: call PetscInitialize(PETSC_NULL_CHARACTER, ierr)
29: if (ierr .ne. 0) then
30: print*,'Unable to initialize PETSc'
31: stop
32: endif
33: dim = 2
34: call PetscOptionsGetInt(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-dim', dim,PETSC_NULL_BOOL, ierr);CHKERRA(ierr)
35: interpolate = PETSC_TRUE
36: ! Create a mesh
37: call DMPlexCreateBoxMesh(PETSC_COMM_WORLD, dim, PETSC_TRUE, PETSC_NULL_INTEGER, PETSC_NULL_REAL, PETSC_NULL_REAL, PETSC_NULL_INTEGER, interpolate, dm, ierr);CHKERRA(ierr)
38: ! Create a scalar field u, a vector field v, and a surface vector field w
39: numFields = 3
40: numComp(1) = 1
41: numComp(2) = dim
42: numComp(3) = dim-1
43: pNumComp => numComp
44: do i = 1, numFields*(dim+1)
45: numDof(i) = 0
46: end do
47: ! Let u be defined on vertices
48: numDof(0*(dim+1)+1) = 1
49: ! Let v be defined on cells
50: numDof(1*(dim+1)+dim+1) = dim
51: ! Let v be defined on faces
52: numDof(2*(dim+1)+dim) = dim-1
53: pNumDof => numDof
54: ! Setup boundary conditions
55: numBC = 1
56: ! Test label retrieval
57: call DMGetLabel(dm, 'marker', label, ierr);CHKERRA(ierr)
58: zero = 0
59: call DMLabelGetValue(label, zero, val, ierr);CHKERRA(ierr)
60: if (val .ne. -1) then
61: CHKERRA(1)
62: endif
63: eight = 8
64: call DMLabelGetValue(label, eight, val, ierr);CHKERRA(ierr)
65: if (val .ne. 1) then
66: CHKERRA(1)
67: endif
68: ! Prescribe a Dirichlet condition on u on the boundary
69: ! Label "marker" is made by the mesh creation routine
70: bcField(1) = 0
71: pBcField => bcField
72: call ISCreateStride(PETSC_COMM_WORLD, 1, 0, 1, bcCompIS(1), ierr);CHKERRA(ierr)
73: pBcCompIS => bcCompIS
74: call DMGetStratumIS(dm, 'marker', 1, bcPointIS(1),ierr);CHKERRA(ierr)
75: pBcPointIS => bcPointIS
76: ! Create a PetscSection with this data layout
77: call DMPlexCreateSection(dm,dim,numFields,pNumComp,pNumDof,numBC,pBcField,pBcCompIS,pBcPointIS,PETSC_NULL_IS,section,ierr)
78: CHKERRA(ierr)
79: call ISDestroy(bcCompIS(1), ierr);CHKERRA(ierr)
80: call ISDestroy(bcPointIS(1), ierr);CHKERRA(ierr)
81: ! Name the Field variables
82: call PetscSectionSetFieldName(section, 0, 'u', ierr);CHKERRA(ierr)
83: call PetscSectionSetFieldName(section, 1, 'v', ierr);CHKERRA(ierr)
84: call PetscSectionSetFieldName(section, 2, 'w', ierr);CHKERRA(ierr)
85: call PetscSectionView(section, PETSC_VIEWER_STDOUT_WORLD, ierr);CHKERRA(ierr)
86: ! Tell the DM to use this data layout
87: call DMSetDefaultSection(dm, section, ierr);CHKERRA(ierr)
88: ! Create a Vec with this layout and view it
89: call DMGetGlobalVector(dm, u, ierr);CHKERRA(ierr)
90: call PetscViewerCreate(PETSC_COMM_WORLD, viewer, ierr);CHKERRA(ierr)
91: call PetscViewerSetType(viewer, PETSCVIEWERVTK, ierr);CHKERRA(ierr)
92: call PetscViewerPushFormat(viewer, PETSC_VIEWER_ASCII_VTK, ierr);CHKERRA(ierr)
93: call PetscViewerFileSetName(viewer, 'sol.vtk', ierr);CHKERRA(ierr)
94: call VecView(u, viewer, ierr);CHKERRA(ierr)
95: call PetscViewerDestroy(viewer, ierr);CHKERRA(ierr)
96: call DMRestoreGlobalVector(dm, u, ierr);CHKERRA(ierr)
97: ! Cleanup
98: call PetscSectionDestroy(section, ierr);CHKERRA(ierr)
99: call DMDestroy(dm, ierr);CHKERRA(ierr)
101: call PetscFinalize(ierr)
102: end program DMPlexTestField
104: !/*TEST
105: ! build:
106: ! requires: define(PETSC_USING_F90FREEFORM)
107: !
108: ! test:
109: ! suffix: 0
110: ! requires: triangle
111: !
112: ! test:
113: ! suffix: 1
114: ! requires: ctetgen
115: ! args: -dim 3
116: !
117: !TEST*/