llvm-project/openmp/testsuite/fortran/omp_workshare.f

143 lines
3.9 KiB
Fortran

<ompts:test>
<ompts:testdescription>Test which checks if WORKSHARE is present.</ompts:testdescription>
<ompts:ompversion>2.0</ompts:ompversion>
<ompts:directive>omp workshare</ompts:directive>
<ompts:dependences>omp critical</ompts:dependences>
<ompts:testcode>
!********************************************************************
! Function: omp_workshare
!
! by Chunhua Liao, University of Houston
! Oct. 2005 - First version
!
! The idea for the test is that if WORKSHARE is not present,
! the array assignment in PARALLEL region will be executed by each
! thread and then wrongfully repeated several times.
!
! TODO:Do we need test for WHERE and FORALL?
! A simple test for WHERE and FORALL is added by Zhenying Liu
!********************************************************************
INTEGER FUNCTION <ompts:testcode:functionname>omp_workshare</ompts:testcode:functionname>()
IMPLICIT NONE
INTEGER result,i
INTEGER scalar02,scalar12,scalar22,scalar32,count
REAL, DIMENSION(1000)::FF
<ompts:orphan:vars>
INTEGER scalar0,scalar1,scalar2,scalar3
INTEGER, DIMENSION(1000)::AA,BB,CC
REAL, DIMENSION(1000)::DD
COMMON /orphvars/ scalar0,scalar1,scalar2,scalar3,
& AA,BB,CC,DD
</ompts:orphan:vars>
result=0
scalar0=0
scalar02=0
scalar1=0
scalar12=0
scalar2=0
scalar22=0
scalar3=0
scalar32=0
count = 0
AA=0
BB=0
do i=1,1000
CC(i) = i
FF(i) = 1.0/i
end do
!$OMP PARALLEL
<ompts:orphan>
<ompts:check>!$OMP WORKSHARE</ompts:check>
! test if work is divided or not for array assignment
AA=AA+1
! test if scalar assignment is treated as a single unit of work
scalar0=scalar0+1
! test if atomic is treated as a single unit of work
!$OMP ATOMIC
scalar1=scalar1+1
! test if critical is treated as a single unit of work
!$OMP CRITICAL
scalar2=scalar2+1
!$OMP END CRITICAL
! test if PARALLEL is treated as a single unit of work
!$OMP PARALLEL
scalar3=scalar3+1
!$OMP END PARALLEL
WHERE ( CC .ne. 0 ) DD = 1.0/CC
FORALL (I=1:1000) CC(i) = -i
<ompts:check>!$OMP END WORKSHARE</ompts:check>
</ompts:orphan>
!$OMP END PARALLEL
!sequential equivalent statements for comparison
BB=BB+1
scalar02=scalar02+1
scalar12=scalar12+1
scalar22=scalar22+1
scalar32=scalar32+1
! write (1,*) "ck:sum of AA is",SUM(AA)," sum of BB is ",sum(BB)
if (SUM(AA)/=SUM(BB)) then
write(1,*) "Array assignment has some problem"
result=result +1
endif
if (scalar0/=scalar02) then
write(1,*) "Scalar assignment has some problem"
result = result +1
endif
if (scalar1/=scalar12) then
write(1,*) "Atomic inside WORKSHARE has some problem"
result = result +1
endif
if (scalar2/=scalar22) then
write(1,*) "CRITICAL inside WORKSHARE has some problem"
result = result +1
endif
if (scalar3/=scalar32) then
write(1,*) "PARALLEL inside WORKSHARE has some problem"
result = result +1
endif
do i=1,1000
if ( abs( DD(i)- FF(i)) .gt. 1.0E-4 ) then
count = count + 1
end if
end do
if ( count .ne. 0 ) then
result = result + 1
write(1,*) "WHERE has some problem"
end if
count = 0
do i=1,1000
if ( CC(i) .ne. -i ) then
count = count + 1
end if
end do
if ( count .ne. 0 ) then
result = result + 1
write(1,*) "FORALL has some problem"
end if
!if anything is wrong, set return value to 0
if (result==0) then
<testfunctionname></testfunctionname> = 1
else
<testfunctionname></testfunctionname> = 0
end if
end
</ompts:testcode>
</ompts:test>