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