Mercurial > hg > CbC > CbC_gcc
comparison libgomp/testsuite/libgomp.fortran/appendix-a/a.39.1.f90 @ 0:a06113de4d67
first commit
| author | kent <kent@cr.ie.u-ryukyu.ac.jp> |
|---|---|
| date | Fri, 17 Jul 2009 14:47:48 +0900 |
| parents | |
| children |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:a06113de4d67 |
|---|---|
| 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 |