72 строки
1.8 KiB
Fortran
72 строки
1.8 KiB
Fortran
C
|
|
C Copyright (c) 2013 Mellanox Technologies, Inc.
|
|
C All rights reserved.
|
|
C $COPYRIGHT$
|
|
C
|
|
C Additional copyrights may follow
|
|
C
|
|
C $HEADER$
|
|
C
|
|
|
|
program ring_shmem_f77
|
|
implicit none
|
|
include 'shmem.fh'
|
|
|
|
integer*8 rbuf
|
|
save rbuf
|
|
integer*8 message
|
|
integer proc, nproc, next
|
|
C func definitions
|
|
integer my_pe, num_pes
|
|
|
|
rbuf = -1
|
|
message = 10
|
|
|
|
call start_pes(0)
|
|
proc = my_pe()
|
|
nproc = num_pes()
|
|
|
|
C Calculate the PE number of the next process in the ring. Use the
|
|
C 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
|
|
|
|
C Pass the message around the ring. The exit mechanism works as
|
|
C follows: the message (a positive integer) is passed around the
|
|
C ring. Each time it passes PE 0, it is decremented. When each
|
|
C processes receives a message containing a 0 value, it passes the
|
|
C message on to the next process and then quits. By passing the 0
|
|
C message first, every process gets the 0 message and can quit
|
|
C normally.
|
|
|
|
10 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
|
|
else
|
|
message = rbuf
|
|
end if
|
|
|
|
call shmem_put8(rbuf, message, 1, next)
|
|
|
|
if (message .gt. 0) then
|
|
goto 10
|
|
else
|
|
goto 20
|
|
end if
|
|
|
|
C All done
|
|
|
|
20 write(*, '("Process", i2," exiting.")') proc
|
|
|
|
end
|