2 * Test program for the COMPLEX*16 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.765625D-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_ZDOTC'/
61 DATA L(2)/'CBLAS_ZDOTU'/
62 DATA L(3)/'CBLAS_ZAXPY'/
63 DATA L(4)/'CBLAS_ZCOPY'/
64 DATA L(5)/'CBLAS_ZSWAP'/
65 DATA L(6)/'CBLAS_DZNRM2'/
66 DATA L(7)/'CBLAS_DZASUM'/
67 DATA L(8)/'CBLAS_ZSCAL'/
68 DATA L(9)/'CBLAS_ZDSCAL'/
69 DATA L(10)/'CBLAS_IZAMAX'/
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*16 CTRUE5(8,5,2), CTRUE6(8,5,2), CV(8,5,2), CX(8),
92 DOUBLE PRECISION STRUE2(5), STRUE4(5)
94 * .. External Functions ..
95 DOUBLE PRECISION DZASUMTEST, DZNRM2TEST
97 EXTERNAL DZASUMTEST, DZNRM2TEST, IZAMAXTEST
98 * .. External Subroutines ..
99 EXTERNAL ZSCALTEST, ZDSCALTEST, 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.3D0, (0.4D0,-0.7D0)/
106 DATA ((CV(I,J,1),I=1,8),J=1,5)/(0.1D0,0.1D0),
107 + (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0),
108 + (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0),
109 + (1.0D0,2.0D0), (0.3D0,-0.4D0), (3.0D0,4.0D0),
110 + (3.0D0,4.0D0), (3.0D0,4.0D0), (3.0D0,4.0D0),
111 + (3.0D0,4.0D0), (3.0D0,4.0D0), (3.0D0,4.0D0),
112 + (0.1D0,-0.3D0), (0.5D0,-0.1D0), (5.0D0,6.0D0),
113 + (5.0D0,6.0D0), (5.0D0,6.0D0), (5.0D0,6.0D0),
114 + (5.0D0,6.0D0), (5.0D0,6.0D0), (0.1D0,0.1D0),
115 + (-0.6D0,0.1D0), (0.1D0,-0.3D0), (7.0D0,8.0D0),
116 + (7.0D0,8.0D0), (7.0D0,8.0D0), (7.0D0,8.0D0),
117 + (7.0D0,8.0D0), (0.3D0,0.1D0), (0.1D0,0.4D0),
118 + (0.4D0,0.1D0), (0.1D0,0.2D0), (2.0D0,3.0D0),
119 + (2.0D0,3.0D0), (2.0D0,3.0D0), (2.0D0,3.0D0)/
120 DATA ((CV(I,J,2),I=1,8),J=1,5)/(0.1D0,0.1D0),
121 + (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0),
122 + (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0),
123 + (4.0D0,5.0D0), (0.3D0,-0.4D0), (6.0D0,7.0D0),
124 + (6.0D0,7.0D0), (6.0D0,7.0D0), (6.0D0,7.0D0),
125 + (6.0D0,7.0D0), (6.0D0,7.0D0), (6.0D0,7.0D0),
126 + (0.1D0,-0.3D0), (8.0D0,9.0D0), (0.5D0,-0.1D0),
127 + (2.0D0,5.0D0), (2.0D0,5.0D0), (2.0D0,5.0D0),
128 + (2.0D0,5.0D0), (2.0D0,5.0D0), (0.1D0,0.1D0),
129 + (3.0D0,6.0D0), (-0.6D0,0.1D0), (4.0D0,7.0D0),
130 + (0.1D0,-0.3D0), (7.0D0,2.0D0), (7.0D0,2.0D0),
131 + (7.0D0,2.0D0), (0.3D0,0.1D0), (5.0D0,8.0D0),
132 + (0.1D0,0.4D0), (6.0D0,9.0D0), (0.4D0,0.1D0),
133 + (8.0D0,3.0D0), (0.1D0,0.2D0), (9.0D0,4.0D0)/
134 DATA STRUE2/0.0D0, 0.5D0, 0.6D0, 0.7D0, 0.7D0/
135 DATA STRUE4/0.0D0, 0.7D0, 1.0D0, 1.3D0, 1.7D0/
136 DATA ((CTRUE5(I,J,1),I=1,8),J=1,5)/(0.1D0,0.1D0),
137 + (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0),
138 + (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0),
139 + (1.0D0,2.0D0), (-0.16D0,-0.37D0), (3.0D0,4.0D0),
140 + (3.0D0,4.0D0), (3.0D0,4.0D0), (3.0D0,4.0D0),
141 + (3.0D0,4.0D0), (3.0D0,4.0D0), (3.0D0,4.0D0),
142 + (-0.17D0,-0.19D0), (0.13D0,-0.39D0),
143 + (5.0D0,6.0D0), (5.0D0,6.0D0), (5.0D0,6.0D0),
144 + (5.0D0,6.0D0), (5.0D0,6.0D0), (5.0D0,6.0D0),
145 + (0.11D0,-0.03D0), (-0.17D0,0.46D0),
146 + (-0.17D0,-0.19D0), (7.0D0,8.0D0), (7.0D0,8.0D0),
147 + (7.0D0,8.0D0), (7.0D0,8.0D0), (7.0D0,8.0D0),
148 + (0.19D0,-0.17D0), (0.32D0,0.09D0),
149 + (0.23D0,-0.24D0), (0.18D0,0.01D0),
150 + (2.0D0,3.0D0), (2.0D0,3.0D0), (2.0D0,3.0D0),
152 DATA ((CTRUE5(I,J,2),I=1,8),J=1,5)/(0.1D0,0.1D0),
153 + (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0),
154 + (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0),
155 + (4.0D0,5.0D0), (-0.16D0,-0.37D0), (6.0D0,7.0D0),
156 + (6.0D0,7.0D0), (6.0D0,7.0D0), (6.0D0,7.0D0),
157 + (6.0D0,7.0D0), (6.0D0,7.0D0), (6.0D0,7.0D0),
158 + (-0.17D0,-0.19D0), (8.0D0,9.0D0),
159 + (0.13D0,-0.39D0), (2.0D0,5.0D0), (2.0D0,5.0D0),
160 + (2.0D0,5.0D0), (2.0D0,5.0D0), (2.0D0,5.0D0),
161 + (0.11D0,-0.03D0), (3.0D0,6.0D0),
162 + (-0.17D0,0.46D0), (4.0D0,7.0D0),
163 + (-0.17D0,-0.19D0), (7.0D0,2.0D0), (7.0D0,2.0D0),
164 + (7.0D0,2.0D0), (0.19D0,-0.17D0), (5.0D0,8.0D0),
165 + (0.32D0,0.09D0), (6.0D0,9.0D0),
166 + (0.23D0,-0.24D0), (8.0D0,3.0D0),
167 + (0.18D0,0.01D0), (9.0D0,4.0D0)/
168 DATA ((CTRUE6(I,J,1),I=1,8),J=1,5)/(0.1D0,0.1D0),
169 + (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0),
170 + (1.0D0,2.0D0), (1.0D0,2.0D0), (1.0D0,2.0D0),
171 + (1.0D0,2.0D0), (0.09D0,-0.12D0), (3.0D0,4.0D0),
172 + (3.0D0,4.0D0), (3.0D0,4.0D0), (3.0D0,4.0D0),
173 + (3.0D0,4.0D0), (3.0D0,4.0D0), (3.0D0,4.0D0),
174 + (0.03D0,-0.09D0), (0.15D0,-0.03D0),
175 + (5.0D0,6.0D0), (5.0D0,6.0D0), (5.0D0,6.0D0),
176 + (5.0D0,6.0D0), (5.0D0,6.0D0), (5.0D0,6.0D0),
177 + (0.03D0,0.03D0), (-0.18D0,0.03D0),
178 + (0.03D0,-0.09D0), (7.0D0,8.0D0), (7.0D0,8.0D0),
179 + (7.0D0,8.0D0), (7.0D0,8.0D0), (7.0D0,8.0D0),
180 + (0.09D0,0.03D0), (0.03D0,0.12D0),
181 + (0.12D0,0.03D0), (0.03D0,0.06D0), (2.0D0,3.0D0),
182 + (2.0D0,3.0D0), (2.0D0,3.0D0), (2.0D0,3.0D0)/
183 DATA ((CTRUE6(I,J,2),I=1,8),J=1,5)/(0.1D0,0.1D0),
184 + (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0),
185 + (4.0D0,5.0D0), (4.0D0,5.0D0), (4.0D0,5.0D0),
186 + (4.0D0,5.0D0), (0.09D0,-0.12D0), (6.0D0,7.0D0),
187 + (6.0D0,7.0D0), (6.0D0,7.0D0), (6.0D0,7.0D0),
188 + (6.0D0,7.0D0), (6.0D0,7.0D0), (6.0D0,7.0D0),
189 + (0.03D0,-0.09D0), (8.0D0,9.0D0),
190 + (0.15D0,-0.03D0), (2.0D0,5.0D0), (2.0D0,5.0D0),
191 + (2.0D0,5.0D0), (2.0D0,5.0D0), (2.0D0,5.0D0),
192 + (0.03D0,0.03D0), (3.0D0,6.0D0),
193 + (-0.18D0,0.03D0), (4.0D0,7.0D0),
194 + (0.03D0,-0.09D0), (7.0D0,2.0D0), (7.0D0,2.0D0),
195 + (7.0D0,2.0D0), (0.09D0,0.03D0), (5.0D0,8.0D0),
196 + (0.03D0,0.12D0), (6.0D0,9.0D0), (0.12D0,0.03D0),
197 + (8.0D0,3.0D0), (0.03D0,0.06D0), (9.0D0,4.0D0)/
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(DZNRM2TEST(N,CX,INCX),STRUE2(NP1),
212 ELSE IF (ICASE.EQ.7) THEN
214 CALL STEST1(DZASUMTEST(N,CX,INCX),STRUE4(NP1),
216 ELSE IF (ICASE.EQ.8) THEN
218 CALL ZSCALTEST(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 ZDSCALTEST(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(IZAMAXTEST(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.0D0,0.0D0)
244 MWPCS(I) = (1.0D0,1.0D0)
246 CALL ZSCALTEST(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.0D0,0.0D0)
254 MWPCS(I) = (1.0D0,1.0D0)
256 CALL ZDSCALTEST(5,SA,CX,INCX)
257 CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
258 * Add a test for alpha equal to one.
264 CALL ZDSCALTEST(5,SA,CX,INCX)
265 CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
266 * Add a test for alpha equal to minus one.
272 CALL ZDSCALTEST(5,SA,CX,INCX)
273 CALL CTEST(5,CX,MWPCT,MWPCS,SFAC)
277 SUBROUTINE CHECK2(SFAC)
281 * .. Scalar Arguments ..
282 DOUBLE PRECISION SFAC
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*16 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 ZDOTCTEST, ZDOTUTEST
296 * .. External Subroutines ..
297 EXTERNAL ZAXPYTEST, ZCOPYTEST, ZSWAPTEST, CTEST
298 * .. Intrinsic Functions ..
300 * .. Common blocks ..
301 COMMON /COMBLA/ICASE, N, INCX, INCY, MODE, PASS
302 * .. Data statements ..
303 DATA CA/(0.4D0,-0.7D0)/
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.7D0,-0.8D0), (-0.4D0,-0.7D0),
309 + (-0.1D0,-0.9D0), (0.2D0,-0.8D0),
310 + (-0.9D0,-0.4D0), (0.1D0,0.4D0), (-0.6D0,0.6D0)/
311 DATA CY1/(0.6D0,-0.6D0), (-0.9D0,0.5D0),
312 + (0.7D0,-0.6D0), (0.1D0,-0.5D0), (-0.1D0,-0.2D0),
313 + (-0.5D0,-0.3D0), (0.8D0,-0.7D0)/
314 DATA ((CT8(I,J,1),I=1,7),J=1,4)/(0.6D0,-0.6D0),
315 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
316 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
317 + (0.32D0,-1.41D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
318 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
319 + (0.0D0,0.0D0), (0.32D0,-1.41D0),
320 + (-1.55D0,0.5D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
321 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
322 + (0.32D0,-1.41D0), (-1.55D0,0.5D0),
323 + (0.03D0,-0.89D0), (-0.38D0,-0.96D0),
324 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/
325 DATA ((CT8(I,J,2),I=1,7),J=1,4)/(0.6D0,-0.6D0),
326 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
327 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
328 + (0.32D0,-1.41D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
329 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
330 + (0.0D0,0.0D0), (-0.07D0,-0.89D0),
331 + (-0.9D0,0.5D0), (0.42D0,-1.41D0), (0.0D0,0.0D0),
332 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
333 + (0.78D0,0.06D0), (-0.9D0,0.5D0),
334 + (0.06D0,-0.13D0), (0.1D0,-0.5D0),
335 + (-0.77D0,-0.49D0), (-0.5D0,-0.3D0),
337 DATA ((CT8(I,J,3),I=1,7),J=1,4)/(0.6D0,-0.6D0),
338 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
339 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
340 + (0.32D0,-1.41D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
341 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
342 + (0.0D0,0.0D0), (-0.07D0,-0.89D0),
343 + (-1.18D0,-0.31D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
344 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
345 + (0.78D0,0.06D0), (-1.54D0,0.97D0),
346 + (0.03D0,-0.89D0), (-0.18D0,-1.31D0),
347 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/
348 DATA ((CT8(I,J,4),I=1,7),J=1,4)/(0.6D0,-0.6D0),
349 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
350 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
351 + (0.32D0,-1.41D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
352 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
353 + (0.0D0,0.0D0), (0.32D0,-1.41D0), (-0.9D0,0.5D0),
354 + (0.05D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
355 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.32D0,-1.41D0),
356 + (-0.9D0,0.5D0), (0.05D0,-0.6D0), (0.1D0,-0.5D0),
357 + (-0.77D0,-0.49D0), (-0.5D0,-0.3D0),
359 DATA CT7/(0.0D0,0.0D0), (-0.06D0,-0.90D0),
360 + (0.65D0,-0.47D0), (-0.34D0,-1.22D0),
361 + (0.0D0,0.0D0), (-0.06D0,-0.90D0),
362 + (-0.59D0,-1.46D0), (-1.04D0,-0.04D0),
363 + (0.0D0,0.0D0), (-0.06D0,-0.90D0),
364 + (-0.83D0,0.59D0), (0.07D0,-0.37D0),
365 + (0.0D0,0.0D0), (-0.06D0,-0.90D0),
366 + (-0.76D0,-1.15D0), (-1.33D0,-1.82D0)/
367 DATA CT6/(0.0D0,0.0D0), (0.90D0,0.06D0),
368 + (0.91D0,-0.77D0), (1.80D0,-0.10D0),
369 + (0.0D0,0.0D0), (0.90D0,0.06D0), (1.45D0,0.74D0),
370 + (0.20D0,0.90D0), (0.0D0,0.0D0), (0.90D0,0.06D0),
371 + (-0.55D0,0.23D0), (0.83D0,-0.39D0),
372 + (0.0D0,0.0D0), (0.90D0,0.06D0), (1.04D0,0.79D0),
374 DATA ((CT10X(I,J,1),I=1,7),J=1,4)/(0.7D0,-0.8D0),
375 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
376 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
377 + (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
378 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
379 + (0.0D0,0.0D0), (0.6D0,-0.6D0), (-0.9D0,0.5D0),
380 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
381 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.6D0,-0.6D0),
382 + (-0.9D0,0.5D0), (0.7D0,-0.6D0), (0.1D0,-0.5D0),
383 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/
384 DATA ((CT10X(I,J,2),I=1,7),J=1,4)/(0.7D0,-0.8D0),
385 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
386 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
387 + (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
388 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
389 + (0.0D0,0.0D0), (0.7D0,-0.6D0), (-0.4D0,-0.7D0),
390 + (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
391 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.8D0,-0.7D0),
392 + (-0.4D0,-0.7D0), (-0.1D0,-0.2D0),
393 + (0.2D0,-0.8D0), (0.7D0,-0.6D0), (0.1D0,0.4D0),
395 DATA ((CT10X(I,J,3),I=1,7),J=1,4)/(0.7D0,-0.8D0),
396 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
397 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
398 + (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
399 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
400 + (0.0D0,0.0D0), (-0.9D0,0.5D0), (-0.4D0,-0.7D0),
401 + (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
402 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.1D0,-0.5D0),
403 + (-0.4D0,-0.7D0), (0.7D0,-0.6D0), (0.2D0,-0.8D0),
404 + (-0.9D0,0.5D0), (0.1D0,0.4D0), (0.6D0,-0.6D0)/
405 DATA ((CT10X(I,J,4),I=1,7),J=1,4)/(0.7D0,-0.8D0),
406 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
407 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
408 + (0.6D0,-0.6D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
409 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
410 + (0.0D0,0.0D0), (0.6D0,-0.6D0), (0.7D0,-0.6D0),
411 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
412 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.6D0,-0.6D0),
413 + (0.7D0,-0.6D0), (-0.1D0,-0.2D0), (0.8D0,-0.7D0),
414 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0)/
415 DATA ((CT10Y(I,J,1),I=1,7),J=1,4)/(0.6D0,-0.6D0),
416 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
417 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
418 + (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
419 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
420 + (0.0D0,0.0D0), (0.7D0,-0.8D0), (-0.4D0,-0.7D0),
421 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
422 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.7D0,-0.8D0),
423 + (-0.4D0,-0.7D0), (-0.1D0,-0.9D0),
424 + (0.2D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
426 DATA ((CT10Y(I,J,2),I=1,7),J=1,4)/(0.6D0,-0.6D0),
427 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
428 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
429 + (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
430 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
431 + (0.0D0,0.0D0), (-0.1D0,-0.9D0), (-0.9D0,0.5D0),
432 + (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
433 + (0.0D0,0.0D0), (0.0D0,0.0D0), (-0.6D0,0.6D0),
434 + (-0.9D0,0.5D0), (-0.9D0,-0.4D0), (0.1D0,-0.5D0),
435 + (-0.1D0,-0.9D0), (-0.5D0,-0.3D0),
437 DATA ((CT10Y(I,J,3),I=1,7),J=1,4)/(0.6D0,-0.6D0),
438 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
439 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
440 + (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
441 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
442 + (0.0D0,0.0D0), (-0.1D0,-0.9D0), (0.7D0,-0.8D0),
443 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
444 + (0.0D0,0.0D0), (0.0D0,0.0D0), (-0.6D0,0.6D0),
445 + (-0.9D0,-0.4D0), (-0.1D0,-0.9D0),
446 + (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
448 DATA ((CT10Y(I,J,4),I=1,7),J=1,4)/(0.6D0,-0.6D0),
449 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
450 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
451 + (0.7D0,-0.8D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
452 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
453 + (0.0D0,0.0D0), (0.7D0,-0.8D0), (-0.9D0,0.5D0),
454 + (-0.4D0,-0.7D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
455 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.7D0,-0.8D0),
456 + (-0.9D0,0.5D0), (-0.4D0,-0.7D0), (0.1D0,-0.5D0),
457 + (-0.1D0,-0.9D0), (-0.5D0,-0.3D0),
459 DATA CSIZE1/(0.0D0,0.0D0), (0.9D0,0.9D0),
460 + (1.63D0,1.73D0), (2.90D0,2.78D0)/
461 DATA CSIZE3/(0.0D0,0.0D0), (0.0D0,0.0D0),
462 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
463 + (0.0D0,0.0D0), (0.0D0,0.0D0), (1.17D0,1.17D0),
464 + (1.17D0,1.17D0), (1.17D0,1.17D0),
465 + (1.17D0,1.17D0), (1.17D0,1.17D0),
466 + (1.17D0,1.17D0), (1.17D0,1.17D0)/
467 DATA CSIZE2/(0.0D0,0.0D0), (0.0D0,0.0D0),
468 + (0.0D0,0.0D0), (0.0D0,0.0D0), (0.0D0,0.0D0),
469 + (0.0D0,0.0D0), (0.0D0,0.0D0), (1.54D0,1.54D0),
470 + (1.54D0,1.54D0), (1.54D0,1.54D0),
471 + (1.54D0,1.54D0), (1.54D0,1.54D0),
472 + (1.54D0,1.54D0), (1.54D0,1.54D0)/
473 * .. Executable Statements ..
485 * .. initialize all argument arrays ..
492 CALL ZDOTCTEST(N,CX,INCX,CY,INCY,ZTEMP)
494 CALL CTEST(1,CDOT,CT6(KN,KI),CSIZE1(KN),SFAC)
495 ELSE IF (ICASE.EQ.2) THEN
497 CALL ZDOTUTEST(N,CX,INCX,CY,INCY,ZTEMP)
499 CALL CTEST(1,CDOT,CT7(KN,KI),CSIZE1(KN),SFAC)
500 ELSE IF (ICASE.EQ.3) THEN
502 CALL ZAXPYTEST(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 ZCOPYTEST(N,CX,INCX,CY,INCY)
507 CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0D0)
508 ELSE IF (ICASE.EQ.5) THEN
510 CALL ZSWAPTEST(N,CX,INCX,CY,INCY)
511 CALL CTEST(LENX,CX,CT10X(1,KN,KI),CSIZE3,1.0D0)
512 CALL CTEST(LENY,CY,CT10Y(1,KN,KI),CSIZE3,1.0D0)
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 ..
535 DOUBLE PRECISION SFAC
537 * .. Array Arguments ..
538 DOUBLE PRECISION SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
539 * .. Scalars in Common ..
540 INTEGER ICASE, INCX, INCY, MODE, N
542 * .. Local Scalars ..
545 * .. External Functions ..
546 DOUBLE PRECISION SDIFF
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.0D0)
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,2D36.8,2D12.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 DOUBLE PRECISION SCOMP1, SFAC, STRUE1
588 * .. Array Arguments ..
589 DOUBLE PRECISION SSIZE(*)
591 DOUBLE PRECISION SCOMP(1), STRUE(1)
592 * .. External Subroutines ..
594 * .. Executable Statements ..
598 CALL STEST(1,SCOMP,STRUE,SSIZE,SFAC)
602 DOUBLE PRECISION FUNCTION SDIFF(SA,SB)
603 * ********************************* SDIFF **************************
604 * COMPUTES DIFFERENCE OF TWO NUMBERS. C. L. LAWSON, JPL 1974 FEB 15
606 * .. Scalar Arguments ..
607 DOUBLE PRECISION SA, SB
608 * .. Executable Statements ..
612 SUBROUTINE CTEST(LEN,CCOMP,CTRUE,CSIZE,SFAC)
613 * **************************** CTEST *****************************
615 * C.L. LAWSON, JPL, 1978 DEC 6
617 * .. Scalar Arguments ..
618 DOUBLE PRECISION SFAC
620 * .. Array Arguments ..
621 COMPLEX*16 CCOMP(LEN), CSIZE(LEN), CTRUE(LEN)
622 * .. Local Scalars ..
625 DOUBLE PRECISION SCOMP(20), SSIZE(20), STRUE(20)
626 * .. External Subroutines ..
628 * .. Intrinsic Functions ..
629 INTRINSIC DIMAG, DBLE
630 * .. Executable Statements ..
632 SCOMP(2*I-1) = DBLE(CCOMP(I))
633 SCOMP(2*I) = DIMAG(CCOMP(I))
634 STRUE(2*I-1) = DBLE(CTRUE(I))
635 STRUE(2*I) = DIMAG(CTRUE(I))
636 SSIZE(2*I-1) = DBLE(CSIZE(I))
637 SSIZE(2*I) = DIMAG(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)