1 C -*- Mode: Fortran; -*-
3 C (C) 2004 by Argonne National Laboratory.
4 C See COPYRIGHT in top-level directory.
11 call mpi_comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN,
14 C Check that all Ctypes are available in Fortran (MPI 2.1, p 483, line 46)
16 call checkdtype( MPI_CHAR, "MPI_CHAR", ierr )
17 call checkdtype( MPI_SIGNED_CHAR, "MPI_SIGNED_CHAR", ierr )
18 call checkdtype( MPI_UNSIGNED_CHAR, "MPI_UNSIGNED_CHAR", ierr )
19 call checkdtype( MPI_BYTE, "MPI_BYTE", ierr )
20 call checkdtype( MPI_WCHAR, "MPI_WCHAR", ierr )
21 call checkdtype( MPI_SHORT, "MPI_SHORT", ierr )
22 call checkdtype( MPI_UNSIGNED_SHORT, "MPI_UNSIGNED_SHORT", ierr )
23 call checkdtype( MPI_INT, "MPI_INT", ierr )
24 call checkdtype( MPI_UNSIGNED, "MPI_UNSIGNED", ierr )
25 call checkdtype( MPI_LONG, "MPI_LONG", ierr )
26 call checkdtype( MPI_UNSIGNED_LONG, "MPI_UNSIGNED_LONG", ierr )
27 call checkdtype( MPI_FLOAT, "MPI_FLOAT", ierr )
28 call checkdtype( MPI_DOUBLE, "MPI_DOUBLE", ierr )
29 if (MPI_LONG_DOUBLE .ne. MPI_DATATYPE_NULL) then
30 call checkdtype( MPI_LONG_DOUBLE, "MPI_LONG_DOUBLE", ierr )
32 if (MPI_LONG_LONG_INT .ne. MPI_DATATYPE_NULL) then
33 call checkdtype2( MPI_LONG_LONG_INT, "MPI_LONG_LONG_INT",
34 * "MPI_LONG_LONG", ierr )
36 if (MPI_UNSIGNED_LONG_LONG .ne. MPI_DATATYPE_NULL) then
37 call checkdtype( MPI_UNSIGNED_LONG_LONG,
38 * "MPI_UNSIGNED_LONG_LONG", ierr )
40 if (MPI_LONG_LONG .ne. MPI_DATATYPE_NULL) then
41 call checkdtype2( MPI_LONG_LONG, "MPI_LONG_LONG",
42 * "MPI_LONG_LONG_INT", ierr )
44 call checkdtype( MPI_PACKED, "MPI_PACKED", ierr )
45 call checkdtype( MPI_LB, "MPI_LB", ierr )
46 call checkdtype( MPI_UB, "MPI_UB", ierr )
47 call checkdtype( MPI_FLOAT_INT, "MPI_FLOAT_INT", ierr )
48 call checkdtype( MPI_DOUBLE_INT, "MPI_DOUBLE_INT", ierr )
49 call checkdtype( MPI_LONG_INT, "MPI_LONG_INT", ierr )
50 call checkdtype( MPI_SHORT_INT, "MPI_SHORT_INT", ierr )
51 call checkdtype( MPI_2INT, "MPI_2INT", ierr )
52 if (MPI_LONG_DOUBLE_INT .ne. MPI_DATATYPE_NULL) then
53 call checkdtype( MPI_LONG_DOUBLE_INT, "MPI_LONG_DOUBLE_INT",
57 C Check that all Ctypes are available in Fortran (MPI 2.2)
58 C Note that because of implicit declarations in Fortran, this
59 C code should compile even with pre MPI 2.2 implementations.
61 if (MPI_VERSION .gt. 2 .or. (MPI_VERSION .eq. 2 .and.
62 * MPI_SUBVERSION .ge. 2)) then
63 call checkdtype( MPI_INT8_T, "MPI_INT8_T", ierr )
64 call checkdtype( MPI_INT16_T, "MPI_INT16_T", ierr )
65 call checkdtype( MPI_INT32_T, "MPI_INT32_T", ierr )
66 call checkdtype( MPI_INT64_T, "MPI_INT64_T", ierr )
67 call checkdtype( MPI_UINT8_T, "MPI_UINT8_T", ierr )
68 call checkdtype( MPI_UINT16_T, "MPI_UINT16_T", ierr )
69 call checkdtype( MPI_UINT32_T, "MPI_UINT32_T", ierr )
70 call checkdtype( MPI_UINT64_T, "MPI_UINT64_T", ierr )
72 call checkdtype( MPI_C_BOOL, "MPI_C_BOOL", ierr )
73 call checkdtype( MPI_C_FLOAT_COMPLEX, "MPI_C_FLOAT_COMPLEX",
75 call checkdtype2( MPI_C_COMPLEX, "MPI_C_COMPLEX",
76 * "MPI_C_FLOAT_COMPLEX", ierr )
77 call checkdtype( MPI_C_DOUBLE_COMPLEX, "MPI_C_DOUBLE_COMPLEX",
79 if (MPI_C_LONG_DOUBLE_COMPLEX .ne. MPI_DATATYPE_NULL) then
80 call checkdtype( MPI_C_LONG_DOUBLE_COMPLEX,
81 * "MPI_C_LONG_DOUBLE_COMPLEX", ierr )
83 C address/offset types
84 call checkdtype( MPI_AINT, "MPI_AINT", ierr )
85 call checkdtype( MPI_OFFSET, "MPI_OFFSET", ierr )
88 call mtest_finalize( ierr )
89 call MPI_Finalize( ierr )
92 C Check name of datatype
93 subroutine CheckDtype( intype, name, ierr )
98 character *(MPI_MAX_OBJECT_NAME) outname
101 call MPI_TYPE_GET_NAME( intype, outname, rlen, ir )
102 if (ir .ne. MPI_SUCCESS) then
103 print *, " Datatype ", name, " not available in Fortran"
106 if (outname .ne. name) then
107 print *, " For datatype ", name, " found name ",
116 C Check name of datatype (allows alias)
117 subroutine CheckDtype2( intype, name, name2, ierr )
120 character *(*) name, name2
122 character *(MPI_MAX_OBJECT_NAME) outname
125 call MPI_TYPE_GET_NAME( intype, outname, rlen, ir )
126 if (ir .ne. MPI_SUCCESS) then
127 print *, " Datatype ", name, " not available in Fortran"
130 if (outname .ne. name .and. outname .ne. name2) then
131 print *, " For datatype ", name, " found name ",