368
369 INTEGER NOUT
370 parameter(nout=6)
371
372 REAL SFAC
373
374 INTEGER ICASE, INCX, INCY, N
375 LOGICAL PASS
376
377 REAL SA
378 INTEGER I, J, KI, KN, KNI, KPAR, KSIZE, LENX, LENY,
379 $ LINCX, LINCY, MX, MY
380
381 REAL DT10X(7,4,4), DT10Y(7,4,4), DT7(4,4),
382 $ DT8(7,4,4), DX1(7),
383 $ DY1(7), SSIZE1(4), SSIZE2(14,2), SSIZE3(4),
384 $ SSIZE(7), STX(7), STY(7), SX(7), SY(7),
385 $ DPAR(5,4), DT19X(7,4,16),DT19XA(7,4,4),
386 $ DT19XB(7,4,4), DT19XC(7,4,4),DT19XD(7,4,4),
387 $ DT19Y(7,4,16), DT19YA(7,4,4),DT19YB(7,4,4),
388 $ DT19YC(7,4,4), DT19YD(7,4,4), DTEMP(5),
389 $ ST7B(4,4), STY0(1), SX0(1), SY0(1)
390 INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4)
391
392 REAL SDOT, SDSDOT
394
396
397 INTRINSIC abs, min
398
399 COMMON /combla/icase, n, incx, incy, pass
400
401 equivalence(dt19x(1,1,1),dt19xa(1,1,1)),(dt19x(1,1,5),
402 a dt19xb(1,1,1)),(dt19x(1,1,9),dt19xc(1,1,1)),
403 b (dt19x(1,1,13),dt19xd(1,1,1))
404 equivalence(dt19y(1,1,1),dt19ya(1,1,1)),(dt19y(1,1,5),
405 a dt19yb(1,1,1)),(dt19y(1,1,9),dt19yc(1,1,1)),
406 b (dt19y(1,1,13),dt19yd(1,1,1))
407
408 DATA sa/0.3e0/
409 DATA incxs/1, 2, -2, -1/
410 DATA incys/1, -2, 1, -2/
411 DATA lens/1, 1, 2, 4, 1, 1, 3, 7/
412 DATA ns/0, 1, 2, 4/
413 DATA dx1/0.6e0, 0.1e0, -0.5e0, 0.8e0, 0.9e0, -0.3e0,
414 + -0.4e0/
415 DATA dy1/0.5e0, -0.9e0, 0.3e0, 0.7e0, -0.6e0, 0.2e0,
416 + 0.8e0/
417 DATA dt7/0.0e0, 0.30e0, 0.21e0, 0.62e0, 0.0e0,
418 + 0.30e0, -0.07e0, 0.85e0, 0.0e0, 0.30e0, -0.79e0,
419 + -0.74e0, 0.0e0, 0.30e0, 0.33e0, 1.27e0/
420 DATA st7b/ .1, .4, .31, .72, .1, .4, .03, .95,
421 + .1, .4, -.69, -.64, .1, .4, .43, 1.37/
422 DATA dt8/0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
423 + 0.0e0, 0.68e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
424 + 0.0e0, 0.0e0, 0.68e0, -0.87e0, 0.0e0, 0.0e0,
425 + 0.0e0, 0.0e0, 0.0e0, 0.68e0, -0.87e0, 0.15e0,
426 + 0.94e0, 0.0e0, 0.0e0, 0.0e0, 0.5e0, 0.0e0,
427 + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.68e0,
428 + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
429 + 0.35e0, -0.9e0, 0.48e0, 0.0e0, 0.0e0, 0.0e0,
430 + 0.0e0, 0.38e0, -0.9e0, 0.57e0, 0.7e0, -0.75e0,
431 + 0.2e0, 0.98e0, 0.5e0, 0.0e0, 0.0e0, 0.0e0,
432 + 0.0e0, 0.0e0, 0.0e0, 0.68e0, 0.0e0, 0.0e0,
433 + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.35e0, -0.72e0,
434 + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.38e0,
435 + -0.63e0, 0.15e0, 0.88e0, 0.0e0, 0.0e0, 0.0e0,
436 + 0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
437 + 0.68e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
438 + 0.0e0, 0.68e0, -0.9e0, 0.33e0, 0.0e0, 0.0e0,
439 + 0.0e0, 0.0e0, 0.68e0, -0.9e0, 0.33e0, 0.7e0,
440 + -0.75e0, 0.2e0, 1.04e0/
441 DATA dt10x/0.6e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
442 + 0.0e0, 0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
443 + 0.0e0, 0.5e0, -0.9e0, 0.0e0, 0.0e0, 0.0e0,
444 + 0.0e0, 0.0e0, 0.5e0, -0.9e0, 0.3e0, 0.7e0,
445 + 0.0e0, 0.0e0, 0.0e0, 0.6e0, 0.0e0, 0.0e0, 0.0e0,
446 + 0.0e0, 0.0e0, 0.0e0, 0.5e0, 0.0e0, 0.0e0, 0.0e0,
447 + 0.0e0, 0.0e0, 0.0e0, 0.3e0, 0.1e0, 0.5e0, 0.0e0,
448 + 0.0e0, 0.0e0, 0.0e0, 0.8e0, 0.1e0, -0.6e0,
449 + 0.8e0, 0.3e0, -0.3e0, 0.5e0, 0.6e0, 0.0e0,
450 + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.5e0, 0.0e0,
451 + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, -0.9e0,
452 + 0.1e0, 0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.7e0,
453 + 0.1e0, 0.3e0, 0.8e0, -0.9e0, -0.3e0, 0.5e0,
454 + 0.6e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
455 + 0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
456 + 0.5e0, 0.3e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
457 + 0.5e0, 0.3e0, -0.6e0, 0.8e0, 0.0e0, 0.0e0,
458 + 0.0e0/
459 DATA dt10y/0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
460 + 0.0e0, 0.6e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
461 + 0.0e0, 0.6e0, 0.1e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
462 + 0.0e0, 0.6e0, 0.1e0, -0.5e0, 0.8e0, 0.0e0,
463 + 0.0e0, 0.0e0, 0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
464 + 0.0e0, 0.0e0, 0.6e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
465 + 0.0e0, 0.0e0, -0.5e0, -0.9e0, 0.6e0, 0.0e0,
466 + 0.0e0, 0.0e0, 0.0e0, -0.4e0, -0.9e0, 0.9e0,
467 + 0.7e0, -0.5e0, 0.2e0, 0.6e0, 0.5e0, 0.0e0,
468 + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.6e0, 0.0e0,
469 + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, -0.5e0,
470 + 0.6e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
471 + -0.4e0, 0.9e0, -0.5e0, 0.6e0, 0.0e0, 0.0e0,
472 + 0.0e0, 0.5e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
473 + 0.0e0, 0.6e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
474 + 0.0e0, 0.6e0, -0.9e0, 0.1e0, 0.0e0, 0.0e0,
475 + 0.0e0, 0.0e0, 0.6e0, -0.9e0, 0.1e0, 0.7e0,
476 + -0.5e0, 0.2e0, 0.8e0/
477 DATA ssize1/0.0e0, 0.3e0, 1.6e0, 3.2e0/
478 DATA ssize2/0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
479 + 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0, 0.0e0,
480 + 0.0e0, 1.17e0, 1.17e0, 1.17e0, 1.17e0, 1.17e0,
481 + 1.17e0, 1.17e0, 1.17e0, 1.17e0, 1.17e0, 1.17e0,
482 + 1.17e0, 1.17e0, 1.17e0/
483 DATA ssize3/ .1, .4, 1.7, 3.3 /
484
485
486
487 DATA dpar/-2.e0, 0.e0,0.e0,0.e0,0.e0,
488 a -1.e0, 2.e0, -3.e0, -4.e0, 5.e0,
489 b 0.e0, 0.e0, 2.e0, -3.e0, 0.e0,
490 c 1.e0, 5.e0, 2.e0, 0.e0, -4.e0/
491
492 DATA dt19xa/.6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
493 a .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
494 b .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
495 c .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
496 d .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
497 e -.8e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
498 f -.9e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
499 g 3.5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
500 h .6e0, .1e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
501 i -.8e0, 3.8e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
502 j -.9e0, 2.8e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
503 k 3.5e0, -.4e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
504 l .6e0, .1e0, -.5e0, .8e0, 0.e0,0.e0,0.e0,
505 m -.8e0, 3.8e0, -2.2e0, -1.2e0, 0.e0,0.e0,0.e0,
506 n -.9e0, 2.8e0, -1.4e0, -1.3e0, 0.e0,0.e0,0.e0,
507 o 3.5e0, -.4e0, -2.2e0, 4.7e0, 0.e0,0.e0,0.e0/
508
509 DATA dt19xb/.6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
510 a .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
511 b .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
512 c .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
513 d .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
514 e -.8e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
515 f -.9e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
516 g 3.5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
517 h .6e0, .1e0, -.5e0, 0.e0,0.e0,0.e0,0.e0,
518 i 0.e0, .1e0, -3.0e0, 0.e0,0.e0,0.e0,0.e0,
519 j -.3e0, .1e0, -2.0e0, 0.e0,0.e0,0.e0,0.e0,
520 k 3.3e0, .1e0, -2.0e0, 0.e0,0.e0,0.e0,0.e0,
521 l .6e0, .1e0, -.5e0, .8e0, .9e0, -.3e0, -.4e0,
522 m -2.0e0, .1e0, 1.4e0, .8e0, .6e0, -.3e0, -2.8e0,
523 n -1.8e0, .1e0, 1.3e0, .8e0, 0.e0, -.3e0, -1.9e0,
524 o 3.8e0, .1e0, -3.1e0, .8e0, 4.8e0, -.3e0, -1.5e0 /
525
526 DATA dt19xc/.6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
527 a .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
528 b .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
529 c .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
530 d .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
531 e -.8e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
532 f -.9e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
533 g 3.5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
534 h .6e0, .1e0, -.5e0, 0.e0,0.e0,0.e0,0.e0,
535 i 4.8e0, .1e0, -3.0e0, 0.e0,0.e0,0.e0,0.e0,
536 j 3.3e0, .1e0, -2.0e0, 0.e0,0.e0,0.e0,0.e0,
537 k 2.1e0, .1e0, -2.0e0, 0.e0,0.e0,0.e0,0.e0,
538 l .6e0, .1e0, -.5e0, .8e0, .9e0, -.3e0, -.4e0,
539 m -1.6e0, .1e0, -2.2e0, .8e0, 5.4e0, -.3e0, -2.8e0,
540 n -1.5e0, .1e0, -1.4e0, .8e0, 3.6e0, -.3e0, -1.9e0,
541 o 3.7e0, .1e0, -2.2e0, .8e0, 3.6e0, -.3e0, -1.5e0 /
542
543 DATA dt19xd/.6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
544 a .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
545 b .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
546 c .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
547 d .6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
548 e -.8e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
549 f -.9e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
550 g 3.5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
551 h .6e0, .1e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
552 i -.8e0, -1.0e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
553 j -.9e0, -.8e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
554 k 3.5e0, .8e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
555 l .6e0, .1e0, -.5e0, .8e0, 0.e0,0.e0,0.e0,
556 m -.8e0, -1.0e0, 1.4e0, -1.6e0, 0.e0,0.e0,0.e0,
557 n -.9e0, -.8e0, 1.3e0, -1.6e0, 0.e0,0.e0,0.e0,
558 o 3.5e0, .8e0, -3.1e0, 4.8e0, 0.e0,0.e0,0.e0/
559
560 DATA dt19ya/.5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
561 a .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
562 b .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
563 c .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
564 d .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
565 e .7e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
566 f 1.7e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
567 g -2.6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
568 h .5e0, -.9e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
569 i .7e0, -4.8e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
570 j 1.7e0, -.7e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
571 k -2.6e0, 3.5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
572 l .5e0, -.9e0, .3e0, .7e0, 0.e0,0.e0,0.e0,
573 m .7e0, -4.8e0, 3.0e0, 1.1e0, 0.e0,0.e0,0.e0,
574 n 1.7e0, -.7e0, -.7e0, 2.3e0, 0.e0,0.e0,0.e0,
575 o -2.6e0, 3.5e0, -.7e0, -3.6e0, 0.e0,0.e0,0.e0/
576
577 DATA dt19yb/.5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
578 a .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
579 b .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
580 c .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
581 d .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
582 e .7e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
583 f 1.7e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
584 g -2.6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
585 h .5e0, -.9e0, .3e0, 0.e0,0.e0,0.e0,0.e0,
586 i 4.0e0, -.9e0, -.3e0, 0.e0,0.e0,0.e0,0.e0,
587 j -.5e0, -.9e0, 1.5e0, 0.e0,0.e0,0.e0,0.e0,
588 k -1.5e0, -.9e0, -1.8e0, 0.e0,0.e0,0.e0,0.e0,
589 l .5e0, -.9e0, .3e0, .7e0, -.6e0, .2e0, .8e0,
590 m 3.7e0, -.9e0, -1.2e0, .7e0, -1.5e0, .2e0, 2.2e0,
591 n -.3e0, -.9e0, 2.1e0, .7e0, -1.6e0, .2e0, 2.0e0,
592 o -1.6e0, -.9e0, -2.1e0, .7e0, 2.9e0, .2e0, -3.8e0 /
593
594 DATA dt19yc/.5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
595 a .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
596 b .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
597 c .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
598 d .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
599 e .7e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
600 f 1.7e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
601 g -2.6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
602 h .5e0, -.9e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
603 i 4.0e0, -6.3e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
604 j -.5e0, .3e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
605 k -1.5e0, 3.0e0, 0.e0,0.e0,0.e0,0.e0,0.e0,
606 l .5e0, -.9e0, .3e0, .7e0, 0.e0,0.e0,0.e0,
607 m 3.7e0, -7.2e0, 3.0e0, 1.7e0, 0.e0,0.e0,0.e0,
608 n -.3e0, .9e0, -.7e0, 1.9e0, 0.e0,0.e0,0.e0,
609 o -1.6e0, 2.7e0, -.7e0, -3.4e0, 0.e0,0.e0,0.e0/
610
611 DATA dt19yd/.5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
612 a .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
613 b .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
614 c .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
615 d .5e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
616 e .7e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
617 f 1.7e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
618 g -2.6e0, 0.e0,0.e0,0.e0,0.e0,0.e0,0.e0,
619 h .5e0, -.9e0, .3e0, 0.e0,0.e0,0.e0,0.e0,
620 i .7e0, -.9e0, 1.2e0, 0.e0,0.e0,0.e0,0.e0,
621 j 1.7e0, -.9e0, .5e0, 0.e0,0.e0,0.e0,0.e0,
622 k -2.6e0, -.9e0, -1.3e0, 0.e0,0.e0,0.e0,0.e0,
623 l .5e0, -.9e0, .3e0, .7e0, -.6e0, .2e0, .8e0,
624 m .7e0, -.9e0, 1.2e0, .7e0, -1.5e0, .2e0, 1.6e0,
625 n 1.7e0, -.9e0, .5e0, .7e0, -1.6e0, .2e0, 2.4e0,
626 o -2.6e0, -.9e0, -1.3e0, .7e0, 2.9e0, .2e0, -4.0e0 /
627
628
629
630 DO 120 ki = 1, 4
631 incx = incxs(ki)
632 incy = incys(ki)
633 mx = abs(incx)
634 my = abs(incy)
635
636 DO 100 kn = 1, 4
637 n = ns(kn)
638 ksize = min(2,kn)
639 lenx = lens(kn,mx)
640 leny = lens(kn,my)
641
642 DO 20 i = 1, 7
643 sx(i) = dx1(i)
644 sy(i) = dy1(i)
645 20 CONTINUE
646
647 IF (icase.EQ.1) THEN
648
649 CALL stest1(
sdot(n,sx,incx,sy,incy),dt7(kn,ki),ssize1(kn)
650 + ,sfac)
651 ELSE IF (icase.EQ.2) THEN
652
653 CALL saxpy(n,sa,sx,incx,sy,incy)
654 DO 40 j = 1, leny
655 sty(j) = dt8(j,kn,ki)
656 40 CONTINUE
657 CALL stest(leny,sy,sty,ssize2(1,ksize),sfac)
658 ELSE IF (icase.EQ.5) THEN
659
660 DO 60 i = 1, 7
661 sty(i) = dt10y(i,kn,ki)
662 60 CONTINUE
663 CALL scopy(n,sx,incx,sy,incy)
664 CALL stest(leny,sy,sty,ssize2(1,1),1.0e0)
665 IF (ki.EQ.1) THEN
666 sx0(1) = 42.0e0
667 sy0(1) = 43.0e0
668 IF (n.EQ.0) THEN
669 sty0(1) = sy0(1)
670 ELSE
671 sty0(1) = sx0(1)
672 END IF
673 lincx = incx
674 incx = 0
675 lincy = incy
676 incy = 0
677 CALL scopy(n,sx0,incx,sy0,incy)
678 CALL stest(1,sy0,sty0,ssize2(1,1),1.0e0)
679 incx = lincx
680 incy = lincy
681 END IF
682 ELSE IF (icase.EQ.6) THEN
683
684 CALL sswap(n,sx,incx,sy,incy)
685 DO 80 i = 1, 7
686 stx(i) = dt10x(i,kn,ki)
687 sty(i) = dt10y(i,kn,ki)
688 80 CONTINUE
689 CALL stest(lenx,sx,stx,ssize2(1,1),1.0e0)
690 CALL stest(leny,sy,sty,ssize2(1,1),1.0e0)
691 ELSEIF (icase.EQ.12) THEN
692
693 kni=kn+4*(ki-1)
694 DO kpar=1,4
695 DO i=1,7
696 sx(i) = dx1(i)
697 sy(i) = dy1(i)
698 stx(i)= dt19x(i,kpar,kni)
699 sty(i)= dt19y(i,kpar,kni)
700 END DO
701
702 DO i=1,5
703 dtemp(i) = dpar(i,kpar)
704 END DO
705
706 DO i=1,lenx
707 ssize(i)=stx(i)
708 END DO
709
710
711 IF ((kpar .EQ. 2) .AND. (kni .EQ. 7))
712 $ ssize(1) = 2.4e0
713 IF ((kpar .EQ. 3) .AND. (kni .EQ. 8))
714 $ ssize(5) = 1.8e0
715
716 CALL srotm(n,sx,incx,sy,incy,dtemp)
717 CALL stest(lenx,sx,stx,ssize,sfac)
718 CALL stest(leny,sy,sty,sty,sfac)
719 END DO
720 ELSEIF (icase.EQ.13) THEN
721
723 $ st7b(kn,ki),ssize3(kn),sfac)
724 ELSE
725 WRITE (nout,*) ' Shouldn''t be here in CHECK2'
726 stop
727 END IF
728 100 CONTINUE
729 120 CONTINUE
730 RETURN
731
732
733
subroutine stest(len, scomp, strue, ssize, sfac)
subroutine stest1(scomp1, strue1, ssize, sfac)
subroutine saxpy(n, sa, sx, incx, sy, incy)
SAXPY
subroutine scopy(n, sx, incx, sy, incy)
SCOPY
real function sdsdot(n, sb, sx, incx, sy, incy)
SDSDOT
real function sdot(n, sx, incx, sy, incy)
SDOT
subroutine srotm(n, sx, incx, sy, incy, sparam)
SROTM
subroutine sswap(n, sx, incx, sy, incy)
SSWAP