1! { dg-do run }
2! { dg-skip-if "" { ! run_expensive_tests } { "*" } { "-O2" } }
3! { dg-set-target-env-var OMP_PROC_BIND "spread,close" }
4! { dg-set-target-env-var OMP_PLACES "{6,7}:4:-2,!{2,3}" }
5! { dg-set-target-env-var OMP_NUM_THREADS "2" }
6! { dg-additional-options "-Wno-deprecated-declarations" }
7
8  use omp_lib
9  integer :: num, i, nump
10  num = omp_get_num_places ()
11  print *, 'omp_get_num_places () == ', num
12  do i = 0, num - 1
13    nump = omp_get_place_num_procs (place_num = i)
14    if (nump .eq. 0) then
15      print *, 'place ', i, ' {}'
16    else
17      call print_place (i, nump)
18    end if
19  end do
20  call print_place_var
21  call omp_set_nested (nested = .true.)
22  !$omp parallel
23    if (omp_get_thread_num () == omp_get_num_threads () - 1) then
24      !$omp parallel
25        if (omp_get_thread_num () == omp_get_num_threads () - 1) &
26          call print_place_var
27      !$omp end parallel
28    end if
29  !$omp end parallel
30contains
31  subroutine print_place (i, nump)
32    integer, intent (in) :: i, nump
33    integer :: ids(nump)
34    call omp_get_place_proc_ids (place_num = i, ids = ids)
35    print *, 'place ', i, ' {', ids, '}'
36  end subroutine
37  subroutine print_place_var
38    integer :: place, num_places
39    place = omp_get_place_num ()
40    num_places = omp_get_partition_num_places ()
41    print *, 'place ', place
42    if (num_places .gt. 0) call print_partition (num_places)
43  end subroutine
44  subroutine print_partition (num_places)
45    integer, intent (in) :: num_places
46    integer :: place_nums(num_places)
47    call omp_get_partition_place_nums (place_nums = place_nums)
48    print *, 'partition ', place_nums(1), '-', place_nums(num_places)
49  end subroutine
50end
51