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 == 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*/