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