1use omp_lib
2implicit none (type, external)
3  if (.not. env_exists ("OMP_NUM_TEAMS") &
4      .and. omp_get_max_teams () /= 0) &
5    error stop 1
6  call omp_set_num_teams (7)
7  if (omp_get_max_teams () /= 7) &
8    error stop 2
9  if (.not. env_exists ("OMP_TEAMS_THREAD_LIMIT") &
10      .and. omp_get_teams_thread_limit () /= 0) &
11    error stop 3
12  call omp_set_teams_thread_limit (15)
13  if (omp_get_teams_thread_limit () /= 15) &
14    error stop 4
15  !$omp teams
16   !$omp parallel if(.false.)
17    if (omp_get_max_teams () /= 7 &
18        .or. omp_get_teams_thread_limit () /= 15 &
19        .or. omp_get_num_teams () < 1 &
20        .or. omp_get_num_teams () > 7 &
21        .or. omp_get_team_num () < 0 &
22        .or. omp_get_team_num () >= omp_get_num_teams () &
23        .or. omp_get_thread_limit () < 1 &
24        .or. omp_get_thread_limit () > 15) &
25      error stop 5
26   !$omp end parallel
27  !$omp end teams
28  !$omp teams num_teams(5) thread_limit (13)
29   !$omp parallel if(.false.)
30    if (omp_get_max_teams () /= 7 &
31        .or. omp_get_teams_thread_limit () /= 15 &
32        .or. omp_get_num_teams () /= 5 &
33        .or. omp_get_team_num () < 0 &
34        .or. omp_get_team_num () >= omp_get_num_teams () &
35        .or. omp_get_thread_limit () < 1 &
36        .or. omp_get_thread_limit () > 13) &
37      error stop 6
38   !$omp end parallel
39  !$omp end teams
40  !$omp teams num_teams(8) thread_limit (16)
41   !$omp parallel if(.false.)
42    if (omp_get_max_teams () /= 7 &
43        .or. omp_get_teams_thread_limit () /= 15 &
44        .or. omp_get_num_teams () /= 8 &
45        .or. omp_get_team_num () < 0 &
46        .or. omp_get_team_num () >= omp_get_num_teams () &
47        .or. omp_get_thread_limit () < 1 &
48        .or. omp_get_thread_limit () > 16) &
49      error stop 7
50   !$omp end parallel
51  !$omp end teams
52contains
53  logical function env_exists (name)
54    character(len=*) :: name
55    character(len=40) :: val
56    integer :: stat
57    call get_environment_variable (name, val, status=stat)
58    if (stat == 0) then
59      env_exists = .true.
60    else if (stat == 1) then
61      env_exists = .false.
62    else
63      error stop 10
64    endif
65  end
66end
67