1! 2! Test the workaround for a bug in OpenMPI-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> 6program main 7#include "petsc/finclude/petsc.h" 8 9 use petsc 10 implicit none 11 12 PetscInt, parameter :: Ndof=1, stencil_size=1 13 PetscInt, parameter :: Nx=3, Ny=3 14 PetscErrorCode :: myid, commsize, ierr 15 PetscScalar, pointer :: xv1d(:) 16 17 type(tDM) :: da 18 type(tVec) :: gVec!, naturalVec 19 20 call PetscInitialize(PETSC_NULL_CHARACTER, ierr) 21 call mpi_comm_rank(PETSC_COMM_WORLD, myid, ierr) 22 call mpi_comm_size(PETSC_COMM_WORLD, commsize, ierr) 23 24 call DMDACreate2d(PETSC_COMM_WORLD, & 25 DM_BOUNDARY_PERIODIC, DM_BOUNDARY_PERIODIC, & 26 DMDA_STENCIL_STAR, & 27 Nx, Ny, PETSC_DECIDE, PETSC_DECIDE, Ndof, stencil_size, & 28 PETSC_NULL_INTEGER, PETSC_NULL_INTEGER, da, ierr) 29 call DMSetup(da, ierr) 30 call DMSetFromOptions(da, ierr) 31 32 call DMCreateGlobalVector(da, gVec, ierr) 33 call VecGetArrayF90(gVec, xv1d, ierr) 34 xv1d(:) = real(myid, kind(xv1d)) 35 !print *,myid, 'xv1d', xv1d, ':', xv1d 36 call VecRestoreArrayF90(gVec, xv1d, ierr) 37 38 call PetscObjectViewFromOptions(gVec, PETSC_NULL_VEC, "-show_gVec", ierr) 39 40 call VecDestroy(gVec, ierr) 41 call DMDestroy(da, ierr) 42 call PetscFinalize(ierr) 43end program 44 45!/*TEST 46! 47! test: 48! nsize: 9 49! args: -show_gVec 50!TEST*/ 51 52