Actual source code: ex1f.F90
1: !
2: ! Test the workaround for a bug in Open MPI 2.1.1 on Ubuntu 18.04.2
3: ! See https://lists.mcs.anl.gov/pipermail/petsc-dev/2019-July/024803.html
4: !
5: ! Contributed-by: Fabian Jakub <Fabian.Jakub@physik.uni-muenchen.de>
6: program main
7: #include "petsc/finclude/petscdmda.h"
8: use petscvec
9: use petscdm
10: use petscdmda
11: implicit none
13: PetscInt, parameter :: Ndof=1, stencil_size=1
14: PetscInt, parameter :: Nx=3, Ny=3
15: PetscErrorCode :: myid, commsize, ierr
16: PetscScalar, pointer :: xv1d(:)
17: PetscInt, pointer :: lx(:), ly(:)
18: PetscMPIInt, pointer :: nb(:)
20: type(tDM) :: da
21: type(tVec) :: gVec!, naturalVec
23: PetscCallA(PetscInitialize(PETSC_NULL_CHARACTER, ierr))
24: PetscCallA(mpi_comm_rank(PETSC_COMM_WORLD, myid, ierr))
25: PetscCallA(mpi_comm_size(PETSC_COMM_WORLD, commsize, ierr))
27: PetscCallA(DMDACreate2d(PETSC_COMM_WORLD,DM_BOUNDARY_PERIODIC, DM_BOUNDARY_PERIODIC,DMDA_STENCIL_STAR,Nx, Ny, PETSC_DECIDE, PETSC_DECIDE, Ndof, stencil_size,PETSC_NULL_INTEGER_ARRAY, PETSC_NULL_INTEGER_ARRAY, da, ierr))
28: PetscCallA(DMSetFromOptions(da, ierr))
29: PetscCallA(DMSetup(da, ierr))
31: PetscCallA(DMCreateGlobalVector(da, gVec, ierr))
32: PetscCallA(VecGetArray(gVec, xv1d, ierr))
33: xv1d(:) = real(myid, kind(xv1d))
34: !print *,myid, 'xv1d', xv1d, ':', xv1d
35: PetscCallA(VecRestoreArray(gVec, xv1d, ierr))
37: PetscCallA(PetscObjectViewFromOptions(PetscObjectCast(gVec), PETSC_NULL_OBJECT, '-show_gVec', ierr))
39: PetscCallA(DMDAGetOwnershipRanges(da, lx, ly, PETSC_NULL_INTEGER_POINTER, ierr))
40: PetscCallA(DMDARestoreOwnershipRanges(da, lx, ly, PETSC_NULL_INTEGER_POINTER, ierr))
41: PetscCallA(DMDAGetNeighbors(da, nb, ierr))
42: PetscCallA(DMDARestoreNeighbors(da, nb, ierr))
44: PetscCallA(VecDestroy(gVec, ierr))
45: PetscCallA(DMDestroy(da, ierr))
46: PetscCallA(PetscFinalize(ierr))
47: end program
49: !/*TEST
50: !
51: ! test:
52: ! nsize: 9
53: ! args: -show_gVec
54: !TEST*/