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