openmpi/examples/ring_oshmemfh.f90

67 lines
1.8 KiB
Fortran
Raw Normal View History

2022-11-01 14:45:02 +08:00
!
! Copyright (c) 2014 Mellanox Technologies, Inc.
! All rights reserved.
! Copyright (c) 2014 Cisco Systems, Inc. All rights reserved.
! $COPYRIGHT$
!
! Additional copyrights may follow
!
! $HEADER$
!
program ring_oshmem
implicit none
include 'shmem.fh'
integer*8, save :: rbuf
integer*8 :: message
integer :: proc, nproc, next
integer :: my_pe, num_pes
rbuf = -1
message = 10
call start_pes(0)
proc = my_pe()
nproc = num_pes()
! Calculate the PE number of the next process in the ring. Use the
! modulus operator so that the last process "wraps around" to PE 0.
next = mod((proc + 1), nproc)
if (proc .eq. 0) then
write(*, '("Process 0 sending ", i2, " to", i2, " (", i2, " processes in ring)")') message, next, nproc
call shmem_put8(rbuf, message, 1, next)
write(*, '("Process 0 sent to ", i2)') next
end if
! Pass the message around the ring. The exit mechanism works as
! follows: the message (a positive integer) is passed around the
! ring. Each time it passes PE 0, it is decremented. When each
! processes receives a message containing a 0 value, it passes the
! message on to the next process and then quits. By passing the 0
! message first, every process gets the 0 message and can quit
! normally.
do while (message .gt. 0)
call shmem_int8_wait_until(rbuf, SHMEM_CMP_EQ, message)
if (proc .eq. 0) then
message = message - 1
write(*, '("Process 0 decremented value:", i2)') message
end if
call shmem_put8(rbuf, message, 1, next)
if (proc .gt. 0) then
message = message - 1
end if
end do
! All done
write(*, '("Process", i2," exiting.")') proc
end program ring_oshmem