Actual source code: ex17f.F90
1: !
2: !
3: ! "Scatters from a parallel vector to a sequential vector. In
4: ! this case each local vector is as long as the entire parallel vector.
5: !
6: #include <petsc/finclude/petscvec.h>
7: use petscvec
8: implicit none
10: PetscErrorCode ierr
11: PetscMPIInt size, rank
12: PetscInt n, NN, low, high
13: PetscInt iglobal, i, ione
14: PetscInt first, stride
15: PetscScalar value, zero
16: Vec x, y
17: IS is1, is2
18: VecScatter ctx
20: n = 5
21: zero = 0.0
22: PetscCallA(PetscInitialize(ierr))
24: PetscCallMPIA(MPI_Comm_size(PETSC_COMM_WORLD, size, ierr))
25: PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD, rank, ierr))
27: ! create two vectors
28: ! one parallel and one sequential. The sequential one on each processor
29: ! is as long as the entire parallel one.
31: NN = size*n
32: ione = 1
33: PetscCallA(VecCreateFromOptions(PETSC_COMM_WORLD, PETSC_NULL_CHARACTER, ione, PETSC_DECIDE, NN, y, ierr))
34: PetscCallA(VecCreateFromOptions(PETSC_COMM_SELF, PETSC_NULL_CHARACTER, ione, NN, NN, x, ierr))
36: PetscCallA(VecSet(x, zero, ierr))
37: PetscCallA(VecGetOwnershipRange(y, low, high, ierr))
38: ione = 1
39: do 10, i = 0, n - 1
40: iglobal = i + low
41: value = i + 10*rank
42: PetscCallA(VecSetValues(y, ione, [iglobal], [value], INSERT_VALUES, ierr))
43: 10 continue
45: PetscCallA(VecAssemblyBegin(y, ierr))
46: PetscCallA(VecAssemblyEnd(y, ierr))
47: !
48: ! View the parallel vector
49: !
50: PetscCallA(VecView(y, PETSC_VIEWER_STDOUT_WORLD, ierr))
52: ! create two index sets and the scatter context to move the contents of
53: ! of the parallel vector to each sequential vector. If you want the
54: ! parallel vector delivered to only one processor then create a is2
55: ! of length zero on all processors except the one to receive the parallel vector
57: first = 0
58: stride = 1
59: PetscCallA(ISCreateStride(PETSC_COMM_SELF, NN, first, stride, is1, ierr))
60: PetscCallA(ISCreateStride(PETSC_COMM_SELF, NN, first, stride, is2, ierr))
61: PetscCallA(VecScatterCreate(y, is2, x, is1, ctx, ierr))
62: PetscCallA(VecScatterBegin(ctx, y, x, ADD_VALUES, SCATTER_FORWARD, ierr))
63: PetscCallA(VecScatterEnd(ctx, y, x, ADD_VALUES, SCATTER_FORWARD, ierr))
64: PetscCallA(VecScatterDestroy(ctx, ierr))
65: !
66: ! View the sequential vector on the 0th processor
67: !
68: if (rank == 0) then
69: PetscCallA(VecView(x, PETSC_VIEWER_STDOUT_SELF, ierr))
70: end if
72: #if defined(PETSC_HAVE_FORTRAN_TYPE_STAR)
73: PetscCallA(PetscBarrier(y, ierr))
74: PetscCallA(PetscBarrier(is1, ierr))
75: #endif
76: PetscCallA(VecDestroy(x, ierr))
77: PetscCallA(VecDestroy(y, ierr))
78: PetscCallA(ISDestroy(is1, ierr))
79: PetscCallA(ISDestroy(is2, ierr))
81: PetscCallA(PetscFinalize(ierr))
82: end
84: !/*TEST
85: !
86: ! test:
87: ! nsize: 3
88: ! filter: grep -v " MPI process"
89: !
90: !TEST*/