363 SUBROUTINE ddrvbd( NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH,
364 $ A, LDA, U, LDU, VT, LDVT, ASAV, USAV, VTSAV, S,
365 $ SSAV, E, WORK, LWORK, IWORK, NOUT, INFO )
374 INTEGER INFO, LDA, LDU, LDVT, LWORK, NOUT, NSIZES,
376 DOUBLE PRECISION THRESH
380 INTEGER ISEED( 4 ), IWORK( * ), MM( * ), NN( * )
381 DOUBLE PRECISION A( LDA, * ), ASAV( LDA, * ), E( * ), S( * ),
382 $ ssav( * ), u( ldu, * ), usav( ldu, * ),
383 $ vt( ldvt, * ), vtsav( ldvt, * ), work( * )
389 DOUBLE PRECISION ZERO, ONE, TWO, HALF
390 PARAMETER ( ZERO = 0.0d0, one = 1.0d0, two = 2.0d0,
393 PARAMETER ( MAXTYP = 5 )
397 CHARACTER JOBQ, JOBU, JOBVT, RANGE
399 INTEGER I, IINFO, IJQ, IJU, IJVT, IL,IU, IWS, IWTMP,
400 $ itemp, j, jsize, jtype, lswork, m, minwrk,
401 $ mmax, mnmax, mnmin, mtypes, n, nfail,
402 $ nmax, ns, nsi, nsv, ntest
403 DOUBLE PRECISION ANORM, DIF, DIV, OVFL, RTUNFL, ULP,
404 $ ULPINV, UNFL, VL, VU
407 INTEGER LIWORK, LRWORK, NUMRANK
410 DOUBLE PRECISION RWORK( 2 )
413 CHARACTER CJOB( 4 ), CJOBR( 3 ), CJOBV( 2 )
414 INTEGER IOLDSD( 4 ), ISEED2( 4 )
415 DOUBLE PRECISION RESULT( 39 )
418 DOUBLE PRECISION DLAMCH, DLARND
419 EXTERNAL DLAMCH, DLARND
427 INTRINSIC abs, dble, int, max, min
435 COMMON / infoc / infot, nunit, ok, lerr
436 COMMON / srnamc / srnamt
439 DATA cjob /
'N',
'O',
'S',
'A' /
440 DATA cjobr /
'A',
'V',
'I' /
441 DATA cjobv /
'N',
'V' /
455 mmax = max( mmax, mm( j ) )
458 nmax = max( nmax, nn( j ) )
461 mnmax = max( mnmax, min( mm( j ), nn( j ) ) )
462 minwrk = max( minwrk, max( 3*min( mm( j ),
463 $ nn( j ) )+max( mm( j ), nn( j ) ), 5*min( mm( j ),
464 $ nn( j )-4 ) )+2*min( mm( j ), nn( j ) )**2 )
469 IF( nsizes.LT.0 )
THEN
471 ELSE IF( badmm )
THEN
473 ELSE IF( badnn )
THEN
475 ELSE IF( ntypes.LT.0 )
THEN
477 ELSE IF( lda.LT.max( 1, mmax ) )
THEN
479 ELSE IF( ldu.LT.max( 1, mmax ) )
THEN
481 ELSE IF( ldvt.LT.max( 1, nmax ) )
THEN
483 ELSE IF( minwrk.GT.lwork )
THEN
488 CALL xerbla(
'DDRVBD', -info )
494 path( 1: 1 ) =
'Double precision'
498 unfl = dlamch(
'Safe minimum' )
500 ulp = dlamch(
'Precision' )
501 rtunfl = sqrt( unfl )
507 DO 240 jsize = 1, nsizes
512 IF( nsizes.NE.1 )
THEN
513 mtypes = min( maxtyp, ntypes )
515 mtypes = min( maxtyp+1, ntypes )
518 DO 230 jtype = 1, mtypes
519 IF( .NOT.dotype( jtype ) )
523 ioldsd( j ) = iseed( j )
528 IF( mtypes.GT.maxtyp )
531 IF( jtype.EQ.1 )
THEN
535 CALL dlaset(
'Full', m, n, zero, zero, a, lda )
537 ELSE IF( jtype.EQ.2 )
THEN
541 CALL dlaset(
'Full', m, n, zero, one, a, lda )
553 CALL dlatms( m, n,
'U', iseed,
'N', s, 4, dble( mnmin ),
554 $ anorm, m-1, n-1,
'N', a, lda, work, iinfo )
555 IF( iinfo.NE.0 )
THEN
556 WRITE( nout, fmt = 9996 )
'Generator', iinfo, m, n,
564 CALL dlacpy(
'F', m, n, a, lda, asav, lda )
576 iwtmp = max( 3*min( m, n )+max( m, n ), 5*min( m, n ) )
577 lswork = iwtmp + ( iws-1 )*( lwork-iwtmp ) / 3
578 lswork = min( lswork, lwork )
579 lswork = max( lswork, 1 )
584 $
CALL dlacpy(
'F', m, n, asav, lda, a, lda )
586 CALL dgesvd(
'A',
'A', m, n, a, lda, ssav, usav, ldu,
587 $ vtsav, ldvt, work, lswork, iinfo )
588 IF( iinfo.NE.0 )
THEN
589 WRITE( nout, fmt = 9995 )
'GESVD', iinfo, m, n, jtype,
597 CALL dbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
598 $ vtsav, ldvt, work, result( 1 ) )
599 IF( m.NE.0 .AND. n.NE.0 )
THEN
600 CALL dort01(
'Columns', m, m, usav, ldu, work, lwork,
602 CALL dort01(
'Rows', n, n, vtsav, ldvt, work, lwork,
606 DO 50 i = 1, mnmin - 1
607 IF( ssav( i ).LT.ssav( i+1 ) )
608 $ result( 4 ) = ulpinv
609 IF( ssav( i ).LT.zero )
610 $ result( 4 ) = ulpinv
612 IF( mnmin.GE.1 )
THEN
613 IF( ssav( mnmin ).LT.zero )
614 $ result( 4 ) = ulpinv
624 IF( ( iju.EQ.3 .AND. ijvt.EQ.3 ) .OR.
625 $ ( iju.EQ.1 .AND. ijvt.EQ.1 ) )
GO TO 70
627 jobvt = cjob( ijvt+1 )
628 CALL dlacpy(
'F', m, n, asav, lda, a, lda )
630 CALL dgesvd( jobu, jobvt, m, n, a, lda, s, u, ldu,
631 $ vt, ldvt, work, lswork, iinfo )
636 IF( m.GT.0 .AND. n.GT.0 )
THEN
638 CALL dort03(
'C', m, mnmin, m, mnmin, usav,
639 $ ldu, a, lda, work, lwork, dif,
641 ELSE IF( iju.EQ.2 )
THEN
642 CALL dort03(
'C', m, mnmin, m, mnmin, usav,
643 $ ldu, u, ldu, work, lwork, dif,
645 ELSE IF( iju.EQ.3 )
THEN
646 CALL dort03(
'C', m, m, m, mnmin, usav, ldu,
647 $ u, ldu, work, lwork, dif,
651 result( 5 ) = max( result( 5 ), dif )
656 IF( m.GT.0 .AND. n.GT.0 )
THEN
658 CALL dort03(
'R', n, mnmin, n, mnmin, vtsav,
659 $ ldvt, a, lda, work, lwork, dif,
661 ELSE IF( ijvt.EQ.2 )
THEN
662 CALL dort03(
'R', n, mnmin, n, mnmin, vtsav,
663 $ ldvt, vt, ldvt, work, lwork,
665 ELSE IF( ijvt.EQ.3 )
THEN
666 CALL dort03(
'R', n, n, n, mnmin, vtsav,
667 $ ldvt, vt, ldvt, work, lwork,
671 result( 6 ) = max( result( 6 ), dif )
676 div = max( mnmin*ulp*s( 1 ), unfl )
677 DO 60 i = 1, mnmin - 1
678 IF( ssav( i ).LT.ssav( i+1 ) )
680 IF( ssav( i ).LT.zero )
682 dif = max( dif, abs( ssav( i )-s( i ) ) / div )
684 result( 7 ) = max( result( 7 ), dif )
690 iwtmp = 5*mnmin*mnmin + 9*mnmin + max( m, n )
691 lswork = iwtmp + ( iws-1 )*( lwork-iwtmp ) / 3
692 lswork = min( lswork, lwork )
693 lswork = max( lswork, 1 )
697 CALL dlacpy(
'F', m, n, asav, lda, a, lda )
699 CALL dgesdd(
'A', m, n, a, lda, ssav, usav, ldu, vtsav,
700 $ ldvt, work, lswork, iwork, iinfo )
701 IF( iinfo.NE.0 )
THEN
702 WRITE( nout, fmt = 9995 )
'GESDD', iinfo, m, n, jtype,
710 CALL dbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
711 $ vtsav, ldvt, work, result( 8 ) )
712 IF( m.NE.0 .AND. n.NE.0 )
THEN
713 CALL dort01(
'Columns', m, m, usav, ldu, work, lwork,
715 CALL dort01(
'Rows', n, n, vtsav, ldvt, work, lwork,
719 DO 90 i = 1, mnmin - 1
720 IF( ssav( i ).LT.ssav( i+1 ) )
721 $ result( 11 ) = ulpinv
722 IF( ssav( i ).LT.zero )
723 $ result( 11 ) = ulpinv
725 IF( mnmin.GE.1 )
THEN
726 IF( ssav( mnmin ).LT.zero )
727 $ result( 11 ) = ulpinv
737 CALL dlacpy(
'F', m, n, asav, lda, a, lda )
739 CALL dgesdd( jobq, m, n, a, lda, s, u, ldu, vt, ldvt,
740 $ work, lswork, iwork, iinfo )
745 IF( m.GT.0 .AND. n.GT.0 )
THEN
748 CALL dort03(
'C', m, mnmin, m, mnmin, usav,
749 $ ldu, a, lda, work, lwork, dif,
752 CALL dort03(
'C', m, mnmin, m, mnmin, usav,
753 $ ldu, u, ldu, work, lwork, dif,
756 ELSE IF( ijq.EQ.2 )
THEN
757 CALL dort03(
'C', m, mnmin, m, mnmin, usav, ldu,
758 $ u, ldu, work, lwork, dif, info )
761 result( 12 ) = max( result( 12 ), dif )
766 IF( m.GT.0 .AND. n.GT.0 )
THEN
769 CALL dort03(
'R', n, mnmin, n, mnmin, vtsav,
770 $ ldvt, vt, ldvt, work, lwork,
773 CALL dort03(
'R', n, mnmin, n, mnmin, vtsav,
774 $ ldvt, a, lda, work, lwork, dif,
777 ELSE IF( ijq.EQ.2 )
THEN
778 CALL dort03(
'R', n, mnmin, n, mnmin, vtsav,
779 $ ldvt, vt, ldvt, work, lwork, dif,
783 result( 13 ) = max( result( 13 ), dif )
788 div = max( mnmin*ulp*s( 1 ), unfl )
789 DO 100 i = 1, mnmin - 1
790 IF( ssav( i ).LT.ssav( i+1 ) )
792 IF( ssav( i ).LT.zero )
794 dif = max( dif, abs( ssav( i )-s( i ) ) / div )
796 result( 14 ) = max( result( 14 ), dif )
808 iwtmp = 5*mnmin*mnmin + 9*mnmin + max( m, n )
809 lswork = iwtmp + ( iws-1 )*( lwork-iwtmp ) / 3
810 lswork = min( lswork, lwork )
811 lswork = max( lswork, 1 )
815 CALL dlacpy(
'F', m, n, asav, lda, a, lda )
820 CALL dgesvdq(
'H',
'N',
'N',
'A',
'A',
821 $ m, n, a, lda, ssav, usav, ldu,
822 $ vtsav, ldvt, numrank, iwork, liwork,
823 $ work, lwork, rwork, lrwork, iinfo )
825 IF( iinfo.NE.0 )
THEN
826 WRITE( nout, fmt = 9995 )
'DGESVDQ', iinfo, m, n,
827 $ jtype, lswork, ioldsd
834 CALL dbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
835 $ vtsav, ldvt, work, result( 36 ) )
836 IF( m.NE.0 .AND. n.NE.0 )
THEN
837 CALL dort01(
'Columns', m, m, usav, ldu, work,
838 $ lwork, result( 37 ) )
839 CALL dort01(
'Rows', n, n, vtsav, ldvt, work,
840 $ lwork, result( 38 ) )
843 DO 199 i = 1, mnmin - 1
844 IF( ssav( i ).LT.ssav( i+1 ) )
845 $ result( 39 ) = ulpinv
846 IF( ssav( i ).LT.zero )
847 $ result( 39 ) = ulpinv
849 IF( mnmin.GE.1 )
THEN
850 IF( ssav( mnmin ).LT.zero )
851 $ result( 39 ) = ulpinv
864 iwtmp = 5*mnmin*mnmin + 9*mnmin + max( m, n )
865 lswork = iwtmp + ( iws-1 )*( lwork-iwtmp ) / 3
866 lswork = min( lswork, lwork )
867 lswork = max( lswork, 1 )
871 CALL dlacpy(
'F', m, n, asav, lda, usav, lda )
873 CALL dgesvj(
'G',
'U',
'V', m, n, usav, lda, ssav,
874 & 0, a, ldvt, work, lwork, info )
884 IF( iinfo.NE.0 )
THEN
885 WRITE( nout, fmt = 9995 )
'GESVJ', iinfo, m, n,
886 $ jtype, lswork, ioldsd
893 CALL dbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
894 $ vtsav, ldvt, work, result( 15 ) )
895 IF( m.NE.0 .AND. n.NE.0 )
THEN
896 CALL dort01(
'Columns', m, m, usav, ldu, work,
897 $ lwork, result( 16 ) )
898 CALL dort01(
'Rows', n, n, vtsav, ldvt, work,
899 $ lwork, result( 17 ) )
902 DO 120 i = 1, mnmin - 1
903 IF( ssav( i ).LT.ssav( i+1 ) )
904 $ result( 18 ) = ulpinv
905 IF( ssav( i ).LT.zero )
906 $ result( 18 ) = ulpinv
908 IF( mnmin.GE.1 )
THEN
909 IF( ssav( mnmin ).LT.zero )
910 $ result( 18 ) = ulpinv
922 iwtmp = 5*mnmin*mnmin + 9*mnmin + max( m, n )
923 lswork = iwtmp + ( iws-1 )*( lwork-iwtmp ) / 3
924 lswork = min( lswork, lwork )
925 lswork = max( lswork, 1 )
929 CALL dlacpy(
'F', m, n, asav, lda, vtsav, lda )
931 CALL dgejsv(
'G',
'U',
'V',
'R',
'N',
'N',
932 & m, n, vtsav, lda, ssav, usav, ldu, a, ldvt,
933 & work, lwork, iwork, info )
943 IF( iinfo.NE.0 )
THEN
944 WRITE( nout, fmt = 9995 )
'GEJSV', iinfo, m, n,
945 $ jtype, lswork, ioldsd
952 CALL dbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
953 $ vtsav, ldvt, work, result( 19 ) )
954 IF( m.NE.0 .AND. n.NE.0 )
THEN
955 CALL dort01(
'Columns', m, m, usav, ldu, work,
956 $ lwork, result( 20 ) )
957 CALL dort01(
'Rows', n, n, vtsav, ldvt, work,
958 $ lwork, result( 21 ) )
961 DO 150 i = 1, mnmin - 1
962 IF( ssav( i ).LT.ssav( i+1 ) )
963 $ result( 22 ) = ulpinv
964 IF( ssav( i ).LT.zero )
965 $ result( 22 ) = ulpinv
967 IF( mnmin.GE.1 )
THEN
968 IF( ssav( mnmin ).LT.zero )
969 $ result( 22 ) = ulpinv
975 CALL dlacpy(
'F', m, n, asav, lda, a, lda )
976 CALL dgesvdx(
'V',
'V',
'A', m, n, a, lda,
977 $ vl, vu, il, iu, ns, ssav, usav, ldu,
978 $ vtsav, ldvt, work, lwork, iwork,
980 IF( iinfo.NE.0 )
THEN
981 WRITE( nout, fmt = 9995 )
'GESVDX', iinfo, m, n,
982 $ jtype, lswork, ioldsd
992 CALL dbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
993 $ vtsav, ldvt, work, result( 23 ) )
994 IF( m.NE.0 .AND. n.NE.0 )
THEN
995 CALL dort01(
'Columns', m, m, usav, ldu, work, lwork,
997 CALL dort01(
'Rows', n, n, vtsav, ldvt, work, lwork,
1001 DO 160 i = 1, mnmin - 1
1002 IF( ssav( i ).LT.ssav( i+1 ) )
1003 $ result( 26 ) = ulpinv
1004 IF( ssav( i ).LT.zero )
1005 $ result( 26 ) = ulpinv
1007 IF( mnmin.GE.1 )
THEN
1008 IF( ssav( mnmin ).LT.zero )
1009 $ result( 26 ) = ulpinv
1019 IF( ( iju.EQ.0 .AND. ijvt.EQ.0 ) .OR.
1020 $ ( iju.EQ.1 .AND. ijvt.EQ.1 ) )
GO TO 170
1021 jobu = cjobv( iju+1 )
1022 jobvt = cjobv( ijvt+1 )
1024 CALL dlacpy(
'F', m, n, asav, lda, a, lda )
1025 CALL dgesvdx( jobu, jobvt, range, m, n, a, lda,
1026 $ vl, vu, il, iu, ns, s, u, ldu,
1027 $ vt, ldvt, work, lwork, iwork,
1033 IF( m.GT.0 .AND. n.GT.0 )
THEN
1035 CALL dort03(
'C', m, mnmin, m, mnmin, usav,
1036 $ ldu, u, ldu, work, lwork, dif,
1040 result( 27 ) = max( result( 27 ), dif )
1045 IF( m.GT.0 .AND. n.GT.0 )
THEN
1046 IF( ijvt.EQ.1 )
THEN
1047 CALL dort03(
'R', n, mnmin, n, mnmin, vtsav,
1048 $ ldvt, vt, ldvt, work, lwork,
1052 result( 28 ) = max( result( 28 ), dif )
1057 div = max( mnmin*ulp*s( 1 ), unfl )
1058 DO 190 i = 1, mnmin - 1
1059 IF( ssav( i ).LT.ssav( i+1 ) )
1061 IF( ssav( i ).LT.zero )
1063 dif = max( dif, abs( ssav( i )-s( i ) ) / div )
1065 result( 29 ) = max( result( 29 ), dif )
1072 iseed2( i ) = iseed( i )
1074 IF( mnmin.LE.1 )
THEN
1076 iu = max( 1, mnmin )
1078 il = 1 + int( ( mnmin-1 )*dlarnd( 1, iseed2 ) )
1079 iu = 1 + int( ( mnmin-1 )*dlarnd( 1, iseed2 ) )
1086 CALL dlacpy(
'F', m, n, asav, lda, a, lda )
1087 CALL dgesvdx(
'V',
'V',
'I', m, n, a, lda,
1088 $ vl, vu, il, iu, nsi, s, u, ldu,
1089 $ vt, ldvt, work, lwork, iwork,
1091 IF( iinfo.NE.0 )
THEN
1092 WRITE( nout, fmt = 9995 )
'GESVDX', iinfo, m, n,
1093 $ jtype, lswork, ioldsd
1101 CALL dbdt05( m, n, asav, lda, s, nsi, u, ldu,
1102 $ vt, ldvt, work, result( 30 ) )
1103 CALL dort01(
'Columns', m, nsi, u, ldu, work, lwork,
1105 CALL dort01(
'Rows', nsi, n, vt, ldvt, work, lwork,
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 dlacpy(
'F', m, n, asav, lda, a, lda )
1135 CALL dgesvdx(
'V',
'V',
'V', m, n, a, lda,
1136 $ vl, vu, il, iu, nsv, s, u, ldu,
1137 $ vt, ldvt, work, lwork, iwork,
1139 IF( iinfo.NE.0 )
THEN
1140 WRITE( nout, fmt = 9995 )
'GESVDX', iinfo, m, n,
1141 $ jtype, lswork, ioldsd
1149 CALL dbdt05( m, n, asav, lda, s, nsv, u, ldu,
1150 $ vt, ldvt, work, result( 33 ) )
1151 CALL dort01(
'Columns', m, nsv, u, ldu, work, lwork,
1153 CALL dort01(
'Rows', nsv, n, vt, ldvt, work, lwork,
1159 IF( result( j ).GE.thresh )
THEN
1160 IF( nfail.EQ.0 )
THEN
1161 WRITE( nout, fmt = 9999 )
1162 WRITE( nout, fmt = 9998 )
1164 WRITE( nout, fmt = 9997 )m, n, jtype, iws, ioldsd,
1176 CALL alasvm( path, nout, nfail, ntest, 0 )
1178 9999
FORMAT(
' SVD -- Real Singular Value Decomposition Driver ',
1179 $ /
' Matrix types (see DDRVBD for details):',
1180 $ / /
' 1 = Zero matrix', /
' 2 = Identity matrix',
1181 $ /
' 3 = Evenly spaced singular values near 1',
1182 $ /
' 4 = Evenly spaced singular values near underflow',
1183 $ /
' 5 = Evenly spaced singular values near overflow', / /
1184 $
' Tests performed: ( A is dense, U and V are orthogonal,',
1185 $ / 19x,
' S is an array, and Upartial, VTpartial, and',
1186 $ / 19x,
' Spartial are partially computed U, VT and S),', / )
1187 9998
FORMAT(
' 1 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
1188 $ /
' 2 = | I - U**T U | / ( M ulp ) ',
1189 $ /
' 3 = | I - VT VT**T | / ( N ulp ) ',
1190 $ /
' 4 = 0 if S contains min(M,N) nonnegative values in',
1191 $
' decreasing order, else 1/ulp',
1192 $ /
' 5 = | U - Upartial | / ( M ulp )',
1193 $ /
' 6 = | VT - VTpartial | / ( N ulp )',
1194 $ /
' 7 = | S - Spartial | / ( min(M,N) ulp |S| )',
1195 $ /
' 8 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
1196 $ /
' 9 = | I - U**T U | / ( M ulp ) ',
1197 $ /
'10 = | I - VT VT**T | / ( N ulp ) ',
1198 $ /
'11 = 0 if S contains min(M,N) nonnegative values in',
1199 $
' decreasing order, else 1/ulp',
1200 $ /
'12 = | U - Upartial | / ( M ulp )',
1201 $ /
'13 = | VT - VTpartial | / ( N ulp )',
1202 $ /
'14 = | S - Spartial | / ( min(M,N) ulp |S| )',
1203 $ /
'15 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
1204 $ /
'16 = | I - U**T U | / ( M ulp ) ',
1205 $ /
'17 = | I - VT VT**T | / ( N ulp ) ',
1206 $ /
'18 = 0 if S contains min(M,N) nonnegative values in',
1207 $
' decreasing order, else 1/ulp',
1208 $ /
'19 = | U - Upartial | / ( M ulp )',
1209 $ /
'20 = | VT - VTpartial | / ( N ulp )',
1210 $ /
'21 = | S - Spartial | / ( min(M,N) ulp |S| )',
1211 $ /
'22 = 0 if S contains min(M,N) nonnegative values in',
1212 $
' decreasing order, else 1/ulp',
1213 $ /
'23 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ),',
1214 $
' DGESVDX(V,V,A) ',
1215 $ /
'24 = | I - U**T U | / ( M ulp ) ',
1216 $ /
'25 = | I - VT VT**T | / ( N ulp ) ',
1217 $ /
'26 = 0 if S contains min(M,N) nonnegative values in',
1218 $
' decreasing order, else 1/ulp',
1219 $ /
'27 = | U - Upartial | / ( M ulp )',
1220 $ /
'28 = | VT - VTpartial | / ( N ulp )',
1221 $ /
'29 = | S - Spartial | / ( min(M,N) ulp |S| )',
1222 $ /
'30 = | U**T A VT**T - diag(S) | / ( |A| max(M,N) ulp ),',
1223 $
' DGESVDX(V,V,I) ',
1224 $ /
'31 = | I - U**T U | / ( M ulp ) ',
1225 $ /
'32 = | I - VT VT**T | / ( N ulp ) ',
1226 $ /
'33 = | U**T A VT**T - diag(S) | / ( |A| max(M,N) ulp ),',
1227 $
' DGESVDX(V,V,V) ',
1228 $ /
'34 = | I - U**T U | / ( M ulp ) ',
1229 $ /
'35 = | I - VT VT**T | / ( N ulp ) ',
1230 $
' DGESVDQ(H,N,N,A,A',
1231 $ /
'36 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
1232 $ /
'37 = | I - U**T U | / ( M ulp ) ',
1233 $ /
'38 = | I - VT VT**T | / ( N ulp ) ',
1234 $ /
'39 = 0 if S contains min(M,N) nonnegative values in',
1235 $
' decreasing order, else 1/ulp',
1237 9997
FORMAT(
' M=', i5,
', N=', i5,
', type ', i1,
', IWS=', i1,
1238 $
', seed=', 4( i4,
',' ),
' test(', i2,
')=', g11.4 )
1239 9996
FORMAT(
' DDRVBD: ', a,
' returned INFO=', i6,
'.', / 9x,
'M=',
1240 $ i6,
', N=', i6,
', JTYPE=', i6,
', ISEED=(', 3( i5,
',' ),
1242 9995
FORMAT(
' DDRVBD: ', a,
' returned INFO=', i6,
'.', / 9x,
'M=',
1243 $ i6,
', N=', i6,
', JTYPE=', i6,
', LSWORK=', i6, / 9x,
1244 $
'ISEED=(', 3( i5,
',' ), i5,
')' )
subroutine alasvm(type, nout, nfail, nrun, nerrs)
ALASVM
subroutine xerbla(srname, info)
subroutine dbdt01(m, n, kd, a, lda, q, ldq, d, e, pt, ldpt, work, resid)
DBDT01
subroutine dbdt05(m, n, a, lda, s, ns, u, ldu, vt, ldvt, work, resid)
DBDT05
subroutine ddrvbd(nsizes, mm, nn, ntypes, dotype, iseed, thresh, a, lda, u, ldu, vt, ldvt, asav, usav, vtsav, s, ssav, e, work, lwork, iwork, nout, info)
DDRVBD
subroutine dlatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
DLATMS
subroutine dort01(rowcol, m, n, u, ldu, work, lwork, resid)
DORT01
subroutine dort03(rc, mu, mv, n, k, u, ldu, v, ldv, work, lwork, result, info)
DORT03
subroutine dgejsv(joba, jobu, jobv, jobr, jobt, jobp, m, n, a, lda, sva, u, ldu, v, ldv, work, lwork, iwork, info)
DGEJSV
subroutine dgesdd(jobz, m, n, a, lda, s, u, ldu, vt, ldvt, work, lwork, iwork, info)
DGESDD
subroutine dgesvd(jobu, jobvt, m, n, a, lda, s, u, ldu, vt, ldvt, work, lwork, info)
DGESVD computes the singular value decomposition (SVD) for GE matrices
subroutine dgesvdq(joba, jobp, jobr, jobu, jobv, m, n, a, lda, s, u, ldu, v, ldv, numrank, iwork, liwork, work, lwork, rwork, lrwork, info)
DGESVDQ computes the singular value decomposition (SVD) with a QR-Preconditioned QR SVD Method for GE...
subroutine dgesvdx(jobu, jobvt, range, m, n, a, lda, vl, vu, il, iu, ns, s, u, ldu, vt, ldvt, work, lwork, iwork, info)
DGESVDX computes the singular value decomposition (SVD) for GE matrices
subroutine dgesvj(joba, jobu, jobv, m, n, a, lda, sva, mv, v, ldv, work, lwork, info)
DGESVJ
subroutine dlacpy(uplo, m, n, a, lda, b, ldb)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dlaset(uplo, m, n, alpha, beta, a, lda)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.