1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
! This file created from f77/datatype/hindex1f.f with f77tof90
!
! Copyright (C) by Argonne National Laboratory
! See COPYRIGHT in top-level directory
!
program main
use mpi
integer errs, ierr, intsize
integer i, displs(10), counts(10), dtype
integer bufsize
parameter (bufsize=100)
integer inbuf(bufsize), outbuf(bufsize), packbuf(bufsize)
integer position, len, psize
!
! Test for hindexed;
!
errs = 0
call mtest_init( ierr )
call mpi_type_size( MPI_INTEGER, intsize, ierr )
do i=1, 10
displs(i) = (10-i)*intsize
counts(i) = 1
enddo
call mpi_type_hindexed( 10, counts, displs, MPI_INTEGER, dtype, &
& ierr )
call mpi_type_commit( dtype, ierr )
!
call mpi_pack_size( 1, dtype, MPI_COMM_WORLD, psize, ierr )
if (psize .gt. bufsize*intsize) then
errs = errs + 1
else
do i=1,10
inbuf(i) = i
outbuf(i) = -i
enddo
position = 0
call mpi_pack( inbuf, 1, dtype, packbuf, psize, position, &
& MPI_COMM_WORLD, ierr )
!
len = position
position = 0
call mpi_unpack( packbuf, len, position, outbuf, 10, &
& MPI_INTEGER, MPI_COMM_WORLD, ierr )
!
do i=1, 10
if (outbuf(i) .ne. 11-i) then
errs = errs + 1
print *, 'outbuf(',i,')=',outbuf(i),', expected ', 10-i
endif
enddo
endif
!
call mpi_type_free( dtype, ierr )
!
call mtest_finalize( errs )
end
|
