! @@name: atomic.3f

! @@type: F-fixed

! @@compilable: yes

! @@linkable: no

! @@expect: success

function fetch_and_add(p)

integer:: fetch_and_add

integer, intent(inout) :: p

! Atomically read the value of p and then increment it. The previous value is

! returned. This can be used to implement a simple lock as shown below.

!$omp atomic capture

fetch_and_add = p

p = p + 1

!$omp end atomic

end function fetch_and_add

module m

interface

function fetch_and_add(p)

integer :: fetch_and_add

integer, intent(inout) :: p

end function

function atomic_read(p)

integer :: atomic_read

integer, intent(in) :: p

end function

end interface

type locktype

integer ticketnumber

integer turn

end type

contains

subroutine do_locked_work(lock)

type(locktype), intent(inout) :: lock

integer myturn

integer junk

! obtain the lock

myturn = fetch_and_add(lock%ticketnumber)

do while (atomic_read(lock%turn) .ne. myturn)

continue

enddo

! Do some work. The flush is needed to ensure visibility of variables

! not involved in atomic directives

!$omp flush

call work

!$omp flush

! Release the lock

junk = fetch_and_add(lock%turn)

end subroutine

end module