blob: f743d380a90bcb82365d0175da043e1f7bbf6952 [file] [log] [blame]
!
! Modified version of omp_set_unset_lock.F, using hinted lock API
!
program omp_set_unset_lock_hinted
integer ret
#if defined(_OPENMP)
include 'omp_lib.h'
ret = 0
call hinted_lock(kmp_lock_hint_none, ret)
call hinted_lock(kmp_lock_hint_contended, ret)
call hinted_lock(kmp_lock_hint_uncontended, ret)
call hinted_lock(kmp_lock_hint_nonspeculative, ret)
call hinted_lock(kmp_lock_hint_speculative, ret)
call hinted_lock(kmp_lock_hint_adaptive, ret)
#else
ret = 0
#endif
if (ret .eq. 0) then
print *, 'Test omp_set_unset_lock_hinted.f passed'
else
print *, 'Test omp_set_unset_lock_hinted.f failed'
endif
stop
end
subroutine hinted_lock(lock_hint, ret)
#if defined(_OPENMP)
include 'omp_lib.h'
integer(omp_lock_kind) lock
integer(kmp_lock_hint_kind) lock_hint
#else
integer lock
integer lock_hint
#endif
integer ret
logical passed
integer n(1000), j, id
passed = .TRUE.
call kmp_init_lock_hinted(lock, lock_hint)
!$omp parallel
!$omp& shared (n,passed,lock)
!$omp& private (id,j)
#if defined(_OPENMP) && !defined(_ASSURE)
id = omp_get_thread_num()
#else
id = 0
#endif
#if defined(_ASSURE)
do j = 1, 10
#else
do j = 1, 10000
#endif
call cscall(id, n, passed, lock)
enddo
!$omp end parallel
call omp_destroy_lock(lock)
if (.not. passed) then
ret = ret + 1
endif
end
subroutine cscall(id, n, passed, lock)
#if defined(_OPENMP)
include 'omp_lib.h'
integer(omp_lock_kind) lock
#else
integer lock
#endif
integer id, i, n(1000)
logical passed
call omp_set_lock(lock)
do i = 1,1000
n(i) = id
enddo
do i = 1,1000
if (n(i) .ne. id) passed = .FALSE.
enddo
call omp_unset_lock(lock)
end