! @@name: simple_lock.1f ! @@type: F-fixed ! @@compilable: yes ! @@linkable: yes ! @@expect: success SUBROUTINE SKIP(ID) END SUBROUTINE SKIP SUBROUTINE WORK(ID) END SUBROUTINE WORK PROGRAM SIMPLELOCK 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 SIMPLELOCK