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
7  use omp_lib
8  integer :: num, i, nump
9  num = omp_get_num_places ()
10  print *, 'omp_get_num_places () == ', num
11  do i = 0, num - 1
12    nump = omp_get_place_num_procs (place_num = i)
13    if (nump .eq. 0) then
14      print *, 'place ', i, ' {}'
15    else
16      call print_place (i, nump)
17    end if
18  end do
19  call print_place_var
20  call omp_set_nested (nested = .true.)
21  !$omp parallel
22    if (omp_get_thread_num () == omp_get_num_threads () - 1) then
23      !$omp parallel
24        if (omp_get_thread_num () == omp_get_num_threads () - 1) &
25          call print_place_var
26      !$omp end parallel
27    end if
28  !$omp end parallel
29contains
30  subroutine print_place (i, nump)
31    integer, intent (in) :: i, nump
32    integer :: ids(nump)
33    call omp_get_place_proc_ids (place_num = i, ids = ids)
34    print *, 'place ', i, ' {', ids, '}'
35  end subroutine
36  subroutine print_place_var
37    integer :: place, num_places
38    place = omp_get_place_num ()
39    num_places = omp_get_partition_num_places ()
40    print *, 'place ', place
41    if (num_places .gt. 0) call print_partition (num_places)
42  end subroutine
43  subroutine print_partition (num_places)
44    integer, intent (in) :: num_places
45    integer :: place_nums(num_places)
46    call omp_get_partition_place_nums (place_nums = place_nums)
47    print *, 'partition ', place_nums(1), '-', place_nums(num_places)
48  end subroutine
49end
50