2 * Test program for the COMPLEX Level 1 CBLAS.
3 * Based upon the original CBLAS 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 CBLAS 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 ..
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)
74 99999 FORMAT (/' Test of subprogram number',I3,9X,A15)
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 ..
95 REAL SCASUMTEST, SCNRM2TEST
97 EXTERNAL SCASUMTEST, SCNRM2TEST, ICAMAXTEST
98 * .. External Subroutines ..
99 EXTERNAL CSCAL, CSSCALTEST, 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(SCNRM2TEST(N,CX,INCX),STRUE2(NP1),
212 ELSE IF (ICASE.EQ.7) THEN
214 CALL STEST1(SCASUMTEST(N,CX,INCX),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 CSSCALTEST(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(ICAMAXTEST(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 CSSCALTEST(5,SA,CX,INCX)
257 CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
258 * Add a test for alpha equal to one.
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.
272 CALL CSSCALTEST(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 ..
295 EXTERNAL CDOTCTEST, CDOTUTEST
296 * .. External Subroutines ..
297 EXTERNAL CAXPYTEST, CCOPYTEST, CSWAPTEST, CTEST
298 * .. Intrinsic Functions ..
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/
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),
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),
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),
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),
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),
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),
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),
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),
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 ..
485 * .. initialize all argument arrays ..
492 CALL CDOTCTEST(N,CX,INCX,CY,INCY,CTEMP)
494 CALL CTEST(1,CDOT,CT6(KN,KI),CSIZE1(KN),SFAC)
495 ELSE IF (ICASE.EQ.2) THEN
497 CALL CDOTUTEST(N,CX,INCX,CY,INCY,CTEMP)
499 CALL CTEST(1,CDOT,CT7(KN,KI),CSIZE1(KN),SFAC)
500 ELSE IF (ICASE.EQ.3) THEN
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
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
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)
514 WRITE (NOUT,*) ' Shouldn''t be here in CHECK2'
522 SUBROUTINE STEST(LEN,SCOMP,STRUE,SSIZE,SFAC)
523 * ********************************* STEST **************************
525 * THIS SUBR COMPARES ARRAYS SCOMP() AND STRUE() OF LENGTH LEN TO
526 * SEE IF THE TERM BY TERM DIFFERENCES, MULTIPLIED BY SFAC, ARE
529 * C. L. LAWSON, JPL, 1974 DEC 10
534 * .. Scalar Arguments ..
537 * .. Array Arguments ..
538 REAL SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
539 * .. Scalars in Common ..
540 INTEGER ICASE, INCX, INCY, MODE, N
542 * .. Local Scalars ..
545 * .. External Functions ..
548 * .. Intrinsic Functions ..
550 * .. Common blocks ..
551 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
552 * .. Executable Statements ..
555 SD = SCOMP(I) - STRUE(I)
556 IF (SDIFF(ABS(SSIZE(I))+ABS(SFAC*SD),ABS(SSIZE(I))).EQ.0.0E0)
559 * HERE SCOMP(I) IS NOT CLOSE TO STRUE(I).
561 IF ( .NOT. PASS) GO TO 20
562 * PRINT FAIL MESSAGE AND HEADER.
566 20 WRITE (NOUT,99997) ICASE, N, INCX, INCY, MODE, I, SCOMP(I),
567 + STRUE(I), SD, SSIZE(I)
571 99999 FORMAT (' FAIL')
572 99998 FORMAT (/' CASE N INCX INCY MODE I ',
573 + ' COMP(I) TRUE(I) DIFFERENCE',
575 99997 FORMAT (1X,I4,I3,3I5,I3,2E36.8,2E12.4)
577 SUBROUTINE STEST1(SCOMP1,STRUE1,SSIZE,SFAC)
578 * ************************* STEST1 *****************************
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.
584 * C.L. LAWSON, JPL, 1978 DEC 6
586 * .. Scalar Arguments ..
587 REAL SCOMP1, SFAC, STRUE1
588 * .. Array Arguments ..
591 REAL SCOMP(1), STRUE(1)
592 * .. External Subroutines ..
594 * .. Executable Statements ..
598 CALL STEST(1,SCOMP,STRUE,SSIZE,SFAC)
602 REAL FUNCTION SDIFF(SA,SB)
603 * ********************************* SDIFF **************************
604 * COMPUTES DIFFERENCE OF TWO NUMBERS. C. L. LAWSON, JPL 1974 FEB 15
606 * .. Scalar Arguments ..
608 * .. Executable Statements ..
612 SUBROUTINE CTEST(LEN,CCOMP,CTRUE,CSIZE,SFAC)
613 * **************************** CTEST *****************************
615 * C.L. LAWSON, JPL, 1978 DEC 6
617 * .. Scalar Arguments ..
620 * .. Array Arguments ..
621 COMPLEX CCOMP(LEN), CSIZE(LEN), CTRUE(LEN)
622 * .. Local Scalars ..
625 REAL SCOMP(20), SSIZE(20), STRUE(20)
626 * .. External Subroutines ..
628 * .. Intrinsic Functions ..
629 INTRINSIC AIMAG, REAL
630 * .. Executable Statements ..
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))
640 CALL STEST(2*LEN,SCOMP,STRUE,SSIZE,SFAC)
643 SUBROUTINE ITEST1(ICOMP,ITRUE)
644 * ********************************* ITEST1 *************************
646 * THIS SUBROUTINE COMPARES THE VARIABLES ICOMP AND ITRUE FOR
648 * C. L. LAWSON, JPL, 1974 DEC 10
653 * .. Scalar Arguments ..
655 * .. Scalars in Common ..
656 INTEGER ICASE, INCX, INCY, MODE, N
658 * .. Local Scalars ..
660 * .. Common blocks ..
661 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
662 * .. Executable Statements ..
663 IF (ICOMP.EQ.ITRUE) GO TO 40
665 * HERE ICOMP IS NOT EQUAL TO ITRUE.
667 IF ( .NOT. PASS) GO TO 20
668 * PRINT FAIL MESSAGE AND HEADER.
672 20 ID = ICOMP - ITRUE
673 WRITE (NOUT,99997) ICASE, N, INCX, INCY, MODE, ICOMP, ITRUE, ID
677 99999 FORMAT (' FAIL')
678 99998 FORMAT (/' CASE N INCX INCY MODE ',
679 + ' COMP TRUE DIFFERENCE',
681 99997 FORMAT (1X,I4,I3,3I5,2I36,I12)