143 lines
3.9 KiB
Fortran
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>
|