2 * Test program for the COMPLEX Level 1 BLAS.
3 * Based upon the original BLAS test routine together with:
4 * F06GAF Example Program Text
8 * .. Scalars in Common ..
9 INTEGER ICASE, INCX, INCY, MODE, N
14 * .. External Subroutines ..
15 EXTERNAL CHECK1, CHECK2, HEADER
17 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
18 * .. Data statements ..
19 DATA SFAC/9.765625E-4/
20 * .. Executable Statements ..
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
37 ELSE IF (ICASE.GE.6) THEN
41 IF (PASS) WRITE (NOUT,99998)
45 99999 FORMAT (' Complex BLAS Test Program Results',/1X)
46 99998 FORMAT (' ----- PASS -----')
52 * .. Scalars in Common ..
53 INTEGER ICASE, INCX, INCY, MODE, N
58 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
59 * .. Data statements ..
70 * .. Executable Statements ..
71 WRITE (NOUT,99999) ICASE, L(ICASE)
74 99999 FORMAT (/' Test of subprogram number',I3,12X,A6)
76 SUBROUTINE CHECK1(SFAC)
80 * .. Scalar Arguments ..
82 * .. Scalars in Common ..
83 INTEGER ICASE, INCX, INCY, MODE, N
88 INTEGER I, J, LEN, NP1
90 COMPLEX CTRUE5(8,5,2), CTRUE6(8,5,2), CV(8,5,2), CX(8),
92 REAL STRUE2(5), STRUE4(5)
94 * .. External Functions ..
97 EXTERNAL SCASUM, SCNRM2, ICAMAX
98 * .. External Subroutines ..
99 EXTERNAL CSCAL, CSSCAL, CTEST, ITEST1, STEST1
100 * .. Intrinsic Functions ..
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),
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 ..
204 * .. Set vector arguments ..
206 CX(I) = CV(I,NP1,INCX)
210 CALL STEST1(SCNRM2(N,CX,INCX),STRUE2(NP1),STRUE2(NP1),
212 ELSE IF (ICASE.EQ.7) THEN
214 CALL STEST1(SCASUM(N,CX,INCX),STRUE4(NP1),STRUE4(NP1),
216 ELSE IF (ICASE.EQ.8) THEN
218 CALL CSCAL(N,CA,CX,INCX)
219 CALL CTEST(LEN,CX,CTRUE5(1,NP1,INCX),CTRUE5(1,NP1,INCX),
221 ELSE IF (ICASE.EQ.9) THEN
223 CALL CSSCAL(N,SA,CX,INCX)
224 CALL CTEST(LEN,CX,CTRUE6(1,NP1,INCX),CTRUE6(1,NP1,INCX),
226 ELSE IF (ICASE.EQ.10) THEN
228 CALL ITEST1(ICAMAX(N,CX,INCX),ITRUE3(NP1))
230 WRITE (NOUT,*) ' Shouldn''t be here in CHECK1'
240 * Add a test for alpha equal to zero.
243 MWPCT(I) = (0.0E0,0.0E0)
244 MWPCS(I) = (1.0E0,1.0E0)
246 CALL CSCAL(5,CA,CX,INCX)
247 CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
248 ELSE IF (ICASE.EQ.9) THEN
250 * Add a test for alpha equal to zero.
253 MWPCT(I) = (0.0E0,0.0E0)
254 MWPCS(I) = (1.0E0,1.0E0)
256 CALL CSSCAL(5,SA,CX,INCX)
257 CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
258 * Add a test for alpha equal to one.
264 CALL CSSCAL(5,SA,CX,INCX)
265 CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
266 * Add a test for alpha equal to minus one.
272 CALL CSSCAL(5,SA,CX,INCX)
273 CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
277 SUBROUTINE CHECK2(SFAC)
281 * .. Scalar Arguments ..
283 * .. Scalars in Common ..
284 INTEGER ICASE, INCX, INCY, MODE, N
286 * .. Local Scalars ..
288 INTEGER I, J, KI, KN, KSIZE, LENX, LENY, MX, MY
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 ..
296 EXTERNAL CDOTC, CDOTU
297 * .. External Subroutines ..
298 EXTERNAL CAXPY, CCOPY, CSWAP, CTEST
299 * .. Intrinsic Functions ..
301 * .. Common blocks ..
302 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
303 * .. Data statements ..
304 DATA CA/(0.4E0,-0.7E0)/
305 DATA INCXS/1, 2, -2, -1/
306 DATA INCYS/1, -2, 1, -2/
307 DATA LENS/1, 1, 2, 4, 1, 1, 3, 7/
309 DATA CX1/(0.7E0,-0.8E0), (-0.4E0,-0.7E0),
310 + (-0.1E0,-0.9E0), (0.2E0,-0.8E0),
311 + (-0.9E0,-0.4E0), (0.1E0,0.4E0), (-0.6E0,0.6E0)/
312 DATA CY1/(0.6E0,-0.6E0), (-0.9E0,0.5E0),
313 + (0.7E0,-0.6E0), (0.1E0,-0.5E0), (-0.1E0,-0.2E0),
314 + (-0.5E0,-0.3E0), (0.8E0,-0.7E0)/
315 DATA ((CT8(I,J,1),I=1,7),J=1,4)/(0.6E0,-0.6E0),
316 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
317 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
318 + (0.32E0,-1.41E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
319 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
320 + (0.0E0,0.0E0), (0.32E0,-1.41E0),
321 + (-1.55E0,0.5E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
322 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
323 + (0.32E0,-1.41E0), (-1.55E0,0.5E0),
324 + (0.03E0,-0.89E0), (-0.38E0,-0.96E0),
325 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/
326 DATA ((CT8(I,J,2),I=1,7),J=1,4)/(0.6E0,-0.6E0),
327 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
328 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
329 + (0.32E0,-1.41E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
330 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
331 + (0.0E0,0.0E0), (-0.07E0,-0.89E0),
332 + (-0.9E0,0.5E0), (0.42E0,-1.41E0), (0.0E0,0.0E0),
333 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
334 + (0.78E0,0.06E0), (-0.9E0,0.5E0),
335 + (0.06E0,-0.13E0), (0.1E0,-0.5E0),
336 + (-0.77E0,-0.49E0), (-0.5E0,-0.3E0),
338 DATA ((CT8(I,J,3),I=1,7),J=1,4)/(0.6E0,-0.6E0),
339 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
340 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
341 + (0.32E0,-1.41E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
342 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
343 + (0.0E0,0.0E0), (-0.07E0,-0.89E0),
344 + (-1.18E0,-0.31E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
345 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
346 + (0.78E0,0.06E0), (-1.54E0,0.97E0),
347 + (0.03E0,-0.89E0), (-0.18E0,-1.31E0),
348 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/
349 DATA ((CT8(I,J,4),I=1,7),J=1,4)/(0.6E0,-0.6E0),
350 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
351 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
352 + (0.32E0,-1.41E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
353 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
354 + (0.0E0,0.0E0), (0.32E0,-1.41E0), (-0.9E0,0.5E0),
355 + (0.05E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
356 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.32E0,-1.41E0),
357 + (-0.9E0,0.5E0), (0.05E0,-0.6E0), (0.1E0,-0.5E0),
358 + (-0.77E0,-0.49E0), (-0.5E0,-0.3E0),
360 DATA CT7/(0.0E0,0.0E0), (-0.06E0,-0.90E0),
361 + (0.65E0,-0.47E0), (-0.34E0,-1.22E0),
362 + (0.0E0,0.0E0), (-0.06E0,-0.90E0),
363 + (-0.59E0,-1.46E0), (-1.04E0,-0.04E0),
364 + (0.0E0,0.0E0), (-0.06E0,-0.90E0),
365 + (-0.83E0,0.59E0), (0.07E0,-0.37E0),
366 + (0.0E0,0.0E0), (-0.06E0,-0.90E0),
367 + (-0.76E0,-1.15E0), (-1.33E0,-1.82E0)/
368 DATA CT6/(0.0E0,0.0E0), (0.90E0,0.06E0),
369 + (0.91E0,-0.77E0), (1.80E0,-0.10E0),
370 + (0.0E0,0.0E0), (0.90E0,0.06E0), (1.45E0,0.74E0),
371 + (0.20E0,0.90E0), (0.0E0,0.0E0), (0.90E0,0.06E0),
372 + (-0.55E0,0.23E0), (0.83E0,-0.39E0),
373 + (0.0E0,0.0E0), (0.90E0,0.06E0), (1.04E0,0.79E0),
375 DATA ((CT10X(I,J,1),I=1,7),J=1,4)/(0.7E0,-0.8E0),
376 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
377 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
378 + (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
379 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
380 + (0.0E0,0.0E0), (0.6E0,-0.6E0), (-0.9E0,0.5E0),
381 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
382 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.6E0,-0.6E0),
383 + (-0.9E0,0.5E0), (0.7E0,-0.6E0), (0.1E0,-0.5E0),
384 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/
385 DATA ((CT10X(I,J,2),I=1,7),J=1,4)/(0.7E0,-0.8E0),
386 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
387 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
388 + (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
389 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
390 + (0.0E0,0.0E0), (0.7E0,-0.6E0), (-0.4E0,-0.7E0),
391 + (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
392 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.8E0,-0.7E0),
393 + (-0.4E0,-0.7E0), (-0.1E0,-0.2E0),
394 + (0.2E0,-0.8E0), (0.7E0,-0.6E0), (0.1E0,0.4E0),
396 DATA ((CT10X(I,J,3),I=1,7),J=1,4)/(0.7E0,-0.8E0),
397 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
398 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
399 + (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
400 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
401 + (0.0E0,0.0E0), (-0.9E0,0.5E0), (-0.4E0,-0.7E0),
402 + (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
403 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.1E0,-0.5E0),
404 + (-0.4E0,-0.7E0), (0.7E0,-0.6E0), (0.2E0,-0.8E0),
405 + (-0.9E0,0.5E0), (0.1E0,0.4E0), (0.6E0,-0.6E0)/
406 DATA ((CT10X(I,J,4),I=1,7),J=1,4)/(0.7E0,-0.8E0),
407 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
408 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
409 + (0.6E0,-0.6E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
410 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
411 + (0.0E0,0.0E0), (0.6E0,-0.6E0), (0.7E0,-0.6E0),
412 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
413 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.6E0,-0.6E0),
414 + (0.7E0,-0.6E0), (-0.1E0,-0.2E0), (0.8E0,-0.7E0),
415 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0)/
416 DATA ((CT10Y(I,J,1),I=1,7),J=1,4)/(0.6E0,-0.6E0),
417 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
418 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
419 + (0.7E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
420 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
421 + (0.0E0,0.0E0), (0.7E0,-0.8E0), (-0.4E0,-0.7E0),
422 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
423 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.7E0,-0.8E0),
424 + (-0.4E0,-0.7E0), (-0.1E0,-0.9E0),
425 + (0.2E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
427 DATA ((CT10Y(I,J,2),I=1,7),J=1,4)/(0.6E0,-0.6E0),
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.7E0,-0.8E0), (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.1E0,-0.9E0), (-0.9E0,0.5E0),
433 + (0.7E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
434 + (0.0E0,0.0E0), (0.0E0,0.0E0), (-0.6E0,0.6E0),
435 + (-0.9E0,0.5E0), (-0.9E0,-0.4E0), (0.1E0,-0.5E0),
436 + (-0.1E0,-0.9E0), (-0.5E0,-0.3E0),
438 DATA ((CT10Y(I,J,3),I=1,7),J=1,4)/(0.6E0,-0.6E0),
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.7E0,-0.8E0), (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.1E0,-0.9E0), (0.7E0,-0.8E0),
444 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
445 + (0.0E0,0.0E0), (0.0E0,0.0E0), (-0.6E0,0.6E0),
446 + (-0.9E0,-0.4E0), (-0.1E0,-0.9E0),
447 + (0.7E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
449 DATA ((CT10Y(I,J,4),I=1,7),J=1,4)/(0.6E0,-0.6E0),
450 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
451 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
452 + (0.7E0,-0.8E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
453 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
454 + (0.0E0,0.0E0), (0.7E0,-0.8E0), (-0.9E0,0.5E0),
455 + (-0.4E0,-0.7E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
456 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.7E0,-0.8E0),
457 + (-0.9E0,0.5E0), (-0.4E0,-0.7E0), (0.1E0,-0.5E0),
458 + (-0.1E0,-0.9E0), (-0.5E0,-0.3E0),
460 DATA CSIZE1/(0.0E0,0.0E0), (0.9E0,0.9E0),
461 + (1.63E0,1.73E0), (2.90E0,2.78E0)/
462 DATA CSIZE3/(0.0E0,0.0E0), (0.0E0,0.0E0),
463 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
464 + (0.0E0,0.0E0), (0.0E0,0.0E0), (1.17E0,1.17E0),
465 + (1.17E0,1.17E0), (1.17E0,1.17E0),
466 + (1.17E0,1.17E0), (1.17E0,1.17E0),
467 + (1.17E0,1.17E0), (1.17E0,1.17E0)/
468 DATA CSIZE2/(0.0E0,0.0E0), (0.0E0,0.0E0),
469 + (0.0E0,0.0E0), (0.0E0,0.0E0), (0.0E0,0.0E0),
470 + (0.0E0,0.0E0), (0.0E0,0.0E0), (1.54E0,1.54E0),
471 + (1.54E0,1.54E0), (1.54E0,1.54E0),
472 + (1.54E0,1.54E0), (1.54E0,1.54E0),
473 + (1.54E0,1.54E0), (1.54E0,1.54E0)/
474 * .. Executable Statements ..
486 * .. initialize all argument arrays ..
493 CDOT(1) = CDOTC(N,CX,INCX,CY,INCY)
494 CALL CTEST(1,CDOT,CT6(KN,KI),CSIZE1(KN),SFAC)
495 ELSE IF (ICASE.EQ.2) THEN
497 CDOT(1) = CDOTU(N,CX,INCX,CY,INCY)
498 CALL CTEST(1,CDOT,CT7(KN,KI),CSIZE1(KN),SFAC)
499 ELSE IF (ICASE.EQ.3) THEN
501 CALL CAXPY(N,CA,CX,INCX,CY,INCY)
502 CALL CTEST(LENY,CY,CT8(1,KN,KI),CSIZE2(1,KSIZE),SFAC)
503 ELSE IF (ICASE.EQ.4) THEN
505 CALL CCOPY(N,CX,INCX,CY,INCY)
506 CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0E0)
507 ELSE IF (ICASE.EQ.5) THEN
509 CALL CSWAP(N,CX,INCX,CY,INCY)
510 CALL CTEST(LENX,CX,CT10X(1,KN,KI),CSIZE3,1.0E0)
511 CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0E0)
513 WRITE (NOUT,*) ' Shouldn''t be here in CHECK2'
521 SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC)
522 * ********************************* STEST **************************
524 * THIS SUBR COMPARES ARRAYS SCOMP() AND STRUE() OF LENGTH LEN TO
525 * SEE IF THE TERM BY TERM DIFFERENCES, MULTIPLIED BY SFAC, ARE
528 * C. L. LAWSON, JPL, 1974 DEC 10
533 * .. Scalar Arguments ..
536 * .. Array Arguments ..
537 REAL SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
538 * .. Scalars in Common ..
539 INTEGER ICASE, INCX, INCY, MODE, N
541 * .. Local Scalars ..
544 * .. External Functions ..
547 * .. Intrinsic Functions ..
549 * .. Common blocks ..
550 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
551 * .. Executable Statements ..
554 SD = SCOMP(I) - STRUE(I)
555 IF (SDIFF(ABS(SSIZE(I))+ABS(SFAC*SD),ABS(SSIZE(I))).EQ.0.0E0)
558 * HERE SCOMP(I) IS NOT CLOSE TO STRUE(I).
560 IF ( .NOT. PASS) GO TO 20
561 * PRINT FAIL MESSAGE AND HEADER.
565 20 WRITE (NOUT,99997) ICASE, N, INCX, INCY, MODE, I, SCOMP(I),
566 + STRUE(I), SD, SSIZE(I)
570 99999 FORMAT (' FAIL')
571 99998 FORMAT (/' CASE N INCX INCY MODE I ',
572 + ' COMP(I) TRUE(I) DIFFERENCE',
574 99997 FORMAT (1X,I4,I3,3I5,I3,2E36.8,2E12.4)
576 SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC)
577 * ************************* STEST1 *****************************
579 * THIS IS AN INTERFACE SUBROUTINE TO ACCOMODATE THE FORTRAN
580 * REQUIREMENT THAT WHEN A DUMMY ARGUMENT IS AN ARRAY, THE
581 * ACTUAL ARGUMENT MUST ALSO BE AN ARRAY OR AN ARRAY ELEMENT.
583 * C.L. LAWSON, JPL, 1978 DEC 6
585 * .. Scalar Arguments ..
586 REAL SCOMP1, SFAC, STRUE1
587 * .. Array Arguments ..
590 REAL SCOMP(1), STRUE(1)
591 * .. External Subroutines ..
593 * .. Executable Statements ..
597 CALL STEST(1,SCOMP,STRUE,SSIZE,SFAC)
601 REAL FUNCTION SDIFF(SA,SB)
602 * ********************************* SDIFF **************************
603 * COMPUTES DIFFERENCE OF TWO NUMBERS. C. L. LAWSON, JPL 1974 FEB 15
605 * .. Scalar Arguments ..
607 * .. Executable Statements ..
611 SUBROUTINE CTEST(LEN,CCOMP,CTRUE,CSIZE,SFAC)
612 * **************************** CTEST *****************************
614 * C.L. LAWSON, JPL, 1978 DEC 6
616 * .. Scalar Arguments ..
619 * .. Array Arguments ..
620 COMPLEX CCOMP(LEN), CSIZE(LEN), CTRUE(LEN)
621 * .. Local Scalars ..
624 REAL SCOMP(20), SSIZE(20), STRUE(20)
625 * .. External Subroutines ..
627 * .. Intrinsic Functions ..
628 INTRINSIC AIMAG, REAL
629 * .. Executable Statements ..
631 SCOMP(2*I-1) = REAL(CCOMP(I))
632 SCOMP(2*I) = AIMAG(CCOMP(I))
633 STRUE(2*I-1) = REAL(CTRUE(I))
634 STRUE(2*I) = AIMAG(CTRUE(I))
635 SSIZE(2*I-1) = REAL(CSIZE(I))
636 SSIZE(2*I) = AIMAG(CSIZE(I))
639 CALL STEST(2*LEN,SCOMP,STRUE,SSIZE,SFAC)
642 SUBROUTINE ITEST1(ICOMP,ITRUE)
643 * ********************************* ITEST1 *************************
645 * THIS SUBROUTINE COMPARES THE VARIABLES ICOMP AND ITRUE FOR
647 * C. L. LAWSON, JPL, 1974 DEC 10
652 * .. Scalar Arguments ..
654 * .. Scalars in Common ..
655 INTEGER ICASE, INCX, INCY, MODE, N
657 * .. Local Scalars ..
659 * .. Common blocks ..
660 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
661 * .. Executable Statements ..
662 IF (ICOMP.EQ.ITRUE) GO TO 40
664 * HERE ICOMP IS NOT EQUAL TO ITRUE.
666 IF ( .NOT. PASS) GO TO 20
667 * PRINT FAIL MESSAGE AND HEADER.
671 20 ID = ICOMP - ITRUE
672 WRITE (NOUT,99997) ICASE, N, INCX, INCY, MODE, ICOMP, ITRUE, ID
676 99999 FORMAT (' FAIL')
677 99998 FORMAT (/' CASE N INCX INCY MODE ',
678 + ' COMP TRUE DIFFERENCE',
680 99997 FORMAT (1X,I4,I3,3I5,2I36,I12)