48 INTEGER icase, incx, incy, n
56 COMMON /combla/icase, n, incx, incy, pass
58 DATA sfac/9.765625e-4/
73 IF (icase.EQ.3 .OR. icase.EQ.11)
THEN
75 ELSE IF (icase.EQ.7 .OR. icase.EQ.8 .OR. icase.EQ.9 .OR.
78 ELSE IF (icase.EQ.1 .OR. icase.EQ.2 .OR. icase.EQ.5 .OR.
79 + icase.EQ.6 .OR. icase.EQ.12 .OR. icase.EQ.13)
THEN
81 ELSE IF (icase.EQ.4)
THEN
85 IF (pass)
WRITE (nout,99998)
8999999
FORMAT (
' Real BLAS Test Program Results',/1x)
9099998
FORMAT (
' ----- PASS -----')
100 INTEGER ICASE, INCX, INCY, N
105 COMMON /combla/icase, n, incx, incy, pass
121 WRITE (nout,99999) icase, l(icase)
12499999
FORMAT (/
' Test of subprogram number',i3,12x,a6)
136 INTEGER ICASE, INCX, INCY, N
139 REAL D12, SA, SB, SC, SS
142 REAL DA1(8), DATRUE(8), DB1(8), DBTRUE(8), DC1(8),
143 + DS1(8), DAB(4,9), DTEMP(9), DTRUE(9,9)
147 COMMON /combla/icase, n, incx, incy, pass
149 DATA da1/0.3e0, 0.4e0, -0.3e0, -0.4e0, -0.3e0, 0.0e0,
151 DATA db1/0.4e0, 0.3e0, 0.4e0, 0.3e0, -0.4e0, 0.0e0,
153 DATA dc1/0.6e0, 0.8e0, -0.6e0, 0.8e0, 0.6e0, 1.0e0,
155 DATA ds1/0.8e0, 0.6e0, 0.8e0, -0.6e0, 0.8e0, 0.0e0,
157 DATA datrue/0.5e0, 0.5e0, 0.5e0, -0.5e0, -0.5e0,
158 + 0.0e0, 1.0e0, 1.0e0/
159 DATA dbtrue/0.0e0, 0.6e0, 0.0e0, -0.6e0, 0.0e0,
160 + 0.0e0, 1.0e0, 0.0e0/
162 DATA dab/ .1e0,.3e0,1.2e0,.2e0,
163 a .7e0, .2e0, .6e0, 4.2e0,
164 b 0.e0,0.e0,0.e0,0.e0,
165 c 4.e0, -1.e0, 2.e0, 4.e0,
166 d 6.e-10, 2.e-2, 1.e5, 10.e0,
167 e 4.e10, 2.e-2, 1.e-5, 10.e0,
168 f 2.e-10, 4.e-2, 1.e5, 10.e0,
169 g 2.e10, 4.e-2, 1.e-5, 10.e0,
170 h 4.e0, -2.e0, 8.e0, 4.e0 /
172 DATA dtrue/0.e0,0.e0, 1.3e0, .2e0, 0.e0,0.e0,0.e0, .5e0, 0.e0,
173 a 0.e0,0.e0, 4.5e0, 4.2e0, 1.e0, .5e0, 0.e0,0.e0,0.e0,
174 b 0.e0,0.e0,0.e0,0.e0, -2.e0, 0.e0,0.e0,0.e0,0.e0,
175 c 0.e0,0.e0,0.e0, 4.e0, -1.e0, 0.e0,0.e0,0.e0,0.e0,
176 d 0.e0, 15.e-3, 0.e0, 10.e0, -1.e0, 0.e0, -1.e-4,
178 f 0.e0,0.e0, 6144.e-5, 10.e0, -1.e0, 4096.e0, -1.e6,
180 h 0.e0,0.e0,15.e0,10.e0,-1.e0, 5.e-5, 0.e0,1.e0,0.e0,
181 i 0.e0,0.e0, 15.e0, 10.e0, -1. e0, 5.e5, -4096.e0,
183 k 0.e0,0.e0, 7.e0, 4.e0, 0.e0,0.e0, -.5e0, -.25e0, 0.e0/
186 dtrue(1,1) = 12.e0 / 130.e0
187 dtrue(2,1) = 36.e0 / 130.e0
188 dtrue(7,1) = -1.e0 / 6.e0
189 dtrue(1,2) = 14.e0 / 75.e0
190 dtrue(2,2) = 49.e0 / 75.e0
191 dtrue(9,2) = 1.e0 / 7.e0
192 dtrue(1,5) = 45.e-11 * (d12 * d12)
193 dtrue(3,5) = 4.e5 / (3.e0 * d12)
194 dtrue(6,5) = 1.e0 / d12
195 dtrue(8,5) = 1.e4 / (3.e0 * d12)
196 dtrue(1,6) = 4.e10 / (1.5e0 * d12 * d12)
197 dtrue(2,6) = 2.e-2 / 1.5e0
198 dtrue(8,6) = 5.e-7 * d12
199 dtrue(1,7) = 4.e0 / 150.e0
200 dtrue(2,7) = (2.e-10 / 1.5e0) * (d12 * d12)
201 dtrue(7,7) = -dtrue(6,5)
202 dtrue(9,7) = 1.e4 / d12
203 dtrue(1,8) = dtrue(1,7)
204 dtrue(2,8) = 2.e10 / (1.5e0 * d12 * d12)
205 dtrue(1,9) = 32.e0 / 7.e0
206 dtrue(2,9) = -16.e0 / 7.e0
212 dbtrue(1) = 1.0e0/0.6e0
213 dbtrue(3) = -1.0e0/0.6e0
214 dbtrue(5) = 1.0e0/0.6e0
224 CALL srotg(sa,sb,sc,ss)
225 CALL stest1(sa,datrue(k),datrue(k),sfac)
226 CALL stest1(sb,dbtrue(k),dbtrue(k),sfac)
227 CALL stest1(sc,dc1(k),dc1(k),sfac)
228 CALL stest1(ss,ds1(k),ds1(k),sfac)
229 ELSEIF (icase.EQ.11)
THEN
236 CALL srotmg(dtemp(1),dtemp(2),dtemp(3),dtemp(4),dtemp(5))
237 CALL stest(9,dtemp,dtrue(1,k),dtrue(1,k),sfac)
239 WRITE (nout,*)
' Shouldn''t be here in CHECK0'
255 INTEGER ICASE, INCX, INCY, N
258 INTEGER I, IX, LEN, NP1
260 REAL DTRUE1(5), DTRUE3(5), DTRUE5(8,5,2), DV(8,5,2),
261 + DVR(8), SA(10), STEMP(1), STRUE(8), SX(8),
263 INTEGER ITRUE2(5), ITRUEC(5)
267 EXTERNAL sasum, snrm2, isamax
273 COMMON /combla/icase, n, incx, incy, pass
275 DATA sa/0.3e0, -1.0e0, 0.0e0, 1.0e0, 0.3e0, 0.3e0,
276 + 0.3e0, 0.3e0, 0.3e0, 0.3e0/
277 DATA dv/0.1e0, 2.0e0, 2.0e0, 2.0e0, 2.0e0, 2.0e0,
278 + 2.0e0, 2.0e0, 0.3e0, 3.0e0, 3.0e0, 3.0e0, 3.0e0,
279 + 3.0e0, 3.0e0, 3.0e0, 0.3e0, -0.4e0, 4.0e0,
280 + 4.0e0, 4.0e0, 4.0e0, 4.0e0, 4.0e0, 0.2e0,
281 + -0.6e0, 0.3e0, 5.0e0, 5.0e0, 5.0e0, 5.0e0,
282 + 5.0e0, 0.1e0, -0.3e0, 0.5e0, -0.1e0, 6.0e0,
283 + 6.0e0, 6.0e0, 6.0e0, 0.1e0, 8.0e0, 8.0e0, 8.0e0,
284 + 8.0e0, 8.0e0, 8.0e0, 8.0e0, 0.3e0, 9.0e0, 9.0e0,
285 + 9.0e0, 9.0e0, 9.0e0, 9.0e0, 9.0e0, 0.3e0, 2.0e0,
286 + -0.4e0, 2.0e0, 2.0e0, 2.0e0, 2.0e0, 2.0e0,
287 + 0.2e0, 3.0e0, -0.6e0, 5.0e0, 0.3e0, 2.0e0,
288 + 2.0e0, 2.0e0, 0.1e0, 4.0e0, -0.3e0, 6.0e0,
289 + -0.5e0, 7.0e0, -0.1e0, 3.0e0/
290 DATA dvr/8.0e0, -7.0e0, 9.0e0, 5.0e0, 9.0e0, 8.0e0,
292 DATA dtrue1/0.0e0, 0.3e0, 0.5e0, 0.7e0, 0.6e0/
293 DATA dtrue3/0.0e0, 0.3e0, 0.7e0, 1.1e0, 1.0e0/
294 DATA dtrue5/0.10e0, 2.0e0, 2.0e0, 2.0e0, 2.0e0,
295 + 2.0e0, 2.0e0, 2.0e0, -0.3e0, 3.0e0, 3.0e0,
296 + 3.0e0, 3.0e0, 3.0e0, 3.0e0, 3.0e0, 0.0e0, 0.0e0,
297 + 4.0e0, 4.0e0, 4.0e0, 4.0e0, 4.0e0, 4.0e0,
298 + 0.20e0, -0.60e0, 0.30e0, 5.0e0, 5.0e0, 5.0e0,
299 + 5.0e0, 5.0e0, 0.03e0, -0.09e0, 0.15e0, -0.03e0,
300 + 6.0e0, 6.0e0, 6.0e0, 6.0e0, 0.10e0, 8.0e0,
301 + 8.0e0, 8.0e0, 8.0e0, 8.0e0, 8.0e0, 8.0e0,
302 + 0.09e0, 9.0e0, 9.0e0, 9.0e0, 9.0e0, 9.0e0,
303 + 9.0e0, 9.0e0, 0.09e0, 2.0e0, -0.12e0, 2.0e0,
304 + 2.0e0, 2.0e0, 2.0e0, 2.0e0, 0.06e0, 3.0e0,
305 + -0.18e0, 5.0e0, 0.09e0, 2.0e0, 2.0e0, 2.0e0,
306 + 0.03e0, 4.0e0, -0.09e0, 6.0e0, -0.15e0, 7.0e0,
308 DATA itrue2/0, 1, 2, 2, 3/
309 DATA itruec/0, 1, 1, 1, 1/
317 sx(i) = dv(i,np1,incx)
322 stemp(1) = dtrue1(np1)
323 CALL stest1(snrm2(n,sx,incx),stemp(1),stemp,sfac)
324 ELSE IF (icase.EQ.8)
THEN
326 stemp(1) = dtrue3(np1)
327 CALL stest1(sasum(n,sx,incx),stemp(1),stemp,sfac)
328 ELSE IF (icase.EQ.9)
THEN
330 CALL sscal(n,sa((incx-1)*5+np1),sx,incx)
332 strue(i) = dtrue5(i,np1,incx)
334 CALL stest(len,sx,strue,strue,sfac)
335 ELSE IF (icase.EQ.10)
THEN
337 CALL itest1(isamax(n,sx,incx),itrue2(np1))
341 CALL itest1(isamax(n,sx,incx),itruec(np1))
343 WRITE (nout,*)
' Shouldn''t be here in CHECK1'
347 IF (icase.EQ.10)
THEN
354 CALL itest1(isamax(n,sxr,incx),3)
369 INTEGER ICASE, INCX, INCY, N
373 INTEGER I, J, KI, KN, KNI, KPAR, KSIZE, LENX, LENY,
374 $ LINCX, LINCY, MX, MY
376 REAL DT10X(7,4,4), DT10Y(7,4,4), DT7(4,4),
377 $ DT8(7,4,4), DX1(7),
378 $ DY1(7), SSIZE1(4), SSIZE2(14,2), SSIZE3(4),
379 $ SSIZE(7), STX(7), STY(7), SX(7), SY(7),
380 $ DPAR(5,4), DT19X(7,4,16),DT19XA(7,4,4),
381 $ DT19XB(7,4,4), DT19XC(7,4,4),DT19XD(7,4,4),
382 $ DT19Y(7,4,16), DT19YA(7,4,4),DT19YB(7,4,4),
383 $ DT19YC(7,4,4), DT19YD(7,4,4), DTEMP(5),
384 $ ST7B(4,4), STY0(1), SX0(1), SY0(1)
385 INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4)
388 EXTERNAL sdot, sdsdot
394 COMMON /combla/icase, n, incx, incy, pass
396 equivalence(dt19x(1,1,1),dt19xa(1,1,1)),(dt19x(1,1,5),
397 a dt19xb(1,1,1)),(dt19x(1,1,9),dt19xc(1,1,1)),
398 b (dt19x(1,1,13),dt19xd(1,1,1))
399 equivalence(dt19y(1,1,1),dt19ya(1,1,1)),(dt19y(1,1,5),
400 a dt19yb(1,1,1)),(dt19y(1,1,9),dt19yc(1,1,1)),
401 b (dt19y(1,1,13),dt19yd(1,1,1))
404 DATA incxs/1, 2, -2, -1/
405 DATA incys/1, -2, 1, -2/
406 DATA lens/1, 1, 2, 4, 1, 1, 3, 7/
408 DATA dx1/0.6e0, 0.1e0, -0.5e0, 0.8e0, 0.9e0, -0.3e0,
410 DATA dy1/0.5e0, -0.9e0, 0.3e0, 0.7e0, -0.6e0, 0.2e0,
412 DATA dt7/0.0e0, 0.30e0, 0.21e0, 0.62e0, 0.0e0,
413 + 0.30e0, -0.07e0, 0.85e0, 0.0e0, 0.30e0, -0.79e0,
414 + -0.74e0, 0.0e0, 0.30e0, 0.33e0, 1.27e0/
415 DATA st7b/ .1, .4, .31, .72, .1, .4, .03, .95,
416 + .1, .4, -.69, -.64, .1, .4, .43, 1.37/
417 DATA dt8/0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
418 + 0.0e0, 0.68e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
419 + 0.0e0, 0.0e0, 0.68e0, -0.87e0, 0.0e0, 0.0e0,
420 + 0.0e0, 0.0e0, 0.0e0, 0.68e0, -0.87e0, 0.15e0,
421 + 0.94e0, 0.0e0, 0.0e0, 0.0e0, 0.5e0, 0.0e0,
422 + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.68e0,
423 + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
424 + 0.35e0, -0.9e0, 0.48e0, 0.0e0, 0.0e0, 0.0e0,
425 + 0.0e0, 0.38e0, -0.9e0, 0.57e0, 0.7e0, -0.75e0,
426 + 0.2e0, 0.98e0, 0.5e0, 0.0e0, 0.0e0, 0.0e0,
427 + 0.0e0, 0.0e0, 0.0e0, 0.68e0, 0.0e0, 0.0e0,
428 + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.35e0, -0.72e0,
429 + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.38e0,
430 + -0.63e0, 0.15e0, 0.88e0, 0.0e0, 0.0e0, 0.0e0,
431 + 0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
432 + 0.68e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
433 + 0.0e0, 0.68e0, -0.9e0, 0.33e0, 0.0e0, 0.0e0,
434 + 0.0e0, 0.0e0, 0.68e0, -0.9e0, 0.33e0, 0.7e0,
435 + -0.75e0, 0.2e0, 1.04e0/
436 DATA dt10x/0.6e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
437 + 0.0e0, 0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
438 + 0.0e0, 0.5e0, -0.9e0, 0.0e0, 0.0e0, 0.0e0,
439 + 0.0e0, 0.0e0, 0.5e0, -0.9e0, 0.3e0, 0.7e0,
440 + 0.0e0, 0.0e0, 0.0e0, 0.6e0, 0.0e0, 0.0e0, 0.0e0,
441 + 0.0e0, 0.0e0, 0.0e0, 0.5e0, 0.0e0, 0.0e0, 0.0e0,
442 + 0.0e0, 0.0e0, 0.0e0, 0.3e0, 0.1e0, 0.5e0, 0.0e0,
443 + 0.0e0, 0.0e0, 0.0e0, 0.8e0, 0.1e0, -0.6e0,
444 + 0.8e0, 0.3e0, -0.3e0, 0.5e0, 0.6e0, 0.0e0,
445 + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.5e0, 0.0e0,
446 + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, -0.9e0,
447 + 0.1e0, 0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.7e0,
448 + 0.1e0, 0.3e0, 0.8e0, -0.9e0, -0.3e0, 0.5e0,
449 + 0.6e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
450 + 0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
451 + 0.5e0, 0.3e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
452 + 0.5e0, 0.3e0, -0.6e0, 0.8e0, 0.0e0, 0.0e0,
454 DATA dt10y/0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
455 + 0.0e0, 0.6e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
456 + 0.0e0, 0.6e0, 0.1e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
457 + 0.0e0, 0.6e0, 0.1e0, -0.5e0, 0.8e0, 0.0e0,
458 + 0.0e0, 0.0e0, 0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
459 + 0.0e0, 0.0e0, 0.6e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
460 + 0.0e0, 0.0e0, -0.5e0, -0.9e0, 0.6e0, 0.0e0,
461 + 0.0e0, 0.0e0, 0.0e0, -0.4e0, -0.9e0, 0.9e0,
462 + 0.7e0, -0.5e0, 0.2e0, 0.6e0, 0.5e0, 0.0e0,
463 + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.6e0, 0.0e0,
464 + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, -0.5e0,
465 + 0.6e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
466 + -0.4e0, 0.9e0, -0.5e0, 0.6e0, 0.0e0, 0.0e0,
467 + 0.0e0, 0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
468 + 0.0e0, 0.6e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
469 + 0.0e0, 0.6e0, -0.9e0, 0.1e0, 0.0e0, 0.0e0,
470 + 0.0e0, 0.0e0, 0.6e0, -0.9e0, 0.1e0, 0.7e0,
471 + -0.5e0, 0.2e0, 0.8e0/
472 DATA ssize1/0.0e0, 0.3e0, 1.6e0, 3.2e0/
473 DATA ssize2/0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
474 + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
475 + 0.0e0, 1.17e0, 1.17e0, 1.17e0, 1.17e0, 1.17e0,
476 + 1.17e0, 1.17e0, 1.17e0, 1.17e0, 1.17e0, 1.17e0,
477 + 1.17e0, 1.17e0, 1.17e0/
478 DATA ssize3/ .1, .4, 1.7, 3.3 /
482 DATA dpar/-2.e0, 0.e0,0.e0,0.e0,0.e0,
483 a -1.e0, 2.e0, -3.e0, -4.e0, 5.e0,
484 b 0.e0, 0.e0, 2.e0, -3.e0, 0.e0,
485 c 1.e0, 5.e0, 2.e0, 0.e0, -4.e0/
487 DATA dt19xa/.6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
488 a .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
489 b .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
490 c .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
491 d .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
492 e -.8e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
493 f -.9e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
494 g 3.5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
495 h .6e0, .1e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
496 i -.8e0, 3.8e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
497 j -.9e0, 2.8e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
498 k 3.5e0, -.4e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
499 l .6e0, .1e0, -.5e0, .8e0, 0.e0,0.e0,0.e0,
500 m -.8e0, 3.8e0, -2.2e0, -1.2e0, 0.e0,0.e0,0.e0,
501 n -.9e0, 2.8e0, -1.4e0, -1.3e0, 0.e0,0.e0,0.e0,
502 o 3.5e0, -.4e0, -2.2e0, 4.7e0, 0.e0,0.e0,0.e0/
504 DATA dt19xb/.6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
505 a .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
506 b .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
507 c .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
508 d .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
509 e -.8e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
510 f -.9e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
511 g 3.5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
512 h .6e0, .1e0, -.5e0, 0.e0,0.e0,0.e0,0.e0,
513 i 0.e0, .1e0, -3.0e0, 0.e0,0.e0,0.e0,0.e0,
514 j -.3e0, .1e0, -2.0e0, 0.e0,0.e0,0.e0,0.e0,
515 k 3.3e0, .1e0, -2.0e0, 0.e0,0.e0,0.e0,0.e0,
516 l .6e0, .1e0, -.5e0, .8e0, .9e0, -.3e0, -.4e0,
517 m -2.0e0, .1e0, 1.4e0, .8e0, .6e0, -.3e0, -2.8e0,
518 n -1.8e0, .1e0, 1.3e0, .8e0, 0.e0, -.3e0, -1.9e0,
519 o 3.8e0, .1e0, -3.1e0, .8e0, 4.8e0, -.3e0, -1.5e0 /
521 DATA dt19xc/.6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
522 a .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
523 b .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
524 c .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
525 d .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
526 e -.8e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
527 f -.9e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
528 g 3.5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
529 h .6e0, .1e0, -.5e0, 0.e0,0.e0,0.e0,0.e0,
530 i 4.8e0, .1e0, -3.0e0, 0.e0,0.e0,0.e0,0.e0,
531 j 3.3e0, .1e0, -2.0e0, 0.e0,0.e0,0.e0,0.e0,
532 k 2.1e0, .1e0, -2.0e0, 0.e0,0.e0,0.e0,0.e0,
533 l .6e0, .1e0, -.5e0, .8e0, .9e0, -.3e0, -.4e0,
534 m -1.6e0, .1e0, -2.2e0, .8e0, 5.4e0, -.3e0, -2.8e0,
535 n -1.5e0, .1e0, -1.4e0, .8e0, 3.6e0, -.3e0, -1.9e0,
536 o 3.7e0, .1e0, -2.2e0, .8e0, 3.6e0, -.3e0, -1.5e0 /
538 DATA dt19xd/.6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
539 a .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
540 b .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
541 c .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
542 d .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
543 e -.8e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
544 f -.9e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
545 g 3.5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
546 h .6e0, .1e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
547 i -.8e0, -1.0e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
548 j -.9e0, -.8e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
549 k 3.5e0, .8e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
550 l .6e0, .1e0, -.5e0, .8e0, 0.e0,0.e0,0.e0,
551 m -.8e0, -1.0e0, 1.4e0, -1.6e0, 0.e0,0.e0,0.e0,
552 n -.9e0, -.8e0, 1.3e0, -1.6e0, 0.e0,0.e0,0.e0,
553 o 3.5e0, .8e0, -3.1e0, 4.8e0, 0.e0,0.e0,0.e0/
555 DATA dt19ya/.5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
556 a .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
557 b .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
558 c .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
559 d .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
560 e .7e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
561 f 1.7e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
562 g -2.6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
563 h .5e0, -.9e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
564 i .7e0, -4.8e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
565 j 1.7e0, -.7e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
566 k -2.6e0, 3.5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
567 l .5e0, -.9e0, .3e0, .7e0, 0.e0,0.e0,0.e0,
568 m .7e0, -4.8e0, 3.0e0, 1.1e0, 0.e0,0.e0,0.e0,
569 n 1.7e0, -.7e0, -.7e0, 2.3e0, 0.e0,0.e0,0.e0,
570 o -2.6e0, 3.5e0, -.7e0, -3.6e0, 0.e0,0.e0,0.e0/
572 DATA dt19yb/.5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
573 a .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
574 b .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
575 c .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
576 d .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
577 e .7e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
578 f 1.7e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
579 g -2.6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
580 h .5e0, -.9e0, .3e0, 0.e0,0.e0,0.e0,0.e0,
581 i 4.0e0, -.9e0, -.3e0, 0.e0,0.e0,0.e0,0.e0,
582 j -.5e0, -.9e0, 1.5e0, 0.e0,0.e0,0.e0,0.e0,
583 k -1.5e0, -.9e0, -1.8e0, 0.e0,0.e0,0.e0,0.e0,
584 l .5e0, -.9e0, .3e0, .7e0, -.6e0, .2e0, .8e0,
585 m 3.7e0, -.9e0, -1.2e0, .7e0, -1.5e0, .2e0, 2.2e0,
586 n -.3e0, -.9e0, 2.1e0, .7e0, -1.6e0, .2e0, 2.0e0,
587 o -1.6e0, -.9e0, -2.1e0, .7e0, 2.9e0, .2e0, -3.8e0 /
589 DATA dt19yc/.5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
590 a .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
591 b .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
592 c .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
593 d .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
594 e .7e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
595 f 1.7e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
596 g -2.6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
597 h .5e0, -.9e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
598 i 4.0e0, -6.3e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
599 j -.5e0, .3e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
600 k -1.5e0, 3.0e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
601 l .5e0, -.9e0, .3e0, .7e0, 0.e0,0.e0,0.e0,
602 m 3.7e0, -7.2e0, 3.0e0, 1.7e0, 0.e0,0.e0,0.e0,
603 n -.3e0, .9e0, -.7e0, 1.9e0, 0.e0,0.e0,0.e0,
604 o -1.6e0, 2.7e0, -.7e0, -3.4e0, 0.e0,0.e0,0.e0/
606 DATA dt19yd/.5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
607 a .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
608 b .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
609 c .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
610 d .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
611 e .7e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
612 f 1.7e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
613 g -2.6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
614 h .5e0, -.9e0, .3e0, 0.e0,0.e0,0.e0,0.e0,
615 i .7e0, -.9e0, 1.2e0, 0.e0,0.e0,0.e0,0.e0,
616 j 1.7e0, -.9e0, .5e0, 0.e0,0.e0,0.e0,0.e0,
617 k -2.6e0, -.9e0, -1.3e0, 0.e0,0.e0,0.e0,0.e0,
618 l .5e0, -.9e0, .3e0, .7e0, -.6e0, .2e0, .8e0,
619 m .7e0, -.9e0, 1.2e0, .7e0, -1.5e0, .2e0, 1.6e0,
620 n 1.7e0, -.9e0, .5e0, .7e0, -1.6e0, .2e0, 2.4e0,
621 o -2.6e0, -.9e0, -1.3e0, .7e0, 2.9e0, .2e0, -4.0e0 /
644 CALL stest1(sdot(n,sx,incx,sy,incy),dt7(kn,ki),ssize1(kn)
646 ELSE IF (icase.EQ.2)
THEN
648 CALL saxpy(n,sa,sx,incx,sy,incy)
650 sty(j) = dt8(j,kn,ki)
652 CALL stest(leny,sy,sty,ssize2(1,ksize),sfac)
653 ELSE IF (icase.EQ.5)
THEN
656 sty(i) = dt10y(i,kn,ki)
658 CALL scopy(n,sx,incx,sy,incy)
659 CALL stest(leny,sy,sty,ssize2(1,1),1.0e0)
672 CALL scopy(n,sx0,incx,sy0,incy)
673 CALL stest(1,sy0,sty0,ssize2(1,1),1.0e0)
677 ELSE IF (icase.EQ.6)
THEN
679 CALL sswap(n,sx,incx,sy,incy)
681 stx(i) = dt10x(i,kn,ki)
682 sty(i) = dt10y(i,kn,ki)
684 CALL stest(lenx,sx,stx,ssize2(1,1),1.0e0)
685 CALL stest(leny,sy,sty,ssize2(1,1),1.0e0)
686 ELSEIF (icase.EQ.12)
THEN
693 stx(i)= dt19x(i,kpar,kni)
694 sty(i)= dt19y(i,kpar,kni)
698 dtemp(i) = dpar(i,kpar)
706 IF ((kpar .EQ. 2) .AND. (kni .EQ. 7))
708 IF ((kpar .EQ. 3) .AND. (kni .EQ. 8))
711 CALL srotm(n,sx,incx,sy,incy,dtemp)
712 CALL stest(lenx,sx,stx,ssize,sfac)
713 CALL stest(leny,sy,sty,sty,sfac)
715 ELSEIF (icase.EQ.13)
THEN
717 CALL stest1 (sdsdot(n,.1,sx,incx,sy,incy),
718 $ st7b(kn,ki),ssize3(kn),sfac)
720 WRITE (nout,*)
' Shouldn''t be here in CHECK2'
737 INTEGER ICASE, INCX, INCY, N
741 INTEGER I, K, KI, KN, KSIZE, LENX, LENY, MX, MY
743 REAL COPYX(5), COPYY(5), DT9X(7,4,4), DT9Y(7,4,4),
744 + DX1(7), DY1(7), MWPC(11), MWPS(11), MWPSTX(5),
745 + MWPSTY(5), MWPTX(11,5), MWPTY(11,5), MWPX(5),
746 + MWPY(5), SSIZE2(14,2), STX(7), STY(7), SX(7),
748 INTEGER INCXS(4), INCYS(4), LENS(4,2), MWPINX(11),
749 + MWPINY(11), MWPN(11), NS(4)
755 COMMON /combla/icase, n, incx, incy, pass
757 DATA incxs/1, 2, -2, -1/
758 DATA incys/1, -2, 1, -2/
759 DATA lens/1, 1, 2, 4, 1, 1, 3, 7/
761 DATA dx1/0.6e0, 0.1e0, -0.5e0, 0.8e0, 0.9e0, -0.3e0,
763 DATA dy1/0.5e0, -0.9e0, 0.3e0, 0.7e0, -0.6e0, 0.2e0,
765 DATA sc, ss/0.8e0, 0.6e0/
766 DATA dt9x/0.6e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
767 + 0.0e0, 0.78e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
768 + 0.0e0, 0.0e0, 0.78e0, -0.46e0, 0.0e0, 0.0e0,
769 + 0.0e0, 0.0e0, 0.0e0, 0.78e0, -0.46e0, -0.22e0,
770 + 1.06e0, 0.0e0, 0.0e0, 0.0e0, 0.6e0, 0.0e0,
771 + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.78e0,
772 + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
773 + 0.66e0, 0.1e0, -0.1e0, 0.0e0, 0.0e0, 0.0e0,
774 + 0.0e0, 0.96e0, 0.1e0, -0.76e0, 0.8e0, 0.90e0,
775 + -0.3e0, -0.02e0, 0.6e0, 0.0e0, 0.0e0, 0.0e0,
776 + 0.0e0, 0.0e0, 0.0e0, 0.78e0, 0.0e0, 0.0e0,
777 + 0.0e0, 0.0e0, 0.0e0, 0.0e0, -0.06e0, 0.1e0,
778 + -0.1e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.90e0,
779 + 0.1e0, -0.22e0, 0.8e0, 0.18e0, -0.3e0, -0.02e0,
780 + 0.6e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
781 + 0.78e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
782 + 0.0e0, 0.78e0, 0.26e0, 0.0e0, 0.0e0, 0.0e0,
783 + 0.0e0, 0.0e0, 0.78e0, 0.26e0, -0.76e0, 1.12e0,
784 + 0.0e0, 0.0e0, 0.0e0/
785 DATA dt9y/0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
786 + 0.0e0, 0.04e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
787 + 0.0e0, 0.0e0, 0.04e0, -0.78e0, 0.0e0, 0.0e0,
788 + 0.0e0, 0.0e0, 0.0e0, 0.04e0, -0.78e0, 0.54e0,
789 + 0.08e0, 0.0e0, 0.0e0, 0.0e0, 0.5e0, 0.0e0,
790 + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.04e0,
791 + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.7e0,
792 + -0.9e0, -0.12e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
793 + 0.64e0, -0.9e0, -0.30e0, 0.7e0, -0.18e0, 0.2e0,
794 + 0.28e0, 0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
795 + 0.0e0, 0.0e0, 0.04e0, 0.0e0, 0.0e0, 0.0e0,
796 + 0.0e0, 0.0e0, 0.0e0, 0.7e0, -1.08e0, 0.0e0,
797 + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.64e0, -1.26e0,
798 + 0.54e0, 0.20e0, 0.0e0, 0.0e0, 0.0e0, 0.5e0,
799 + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
800 + 0.04e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
801 + 0.0e0, 0.04e0, -0.9e0, 0.18e0, 0.0e0, 0.0e0,
802 + 0.0e0, 0.0e0, 0.04e0, -0.9e0, 0.18e0, 0.7e0,
803 + -0.18e0, 0.2e0, 0.16e0/
804 DATA ssize2/0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
805 + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
806 + 0.0e0, 1.17e0, 1.17e0, 1.17e0, 1.17e0, 1.17e0,
807 + 1.17e0, 1.17e0, 1.17e0, 1.17e0, 1.17e0, 1.17e0,
808 + 1.17e0, 1.17e0, 1.17e0/
828 stx(i) = dt9x(i,kn,ki)
829 sty(i) = dt9y(i,kn,ki)
831 CALL srot(n,sx,incx,sy,incy,sc,ss)
832 CALL stest(lenx,sx,stx,ssize2(1,ksize),sfac)
833 CALL stest(leny,sy,sty,ssize2(1,ksize),sfac)
835 WRITE (nout,*)
' Shouldn''t be here in CHECK3'
927 mwpstx(k) = mwptx(i,k)
928 mwpsty(k) = mwpty(i,k)
930 CALL srot(mwpn(i),copyx,incx,copyy,incy,mwpc(i),mwps(i))
931 CALL stest(5,copyx,mwpstx,mwpstx,sfac)
932 CALL stest(5,copyy,mwpsty,mwpsty,sfac)
939 SUBROUTINE stest(LEN,SCOMP,STRUE,SSIZE,SFAC)
951 parameter(nout=6, zero=0.0e0)
956 REAL SCOMP(LEN), SSIZE(LEN), STRUE(LEN)
958 INTEGER ICASE, INCX, INCY, N
969 COMMON /combla/icase, n, incx, incy, pass
973 sd = scomp(i) - strue(i)
974 IF (abs(sfac*sd) .LE. abs(ssize(i))*epsilon(zero))
979 IF ( .NOT. pass)
GO TO 20
984 20
WRITE (nout,99997) icase, n, incx, incy, i, scomp(i),
985 + strue(i), sd, ssize(i)
98999999
FORMAT (
' FAIL')
99099998
FORMAT (/
' CASE N INCX INCY I ',
991 +
' COMP(I) TRUE(I) DIFFERENCE',
99399997
FORMAT (1x,i4,i3,2i5,i3,2e36.8,2e12.4)
998 SUBROUTINE stest1(SCOMP1,STRUE1,SSIZE,SFAC)
1008 REAL SCOMP1, SFAC, STRUE1
1012 REAL SCOMP(1), STRUE(1)
1019 CALL stest(1,scomp,strue,ssize,sfac)
1050 INTEGER ICOMP, ITRUE
1052 INTEGER ICASE, INCX, INCY, N
1057 COMMON /combla/icase, n, incx, incy, pass
1060 IF (icomp.EQ.itrue)
GO TO 40
1064 IF ( .NOT. pass)
GO TO 20
1069 20 id = icomp - itrue
1070 WRITE (nout,99997) icase, n, incx, incy, icomp, itrue, id
107499999
FORMAT (
' FAIL')
107599998
FORMAT (/
' CASE N INCX INCY ',
1076 +
' COMP TRUE DIFFERENCE',
107899997
FORMAT (1x,i4,i3,2i5,2i36,i12)
subroutine stest(LEN, SCOMP, STRUE, SSIZE, SFAC)
real function sdiff(SA, SB)
subroutine stest1(SCOMP1, STRUE1, SSIZE, SFAC)
subroutine itest1(ICOMP, ITRUE)
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
subroutine srot(N, SX, INCX, SY, INCY, C, S)
SROT
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine sscal(N, SA, SX, INCX)
SSCAL
subroutine srotg(a, b, c, s)
SROTG
subroutine srotm(N, SX, INCX, SY, INCY, SPARAM)
SROTM
subroutine srotmg(SD1, SD2, SX1, SY1, SPARAM)
SROTMG
subroutine saxpy(N, SA, SX, INCX, SY, INCY)
SAXPY