libgomp/testsuite/libgomp.fortran/icv-6.f90

   1 ! { dg-set-target-env-var OMP_NUM_TEAMS_ALL "3" }
   2 ! { dg-set-target-env-var OMP_NUM_TEAMS_DEV "4" }
   3 ! { dg-set-target-env-var OMP_TEAMS_THREAD_LIMIT_ALL "2" }
   4 ! { dg-set-target-env-var OMP_TEAMS_THREAD_LIMIT_DEV "3" }
   5
   6 ! This test considers the hierarchical usage of ICVs on the device, i.e. if
   7 ! e.g. OMP_NUM_TEAMS_DEV_<device_num> is not configured, then the value of
   8 ! OMP_NUM_TEAMS_DEV should be used for the targets.
   9
  10 use omp_lib
  11 implicit none (type, external)
  12   integer :: num_devices, i, stat, tmp
  13   logical :: err
  14   character(len=40) :: val
  15
  16   ! The following environment variables should not be set.
  17   call get_environment_variable ("OMP_NUM_TEAMS_DEV_0", val, status=stat)
  18   if (stat /= 1) return
  19   call get_environment_variable ("OMP_NUM_TEAMS_DEV_1", val, status=stat)
  20   if (stat /= 1) return
  21   call get_environment_variable ("OMP_NUM_TEAMS_DEV_2", val, status=stat)
  22   if (stat /= 1) return
  23   call get_environment_variable ("OMP_TEAMS_THREAD_LIMIT_DEV_0", val, status=stat)
  24   if (stat /= 1) return
  25   call get_environment_variable ("OMP_TEAMS_THREAD_LIMIT_DEV_1", val, status=stat)
  26   if (stat /= 1) return
  27   call get_environment_variable ("OMP_TEAMS_THREAD_LIMIT_DEV_2", val, status=stat)
  28   if (stat /= 1) return
  29
  30   if (omp_get_num_devices () > 3) then
  31     num_devices = 3
  32   else
  33     num_devices = omp_get_num_devices ()
  34   end if
  35
  36   do i=0,num_devices-1
  37
  38     ! Testing NUM_TEAMS.
  39     if (env_is_set ("OMP_NUM_TEAMS_DEV", "4")) then
  40       err = .false.
  41       !$omp target device(i) map(tofrom: err)
  42       if (omp_get_max_teams () /= 4) err = .true.
  43       !$omp end target
  44       if (err) stop 1
  45
  46       err = .false.
  47       !$omp target device(i) map(tofrom: err)
  48       !$omp teams
  49       if (omp_get_num_teams () > 4 .or. omp_get_team_num () >= 4) &
  50         err = .true.
  51       !$omp end teams
  52       !$omp end target
  53       if (err) stop 2
  54
  55       err = .false.
  56       !$omp target device(i) map(tofrom: err)
  57       call omp_set_num_teams (3 + i)
  58       if (omp_get_max_teams () /= 3 + i) err = .true.
  59       !$omp end target
  60       if (err) stop 3
  61
  62       err = .false.
  63       !$omp target device(i) map(tofrom: err)
  64       if (omp_get_max_teams () /= 3 + i) err = .true.
  65       !$omp end target
  66       if (err) stop 4
  67
  68       err = .false.
  69       !$omp target device(i) map(tofrom: err)
  70       !$omp teams
  71       if (omp_get_num_teams () > 3 + i .or. omp_get_team_num () >= 3 + i) &
  72         err = .true.
  73       !$omp end teams
  74       !$omp end target
  75       if (err) stop 5
  76     end if
  77
  78     ! Testing TEAMS-THREAD-LIMIT
  79     if (env_is_set ("OMP_TEAMS_THREAD_LIMIT_DEV", "3")) then
  80       err = .false.
  81       !$omp target device(i) map(tofrom: err)
  82       if (omp_get_teams_thread_limit () /= 3) err = .true.
  83       !$omp end target
  84       if (err) stop 6
  85
  86       err = .false.
  87       !$omp target device(i) map(tofrom: err)
  88       !$omp teams
  89       !$omp parallel
  90       if (omp_get_thread_limit () > 3 .or. omp_get_thread_num () >= 3) &
  91         err = .true.
  92       !$omp end parallel
  93       !$omp end teams
  94       !$omp end target
  95       if (err) stop 7
  96
  97       err = .false.
  98       !$omp target device(i) map(tofrom: err)
  99       call omp_set_teams_thread_limit (2 + i)
 100       if (omp_get_teams_thread_limit () /= 2 + i) err = .true.
 101       !$omp end target
 102       if (err) stop 8
 103
 104       err = .false.
 105       !$omp target device(i) map(tofrom: err)
 106       if (omp_get_teams_thread_limit () /= 2 + i) err = .true.
 107       !$omp end target
 108       if (err) stop 9
 109
 110       err = .false.
 111       !$omp target device(i) map(tofrom: err)
 112       !$omp teams
 113       !$omp parallel
 114       if (omp_get_thread_limit () > 2 + i .or. omp_get_thread_num () >= 2 + i) &
 115         err = .true.
 116       !$omp end parallel
 117       !$omp end teams
 118       !$omp end target
 119       if (err) stop 10
 120     end if
 121
 122   end do
 123
 124 contains
 125   logical function env_is_set (name, val)
 126     character(len=*) :: name, val
 127     character(len=40) :: val2
 128     integer :: stat
 129     call get_environment_variable (name, val2, status=stat)
 130     if (stat == 0) then
 131       if (val == val2) then
 132         env_is_set = .true.
 133         return
 134       end if
 135     else if (stat /= 1) then
 136       error stop 10
 137     endif
 138     env_is_set = .false.
 139   end
 140 end