1! { 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. 51!$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) 55!$omp master 56 l = l .or. (omp_get_thread_num () .ne. 0) 57!$omp end master 58!$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 63!$omp parallel reduction (.or.:l) 64 l = .not. omp_in_parallel () 65!$omp end parallel 66!$omp parallel reduction (.or.:l) if (.true.) 67 l = .not. omp_in_parallel () 68!$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 () 74 ! Negative precision is definitely wrong, 75 ! bigger than 1s clock resolution is also strange 76 if (d .le. 0 .or. d .gt. 1.) STOP 22 77end 78