Actual source code: ex26f.F90
petsc-3.14.3 2021-01-09
1: !
2: ! Test VecGetSubVector()
3: ! Contributed-by: Adrian Croucher <gitlab@mg.gitlab.com>
5: program main
6: #include <petsc/finclude/petsc.h>
7: use petsc
8: implicit none
10: PetscMPIInt :: rank
11: PetscErrorCode :: ierr
12: PetscInt :: num_cells, subsize, i
13: PetscInt, parameter :: blocksize = 3, field = 0
14: Vec :: v, subv
15: IS :: index_set
16: PetscInt, allocatable :: subindices(:)
18: call PetscInitialize(PETSC_NULL_CHARACTER, ierr)
19: if (ierr .ne. 0) then
20: print*,'Unable to initialize PETSc'
21: stop
22: endif
23: call MPI_COMM_RANK(PETSC_COMM_WORLD, rank, ierr)
25: if (rank .eq. 0) then
26: num_cells = 1
27: else
28: num_cells = 0
29: end if
31: call VecCreate(PETSC_COMM_WORLD, v, ierr);CHKERRA(ierr)
32: call VecSetSizes(v, num_cells * blocksize, PETSC_DECIDE, ierr);CHKERRA(ierr)
33: call VecSetBlockSize(v, blocksize, ierr);CHKERRA(ierr)
34: call VecSetFromOptions(v, ierr);CHKERRA(ierr)
36: subsize = num_cells
37: allocate(subindices(0: subsize - 1))
38: subindices = [(i, i = 0, subsize - 1)] * blocksize + field
39: call ISCreateGeneral(PETSC_COMM_WORLD, subsize, subindices, &
40: PETSC_COPY_VALUES, index_set, ierr);CHKERRA(ierr)
41: deallocate(subindices)
43: call VecGetSubVector(v, index_set, subv, ierr);CHKERRA(ierr)
44: call VecRestoreSubVector(v, index_set, subv, ierr);CHKERRA(ierr)
45: call ISDestroy(index_set, ierr);CHKERRA(ierr);
47: call VecDestroy(v, ierr);CHKERRA(ierr)
48: call PetscFinalize(ierr);
49: end
51: !/*TEST
52: !
53: ! test:
54: ! nsize: 2
55: ! filter: sort -b
56: ! filter_output: sort -b
57: !
58: !TEST*/