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