1 C -*- Mode: Fortran; -*-
3 C (C) 2003 by Argonne National Laboratory.
4 C See COPYRIGHT in top-level directory.
9 integer errs, ierr, i, intsize
10 integer type1, type2, type3, type4, type5
12 parameter (max_asizev = 10)
14 integer blocklens(max_asizev), dtypes(max_asizev)
15 integer displs(max_asizev)
16 integer recvbuf(6*max_asizev)
17 integer sendbuf(max_asizev), status(MPI_STATUS_SIZE)
22 call mtest_init( ierr )
24 call mpi_comm_size( MPI_COMM_WORLD, size, ierr )
25 call mpi_comm_rank( MPI_COMM_WORLD, rank, ierr )
27 call mpi_type_size( MPI_INTEGER, intsize, ierr )
30 aintv(2) = 3 * intsize
31 call mpi_type_create_resized( MPI_INTEGER, aintv(1), aintv(2),
33 call mpi_type_commit( type1, ierr )
36 call mpi_type_get_extent( type1, aintv(1), aintv(2), ierr )
37 if (aintv(1) .ne. 0) then
39 print *, 'Did not get expected lb'
41 if (aintv(2) .ne. 3*intsize) then
43 print *, 'Did not get expected extent'
47 call mpi_type_get_true_extent( type1, aintv(1), aintv(2), ierr )
48 if (aintv(1) .ne. 0) then
50 print *, 'Did not get expected true lb'
52 if (aintv(2) .ne. intsize) then
54 print *, 'Did not get expected true extent (', aintv(2), ') ',
55 & ' expected ', intsize
60 aintv(i) = (i-1) * 3 * intsize
62 call mpi_type_create_hindexed( 10, blocklens, aintv,
63 & MPI_INTEGER, type2, ierr )
64 call mpi_type_commit( type2, ierr )
67 call mpi_type_create_hvector( 10, 1, aint, MPI_INTEGER, type3,
69 call mpi_type_commit( type3, ierr )
73 dtypes(i) = MPI_INTEGER
74 aintv(i) = (i-1) * 3 * intsize
76 call mpi_type_create_struct( 10, blocklens, aintv, dtypes,
78 call mpi_type_commit( type4, ierr )
83 call mpi_type_create_indexed_block( 10, 1, displs,
84 & MPI_INTEGER, type5, ierr )
85 call mpi_type_commit( type5, ierr )
87 C Using each time, send and receive using these types
94 call mpi_sendrecv( sendbuf, max_asizev, MPI_INTEGER, rank, 0,
95 & recvbuf, max_asizev, type1, rank, 0,
96 & MPI_COMM_WORLD, status, ierr )
98 if (recvbuf(1+(i-1)*3) .ne. i ) then
100 print *, 'type1:', i, 'th element = ', recvbuf(1+(i-1)*3)
110 call mpi_sendrecv( sendbuf, max_asizev, MPI_INTEGER, rank, 0,
111 & recvbuf, 1, type2, rank, 0,
112 & MPI_COMM_WORLD, status, ierr )
114 if (recvbuf(1+(i-1)*3) .ne. i ) then
116 print *, 'type2:', i, 'th element = ', recvbuf(1+(i-1)*3)
126 call mpi_sendrecv( sendbuf, max_asizev, MPI_INTEGER, rank, 0,
127 & recvbuf, 1, type3, rank, 0,
128 & MPI_COMM_WORLD, status, ierr )
130 if (recvbuf(1+(i-1)*3) .ne. i ) then
132 print *, 'type3:', i, 'th element = ', recvbuf(1+(i-1)*3)
142 call mpi_sendrecv( sendbuf, max_asizev, MPI_INTEGER, rank, 0,
143 & recvbuf, 1, type4, rank, 0,
144 & MPI_COMM_WORLD, status, ierr )
146 if (recvbuf(1+(i-1)*3) .ne. i ) then
148 print *, 'type4:', i, 'th element = ', recvbuf(1+(i-1)*3)
158 call mpi_sendrecv( sendbuf, max_asizev, MPI_INTEGER, rank, 0,
159 & recvbuf, 1, type5, rank, 0,
160 & MPI_COMM_WORLD, status, ierr )
162 if (recvbuf(1+(i-1)*3) .ne. i ) then
164 print *, 'type5:', i, 'th element = ', recvbuf(1+(i-1)*3)
168 call mpi_type_free( type1, ierr )
169 call mpi_type_free( type2, ierr )
170 call mpi_type_free( type3, ierr )
171 call mpi_type_free( type4, ierr )
172 call mpi_type_free( type5, ierr )
174 call mtest_finalize( errs )
175 call mpi_finalize( ierr )