1C { dg-do run } 2 3 USE OMP_LIB 4 5 DOUBLE PRECISION :: D, E 6 LOGICAL :: L 7 INTEGER (KIND = OMP_LOCK_KIND) :: LCK 8 INTEGER (KIND = OMP_NEST_LOCK_KIND) :: NLCK 9 10 D = OMP_GET_WTIME () 11 12 CALL OMP_INIT_LOCK (LCK) 13 CALL OMP_SET_LOCK (LCK) 14 IF (OMP_TEST_LOCK (LCK)) STOP 1 15 CALL OMP_UNSET_LOCK (LCK) 16 IF (.NOT. OMP_TEST_LOCK (LCK)) STOP 2 17 IF (OMP_TEST_LOCK (LCK)) STOP 3 18 CALL OMP_UNSET_LOCK (LCK) 19 CALL OMP_DESTROY_LOCK (LCK) 20 21 CALL OMP_INIT_NEST_LOCK (NLCK) 22 IF (OMP_TEST_NEST_LOCK (NLCK) .NE. 1) STOP 4 23 CALL OMP_SET_NEST_LOCK (NLCK) 24 IF (OMP_TEST_NEST_LOCK (NLCK) .NE. 3) STOP 5 25 CALL OMP_UNSET_NEST_LOCK (NLCK) 26 CALL OMP_UNSET_NEST_LOCK (NLCK) 27 IF (OMP_TEST_NEST_LOCK (NLCK) .NE. 2) STOP 6 28 CALL OMP_UNSET_NEST_LOCK (NLCK) 29 CALL OMP_UNSET_NEST_LOCK (NLCK) 30 CALL OMP_DESTROY_NEST_LOCK (NLCK) 31 32 CALL OMP_SET_DYNAMIC (.TRUE.) 33 IF (.NOT. OMP_GET_DYNAMIC ()) STOP 7 34 CALL OMP_SET_DYNAMIC (.FALSE.) 35 IF (OMP_GET_DYNAMIC ()) STOP 8 36 37 CALL OMP_SET_NESTED (.TRUE.) 38 IF (.NOT. OMP_GET_NESTED ()) STOP 9 39 CALL OMP_SET_NESTED (.FALSE.) 40 IF (OMP_GET_NESTED ()) STOP 10 41 42 CALL OMP_SET_NUM_THREADS (5) 43 IF (OMP_GET_NUM_THREADS () .NE. 1) STOP 11 44 IF (OMP_GET_MAX_THREADS () .NE. 5) STOP 12 45 IF (OMP_GET_THREAD_NUM () .NE. 0) STOP 13 46 CALL OMP_SET_NUM_THREADS (3) 47 IF (OMP_GET_NUM_THREADS () .NE. 1) STOP 14 48 IF (OMP_GET_MAX_THREADS () .NE. 3) STOP 15 49 IF (OMP_GET_THREAD_NUM () .NE. 0) STOP 16 50 L = .FALSE. 51C$OMP PARALLEL REDUCTION (.OR.:L) 52 L = OMP_GET_NUM_THREADS () .NE. 3 53 L = L .OR. (OMP_GET_THREAD_NUM () .LT. 0) 54 L = L .OR. (OMP_GET_THREAD_NUM () .GE. 3) 55C$OMP MASTER 56 L = L .OR. (OMP_GET_THREAD_NUM () .NE. 0) 57C$OMP END MASTER 58C$OMP END PARALLEL 59 IF (L) STOP 17 60 61 IF (OMP_GET_NUM_PROCS () .LE. 0) STOP 18 62 IF (OMP_IN_PARALLEL ()) STOP 19 63C$OMP PARALLEL REDUCTION (.OR.:L) 64 L = .NOT. OMP_IN_PARALLEL () 65C$OMP END PARALLEL 66C$OMP PARALLEL REDUCTION (.OR.:L) IF (.TRUE.) 67 L = .NOT. OMP_IN_PARALLEL () 68C$OMP END PARALLEL 69 IF (L) STOP 20 70 71 E = OMP_GET_WTIME () 72 IF (D .GT. E) STOP 21 73 D = OMP_GET_WTICK () 74C Negative precision is definitely wrong, 75C bigger than 1s clock resolution is also strange 76 IF (D .LE. 0 .OR. D .GT. 1.) STOP 22 77 END 78