1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
|
<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>
|
