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