mirror of
https://github.com/OpenMP/Examples.git
synced 2025-04-10 08:22:11 +01:00
42 lines
983 B
Fortran
42 lines
983 B
Fortran
! @@name: simple_lock.1
|
|
! @@type: F-fixed
|
|
! @@operation: link
|
|
! @@expect: success
|
|
! @@version: pre_omp_3.0
|
|
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
|