Actual source code: ex30f.F90

  1: !
  2: !
  3: !  Tests parallel to parallel scatter where a to from index are
  4: !  duplicated
  5: program main
  6: #include <petsc/finclude/petscvec.h>
  7:   use petscvec
  8:   implicit none

 10:   PetscErrorCode ierr
 11:   PetscInt nlocal, n, row, i1
 12:   PetscInt nlocal2, n2, eight
 13:   PetscMPIInt rank, size
 14:   PetscInt from(10), to(10)

 16:   PetscScalar num
 17:   Vec v1, v2, v3
 18:   VecScatter scat1, scat2
 19:   IS fromis, tois
 20:   n = 8
 21:   nlocal = 2
 22:   PetscCallA(PetscInitialize(ierr))
 23:   PetscCallMPIA(MPI_COMM_RANK(PETSC_COMM_WORLD, rank, ierr))
 24:   PetscCallMPIA(MPI_COMM_SIZE(PETSC_COMM_WORLD, size, ierr))
 25:   if (size /= 4) then
 26:     print *, 'Four processor test'
 27:     stop
 28:   end if

 30:   nlocal2 = 2*nlocal
 31:   n2 = 2*n
 32:   i1 = 1
 33:   PetscCallA(VecCreateFromOptions(PETSC_COMM_WORLD, PETSC_NULL_CHARACTER, i1, nlocal2, n2, v1, ierr))
 34:   PetscCallA(VecCreateFromOptions(PETSC_COMM_WORLD, PETSC_NULL_CHARACTER, i1, nlocal, n, v2, ierr))
 35:   PetscCallA(VecCreateSeq(PETSC_COMM_SELF, n, v3, ierr))

 37:   num = 2.0
 38:   row = 1
 39:   PetscCallA(VecSetValue(v1, row, num, INSERT_VALUES, ierr))
 40:   row = 5
 41:   PetscCallA(VecSetValue(v1, row, num, INSERT_VALUES, ierr))
 42:   row = 9
 43:   PetscCallA(VecSetValue(v1, row, num, INSERT_VALUES, ierr))
 44:   row = 13
 45:   PetscCallA(VecSetValue(v1, row, num, INSERT_VALUES, ierr))
 46:   num = 1.0
 47:   row = 15
 48:   PetscCallA(VecSetValue(v1, row, num, INSERT_VALUES, ierr))
 49:   row = 3
 50:   PetscCallA(VecSetValue(v1, row, num, INSERT_VALUES, ierr))
 51:   row = 7
 52:   PetscCallA(VecSetValue(v1, row, num, INSERT_VALUES, ierr))
 53:   row = 11
 54:   PetscCallA(VecSetValue(v1, row, num, INSERT_VALUES, ierr))

 56:   PetscCallA(VecAssemblyBegin(v1, ierr))
 57:   PetscCallA(VecAssemblyEnd(v1, ierr))

 59:   num = 0.0
 60:   PetscCallA(VecScale(v2, num, ierr))
 61:   PetscCallA(VecScale(v3, num, ierr))

 63:   from(1) = 1
 64:   from(2) = 5
 65:   from(3) = 9
 66:   from(4) = 13
 67:   from(5) = 3
 68:   from(6) = 7
 69:   from(7) = 11
 70:   from(8) = 15
 71:   to(1) = 0
 72:   to(2) = 0
 73:   to(3) = 0
 74:   to(4) = 0
 75:   to(5) = 7
 76:   to(6) = 7
 77:   to(7) = 7
 78:   to(8) = 7

 80:   eight = 8
 81:   PetscCallA(ISCreateGeneral(PETSC_COMM_SELF, eight, from, PETSC_COPY_VALUES, fromis, ierr))
 82:   PetscCallA(ISCreateGeneral(PETSC_COMM_SELF, eight, to, PETSC_COPY_VALUES, tois, ierr))
 83:   PetscCallA(VecScatterCreate(v1, fromis, v2, tois, scat1, ierr))
 84:   PetscCallA(VecScatterCreate(v1, fromis, v3, tois, scat2, ierr))
 85:   PetscCallA(ISDestroy(fromis, ierr))
 86:   PetscCallA(ISDestroy(tois, ierr))

 88:   PetscCallA(VecScatterBegin(scat1, v1, v2, ADD_VALUES, SCATTER_FORWARD, ierr))
 89:   PetscCallA(VecScatterEnd(scat1, v1, v2, ADD_VALUES, SCATTER_FORWARD, ierr))

 91:   PetscCallA(VecScatterBegin(scat2, v1, v3, ADD_VALUES, SCATTER_FORWARD, ierr))
 92:   PetscCallA(VecScatterEnd(scat2, v1, v3, ADD_VALUES, SCATTER_FORWARD, ierr))

 94:   PetscCallA(PetscObjectSetName(v1, 'V1', ierr))
 95:   PetscCallA(VecView(v1, PETSC_VIEWER_STDOUT_WORLD, ierr))

 97:   PetscCallA(PetscObjectSetName(v2, 'V2', ierr))
 98:   PetscCallA(VecView(v2, PETSC_VIEWER_STDOUT_WORLD, ierr))

100:   if (rank == 0) then
101:     PetscCallA(PetscObjectSetName(v3, 'V3', ierr))
102:     PetscCallA(VecView(v3, PETSC_VIEWER_STDOUT_SELF, ierr))
103:   end if

105:   PetscCallA(VecScatterDestroy(scat1, ierr))
106:   PetscCallA(VecScatterDestroy(scat2, ierr))
107:   PetscCallA(VecDestroy(v1, ierr))
108:   PetscCallA(VecDestroy(v2, ierr))
109:   PetscCallA(VecDestroy(v3, ierr))

111:   PetscCallA(PetscFinalize(ierr))

113: end

115: !/*TEST
116: !
117: !     test:
118: !       nsize: 4
119: !
120: !TEST*/