1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
|
! This file created from f77/datatype/typenamef.f with f77tof90
!
! Copyright (C) by Argonne National Laboratory
! See COPYRIGHT in top-level directory
!
program main
use mpi
character*(MPI_MAX_OBJECT_NAME) name
integer namelen
integer ierr, errs
errs = 0
call mtest_init( ierr )
!
! Check each Fortran datatype, including the size-specific ones
! See the C version (typename.c) for the relevant MPI sections
call MPI_Type_get_name( MPI_COMPLEX, name, namelen, ierr )
if (name(1:namelen) .ne. "MPI_COMPLEX") then
errs = errs + 1
print *, "Expected MPI_COMPLEX but got "//name(1:namelen)
endif
call MPI_Type_get_name( MPI_DOUBLE_COMPLEX, name, namelen, ierr )
if (name(1:namelen) .ne. "MPI_DOUBLE_COMPLEX") then
errs = errs + 1
print *, "Expected MPI_DOUBLE_COMPLEX but got "// &
& name(1:namelen)
endif
call MPI_Type_get_name( MPI_LOGICAL, name, namelen, ierr )
if (name(1:namelen) .ne. "MPI_LOGICAL") then
errs = errs + 1
print *, "Expected MPI_LOGICAL but got "//name(1:namelen)
endif
call MPI_Type_get_name( MPI_REAL, name, namelen, ierr )
if (name(1:namelen) .ne. "MPI_REAL") then
errs = errs + 1
print *, "Expected MPI_REAL but got "//name(1:namelen)
endif
call MPI_Type_get_name( MPI_DOUBLE_PRECISION, name, namelen, ierr)
if (name(1:namelen) .ne. "MPI_DOUBLE_PRECISION") then
errs = errs + 1
print *, "Expected MPI_DOUBLE_PRECISION but got "// &
& name(1:namelen)
endif
call MPI_Type_get_name( MPI_INTEGER, name, namelen, ierr )
if (name(1:namelen) .ne. "MPI_INTEGER") then
errs = errs + 1
print *, "Expected MPI_INTEGER but got "//name(1:namelen)
endif
call MPI_Type_get_name( MPI_2INTEGER, name, namelen, ierr )
if (name(1:namelen) .ne. "MPI_2INTEGER") then
errs = errs + 1
print *, "Expected MPI_2INTEGER but got "//name(1:namelen)
endif
call MPI_Type_get_name(MPI_2DOUBLE_PRECISION, name, namelen, ierr)
if (name(1:namelen) .ne. "MPI_2DOUBLE_PRECISION") then
errs = errs + 1
print *, "Expected MPI_2DOUBLE_PRECISION but got "// &
& name(1:namelen)
endif
call MPI_Type_get_name( MPI_2REAL, name, namelen, ierr )
if (name(1:namelen) .ne. "MPI_2REAL") then
errs = errs + 1
print *, "Expected MPI_2REAL but got "//name(1:namelen)
endif
call MPI_Type_get_name( MPI_CHARACTER, name, namelen, ierr )
if (name(1:namelen) .ne. "MPI_CHARACTER") then
errs = errs + 1
print *, "Expected MPI_CHARACTER but got "//name(1:namelen)
endif
call MPI_Type_get_name( MPI_BYTE, name, namelen, ierr )
if (name(1:namelen) .ne. "MPI_BYTE") then
errs = errs + 1
print *, "Expected MPI_BYTE but got "//name(1:namelen)
endif
if (MPI_REAL4 .ne. MPI_DATATYPE_NULL) then
call MPI_Type_get_name( MPI_REAL4, name, namelen, ierr )
if (name(1:namelen) .ne. "MPI_REAL4") then
errs = errs + 1
print *, "Expected MPI_REAL4 but got "//name(1:namelen)
endif
endif
if (MPI_REAL8 .ne. MPI_DATATYPE_NULL) then
call MPI_Type_get_name( MPI_REAL8, name, namelen, ierr )
if (name(1:namelen) .ne. "MPI_REAL8") then
errs = errs + 1
print *, "Expected MPI_REAL8 but got "//name(1:namelen)
endif
endif
if (MPI_REAL16 .ne. MPI_DATATYPE_NULL) then
call MPI_Type_get_name( MPI_REAL16, name, namelen, ierr )
if (name(1:namelen) .ne. "MPI_REAL16") then
errs = errs + 1
print *, "Expected MPI_REAL16 but got "//name(1:namelen)
endif
endif
if (MPI_COMPLEX8 .ne. MPI_DATATYPE_NULL) then
call MPI_Type_get_name( MPI_COMPLEX8, name, namelen, ierr )
if (name(1:namelen) .ne. "MPI_COMPLEX8") then
errs = errs + 1
print *, "Expected MPI_COMPLEX8 but got "// &
& name(1:namelen)
endif
endif
if (MPI_COMPLEX16 .ne. MPI_DATATYPE_NULL) then
call MPI_Type_get_name( MPI_COMPLEX16, name, namelen, ierr )
if (name(1:namelen) .ne. "MPI_COMPLEX16") then
errs = errs + 1
print *, "Expected MPI_COMPLEX16 but got "// &
& name(1:namelen)
endif
endif
if (MPI_COMPLEX32 .ne. MPI_DATATYPE_NULL) then
call MPI_Type_get_name( MPI_COMPLEX32, name, namelen, ierr )
if (name(1:namelen) .ne. "MPI_COMPLEX32") then
errs = errs + 1
print *, "Expected MPI_COMPLEX32 but got "// &
& name(1:namelen)
endif
endif
if (MPI_INTEGER1 .ne. MPI_DATATYPE_NULL) then
call MPI_Type_get_name( MPI_INTEGER1, name, namelen, ierr )
if (name(1:namelen) .ne. "MPI_INTEGER1") then
errs = errs + 1
print *, "Expected MPI_INTEGER1 but got "// &
& name(1:namelen)
endif
endif
if (MPI_INTEGER2 .ne. MPI_DATATYPE_NULL) then
call MPI_Type_get_name( MPI_INTEGER2, name, namelen, ierr )
if (name(1:namelen) .ne. "MPI_INTEGER2") then
errs = errs + 1
print *, "Expected MPI_INTEGER2 but got "// &
& name(1:namelen)
endif
endif
if (MPI_INTEGER4 .ne. MPI_DATATYPE_NULL) then
call MPI_Type_get_name( MPI_INTEGER4, name, namelen, ierr )
if (name(1:namelen) .ne. "MPI_INTEGER4") then
errs = errs + 1
print *, "Expected MPI_INTEGER4 but got "// &
& name(1:namelen)
endif
endif
if (MPI_INTEGER8 .ne. MPI_DATATYPE_NULL) then
call MPI_Type_get_name( MPI_INTEGER8, name, namelen, ierr )
if (name(1:namelen) .ne. "MPI_INTEGER8") then
errs = errs + 1
print *, "Expected MPI_INTEGER8 but got "// &
& name(1:namelen)
endif
endif
! MPI_INTEGER16 is in MPI 2.1, but it is missing from most tables
! Some MPI implementations may not provide it
! if (MPI_INTEGER16 .ne. MPI_DATATYPE_NULL) then
! call MPI_Type_get_name( MPI_INTEGER16, name, namelen, ierr )
! if (name(1:namelen) .ne. "MPI_INTEGER16") then
! errs = errs + 1
! print *, "Expected MPI_INTEGER16 but got "//
! & name(1:namelen)
! endif
! endif
call mtest_finalize( errs )
end
|
