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