libgomp/testsuite/libgomp.fortran/icv-5.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_NUM_TEAMS "5" }
   4 ! { dg-set-target-env-var OMP_NUM_TEAMS_DEV_0 "6" }
   5 ! { dg-set-target-env-var OMP_NUM_TEAMS_DEV_1 "7" }
   6 ! { dg-set-target-env-var OMP_NUM_TEAMS_DEV_2 "8" }
   7 ! { dg-set-target-env-var OMP_TEAMS_THREAD_LIMIT_ALL "2" }
   8 ! { dg-set-target-env-var OMP_TEAMS_THREAD_LIMIT_DEV "3" }
   9 ! { dg-set-target-env-var OMP_TEAMS_THREAD_LIMIT "4" }
  10 ! { dg-set-target-env-var OMP_TEAMS_THREAD_LIMIT_DEV_0 "5" }
  11 ! { dg-set-target-env-var OMP_TEAMS_THREAD_LIMIT_DEV_1 "6" }
  12 ! { dg-set-target-env-var OMP_TEAMS_THREAD_LIMIT_DEV_2 "7" }
  13
  14 use omp_lib
  15 implicit none (type, external)
  16   integer :: num_devices, i, large_num_teams, large_threads_limit
  17   logical :: err
  18
  19   if (omp_get_num_devices () > 3) then
  20     num_devices = 3
  21   else
  22     num_devices = omp_get_num_devices ()
  23   end if
  24
  25   do i=0,num_devices-1
  26
  27     ! Testing NUM_TEAMS.
  28     if (env_is_set_dev ("OMP_NUM_TEAMS_DEV_", i, 6 + i)) then
  29       err = .false.
  30       !$omp target device(i) map(tofrom: err)
  31       if (omp_get_max_teams () /= 6 + i) err = .true.
  32       !$omp end target
  33       if (err) stop 1
  34
  35       err = .false.
  36       !$omp target device(i) map(tofrom: err)
  37       !$omp teams
  38       if (omp_get_num_teams () > 6 + i .or. omp_get_team_num () >= 6 + i) &
  39         err = .true.
  40       !$omp end teams
  41       !$omp end target
  42       if (err) stop 2
  43
  44       err = .false.
  45       !$omp target device(i) map(tofrom: err)
  46       call omp_set_num_teams (5 + i)
  47       if (omp_get_max_teams () /= 5 + i) err = .true.
  48       !$omp end target
  49       if (err) stop 3
  50
  51       err = .false.
  52       !$omp target device(i) map(tofrom: err)
  53       if (omp_get_max_teams () /= 5 + i) err = .true.
  54       !$omp end target
  55       if (err) stop 4
  56
  57       err = .false.
  58       !$omp target device(i) map(tofrom: err)
  59       !$omp teams
  60       if (omp_get_num_teams () > 5 + i .or. omp_get_team_num () >= 5 + i) &
  61         err = .true.
  62       !$omp end teams
  63       !$omp end target
  64       if (err) stop 5
  65
  66       err = .false.
  67       !$omp target device(i) map(tofrom: err)
  68       !$omp teams num_teams(6 + i)
  69       if (omp_get_num_teams () > 6 + i .or. omp_get_team_num () >= 6 + i) &
  70         err = .true.
  71       !$omp end teams
  72       !$omp end target
  73       if (err) stop 6
  74
  75       err = .false.
  76       !$omp target device(i) map(tofrom: err)
  77       !$omp teams num_teams(4 + i)
  78       if (omp_get_num_teams () > 4 + i .or. omp_get_team_num () >= 4 + i) &
  79         err = .true.
  80       !$omp end teams
  81       !$omp end target
  82       if (err) stop 7
  83
  84       large_num_teams = 66000
  85       err = .false.
  86       !$omp target device(i) map(tofrom: err)
  87       call omp_set_num_teams (large_num_teams + i)
  88       if (omp_get_max_teams () /= large_num_teams + i) err = .true.
  89       !$omp end target
  90       if (err) stop 8
  91
  92       err = .false.
  93       !$omp target device(i) map(tofrom: err)
  94       if (omp_get_max_teams () /= large_num_teams + i) err = .true.
  95       !$omp end target
  96       if (err) stop 9
  97
  98       err = .false.
  99       !$omp target device(i) map(tofrom: err)
 100       !$omp teams
 101       if (omp_get_num_teams () > large_num_teams + i &
 102           .or. omp_get_team_num () >= large_num_teams + i) err = .true.
 103       !$omp end teams
 104       !$omp end target
 105       if (err) stop 10
 106     end if
 107
 108     ! Testing TEAMS-THREAD-LIMIT
 109     if (env_is_set_dev ("OMP_TEAMS_THREAD_LIMIT_DEV_", i, 5 + i)) then
 110       err = .false.
 111       !$omp target device(i) map(tofrom: err)
 112       if (omp_get_teams_thread_limit () /= 5 + i) err = .true.
 113       !$omp end target
 114       if (err) stop 11
 115
 116       err = .false.
 117       !$omp target device(i) map(tofrom: err)
 118       !$omp teams
 119       !$omp parallel
 120       if (omp_get_thread_limit () > 5 + i .or. omp_get_thread_num () >= 5 + i) &
 121         err = .true.
 122       !$omp end parallel
 123       !$omp end teams
 124       !$omp end target
 125       if (err) stop 12
 126
 127       err = .false.
 128       !$omp target device(i) map(tofrom: err)
 129       call omp_set_teams_thread_limit (4 + i)
 130       if (omp_get_teams_thread_limit () /= 4 + i) err = .true.
 131       !$omp end target
 132       if (err) stop 13
 133
 134       err = .false.
 135       !$omp target device(i) map(tofrom: err)
 136       if (omp_get_teams_thread_limit () /= 4 + i) err = .true.
 137       !$omp end target
 138       if (err) stop 14
 139
 140       err = .false.
 141       !$omp target device(i) map(tofrom: err)
 142       !$omp teams
 143       !$omp parallel
 144       if (omp_get_thread_limit () > 4 + i .or. omp_get_thread_num () >= 4 + i) &
 145         err = .true.
 146       !$omp end parallel
 147       !$omp end teams
 148       !$omp end target
 149       if (err) stop 15
 150
 151       err = .false.
 152       !$omp target device(i) map(tofrom: err)
 153       !$omp teams thread_limit(5 + i)
 154       !$omp parallel
 155       if (omp_get_thread_limit () > 5 + i .or. omp_get_thread_num () >= 5 + i) &
 156         err = .true.
 157       !$omp end parallel
 158       !$omp end teams
 159       !$omp end target
 160       if (err) stop 16
 161
 162       err = .false.
 163       !$omp target device(i) map(tofrom: err)
 164       !$omp teams thread_limit(3 + i)
 165       !$omp parallel
 166       if (omp_get_thread_limit () > 3 + i .or. omp_get_thread_num () >= 3 + i) &
 167         err = .true.
 168       !$omp end parallel
 169       !$omp end teams
 170       !$omp end target
 171       if (err) stop 17
 172
 173       large_threads_limit = 67000
 174       err = .false.
 175       !$omp target device(i) map(tofrom: err)
 176       call omp_set_teams_thread_limit (large_threads_limit + i)
 177       if (omp_get_teams_thread_limit () /= large_threads_limit + i) err = .true.
 178       !$omp end target
 179       if (err) stop 18
 180
 181       err = .false.
 182       !$omp target device(i) map(tofrom: err)
 183       if (omp_get_teams_thread_limit () /= large_threads_limit + i) err = .true.
 184       !$omp end target
 185       if (err) stop 19
 186
 187       err = .false.
 188       !$omp target device(i) map(tofrom: err)
 189       !$omp teams
 190       !$omp parallel
 191       if (omp_get_thread_limit () > large_threads_limit + i &
 192           .or. omp_get_thread_num () >= large_threads_limit + i) err = .true.
 193       !$omp end parallel
 194       !$omp end teams
 195       !$omp end target
 196       if (err) stop 20
 197     end if
 198
 199   end do
 200
 201 contains
 202   logical function env_is_set (name, val)
 203     character(len=*) :: name, val
 204     character(len=40) :: val2
 205     integer :: stat
 206     call get_environment_variable (name, val2, status=stat)
 207     if (stat == 0) then
 208       if (val == val2) then
 209         env_is_set = .true.
 210         return
 211       end if
 212     else if (stat /= 1) then
 213       error stop 30
 214     endif
 215     env_is_set = .false.
 216   end
 217   logical function env_is_set_dev (name, dev_num, val)
 218     character(len=*) :: name
 219     integer :: dev_num, val
 220     character(len=64) :: dev_num_str, env_var, val_str
 221     dev_num_str = ADJUSTL(dev_num_str)
 222     env_var = name // dev_num_str
 223     val_str = ADJUSTL(val_str)
 224     env_is_set_dev = env_is_set (TRIM(env_var), TRIM(val_str))
 225   end
 226 end