0
|
1 ! { dg-do run }
|
|
2
|
|
3 SUBROUTINE SKIP(ID)
|
|
4 END SUBROUTINE SKIP
|
|
5 SUBROUTINE WORK(ID)
|
|
6 END SUBROUTINE WORK
|
|
7 PROGRAM A39
|
|
8 INCLUDE "omp_lib.h" ! or USE OMP_LIB
|
|
9 INTEGER(OMP_LOCK_KIND) LCK
|
|
10 INTEGER ID
|
|
11 CALL OMP_INIT_LOCK(LCK)
|
|
12 !$OMP PARALLEL SHARED(LCK) PRIVATE(ID)
|
|
13 ID = OMP_GET_THREAD_NUM()
|
|
14 CALL OMP_SET_LOCK(LCK)
|
|
15 PRINT *, "My thread id is ", ID
|
|
16 CALL OMP_UNSET_LOCK(LCK)
|
|
17 DO WHILE (.NOT. OMP_TEST_LOCK(LCK))
|
|
18 CALL SKIP(ID) ! We do not yet have the lock
|
|
19 ! so we must do something else
|
|
20 END DO
|
|
21 CALL WORK(ID) ! We now have the lock
|
|
22 ! and can do the work
|
|
23 CALL OMP_UNSET_LOCK( LCK )
|
|
24 !$OMP END PARALLEL
|
|
25 CALL OMP_DESTROY_LOCK( LCK )
|
|
26 END PROGRAM A39
|