1 ! This file created from test/mpi/f77/datatype/packef.f with f77tof90
2 ! -*- Mode: Fortran; -*-
4 ! (C) 2003 by Argonne National Laboratory.
5 ! See COPYRIGHT in top-level directory.
10 integer inbuf(10), ioutbuf(10), inbuf2(10), ioutbuf2(10)
11 integer i, insize, rsize, csize, insize2
12 character*(16) cbuf, coutbuf
13 double precision rbuf(10), routbuf(10)
14 integer packbuf(1000), pbufsize, intsize
16 parameter (max_asizev = 3)
17 integer (kind=MPI_ADDRESS_KIND) aint, aintv(max_asizev)
21 call mtest_init( ierr )
23 call mpi_type_size( MPI_INTEGER, intsize, ierr )
24 pbufsize = 1000 * intsize
26 call mpi_pack_external_size( 'external32', 10, MPI_INTEGER, &
28 if (aint .ne. 10 * 4) then
30 print *, 'Expected 40 for size of 10 external32 integers', &
33 call mpi_pack_external_size( 'external32', 10, MPI_LOGICAL, &
35 if (aint .ne. 10 * 4) then
37 print *, 'Expected 40 for size of 10 external32 logicals', &
40 call mpi_pack_external_size( 'external32', 10, MPI_CHARACTER, &
42 if (aint .ne. 10 * 1) then
44 print *, 'Expected 10 for size of 10 external32 characters', &
48 call mpi_pack_external_size( 'external32', 3, MPI_INTEGER2, &
50 if (aint .ne. 3 * 2) then
52 print *, 'Expected 6 for size of 3 external32 INTEGER*2', &
55 call mpi_pack_external_size( 'external32', 3, MPI_INTEGER4, &
57 if (aint .ne. 3 * 4) then
59 print *, 'Expected 12 for size of 3 external32 INTEGER*4', &
62 call mpi_pack_external_size( 'external32', 3, MPI_REAL4, &
64 if (aint .ne. 3 * 4) then
66 print *, 'Expected 12 for size of 3 external32 REAL*4', &
69 call mpi_pack_external_size( 'external32', 3, MPI_REAL8, &
71 if (aint .ne. 3 * 8) then
73 print *, 'Expected 24 for size of 3 external32 REAL*8', &
76 if (MPI_INTEGER1 .ne. MPI_DATATYPE_NULL) then
77 call mpi_pack_external_size( 'external32', 3, MPI_INTEGER1, &
79 if (aint .ne. 3 * 1) then
81 print *, 'Expected 3 for size of 3 external32 INTEGER*1', &
85 if (MPI_INTEGER8 .ne. MPI_DATATYPE_NULL) then
86 call mpi_pack_external_size( 'external32', 3, MPI_INTEGER8, &
88 if (aint .ne. 3 * 8) then
90 print *, 'Expected 24 for size of 3 external32 INTEGER*8', &
106 cbuf = 'This is a string'
116 ! One MPI implementation failed to increment the position; instead,
117 ! it set the value with the amount of data packed in this call
118 ! We use aintv(3) to detect and report this specific error
119 call mpi_pack_external( 'external32', inbuf, insize, MPI_INTEGER, &
120 & packbuf, aintv(1), aintv(2), ierr )
121 if (aintv(2) .le. aintv(3)) then
122 print *, ' Position decreased after pack of integer!'
125 call mpi_pack_external( 'external32', rbuf, rsize, &
126 & MPI_DOUBLE_PRECISION, packbuf, aintv(1), &
128 if (aintv(2) .le. aintv(3)) then
129 print *, ' Position decreased after pack of real!'
132 call mpi_pack_external( 'external32', cbuf, csize, &
133 & MPI_CHARACTER, packbuf, aintv(1), &
135 if (aintv(2) .le. aintv(3)) then
136 print *, ' Position decreased after pack of character!'
139 call mpi_pack_external( 'external32', inbuf2, insize2, &
141 & packbuf, aintv(1), aintv(2), ierr )
142 if (aintv(2) .le. aintv(3)) then
143 print *, ' Position decreased after pack of integer (2nd)!'
147 ! We could try sending this with MPI_BYTE...
149 call mpi_unpack_external( 'external32', packbuf, aintv(1), &
150 & aintv(2), ioutbuf, insize, MPI_INTEGER, ierr )
151 call mpi_unpack_external( 'external32', packbuf, aintv(1), &
152 & aintv(2), routbuf, rsize, MPI_DOUBLE_PRECISION, ierr )
153 call mpi_unpack_external( 'external32', packbuf, aintv(1), &
154 & aintv(2), coutbuf, csize, MPI_CHARACTER, ierr )
155 call mpi_unpack_external( 'external32', packbuf, aintv(1), &
156 & aintv(2), ioutbuf2, insize2, MPI_INTEGER, ierr )
158 ! Now, test the values
161 if (ioutbuf(i) .ne. i) then
163 print *, 'ioutbuf(',i,') = ', ioutbuf(i), ' expected ', i
167 if (routbuf(i) .ne. 1000.0 * i) then
169 print *, 'routbuf(',i,') = ', routbuf(i), ' expected ', &
173 if (coutbuf(1:csize) .ne. 'This is a string') then
175 print *, 'coutbuf = ', coutbuf(1:csize), ' expected ', &
179 if (ioutbuf2(i) .ne. 5000-i) then
181 print *, 'ioutbuf2(',i,') = ', ioutbuf2(i), ' expected ', &
186 call mtest_finalize( errs )
187 call mpi_finalize( ierr )