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