Actual source code: ex26f.F90

petsc-3.14.5 2021-03-03
Report Typos and Errors
  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*/