mirror of
https://github.com/autc04/Retro68.git
synced 2024-12-11 19:49:32 +00:00
50 lines
1.6 KiB
Fortran
50 lines
1.6 KiB
Fortran
|
! { 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" }
|
||
|
|
|
||
|
|
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
|