mirror of
https://github.com/autc04/Retro68.git
synced 2024-10-19 13:26:21 +00:00
27 lines
866 B
Fortran
27 lines
866 B
Fortran
! { dg-do run }
|
|
|
|
SUBROUTINE SKIP(ID)
|
|
END SUBROUTINE SKIP
|
|
SUBROUTINE WORK(ID)
|
|
END SUBROUTINE WORK
|
|
PROGRAM A39
|
|
INCLUDE "omp_lib.h" ! or USE OMP_LIB
|
|
INTEGER(OMP_LOCK_KIND) LCK
|
|
INTEGER ID
|
|
CALL OMP_INIT_LOCK(LCK)
|
|
!$OMP PARALLEL SHARED(LCK) PRIVATE(ID)
|
|
ID = OMP_GET_THREAD_NUM()
|
|
CALL OMP_SET_LOCK(LCK)
|
|
PRINT *, "My thread id is ", ID
|
|
CALL OMP_UNSET_LOCK(LCK)
|
|
DO WHILE (.NOT. OMP_TEST_LOCK(LCK))
|
|
CALL SKIP(ID) ! We do not yet have the lock
|
|
! so we must do something else
|
|
END DO
|
|
CALL WORK(ID) ! We now have the lock
|
|
! and can do the work
|
|
CALL OMP_UNSET_LOCK( LCK )
|
|
!$OMP END PARALLEL
|
|
CALL OMP_DESTROY_LOCK( LCK )
|
|
END PROGRAM A39
|