1! @@name:	atomic.3f
2! @@type:	F-fixed
3! @@compilable:	yes
4! @@linkable:	no
5! @@expect:	success
6       function fetch_and_add(p)
7       integer:: fetch_and_add
8       integer, intent(inout) :: p
9
10! Atomically read the value of p and then increment it. The previous value is
11! returned. This can be used to implement a simple lock as shown below.
12!$omp atomic capture
13       fetch_and_add = p
14       p = p + 1
15!$omp end atomic
16       end function fetch_and_add
17       module m
18       interface
19         function fetch_and_add(p)
20           integer :: fetch_and_add
21           integer, intent(inout) :: p
22         end function
23         function atomic_read(p)
24           integer :: atomic_read
25           integer, intent(in) :: p
26         end function
27       end interface
28       type locktype
29          integer ticketnumber
30          integer turn
31       end type
32       contains
33       subroutine do_locked_work(lock)
34       type(locktype), intent(inout) :: lock
35       integer myturn
36       integer junk
37! obtain the lock
38        myturn = fetch_and_add(lock%ticketnumber)
39        do while (atomic_read(lock%turn) .ne. myturn)
40          continue
41        enddo
42! Do some work. The flush is needed to ensure visibility of variables
43! not involved in atomic directives
44!$omp flush
45       call work
46!$omp flush
47! Release the lock
48       junk = fetch_and_add(lock%turn)
49       end subroutine
50       end module
51