Actual source code: ex30f.F

petsc-3.12.2 2019-11-22
Report Typos and Errors
  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
 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:       call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
 23:       if (ierr .ne. 0) then
 24:         print*,'Unable to initialize PETSc'
 25:         stop
 26:       endif
 27:       call MPI_COMM_RANK(PETSC_COMM_WORLD,rank,ierr)
 28:       call MPI_COMM_SIZE(PETSC_COMM_WORLD,size,ierr)
 29:       if (size.ne.4) then
 30:          print *, 'Four processor test'
 31:          stop
 32:       end if

 34:       nlocal2 = 2*nlocal
 35:       n2      = 2*n
 36:       call VecCreateMPI(PETSC_COMM_WORLD,nlocal2,n2,v1,ierr)
 37:       call VecCreateMPI(PETSC_COMM_WORLD,nlocal,n,v2,ierr)
 38:       call VecCreateSeq(PETSC_COMM_SELF,n,v3,ierr)

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

 59:       call VecAssemblyBegin(v1,ierr)
 60:       call VecAssemblyEnd(v1,ierr)

 62:       num=0.0
 63:       call VecScale(v2,num,ierr)
 64:       call VecScale(v3,num,ierr)

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

 83:       eight = 8
 84:       call ISCreateGeneral(PETSC_COMM_SELF,eight,from,PETSC_COPY_VALUES,      &
 85:      &                     fromis,ierr)
 86:       call ISCreateGeneral(PETSC_COMM_SELF,eight,to,PETSC_COPY_VALUES,        &
 87:      &                     tois,ierr)
 88:       call VecScatterCreate(v1,fromis,v2,tois,scat1,ierr)
 89:       call VecScatterCreate(v1,fromis,v3,tois,scat2,ierr)
 90:       call ISDestroy(fromis,ierr)
 91:       call ISDestroy(tois,ierr)

 93:       call VecScatterBegin(scat1,v1,v2,ADD_VALUES,SCATTER_FORWARD,ierr)
 94:       call VecScatterEnd(scat1,v1,v2,ADD_VALUES,SCATTER_FORWARD,ierr)

 96:       call VecScatterBegin(scat2,v1,v3,ADD_VALUES,SCATTER_FORWARD,ierr)
 97:       call VecScatterEnd(scat2,v1,v3,ADD_VALUES,SCATTER_FORWARD,ierr)

 99:       call PetscObjectSetName(v1, 'V1',ierr)
100:       call VecView(v1,PETSC_VIEWER_STDOUT_WORLD,ierr)

102:       call PetscObjectSetName(v2, 'V2',ierr)
103:       call VecView(v2,PETSC_VIEWER_STDOUT_WORLD,ierr)

105:       if (rank.eq.0) then
106:          call PetscObjectSetName(v3, 'V3',ierr)
107:          call VecView(v3,PETSC_VIEWER_STDOUT_SELF,ierr)
108:       end if

110:       call VecScatterDestroy(scat1,ierr)
111:       call VecScatterDestroy(scat2,ierr)
112:       call VecDestroy(v1,ierr)
113:       call VecDestroy(v2,ierr)
114:       call VecDestroy(v3,ierr)

116:       call PetscFinalize(ierr)

118:       end

120: !/*TEST
121: !
122: !     test:
123: !       nsize: 4
124: !
125: !TEST*/