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