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