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
|
!
! Copyright (C) by Argonne National Laboratory
! See COPYRIGHT in top-level directory
!
! This program tests that all of the integer kinds defined in MPI 2.2 are
! available.
!
program main
use mpi_f08
integer (kind=MPI_ADDRESS_KIND) aint, taint
integer (kind=MPI_OFFSET_KIND) oint, toint
integer (kind=MPI_INTEGER_KIND) iint, tiint
TYPE(MPI_Status) s
integer i, wsize, wrank, ierr, errs
!
errs = 0
!
call MTEST_INIT(ierr)
call MPI_COMM_SIZE(MPI_COMM_WORLD,wsize,ierr)
call MPI_COMM_RANK(MPI_COMM_WORLD,wrank,ierr)
if (wsize .lt. 2) then
print *, "This test requires at least 2 processes"
call MPI_ABORT( MPI_COMM_WORLD, 1, ierr )
endif
!
! Some compilers (e.g., gfortran) will issue an error if, at compile time,
! an assignment would cause overflow, even if appropriated guarded. To
! avoid this problem, we must compute the value in the integer (the
! code here is simple; there are faster fixes for this but this is easy
if (wrank .eq. 0) then
if (range(aint) .ge. 10) then
aint = 1
do i=1, range(aint)-1
aint = aint * 10
enddo
aint = aint - 1
else
aint = 12345678
endif
if (range(oint) .ge. 10) then
oint = 1
do i=1, range(oint)-1
oint = oint * 10
enddo
oint = oint - 1
else
oint = 12345678
endif
if (range(iint) .ge. 10) then
iint = 1
do i=1, range(iint)-1
iint = iint * 10
enddo
iint = iint - 1
else
iint = 12345678
endif
call MPI_SEND( aint, 1, MPI_AINT, 1, 0, MPI_COMM_WORLD, ierr )
call MPI_SEND( oint, 1, MPI_OFFSET, 1, 1, MPI_COMM_WORLD, ierr )
call MPI_SEND( iint, 1, MPI_INTEGER, 1, 2, MPI_COMM_WORLD, ierr )
!
else if (wrank .eq. 1) then
if (range(taint) .ge. 10) then
taint = 1
do i=1, range(taint)-1
taint = taint * 10
enddo
taint = taint - 1
else
taint = 12345678
endif
if (range(toint) .ge. 10) then
toint = 1
do i=1, range(toint)-1
toint = toint * 10
enddo
toint = toint - 1
else
toint = 12345678
endif
if (range(tiint) .ge. 10) then
tiint = 1
do i=1, range(tiint)-1
tiint = tiint * 10
enddo
tiint = tiint - 1
else
tiint = 12345678
endif
call MPI_RECV( aint, 1, MPI_AINT, 0, 0, MPI_COMM_WORLD, s, ierr )
if (taint .ne. aint) then
print *, "Address-sized int not correctly transferred"
print *, "Value should be ", taint, " but is ", aint
errs = errs + 1
endif
call MPI_RECV( oint, 1, MPI_OFFSET, 0, 1, MPI_COMM_WORLD, s, ierr )
if (toint .ne. oint) then
print *, "Offset-sized int not correctly transferred"
print *, "Value should be ", toint, " but is ", oint
errs = errs + 1
endif
call MPI_RECV( iint, 1, MPI_INTEGER, 0, 2, MPI_COMM_WORLD, s, ierr )
if (tiint .ne. iint) then
print *, "Integer (by kind) not correctly transferred"
print *, "Value should be ", tiint, " but is ", iint
errs = errs + 1
endif
!
endif
!
call MTEST_FINALIZE(errs)
end
|
