1 PROGRAM CCBLAT1
2 * Test program for the COMPLEX Level 1 CBLAS.
3 * Based upon the original CBLAS test routine together with:
4 * F06GAF Example Program Text
5 * .. Parameters ..
6 INTEGER NOUT
7 PARAMETER (NOUT=6)
8 * .. Scalars in Common ..
9 INTEGER ICASE, INCX, INCY, MODE, N
10 LOGICAL PASS
11 * .. Local Scalars ..
12 REAL SFAC
13 INTEGER IC
14 * .. External Subroutines ..
15 EXTERNAL CHECK1, CHECK2, HEADER
16 * .. Common blocks ..
17 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
18 * .. Data statements ..
19 DATA SFAC/9.765625E-4/
20 * .. Executable Statements ..
21 WRITE (NOUT,99999)
22 DO 20 IC = 1, 10
23 ICASE = IC
24 CALL HEADER
25 *
26 * Initialize PASS, INCX, INCY, and MODE for a new case.
27 * The value 9999 for INCX, INCY or MODE will appear in the
28 * detailed output, if any, for cases that do not involve
29 * these parameters.
30 *
31 PASS = .TRUE.
32 INCX = 9999
33 INCY = 9999
34 MODE = 9999
35 IF (ICASE.LE.5) THEN
36 CALL CHECK2(SFAC)
37 ELSE IF (ICASE.GE.6) THEN
38 CALL CHECK1(SFAC)
39 END IF
40 * -- Print
41 IF (PASS) WRITE (NOUT,99998)
42 20 CONTINUE
43 STOP
44 *
45 99999 FORMAT (' Complex CBLAS Test Program Results',/1X)
46 99998 FORMAT (' ----- PASS -----')
47 END
48 SUBROUTINE HEADER
49 * .. Parameters ..
50 INTEGER NOUT
51 PARAMETER (NOUT=6)
52 * .. Scalars in Common ..
53 INTEGER ICASE, INCX, INCY, MODE, N
54 LOGICAL PASS
55 * .. Local Arrays ..
56 CHARACTER*15 L(10)
57 * .. Common blocks ..
58 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
59 * .. Data statements ..
60 DATA L(1)/'CBLAS_CDOTC'/
61 DATA L(2)/'CBLAS_CDOTU'/
62 DATA L(3)/'CBLAS_CAXPY'/
63 DATA L(4)/'CBLAS_CCOPY'/
64 DATA L(5)/'CBLAS_CSWAP'/
65 DATA L(6)/'CBLAS_SCNRM2'/
66 DATA L(7)/'CBLAS_SCASUM'/
67 DATA L(8)/'CBLAS_CSCAL'/
68 DATA L(9)/'CBLAS_CSSCAL'/
69 DATA L(10)/'CBLAS_ICAMAX'/
70 * .. Executable Statements ..
71 WRITE (NOUT,99999) ICASE, L(ICASE)
72 RETURN
73 *
74 99999 FORMAT (/' Test of subprogram number',I3,9X,A15)
75 END
76 SUBROUTINE CHECK1(SFAC)
77 * .. Parameters ..
78 INTEGER NOUT
79 PARAMETER (NOUT=6)
80 * .. Scalar Arguments ..
81 REAL SFAC
82 * .. Scalars in Common ..
83 INTEGER ICASE, INCX, INCY, MODE, N
84 LOGICAL PASS
85 * .. Local Scalars ..
86 COMPLEX CA
87 REAL SA
88 INTEGER I, J, LEN, NP1
89 * .. Local Arrays ..
90 COMPLEX CTRUE5(8,5,2), CTRUE6(8,5,2), CV(8,5,2), CX(8),
91 + MWPCS(5), MWPCT(5)
92 REAL STRUE2(5), STRUE4(5)
93 INTEGER ITRUE3(5)
94 * .. External Functions ..
95 REAL SCASUMTEST, SCNRM2TEST
96 INTEGER ICAMAXTEST
97 EXTERNAL SCASUMTEST, SCNRM2TEST, ICAMAXTEST
98 * .. External Subroutines ..
99 EXTERNAL CSCAL, CSSCALTEST, CTEST, ITEST1, STEST1
100 * .. Intrinsic Functions ..
101 INTRINSIC MAX
102 * .. Common blocks ..
103 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
104 * .. Data statements ..
105 DATA SA, CA/0.3E0, (0.4E0,-0.7E0)/
106 DATA ((CV(I,J,1),I=1,8),J=1,5)/(0.1E0,0.1E0),
107 + (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0),
108 + (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0),
109 + (1.0E0,2.0E0), (0.3E0,-0.4E0), (3.0E0,4.0E0),
110 + (3.0E0,4.0E0), (3.0E0,4.0E0), (3.0E0,4.0E0),
111 + (3.0E0,4.0E0), (3.0E0,4.0E0), (3.0E0,4.0E0),
112 + (0.1E0,-0.3E0), (0.5E0,-0.1E0), (5.0E0,6.0E0),
113 + (5.0E0,6.0E0), (5.0E0,6.0E0), (5.0E0,6.0E0),
114 + (5.0E0,6.0E0), (5.0E0,6.0E0), (0.1E0,0.1E0),
115 + (-0.6E0,0.1E0), (0.1E0,-0.3E0), (7.0E0,8.0E0),
116 + (7.0E0,8.0E0), (7.0E0,8.0E0), (7.0E0,8.0E0),
117 + (7.0E0,8.0E0), (0.3E0,0.1E0), (0.1E0,0.4E0),
118 + (0.4E0,0.1E0), (0.1E0,0.2E0), (2.0E0,3.0E0),
119 + (2.0E0,3.0E0), (2.0E0,3.0E0), (2.0E0,3.0E0)/
120 DATA ((CV(I,J,2),I=1,8),J=1,5)/(0.1E0,0.1E0),
121 + (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0),
122 + (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0),
123 + (4.0E0,5.0E0), (0.3E0,-0.4E0), (6.0E0,7.0E0),
124 + (6.0E0,7.0E0), (6.0E0,7.0E0), (6.0E0,7.0E0),
125 + (6.0E0,7.0E0), (6.0E0,7.0E0), (6.0E0,7.0E0),
126 + (0.1E0,-0.3E0), (8.0E0,9.0E0), (0.5E0,-0.1E0),
127 + (2.0E0,5.0E0), (2.0E0,5.0E0), (2.0E0,5.0E0),
128 + (2.0E0,5.0E0), (2.0E0,5.0E0), (0.1E0,0.1E0),
129 + (3.0E0,6.0E0), (-0.6E0,0.1E0), (4.0E0,7.0E0),
130 + (0.1E0,-0.3E0), (7.0E0,2.0E0), (7.0E0,2.0E0),
131 + (7.0E0,2.0E0), (0.3E0,0.1E0), (5.0E0,8.0E0),
132 + (0.1E0,0.4E0), (6.0E0,9.0E0), (0.4E0,0.1E0),
133 + (8.0E0,3.0E0), (0.1E0,0.2E0), (9.0E0,4.0E0)/
134 DATA STRUE2/0.0E0, 0.5E0, 0.6E0, 0.7E0, 0.7E0/
135 DATA STRUE4/0.0E0, 0.7E0, 1.0E0, 1.3E0, 1.7E0/
136 DATA ((CTRUE5(I,J,1),I=1,8),J=1,5)/(0.1E0,0.1E0),
137 + (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0),
138 + (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0),
139 + (1.0E0,2.0E0), (-0.16E0,-0.37E0), (3.0E0,4.0E0),
140 + (3.0E0,4.0E0), (3.0E0,4.0E0), (3.0E0,4.0E0),
141 + (3.0E0,4.0E0), (3.0E0,4.0E0), (3.0E0,4.0E0),
142 + (-0.17E0,-0.19E0), (0.13E0,-0.39E0),
143 + (5.0E0,6.0E0), (5.0E0,6.0E0), (5.0E0,6.0E0),
144 + (5.0E0,6.0E0), (5.0E0,6.0E0), (5.0E0,6.0E0),
145 + (0.11E0,-0.03E0), (-0.17E0,0.46E0),
146 + (-0.17E0,-0.19E0), (7.0E0,8.0E0), (7.0E0,8.0E0),
147 + (7.0E0,8.0E0), (7.0E0,8.0E0), (7.0E0,8.0E0),
148 + (0.19E0,-0.17E0), (0.32E0,0.09E0),
149 + (0.23E0,-0.24E0), (0.18E0,0.01E0),
150 + (2.0E0,3.0E0), (2.0E0,3.0E0), (2.0E0,3.0E0),
151 + (2.0E0,3.0E0)/
152 DATA ((CTRUE5(I,J,2),I=1,8),J=1,5)/(0.1E0,0.1E0),
153 + (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0),
154 + (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0),
155 + (4.0E0,5.0E0), (-0.16E0,-0.37E0), (6.0E0,7.0E0),
156 + (6.0E0,7.0E0), (6.0E0,7.0E0), (6.0E0,7.0E0),
157 + (6.0E0,7.0E0), (6.0E0,7.0E0), (6.0E0,7.0E0),
158 + (-0.17E0,-0.19E0), (8.0E0,9.0E0),
159 + (0.13E0,-0.39E0), (2.0E0,5.0E0), (2.0E0,5.0E0),
160 + (2.0E0,5.0E0), (2.0E0,5.0E0), (2.0E0,5.0E0),
161 + (0.11E0,-0.03E0), (3.0E0,6.0E0),
162 + (-0.17E0,0.46E0), (4.0E0,7.0E0),
163 + (-0.17E0,-0.19E0), (7.0E0,2.0E0), (7.0E0,2.0E0),
164 + (7.0E0,2.0E0), (0.19E0,-0.17E0), (5.0E0,8.0E0),
165 + (0.32E0,0.09E0), (6.0E0,9.0E0),
166 + (0.23E0,-0.24E0), (8.0E0,3.0E0),
167 + (0.18E0,0.01E0), (9.0E0,4.0E0)/
168 DATA ((CTRUE6(I,J,1),I=1,8),J=1,5)/(0.1E0,0.1E0),
169 + (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0),
170 + (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0),
171 + (1.0E0,2.0E0), (0.09E0,-0.12E0), (3.0E0,4.0E0),
172 + (3.0E0,4.0E0), (3.0E0,4.0E0), (3.0E0,4.0E0),
173 + (3.0E0,4.0E0), (3.0E0,4.0E0), (3.0E0,4.0E0),
174 + (0.03E0,-0.09E0), (0.15E0,-0.03E0),
175 + (5.0E0,6.0E0), (5.0E0,6.0E0), (5.0E0,6.0E0),
176 + (5.0E0,6.0E0), (5.0E0,6.0E0), (5.0E0,6.0E0),
177 + (0.03E0,0.03E0), (-0.18E0,0.03E0),
178 + (0.03E0,-0.09E0), (7.0E0,8.0E0), (7.0E0,8.0E0),
179 + (7.0E0,8.0E0), (7.0E0,8.0E0), (7.0E0,8.0E0),
180 + (0.09E0,0.03E0), (0.03E0,0.12E0),
181 + (0.12E0,0.03E0), (0.03E0,0.06E0), (2.0E0,3.0E0),
182 + (2.0E0,3.0E0), (2.0E0,3.0E0), (2.0E0,3.0E0)/
183 DATA ((CTRUE6(I,J,2),I=1,8),J=1,5)/(0.1E0,0.1E0),
184 + (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0),
185 + (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0),
186 + (4.0E0,5.0E0), (0.09E0,-0.12E0), (6.0E0,7.0E0),
187 + (6.0E0,7.0E0), (6.0E0,7.0E0), (6.0E0,7.0E0),
188 + (6.0E0,7.0E0), (6.0E0,7.0E0), (6.0E0,7.0E0),
189 + (0.03E0,-0.09E0), (8.0E0,9.0E0),
190 + (0.15E0,-0.03E0), (2.0E0,5.0E0), (2.0E0,5.0E0),
191 + (2.0E0,5.0E0), (2.0E0,5.0E0), (2.0E0,5.0E0),
192 + (0.03E0,0.03E0), (3.0E0,6.0E0),
193 + (-0.18E0,0.03E0), (4.0E0,7.0E0),
194 + (0.03E0,-0.09E0), (7.0E0,2.0E0), (7.0E0,2.0E0),
195 + (7.0E0,2.0E0), (0.09E0,0.03E0), (5.0E0,8.0E0),
196 + (0.03E0,0.12E0), (6.0E0,9.0E0), (0.12E0,0.03E0),
197 + (8.0E0,3.0E0), (0.03E0,0.06E0), (9.0E0,4.0E0)/
198 DATA ITRUE3/0, 1, 2, 2, 2/
199 * .. Executable Statements ..
200 DO 60 INCX = 1, 2
201 DO 40 NP1 = 1, 5
202 N = NP1 - 1
203 LEN = 2*MAX(N,1)
204 * .. Set vector arguments ..
205 DO 20 I = 1, LEN
206 CX(I) = CV(I,NP1,INCX)
207 20 CONTINUE
208 IF (ICASE.EQ.6) THEN
209 * .. SCNRM2TEST ..
210 CALL STEST1(SCNRM2TEST(N,CX,INCX),STRUE2(NP1),
211 + STRUE2(NP1), SFAC)
212 ELSE IF (ICASE.EQ.7) THEN
213 * .. SCASUMTEST ..
214 CALL STEST1(SCASUMTEST(N,CX,INCX),STRUE4(NP1),
215 + STRUE4(NP1),SFAC)
216 ELSE IF (ICASE.EQ.8) THEN
217 * .. CSCAL ..
218 CALL CSCAL(N,CA,CX,INCX)
219 CALL CTEST(LEN,CX,CTRUE5(1,NP1,INCX),CTRUE5(1,NP1,INCX),
220 + SFAC)
221 ELSE IF (ICASE.EQ.9) THEN
222 * .. CSSCALTEST ..
223 CALL CSSCALTEST(N,SA,CX,INCX)
224 CALL CTEST(LEN,CX,CTRUE6(1,NP1,INCX),CTRUE6(1,NP1,INCX),
225 + SFAC)
226 ELSE IF (ICASE.EQ.10) THEN
227 * .. ICAMAXTEST ..
228 CALL ITEST1(ICAMAXTEST(N,CX,INCX),ITRUE3(NP1))
229 ELSE
230 WRITE (NOUT,*) ' Shouldn''t be here in CHECK1'
231 STOP
232 END IF
233 *
234 40 CONTINUE
235 60 CONTINUE
236 *
237 INCX = 1
238 IF (ICASE.EQ.8) THEN
239 * CSCAL
240 * Add a test for alpha equal to zero.
241 CA = (0.0E0,0.0E0)
242 DO 80 I = 1, 5
243 MWPCT(I) = (0.0E0,0.0E0)
244 MWPCS(I) = (1.0E0,1.0E0)
245 80 CONTINUE
246 CALL CSCAL(5,CA,CX,INCX)
247 CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
248 ELSE IF (ICASE.EQ.9) THEN
249 * CSSCALTEST
250 * Add a test for alpha equal to zero.
251 SA = 0.0E0
252 DO 100 I = 1, 5
253 MWPCT(I) = (0.0E0,0.0E0)
254 MWPCS(I) = (1.0E0,1.0E0)
255 100 CONTINUE
256 CALL CSSCALTEST(5,SA,CX,INCX)
257 CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
258 * Add a test for alpha equal to one.
259 SA = 1.0E0
260 DO 120 I = 1, 5
261 MWPCT(I) = CX(I)
262 MWPCS(I) = CX(I)
263 120 CONTINUE
264 CALL CSSCALTEST(5,SA,CX,INCX)
265 CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
266 * Add a test for alpha equal to minus one.
267 SA = -1.0E0
268 DO 140 I = 1, 5
269 MWPCT(I) = -CX(I)
270 MWPCS(I) = -CX(I)
271 140 CONTINUE
272 CALL CSSCALTEST(5,SA,CX,INCX)
273 CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
274 END IF
275 RETURN
276 END
277 SUBROUTINE CHECK2(SFAC)
278 * .. Parameters ..
279 INTEGER NOUT
280 PARAMETER (NOUT=6)
281 * .. Scalar Arguments ..
282 REAL SFAC
283 * .. Scalars in Common ..
284 INTEGER ICASE, INCX, INCY, MODE, N
285 LOGICAL PASS
286 * .. Local Scalars ..
287 COMPLEX CA,CTEMP
288 INTEGER I, J, KI, KN, KSIZE, LENX, LENY, MX, MY
289 * .. Local Arrays ..
290 COMPLEX CDOT(1), CSIZE1(4), CSIZE2(7,2), CSIZE3(14),
291 + CT10X(7,4,4), CT10Y(7,4,4), CT6(4,4), CT7(4,4),
292 + CT8(7,4,4), CX(7), CX1(7), CY(7), CY1(7)
293 INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4)
294 * .. External Functions ..
295 EXTERNAL CDOTCTEST, CDOTUTEST
296 * .. External Subroutines ..
297 EXTERNAL CAXPYTEST, CCOPYTEST, CSWAPTEST, CTEST
298 * .. Intrinsic Functions ..
299 INTRINSIC ABS, MIN
300 * .. Common blocks ..
301 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
302 * .. Data statements ..
303 DATA CA/(0.4E0,-0.7E0)/
304 DATA INCXS/1, 2, -2, -1/
305 DATA INCYS/1, -2, 1, -2/
306 DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/
307 DATA NS/0, 1, 2, 4/
308 DATA CX1/(0.7E0,-0.8E0), (-0.4E0,-0.7E0),
309 + (-0.1E0,-0.9E0), (0.2E0,-0.8E0),
310 + (-0.9E0,-0.4E0), (0.1E0,0.4E0), (-0.6E0,0.6E0)/
311 DATA CY1/(0.6E0,-0.6E0), (-0.9E0,0.5E0),
312 + (0.7E0,-0.6E0), (0.1E0,-0.5E0), (-0.1E0,-0.2E0),
313 + (-0.5E0,-0.3E0), (0.8E0,-0.7E0)/
314 DATA ((CT8(I,J,1),I=1,7),J=1,4)/(0.6E0,-0.6E0),
315 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
316 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
317 + (0.32E0,-1.41E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
318 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
319 + (0.0E0,0.0E0), (0.32E0,-1.41E0),
320 + (-1.55E0,0.5E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
321 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
322 + (0.32E0,-1.41E0), (-1.55E0,0.5E0),
323 + (0.03E0,-0.89E0), (-0.38E0,-0.96E0),
324 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/
325 DATA ((CT8(I,J,2),I=1,7),J=1,4)/(0.6E0,-0.6E0),
326 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
327 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
328 + (0.32E0,-1.41E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
329 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
330 + (0.0E0,0.0E0), (-0.07E0,-0.89E0),
331 + (-0.9E0,0.5E0), (0.42E0,-1.41E0), (0.0E0,0.0E0),
332 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
333 + (0.78E0,0.06E0), (-0.9E0,0.5E0),
334 + (0.06E0,-0.13E0), (0.1E0,-0.5E0),
335 + (-0.77E0,-0.49E0), (-0.5E0,-0.3E0),
336 + (0.52E0,-1.51E0)/
337 DATA ((CT8(I,J,3),I=1,7),J=1,4)/(0.6E0,-0.6E0),
338 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
339 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
340 + (0.32E0,-1.41E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
341 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
342 + (0.0E0,0.0E0), (-0.07E0,-0.89E0),
343 + (-1.18E0,-0.31E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
344 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
345 + (0.78E0,0.06E0), (-1.54E0,0.97E0),
346 + (0.03E0,-0.89E0), (-0.18E0,-1.31E0),
347 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/
348 DATA ((CT8(I,J,4),I=1,7),J=1,4)/(0.6E0,-0.6E0),
349 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
350 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
351 + (0.32E0,-1.41E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
352 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
353 + (0.0E0,0.0E0), (0.32E0,-1.41E0), (-0.9E0,0.5E0),
354 + (0.05E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
355 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.32E0,-1.41E0),
356 + (-0.9E0,0.5E0), (0.05E0,-0.6E0), (0.1E0,-0.5E0),
357 + (-0.77E0,-0.49E0), (-0.5E0,-0.3E0),
358 + (0.32E0,-1.16E0)/
359 DATA CT7/(0.0E0,0.0E0), (-0.06E0,-0.90E0),
360 + (0.65E0,-0.47E0), (-0.34E0,-1.22E0),
361 + (0.0E0,0.0E0), (-0.06E0,-0.90E0),
362 + (-0.59E0,-1.46E0), (-1.04E0,-0.04E0),
363 + (0.0E0,0.0E0), (-0.06E0,-0.90E0),
364 + (-0.83E0,0.59E0), (0.07E0,-0.37E0),
365 + (0.0E0,0.0E0), (-0.06E0,-0.90E0),
366 + (-0.76E0,-1.15E0), (-1.33E0,-1.82E0)/
367 DATA CT6/(0.0E0,0.0E0), (0.90E0,0.06E0),
368 + (0.91E0,-0.77E0), (1.80E0,-0.10E0),
369 + (0.0E0,0.0E0), (0.90E0,0.06E0), (1.45E0,0.74E0),
370 + (0.20E0,0.90E0), (0.0E0,0.0E0), (0.90E0,0.06E0),
371 + (-0.55E0,0.23E0), (0.83E0,-0.39E0),
372 + (0.0E0,0.0E0), (0.90E0,0.06E0), (1.04E0,0.79E0),
373 + (1.95E0,1.22E0)/
374 DATA ((CT10X(I,J,1),I=1,7),J=1,4)/(0.7E0,-0.8E0),
375 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
376 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
377 + (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
378 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
379 + (0.0E0,0.0E0), (0.6E0,-0.6E0), (-0.9E0,0.5E0),
380 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
381 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.6E0,-0.6E0),
382 + (-0.9E0,0.5E0), (0.7E0,-0.6E0), (0.1E0,-0.5E0),
383 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/
384 DATA ((CT10X(I,J,2),I=1,7),J=1,4)/(0.7E0,-0.8E0),
385 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
386 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
387 + (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
388 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
389 + (0.0E0,0.0E0), (0.7E0,-0.6E0), (-0.4E0,-0.7E0),
390 + (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
391 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.8E0,-0.7E0),
392 + (-0.4E0,-0.7E0), (-0.1E0,-0.2E0),
393 + (0.2E0,-0.8E0), (0.7E0,-0.6E0), (0.1E0,0.4E0),
394 + (0.6E0,-0.6E0)/
395 DATA ((CT10X(I,J,3),I=1,7),J=1,4)/(0.7E0,-0.8E0),
396 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
397 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
398 + (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
399 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
400 + (0.0E0,0.0E0), (-0.9E0,0.5E0), (-0.4E0,-0.7E0),
401 + (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
402 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.1E0,-0.5E0),
403 + (-0.4E0,-0.7E0), (0.7E0,-0.6E0), (0.2E0,-0.8E0),
404 + (-0.9E0,0.5E0), (0.1E0,0.4E0), (0.6E0,-0.6E0)/
405 DATA ((CT10X(I,J,4),I=1,7),J=1,4)/(0.7E0,-0.8E0),
406 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
407 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
408 + (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
409 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
410 + (0.0E0,0.0E0), (0.6E0,-0.6E0), (0.7E0,-0.6E0),
411 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
412 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.6E0,-0.6E0),
413 + (0.7E0,-0.6E0), (-0.1E0,-0.2E0), (0.8E0,-0.7E0),
414 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/
415 DATA ((CT10Y(I,J,1),I=1,7),J=1,4)/(0.6E0,-0.6E0),
416 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
417 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
418 + (0.7E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
419 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
420 + (0.0E0,0.0E0), (0.7E0,-0.8E0), (-0.4E0,-0.7E0),
421 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
422 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.7E0,-0.8E0),
423 + (-0.4E0,-0.7E0), (-0.1E0,-0.9E0),
424 + (0.2E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
425 + (0.0E0,0.0E0)/
426 DATA ((CT10Y(I,J,2),I=1,7),J=1,4)/(0.6E0,-0.6E0),
427 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
428 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
429 + (0.7E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
430 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
431 + (0.0E0,0.0E0), (-0.1E0,-0.9E0), (-0.9E0,0.5E0),
432 + (0.7E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
433 + (0.0E0,0.0E0), (0.0E0,0.0E0), (-0.6E0,0.6E0),
434 + (-0.9E0,0.5E0), (-0.9E0,-0.4E0), (0.1E0,-0.5E0),
435 + (-0.1E0,-0.9E0), (-0.5E0,-0.3E0),
436 + (0.7E0,-0.8E0)/
437 DATA ((CT10Y(I,J,3),I=1,7),J=1,4)/(0.6E0,-0.6E0),
438 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
439 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
440 + (0.7E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
441 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
442 + (0.0E0,0.0E0), (-0.1E0,-0.9E0), (0.7E0,-0.8E0),
443 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
444 + (0.0E0,0.0E0), (0.0E0,0.0E0), (-0.6E0,0.6E0),
445 + (-0.9E0,-0.4E0), (-0.1E0,-0.9E0),
446 + (0.7E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
447 + (0.0E0,0.0E0)/
448 DATA ((CT10Y(I,J,4),I=1,7),J=1,4)/(0.6E0,-0.6E0),
449 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
450 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
451 + (0.7E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
452 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
453 + (0.0E0,0.0E0), (0.7E0,-0.8E0), (-0.9E0,0.5E0),
454 + (-0.4E0,-0.7E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
455 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.7E0,-0.8E0),
456 + (-0.9E0,0.5E0), (-0.4E0,-0.7E0), (0.1E0,-0.5E0),
457 + (-0.1E0,-0.9E0), (-0.5E0,-0.3E0),
458 + (0.2E0,-0.8E0)/
459 DATA CSIZE1/(0.0E0,0.0E0), (0.9E0,0.9E0),
460 + (1.63E0,1.73E0), (2.90E0,2.78E0)/
461 DATA CSIZE3/(0.0E0,0.0E0), (0.0E0,0.0E0),
462 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
463 + (0.0E0,0.0E0), (0.0E0,0.0E0), (1.17E0,1.17E0),
464 + (1.17E0,1.17E0), (1.17E0,1.17E0),
465 + (1.17E0,1.17E0), (1.17E0,1.17E0),
466 + (1.17E0,1.17E0), (1.17E0,1.17E0)/
467 DATA CSIZE2/(0.0E0,0.0E0), (0.0E0,0.0E0),
468 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
469 + (0.0E0,0.0E0), (0.0E0,0.0E0), (1.54E0,1.54E0),
470 + (1.54E0,1.54E0), (1.54E0,1.54E0),
471 + (1.54E0,1.54E0), (1.54E0,1.54E0),
472 + (1.54E0,1.54E0), (1.54E0,1.54E0)/
473 * .. Executable Statements ..
474 DO 60 KI = 1, 4
475 INCX = INCXS(KI)
476 INCY = INCYS(KI)
477 MX = ABS(INCX)
478 MY = ABS(INCY)
479 *
480 DO 40 KN = 1, 4
481 N = NS(KN)
482 KSIZE = MIN(2,KN)
483 LENX = LENS(KN,MX)
484 LENY = LENS(KN,MY)
485 * .. initialize all argument arrays ..
486 DO 20 I = 1, 7
487 CX(I) = CX1(I)
488 CY(I) = CY1(I)
489 20 CONTINUE
490 IF (ICASE.EQ.1) THEN
491 * .. CDOTCTEST ..
492 CALL CDOTCTEST(N,CX,INCX,CY,INCY,CTEMP)
493 CDOT(1) = CTEMP
494 CALL CTEST(1,CDOT,CT6(KN,KI),CSIZE1(KN),SFAC)
495 ELSE IF (ICASE.EQ.2) THEN
496 * .. CDOTUTEST ..
497 CALL CDOTUTEST(N,CX,INCX,CY,INCY,CTEMP)
498 CDOT(1) = CTEMP
499 CALL CTEST(1,CDOT,CT7(KN,KI),CSIZE1(KN),SFAC)
500 ELSE IF (ICASE.EQ.3) THEN
501 * .. CAXPYTEST ..
502 CALL CAXPYTEST(N,CA,CX,INCX,CY,INCY)
503 CALL CTEST(LENY,CY,CT8(1,KN,KI),CSIZE2(1,KSIZE),SFAC)
504 ELSE IF (ICASE.EQ.4) THEN
505 * .. CCOPYTEST ..
506 CALL CCOPYTEST(N,CX,INCX,CY,INCY)
507 CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0E0)
508 ELSE IF (ICASE.EQ.5) THEN
509 * .. CSWAPTEST ..
510 CALL CSWAPTEST(N,CX,INCX,CY,INCY)
511 CALL CTEST(LENX,CX,CT10X(1,KN,KI),CSIZE3,1.0E0)
512 CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0E0)
513 ELSE
514 WRITE (NOUT,*) ' Shouldn''t be here in CHECK2'
515 STOP
516 END IF
517 *
518 40 CONTINUE
519 60 CONTINUE
520 RETURN
521 END
522 SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC)
523 * ********************************* STEST **************************
524 *
525 * THIS SUBR COMPARES ARRAYS SCOMP() AND STRUE() OF LENGTH LEN TO
526 * SEE IF THE TERM BY TERM DIFFERENCES, MULTIPLIED BY SFAC, ARE
527 * NEGLIGIBLE.
528 *
529 * C. L. LAWSON, JPL, 1974 DEC 10
530 *
531 * .. Parameters ..
532 INTEGER NOUT
533 PARAMETER (NOUT=6)
534 * .. Scalar Arguments ..
535 REAL SFAC
536 INTEGER LEN
537 * .. Array Arguments ..
538 REAL SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
539 * .. Scalars in Common ..
540 INTEGER ICASE, INCX, INCY, MODE, N
541 LOGICAL PASS
542 * .. Local Scalars ..
543 REAL SD
544 INTEGER I
545 * .. External Functions ..
546 REAL SDIFF
547 EXTERNAL SDIFF
548 * .. Intrinsic Functions ..
549 INTRINSIC ABS
550 * .. Common blocks ..
551 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
552 * .. Executable Statements ..
553 *
554 DO 40 I = 1, LEN
555 SD = SCOMP(I) - STRUE(I)
556 IF (SDIFF(ABS(SSIZE(I))+ABS(SFAC*SD),ABS(SSIZE(I))).EQ.0.0E0)
557 + GO TO 40
558 *
559 * HERE SCOMP(I) IS NOT CLOSE TO STRUE(I).
560 *
561 IF ( .NOT. PASS) GO TO 20
562 * PRINT FAIL MESSAGE AND HEADER.
563 PASS = .FALSE.
564 WRITE (NOUT,99999)
565 WRITE (NOUT,99998)
566 20 WRITE (NOUT,99997) ICASE, N, INCX, INCY, MODE, I, SCOMP(I),
567 + STRUE(I), SD, SSIZE(I)
568 40 CONTINUE
569 RETURN
570 *
571 99999 FORMAT (' FAIL')
572 99998 FORMAT (/' CASE N INCX INCY MODE I ',
573 + ' COMP(I) TRUE(I) DIFFERENCE',
574 + ' SIZE(I)',/1X)
575 99997 FORMAT (1X,I4,I3,3I5,I3,2E36.8,2E12.4)
576 END
577 SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC)
578 * ************************* STEST1 *****************************
579 *
580 * THIS IS AN INTERFACE SUBROUTINE TO ACCOMODATE THE FORTRAN
581 * REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE
582 * ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT.
583 *
584 * C.L. LAWSON, JPL, 1978 DEC 6
585 *
586 * .. Scalar Arguments ..
587 REAL SCOMP1, SFAC, STRUE1
588 * .. Array Arguments ..
589 REAL SSIZE(*)
590 * .. Local Arrays ..
591 REAL SCOMP(1), STRUE(1)
592 * .. External Subroutines ..
593 EXTERNAL STEST
594 * .. Executable Statements ..
595 *
596 SCOMP(1) = SCOMP1
597 STRUE(1) = STRUE1
598 CALL STEST(1,SCOMP,STRUE,SSIZE,SFAC)
599 *
600 RETURN
601 END
602 REAL FUNCTION SDIFF(SA,SB)
603 * ********************************* SDIFF **************************
604 * COMPUTES DIFFERENCE OF TWO NUMBERS. C. L. LAWSON, JPL 1974 FEB 15
605 *
606 * .. Scalar Arguments ..
607 REAL SA, SB
608 * .. Executable Statements ..
609 SDIFF = SA - SB
610 RETURN
611 END
612 SUBROUTINE CTEST(LEN,CCOMP,CTRUE,CSIZE,SFAC)
613 * **************************** CTEST *****************************
614 *
615 * C.L. LAWSON, JPL, 1978 DEC 6
616 *
617 * .. Scalar Arguments ..
618 REAL SFAC
619 INTEGER LEN
620 * .. Array Arguments ..
621 COMPLEX CCOMP(LEN), CSIZE(LEN), CTRUE(LEN)
622 * .. Local Scalars ..
623 INTEGER I
624 * .. Local Arrays ..
625 REAL SCOMP(20), SSIZE(20), STRUE(20)
626 * .. External Subroutines ..
627 EXTERNAL STEST
628 * .. Intrinsic Functions ..
629 INTRINSIC AIMAG, REAL
630 * .. Executable Statements ..
631 DO 20 I = 1, LEN
632 SCOMP(2*I-1) = REAL(CCOMP(I))
633 SCOMP(2*I) = AIMAG(CCOMP(I))
634 STRUE(2*I-1) = REAL(CTRUE(I))
635 STRUE(2*I) = AIMAG(CTRUE(I))
636 SSIZE(2*I-1) = REAL(CSIZE(I))
637 SSIZE(2*I) = AIMAG(CSIZE(I))
638 20 CONTINUE
639 *
640 CALL STEST(2*LEN,SCOMP,STRUE,SSIZE,SFAC)
641 RETURN
642 END
643 SUBROUTINE ITEST1(ICOMP,ITRUE)
644 * ********************************* ITEST1 *************************
645 *
646 * THIS SUBROUTINE COMPARES THE VARIABLES ICOMP AND ITRUE FOR
647 * EQUALITY.
648 * C. L. LAWSON, JPL, 1974 DEC 10
649 *
650 * .. Parameters ..
651 INTEGER NOUT
652 PARAMETER (NOUT=6)
653 * .. Scalar Arguments ..
654 INTEGER ICOMP, ITRUE
655 * .. Scalars in Common ..
656 INTEGER ICASE, INCX, INCY, MODE, N
657 LOGICAL PASS
658 * .. Local Scalars ..
659 INTEGER ID
660 * .. Common blocks ..
661 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
662 * .. Executable Statements ..
663 IF (ICOMP.EQ.ITRUE) GO TO 40
664 *
665 * HERE ICOMP IS NOT EQUAL TO ITRUE.
666 *
667 IF ( .NOT. PASS) GO TO 20
668 * PRINT FAIL MESSAGE AND HEADER.
669 PASS = .FALSE.
670 WRITE (NOUT,99999)
671 WRITE (NOUT,99998)
672 20 ID = ICOMP - ITRUE
673 WRITE (NOUT,99997) ICASE, N, INCX, INCY, MODE, ICOMP, ITRUE, ID
674 40 CONTINUE
675 RETURN
676 *
677 99999 FORMAT (' FAIL')
678 99998 FORMAT (/' CASE N INCX INCY MODE ',
679 + ' COMP TRUE DIFFERENCE',
680 + /1X)
681 99997 FORMAT (1X,I4,I3,3I5,2I36,I12)
682 END
2 * Test program for the COMPLEX Level 1 CBLAS.
3 * Based upon the original CBLAS test routine together with:
4 * F06GAF Example Program Text
5 * .. Parameters ..
6 INTEGER NOUT
7 PARAMETER (NOUT=6)
8 * .. Scalars in Common ..
9 INTEGER ICASE, INCX, INCY, MODE, N
10 LOGICAL PASS
11 * .. Local Scalars ..
12 REAL SFAC
13 INTEGER IC
14 * .. External Subroutines ..
15 EXTERNAL CHECK1, CHECK2, HEADER
16 * .. Common blocks ..
17 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
18 * .. Data statements ..
19 DATA SFAC/9.765625E-4/
20 * .. Executable Statements ..
21 WRITE (NOUT,99999)
22 DO 20 IC = 1, 10
23 ICASE = IC
24 CALL HEADER
25 *
26 * Initialize PASS, INCX, INCY, and MODE for a new case.
27 * The value 9999 for INCX, INCY or MODE will appear in the
28 * detailed output, if any, for cases that do not involve
29 * these parameters.
30 *
31 PASS = .TRUE.
32 INCX = 9999
33 INCY = 9999
34 MODE = 9999
35 IF (ICASE.LE.5) THEN
36 CALL CHECK2(SFAC)
37 ELSE IF (ICASE.GE.6) THEN
38 CALL CHECK1(SFAC)
39 END IF
40 * -- Print
41 IF (PASS) WRITE (NOUT,99998)
42 20 CONTINUE
43 STOP
44 *
45 99999 FORMAT (' Complex CBLAS Test Program Results',/1X)
46 99998 FORMAT (' ----- PASS -----')
47 END
48 SUBROUTINE HEADER
49 * .. Parameters ..
50 INTEGER NOUT
51 PARAMETER (NOUT=6)
52 * .. Scalars in Common ..
53 INTEGER ICASE, INCX, INCY, MODE, N
54 LOGICAL PASS
55 * .. Local Arrays ..
56 CHARACTER*15 L(10)
57 * .. Common blocks ..
58 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
59 * .. Data statements ..
60 DATA L(1)/'CBLAS_CDOTC'/
61 DATA L(2)/'CBLAS_CDOTU'/
62 DATA L(3)/'CBLAS_CAXPY'/
63 DATA L(4)/'CBLAS_CCOPY'/
64 DATA L(5)/'CBLAS_CSWAP'/
65 DATA L(6)/'CBLAS_SCNRM2'/
66 DATA L(7)/'CBLAS_SCASUM'/
67 DATA L(8)/'CBLAS_CSCAL'/
68 DATA L(9)/'CBLAS_CSSCAL'/
69 DATA L(10)/'CBLAS_ICAMAX'/
70 * .. Executable Statements ..
71 WRITE (NOUT,99999) ICASE, L(ICASE)
72 RETURN
73 *
74 99999 FORMAT (/' Test of subprogram number',I3,9X,A15)
75 END
76 SUBROUTINE CHECK1(SFAC)
77 * .. Parameters ..
78 INTEGER NOUT
79 PARAMETER (NOUT=6)
80 * .. Scalar Arguments ..
81 REAL SFAC
82 * .. Scalars in Common ..
83 INTEGER ICASE, INCX, INCY, MODE, N
84 LOGICAL PASS
85 * .. Local Scalars ..
86 COMPLEX CA
87 REAL SA
88 INTEGER I, J, LEN, NP1
89 * .. Local Arrays ..
90 COMPLEX CTRUE5(8,5,2), CTRUE6(8,5,2), CV(8,5,2), CX(8),
91 + MWPCS(5), MWPCT(5)
92 REAL STRUE2(5), STRUE4(5)
93 INTEGER ITRUE3(5)
94 * .. External Functions ..
95 REAL SCASUMTEST, SCNRM2TEST
96 INTEGER ICAMAXTEST
97 EXTERNAL SCASUMTEST, SCNRM2TEST, ICAMAXTEST
98 * .. External Subroutines ..
99 EXTERNAL CSCAL, CSSCALTEST, CTEST, ITEST1, STEST1
100 * .. Intrinsic Functions ..
101 INTRINSIC MAX
102 * .. Common blocks ..
103 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
104 * .. Data statements ..
105 DATA SA, CA/0.3E0, (0.4E0,-0.7E0)/
106 DATA ((CV(I,J,1),I=1,8),J=1,5)/(0.1E0,0.1E0),
107 + (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0),
108 + (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0),
109 + (1.0E0,2.0E0), (0.3E0,-0.4E0), (3.0E0,4.0E0),
110 + (3.0E0,4.0E0), (3.0E0,4.0E0), (3.0E0,4.0E0),
111 + (3.0E0,4.0E0), (3.0E0,4.0E0), (3.0E0,4.0E0),
112 + (0.1E0,-0.3E0), (0.5E0,-0.1E0), (5.0E0,6.0E0),
113 + (5.0E0,6.0E0), (5.0E0,6.0E0), (5.0E0,6.0E0),
114 + (5.0E0,6.0E0), (5.0E0,6.0E0), (0.1E0,0.1E0),
115 + (-0.6E0,0.1E0), (0.1E0,-0.3E0), (7.0E0,8.0E0),
116 + (7.0E0,8.0E0), (7.0E0,8.0E0), (7.0E0,8.0E0),
117 + (7.0E0,8.0E0), (0.3E0,0.1E0), (0.1E0,0.4E0),
118 + (0.4E0,0.1E0), (0.1E0,0.2E0), (2.0E0,3.0E0),
119 + (2.0E0,3.0E0), (2.0E0,3.0E0), (2.0E0,3.0E0)/
120 DATA ((CV(I,J,2),I=1,8),J=1,5)/(0.1E0,0.1E0),
121 + (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0),
122 + (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0),
123 + (4.0E0,5.0E0), (0.3E0,-0.4E0), (6.0E0,7.0E0),
124 + (6.0E0,7.0E0), (6.0E0,7.0E0), (6.0E0,7.0E0),
125 + (6.0E0,7.0E0), (6.0E0,7.0E0), (6.0E0,7.0E0),
126 + (0.1E0,-0.3E0), (8.0E0,9.0E0), (0.5E0,-0.1E0),
127 + (2.0E0,5.0E0), (2.0E0,5.0E0), (2.0E0,5.0E0),
128 + (2.0E0,5.0E0), (2.0E0,5.0E0), (0.1E0,0.1E0),
129 + (3.0E0,6.0E0), (-0.6E0,0.1E0), (4.0E0,7.0E0),
130 + (0.1E0,-0.3E0), (7.0E0,2.0E0), (7.0E0,2.0E0),
131 + (7.0E0,2.0E0), (0.3E0,0.1E0), (5.0E0,8.0E0),
132 + (0.1E0,0.4E0), (6.0E0,9.0E0), (0.4E0,0.1E0),
133 + (8.0E0,3.0E0), (0.1E0,0.2E0), (9.0E0,4.0E0)/
134 DATA STRUE2/0.0E0, 0.5E0, 0.6E0, 0.7E0, 0.7E0/
135 DATA STRUE4/0.0E0, 0.7E0, 1.0E0, 1.3E0, 1.7E0/
136 DATA ((CTRUE5(I,J,1),I=1,8),J=1,5)/(0.1E0,0.1E0),
137 + (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0),
138 + (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0),
139 + (1.0E0,2.0E0), (-0.16E0,-0.37E0), (3.0E0,4.0E0),
140 + (3.0E0,4.0E0), (3.0E0,4.0E0), (3.0E0,4.0E0),
141 + (3.0E0,4.0E0), (3.0E0,4.0E0), (3.0E0,4.0E0),
142 + (-0.17E0,-0.19E0), (0.13E0,-0.39E0),
143 + (5.0E0,6.0E0), (5.0E0,6.0E0), (5.0E0,6.0E0),
144 + (5.0E0,6.0E0), (5.0E0,6.0E0), (5.0E0,6.0E0),
145 + (0.11E0,-0.03E0), (-0.17E0,0.46E0),
146 + (-0.17E0,-0.19E0), (7.0E0,8.0E0), (7.0E0,8.0E0),
147 + (7.0E0,8.0E0), (7.0E0,8.0E0), (7.0E0,8.0E0),
148 + (0.19E0,-0.17E0), (0.32E0,0.09E0),
149 + (0.23E0,-0.24E0), (0.18E0,0.01E0),
150 + (2.0E0,3.0E0), (2.0E0,3.0E0), (2.0E0,3.0E0),
151 + (2.0E0,3.0E0)/
152 DATA ((CTRUE5(I,J,2),I=1,8),J=1,5)/(0.1E0,0.1E0),
153 + (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0),
154 + (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0),
155 + (4.0E0,5.0E0), (-0.16E0,-0.37E0), (6.0E0,7.0E0),
156 + (6.0E0,7.0E0), (6.0E0,7.0E0), (6.0E0,7.0E0),
157 + (6.0E0,7.0E0), (6.0E0,7.0E0), (6.0E0,7.0E0),
158 + (-0.17E0,-0.19E0), (8.0E0,9.0E0),
159 + (0.13E0,-0.39E0), (2.0E0,5.0E0), (2.0E0,5.0E0),
160 + (2.0E0,5.0E0), (2.0E0,5.0E0), (2.0E0,5.0E0),
161 + (0.11E0,-0.03E0), (3.0E0,6.0E0),
162 + (-0.17E0,0.46E0), (4.0E0,7.0E0),
163 + (-0.17E0,-0.19E0), (7.0E0,2.0E0), (7.0E0,2.0E0),
164 + (7.0E0,2.0E0), (0.19E0,-0.17E0), (5.0E0,8.0E0),
165 + (0.32E0,0.09E0), (6.0E0,9.0E0),
166 + (0.23E0,-0.24E0), (8.0E0,3.0E0),
167 + (0.18E0,0.01E0), (9.0E0,4.0E0)/
168 DATA ((CTRUE6(I,J,1),I=1,8),J=1,5)/(0.1E0,0.1E0),
169 + (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0),
170 + (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0),
171 + (1.0E0,2.0E0), (0.09E0,-0.12E0), (3.0E0,4.0E0),
172 + (3.0E0,4.0E0), (3.0E0,4.0E0), (3.0E0,4.0E0),
173 + (3.0E0,4.0E0), (3.0E0,4.0E0), (3.0E0,4.0E0),
174 + (0.03E0,-0.09E0), (0.15E0,-0.03E0),
175 + (5.0E0,6.0E0), (5.0E0,6.0E0), (5.0E0,6.0E0),
176 + (5.0E0,6.0E0), (5.0E0,6.0E0), (5.0E0,6.0E0),
177 + (0.03E0,0.03E0), (-0.18E0,0.03E0),
178 + (0.03E0,-0.09E0), (7.0E0,8.0E0), (7.0E0,8.0E0),
179 + (7.0E0,8.0E0), (7.0E0,8.0E0), (7.0E0,8.0E0),
180 + (0.09E0,0.03E0), (0.03E0,0.12E0),
181 + (0.12E0,0.03E0), (0.03E0,0.06E0), (2.0E0,3.0E0),
182 + (2.0E0,3.0E0), (2.0E0,3.0E0), (2.0E0,3.0E0)/
183 DATA ((CTRUE6(I,J,2),I=1,8),J=1,5)/(0.1E0,0.1E0),
184 + (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0),
185 + (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0),
186 + (4.0E0,5.0E0), (0.09E0,-0.12E0), (6.0E0,7.0E0),
187 + (6.0E0,7.0E0), (6.0E0,7.0E0), (6.0E0,7.0E0),
188 + (6.0E0,7.0E0), (6.0E0,7.0E0), (6.0E0,7.0E0),
189 + (0.03E0,-0.09E0), (8.0E0,9.0E0),
190 + (0.15E0,-0.03E0), (2.0E0,5.0E0), (2.0E0,5.0E0),
191 + (2.0E0,5.0E0), (2.0E0,5.0E0), (2.0E0,5.0E0),
192 + (0.03E0,0.03E0), (3.0E0,6.0E0),
193 + (-0.18E0,0.03E0), (4.0E0,7.0E0),
194 + (0.03E0,-0.09E0), (7.0E0,2.0E0), (7.0E0,2.0E0),
195 + (7.0E0,2.0E0), (0.09E0,0.03E0), (5.0E0,8.0E0),
196 + (0.03E0,0.12E0), (6.0E0,9.0E0), (0.12E0,0.03E0),
197 + (8.0E0,3.0E0), (0.03E0,0.06E0), (9.0E0,4.0E0)/
198 DATA ITRUE3/0, 1, 2, 2, 2/
199 * .. Executable Statements ..
200 DO 60 INCX = 1, 2
201 DO 40 NP1 = 1, 5
202 N = NP1 - 1
203 LEN = 2*MAX(N,1)
204 * .. Set vector arguments ..
205 DO 20 I = 1, LEN
206 CX(I) = CV(I,NP1,INCX)
207 20 CONTINUE
208 IF (ICASE.EQ.6) THEN
209 * .. SCNRM2TEST ..
210 CALL STEST1(SCNRM2TEST(N,CX,INCX),STRUE2(NP1),
211 + STRUE2(NP1), SFAC)
212 ELSE IF (ICASE.EQ.7) THEN
213 * .. SCASUMTEST ..
214 CALL STEST1(SCASUMTEST(N,CX,INCX),STRUE4(NP1),
215 + STRUE4(NP1),SFAC)
216 ELSE IF (ICASE.EQ.8) THEN
217 * .. CSCAL ..
218 CALL CSCAL(N,CA,CX,INCX)
219 CALL CTEST(LEN,CX,CTRUE5(1,NP1,INCX),CTRUE5(1,NP1,INCX),
220 + SFAC)
221 ELSE IF (ICASE.EQ.9) THEN
222 * .. CSSCALTEST ..
223 CALL CSSCALTEST(N,SA,CX,INCX)
224 CALL CTEST(LEN,CX,CTRUE6(1,NP1,INCX),CTRUE6(1,NP1,INCX),
225 + SFAC)
226 ELSE IF (ICASE.EQ.10) THEN
227 * .. ICAMAXTEST ..
228 CALL ITEST1(ICAMAXTEST(N,CX,INCX),ITRUE3(NP1))
229 ELSE
230 WRITE (NOUT,*) ' Shouldn''t be here in CHECK1'
231 STOP
232 END IF
233 *
234 40 CONTINUE
235 60 CONTINUE
236 *
237 INCX = 1
238 IF (ICASE.EQ.8) THEN
239 * CSCAL
240 * Add a test for alpha equal to zero.
241 CA = (0.0E0,0.0E0)
242 DO 80 I = 1, 5
243 MWPCT(I) = (0.0E0,0.0E0)
244 MWPCS(I) = (1.0E0,1.0E0)
245 80 CONTINUE
246 CALL CSCAL(5,CA,CX,INCX)
247 CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
248 ELSE IF (ICASE.EQ.9) THEN
249 * CSSCALTEST
250 * Add a test for alpha equal to zero.
251 SA = 0.0E0
252 DO 100 I = 1, 5
253 MWPCT(I) = (0.0E0,0.0E0)
254 MWPCS(I) = (1.0E0,1.0E0)
255 100 CONTINUE
256 CALL CSSCALTEST(5,SA,CX,INCX)
257 CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
258 * Add a test for alpha equal to one.
259 SA = 1.0E0
260 DO 120 I = 1, 5
261 MWPCT(I) = CX(I)
262 MWPCS(I) = CX(I)
263 120 CONTINUE
264 CALL CSSCALTEST(5,SA,CX,INCX)
265 CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
266 * Add a test for alpha equal to minus one.
267 SA = -1.0E0
268 DO 140 I = 1, 5
269 MWPCT(I) = -CX(I)
270 MWPCS(I) = -CX(I)
271 140 CONTINUE
272 CALL CSSCALTEST(5,SA,CX,INCX)
273 CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
274 END IF
275 RETURN
276 END
277 SUBROUTINE CHECK2(SFAC)
278 * .. Parameters ..
279 INTEGER NOUT
280 PARAMETER (NOUT=6)
281 * .. Scalar Arguments ..
282 REAL SFAC
283 * .. Scalars in Common ..
284 INTEGER ICASE, INCX, INCY, MODE, N
285 LOGICAL PASS
286 * .. Local Scalars ..
287 COMPLEX CA,CTEMP
288 INTEGER I, J, KI, KN, KSIZE, LENX, LENY, MX, MY
289 * .. Local Arrays ..
290 COMPLEX CDOT(1), CSIZE1(4), CSIZE2(7,2), CSIZE3(14),
291 + CT10X(7,4,4), CT10Y(7,4,4), CT6(4,4), CT7(4,4),
292 + CT8(7,4,4), CX(7), CX1(7), CY(7), CY1(7)
293 INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4)
294 * .. External Functions ..
295 EXTERNAL CDOTCTEST, CDOTUTEST
296 * .. External Subroutines ..
297 EXTERNAL CAXPYTEST, CCOPYTEST, CSWAPTEST, CTEST
298 * .. Intrinsic Functions ..
299 INTRINSIC ABS, MIN
300 * .. Common blocks ..
301 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
302 * .. Data statements ..
303 DATA CA/(0.4E0,-0.7E0)/
304 DATA INCXS/1, 2, -2, -1/
305 DATA INCYS/1, -2, 1, -2/
306 DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/
307 DATA NS/0, 1, 2, 4/
308 DATA CX1/(0.7E0,-0.8E0), (-0.4E0,-0.7E0),
309 + (-0.1E0,-0.9E0), (0.2E0,-0.8E0),
310 + (-0.9E0,-0.4E0), (0.1E0,0.4E0), (-0.6E0,0.6E0)/
311 DATA CY1/(0.6E0,-0.6E0), (-0.9E0,0.5E0),
312 + (0.7E0,-0.6E0), (0.1E0,-0.5E0), (-0.1E0,-0.2E0),
313 + (-0.5E0,-0.3E0), (0.8E0,-0.7E0)/
314 DATA ((CT8(I,J,1),I=1,7),J=1,4)/(0.6E0,-0.6E0),
315 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
316 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
317 + (0.32E0,-1.41E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
318 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
319 + (0.0E0,0.0E0), (0.32E0,-1.41E0),
320 + (-1.55E0,0.5E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
321 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
322 + (0.32E0,-1.41E0), (-1.55E0,0.5E0),
323 + (0.03E0,-0.89E0), (-0.38E0,-0.96E0),
324 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/
325 DATA ((CT8(I,J,2),I=1,7),J=1,4)/(0.6E0,-0.6E0),
326 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
327 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
328 + (0.32E0,-1.41E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
329 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
330 + (0.0E0,0.0E0), (-0.07E0,-0.89E0),
331 + (-0.9E0,0.5E0), (0.42E0,-1.41E0), (0.0E0,0.0E0),
332 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
333 + (0.78E0,0.06E0), (-0.9E0,0.5E0),
334 + (0.06E0,-0.13E0), (0.1E0,-0.5E0),
335 + (-0.77E0,-0.49E0), (-0.5E0,-0.3E0),
336 + (0.52E0,-1.51E0)/
337 DATA ((CT8(I,J,3),I=1,7),J=1,4)/(0.6E0,-0.6E0),
338 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
339 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
340 + (0.32E0,-1.41E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
341 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
342 + (0.0E0,0.0E0), (-0.07E0,-0.89E0),
343 + (-1.18E0,-0.31E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
344 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
345 + (0.78E0,0.06E0), (-1.54E0,0.97E0),
346 + (0.03E0,-0.89E0), (-0.18E0,-1.31E0),
347 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/
348 DATA ((CT8(I,J,4),I=1,7),J=1,4)/(0.6E0,-0.6E0),
349 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
350 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
351 + (0.32E0,-1.41E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
352 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
353 + (0.0E0,0.0E0), (0.32E0,-1.41E0), (-0.9E0,0.5E0),
354 + (0.05E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
355 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.32E0,-1.41E0),
356 + (-0.9E0,0.5E0), (0.05E0,-0.6E0), (0.1E0,-0.5E0),
357 + (-0.77E0,-0.49E0), (-0.5E0,-0.3E0),
358 + (0.32E0,-1.16E0)/
359 DATA CT7/(0.0E0,0.0E0), (-0.06E0,-0.90E0),
360 + (0.65E0,-0.47E0), (-0.34E0,-1.22E0),
361 + (0.0E0,0.0E0), (-0.06E0,-0.90E0),
362 + (-0.59E0,-1.46E0), (-1.04E0,-0.04E0),
363 + (0.0E0,0.0E0), (-0.06E0,-0.90E0),
364 + (-0.83E0,0.59E0), (0.07E0,-0.37E0),
365 + (0.0E0,0.0E0), (-0.06E0,-0.90E0),
366 + (-0.76E0,-1.15E0), (-1.33E0,-1.82E0)/
367 DATA CT6/(0.0E0,0.0E0), (0.90E0,0.06E0),
368 + (0.91E0,-0.77E0), (1.80E0,-0.10E0),
369 + (0.0E0,0.0E0), (0.90E0,0.06E0), (1.45E0,0.74E0),
370 + (0.20E0,0.90E0), (0.0E0,0.0E0), (0.90E0,0.06E0),
371 + (-0.55E0,0.23E0), (0.83E0,-0.39E0),
372 + (0.0E0,0.0E0), (0.90E0,0.06E0), (1.04E0,0.79E0),
373 + (1.95E0,1.22E0)/
374 DATA ((CT10X(I,J,1),I=1,7),J=1,4)/(0.7E0,-0.8E0),
375 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
376 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
377 + (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
378 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
379 + (0.0E0,0.0E0), (0.6E0,-0.6E0), (-0.9E0,0.5E0),
380 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
381 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.6E0,-0.6E0),
382 + (-0.9E0,0.5E0), (0.7E0,-0.6E0), (0.1E0,-0.5E0),
383 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/
384 DATA ((CT10X(I,J,2),I=1,7),J=1,4)/(0.7E0,-0.8E0),
385 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
386 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
387 + (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
388 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
389 + (0.0E0,0.0E0), (0.7E0,-0.6E0), (-0.4E0,-0.7E0),
390 + (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
391 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.8E0,-0.7E0),
392 + (-0.4E0,-0.7E0), (-0.1E0,-0.2E0),
393 + (0.2E0,-0.8E0), (0.7E0,-0.6E0), (0.1E0,0.4E0),
394 + (0.6E0,-0.6E0)/
395 DATA ((CT10X(I,J,3),I=1,7),J=1,4)/(0.7E0,-0.8E0),
396 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
397 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
398 + (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
399 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
400 + (0.0E0,0.0E0), (-0.9E0,0.5E0), (-0.4E0,-0.7E0),
401 + (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
402 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.1E0,-0.5E0),
403 + (-0.4E0,-0.7E0), (0.7E0,-0.6E0), (0.2E0,-0.8E0),
404 + (-0.9E0,0.5E0), (0.1E0,0.4E0), (0.6E0,-0.6E0)/
405 DATA ((CT10X(I,J,4),I=1,7),J=1,4)/(0.7E0,-0.8E0),
406 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
407 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
408 + (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
409 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
410 + (0.0E0,0.0E0), (0.6E0,-0.6E0), (0.7E0,-0.6E0),
411 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
412 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.6E0,-0.6E0),
413 + (0.7E0,-0.6E0), (-0.1E0,-0.2E0), (0.8E0,-0.7E0),
414 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/
415 DATA ((CT10Y(I,J,1),I=1,7),J=1,4)/(0.6E0,-0.6E0),
416 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
417 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
418 + (0.7E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
419 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
420 + (0.0E0,0.0E0), (0.7E0,-0.8E0), (-0.4E0,-0.7E0),
421 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
422 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.7E0,-0.8E0),
423 + (-0.4E0,-0.7E0), (-0.1E0,-0.9E0),
424 + (0.2E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
425 + (0.0E0,0.0E0)/
426 DATA ((CT10Y(I,J,2),I=1,7),J=1,4)/(0.6E0,-0.6E0),
427 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
428 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
429 + (0.7E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
430 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
431 + (0.0E0,0.0E0), (-0.1E0,-0.9E0), (-0.9E0,0.5E0),
432 + (0.7E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
433 + (0.0E0,0.0E0), (0.0E0,0.0E0), (-0.6E0,0.6E0),
434 + (-0.9E0,0.5E0), (-0.9E0,-0.4E0), (0.1E0,-0.5E0),
435 + (-0.1E0,-0.9E0), (-0.5E0,-0.3E0),
436 + (0.7E0,-0.8E0)/
437 DATA ((CT10Y(I,J,3),I=1,7),J=1,4)/(0.6E0,-0.6E0),
438 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
439 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
440 + (0.7E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
441 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
442 + (0.0E0,0.0E0), (-0.1E0,-0.9E0), (0.7E0,-0.8E0),
443 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
444 + (0.0E0,0.0E0), (0.0E0,0.0E0), (-0.6E0,0.6E0),
445 + (-0.9E0,-0.4E0), (-0.1E0,-0.9E0),
446 + (0.7E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
447 + (0.0E0,0.0E0)/
448 DATA ((CT10Y(I,J,4),I=1,7),J=1,4)/(0.6E0,-0.6E0),
449 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
450 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
451 + (0.7E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
452 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
453 + (0.0E0,0.0E0), (0.7E0,-0.8E0), (-0.9E0,0.5E0),
454 + (-0.4E0,-0.7E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
455 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.7E0,-0.8E0),
456 + (-0.9E0,0.5E0), (-0.4E0,-0.7E0), (0.1E0,-0.5E0),
457 + (-0.1E0,-0.9E0), (-0.5E0,-0.3E0),
458 + (0.2E0,-0.8E0)/
459 DATA CSIZE1/(0.0E0,0.0E0), (0.9E0,0.9E0),
460 + (1.63E0,1.73E0), (2.90E0,2.78E0)/
461 DATA CSIZE3/(0.0E0,0.0E0), (0.0E0,0.0E0),
462 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
463 + (0.0E0,0.0E0), (0.0E0,0.0E0), (1.17E0,1.17E0),
464 + (1.17E0,1.17E0), (1.17E0,1.17E0),
465 + (1.17E0,1.17E0), (1.17E0,1.17E0),
466 + (1.17E0,1.17E0), (1.17E0,1.17E0)/
467 DATA CSIZE2/(0.0E0,0.0E0), (0.0E0,0.0E0),
468 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
469 + (0.0E0,0.0E0), (0.0E0,0.0E0), (1.54E0,1.54E0),
470 + (1.54E0,1.54E0), (1.54E0,1.54E0),
471 + (1.54E0,1.54E0), (1.54E0,1.54E0),
472 + (1.54E0,1.54E0), (1.54E0,1.54E0)/
473 * .. Executable Statements ..
474 DO 60 KI = 1, 4
475 INCX = INCXS(KI)
476 INCY = INCYS(KI)
477 MX = ABS(INCX)
478 MY = ABS(INCY)
479 *
480 DO 40 KN = 1, 4
481 N = NS(KN)
482 KSIZE = MIN(2,KN)
483 LENX = LENS(KN,MX)
484 LENY = LENS(KN,MY)
485 * .. initialize all argument arrays ..
486 DO 20 I = 1, 7
487 CX(I) = CX1(I)
488 CY(I) = CY1(I)
489 20 CONTINUE
490 IF (ICASE.EQ.1) THEN
491 * .. CDOTCTEST ..
492 CALL CDOTCTEST(N,CX,INCX,CY,INCY,CTEMP)
493 CDOT(1) = CTEMP
494 CALL CTEST(1,CDOT,CT6(KN,KI),CSIZE1(KN),SFAC)
495 ELSE IF (ICASE.EQ.2) THEN
496 * .. CDOTUTEST ..
497 CALL CDOTUTEST(N,CX,INCX,CY,INCY,CTEMP)
498 CDOT(1) = CTEMP
499 CALL CTEST(1,CDOT,CT7(KN,KI),CSIZE1(KN),SFAC)
500 ELSE IF (ICASE.EQ.3) THEN
501 * .. CAXPYTEST ..
502 CALL CAXPYTEST(N,CA,CX,INCX,CY,INCY)
503 CALL CTEST(LENY,CY,CT8(1,KN,KI),CSIZE2(1,KSIZE),SFAC)
504 ELSE IF (ICASE.EQ.4) THEN
505 * .. CCOPYTEST ..
506 CALL CCOPYTEST(N,CX,INCX,CY,INCY)
507 CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0E0)
508 ELSE IF (ICASE.EQ.5) THEN
509 * .. CSWAPTEST ..
510 CALL CSWAPTEST(N,CX,INCX,CY,INCY)
511 CALL CTEST(LENX,CX,CT10X(1,KN,KI),CSIZE3,1.0E0)
512 CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0E0)
513 ELSE
514 WRITE (NOUT,*) ' Shouldn''t be here in CHECK2'
515 STOP
516 END IF
517 *
518 40 CONTINUE
519 60 CONTINUE
520 RETURN
521 END
522 SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC)
523 * ********************************* STEST **************************
524 *
525 * THIS SUBR COMPARES ARRAYS SCOMP() AND STRUE() OF LENGTH LEN TO
526 * SEE IF THE TERM BY TERM DIFFERENCES, MULTIPLIED BY SFAC, ARE
527 * NEGLIGIBLE.
528 *
529 * C. L. LAWSON, JPL, 1974 DEC 10
530 *
531 * .. Parameters ..
532 INTEGER NOUT
533 PARAMETER (NOUT=6)
534 * .. Scalar Arguments ..
535 REAL SFAC
536 INTEGER LEN
537 * .. Array Arguments ..
538 REAL SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
539 * .. Scalars in Common ..
540 INTEGER ICASE, INCX, INCY, MODE, N
541 LOGICAL PASS
542 * .. Local Scalars ..
543 REAL SD
544 INTEGER I
545 * .. External Functions ..
546 REAL SDIFF
547 EXTERNAL SDIFF
548 * .. Intrinsic Functions ..
549 INTRINSIC ABS
550 * .. Common blocks ..
551 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
552 * .. Executable Statements ..
553 *
554 DO 40 I = 1, LEN
555 SD = SCOMP(I) - STRUE(I)
556 IF (SDIFF(ABS(SSIZE(I))+ABS(SFAC*SD),ABS(SSIZE(I))).EQ.0.0E0)
557 + GO TO 40
558 *
559 * HERE SCOMP(I) IS NOT CLOSE TO STRUE(I).
560 *
561 IF ( .NOT. PASS) GO TO 20
562 * PRINT FAIL MESSAGE AND HEADER.
563 PASS = .FALSE.
564 WRITE (NOUT,99999)
565 WRITE (NOUT,99998)
566 20 WRITE (NOUT,99997) ICASE, N, INCX, INCY, MODE, I, SCOMP(I),
567 + STRUE(I), SD, SSIZE(I)
568 40 CONTINUE
569 RETURN
570 *
571 99999 FORMAT (' FAIL')
572 99998 FORMAT (/' CASE N INCX INCY MODE I ',
573 + ' COMP(I) TRUE(I) DIFFERENCE',
574 + ' SIZE(I)',/1X)
575 99997 FORMAT (1X,I4,I3,3I5,I3,2E36.8,2E12.4)
576 END
577 SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC)
578 * ************************* STEST1 *****************************
579 *
580 * THIS IS AN INTERFACE SUBROUTINE TO ACCOMODATE THE FORTRAN
581 * REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE
582 * ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT.
583 *
584 * C.L. LAWSON, JPL, 1978 DEC 6
585 *
586 * .. Scalar Arguments ..
587 REAL SCOMP1, SFAC, STRUE1
588 * .. Array Arguments ..
589 REAL SSIZE(*)
590 * .. Local Arrays ..
591 REAL SCOMP(1), STRUE(1)
592 * .. External Subroutines ..
593 EXTERNAL STEST
594 * .. Executable Statements ..
595 *
596 SCOMP(1) = SCOMP1
597 STRUE(1) = STRUE1
598 CALL STEST(1,SCOMP,STRUE,SSIZE,SFAC)
599 *
600 RETURN
601 END
602 REAL FUNCTION SDIFF(SA,SB)
603 * ********************************* SDIFF **************************
604 * COMPUTES DIFFERENCE OF TWO NUMBERS. C. L. LAWSON, JPL 1974 FEB 15
605 *
606 * .. Scalar Arguments ..
607 REAL SA, SB
608 * .. Executable Statements ..
609 SDIFF = SA - SB
610 RETURN
611 END
612 SUBROUTINE CTEST(LEN,CCOMP,CTRUE,CSIZE,SFAC)
613 * **************************** CTEST *****************************
614 *
615 * C.L. LAWSON, JPL, 1978 DEC 6
616 *
617 * .. Scalar Arguments ..
618 REAL SFAC
619 INTEGER LEN
620 * .. Array Arguments ..
621 COMPLEX CCOMP(LEN), CSIZE(LEN), CTRUE(LEN)
622 * .. Local Scalars ..
623 INTEGER I
624 * .. Local Arrays ..
625 REAL SCOMP(20), SSIZE(20), STRUE(20)
626 * .. External Subroutines ..
627 EXTERNAL STEST
628 * .. Intrinsic Functions ..
629 INTRINSIC AIMAG, REAL
630 * .. Executable Statements ..
631 DO 20 I = 1, LEN
632 SCOMP(2*I-1) = REAL(CCOMP(I))
633 SCOMP(2*I) = AIMAG(CCOMP(I))
634 STRUE(2*I-1) = REAL(CTRUE(I))
635 STRUE(2*I) = AIMAG(CTRUE(I))
636 SSIZE(2*I-1) = REAL(CSIZE(I))
637 SSIZE(2*I) = AIMAG(CSIZE(I))
638 20 CONTINUE
639 *
640 CALL STEST(2*LEN,SCOMP,STRUE,SSIZE,SFAC)
641 RETURN
642 END
643 SUBROUTINE ITEST1(ICOMP,ITRUE)
644 * ********************************* ITEST1 *************************
645 *
646 * THIS SUBROUTINE COMPARES THE VARIABLES ICOMP AND ITRUE FOR
647 * EQUALITY.
648 * C. L. LAWSON, JPL, 1974 DEC 10
649 *
650 * .. Parameters ..
651 INTEGER NOUT
652 PARAMETER (NOUT=6)
653 * .. Scalar Arguments ..
654 INTEGER ICOMP, ITRUE
655 * .. Scalars in Common ..
656 INTEGER ICASE, INCX, INCY, MODE, N
657 LOGICAL PASS
658 * .. Local Scalars ..
659 INTEGER ID
660 * .. Common blocks ..
661 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
662 * .. Executable Statements ..
663 IF (ICOMP.EQ.ITRUE) GO TO 40
664 *
665 * HERE ICOMP IS NOT EQUAL TO ITRUE.
666 *
667 IF ( .NOT. PASS) GO TO 20
668 * PRINT FAIL MESSAGE AND HEADER.
669 PASS = .FALSE.
670 WRITE (NOUT,99999)
671 WRITE (NOUT,99998)
672 20 ID = ICOMP - ITRUE
673 WRITE (NOUT,99997) ICASE, N, INCX, INCY, MODE, ICOMP, ITRUE, ID
674 40 CONTINUE
675 RETURN
676 *
677 99999 FORMAT (' FAIL')
678 99998 FORMAT (/' CASE N INCX INCY MODE ',
679 + ' COMP TRUE DIFFERENCE',
680 + /1X)
681 99997 FORMAT (1X,I4,I3,3I5,2I36,I12)
682 END