view libgomp/testsuite/libgomp.fortran/affinity1.f90 @ 152:2b5abeee2509

update gcc11
author anatofuz
date Mon, 25 May 2020 07:50:57 +0900
parents 04ced10e8804
children
line wrap: on
line source

! { 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