File: ring_oshmemfh.f90

package info (click to toggle)
openmpi 3.1.3-11
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 118,572 kB
  • sloc: ansic: 628,972; f90: 17,993; makefile: 13,761; sh: 7,051; java: 6,360; perl: 3,215; cpp: 2,225; python: 1,350; lex: 988; fortran: 52; tcl: 12
file content (66 lines) | stat: -rw-r--r-- 1,857 bytes parent folder | download | duplicates (5)
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
!
! 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