370
371
372
373
374
375
376 INTEGER INFO, LDA, LDB, LDZ, LIWORK, LRWORK, NOUNIT,
377 $ NSIZES, NTYPES, NWORK
378 DOUBLE PRECISION THRESH
379
380
381 LOGICAL DOTYPE( * )
382 INTEGER ISEED( 4 ), IWORK( * ), NN( * )
383 DOUBLE PRECISION D( * ), RESULT( * ), RWORK( * )
384 COMPLEX*16 A( LDA, * ), AB( LDA, * ), AP( * ),
385 $ B( LDB, * ), BB( LDB, * ), BP( * ), WORK( * ),
386 $ Z( LDZ, * )
387
388
389
390
391
392 DOUBLE PRECISION ZERO, ONE, TEN
393 parameter( zero = 0.0d+0, one = 1.0d+0, ten = 10.0d+0 )
394 COMPLEX*16 CZERO, CONE
395 parameter( czero = ( 0.0d+0, 0.0d+0 ),
396 $ cone = ( 1.0d+0, 0.0d+0 ) )
397 INTEGER MAXTYP
398 parameter( maxtyp = 21 )
399
400
401 LOGICAL BADNN
402 CHARACTER UPLO
403 INTEGER I, IBTYPE, IBUPLO, IINFO, IJ, IL, IMODE, ITEMP,
404 $ ITYPE, IU, J, JCOL, JSIZE, JTYPE, KA, KA9, KB,
405 $ KB9, M, MTYPES, N, NERRS, NMATS, NMAX, NTEST,
406 $ NTESTT
407 DOUBLE PRECISION ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
408 $ RTUNFL, ULP, ULPINV, UNFL, VL, VU
409
410
411 INTEGER IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
412 $ KMAGN( MAXTYP ), KMODE( MAXTYP ),
413 $ KTYPE( MAXTYP )
414
415
416 LOGICAL LSAME
417 DOUBLE PRECISION DLAMCH, DLARND
419
420
424
425
426 INTRINSIC abs, dble, max, min, sqrt
427
428
429 DATA ktype / 1, 2, 5*4, 5*5, 3*8, 6*9 /
430 DATA kmagn / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
431 $ 2, 3, 6*1 /
432 DATA kmode / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
433 $ 0, 0, 6*4 /
434
435
436
437
438
439 ntestt = 0
440 info = 0
441
442 badnn = .false.
443 nmax = 0
444 DO 10 j = 1, nsizes
445 nmax = max( nmax, nn( j ) )
446 IF( nn( j ).LT.0 )
447 $ badnn = .true.
448 10 CONTINUE
449
450
451
452 IF( nsizes.LT.0 ) THEN
453 info = -1
454 ELSE IF( badnn ) THEN
455 info = -2
456 ELSE IF( ntypes.LT.0 ) THEN
457 info = -3
458 ELSE IF( lda.LE.1 .OR. lda.LT.nmax ) THEN
459 info = -9
460 ELSE IF( ldz.LE.1 .OR. ldz.LT.nmax ) THEN
461 info = -16
462 ELSE IF( 2*max( nmax, 2 )**2.GT.nwork ) THEN
463 info = -21
464 ELSE IF( 2*max( nmax, 2 )**2.GT.lrwork ) THEN
465 info = -23
466 ELSE IF( 2*max( nmax, 2 )**2.GT.liwork ) THEN
467 info = -25
468 END IF
469
470 IF( info.NE.0 ) THEN
471 CALL xerbla(
'ZDRVSG', -info )
472 RETURN
473 END IF
474
475
476
477 IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
478 $ RETURN
479
480
481
482 unfl =
dlamch(
'Safe minimum' )
483 ovfl =
dlamch(
'Overflow' )
486 ulpinv = one / ulp
487 rtunfl = sqrt( unfl )
488 rtovfl = sqrt( ovfl )
489
490 DO 20 i = 1, 4
491 iseed2( i ) = iseed( i )
492 20 CONTINUE
493
494
495
496 nerrs = 0
497 nmats = 0
498
499 DO 650 jsize = 1, nsizes
500 n = nn( jsize )
501 aninv = one / dble( max( 1, n ) )
502
503 IF( nsizes.NE.1 ) THEN
504 mtypes = min( maxtyp, ntypes )
505 ELSE
506 mtypes = min( maxtyp+1, ntypes )
507 END IF
508
509 ka9 = 0
510 kb9 = 0
511 DO 640 jtype = 1, mtypes
512 IF( .NOT.dotype( jtype ) )
513 $ GO TO 640
514 nmats = nmats + 1
515 ntest = 0
516
517 DO 30 j = 1, 4
518 ioldsd( j ) = iseed( j )
519 30 CONTINUE
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536 IF( mtypes.GT.maxtyp )
537 $ GO TO 90
538
539 itype = ktype( jtype )
540 imode = kmode( jtype )
541
542
543
544 GO TO ( 40, 50, 60 )kmagn( jtype )
545
546 40 CONTINUE
547 anorm = one
548 GO TO 70
549
550 50 CONTINUE
551 anorm = ( rtovfl*ulp )*aninv
552 GO TO 70
553
554 60 CONTINUE
555 anorm = rtunfl*n*ulpinv
556 GO TO 70
557
558 70 CONTINUE
559
560 iinfo = 0
561 cond = ulpinv
562
563
564
565 IF( itype.EQ.1 ) THEN
566
567
568
569 ka = 0
570 kb = 0
571 CALL zlaset(
'Full', lda, n, czero, czero, a, lda )
572
573 ELSE IF( itype.EQ.2 ) THEN
574
575
576
577 ka = 0
578 kb = 0
579 CALL zlaset(
'Full', lda, n, czero, czero, a, lda )
580 DO 80 jcol = 1, n
581 a( jcol, jcol ) = anorm
582 80 CONTINUE
583
584 ELSE IF( itype.EQ.4 ) THEN
585
586
587
588 ka = 0
589 kb = 0
590 CALL zlatms( n, n,
'S', iseed,
'H', rwork, imode, cond,
591 $ anorm, 0, 0, 'N', a, lda, work, iinfo )
592
593 ELSE IF( itype.EQ.5 ) THEN
594
595
596
597 ka = max( 0, n-1 )
598 kb = ka
599 CALL zlatms( n, n,
'S', iseed,
'H', rwork, imode, cond,
600 $ anorm, n, n, 'N', a, lda, work, iinfo )
601
602 ELSE IF( itype.EQ.7 ) THEN
603
604
605
606 ka = 0
607 kb = 0
608 CALL zlatmr( n, n,
'S', iseed,
'H', work, 6, one, cone,
609 $ 'T', 'N', work( n+1 ), 1, one,
610 $ work( 2*n+1 ), 1, one, 'N', idumma, 0, 0,
611 $ zero, anorm, 'NO', a, lda, iwork, iinfo )
612
613 ELSE IF( itype.EQ.8 ) THEN
614
615
616
617 ka = max( 0, n-1 )
618 kb = ka
619 CALL zlatmr( n, n,
'S', iseed,
'H', work, 6, one, cone,
620 $ 'T', 'N', work( n+1 ), 1, one,
621 $ work( 2*n+1 ), 1, one, 'N', idumma, n, n,
622 $ zero, anorm, 'NO', a, lda, iwork, iinfo )
623
624 ELSE IF( itype.EQ.9 ) THEN
625
626
627
628
629
630
631
632
633
634
635
636
637 kb9 = kb9 + 1
638 IF( kb9.GT.ka9 ) THEN
639 ka9 = ka9 + 1
640 kb9 = 1
641 END IF
642 ka = max( 0, min( n-1, ka9 ) )
643 kb = max( 0, min( n-1, kb9 ) )
644 CALL zlatms( n, n,
'S', iseed,
'H', rwork, imode, cond,
645 $ anorm, ka, ka, 'N', a, lda, work, iinfo )
646
647 ELSE
648
649 iinfo = 1
650 END IF
651
652 IF( iinfo.NE.0 ) THEN
653 WRITE( nounit, fmt = 9999 )'Generator', iinfo, n, jtype,
654 $ ioldsd
655 info = abs( iinfo )
656 RETURN
657 END IF
658
659 90 CONTINUE
660
661 abstol = unfl + unfl
662 IF( n.LE.1 ) THEN
663 il = 1
664 iu = n
665 ELSE
666 il = 1 + int( ( n-1 )*
dlarnd( 1, iseed2 ) )
667 iu = 1 + int( ( n-1 )*
dlarnd( 1, iseed2 ) )
668 IF( il.GT.iu ) THEN
669 itemp = il
670 il = iu
671 iu = itemp
672 END IF
673 END IF
674
675
676
677
678
679
680
681
682
683 DO 630 ibtype = 1, 3
684
685
686
687 DO 620 ibuplo = 1, 2
688 IF( ibuplo.EQ.1 )
689 $ uplo = 'U'
690 IF( ibuplo.EQ.2 )
691 $ uplo = 'L'
692
693
694
695
696 CALL zlatms( n, n,
'U', iseed,
'P', rwork, 5, ten,
697 $ one, kb, kb, uplo, b, ldb, work( n+1 ),
698 $ iinfo )
699
700
701
702 ntest = ntest + 1
703
704 CALL zlacpy(
' ', n, n, a, lda, z, ldz )
705 CALL zlacpy( uplo, n, n, b, ldb, bb, ldb )
706
707 CALL zhegv( ibtype,
'V', uplo, n, z, ldz, bb, ldb, d,
708 $ work, nwork, rwork, iinfo )
709 IF( iinfo.NE.0 ) THEN
710 WRITE( nounit, fmt = 9999 )'ZHEGV(V,' // uplo //
711 $ ')', iinfo, n, jtype, ioldsd
712 info = abs( iinfo )
713 IF( iinfo.LT.0 ) THEN
714 RETURN
715 ELSE
716 result( ntest ) = ulpinv
717 GO TO 100
718 END IF
719 END IF
720
721
722
723 CALL zsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
724 $ ldz, d, work, rwork, result( ntest ) )
725
726
727
728 ntest = ntest + 1
729
730 CALL zlacpy(
' ', n, n, a, lda, z, ldz )
731 CALL zlacpy( uplo, n, n, b, ldb, bb, ldb )
732
733 CALL zhegvd( ibtype,
'V', uplo, n, z, ldz, bb, ldb, d,
734 $ work, nwork, rwork, lrwork, iwork,
735 $ liwork, iinfo )
736 IF( iinfo.NE.0 ) THEN
737 WRITE( nounit, fmt = 9999 )'ZHEGVD(V,' // uplo //
738 $ ')', iinfo, n, jtype, ioldsd
739 info = abs( iinfo )
740 IF( iinfo.LT.0 ) THEN
741 RETURN
742 ELSE
743 result( ntest ) = ulpinv
744 GO TO 100
745 END IF
746 END IF
747
748
749
750 CALL zsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
751 $ ldz, d, work, rwork, result( ntest ) )
752
753
754
755 ntest = ntest + 1
756
757 CALL zlacpy(
' ', n, n, a, lda, ab, lda )
758 CALL zlacpy( uplo, n, n, b, ldb, bb, ldb )
759
760 CALL zhegvx( ibtype,
'V',
'A', uplo, n, ab, lda, bb,
761 $ ldb, vl, vu, il, iu, abstol, m, d, z,
762 $ ldz, work, nwork, rwork, iwork( n+1 ),
763 $ iwork, iinfo )
764 IF( iinfo.NE.0 ) THEN
765 WRITE( nounit, fmt = 9999 )'ZHEGVX(V,A' // uplo //
766 $ ')', iinfo, n, jtype, ioldsd
767 info = abs( iinfo )
768 IF( iinfo.LT.0 ) THEN
769 RETURN
770 ELSE
771 result( ntest ) = ulpinv
772 GO TO 100
773 END IF
774 END IF
775
776
777
778 CALL zsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
779 $ ldz, d, work, rwork, result( ntest ) )
780
781 ntest = ntest + 1
782
783 CALL zlacpy(
' ', n, n, a, lda, ab, lda )
784 CALL zlacpy( uplo, n, n, b, ldb, bb, ldb )
785
786
787
788
789
790
791 vl = zero
792 vu = anorm
793 CALL zhegvx( ibtype,
'V',
'V', uplo, n, ab, lda, bb,
794 $ ldb, vl, vu, il, iu, abstol, m, d, z,
795 $ ldz, work, nwork, rwork, iwork( n+1 ),
796 $ iwork, iinfo )
797 IF( iinfo.NE.0 ) THEN
798 WRITE( nounit, fmt = 9999 )'ZHEGVX(V,V,' //
799 $ uplo // ')', iinfo, n, jtype, ioldsd
800 info = abs( iinfo )
801 IF( iinfo.LT.0 ) THEN
802 RETURN
803 ELSE
804 result( ntest ) = ulpinv
805 GO TO 100
806 END IF
807 END IF
808
809
810
811 CALL zsgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
812 $ ldz, d, work, rwork, result( ntest ) )
813
814 ntest = ntest + 1
815
816 CALL zlacpy(
' ', n, n, a, lda, ab, lda )
817 CALL zlacpy( uplo, n, n, b, ldb, bb, ldb )
818
819 CALL zhegvx( ibtype,
'V',
'I', uplo, n, ab, lda, bb,
820 $ ldb, vl, vu, il, iu, abstol, m, d, z,
821 $ ldz, work, nwork, rwork, iwork( n+1 ),
822 $ iwork, iinfo )
823 IF( iinfo.NE.0 ) THEN
824 WRITE( nounit, fmt = 9999 )'ZHEGVX(V,I,' //
825 $ uplo // ')', iinfo, n, jtype, ioldsd
826 info = abs( iinfo )
827 IF( iinfo.LT.0 ) THEN
828 RETURN
829 ELSE
830 result( ntest ) = ulpinv
831 GO TO 100
832 END IF
833 END IF
834
835
836
837 CALL zsgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
838 $ ldz, d, work, rwork, result( ntest ) )
839
840 100 CONTINUE
841
842
843
844 ntest = ntest + 1
845
846
847
848 IF(
lsame( uplo,
'U' ) )
THEN
849 ij = 1
850 DO 120 j = 1, n
851 DO 110 i = 1, j
852 ap( ij ) = a( i, j )
853 bp( ij ) = b( i, j )
854 ij = ij + 1
855 110 CONTINUE
856 120 CONTINUE
857 ELSE
858 ij = 1
859 DO 140 j = 1, n
860 DO 130 i = j, n
861 ap( ij ) = a( i, j )
862 bp( ij ) = b( i, j )
863 ij = ij + 1
864 130 CONTINUE
865 140 CONTINUE
866 END IF
867
868 CALL zhpgv( ibtype,
'V', uplo, n, ap, bp, d, z, ldz,
869 $ work, rwork, iinfo )
870 IF( iinfo.NE.0 ) THEN
871 WRITE( nounit, fmt = 9999 )'ZHPGV(V,' // uplo //
872 $ ')', iinfo, n, jtype, ioldsd
873 info = abs( iinfo )
874 IF( iinfo.LT.0 ) THEN
875 RETURN
876 ELSE
877 result( ntest ) = ulpinv
878 GO TO 310
879 END IF
880 END IF
881
882
883
884 CALL zsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
885 $ ldz, d, work, rwork, result( ntest ) )
886
887
888
889 ntest = ntest + 1
890
891
892
893 IF(
lsame( uplo,
'U' ) )
THEN
894 ij = 1
895 DO 160 j = 1, n
896 DO 150 i = 1, j
897 ap( ij ) = a( i, j )
898 bp( ij ) = b( i, j )
899 ij = ij + 1
900 150 CONTINUE
901 160 CONTINUE
902 ELSE
903 ij = 1
904 DO 180 j = 1, n
905 DO 170 i = j, n
906 ap( ij ) = a( i, j )
907 bp( ij ) = b( i, j )
908 ij = ij + 1
909 170 CONTINUE
910 180 CONTINUE
911 END IF
912
913 CALL zhpgvd( ibtype,
'V', uplo, n, ap, bp, d, z, ldz,
914 $ work, nwork, rwork, lrwork, iwork,
915 $ liwork, iinfo )
916 IF( iinfo.NE.0 ) THEN
917 WRITE( nounit, fmt = 9999 )'ZHPGVD(V,' // uplo //
918 $ ')', iinfo, n, jtype, ioldsd
919 info = abs( iinfo )
920 IF( iinfo.LT.0 ) THEN
921 RETURN
922 ELSE
923 result( ntest ) = ulpinv
924 GO TO 310
925 END IF
926 END IF
927
928
929
930 CALL zsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
931 $ ldz, d, work, rwork, result( ntest ) )
932
933
934
935 ntest = ntest + 1
936
937
938
939 IF(
lsame( uplo,
'U' ) )
THEN
940 ij = 1
941 DO 200 j = 1, n
942 DO 190 i = 1, j
943 ap( ij ) = a( i, j )
944 bp( ij ) = b( i, j )
945 ij = ij + 1
946 190 CONTINUE
947 200 CONTINUE
948 ELSE
949 ij = 1
950 DO 220 j = 1, n
951 DO 210 i = j, n
952 ap( ij ) = a( i, j )
953 bp( ij ) = b( i, j )
954 ij = ij + 1
955 210 CONTINUE
956 220 CONTINUE
957 END IF
958
959 CALL zhpgvx( ibtype,
'V',
'A', uplo, n, ap, bp, vl,
960 $ vu, il, iu, abstol, m, d, z, ldz, work,
961 $ rwork, iwork( n+1 ), iwork, info )
962 IF( iinfo.NE.0 ) THEN
963 WRITE( nounit, fmt = 9999 )'ZHPGVX(V,A' // uplo //
964 $ ')', iinfo, n, jtype, ioldsd
965 info = abs( iinfo )
966 IF( iinfo.LT.0 ) THEN
967 RETURN
968 ELSE
969 result( ntest ) = ulpinv
970 GO TO 310
971 END IF
972 END IF
973
974
975
976 CALL zsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
977 $ ldz, d, work, rwork, result( ntest ) )
978
979 ntest = ntest + 1
980
981
982
983 IF(
lsame( uplo,
'U' ) )
THEN
984 ij = 1
985 DO 240 j = 1, n
986 DO 230 i = 1, j
987 ap( ij ) = a( i, j )
988 bp( ij ) = b( i, j )
989 ij = ij + 1
990 230 CONTINUE
991 240 CONTINUE
992 ELSE
993 ij = 1
994 DO 260 j = 1, n
995 DO 250 i = j, n
996 ap( ij ) = a( i, j )
997 bp( ij ) = b( i, j )
998 ij = ij + 1
999 250 CONTINUE
1000 260 CONTINUE
1001 END IF
1002
1003 vl = zero
1004 vu = anorm
1005 CALL zhpgvx( ibtype,
'V',
'V', uplo, n, ap, bp, vl,
1006 $ vu, il, iu, abstol, m, d, z, ldz, work,
1007 $ rwork, iwork( n+1 ), iwork, info )
1008 IF( iinfo.NE.0 ) THEN
1009 WRITE( nounit, fmt = 9999 )'ZHPGVX(V,V' // uplo //
1010 $ ')', iinfo, n, jtype, ioldsd
1011 info = abs( iinfo )
1012 IF( iinfo.LT.0 ) THEN
1013 RETURN
1014 ELSE
1015 result( ntest ) = ulpinv
1016 GO TO 310
1017 END IF
1018 END IF
1019
1020
1021
1022 CALL zsgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1023 $ ldz, d, work, rwork, result( ntest ) )
1024
1025 ntest = ntest + 1
1026
1027
1028
1029 IF(
lsame( uplo,
'U' ) )
THEN
1030 ij = 1
1031 DO 280 j = 1, n
1032 DO 270 i = 1, j
1033 ap( ij ) = a( i, j )
1034 bp( ij ) = b( i, j )
1035 ij = ij + 1
1036 270 CONTINUE
1037 280 CONTINUE
1038 ELSE
1039 ij = 1
1040 DO 300 j = 1, n
1041 DO 290 i = j, n
1042 ap( ij ) = a( i, j )
1043 bp( ij ) = b( i, j )
1044 ij = ij + 1
1045 290 CONTINUE
1046 300 CONTINUE
1047 END IF
1048
1049 CALL zhpgvx( ibtype,
'V',
'I', uplo, n, ap, bp, vl,
1050 $ vu, il, iu, abstol, m, d, z, ldz, work,
1051 $ rwork, iwork( n+1 ), iwork, info )
1052 IF( iinfo.NE.0 ) THEN
1053 WRITE( nounit, fmt = 9999 )'ZHPGVX(V,I' // uplo //
1054 $ ')', iinfo, n, jtype, ioldsd
1055 info = abs( iinfo )
1056 IF( iinfo.LT.0 ) THEN
1057 RETURN
1058 ELSE
1059 result( ntest ) = ulpinv
1060 GO TO 310
1061 END IF
1062 END IF
1063
1064
1065
1066 CALL zsgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1067 $ ldz, d, work, rwork, result( ntest ) )
1068
1069 310 CONTINUE
1070
1071 IF( ibtype.EQ.1 ) THEN
1072
1073
1074
1075 ntest = ntest + 1
1076
1077
1078
1079 IF(
lsame( uplo,
'U' ) )
THEN
1080 DO 340 j = 1, n
1081 DO 320 i = max( 1, j-ka ), j
1082 ab( ka+1+i-j, j ) = a( i, j )
1083 320 CONTINUE
1084 DO 330 i = max( 1, j-kb ), j
1085 bb( kb+1+i-j, j ) = b( i, j )
1086 330 CONTINUE
1087 340 CONTINUE
1088 ELSE
1089 DO 370 j = 1, n
1090 DO 350 i = j, min( n, j+ka )
1091 ab( 1+i-j, j ) = a( i, j )
1092 350 CONTINUE
1093 DO 360 i = j, min( n, j+kb )
1094 bb( 1+i-j, j ) = b( i, j )
1095 360 CONTINUE
1096 370 CONTINUE
1097 END IF
1098
1099 CALL zhbgv(
'V', uplo, n, ka, kb, ab, lda, bb, ldb,
1100 $ d, z, ldz, work, rwork, iinfo )
1101 IF( iinfo.NE.0 ) THEN
1102 WRITE( nounit, fmt = 9999 )'ZHBGV(V,' //
1103 $ uplo // ')', iinfo, n, jtype, ioldsd
1104 info = abs( iinfo )
1105 IF( iinfo.LT.0 ) THEN
1106 RETURN
1107 ELSE
1108 result( ntest ) = ulpinv
1109 GO TO 620
1110 END IF
1111 END IF
1112
1113
1114
1115 CALL zsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
1116 $ ldz, d, work, rwork, result( ntest ) )
1117
1118
1119
1120 ntest = ntest + 1
1121
1122
1123
1124 IF(
lsame( uplo,
'U' ) )
THEN
1125 DO 400 j = 1, n
1126 DO 380 i = max( 1, j-ka ), j
1127 ab( ka+1+i-j, j ) = a( i, j )
1128 380 CONTINUE
1129 DO 390 i = max( 1, j-kb ), j
1130 bb( kb+1+i-j, j ) = b( i, j )
1131 390 CONTINUE
1132 400 CONTINUE
1133 ELSE
1134 DO 430 j = 1, n
1135 DO 410 i = j, min( n, j+ka )
1136 ab( 1+i-j, j ) = a( i, j )
1137 410 CONTINUE
1138 DO 420 i = j, min( n, j+kb )
1139 bb( 1+i-j, j ) = b( i, j )
1140 420 CONTINUE
1141 430 CONTINUE
1142 END IF
1143
1144 CALL zhbgvd(
'V', uplo, n, ka, kb, ab, lda, bb,
1145 $ ldb, d, z, ldz, work, nwork, rwork,
1146 $ lrwork, iwork, liwork, iinfo )
1147 IF( iinfo.NE.0 ) THEN
1148 WRITE( nounit, fmt = 9999 )'ZHBGVD(V,' //
1149 $ uplo // ')', iinfo, n, jtype, ioldsd
1150 info = abs( iinfo )
1151 IF( iinfo.LT.0 ) THEN
1152 RETURN
1153 ELSE
1154 result( ntest ) = ulpinv
1155 GO TO 620
1156 END IF
1157 END IF
1158
1159
1160
1161 CALL zsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
1162 $ ldz, d, work, rwork, result( ntest ) )
1163
1164
1165
1166 ntest = ntest + 1
1167
1168
1169
1170 IF(
lsame( uplo,
'U' ) )
THEN
1171 DO 460 j = 1, n
1172 DO 440 i = max( 1, j-ka ), j
1173 ab( ka+1+i-j, j ) = a( i, j )
1174 440 CONTINUE
1175 DO 450 i = max( 1, j-kb ), j
1176 bb( kb+1+i-j, j ) = b( i, j )
1177 450 CONTINUE
1178 460 CONTINUE
1179 ELSE
1180 DO 490 j = 1, n
1181 DO 470 i = j, min( n, j+ka )
1182 ab( 1+i-j, j ) = a( i, j )
1183 470 CONTINUE
1184 DO 480 i = j, min( n, j+kb )
1185 bb( 1+i-j, j ) = b( i, j )
1186 480 CONTINUE
1187 490 CONTINUE
1188 END IF
1189
1190 CALL zhbgvx(
'V',
'A', uplo, n, ka, kb, ab, lda,
1191 $ bb, ldb, bp, max( 1, n ), vl, vu, il,
1192 $ iu, abstol, m, d, z, ldz, work, rwork,
1193 $ iwork( n+1 ), iwork, iinfo )
1194 IF( iinfo.NE.0 ) THEN
1195 WRITE( nounit, fmt = 9999 )'ZHBGVX(V,A' //
1196 $ uplo // ')', iinfo, n, jtype, ioldsd
1197 info = abs( iinfo )
1198 IF( iinfo.LT.0 ) THEN
1199 RETURN
1200 ELSE
1201 result( ntest ) = ulpinv
1202 GO TO 620
1203 END IF
1204 END IF
1205
1206
1207
1208 CALL zsgt01( ibtype, uplo, n, n, a, lda, b, ldb, z,
1209 $ ldz, d, work, rwork, result( ntest ) )
1210
1211 ntest = ntest + 1
1212
1213
1214
1215 IF(
lsame( uplo,
'U' ) )
THEN
1216 DO 520 j = 1, n
1217 DO 500 i = max( 1, j-ka ), j
1218 ab( ka+1+i-j, j ) = a( i, j )
1219 500 CONTINUE
1220 DO 510 i = max( 1, j-kb ), j
1221 bb( kb+1+i-j, j ) = b( i, j )
1222 510 CONTINUE
1223 520 CONTINUE
1224 ELSE
1225 DO 550 j = 1, n
1226 DO 530 i = j, min( n, j+ka )
1227 ab( 1+i-j, j ) = a( i, j )
1228 530 CONTINUE
1229 DO 540 i = j, min( n, j+kb )
1230 bb( 1+i-j, j ) = b( i, j )
1231 540 CONTINUE
1232 550 CONTINUE
1233 END IF
1234
1235 vl = zero
1236 vu = anorm
1237 CALL zhbgvx(
'V',
'V', uplo, n, ka, kb, ab, lda,
1238 $ bb, ldb, bp, max( 1, n ), vl, vu, il,
1239 $ iu, abstol, m, d, z, ldz, work, rwork,
1240 $ iwork( n+1 ), iwork, iinfo )
1241 IF( iinfo.NE.0 ) THEN
1242 WRITE( nounit, fmt = 9999 )'ZHBGVX(V,V' //
1243 $ uplo // ')', iinfo, n, jtype, ioldsd
1244 info = abs( iinfo )
1245 IF( iinfo.LT.0 ) THEN
1246 RETURN
1247 ELSE
1248 result( ntest ) = ulpinv
1249 GO TO 620
1250 END IF
1251 END IF
1252
1253
1254
1255 CALL zsgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1256 $ ldz, d, work, rwork, result( ntest ) )
1257
1258 ntest = ntest + 1
1259
1260
1261
1262 IF(
lsame( uplo,
'U' ) )
THEN
1263 DO 580 j = 1, n
1264 DO 560 i = max( 1, j-ka ), j
1265 ab( ka+1+i-j, j ) = a( i, j )
1266 560 CONTINUE
1267 DO 570 i = max( 1, j-kb ), j
1268 bb( kb+1+i-j, j ) = b( i, j )
1269 570 CONTINUE
1270 580 CONTINUE
1271 ELSE
1272 DO 610 j = 1, n
1273 DO 590 i = j, min( n, j+ka )
1274 ab( 1+i-j, j ) = a( i, j )
1275 590 CONTINUE
1276 DO 600 i = j, min( n, j+kb )
1277 bb( 1+i-j, j ) = b( i, j )
1278 600 CONTINUE
1279 610 CONTINUE
1280 END IF
1281
1282 CALL zhbgvx(
'V',
'I', uplo, n, ka, kb, ab, lda,
1283 $ bb, ldb, bp, max( 1, n ), vl, vu, il,
1284 $ iu, abstol, m, d, z, ldz, work, rwork,
1285 $ iwork( n+1 ), iwork, iinfo )
1286 IF( iinfo.NE.0 ) THEN
1287 WRITE( nounit, fmt = 9999 )'ZHBGVX(V,I' //
1288 $ uplo // ')', iinfo, n, jtype, ioldsd
1289 info = abs( iinfo )
1290 IF( iinfo.LT.0 ) THEN
1291 RETURN
1292 ELSE
1293 result( ntest ) = ulpinv
1294 GO TO 620
1295 END IF
1296 END IF
1297
1298
1299
1300 CALL zsgt01( ibtype, uplo, n, m, a, lda, b, ldb, z,
1301 $ ldz, d, work, rwork, result( ntest ) )
1302
1303 END IF
1304
1305 620 CONTINUE
1306 630 CONTINUE
1307
1308
1309
1310 ntestt = ntestt + ntest
1311 CALL dlafts(
'ZSG', n, n, jtype, ntest, result, ioldsd,
1312 $ thresh, nounit, nerrs )
1313 640 CONTINUE
1314 650 CONTINUE
1315
1316
1317
1318 CALL dlasum(
'ZSG', nounit, nerrs, ntestt )
1319
1320 RETURN
1321
1322 9999 FORMAT( ' ZDRVSG: ', a, ' returned INFO=', i6, '.', / 9x, 'N=',
1323 $ i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ), i5, ')' )
1324
1325
1326
double precision function dlamch(CMACH)
DLAMCH
subroutine dlabad(SMALL, LARGE)
DLABAD
subroutine xerbla(SRNAME, INFO)
XERBLA
logical function lsame(CA, CB)
LSAME
subroutine zsgt01(ITYPE, UPLO, N, M, A, LDA, B, LDB, Z, LDZ, D, WORK, RWORK, RESULT)
ZSGT01
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine zlatmr(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, RSIGN, GRADE, DL, MODEL, CONDL, DR, MODER, CONDR, PIVTNG, IPIVOT, KL, KU, SPARSE, ANORM, PACK, A, LDA, IWORK, INFO)
ZLATMR
subroutine zhegvd(ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
ZHEGVD
subroutine zhegvx(ITYPE, JOBZ, RANGE, UPLO, N, A, LDA, B, LDB, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, LWORK, RWORK, IWORK, IFAIL, INFO)
ZHEGVX
subroutine zhegv(ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK, LWORK, RWORK, INFO)
ZHEGV
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
subroutine zhbgvd(JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, Z, LDZ, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
ZHBGVD
subroutine zhbgv(JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, W, Z, LDZ, WORK, RWORK, INFO)
ZHBGV
subroutine zhpgvx(ITYPE, JOBZ, RANGE, UPLO, N, AP, BP, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, RWORK, IWORK, IFAIL, INFO)
ZHPGVX
subroutine zhbgvx(JOBZ, RANGE, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, RWORK, IWORK, IFAIL, INFO)
ZHBGVX
subroutine zhpgv(ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK, RWORK, INFO)
ZHPGV
subroutine zhpgvd(ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
ZHPGVD
subroutine dlasum(TYPE, IOUNIT, IE, NRUN)
DLASUM
subroutine dlafts(TYPE, M, N, IMAT, NTESTS, RESULT, ISEED, THRESH, IOUNIT, IE)
DLAFTS
double precision function dlarnd(IDIST, ISEED)
DLARND