LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ check2()

subroutine check2 ( double precision  sfac)

Definition at line 367 of file dblat1.f.

368* .. Parameters ..
369 INTEGER NOUT
370 parameter(nout=6)
371* .. Scalar Arguments ..
372 DOUBLE PRECISION SFAC
373* .. Scalars in Common ..
374 INTEGER ICASE, INCX, INCY, N
375 LOGICAL PASS
376* .. Local Scalars ..
377 DOUBLE PRECISION SA
378 INTEGER I, J, KI, KN, KNI, KPAR, KSIZE, LENX, LENY,
379 $ LINCX, LINCY, MX, MY
380* .. Local Arrays ..
381 DOUBLE PRECISION 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), SSIZE(7),
384 $ 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 $ STY0(1), SX0(1), SY0(1)
390 INTEGER INCXS(4), INCYS(4), LENS(4,2), NS(4)
391* .. External Functions ..
392 DOUBLE PRECISION DDOT, DSDOT
393 EXTERNAL ddot, dsdot
394* .. External Subroutines ..
395 EXTERNAL daxpy, dcopy, drotm, dswap, stest, stest1,
396 $ testdsdot
397* .. Intrinsic Functions ..
398 INTRINSIC abs, min
399* .. Common blocks ..
400 COMMON /combla/icase, n, incx, incy, pass
401* .. Data statements ..
402 equivalence(dt19x(1,1,1),dt19xa(1,1,1)),(dt19x(1,1,5),
403 a dt19xb(1,1,1)),(dt19x(1,1,9),dt19xc(1,1,1)),
404 b (dt19x(1,1,13),dt19xd(1,1,1))
405 equivalence(dt19y(1,1,1),dt19ya(1,1,1)),(dt19y(1,1,5),
406 a dt19yb(1,1,1)),(dt19y(1,1,9),dt19yc(1,1,1)),
407 b (dt19y(1,1,13),dt19yd(1,1,1))
408
409 DATA sa/0.3d0/
410 DATA incxs/1, 2, -2, -1/
411 DATA incys/1, -2, 1, -2/
412 DATA lens/1, 1, 2, 4, 1, 1, 3, 7/
413 DATA ns/0, 1, 2, 4/
414 DATA dx1/0.6d0, 0.1d0, -0.5d0, 0.8d0, 0.9d0, -0.3d0,
415 + -0.4d0/
416 DATA dy1/0.5d0, -0.9d0, 0.3d0, 0.7d0, -0.6d0, 0.2d0,
417 + 0.8d0/
418 DATA dt7/0.0d0, 0.30d0, 0.21d0, 0.62d0, 0.0d0,
419 + 0.30d0, -0.07d0, 0.85d0, 0.0d0, 0.30d0, -0.79d0,
420 + -0.74d0, 0.0d0, 0.30d0, 0.33d0, 1.27d0/
421 DATA dt8/0.5d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
422 + 0.0d0, 0.68d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
423 + 0.0d0, 0.0d0, 0.68d0, -0.87d0, 0.0d0, 0.0d0,
424 + 0.0d0, 0.0d0, 0.0d0, 0.68d0, -0.87d0, 0.15d0,
425 + 0.94d0, 0.0d0, 0.0d0, 0.0d0, 0.5d0, 0.0d0,
426 + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.68d0,
427 + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
428 + 0.35d0, -0.9d0, 0.48d0, 0.0d0, 0.0d0, 0.0d0,
429 + 0.0d0, 0.38d0, -0.9d0, 0.57d0, 0.7d0, -0.75d0,
430 + 0.2d0, 0.98d0, 0.5d0, 0.0d0, 0.0d0, 0.0d0,
431 + 0.0d0, 0.0d0, 0.0d0, 0.68d0, 0.0d0, 0.0d0,
432 + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.35d0, -0.72d0,
433 + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.38d0,
434 + -0.63d0, 0.15d0, 0.88d0, 0.0d0, 0.0d0, 0.0d0,
435 + 0.5d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
436 + 0.68d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
437 + 0.0d0, 0.68d0, -0.9d0, 0.33d0, 0.0d0, 0.0d0,
438 + 0.0d0, 0.0d0, 0.68d0, -0.9d0, 0.33d0, 0.7d0,
439 + -0.75d0, 0.2d0, 1.04d0/
440 DATA dt10x/0.6d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
441 + 0.0d0, 0.5d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
442 + 0.0d0, 0.5d0, -0.9d0, 0.0d0, 0.0d0, 0.0d0,
443 + 0.0d0, 0.0d0, 0.5d0, -0.9d0, 0.3d0, 0.7d0,
444 + 0.0d0, 0.0d0, 0.0d0, 0.6d0, 0.0d0, 0.0d0, 0.0d0,
445 + 0.0d0, 0.0d0, 0.0d0, 0.5d0, 0.0d0, 0.0d0, 0.0d0,
446 + 0.0d0, 0.0d0, 0.0d0, 0.3d0, 0.1d0, 0.5d0, 0.0d0,
447 + 0.0d0, 0.0d0, 0.0d0, 0.8d0, 0.1d0, -0.6d0,
448 + 0.8d0, 0.3d0, -0.3d0, 0.5d0, 0.6d0, 0.0d0,
449 + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.5d0, 0.0d0,
450 + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, -0.9d0,
451 + 0.1d0, 0.5d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.7d0,
452 + 0.1d0, 0.3d0, 0.8d0, -0.9d0, -0.3d0, 0.5d0,
453 + 0.6d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
454 + 0.5d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
455 + 0.5d0, 0.3d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
456 + 0.5d0, 0.3d0, -0.6d0, 0.8d0, 0.0d0, 0.0d0,
457 + 0.0d0/
458 DATA dt10y/0.5d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
459 + 0.0d0, 0.6d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
460 + 0.0d0, 0.6d0, 0.1d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
461 + 0.0d0, 0.6d0, 0.1d0, -0.5d0, 0.8d0, 0.0d0,
462 + 0.0d0, 0.0d0, 0.5d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
463 + 0.0d0, 0.0d0, 0.6d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
464 + 0.0d0, 0.0d0, -0.5d0, -0.9d0, 0.6d0, 0.0d0,
465 + 0.0d0, 0.0d0, 0.0d0, -0.4d0, -0.9d0, 0.9d0,
466 + 0.7d0, -0.5d0, 0.2d0, 0.6d0, 0.5d0, 0.0d0,
467 + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.6d0, 0.0d0,
468 + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, -0.5d0,
469 + 0.6d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
470 + -0.4d0, 0.9d0, -0.5d0, 0.6d0, 0.0d0, 0.0d0,
471 + 0.0d0, 0.5d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
472 + 0.0d0, 0.6d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
473 + 0.0d0, 0.6d0, -0.9d0, 0.1d0, 0.0d0, 0.0d0,
474 + 0.0d0, 0.0d0, 0.6d0, -0.9d0, 0.1d0, 0.7d0,
475 + -0.5d0, 0.2d0, 0.8d0/
476 DATA ssize1/0.0d0, 0.3d0, 1.6d0, 3.2d0/
477 DATA ssize2/0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
478 + 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0,
479 + 0.0d0, 1.17d0, 1.17d0, 1.17d0, 1.17d0, 1.17d0,
480 + 1.17d0, 1.17d0, 1.17d0, 1.17d0, 1.17d0, 1.17d0,
481 + 1.17d0, 1.17d0, 1.17d0/
482*
483* FOR DROTM
484*
485 DATA dpar/-2.d0, 0.d0,0.d0,0.d0,0.d0,
486 a -1.d0, 2.d0, -3.d0, -4.d0, 5.d0,
487 b 0.d0, 0.d0, 2.d0, -3.d0, 0.d0,
488 c 1.d0, 5.d0, 2.d0, 0.d0, -4.d0/
489* TRUE X RESULTS F0R ROTATIONS DROTM
490 DATA dt19xa/.6d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
491 a .6d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
492 b .6d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
493 c .6d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
494 d .6d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
495 e -.8d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
496 f -.9d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
497 g 3.5d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
498 h .6d0, .1d0, 0.d0,0.d0,0.d0,0.d0,0.d0,
499 i -.8d0, 3.8d0, 0.d0,0.d0,0.d0,0.d0,0.d0,
500 j -.9d0, 2.8d0, 0.d0,0.d0,0.d0,0.d0,0.d0,
501 k 3.5d0, -.4d0, 0.d0,0.d0,0.d0,0.d0,0.d0,
502 l .6d0, .1d0, -.5d0, .8d0, 0.d0,0.d0,0.d0,
503 m -.8d0, 3.8d0, -2.2d0, -1.2d0, 0.d0,0.d0,0.d0,
504 n -.9d0, 2.8d0, -1.4d0, -1.3d0, 0.d0,0.d0,0.d0,
505 o 3.5d0, -.4d0, -2.2d0, 4.7d0, 0.d0,0.d0,0.d0/
506*
507 DATA dt19xb/.6d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
508 a .6d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
509 b .6d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
510 c .6d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
511 d .6d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
512 e -.8d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
513 f -.9d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
514 g 3.5d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
515 h .6d0, .1d0, -.5d0, 0.d0,0.d0,0.d0,0.d0,
516 i 0.d0, .1d0, -3.0d0, 0.d0,0.d0,0.d0,0.d0,
517 j -.3d0, .1d0, -2.0d0, 0.d0,0.d0,0.d0,0.d0,
518 k 3.3d0, .1d0, -2.0d0, 0.d0,0.d0,0.d0,0.d0,
519 l .6d0, .1d0, -.5d0, .8d0, .9d0, -.3d0, -.4d0,
520 m -2.0d0, .1d0, 1.4d0, .8d0, .6d0, -.3d0, -2.8d0,
521 n -1.8d0, .1d0, 1.3d0, .8d0, 0.d0, -.3d0, -1.9d0,
522 o 3.8d0, .1d0, -3.1d0, .8d0, 4.8d0, -.3d0, -1.5d0 /
523*
524 DATA dt19xc/.6d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
525 a .6d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
526 b .6d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
527 c .6d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
528 d .6d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
529 e -.8d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
530 f -.9d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
531 g 3.5d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
532 h .6d0, .1d0, -.5d0, 0.d0,0.d0,0.d0,0.d0,
533 i 4.8d0, .1d0, -3.0d0, 0.d0,0.d0,0.d0,0.d0,
534 j 3.3d0, .1d0, -2.0d0, 0.d0,0.d0,0.d0,0.d0,
535 k 2.1d0, .1d0, -2.0d0, 0.d0,0.d0,0.d0,0.d0,
536 l .6d0, .1d0, -.5d0, .8d0, .9d0, -.3d0, -.4d0,
537 m -1.6d0, .1d0, -2.2d0, .8d0, 5.4d0, -.3d0, -2.8d0,
538 n -1.5d0, .1d0, -1.4d0, .8d0, 3.6d0, -.3d0, -1.9d0,
539 o 3.7d0, .1d0, -2.2d0, .8d0, 3.6d0, -.3d0, -1.5d0 /
540*
541 DATA dt19xd/.6d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
542 a .6d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
543 b .6d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
544 c .6d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
545 d .6d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
546 e -.8d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
547 f -.9d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
548 g 3.5d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
549 h .6d0, .1d0, 0.d0,0.d0,0.d0,0.d0,0.d0,
550 i -.8d0, -1.0d0, 0.d0,0.d0,0.d0,0.d0,0.d0,
551 j -.9d0, -.8d0, 0.d0,0.d0,0.d0,0.d0,0.d0,
552 k 3.5d0, .8d0, 0.d0,0.d0,0.d0,0.d0,0.d0,
553 l .6d0, .1d0, -.5d0, .8d0, 0.d0,0.d0,0.d0,
554 m -.8d0, -1.0d0, 1.4d0, -1.6d0, 0.d0,0.d0,0.d0,
555 n -.9d0, -.8d0, 1.3d0, -1.6d0, 0.d0,0.d0,0.d0,
556 o 3.5d0, .8d0, -3.1d0, 4.8d0, 0.d0,0.d0,0.d0/
557* TRUE Y RESULTS FOR ROTATIONS DROTM
558 DATA dt19ya/.5d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
559 a .5d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
560 b .5d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
561 c .5d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
562 d .5d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
563 e .7d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
564 f 1.7d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
565 g -2.6d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
566 h .5d0, -.9d0, 0.d0,0.d0,0.d0,0.d0,0.d0,
567 i .7d0, -4.8d0, 0.d0,0.d0,0.d0,0.d0,0.d0,
568 j 1.7d0, -.7d0, 0.d0,0.d0,0.d0,0.d0,0.d0,
569 k -2.6d0, 3.5d0, 0.d0,0.d0,0.d0,0.d0,0.d0,
570 l .5d0, -.9d0, .3d0, .7d0, 0.d0,0.d0,0.d0,
571 m .7d0, -4.8d0, 3.0d0, 1.1d0, 0.d0,0.d0,0.d0,
572 n 1.7d0, -.7d0, -.7d0, 2.3d0, 0.d0,0.d0,0.d0,
573 o -2.6d0, 3.5d0, -.7d0, -3.6d0, 0.d0,0.d0,0.d0/
574*
575 DATA dt19yb/.5d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
576 a .5d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
577 b .5d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
578 c .5d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
579 d .5d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
580 e .7d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
581 f 1.7d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
582 g -2.6d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
583 h .5d0, -.9d0, .3d0, 0.d0,0.d0,0.d0,0.d0,
584 i 4.0d0, -.9d0, -.3d0, 0.d0,0.d0,0.d0,0.d0,
585 j -.5d0, -.9d0, 1.5d0, 0.d0,0.d0,0.d0,0.d0,
586 k -1.5d0, -.9d0, -1.8d0, 0.d0,0.d0,0.d0,0.d0,
587 l .5d0, -.9d0, .3d0, .7d0, -.6d0, .2d0, .8d0,
588 m 3.7d0, -.9d0, -1.2d0, .7d0, -1.5d0, .2d0, 2.2d0,
589 n -.3d0, -.9d0, 2.1d0, .7d0, -1.6d0, .2d0, 2.0d0,
590 o -1.6d0, -.9d0, -2.1d0, .7d0, 2.9d0, .2d0, -3.8d0 /
591*
592 DATA dt19yc/.5d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
593 a .5d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
594 b .5d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
595 c .5d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
596 d .5d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
597 e .7d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
598 f 1.7d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
599 g -2.6d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
600 h .5d0, -.9d0, 0.d0,0.d0,0.d0,0.d0,0.d0,
601 i 4.0d0, -6.3d0, 0.d0,0.d0,0.d0,0.d0,0.d0,
602 j -.5d0, .3d0, 0.d0,0.d0,0.d0,0.d0,0.d0,
603 k -1.5d0, 3.0d0, 0.d0,0.d0,0.d0,0.d0,0.d0,
604 l .5d0, -.9d0, .3d0, .7d0, 0.d0,0.d0,0.d0,
605 m 3.7d0, -7.2d0, 3.0d0, 1.7d0, 0.d0,0.d0,0.d0,
606 n -.3d0, .9d0, -.7d0, 1.9d0, 0.d0,0.d0,0.d0,
607 o -1.6d0, 2.7d0, -.7d0, -3.4d0, 0.d0,0.d0,0.d0/
608*
609 DATA dt19yd/.5d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
610 a .5d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
611 b .5d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
612 c .5d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
613 d .5d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
614 e .7d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
615 f 1.7d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
616 g -2.6d0, 0.d0,0.d0,0.d0,0.d0,0.d0,0.d0,
617 h .5d0, -.9d0, .3d0, 0.d0,0.d0,0.d0,0.d0,
618 i .7d0, -.9d0, 1.2d0, 0.d0,0.d0,0.d0,0.d0,
619 j 1.7d0, -.9d0, .5d0, 0.d0,0.d0,0.d0,0.d0,
620 k -2.6d0, -.9d0, -1.3d0, 0.d0,0.d0,0.d0,0.d0,
621 l .5d0, -.9d0, .3d0, .7d0, -.6d0, .2d0, .8d0,
622 m .7d0, -.9d0, 1.2d0, .7d0, -1.5d0, .2d0, 1.6d0,
623 n 1.7d0, -.9d0, .5d0, .7d0, -1.6d0, .2d0, 2.4d0,
624 o -2.6d0, -.9d0, -1.3d0, .7d0, 2.9d0, .2d0, -4.0d0 /
625*
626* .. Executable Statements ..
627*
628 DO 120 ki = 1, 4
629 incx = incxs(ki)
630 incy = incys(ki)
631 mx = abs(incx)
632 my = abs(incy)
633*
634 DO 100 kn = 1, 4
635 n = ns(kn)
636 ksize = min(2,kn)
637 lenx = lens(kn,mx)
638 leny = lens(kn,my)
639* .. Initialize all argument arrays ..
640 DO 20 i = 1, 7
641 sx(i) = dx1(i)
642 sy(i) = dy1(i)
643 20 CONTINUE
644*
645 IF (icase.EQ.1) THEN
646* .. DDOT ..
647 CALL stest1(ddot(n,sx,incx,sy,incy),dt7(kn,ki),ssize1(kn)
648 + ,sfac)
649 ELSE IF (icase.EQ.2) THEN
650* .. DAXPY ..
651 CALL daxpy(n,sa,sx,incx,sy,incy)
652 DO 40 j = 1, leny
653 sty(j) = dt8(j,kn,ki)
654 40 CONTINUE
655 CALL stest(leny,sy,sty,ssize2(1,ksize),sfac)
656 ELSE IF (icase.EQ.5) THEN
657* .. DCOPY ..
658 DO 60 i = 1, 7
659 sty(i) = dt10y(i,kn,ki)
660 60 CONTINUE
661 CALL dcopy(n,sx,incx,sy,incy)
662 CALL stest(leny,sy,sty,ssize2(1,1),1.0d0)
663 IF (ki.EQ.1) THEN
664 sx0(1) = 42.0d0
665 sy0(1) = 43.0d0
666 IF (n.EQ.0) THEN
667 sty0(1) = sy0(1)
668 ELSE
669 sty0(1) = sx0(1)
670 END IF
671 lincx = incx
672 incx = 0
673 lincy = incy
674 incy = 0
675 CALL dcopy(n,sx0,incx,sy0,incy)
676 CALL stest(1,sy0,sty0,ssize2(1,1),1.0d0)
677 incx = lincx
678 incy = lincy
679 END IF
680 ELSE IF (icase.EQ.6) THEN
681* .. DSWAP ..
682 CALL dswap(n,sx,incx,sy,incy)
683 DO 80 i = 1, 7
684 stx(i) = dt10x(i,kn,ki)
685 sty(i) = dt10y(i,kn,ki)
686 80 CONTINUE
687 CALL stest(lenx,sx,stx,ssize2(1,1),1.0d0)
688 CALL stest(leny,sy,sty,ssize2(1,1),1.0d0)
689 ELSE IF (icase.EQ.12) THEN
690* .. DROTM ..
691 kni=kn+4*(ki-1)
692 DO kpar=1,4
693 DO i=1,7
694 sx(i) = dx1(i)
695 sy(i) = dy1(i)
696 stx(i)= dt19x(i,kpar,kni)
697 sty(i)= dt19y(i,kpar,kni)
698 END DO
699*
700 DO i=1,5
701 dtemp(i) = dpar(i,kpar)
702 END DO
703*
704 DO i=1,lenx
705 ssize(i)=stx(i)
706 END DO
707* SEE REMARK ABOVE ABOUT DT11X(1,2,7)
708* AND DT11X(5,3,8).
709 IF ((kpar .EQ. 2) .AND. (kni .EQ. 7))
710 $ ssize(1) = 2.4d0
711 IF ((kpar .EQ. 3) .AND. (kni .EQ. 8))
712 $ ssize(5) = 1.8d0
713*
714 CALL drotm(n,sx,incx,sy,incy,dtemp)
715 CALL stest(lenx,sx,stx,ssize,sfac)
716 CALL stest(leny,sy,sty,sty,sfac)
717 END DO
718 ELSE IF (icase.EQ.13) THEN
719* .. DSDOT ..
720 CALL testdsdot(real(dsdot(n,real(sx),incx,real(sy),incy)),
721 $ real(dt7(kn,ki)),real(ssize1(kn)), .3125e-1)
722 ELSE
723 WRITE (nout,*) ' Shouldn''t be here in CHECK2'
724 stop
725 END IF
726 100 CONTINUE
727 120 CONTINUE
728 RETURN
729*
730* End of CHECK2
731*
stest
subroutine stest(len, scomp, strue, ssize, sfac)
Definition cblat1.f:614
stest1
subroutine stest1(scomp1, strue1, ssize, sfac)
Definition cblat1.f:673
testdsdot
subroutine testdsdot(scomp, strue, ssize, sfac)
Definition dblat1.f:1002
daxpy
subroutine daxpy(n, da, dx, incx, dy, incy)
DAXPY
Definition daxpy.f:89
dcopy
subroutine dcopy(n, dx, incx, dy, incy)
DCOPY
Definition dcopy.f:82
dsdot
double precision function dsdot(n, sx, incx, sy, incy)
DSDOT
Definition dsdot.f:119
ddot
double precision function ddot(n, dx, incx, dy, incy)
DDOT
Definition ddot.f:82
drotm
subroutine drotm(n, dx, incx, dy, incy, dparam)
DROTM
Definition drotm.f:96
dswap
subroutine dswap(n, dx, incx, dy, incy)
DSWAP
Definition dswap.f:82
Here is the call graph for this function: