2 ! (C) 2004 by Argonne National Laboratory.
3 ! See COPYRIGHT in top-level directory.
9 integer nints, nadds, ndtypes, combiner
10 integer nparms(2), dummy(1)
11 integer (kind=MPI_ADDRESS_KIND) adummy(1)
12 integer ntype1, nsize, ntype2, ntype3, i
14 ! Test the Type_create_f90_xxx routines
17 call mtest_init( ierr )
19 ! integers with upto 9 are 4 bytes integers; r of 4 are 2 byte,
20 ! and r of 2 is 1 byte
21 call mpi_type_create_f90_integer( 9, ntype1, ierr )
23 ! Check with get contents and envelope...
24 call mpi_type_get_envelope( ntype1, nints, nadds, ndtypes, &
26 if (nadds .ne. 0) then
28 print *, "There should be no addresses on created type (r=9)"
30 if (ndtypes .ne. 0) then
32 print *, "There should be no datatypes on created type (r=9)"
34 if (nints .ne. 1) then
36 print *, "There should be exactly 1 integer on create type (r=9)"
38 if (combiner .ne. MPI_COMBINER_F90_INTEGER) then
40 print *, "The combiner should be INTEGER, not ", combiner
42 if (nints .eq. 1) then
43 call mpi_type_get_contents( ntype1, 1, 0, 0, &
44 nparms, adummy, dummy, ierr )
45 if (nparms(1) .ne. 9) then
47 print *, "parameter was ", nparms(1), " should be 9"
51 call mpi_type_create_f90_integer( 8, ntype2, ierr )
52 if (ntype1 .eq. ntype2) then
54 print *, "Types with r = 8 and r = 9 are the same, ", &
59 ! Check that we don't create new types each time. This test will fail only
60 ! if the MPI implementation checks for un-freed types or runs out of space
62 call mpi_type_create_f90_integer( 8, ntype3, ierr )
65 call mtest_finalize( errs )
66 call mpi_finalize( ierr )