1 C -*- Mode: Fortran; -*-
3 C (C) 2003 by Argonne National Laboratory.
4 C 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)
20 call mtest_init( ierr )
22 call mpi_type_size( MPI_INTEGER, intsize, ierr )
23 pbufsize = 1000 * intsize
25 call mpi_pack_external_size( 'external32', 10, MPI_INTEGER,
27 if (aint .ne. 10 * 4) then
29 print *, 'Expected 40 for size of 10 external32 integers',
32 call mpi_pack_external_size( 'external32', 10, MPI_LOGICAL,
34 if (aint .ne. 10 * 4) then
36 print *, 'Expected 40 for size of 10 external32 logicals',
39 call mpi_pack_external_size( 'external32', 10, MPI_CHARACTER,
41 if (aint .ne. 10 * 1) then
43 print *, 'Expected 10 for size of 10 external32 characters',
47 call mpi_pack_external_size( 'external32', 3, MPI_INTEGER2,
49 if (aint .ne. 3 * 2) then
51 print *, 'Expected 6 for size of 3 external32 INTEGER*2',
54 call mpi_pack_external_size( 'external32', 3, MPI_INTEGER4,
56 if (aint .ne. 3 * 4) then
58 print *, 'Expected 12 for size of 3 external32 INTEGER*4',
61 call mpi_pack_external_size( 'external32', 3, MPI_REAL4,
63 if (aint .ne. 3 * 4) then
65 print *, 'Expected 12 for size of 3 external32 REAL*4',
68 call mpi_pack_external_size( 'external32', 3, MPI_REAL8,
70 if (aint .ne. 3 * 8) then
72 print *, 'Expected 24 for size of 3 external32 REAL*8',
75 if (MPI_INTEGER1 .ne. MPI_DATATYPE_NULL) then
76 call mpi_pack_external_size( 'external32', 3, MPI_INTEGER1,
78 if (aint .ne. 3 * 1) then
80 print *, 'Expected 3 for size of 3 external32 INTEGER*1',
84 if (MPI_INTEGER8 .ne. MPI_DATATYPE_NULL) then
85 call mpi_pack_external_size( 'external32', 3, MPI_INTEGER8,
87 if (aint .ne. 3 * 8) then
89 print *, 'Expected 24 for size of 3 external32 INTEGER*8',
105 cbuf = 'This is a string'
115 C One MPI implementation failed to increment the position; instead,
116 C it set the value with the amount of data packed in this call
117 C We use aintv(3) to detect and report this specific error
118 call mpi_pack_external( 'external32', inbuf, insize, MPI_INTEGER,
119 & packbuf, aintv(1), aintv(2), ierr )
120 if (aintv(2) .le. aintv(3)) then
121 print *, ' Position decreased after pack of integer!'
124 call mpi_pack_external( 'external32', rbuf, rsize,
125 & MPI_DOUBLE_PRECISION, packbuf, aintv(1),
127 if (aintv(2) .le. aintv(3)) then
128 print *, ' Position decreased after pack of real!'
131 call mpi_pack_external( 'external32', cbuf, csize,
132 & MPI_CHARACTER, packbuf, aintv(1),
134 if (aintv(2) .le. aintv(3)) then
135 print *, ' Position decreased after pack of character!'
138 call mpi_pack_external( 'external32', inbuf2, insize2,
140 & packbuf, aintv(1), aintv(2), ierr )
141 if (aintv(2) .le. aintv(3)) then
142 print *, ' Position decreased after pack of integer (2nd)!'
146 C We could try sending this with MPI_BYTE...
148 call mpi_unpack_external( 'external32', packbuf, aintv(1),
149 & aintv(2), ioutbuf, insize, MPI_INTEGER, ierr )
150 call mpi_unpack_external( 'external32', packbuf, aintv(1),
151 & aintv(2), routbuf, rsize, MPI_DOUBLE_PRECISION, ierr )
152 call mpi_unpack_external( 'external32', packbuf, aintv(1),
153 & aintv(2), coutbuf, csize, MPI_CHARACTER, ierr )
154 call mpi_unpack_external( 'external32', packbuf, aintv(1),
155 & aintv(2), ioutbuf2, insize2, MPI_INTEGER, ierr )
157 C Now, test the values
160 if (ioutbuf(i) .ne. i) then
162 print *, 'ioutbuf(',i,') = ', ioutbuf(i), ' expected ', i
166 if (routbuf(i) .ne. 1000.0 * i) then
168 print *, 'routbuf(',i,') = ', routbuf(i), ' expected ', &
172 if (coutbuf(1:csize) .ne. 'This is a string') then
174 print *, 'coutbuf = ', coutbuf(1:csize), ' expected ', &
178 if (ioutbuf2(i) .ne. 5000-i) then
180 print *, 'ioutbuf2(',i,') = ', ioutbuf2(i), ' expected ', &
185 call mtest_finalize( errs )
186 call mpi_finalize( ierr )