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