xref: /petsc/src/vec/is/sf/tests/ex1f.F90 (revision d5b43468fb8780a8feea140ccd6fa3e6a50411cc)
1!
2!  Tests VecScatterCreateToAll Fortran stub
3      program main
4#include <petsc/finclude/petscvec.h>
5      use petscvec
6      implicit none
7
8      PetscErrorCode ierr
9      PetscInt  nlocal, row
10      PetscScalar num
11      PetscMPIInt rank
12      Vec v1, v2
13      VecScatter toall
14
15      PetscCallA(PetscInitialize(ierr))
16      PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr))
17
18      nlocal = 1
19      PetscCallA(VecCreateMPI(PETSC_COMM_WORLD,nlocal,PETSC_DECIDE,v1,ierr))
20
21      row = rank
22      num = rank
23      PetscCallA(VecSetValue(v1,row,num,INSERT_VALUES,ierr))
24      PetscCallA(VecAssemblyBegin(v1,ierr))
25      PetscCallA(VecAssemblyEnd(v1,ierr))
26
27      PetscCallA(VecScatterCreateToAll(v1,toall,v2,ierr))
28
29      PetscCallA(VecScatterBegin(toall,v1,v2,INSERT_VALUES,SCATTER_FORWARD,ierr))
30      PetscCallA(VecScatterEnd(toall,v1,v2,INSERT_VALUES,SCATTER_FORWARD,ierr))
31
32      PetscCallA(VecScatterDestroy(toall,ierr))
33! Destroy v2 and then re-create it in VecScatterCreateToAll() to test if petsc can differentiate NULL projects with destroyed objects
34      PetscCallA(VecDestroy(v2,ierr))
35
36      PetscCallA(VecScatterCreateToAll(v1,toall,v2,ierr))
37      PetscCallA(VecScatterBegin(toall,v1,v2,INSERT_VALUES,SCATTER_FORWARD,ierr))
38      PetscCallA(VecScatterEnd(toall,v1,v2,INSERT_VALUES,SCATTER_FORWARD,ierr))
39
40      if (rank.eq.2) then
41         PetscCallA(PetscObjectSetName(v2, 'v2',ierr))
42         PetscCallA(VecView(v2,PETSC_VIEWER_STDOUT_SELF,ierr))
43      end if
44
45      PetscCallA(VecScatterDestroy(toall,ierr))
46      PetscCallA(VecDestroy(v1,ierr))
47      PetscCallA(VecDestroy(v2,ierr))
48! It is OK to destroy again
49      PetscCallA(VecDestroy(v2,ierr))
50
51      PetscCallA(PetscFinalize(ierr))
52      end
53
54!/*TEST
55!
56!     test:
57!       nsize: 4
58!
59!TEST*/
60