387 SUBROUTINE zdrvbd( NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH,
388 $ a, lda, u, ldu, vt, ldvt, asav, usav, vtsav, s,
389 $ ssav, e, work, lwork, rwork, iwork, nounit,
398 INTEGER INFO, LDA, LDU, LDVT, LWORK, NOUNIT, NSIZES,
400 DOUBLE PRECISION THRESH
404 INTEGER ISEED( 4 ), IWORK( * ), MM( * ), NN( * )
405 DOUBLE PRECISION E( * ), RWORK( * ), S( * ), SSAV( * )
406 COMPLEX*16 A( lda, * ), ASAV( lda, * ), U( ldu, * ),
407 $ usav( ldu, * ), vt( ldvt, * ),
408 $ vtsav( ldvt, * ), work( * )
414 DOUBLE PRECISION ZERO, ONE, TWO, HALF
415 parameter ( zero = 0.0d0, one = 1.0d0, two = 2.0d0,
417 COMPLEX*16 CZERO, CONE
418 parameter ( czero = ( 0.0d+0, 0.0d+0 ),
419 $ cone = ( 1.0d+0, 0.0d+0 ) )
421 parameter ( maxtyp = 5 )
425 CHARACTER JOBQ, JOBU, JOBVT, RANGE
426 INTEGER I, IINFO, IJQ, IJU, IJVT, IL, IU, ITEMP,
427 $ iwspc, iwtmp, j, jsize, jtype, lswork, m,
428 $ minwrk, mmax, mnmax, mnmin, mtypes, n,
429 $ nerrs, nfail, nmax, ns, nsi, nsv, ntest,
430 $ ntestf, ntestt, lrwork
431 DOUBLE PRECISION ANORM, DIF, DIV, OVFL, RTUNFL, ULP, ULPINV,
435 CHARACTER CJOB( 4 ), CJOBR( 3 ), CJOBV( 2 )
436 INTEGER IOLDSD( 4 ), ISEED2( 4 )
437 DOUBLE PRECISION RESULT( 35 )
440 DOUBLE PRECISION DLAMCH, DLARND
441 EXTERNAL dlamch, dlarnd
449 INTRINSIC abs, dble, max, min
455 COMMON / srnamc / srnamt
458 DATA cjob /
'N',
'O',
'S',
'A' /
459 DATA cjobr /
'A',
'V',
'I' /
460 DATA cjobv /
'N',
'V' /
480 mmax = max( mmax, mm( j ) )
483 nmax = max( nmax, nn( j ) )
486 mnmax = max( mnmax, min( mm( j ), nn( j ) ) )
487 minwrk = max( minwrk, max( 3*min( mm( j ),
488 $ nn( j ) )+max( mm( j ), nn( j ) )**2, 5*min( mm( j ),
489 $ nn( j ) ), 3*max( mm( j ), nn( j ) ) ) )
494 IF( nsizes.LT.0 )
THEN
496 ELSE IF( badmm )
THEN
498 ELSE IF( badnn )
THEN
500 ELSE IF( ntypes.LT.0 )
THEN
502 ELSE IF( lda.LT.max( 1, mmax ) )
THEN
504 ELSE IF( ldu.LT.max( 1, mmax ) )
THEN
506 ELSE IF( ldvt.LT.max( 1, nmax ) )
THEN
508 ELSE IF( minwrk.GT.lwork )
THEN
513 CALL xerbla(
'ZDRVBD', -info )
519 IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
528 rtunfl = sqrt( unfl )
534 DO 230 jsize = 1, nsizes
539 IF( nsizes.NE.1 )
THEN
540 mtypes = min( maxtyp, ntypes )
542 mtypes = min( maxtyp+1, ntypes )
545 DO 220 jtype = 1, mtypes
546 IF( .NOT.dotype( jtype ) )
551 ioldsd( j ) = iseed( j )
556 IF( mtypes.GT.maxtyp )
559 IF( jtype.EQ.1 )
THEN
563 CALL zlaset(
'Full', m, n, czero, czero, a, lda )
564 DO 30 i = 1, min( m, n )
568 ELSE IF( jtype.EQ.2 )
THEN
572 CALL zlaset(
'Full', m, n, czero, cone, a, lda )
573 DO 40 i = 1, min( m, n )
587 CALL zlatms( m, n,
'U', iseed,
'N', s, 4, dble( mnmin ),
588 $ anorm, m-1, n-1,
'N', a, lda, work, iinfo )
589 IF( iinfo.NE.0 )
THEN
590 WRITE( nounit, fmt = 9996 )
'Generator', iinfo, m, n,
598 CALL zlacpy(
'F', m, n, a, lda, asav, lda )
606 iwtmp = 2*min( m, n )+max( m, n )
607 lswork = iwtmp + ( iwspc-1 )*( lwork-iwtmp ) / 3
608 lswork = min( lswork, lwork )
609 lswork = max( lswork, 1 )
620 $
CALL zlacpy(
'F', m, n, asav, lda, a, lda )
622 CALL zgesvd(
'A',
'A', m, n, a, lda, ssav, usav, ldu,
623 $ vtsav, ldvt, work, lswork, rwork, iinfo )
624 IF( iinfo.NE.0 )
THEN
625 WRITE( nounit, fmt = 9995 )
'GESVD', iinfo, m, n,
626 $ jtype, lswork, ioldsd
633 CALL zbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
634 $ vtsav, ldvt, work, rwork, result( 1 ) )
635 IF( m.NE.0 .AND. n.NE.0 )
THEN
636 CALL zunt01(
'Columns', mnmin, m, usav, ldu, work,
637 $ lwork, rwork, result( 2 ) )
638 CALL zunt01(
'Rows', mnmin, n, vtsav, ldvt, work,
639 $ lwork, rwork, result( 3 ) )
642 DO 70 i = 1, mnmin - 1
643 IF( ssav( i ).LT.ssav( i+1 ) )
644 $ result( 4 ) = ulpinv
645 IF( ssav( i ).LT.zero )
646 $ result( 4 ) = ulpinv
648 IF( mnmin.GE.1 )
THEN
649 IF( ssav( mnmin ).LT.zero )
650 $ result( 4 ) = ulpinv
660 IF( ( iju.EQ.3 .AND. ijvt.EQ.3 ) .OR.
661 $ ( iju.EQ.1 .AND. ijvt.EQ.1 ) )
GO TO 90
663 jobvt = cjob( ijvt+1 )
664 CALL zlacpy(
'F', m, n, asav, lda, a, lda )
666 CALL zgesvd( jobu, jobvt, m, n, a, lda, s, u, ldu,
667 $ vt, ldvt, work, lswork, rwork, iinfo )
672 IF( m.GT.0 .AND. n.GT.0 )
THEN
674 CALL zunt03(
'C', m, mnmin, m, mnmin, usav,
675 $ ldu, a, lda, work, lwork, rwork,
677 ELSE IF( iju.EQ.2 )
THEN
678 CALL zunt03(
'C', m, mnmin, m, mnmin, usav,
679 $ ldu, u, ldu, work, lwork, rwork,
681 ELSE IF( iju.EQ.3 )
THEN
682 CALL zunt03(
'C', m, m, m, mnmin, usav, ldu,
683 $ u, ldu, work, lwork, rwork, dif,
687 result( 5 ) = max( result( 5 ), dif )
692 IF( m.GT.0 .AND. n.GT.0 )
THEN
694 CALL zunt03(
'R', n, mnmin, n, mnmin, vtsav,
695 $ ldvt, a, lda, work, lwork,
696 $ rwork, dif, iinfo )
697 ELSE IF( ijvt.EQ.2 )
THEN
698 CALL zunt03(
'R', n, mnmin, n, mnmin, vtsav,
699 $ ldvt, vt, ldvt, work, lwork,
700 $ rwork, dif, iinfo )
701 ELSE IF( ijvt.EQ.3 )
THEN
702 CALL zunt03(
'R', n, n, n, mnmin, vtsav,
703 $ ldvt, vt, ldvt, work, lwork,
704 $ rwork, dif, iinfo )
707 result( 6 ) = max( result( 6 ), dif )
712 div = max( dble( mnmin )*ulp*s( 1 ),
713 $ dlamch(
'Safe minimum' ) )
714 DO 80 i = 1, mnmin - 1
715 IF( ssav( i ).LT.ssav( i+1 ) )
717 IF( ssav( i ).LT.zero )
719 dif = max( dif, abs( ssav( i )-s( i ) ) / div )
721 result( 7 ) = max( result( 7 ), dif )
727 iwtmp = 2*mnmin*mnmin + 2*mnmin + max( m, n )
728 lswork = iwtmp + ( iwspc-1 )*( lwork-iwtmp ) / 3
729 lswork = min( lswork, lwork )
730 lswork = max( lswork, 1 )
736 CALL zlacpy(
'F', m, n, asav, lda, a, lda )
738 CALL zgesdd(
'A', m, n, a, lda, ssav, usav, ldu, vtsav,
739 $ ldvt, work, lswork, rwork, iwork, iinfo )
740 IF( iinfo.NE.0 )
THEN
741 WRITE( nounit, fmt = 9995 )
'GESDD', iinfo, m, n,
742 $ jtype, lswork, ioldsd
749 CALL zbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
750 $ vtsav, ldvt, work, rwork, result( 8 ) )
751 IF( m.NE.0 .AND. n.NE.0 )
THEN
752 CALL zunt01(
'Columns', mnmin, m, usav, ldu, work,
753 $ lwork, rwork, result( 9 ) )
754 CALL zunt01(
'Rows', mnmin, n, vtsav, ldvt, work,
755 $ lwork, rwork, result( 10 ) )
758 DO 110 i = 1, mnmin - 1
759 IF( ssav( i ).LT.ssav( i+1 ) )
760 $ result( 11 ) = ulpinv
761 IF( ssav( i ).LT.zero )
762 $ result( 11 ) = ulpinv
764 IF( mnmin.GE.1 )
THEN
765 IF( ssav( mnmin ).LT.zero )
766 $ result( 11 ) = ulpinv
776 CALL zlacpy(
'F', m, n, asav, lda, a, lda )
778 CALL zgesdd( jobq, m, n, a, lda, s, u, ldu, vt, ldvt,
779 $ work, lswork, rwork, iwork, iinfo )
784 IF( m.GT.0 .AND. n.GT.0 )
THEN
787 CALL zunt03(
'C', m, mnmin, m, mnmin, usav,
788 $ ldu, a, lda, work, lwork, rwork,
791 CALL zunt03(
'C', m, mnmin, m, mnmin, usav,
792 $ ldu, u, ldu, work, lwork, rwork,
795 ELSE IF( ijq.EQ.2 )
THEN
796 CALL zunt03(
'C', m, mnmin, m, mnmin, usav, ldu,
797 $ u, ldu, work, lwork, rwork, dif,
801 result( 12 ) = max( result( 12 ), dif )
806 IF( m.GT.0 .AND. n.GT.0 )
THEN
809 CALL zunt03(
'R', n, mnmin, n, mnmin, vtsav,
810 $ ldvt, vt, ldvt, work, lwork,
811 $ rwork, dif, iinfo )
813 CALL zunt03(
'R', n, mnmin, n, mnmin, vtsav,
814 $ ldvt, a, lda, work, lwork,
815 $ rwork, dif, iinfo )
817 ELSE IF( ijq.EQ.2 )
THEN
818 CALL zunt03(
'R', n, mnmin, n, mnmin, vtsav,
819 $ ldvt, vt, ldvt, work, lwork, rwork,
823 result( 13 ) = max( result( 13 ), dif )
828 div = max( dble( mnmin )*ulp*s( 1 ),
829 $ dlamch(
'Safe minimum' ) )
830 DO 120 i = 1, mnmin - 1
831 IF( ssav( i ).LT.ssav( i+1 ) )
833 IF( ssav( i ).LT.zero )
835 dif = max( dif, abs( ssav( i )-s( i ) ) / div )
837 result( 14 ) = max( result( 14 ), dif )
850 iwtmp = 2*mnmin*mnmin + 2*mnmin + max( m, n )
851 lswork = iwtmp + ( iwspc-1 )*( lwork-iwtmp ) / 3
852 lswork = min( lswork, lwork )
853 lswork = max( lswork, 1 )
858 CALL zlacpy(
'F', m, n, asav, lda, usav, lda )
860 CALL zgesvj(
'G',
'U',
'V', m, n, usav, lda, ssav,
861 & 0, a, ldvt, work, lwork, rwork,
869 vtsav(j,i) = conjg(a(i,j))
873 IF( iinfo.NE.0 )
THEN
874 WRITE( nounit, fmt = 9995 )
'GESVJ', iinfo, m, n,
875 $ jtype, lswork, ioldsd
882 CALL zbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
883 $ vtsav, ldvt, work, rwork, result( 15 ) )
884 IF( m.NE.0 .AND. n.NE.0 )
THEN
885 CALL zunt01(
'Columns', m, m, usav, ldu, work,
886 $ lwork, rwork, result( 16 ) )
887 CALL zunt01(
'Rows', n, n, vtsav, ldvt, work,
888 $ lwork, rwork, result( 17 ) )
891 DO 131 i = 1, mnmin - 1
892 IF( ssav( i ).LT.ssav( i+1 ) )
893 $ result( 18 ) = ulpinv
894 IF( ssav( i ).LT.zero )
895 $ result( 18 ) = ulpinv
897 IF( mnmin.GE.1 )
THEN
898 IF( ssav( mnmin ).LT.zero )
899 $ result( 18 ) = ulpinv
911 iwtmp = 2*mnmin*mnmin + 2*mnmin + max( m, n )
912 lswork = iwtmp + ( iwspc-1 )*( lwork-iwtmp ) / 3
913 lswork = min( lswork, lwork )
914 lswork = max( lswork, 1 )
917 lrwork = max( 7, n + 2*m)
919 CALL zlacpy(
'F', m, n, asav, lda, vtsav, lda )
921 CALL zgejsv(
'G',
'U',
'V',
'R',
'N',
'N',
922 & m, n, vtsav, lda, ssav, usav, ldu, a, ldvt,
923 & work, lwork, rwork,
924 & lrwork, iwork, iinfo )
931 vtsav(j,i) = conjg(a(i,j))
935 IF( iinfo.NE.0 )
THEN
936 WRITE( nounit, fmt = 9995 )
'GESVJ', iinfo, m, n,
937 $ jtype, lswork, ioldsd
944 CALL zbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
945 $ vtsav, ldvt, work, rwork, result( 19 ) )
946 IF( m.NE.0 .AND. n.NE.0 )
THEN
947 CALL zunt01(
'Columns', m, m, usav, ldu, work,
948 $ lwork, rwork, result( 20 ) )
949 CALL zunt01(
'Rows', n, n, vtsav, ldvt, work,
950 $ lwork, rwork, result( 21 ) )
953 DO 134 i = 1, mnmin - 1
954 IF( ssav( i ).LT.ssav( i+1 ) )
955 $ result( 22 ) = ulpinv
956 IF( ssav( i ).LT.zero )
957 $ result( 22 ) = ulpinv
959 IF( mnmin.GE.1 )
THEN
960 IF( ssav( mnmin ).LT.zero )
961 $ result( 22 ) = ulpinv
969 CALL zlacpy(
'F', m, n, asav, lda, a, lda )
971 CALL zgesvdx(
'V',
'V',
'A', m, n, a, lda,
972 $ vl, vu, il, iu, ns, ssav, usav, ldu,
973 $ vtsav, ldvt, work, lwork, rwork,
975 IF( iinfo.NE.0 )
THEN
976 WRITE( nounit, fmt = 9995 )
'GESVDX', iinfo, m, n,
977 $ jtype, lswork, ioldsd
987 CALL zbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
988 $ vtsav, ldvt, work, rwork, result( 23 ) )
989 IF( m.NE.0 .AND. n.NE.0 )
THEN
990 CALL zunt01(
'Columns', mnmin, m, usav, ldu, work,
991 $ lwork, rwork, result( 24 ) )
992 CALL zunt01(
'Rows', mnmin, n, vtsav, ldvt, work,
993 $ lwork, rwork, result( 25 ) )
996 DO 140 i = 1, mnmin - 1
997 IF( ssav( i ).LT.ssav( i+1 ) )
998 $ result( 26 ) = ulpinv
999 IF( ssav( i ).LT.zero )
1000 $ result( 26 ) = ulpinv
1002 IF( mnmin.GE.1 )
THEN
1003 IF( ssav( mnmin ).LT.zero )
1004 $ result( 26 ) = ulpinv
1014 IF( ( iju.EQ.0 .AND. ijvt.EQ.0 ) .OR.
1015 $ ( iju.EQ.1 .AND. ijvt.EQ.1 ) )
GO TO 160
1016 jobu = cjobv( iju+1 )
1017 jobvt = cjobv( ijvt+1 )
1019 CALL zlacpy(
'F', m, n, asav, lda, a, lda )
1021 CALL zgesvdx( jobu, jobvt,
'A', m, n, a, lda,
1022 $ vl, vu, il, iu, ns, ssav, u, ldu,
1023 $ vt, ldvt, work, lwork, rwork,
1029 IF( m.GT.0 .AND. n.GT.0 )
THEN
1031 CALL zunt03(
'C', m, mnmin, m, mnmin, usav,
1032 $ ldu, u, ldu, work, lwork, rwork,
1036 result( 27 ) = max( result( 27 ), dif )
1041 IF( m.GT.0 .AND. n.GT.0 )
THEN
1042 IF( ijvt.EQ.1 )
THEN
1043 CALL zunt03(
'R', n, mnmin, n, mnmin, vtsav,
1044 $ ldvt, vt, ldvt, work, lwork,
1045 $ rwork, dif, iinfo )
1048 result( 28 ) = max( result( 28 ), dif )
1053 div = max( dble( mnmin )*ulp*s( 1 ),
1054 $ dlamch(
'Safe minimum' ) )
1055 DO 150 i = 1, mnmin - 1
1056 IF( ssav( i ).LT.ssav( i+1 ) )
1058 IF( ssav( i ).LT.zero )
1060 dif = max( dif, abs( ssav( i )-s( i ) ) / div )
1062 result( 29) = max( result( 29 ), dif )
1069 iseed2( i ) = iseed( i )
1071 IF( mnmin.LE.1 )
THEN
1073 iu = max( 1, mnmin )
1075 il = 1 + int( ( mnmin-1 )*dlarnd( 1, iseed2 ) )
1076 iu = 1 + int( ( mnmin-1 )*dlarnd( 1, iseed2 ) )
1083 CALL zlacpy(
'F', m, n, asav, lda, a, lda )
1085 CALL zgesvdx(
'V',
'V',
'I', m, n, a, lda,
1086 $ vl, vu, il, iu, nsi, s, u, ldu,
1087 $ vt, ldvt, work, lwork, rwork,
1089 IF( iinfo.NE.0 )
THEN
1090 WRITE( nounit, fmt = 9995 )
'GESVDX', iinfo, m, n,
1091 $ jtype, lswork, ioldsd
1099 CALL zbdt05( m, n, asav, lda, s, nsi, u, ldu,
1100 $ vt, ldvt, work, result( 30 ) )
1101 IF( m.NE.0 .AND. n.NE.0 )
THEN
1102 CALL zunt01(
'Columns', m, nsi, u, ldu, work,
1103 $ lwork, rwork, result( 31 ) )
1104 CALL zunt01(
'Rows', nsi, n, vt, ldvt, work,
1105 $ lwork, rwork, result( 32 ) )
1110 IF( mnmin.GT.0 .AND. nsi.GT.1 )
THEN
1113 $ max( half*abs( ssav( il )-ssav( il-1 ) ),
1114 $ ulp*anorm, two*rtunfl )
1117 $ max( half*abs( ssav( ns )-ssav( 1 ) ),
1118 $ ulp*anorm, two*rtunfl )
1121 vl = ssav( iu ) - max( ulp*anorm, two*rtunfl,
1122 $ half*abs( ssav( iu+1 )-ssav( iu ) ) )
1124 vl = ssav( ns ) - max( ulp*anorm, two*rtunfl,
1125 $ half*abs( ssav( ns )-ssav( 1 ) ) )
1129 IF( vl.GE.vu ) vu = max( vu*2, vu+vl+half )
1134 CALL zlacpy(
'F', m, n, asav, lda, a, lda )
1136 CALL zgesvdx(
'V',
'V',
'V', m, n, a, lda,
1137 $ vl, vu, il, iu, nsv, s, u, ldu,
1138 $ vt, ldvt, work, lwork, rwork,
1140 IF( iinfo.NE.0 )
THEN
1141 WRITE( nounit, fmt = 9995 )
'GESVDX', iinfo, m, n,
1142 $ jtype, lswork, ioldsd
1150 CALL zbdt05( m, n, asav, lda, s, nsv, u, ldu,
1151 $ vt, ldvt, work, result( 33 ) )
1152 IF( m.NE.0 .AND. n.NE.0 )
THEN
1153 CALL zunt01(
'Columns', m, nsv, u, ldu, work,
1154 $ lwork, rwork, result( 34 ) )
1155 CALL zunt01(
'Rows', nsv, n, vt, ldvt, work,
1156 $ lwork, rwork, result( 35 ) )
1164 IF( result( j ).GE.zero )
1166 IF( result( j ).GE.thresh )
1171 $ ntestf = ntestf + 1
1172 IF( ntestf.EQ.1 )
THEN
1173 WRITE( nounit, fmt = 9999 )
1174 WRITE( nounit, fmt = 9998 )thresh
1179 IF( result( j ).GE.thresh )
THEN
1180 WRITE( nounit, fmt = 9997 )m, n, jtype, iwspc,
1181 $ ioldsd, j, result( j )
1185 nerrs = nerrs + nfail
1186 ntestt = ntestt + ntest
1195 CALL alasvm(
'ZBD', nounit, nerrs, ntestt, 0 )
1197 9999
FORMAT(
' SVD -- Complex Singular Value Decomposition Driver ',
1198 $ /
' Matrix types (see ZDRVBD for details):',
1199 $ / /
' 1 = Zero matrix', /
' 2 = Identity matrix',
1200 $ /
' 3 = Evenly spaced singular values near 1',
1201 $ /
' 4 = Evenly spaced singular values near underflow',
1202 $ /
' 5 = Evenly spaced singular values near overflow',
1203 $ / /
' Tests performed: ( A is dense, U and V are unitary,',
1204 $ / 19x,
' S is an array, and Upartial, VTpartial, and',
1205 $ / 19x,
' Spartial are partially computed U, VT and S),', / )
1206 9998
FORMAT(
' Tests performed with Test Threshold = ', f8.2,
1208 $
' 1 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
1209 $ /
' 2 = | I - U**T U | / ( M ulp ) ',
1210 $ /
' 3 = | I - VT VT**T | / ( N ulp ) ',
1211 $ /
' 4 = 0 if S contains min(M,N) nonnegative values in',
1212 $
' decreasing order, else 1/ulp',
1213 $ /
' 5 = | U - Upartial | / ( M ulp )',
1214 $ /
' 6 = | VT - VTpartial | / ( N ulp )',
1215 $ /
' 7 = | S - Spartial | / ( min(M,N) ulp |S| )',
1217 $
' 8 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
1218 $ /
' 9 = | I - U**T U | / ( M ulp ) ',
1219 $ /
'10 = | I - VT VT**T | / ( N ulp ) ',
1220 $ /
'11 = 0 if S contains min(M,N) nonnegative values in',
1221 $
' decreasing order, else 1/ulp',
1222 $ /
'12 = | U - Upartial | / ( M ulp )',
1223 $ /
'13 = | VT - VTpartial | / ( N ulp )',
1224 $ /
'14 = | S - Spartial | / ( min(M,N) ulp |S| )',
1226 $ /
'15 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
1227 $ /
'16 = | I - U**T U | / ( M ulp ) ',
1228 $ /
'17 = | I - VT VT**T | / ( N ulp ) ',
1229 $ /
'18 = 0 if S contains min(M,N) nonnegative values in',
1230 $
' decreasing order, else 1/ulp',
1232 $ /
'19 = | A - U diag(S) VT | / ( |A| max(M,N) ulp )',
1233 $ /
'20 = | I - U**T U | / ( M ulp ) ',
1234 $ /
'21 = | I - VT VT**T | / ( N ulp ) ',
1235 $ /
'22 = 0 if S contains min(M,N) nonnegative values in',
1236 $
' decreasing order, else 1/ulp',
1237 $ /
' ZGESVDX(V,V,A): ', /
1238 $
'23 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
1239 $ /
'24 = | I - U**T U | / ( M ulp ) ',
1240 $ /
'25 = | I - VT VT**T | / ( N ulp ) ',
1241 $ /
'26 = 0 if S contains min(M,N) nonnegative values in',
1242 $
' decreasing order, else 1/ulp',
1243 $ /
'27 = | U - Upartial | / ( M ulp )',
1244 $ /
'28 = | VT - VTpartial | / ( N ulp )',
1245 $ /
'29 = | S - Spartial | / ( min(M,N) ulp |S| )',
1246 $ /
' ZGESVDX(V,V,I): ',
1247 $ /
'30 = | U**T A VT**T - diag(S) | / ( |A| max(M,N) ulp )',
1248 $ /
'31 = | I - U**T U | / ( M ulp ) ',
1249 $ /
'32 = | I - VT VT**T | / ( N ulp ) ',
1250 $ /
' ZGESVDX(V,V,V) ',
1251 $ /
'33 = | U**T A VT**T - diag(S) | / ( |A| max(M,N) ulp )',
1252 $ /
'34 = | I - U**T U | / ( M ulp ) ',
1253 $ /
'35 = | I - VT VT**T | / ( N ulp ) ',
1255 9997
FORMAT(
' M=', i5,
', N=', i5,
', type ', i1,
', IWS=', i1,
1256 $
', seed=', 4( i4,
',' ),
' test(', i2,
')=', g11.4 )
1257 9996
FORMAT(
' ZDRVBD: ', a,
' returned INFO=', i6,
'.', / 9x,
'M=',
1258 $ i6,
', N=', i6,
', JTYPE=', i6,
', ISEED=(', 3( i5,
',' ),
1260 9995
FORMAT(
' ZDRVBD: ', a,
' returned INFO=', i6,
'.', / 9x,
'M=',
1261 $ i6,
', N=', i6,
', JTYPE=', i6,
', LSWORK=', i6, / 9x,
1262 $
'ISEED=(', 3( i5,
',' ), i5,
')' )
subroutine zgesdd(JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, RWORK, IWORK, INFO)
ZGESDD
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
subroutine zbdt05(M, N, A, LDA, S, NS, U, LDU, VT, LDVT, WORK, RESID)
ZBDT05
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zgesvdx(JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, IL, IU, NS, S, U, LDU, VT, LDVT, WORK, LWORK, RWORK, IWORK, INFO)
ZGESVDX computes the singular value decomposition (SVD) for GE matrices
subroutine zdrvbd(NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH, A, LDA, U, LDU, VT, LDVT, ASAV, USAV, VTSAV, S, SSAV, E, WORK, LWORK, RWORK, IWORK, NOUNIT, INFO)
ZDRVBD
subroutine zunt01(ROWCOL, M, N, U, LDU, WORK, LWORK, RWORK, RESID)
ZUNT01
subroutine zbdt01(M, N, KD, A, LDA, Q, LDQ, D, E, PT, LDPT, WORK, RWORK, RESID)
ZBDT01
subroutine zgejsv(JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, M, N, A, LDA, SVA, U, LDU, V, LDV, CWORK, LWORK, RWORK, LRWORK, IWORK, INFO)
ZGEJSV
subroutine zgesvd(JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, RWORK, INFO)
ZGESVD computes the singular value decomposition (SVD) for GE matrices
subroutine xerbla(SRNAME, INFO)
XERBLA
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 zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine zunt03(RC, MU, MV, N, K, U, LDU, V, LDV, WORK, LWORK, RWORK, RESULT, INFO)
ZUNT03
subroutine zgesvj(JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, LDV, CWORK, LWORK, RWORK, LRWORK, INFO)
ZGESVJ