! { dg-do run } ! { dg-skip-if "" { ! run_expensive_tests } { "*" } { "-O2" } } ! { dg-set-target-env-var OMP_PROC_BIND "spread,close" } ! { dg-set-target-env-var OMP_PLACES "{6,7}:4:-2,!{2,3}" } ! { dg-set-target-env-var OMP_NUM_THREADS "2" } ! { dg-additional-options "-Wno-deprecated-declarations" } use omp_lib integer :: num, i, nump num = omp_get_num_places () print *, 'omp_get_num_places () == ', num do i = 0, num - 1 nump = omp_get_place_num_procs (place_num = i) if (nump .eq. 0) then print *, 'place ', i, ' {}' else call print_place (i, nump) end if end do call print_place_var call omp_set_nested (nested = .true.) !$omp parallel if (omp_get_thread_num () == omp_get_num_threads () - 1) then !$omp parallel if (omp_get_thread_num () == omp_get_num_threads () - 1) & call print_place_var !$omp end parallel end if !$omp end parallel contains subroutine print_place (i, nump) integer, intent (in) :: i, nump integer :: ids(nump) call omp_get_place_proc_ids (place_num = i, ids = ids) print *, 'place ', i, ' {', ids, '}' end subroutine subroutine print_place_var integer :: place, num_places place = omp_get_place_num () num_places = omp_get_partition_num_places () print *, 'place ', place if (num_places .gt. 0) call print_partition (num_places) end subroutine subroutine print_partition (num_places) integer, intent (in) :: num_places integer :: place_nums(num_places) call omp_get_partition_place_nums (place_nums = place_nums) print *, 'partition ', place_nums(1), '-', place_nums(num_places) end subroutine end