3 * =========== DOCUMENTATION ===========
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
19 *> Test program for the COMPLEX Level 1 BLAS.
20 *> Based upon the original BLAS test routine together with:
22 *> F06GAF Example Program Text
28 *> \author Univ. of Tennessee
29 *> \author Univ. of California Berkeley
30 *> \author Univ. of Colorado Denver
35 *> \ingroup complex_blas_testing
37 * =====================================================================
40 * -- Reference BLAS test routine (version 3.7.0) --
41 * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
42 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
45 * =====================================================================
50 * .. Scalars in Common ..
51 INTEGER ICASE, INCX, INCY, MODE, N
56 * .. External Subroutines ..
57 EXTERNAL CHECK1, CHECK2, HEADER
59 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
60 * .. Data statements ..
61 DATA SFAC/9.765625E-4/
62 * .. Executable Statements ..
68 * Initialize PASS, INCX, INCY, and MODE for a new case.
69 * The value 9999 for INCX, INCY or MODE will appear in the
70 * detailed output, if any, for cases that do not involve
79 ELSE IF (ICASE.GE.6) THEN
83 IF (PASS) WRITE (NOUT,99998)
87 99999 FORMAT (' Complex BLAS Test Program Results',/1X)
88 99998 FORMAT (' ----- PASS -----')
94 * .. Scalars in Common ..
95 INTEGER ICASE, INCX, INCY, MODE, N
100 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
101 * .. Data statements ..
112 * .. Executable Statements ..
113 WRITE (NOUT,99999) ICASE, L(ICASE)
116 99999 FORMAT (/' Test of subprogram number',I3,12X,A6)
118 SUBROUTINE CHECK1(SFAC)
122 * .. Scalar Arguments ..
124 * .. Scalars in Common ..
125 INTEGER ICASE, INCX, INCY, MODE, N
127 * .. Local Scalars ..
130 INTEGER I, J, LEN, NP1
132 COMPLEX CTRUE5(8,5,2), CTRUE6(8,5,2), CV(8,5,2), CX(8),
134 REAL STRUE2(5), STRUE4(5)
136 * .. External Functions ..
139 EXTERNAL SCASUM, SCNRM2, ICAMAX
140 * .. External Subroutines ..
141 EXTERNAL CSCAL, CSSCAL, CTEST, ITEST1, STEST1
142 * .. Intrinsic Functions ..
144 * .. Common blocks ..
145 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
146 * .. Data statements ..
147 DATA SA, CA/0.3E0, (0.4E0,-0.7E0)/
148 DATA ((CV(I,J,1),I=1,8),J=1,5)/(0.1E0,0.1E0),
149 + (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0),
150 + (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0),
151 + (1.0E0,2.0E0), (0.3E0,-0.4E0), (3.0E0,4.0E0),
152 + (3.0E0,4.0E0), (3.0E0,4.0E0), (3.0E0,4.0E0),
153 + (3.0E0,4.0E0), (3.0E0,4.0E0), (3.0E0,4.0E0),
154 + (0.1E0,-0.3E0), (0.5E0,-0.1E0), (5.0E0,6.0E0),
155 + (5.0E0,6.0E0), (5.0E0,6.0E0), (5.0E0,6.0E0),
156 + (5.0E0,6.0E0), (5.0E0,6.0E0), (0.1E0,0.1E0),
157 + (-0.6E0,0.1E0), (0.1E0,-0.3E0), (7.0E0,8.0E0),
158 + (7.0E0,8.0E0), (7.0E0,8.0E0), (7.0E0,8.0E0),
159 + (7.0E0,8.0E0), (0.3E0,0.1E0), (0.5E0,0.0E0),
160 + (0.0E0,0.5E0), (0.0E0,0.2E0), (2.0E0,3.0E0),
161 + (2.0E0,3.0E0), (2.0E0,3.0E0), (2.0E0,3.0E0)/
162 DATA ((CV(I,J,2),I=1,8),J=1,5)/(0.1E0,0.1E0),
163 + (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0),
164 + (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0),
165 + (4.0E0,5.0E0), (0.3E0,-0.4E0), (6.0E0,7.0E0),
166 + (6.0E0,7.0E0), (6.0E0,7.0E0), (6.0E0,7.0E0),
167 + (6.0E0,7.0E0), (6.0E0,7.0E0), (6.0E0,7.0E0),
168 + (0.1E0,-0.3E0), (8.0E0,9.0E0), (0.5E0,-0.1E0),
169 + (2.0E0,5.0E0), (2.0E0,5.0E0), (2.0E0,5.0E0),
170 + (2.0E0,5.0E0), (2.0E0,5.0E0), (0.1E0,0.1E0),
171 + (3.0E0,6.0E0), (-0.6E0,0.1E0), (4.0E0,7.0E0),
172 + (0.1E0,-0.3E0), (7.0E0,2.0E0), (7.0E0,2.0E0),
173 + (7.0E0,2.0E0), (0.3E0,0.1E0), (5.0E0,8.0E0),
174 + (0.5E0,0.0E0), (6.0E0,9.0E0), (0.0E0,0.5E0),
175 + (8.0E0,3.0E0), (0.0E0,0.2E0), (9.0E0,4.0E0)/
176 DATA STRUE2/0.0E0, 0.5E0, 0.6E0, 0.7E0, 0.8E0/
177 DATA STRUE4/0.0E0, 0.7E0, 1.0E0, 1.3E0, 1.6E0/
178 DATA ((CTRUE5(I,J,1),I=1,8),J=1,5)/(0.1E0,0.1E0),
179 + (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0),
180 + (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0),
181 + (1.0E0,2.0E0), (-0.16E0,-0.37E0), (3.0E0,4.0E0),
182 + (3.0E0,4.0E0), (3.0E0,4.0E0), (3.0E0,4.0E0),
183 + (3.0E0,4.0E0), (3.0E0,4.0E0), (3.0E0,4.0E0),
184 + (-0.17E0,-0.19E0), (0.13E0,-0.39E0),
185 + (5.0E0,6.0E0), (5.0E0,6.0E0), (5.0E0,6.0E0),
186 + (5.0E0,6.0E0), (5.0E0,6.0E0), (5.0E0,6.0E0),
187 + (0.11E0,-0.03E0), (-0.17E0,0.46E0),
188 + (-0.17E0,-0.19E0), (7.0E0,8.0E0), (7.0E0,8.0E0),
189 + (7.0E0,8.0E0), (7.0E0,8.0E0), (7.0E0,8.0E0),
190 + (0.19E0,-0.17E0), (0.20E0,-0.35E0),
191 + (0.35E0,0.20E0), (0.14E0,0.08E0),
192 + (2.0E0,3.0E0), (2.0E0,3.0E0), (2.0E0,3.0E0),
194 DATA ((CTRUE5(I,J,2),I=1,8),J=1,5)/(0.1E0,0.1E0),
195 + (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0),
196 + (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0),
197 + (4.0E0,5.0E0), (-0.16E0,-0.37E0), (6.0E0,7.0E0),
198 + (6.0E0,7.0E0), (6.0E0,7.0E0), (6.0E0,7.0E0),
199 + (6.0E0,7.0E0), (6.0E0,7.0E0), (6.0E0,7.0E0),
200 + (-0.17E0,-0.19E0), (8.0E0,9.0E0),
201 + (0.13E0,-0.39E0), (2.0E0,5.0E0), (2.0E0,5.0E0),
202 + (2.0E0,5.0E0), (2.0E0,5.0E0), (2.0E0,5.0E0),
203 + (0.11E0,-0.03E0), (3.0E0,6.0E0),
204 + (-0.17E0,0.46E0), (4.0E0,7.0E0),
205 + (-0.17E0,-0.19E0), (7.0E0,2.0E0), (7.0E0,2.0E0),
206 + (7.0E0,2.0E0), (0.19E0,-0.17E0), (5.0E0,8.0E0),
207 + (0.20E0,-0.35E0), (6.0E0,9.0E0),
208 + (0.35E0,0.20E0), (8.0E0,3.0E0),
209 + (0.14E0,0.08E0), (9.0E0,4.0E0)/
210 DATA ((CTRUE6(I,J,1),I=1,8),J=1,5)/(0.1E0,0.1E0),
211 + (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0),
212 + (1.0E0,2.0E0), (1.0E0,2.0E0), (1.0E0,2.0E0),
213 + (1.0E0,2.0E0), (0.09E0,-0.12E0), (3.0E0,4.0E0),
214 + (3.0E0,4.0E0), (3.0E0,4.0E0), (3.0E0,4.0E0),
215 + (3.0E0,4.0E0), (3.0E0,4.0E0), (3.0E0,4.0E0),
216 + (0.03E0,-0.09E0), (0.15E0,-0.03E0),
217 + (5.0E0,6.0E0), (5.0E0,6.0E0), (5.0E0,6.0E0),
218 + (5.0E0,6.0E0), (5.0E0,6.0E0), (5.0E0,6.0E0),
219 + (0.03E0,0.03E0), (-0.18E0,0.03E0),
220 + (0.03E0,-0.09E0), (7.0E0,8.0E0), (7.0E0,8.0E0),
221 + (7.0E0,8.0E0), (7.0E0,8.0E0), (7.0E0,8.0E0),
222 + (0.09E0,0.03E0), (0.15E0,0.00E0),
223 + (0.00E0,0.15E0), (0.00E0,0.06E0), (2.0E0,3.0E0),
224 + (2.0E0,3.0E0), (2.0E0,3.0E0), (2.0E0,3.0E0)/
225 DATA ((CTRUE6(I,J,2),I=1,8),J=1,5)/(0.1E0,0.1E0),
226 + (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0),
227 + (4.0E0,5.0E0), (4.0E0,5.0E0), (4.0E0,5.0E0),
228 + (4.0E0,5.0E0), (0.09E0,-0.12E0), (6.0E0,7.0E0),
229 + (6.0E0,7.0E0), (6.0E0,7.0E0), (6.0E0,7.0E0),
230 + (6.0E0,7.0E0), (6.0E0,7.0E0), (6.0E0,7.0E0),
231 + (0.03E0,-0.09E0), (8.0E0,9.0E0),
232 + (0.15E0,-0.03E0), (2.0E0,5.0E0), (2.0E0,5.0E0),
233 + (2.0E0,5.0E0), (2.0E0,5.0E0), (2.0E0,5.0E0),
234 + (0.03E0,0.03E0), (3.0E0,6.0E0),
235 + (-0.18E0,0.03E0), (4.0E0,7.0E0),
236 + (0.03E0,-0.09E0), (7.0E0,2.0E0), (7.0E0,2.0E0),
237 + (7.0E0,2.0E0), (0.09E0,0.03E0), (5.0E0,8.0E0),
238 + (0.15E0,0.00E0), (6.0E0,9.0E0), (0.00E0,0.15E0),
239 + (8.0E0,3.0E0), (0.00E0,0.06E0), (9.0E0,4.0E0)/
240 DATA ITRUE3/0, 1, 2, 2, 2/
241 * .. Executable Statements ..
246 * .. Set vector arguments ..
248 CX(I) = CV(I,NP1,INCX)
252 CALL STEST1(SCNRM2(N,CX,INCX),STRUE2(NP1),STRUE2(NP1),
254 ELSE IF (ICASE.EQ.7) THEN
256 CALL STEST1(SCASUM(N,CX,INCX),STRUE4(NP1),STRUE4(NP1),
258 ELSE IF (ICASE.EQ.8) THEN
260 CALL CSCAL(N,CA,CX,INCX)
261 CALL CTEST(LEN,CX,CTRUE5(1,NP1,INCX),CTRUE5(1,NP1,INCX),
263 ELSE IF (ICASE.EQ.9) THEN
265 CALL CSSCAL(N,SA,CX,INCX)
266 CALL CTEST(LEN,CX,CTRUE6(1,NP1,INCX),CTRUE6(1,NP1,INCX),
268 ELSE IF (ICASE.EQ.10) THEN
270 CALL ITEST1(ICAMAX(N,CX,INCX),ITRUE3(NP1))
272 WRITE (NOUT,*) ' Shouldn''t be here in CHECK1'
282 * Add a test for alpha equal to zero.
285 MWPCT(I) = (0.0E0,0.0E0)
286 MWPCS(I) = (1.0E0,1.0E0)
288 CALL CSCAL(5,CA,CX,INCX)
289 CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
290 ELSE IF (ICASE.EQ.9) THEN
292 * Add a test for alpha equal to zero.
295 MWPCT(I) = (0.0E0,0.0E0)
296 MWPCS(I) = (1.0E0,1.0E0)
298 CALL CSSCAL(5,SA,CX,INCX)
299 CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
300 * Add a test for alpha equal to one.
306 CALL CSSCAL(5,SA,CX,INCX)
307 CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
308 * Add a test for alpha equal to minus one.
314 CALL CSSCAL(5,SA,CX,INCX)
315 CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
319 SUBROUTINE CHECK2(SFAC)
323 * .. Scalar Arguments ..
325 * .. Scalars in Common ..
326 INTEGER ICASE, INCX, INCY, MODE, N
328 * .. Local Scalars ..
330 INTEGER I, J, KI, KN, KSIZE, LENX, LENY, MX, MY
332 COMPLEX CDOT(1), CSIZE1(4), CSIZE2(7,2), CSIZE3(14),
333 + CT10X(7,4,4), CT10Y(7,4,4), CT6(4,4), CT7(4,4),
334 + CT8(7,4,4), CX(7), CX1(7), CY(7), CY1(7)
335 INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4)
336 * .. External Functions ..
338 EXTERNAL CDOTC, CDOTU
339 * .. External Subroutines ..
340 EXTERNAL CAXPY, CCOPY, CSWAP, CTEST
341 * .. Intrinsic Functions ..
343 * .. Common blocks ..
344 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
345 * .. Data statements ..
346 DATA CA/(0.4E0,-0.7E0)/
347 DATA INCXS/1, 2, -2, -1/
348 DATA INCYS/1, -2, 1, -2/
349 DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/
351 DATA CX1/(0.7E0,-0.8E0), (-0.4E0,-0.7E0),
352 + (-0.1E0,-0.9E0), (0.2E0,-0.8E0),
353 + (-0.9E0,-0.4E0), (0.1E0,0.4E0), (-0.6E0,0.6E0)/
354 DATA CY1/(0.6E0,-0.6E0), (-0.9E0,0.5E0),
355 + (0.7E0,-0.6E0), (0.1E0,-0.5E0), (-0.1E0,-0.2E0),
356 + (-0.5E0,-0.3E0), (0.8E0,-0.7E0)/
357 DATA ((CT8(I,J,1),I=1,7),J=1,4)/(0.6E0,-0.6E0),
358 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
359 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
360 + (0.32E0,-1.41E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
361 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
362 + (0.0E0,0.0E0), (0.32E0,-1.41E0),
363 + (-1.55E0,0.5E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
364 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
365 + (0.32E0,-1.41E0), (-1.55E0,0.5E0),
366 + (0.03E0,-0.89E0), (-0.38E0,-0.96E0),
367 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/
368 DATA ((CT8(I,J,2),I=1,7),J=1,4)/(0.6E0,-0.6E0),
369 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
370 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
371 + (0.32E0,-1.41E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
372 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
373 + (0.0E0,0.0E0), (-0.07E0,-0.89E0),
374 + (-0.9E0,0.5E0), (0.42E0,-1.41E0), (0.0E0,0.0E0),
375 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
376 + (0.78E0,0.06E0), (-0.9E0,0.5E0),
377 + (0.06E0,-0.13E0), (0.1E0,-0.5E0),
378 + (-0.77E0,-0.49E0), (-0.5E0,-0.3E0),
380 DATA ((CT8(I,J,3),I=1,7),J=1,4)/(0.6E0,-0.6E0),
381 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
382 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
383 + (0.32E0,-1.41E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
384 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
385 + (0.0E0,0.0E0), (-0.07E0,-0.89E0),
386 + (-1.18E0,-0.31E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
387 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
388 + (0.78E0,0.06E0), (-1.54E0,0.97E0),
389 + (0.03E0,-0.89E0), (-0.18E0,-1.31E0),
390 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/
391 DATA ((CT8(I,J,4),I=1,7),J=1,4)/(0.6E0,-0.6E0),
392 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
393 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
394 + (0.32E0,-1.41E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
395 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
396 + (0.0E0,0.0E0), (0.32E0,-1.41E0), (-0.9E0,0.5E0),
397 + (0.05E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
398 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.32E0,-1.41E0),
399 + (-0.9E0,0.5E0), (0.05E0,-0.6E0), (0.1E0,-0.5E0),
400 + (-0.77E0,-0.49E0), (-0.5E0,-0.3E0),
402 DATA CT7/(0.0E0,0.0E0), (-0.06E0,-0.90E0),
403 + (0.65E0,-0.47E0), (-0.34E0,-1.22E0),
404 + (0.0E0,0.0E0), (-0.06E0,-0.90E0),
405 + (-0.59E0,-1.46E0), (-1.04E0,-0.04E0),
406 + (0.0E0,0.0E0), (-0.06E0,-0.90E0),
407 + (-0.83E0,0.59E0), (0.07E0,-0.37E0),
408 + (0.0E0,0.0E0), (-0.06E0,-0.90E0),
409 + (-0.76E0,-1.15E0), (-1.33E0,-1.82E0)/
410 DATA CT6/(0.0E0,0.0E0), (0.90E0,0.06E0),
411 + (0.91E0,-0.77E0), (1.80E0,-0.10E0),
412 + (0.0E0,0.0E0), (0.90E0,0.06E0), (1.45E0,0.74E0),
413 + (0.20E0,0.90E0), (0.0E0,0.0E0), (0.90E0,0.06E0),
414 + (-0.55E0,0.23E0), (0.83E0,-0.39E0),
415 + (0.0E0,0.0E0), (0.90E0,0.06E0), (1.04E0,0.79E0),
417 DATA ((CT10X(I,J,1),I=1,7),J=1,4)/(0.7E0,-0.8E0),
418 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
419 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
420 + (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
421 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
422 + (0.0E0,0.0E0), (0.6E0,-0.6E0), (-0.9E0,0.5E0),
423 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
424 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.6E0,-0.6E0),
425 + (-0.9E0,0.5E0), (0.7E0,-0.6E0), (0.1E0,-0.5E0),
426 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/
427 DATA ((CT10X(I,J,2),I=1,7),J=1,4)/(0.7E0,-0.8E0),
428 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
429 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
430 + (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
431 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
432 + (0.0E0,0.0E0), (0.7E0,-0.6E0), (-0.4E0,-0.7E0),
433 + (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
434 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.8E0,-0.7E0),
435 + (-0.4E0,-0.7E0), (-0.1E0,-0.2E0),
436 + (0.2E0,-0.8E0), (0.7E0,-0.6E0), (0.1E0,0.4E0),
438 DATA ((CT10X(I,J,3),I=1,7),J=1,4)/(0.7E0,-0.8E0),
439 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
440 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
441 + (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
442 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
443 + (0.0E0,0.0E0), (-0.9E0,0.5E0), (-0.4E0,-0.7E0),
444 + (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
445 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.1E0,-0.5E0),
446 + (-0.4E0,-0.7E0), (0.7E0,-0.6E0), (0.2E0,-0.8E0),
447 + (-0.9E0,0.5E0), (0.1E0,0.4E0), (0.6E0,-0.6E0)/
448 DATA ((CT10X(I,J,4),I=1,7),J=1,4)/(0.7E0,-0.8E0),
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.6E0,-0.6E0), (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.6E0,-0.6E0), (0.7E0,-0.6E0),
454 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
455 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.6E0,-0.6E0),
456 + (0.7E0,-0.6E0), (-0.1E0,-0.2E0), (0.8E0,-0.7E0),
457 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/
458 DATA ((CT10Y(I,J,1),I=1,7),J=1,4)/(0.6E0,-0.6E0),
459 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
460 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
461 + (0.7E0,-0.8E0), (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.7E0,-0.8E0), (-0.4E0,-0.7E0),
464 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
465 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.7E0,-0.8E0),
466 + (-0.4E0,-0.7E0), (-0.1E0,-0.9E0),
467 + (0.2E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
469 DATA ((CT10Y(I,J,2),I=1,7),J=1,4)/(0.6E0,-0.6E0),
470 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
471 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
472 + (0.7E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
473 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
474 + (0.0E0,0.0E0), (-0.1E0,-0.9E0), (-0.9E0,0.5E0),
475 + (0.7E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
476 + (0.0E0,0.0E0), (0.0E0,0.0E0), (-0.6E0,0.6E0),
477 + (-0.9E0,0.5E0), (-0.9E0,-0.4E0), (0.1E0,-0.5E0),
478 + (-0.1E0,-0.9E0), (-0.5E0,-0.3E0),
480 DATA ((CT10Y(I,J,3),I=1,7),J=1,4)/(0.6E0,-0.6E0),
481 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
482 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
483 + (0.7E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
484 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
485 + (0.0E0,0.0E0), (-0.1E0,-0.9E0), (0.7E0,-0.8E0),
486 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
487 + (0.0E0,0.0E0), (0.0E0,0.0E0), (-0.6E0,0.6E0),
488 + (-0.9E0,-0.4E0), (-0.1E0,-0.9E0),
489 + (0.7E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
491 DATA ((CT10Y(I,J,4),I=1,7),J=1,4)/(0.6E0,-0.6E0),
492 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
493 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
494 + (0.7E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
495 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
496 + (0.0E0,0.0E0), (0.7E0,-0.8E0), (-0.9E0,0.5E0),
497 + (-0.4E0,-0.7E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
498 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.7E0,-0.8E0),
499 + (-0.9E0,0.5E0), (-0.4E0,-0.7E0), (0.1E0,-0.5E0),
500 + (-0.1E0,-0.9E0), (-0.5E0,-0.3E0),
502 DATA CSIZE1/(0.0E0,0.0E0), (0.9E0,0.9E0),
503 + (1.63E0,1.73E0), (2.90E0,2.78E0)/
504 DATA CSIZE3/(0.0E0,0.0E0), (0.0E0,0.0E0),
505 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
506 + (0.0E0,0.0E0), (0.0E0,0.0E0), (1.17E0,1.17E0),
507 + (1.17E0,1.17E0), (1.17E0,1.17E0),
508 + (1.17E0,1.17E0), (1.17E0,1.17E0),
509 + (1.17E0,1.17E0), (1.17E0,1.17E0)/
510 DATA CSIZE2/(0.0E0,0.0E0), (0.0E0,0.0E0),
511 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
512 + (0.0E0,0.0E0), (0.0E0,0.0E0), (1.54E0,1.54E0),
513 + (1.54E0,1.54E0), (1.54E0,1.54E0),
514 + (1.54E0,1.54E0), (1.54E0,1.54E0),
515 + (1.54E0,1.54E0), (1.54E0,1.54E0)/
516 * .. Executable Statements ..
528 * .. initialize all argument arrays ..
535 CDOT(1) = CDOTC(N,CX,INCX,CY,INCY)
536 CALL CTEST(1,CDOT,CT6(KN,KI),CSIZE1(KN),SFAC)
537 ELSE IF (ICASE.EQ.2) THEN
539 CDOT(1) = CDOTU(N,CX,INCX,CY,INCY)
540 CALL CTEST(1,CDOT,CT7(KN,KI),CSIZE1(KN),SFAC)
541 ELSE IF (ICASE.EQ.3) THEN
543 CALL CAXPY(N,CA,CX,INCX,CY,INCY)
544 CALL CTEST(LENY,CY,CT8(1,KN,KI),CSIZE2(1,KSIZE),SFAC)
545 ELSE IF (ICASE.EQ.4) THEN
547 CALL CCOPY(N,CX,INCX,CY,INCY)
548 CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0E0)
549 ELSE IF (ICASE.EQ.5) THEN
551 CALL CSWAP(N,CX,INCX,CY,INCY)
552 CALL CTEST(LENX,CX,CT10X(1,KN,KI),CSIZE3,1.0E0)
553 CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0E0)
555 WRITE (NOUT,*) ' Shouldn''t be here in CHECK2'
563 SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC)
564 * ********************************* STEST **************************
566 * THIS SUBR COMPARES ARRAYS SCOMP() AND STRUE() OF LENGTH LEN TO
567 * SEE IF THE TERM BY TERM DIFFERENCES, MULTIPLIED BY SFAC, ARE
570 * C. L. LAWSON, JPL, 1974 DEC 10
575 PARAMETER (NOUT=6, ZERO=0.0E0)
576 * .. Scalar Arguments ..
579 * .. Array Arguments ..
580 REAL SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
581 * .. Scalars in Common ..
582 INTEGER ICASE, INCX, INCY, MODE, N
584 * .. Local Scalars ..
587 * .. External Functions ..
590 * .. Intrinsic Functions ..
592 * .. Common blocks ..
593 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
594 * .. Executable Statements ..
597 SD = SCOMP(I) - STRUE(I)
598 IF (ABS(SFAC*SD) .LE. ABS(SSIZE(I))*EPSILON(ZERO))
601 * HERE SCOMP(I) IS NOT CLOSE TO STRUE(I).
603 IF ( .NOT. PASS) GO TO 20
604 * PRINT FAIL MESSAGE AND HEADER.
608 20 WRITE (NOUT,99997) ICASE, N, INCX, INCY, MODE, I, SCOMP(I),
609 + STRUE(I), SD, SSIZE(I)
613 99999 FORMAT (' FAIL')
614 99998 FORMAT (/' CASE N INCX INCY MODE I ',
615 + ' COMP(I) TRUE(I) DIFFERENCE',
617 99997 FORMAT (1X,I4,I3,3I5,I3,2E36.8,2E12.4)
619 SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC)
620 * ************************* STEST1 *****************************
622 * THIS IS AN INTERFACE SUBROUTINE TO ACCOMMODATE THE FORTRAN
623 * REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE
624 * ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT.
626 * C.L. LAWSON, JPL, 1978 DEC 6
628 * .. Scalar Arguments ..
629 REAL SCOMP1, SFAC, STRUE1
630 * .. Array Arguments ..
633 REAL SCOMP(1), STRUE(1)
634 * .. External Subroutines ..
636 * .. Executable Statements ..
640 CALL STEST(1,SCOMP,STRUE,SSIZE,SFAC)
644 REAL FUNCTION SDIFF(SA,SB)
645 * ********************************* SDIFF **************************
646 * COMPUTES DIFFERENCE OF TWO NUMBERS. C. L. LAWSON, JPL 1974 FEB 15
648 * .. Scalar Arguments ..
650 * .. Executable Statements ..
654 SUBROUTINE CTEST(LEN,CCOMP,CTRUE,CSIZE,SFAC)
655 * **************************** CTEST *****************************
657 * C.L. LAWSON, JPL, 1978 DEC 6
659 * .. Scalar Arguments ..
662 * .. Array Arguments ..
663 COMPLEX CCOMP(LEN), CSIZE(LEN), CTRUE(LEN)
664 * .. Local Scalars ..
667 REAL SCOMP(20), SSIZE(20), STRUE(20)
668 * .. External Subroutines ..
670 * .. Intrinsic Functions ..
671 INTRINSIC AIMAG, REAL
672 * .. Executable Statements ..
674 SCOMP(2*I-1) = REAL(CCOMP(I))
675 SCOMP(2*I) = AIMAG(CCOMP(I))
676 STRUE(2*I-1) = REAL(CTRUE(I))
677 STRUE(2*I) = AIMAG(CTRUE(I))
678 SSIZE(2*I-1) = REAL(CSIZE(I))
679 SSIZE(2*I) = AIMAG(CSIZE(I))
682 CALL STEST(2*LEN,SCOMP,STRUE,SSIZE,SFAC)
685 SUBROUTINE ITEST1(ICOMP,ITRUE)
686 * ********************************* ITEST1 *************************
688 * THIS SUBROUTINE COMPARES THE VARIABLES ICOMP AND ITRUE FOR
690 * C. L. LAWSON, JPL, 1974 DEC 10
695 * .. Scalar Arguments ..
697 * .. Scalars in Common ..
698 INTEGER ICASE, INCX, INCY, MODE, N
700 * .. Local Scalars ..
702 * .. Common blocks ..
703 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
704 * .. Executable Statements ..
705 IF (ICOMP.EQ.ITRUE) GO TO 40
707 * HERE ICOMP IS NOT EQUAL TO ITRUE.
709 IF ( .NOT. PASS) GO TO 20
710 * PRINT FAIL MESSAGE AND HEADER.
714 20 ID = ICOMP - ITRUE
715 WRITE (NOUT,99997) ICASE, N, INCX, INCY, MODE, ICOMP, ITRUE, ID
719 99999 FORMAT (' FAIL')
720 99998 FORMAT (/' CASE N INCX INCY MODE ',
721 + ' COMP TRUE DIFFERENCE',
723 99997 FORMAT (1X,I4,I3,3I5,2I36,I12)