Actual source code: ex30f.F
petsc-3.12.1 2019-10-22
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*/