gcc/testsuite/gfortran.dg/gomp/teams-4.f90

   1 ! PR middle-end/102972
   2
   3 module m
   4 implicit none (type, external)
   5
   6 ! Note: Those are module functions - not an interface
   7 ! Hence, they are internally manged to contain the module name!
   8
   9 contains
  10
  11 subroutine omp_set_num_teams (num_teams); integer :: num_teams; end
  12 subroutine omp_set_teams_thread_limit (thread_limit); integer :: thread_limit; end
  13 subroutine omp_set_num_teams_8 (num_teams); integer(8) :: num_teams; end
  14 subroutine omp_set_num_teams_9 (num_teams); integer :: num_teams; end
  15 subroutine omp_set_teams_thread_limit_8 (thread_limit); integer(8) :: thread_limit; end
  16 integer function omp_get_num_teams (); omp_get_num_teams = 0; end
  17 integer function omp_get_team_size (level); integer :: level; omp_get_team_size = 0; end
  18 integer function omp_get_team_num (); omp_get_team_num = 0; end
  19 integer function omp_get_max_teams (); omp_get_max_teams = 0; end
  20 integer function omp_get_teams_thread_limit (); omp_get_teams_thread_limit = 0; end
  21 logical function omp_is_initial_device (); omp_is_initial_device = .true.; end
  22 integer function omp_get_num_threads (); omp_get_num_threads = 0; end
  23 end module
  24
  25 subroutine nest_test ()
  26   use m
  27   implicit none (type, external)
  28
  29   integer :: i, n
  30   !$omp teams
  31     !$omp distribute parallel do simd
  32     do i = 1, 64
  33     end do
  34
  35     n = 0
  36     n = n + omp_get_team_size (0)
  37     n = n + omp_get_num_teams ()
  38     n = n + omp_get_team_num ()
  39     call omp_set_num_teams (n)
  40     call omp_set_num_teams_8 (4_8)
  41     call omp_set_num_teams_9 (4)
  42     n = n + omp_get_max_teams ()
  43     n = n + omp_get_teams_thread_limit ()
  44     call omp_set_teams_thread_limit (n)
  45     call omp_set_teams_thread_limit_8 (3_8)
  46   !$omp end teams
  47 end