a8a5f4cc04
PR fortran/92756 * trans-openmp.c (gfc_trans_omp_teams): Wrap OMP_TEAMS body into a BIND_EXPR with a forced BLOCK. * gfortran.dg/gomp/teams1.f90: New test. * testsuite/libgomp.fortran/teams1.f90: New test. * testsuite/libgomp.fortran/teams2.f90: New test. From-SVN: r278956
141 lines
2.7 KiB
Fortran
141 lines
2.7 KiB
Fortran
program teams2
|
|
use omp_lib
|
|
integer :: i, j, err
|
|
err = 0
|
|
!$omp teams reduction(+:err)
|
|
err = err + bar (0, 0, 0)
|
|
!$omp end teams
|
|
if (err .ne. 0) stop 1
|
|
!$omp teams reduction(+:err)
|
|
err = err + bar (1, 0, 0)
|
|
!$omp end teams
|
|
if (err .ne. 0) stop 2
|
|
!$omp teams reduction(+:err)
|
|
!$omp distribute
|
|
do i = 0, 63
|
|
err = err + bar (2, i, 0)
|
|
end do
|
|
!$omp end teams
|
|
if (err .ne. 0) stop 3
|
|
!$omp teams reduction(+:err)
|
|
!$omp distribute
|
|
do i = 0, 63
|
|
!$omp parallel do reduction(+:err)
|
|
do j = 0, 31
|
|
err = err + bar (3, i, j)
|
|
end do
|
|
end do
|
|
!$omp end teams
|
|
if (err .ne. 0) stop 4
|
|
contains
|
|
subroutine foo (x, y, z, a, b)
|
|
integer :: x, y, z, a, b(64), i, j
|
|
if (x .eq. 0) then
|
|
do i = 0, 63
|
|
!$omp parallel do shared (a, b)
|
|
do j = 0, 31
|
|
call foo (3, i, j, a, b)
|
|
end do
|
|
end do
|
|
else if (x .eq. 1) then
|
|
!$omp distribute dist_schedule (static, 1)
|
|
do i = 0, 63
|
|
!$omp parallel do shared (a, b)
|
|
do j = 0, 31
|
|
call foo (3, i, j, a, b)
|
|
end do
|
|
end do
|
|
else if (x .eq. 2) then
|
|
!$omp parallel do shared (a, b)
|
|
do j = 0, 31
|
|
call foo (3, y, j, a, b)
|
|
end do
|
|
else
|
|
!$omp atomic
|
|
b(y + 1) = b(y + 1) + z
|
|
!$omp end atomic
|
|
!$omp atomic
|
|
a = a + 1
|
|
!$omp end atomic
|
|
end if
|
|
end subroutine
|
|
|
|
integer function bar (x, y, z)
|
|
use omp_lib
|
|
integer :: x, y, z, a, b(64), i, c, d, e, f
|
|
a = 8
|
|
do i = 0, 63
|
|
b(i + 1) = i
|
|
end do
|
|
call foo (x, y, z, a, b)
|
|
if (x .eq. 0) then
|
|
if (a .ne. 8 + 64 * 32) then
|
|
bar = 1
|
|
return
|
|
end if
|
|
do i = 0, 63
|
|
if (b(i + 1) .ne. i + 31 * 32 / 2) then
|
|
bar = 1
|
|
return
|
|
end if
|
|
end do
|
|
else if (x .eq. 1) then
|
|
c = omp_get_num_teams ()
|
|
d = omp_get_team_num ()
|
|
e = d
|
|
f = 0
|
|
do i = 0, 63
|
|
if (i .eq. e) then
|
|
if (b(i + 1) .ne. i + 31 * 32 / 2) then
|
|
bar = 1
|
|
return
|
|
end if
|
|
f = f + 1
|
|
e = e + c
|
|
else if (b(i + 1) .ne. i) then
|
|
bar = 1
|
|
return
|
|
end if
|
|
end do
|
|
if (a .lt. 8 .or. a > 8 + f * 32) then
|
|
bar = 1
|
|
return
|
|
end if
|
|
else if (x .eq. 2) then
|
|
if (a .ne. 8 + 32) then
|
|
bar = 1
|
|
return
|
|
end if
|
|
do i = 0, 63
|
|
if (i .eq. y) then
|
|
c = 31 * 32 / 2
|
|
else
|
|
c = 0
|
|
end if
|
|
if (b(i + 1) .ne. i + c) then
|
|
bar = 1
|
|
return
|
|
end if
|
|
end do
|
|
else if (x .eq. 3) then
|
|
if (a .ne. 8 + 1) then
|
|
bar = 1
|
|
return
|
|
end if
|
|
do i = 0, 63
|
|
if (i .eq. y) then
|
|
c = z
|
|
else
|
|
c = 0
|
|
end if
|
|
if (b (i + 1) .ne. i + c) then
|
|
bar = 1
|
|
return
|
|
end if
|
|
end do
|
|
end if
|
|
bar = 0
|
|
return
|
|
end function
|
|
end program
|