387 SUBROUTINE cdrvbd( 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,
404 INTEGER ISEED( 4 ), IWORK( * ), MM( * ), NN( * )
405 REAL E( * ), RWORK( * ), S( * ), SSAV( * )
406 COMPLEX A( lda, * ), ASAV( lda, * ), U( ldu, * ),
407 $ usav( ldu, * ), vt( ldvt, * ),
408 $ vtsav( ldvt, * ), work( * )
414 REAL ZERO, ONE, TWO, HALF
415 parameter ( zero = 0.0e0, one = 1.0e0, two = 2.0e0,
418 parameter ( czero = ( 0.0e+0, 0.0e+0 ),
419 $ cone = ( 1.0e+0, 0.0e+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 REAL ANORM, DIF, DIV, OVFL, RTUNFL, ULP, ULPINV,
435 CHARACTER CJOB( 4 ), CJOBR( 3 ), CJOBV( 2 )
436 INTEGER IOLDSD( 4 ), ISEED2( 4 )
441 EXTERNAL slamch, slarnd
449 INTRINSIC abs,
REAL, 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(
'CDRVBD', -info )
519 IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
528 rtunfl = sqrt( unfl )
534 DO 310 jsize = 1, nsizes
539 IF( nsizes.NE.1 )
THEN
540 mtypes = min( maxtyp, ntypes )
542 mtypes = min( maxtyp+1, ntypes )
545 DO 300 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 claset(
'Full', m, n, czero, czero, a, lda )
564 DO 30 i = 1, min( m, n )
568 ELSE IF( jtype.EQ.2 )
THEN
572 CALL claset(
'Full', m, n, czero, cone, a, lda )
573 DO 40 i = 1, min( m, n )
587 CALL clatms( m, n,
'U', iseed,
'N', s, 4,
REAL( 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 clacpy(
'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 clacpy(
'F', m, n, asav, lda, a, lda )
622 CALL cgesvd(
'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 cbdt01( 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 cunt01(
'Columns', mnmin, m, usav, ldu, work,
637 $ lwork, rwork, result( 2 ) )
638 CALL cunt01(
'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 clacpy(
'F', m, n, asav, lda, a, lda )
666 CALL cgesvd( 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 cunt03(
'C', m, mnmin, m, mnmin, usav,
675 $ ldu, a, lda, work, lwork, rwork,
677 ELSE IF( iju.EQ.2 )
THEN
678 CALL cunt03(
'C', m, mnmin, m, mnmin, usav,
679 $ ldu, u, ldu, work, lwork, rwork,
681 ELSE IF( iju.EQ.3 )
THEN
682 CALL cunt03(
'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 cunt03(
'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 cunt03(
'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 cunt03(
'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(
REAL( mnmin )*ULP*S( 1 ),
713 $ slamch(
'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 clacpy(
'F', m, n, asav, lda, a, lda )
738 CALL cgesdd(
'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 cbdt01( 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 cunt01(
'Columns', mnmin, m, usav, ldu, work,
753 $ lwork, rwork, result( 9 ) )
754 CALL cunt01(
'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 clacpy(
'F', m, n, asav, lda, a, lda )
778 CALL cgesdd( 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 cunt03(
'C', m, mnmin, m, mnmin, usav,
788 $ ldu, a, lda, work, lwork, rwork,
791 CALL cunt03(
'C', m, mnmin, m, mnmin, usav,
792 $ ldu, u, ldu, work, lwork, rwork,
795 ELSE IF( ijq.EQ.2 )
THEN
796 CALL cunt03(
'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 cunt03(
'R', n, mnmin, n, mnmin, vtsav,
810 $ ldvt, vt, ldvt, work, lwork,
811 $ rwork, dif, iinfo )
813 CALL cunt03(
'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 cunt03(
'R', n, mnmin, n, mnmin, vtsav,
819 $ ldvt, vt, ldvt, work, lwork, rwork,
823 result( 13 ) = max( result( 13 ), dif )
828 div = max(
REAL( mnmin )*ULP*S( 1 ),
829 $ slamch(
'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 clacpy(
'F', m, n, asav, lda, usav, lda )
860 CALL cgesvj(
'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 cbdt01( 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 cunt01(
'Columns', m, m, usav, ldu, work,
886 $ lwork, rwork, result( 16 ) )
887 CALL cunt01(
'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 clacpy(
'F', m, n, asav, lda, vtsav, lda )
921 CALL cgejsv(
'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 cbdt01( 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 cunt01(
'Columns', m, m, usav, ldu, work,
948 $ lwork, rwork, result( 20 ) )
949 CALL cunt01(
'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 clacpy(
'F', m, n, asav, lda, a, lda )
971 CALL cgesvdx(
'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 cbdt01( 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 cunt01(
'Columns', mnmin, m, usav, ldu, work,
991 $ lwork, rwork, result( 24 ) )
992 CALL cunt01(
'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 clacpy(
'F', m, n, asav, lda, a, lda )
1021 CALL cgesvdx( 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 cunt03(
'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 cunt03(
'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(
REAL( mnmin )*ULP*S( 1 ),
1054 $ slamch(
'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 )*slarnd( 1, iseed2 ) )
1076 iu = 1 + int( ( mnmin-1 )*slarnd( 1, iseed2 ) )
1083 CALL clacpy(
'F', m, n, asav, lda, a, lda )
1085 CALL cgesvdx(
'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 cbdt05( 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 cunt01(
'Columns', m, nsi, u, ldu, work,
1103 $ lwork, rwork, result( 31 ) )
1104 CALL cunt01(
'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 clacpy(
'F', m, n, asav, lda, a, lda )
1136 CALL cgesvdx(
'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 cbdt05( 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 cunt01(
'Columns', m, nsv, u, ldu, work,
1154 $ lwork, rwork, result( 34 ) )
1155 CALL cunt01(
'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(
'CBD', nounit, nerrs, ntestt, 0 )
1197 9999
FORMAT(
' SVD -- Complex Singular Value Decomposition Driver ',
1198 $ /
' Matrix types (see CDRVBD 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 $ /
' CGESVDX(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 $ /
' CGESVDX(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 $ /
' CGESVDX(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(
' CDRVBD: ', a,
' returned INFO=', i6,
'.', / 9x,
'M=',
1258 $ i6,
', N=', i6,
', JTYPE=', i6,
', ISEED=(', 3( i5,
',' ),
1260 9995
FORMAT(
' CDRVBD: ', a,
' returned INFO=', i6,
'.', / 9x,
'M=',
1261 $ i6,
', N=', i6,
', JTYPE=', i6,
', LSWORK=', i6, / 9x,
1262 $
'ISEED=(', 3( i5,
',' ), i5,
')' )
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
subroutine cunt03(RC, MU, MV, N, K, U, LDU, V, LDV, WORK, LWORK, RWORK, RESULT, INFO)
CUNT03
subroutine cdrvbd(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)
CDRVBD
subroutine cgesvd(JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, RWORK, INFO)
CGESVD computes the singular value decomposition (SVD) for GE matrices
subroutine cgesvdx(JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, IL, IU, NS, S, U, LDU, VT, LDVT, WORK, LWORK, RWORK, IWORK, INFO)
CGESVDX computes the singular value decomposition (SVD) for GE matrices
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cbdt01(M, N, KD, A, LDA, Q, LDQ, D, E, PT, LDPT, WORK, RWORK, RESID)
CBDT01
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine cgejsv(JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, M, N, A, LDA, SVA, U, LDU, V, LDV, CWORK, LWORK, RWORK, LRWORK, IWORK, INFO)
CGEJSV
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
subroutine cgesvj(JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, LDV, CWORK, LWORK, RWORK, LRWORK, INFO)
CGESVJ
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine cgesdd(JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, RWORK, IWORK, INFO)
CGESDD
subroutine cbdt05(M, N, A, LDA, S, NS, U, LDU, VT, LDVT, WORK, RESID)
subroutine cunt01(ROWCOL, M, N, U, LDU, WORK, LWORK, RWORK, RESID)
CUNT01