libgomp/testsuite/libgomp.fortran/affinity1.f90

   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
  29 contains
  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
  49 end