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
|
! This file created from f77/rma/baseattrwinf.f with f77tof90
!
! Copyright (C) by Argonne National Laboratory
! See COPYRIGHT in top-level directory
!
program main
use mpi
integer (kind=MPI_ADDRESS_KIND) extrastate, valin, valout, val
logical flag
integer ierr, errs
integer base(1024)
integer disp
integer win
integer commsize
! Include addsize defines asize as an address-sized integer
integer (kind=MPI_ADDRESS_KIND) asize
errs = 0
call mtest_init( ierr )
call mpi_comm_size( MPI_COMM_WORLD, commsize, ierr )
! Create a window; then extract the values
asize = 1024
disp = 4
call MPI_Win_create( base, asize, disp, MPI_INFO_NULL, &
& MPI_COMM_WORLD, win, ierr )
!
! In order to check the base, we need an address-of function.
! We use MPI_Get_address, even though that isn't strictly correct
call MPI_Win_get_attr( win, MPI_WIN_BASE, valout, flag, ierr )
if (.not. flag) then
errs = errs + 1
print *, "Could not get WIN_BASE"
!
! There is no easy way to get the actual value of base to compare
! against. MPI_Address gives a value relative to MPI_BOTTOM, which
! is different from 0 in Fortran (unless you can define MPI_BOTTOM
! as something like %pointer(0)).
! else
!
!C For this Fortran 77 version, we use the older MPI_Address function
! call MPI_Address( base, baseadd, ierr )
! if (valout .ne. baseadd) then
! errs = errs + 1
! print *, "Got incorrect value for WIN_BASE (", valout,
! & ", should be ", baseadd, ")"
! endif
endif
call MPI_Win_get_attr( win, MPI_WIN_SIZE, valout, flag, ierr )
if (.not. flag) then
errs = errs + 1
print *, "Could not get WIN_SIZE"
else
if (valout .ne. asize) then
errs = errs + 1
print *, "Got incorrect value for WIN_SIZE (", valout, &
& ", should be ", asize, ")"
endif
endif
call MPI_Win_get_attr( win, MPI_WIN_DISP_UNIT, valout, flag, ierr)
if (.not. flag) then
errs = errs + 1
print *, "Could not get WIN_DISP_UNIT"
else
if (valout .ne. disp) then
errs = errs + 1
print *, "Got wrong value for WIN_DISP_UNIT (", valout, &
& ", should be ", disp, ")"
endif
endif
call MPI_Win_free( win, ierr )
call mtest_finalize( errs )
end
|
