-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathsimple_bcast_gpudirect.f90
58 lines (43 loc) · 1.42 KB
/
simple_bcast_gpudirect.f90
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
program simple_bcast
use mpi
use openacc
implicit none
integer, parameter :: n = 2
integer :: v(n)
integer :: i, ierr, myrank, nranks
call MPI_Init(ierr)
call MPI_Comm_rank(MPI_COMM_WORLD, myrank, ierr)
call MPI_Comm_size(MPI_COMM_WORLD, nranks, ierr)
call acc_set_device_num(myrank, ACC_DEVICE_NVIDIA)
call print_array(v, "a. Before bcast, outside data")
!$acc data copy(v)
!$acc kernels present(v)
if (myrank == 0) then
v = 1
endif
!$acc end kernels
call print_array(v, "b. Before bcast, in data")
!$acc host_data use_device(v)
call MPI_Bcast(v, n, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
!$acc end host_data
call print_array(v, "c. After bcast, in data")
!$acc end data
call print_array(v, "d. After bcast, outside data")
call MPI_Finalize(ierr)
contains
subroutine print_array(array, label)
implicit none
integer, dimension(:), intent(in) :: array
character(*), intent(in) :: label
integer :: myrank, nranks, ierr
call MPI_Comm_rank(MPI_COMM_WORLD, myrank, ierr)
call MPI_Comm_size(MPI_COMM_WORLD, nranks, ierr)
do i = 0, nranks-1
if (myrank == i) then
write (6,*) label, myrank, ":" , array
call flush(6)
endif
call MPI_Barrier(MPI_COMM_WORLD, ierr)
enddo
end subroutine
end program