364 INTEGER info, lda, ldu, ldvt, lwork, nout, nsizes,
370 INTEGER iseed( 4 ), iwork( * ), mm( * ), nn( * )
371 REAL a( lda, * ), asav( lda, * ), e( * ), s( * ),
372 $ ssav( * ), u( ldu, * ), usav( ldu, * ),
373 $ vt( ldvt, * ), vtsav( ldvt, * ), work( * )
379 REAL zero, one, two, half
380 parameter ( zero = 0.0e0, one = 1.0e0, two = 2.0e0,
383 parameter ( maxtyp = 5 )
387 CHARACTER jobq, jobu, jobvt, range
389 INTEGER i, iinfo, ijq, iju, ijvt, il,iu, iws, iwtmp,
390 $ itemp, j, jsize, jtype, lswork, m, minwrk,
391 $ mmax, mnmax, mnmin, mtypes, n, nfail,
392 $ nmax, ns, nsi, nsv, ntest
393 REAL anorm, dif, div, ovfl, rtunfl, ulp,
394 $ ulpinv, unfl, vl, vu
397 CHARACTER cjob( 4 ), cjobr( 3 ), cjobv( 2 )
398 INTEGER ioldsd( 4 ), iseed2( 4 )
411 INTRINSIC abs,
REAL, int, max, min
419 COMMON / infoc / infot, nunit, ok, lerr
420 COMMON / srnamc / srnamt
423 DATA cjob /
'N',
'O',
'S',
'A' /
424 DATA cjobr /
'A',
'V',
'I' /
425 DATA cjobv /
'N',
'V' /
439 mmax = max( mmax, mm( j ) )
442 nmax = max( nmax, nn( j ) )
445 mnmax = max( mnmax, min( mm( j ), nn( j ) ) )
446 minwrk = max( minwrk, max( 3*min( mm( j ),
447 $ nn( j ) )+max( mm( j ), nn( j ) ), 5*min( mm( j ),
448 $ nn( j )-4 ) )+2*min( mm( j ), nn( j ) )**2 )
453 IF( nsizes.LT.0 )
THEN
455 ELSE IF( badmm )
THEN
457 ELSE IF( badnn )
THEN
459 ELSE IF( ntypes.LT.0 )
THEN
461 ELSE IF( lda.LT.max( 1, mmax ) )
THEN
463 ELSE IF( ldu.LT.max( 1, mmax ) )
THEN
465 ELSE IF( ldvt.LT.max( 1, nmax ) )
THEN
467 ELSE IF( minwrk.GT.lwork )
THEN
472 CALL xerbla(
'SDRVBD', -info )
478 path( 1: 1 ) =
'Single precision'
482 unfl =
slamch(
'Safe minimum' )
485 ulp =
slamch(
'Precision' )
486 rtunfl = sqrt( unfl )
492 DO 240 jsize = 1, nsizes
497 IF( nsizes.NE.1 )
THEN
498 mtypes = min( maxtyp, ntypes )
500 mtypes = min( maxtyp+1, ntypes )
503 DO 230 jtype = 1, mtypes
504 IF( .NOT.dotype( jtype ) )
508 ioldsd( j ) = iseed( j )
513 IF( mtypes.GT.maxtyp )
516 IF( jtype.EQ.1 )
THEN
520 CALL slaset(
'Full', m, n, zero, zero, a, lda )
522 ELSE IF( jtype.EQ.2 )
THEN
526 CALL slaset(
'Full', m, n, zero, one, a, lda )
538 CALL slatms( m, n,
'U', iseed,
'N', s, 4,
REAL( MNMIN ),
539 $ anorm, m-1, n-1,
'N', a, lda, work, iinfo )
540 IF( iinfo.NE.0 )
THEN
541 WRITE( nout, fmt = 9996 )
'Generator', iinfo, m, n,
549 CALL slacpy(
'F', m, n, a, lda, asav, lda )
561 iwtmp = max( 3*min( m, n )+max( m, n ), 5*min( m, n ) )
562 lswork = iwtmp + ( iws-1 )*( lwork-iwtmp ) / 3
563 lswork = min( lswork, lwork )
564 lswork = max( lswork, 1 )
569 $
CALL slacpy(
'F', m, n, asav, lda, a, lda )
571 CALL sgesvd(
'A',
'A', m, n, a, lda, ssav, usav, ldu,
572 $ vtsav, ldvt, work, lswork, iinfo )
573 IF( iinfo.NE.0 )
THEN
574 WRITE( nout, fmt = 9995 )
'GESVD', iinfo, m, n, jtype,
582 CALL sbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
583 $ vtsav, ldvt, work, result( 1 ) )
584 IF( m.NE.0 .AND. n.NE.0 )
THEN
585 CALL sort01(
'Columns', m, m, usav, ldu, work, lwork,
587 CALL sort01(
'Rows', n, n, vtsav, ldvt, work, lwork,
591 DO 50 i = 1, mnmin - 1
592 IF( ssav( i ).LT.ssav( i+1 ) )
593 $ result( 4 ) = ulpinv
594 IF( ssav( i ).LT.zero )
595 $ result( 4 ) = ulpinv
597 IF( mnmin.GE.1 )
THEN
598 IF( ssav( mnmin ).LT.zero )
599 $ result( 4 ) = ulpinv
609 IF( ( iju.EQ.3 .AND. ijvt.EQ.3 ) .OR.
610 $ ( iju.EQ.1 .AND. ijvt.EQ.1 ) )
GO TO 70
612 jobvt = cjob( ijvt+1 )
613 CALL slacpy(
'F', m, n, asav, lda, a, lda )
615 CALL sgesvd( jobu, jobvt, m, n, a, lda, s, u, ldu,
616 $ vt, ldvt, work, lswork, iinfo )
621 IF( m.GT.0 .AND. n.GT.0 )
THEN
623 CALL sort03(
'C', m, mnmin, m, mnmin, usav,
624 $ ldu, a, lda, work, lwork, dif,
626 ELSE IF( iju.EQ.2 )
THEN
627 CALL sort03(
'C', m, mnmin, m, mnmin, usav,
628 $ ldu, u, ldu, work, lwork, dif,
630 ELSE IF( iju.EQ.3 )
THEN
631 CALL sort03(
'C', m, m, m, mnmin, usav, ldu,
632 $ u, ldu, work, lwork, dif,
636 result( 5 ) = max( result( 5 ), dif )
641 IF( m.GT.0 .AND. n.GT.0 )
THEN
643 CALL sort03(
'R', n, mnmin, n, mnmin, vtsav,
644 $ ldvt, a, lda, work, lwork, dif,
646 ELSE IF( ijvt.EQ.2 )
THEN
647 CALL sort03(
'R', n, mnmin, n, mnmin, vtsav,
648 $ ldvt, vt, ldvt, work, lwork,
650 ELSE IF( ijvt.EQ.3 )
THEN
651 CALL sort03(
'R', n, n, n, mnmin, vtsav,
652 $ ldvt, vt, ldvt, work, lwork,
656 result( 6 ) = max( result( 6 ), dif )
661 div = max( mnmin*ulp*s( 1 ), unfl )
662 DO 60 i = 1, mnmin - 1
663 IF( ssav( i ).LT.ssav( i+1 ) )
665 IF( ssav( i ).LT.zero )
667 dif = max( dif, abs( ssav( i )-s( i ) ) / div )
669 result( 7 ) = max( result( 7 ), dif )
675 iwtmp = 5*mnmin*mnmin + 9*mnmin + max( m, n )
676 lswork = iwtmp + ( iws-1 )*( lwork-iwtmp ) / 3
677 lswork = min( lswork, lwork )
678 lswork = max( lswork, 1 )
682 CALL slacpy(
'F', m, n, asav, lda, a, lda )
684 CALL sgesdd(
'A', m, n, a, lda, ssav, usav, ldu, vtsav,
685 $ ldvt, work, lswork, iwork, iinfo )
686 IF( iinfo.NE.0 )
THEN
687 WRITE( nout, fmt = 9995 )
'GESDD', iinfo, m, n, jtype,
695 CALL sbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
696 $ vtsav, ldvt, work, result( 8 ) )
697 IF( m.NE.0 .AND. n.NE.0 )
THEN
698 CALL sort01(
'Columns', m, m, usav, ldu, work, lwork,
700 CALL sort01(
'Rows', n, n, vtsav, ldvt, work, lwork,
704 DO 90 i = 1, mnmin - 1
705 IF( ssav( i ).LT.ssav( i+1 ) )
706 $ result( 11 ) = ulpinv
707 IF( ssav( i ).LT.zero )
708 $ result( 11 ) = ulpinv
710 IF( mnmin.GE.1 )
THEN
711 IF( ssav( mnmin ).LT.zero )
712 $ result( 11 ) = ulpinv
722 CALL slacpy(
'F', m, n, asav, lda, a, lda )
724 CALL sgesdd( jobq, m, n, a, lda, s, u, ldu, vt, ldvt,
725 $ work, lswork, iwork, iinfo )
730 IF( m.GT.0 .AND. n.GT.0 )
THEN
733 CALL sort03(
'C', m, mnmin, m, mnmin, usav,
734 $ ldu, a, lda, work, lwork, dif,
737 CALL sort03(
'C', m, mnmin, m, mnmin, usav,
738 $ ldu, u, ldu, work, lwork, dif,
741 ELSE IF( ijq.EQ.2 )
THEN
742 CALL sort03(
'C', m, mnmin, m, mnmin, usav, ldu,
743 $ u, ldu, work, lwork, dif, info )
746 result( 12 ) = max( result( 12 ), dif )
751 IF( m.GT.0 .AND. n.GT.0 )
THEN
754 CALL sort03(
'R', n, mnmin, n, mnmin, vtsav,
755 $ ldvt, vt, ldvt, work, lwork,
758 CALL sort03(
'R', n, mnmin, n, mnmin, vtsav,
759 $ ldvt, a, lda, work, lwork, dif,
762 ELSE IF( ijq.EQ.2 )
THEN
763 CALL sort03(
'R', n, mnmin, n, mnmin, vtsav,
764 $ ldvt, vt, ldvt, work, lwork, dif,
768 result( 13 ) = max( result( 13 ), dif )
773 div = max( mnmin*ulp*s( 1 ), unfl )
774 DO 100 i = 1, mnmin - 1
775 IF( ssav( i ).LT.ssav( i+1 ) )
777 IF( ssav( i ).LT.zero )
779 dif = max( dif, abs( ssav( i )-s( i ) ) / div )
781 result( 14 ) = max( result( 14 ), dif )
793 iwtmp = 5*mnmin*mnmin + 9*mnmin + max( m, n )
794 lswork = iwtmp + ( iws-1 )*( lwork-iwtmp ) / 3
795 lswork = min( lswork, lwork )
796 lswork = max( lswork, 1 )
800 CALL slacpy(
'F', m, n, asav, lda, usav, lda )
802 CALL sgesvj(
'G',
'U',
'V', m, n, usav, lda, ssav,
803 & 0, a, ldvt, work, lwork, info )
814 IF( iinfo.NE.0 )
THEN
815 WRITE( nout, fmt = 9995 )
'GESVJ', iinfo, m, n,
816 $ jtype, lswork, ioldsd
823 CALL sbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
824 $ vtsav, ldvt, work, result( 15 ) )
825 IF( m.NE.0 .AND. n.NE.0 )
THEN
826 CALL sort01(
'Columns', m, m, usav, ldu, work,
827 $ lwork, result( 16 ) )
828 CALL sort01(
'Rows', n, n, vtsav, ldvt, work,
829 $ lwork, result( 17 ) )
832 DO 120 i = 1, mnmin - 1
833 IF( ssav( i ).LT.ssav( i+1 ) )
834 $ result( 18 ) = ulpinv
835 IF( ssav( i ).LT.zero )
836 $ result( 18 ) = ulpinv
838 IF( mnmin.GE.1 )
THEN
839 IF( ssav( mnmin ).LT.zero )
840 $ result( 18 ) = ulpinv
852 iwtmp = 5*mnmin*mnmin + 9*mnmin + max( m, n )
853 lswork = iwtmp + ( iws-1 )*( lwork-iwtmp ) / 3
854 lswork = min( lswork, lwork )
855 lswork = max( lswork, 1 )
859 CALL slacpy(
'F', m, n, asav, lda, vtsav, lda )
861 CALL sgejsv(
'G',
'U',
'V',
'R',
'N',
'N',
862 & m, n, vtsav, lda, ssav, usav, ldu, a, ldvt,
863 & work, lwork, iwork, info )
874 IF( iinfo.NE.0 )
THEN
875 WRITE( nout, fmt = 9995 )
'GESVJ', iinfo, m, n,
876 $ jtype, lswork, ioldsd
883 CALL sbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
884 $ vtsav, ldvt, work, result( 19 ) )
885 IF( m.NE.0 .AND. n.NE.0 )
THEN
886 CALL sort01(
'Columns', m, m, usav, ldu, work,
887 $ lwork, result( 20 ) )
888 CALL sort01(
'Rows', n, n, vtsav, ldvt, work,
889 $ lwork, result( 21 ) )
892 DO 150 i = 1, mnmin - 1
893 IF( ssav( i ).LT.ssav( i+1 ) )
894 $ result( 22 ) = ulpinv
895 IF( ssav( i ).LT.zero )
896 $ result( 22 ) = ulpinv
898 IF( mnmin.GE.1 )
THEN
899 IF( ssav( mnmin ).LT.zero )
900 $ result( 22 ) = ulpinv
906 CALL slacpy(
'F', m, n, asav, lda, a, lda )
907 CALL sgesvdx(
'V',
'V',
'A', m, n, a, lda,
908 $ vl, vu, il, iu, ns, ssav, usav, ldu,
909 $ vtsav, ldvt, work, lwork, iwork,
911 IF( iinfo.NE.0 )
THEN
912 WRITE( nout, fmt = 9995 )
'GESVDX', iinfo, m, n,
913 $ jtype, lswork, ioldsd
923 CALL sbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
924 $ vtsav, ldvt, work, result( 23 ) )
925 IF( m.NE.0 .AND. n.NE.0 )
THEN
926 CALL sort01(
'Columns', m, m, usav, ldu, work, lwork,
928 CALL sort01(
'Rows', n, n, vtsav, ldvt, work, lwork,
932 DO 160 i = 1, mnmin - 1
933 IF( ssav( i ).LT.ssav( i+1 ) )
934 $ result( 26 ) = ulpinv
935 IF( ssav( i ).LT.zero )
936 $ result( 26 ) = ulpinv
938 IF( mnmin.GE.1 )
THEN
939 IF( ssav( mnmin ).LT.zero )
940 $ result( 26 ) = ulpinv
950 IF( ( iju.EQ.0 .AND. ijvt.EQ.0 ) .OR.
951 $ ( iju.EQ.1 .AND. ijvt.EQ.1 ) )
GO TO 170
952 jobu = cjobv( iju+1 )
953 jobvt = cjobv( ijvt+1 )
955 CALL slacpy(
'F', m, n, asav, lda, a, lda )
956 CALL sgesvdx( jobu, jobvt, range, m, n, a, lda,
957 $ vl, vu, il, iu, ns, s, u, ldu,
958 $ vt, ldvt, work, lwork, iwork,
964 IF( m.GT.0 .AND. n.GT.0 )
THEN
966 CALL sort03(
'C', m, mnmin, m, mnmin, usav,
967 $ ldu, u, ldu, work, lwork, dif,
971 result( 27 ) = max( result( 27 ), dif )
976 IF( m.GT.0 .AND. n.GT.0 )
THEN
978 CALL sort03(
'R', n, mnmin, n, mnmin, vtsav,
979 $ ldvt, vt, ldvt, work, lwork,
983 result( 28 ) = max( result( 28 ), dif )
988 div = max( mnmin*ulp*s( 1 ), unfl )
989 DO 190 i = 1, mnmin - 1
990 IF( ssav( i ).LT.ssav( i+1 ) )
992 IF( ssav( i ).LT.zero )
994 dif = max( dif, abs( ssav( i )-s( i ) ) / div )
996 result( 29 ) = max( result( 29 ), dif )
1003 iseed2( i ) = iseed( i )
1005 IF( mnmin.LE.1 )
THEN
1007 iu = max( 1, mnmin )
1009 il = 1 + int( ( mnmin-1 )*
slarnd( 1, iseed2 ) )
1010 iu = 1 + int( ( mnmin-1 )*
slarnd( 1, iseed2 ) )
1017 CALL slacpy(
'F', m, n, asav, lda, a, lda )
1018 CALL sgesvdx(
'V',
'V',
'I', m, n, a, lda,
1019 $ vl, vu, il, iu, nsi, s, u, ldu,
1020 $ vt, ldvt, work, lwork, iwork,
1022 IF( iinfo.NE.0 )
THEN
1023 WRITE( nout, fmt = 9995 )
'GESVDX', iinfo, m, n,
1024 $ jtype, lswork, ioldsd
1032 CALL sbdt05( m, n, asav, lda, s, nsi, u, ldu,
1033 $ vt, ldvt, work, result( 30 ) )
1034 CALL sort01(
'Columns', m, nsi, u, ldu, work, lwork,
1036 CALL sort01(
'Rows', nsi, n, vt, ldvt, work, lwork,
1041 IF( mnmin.GT.0 .AND. nsi.GT.1 )
THEN
1044 $ max( half*abs( ssav( il )-ssav( il-1 ) ),
1045 $ ulp*anorm, two*rtunfl )
1048 $ max( half*abs( ssav( ns )-ssav( 1 ) ),
1049 $ ulp*anorm, two*rtunfl )
1052 vl = ssav( iu ) - max( ulp*anorm, two*rtunfl,
1053 $ half*abs( ssav( iu+1 )-ssav( iu ) ) )
1055 vl = ssav( ns ) - max( ulp*anorm, two*rtunfl,
1056 $ half*abs( ssav( ns )-ssav( 1 ) ) )
1060 IF( vl.GE.vu ) vu = max( vu*2, vu+vl+half )
1065 CALL slacpy(
'F', m, n, asav, lda, a, lda )
1066 CALL sgesvdx(
'V',
'V',
'V', m, n, a, lda,
1067 $ vl, vu, il, iu, nsv, s, u, ldu,
1068 $ vt, ldvt, work, lwork, iwork,
1070 IF( iinfo.NE.0 )
THEN
1071 WRITE( nout, fmt = 9995 )
'GESVDX', iinfo, m, n,
1072 $ jtype, lswork, ioldsd
1080 CALL sbdt05( m, n, asav, lda, s, nsv, u, ldu,
1081 $ vt, ldvt, work, result( 33 ) )
1082 CALL sort01(
'Columns', m, nsv, u, ldu, work, lwork,
1084 CALL sort01(
'Rows', nsv, n, vt, ldvt, work, lwork,
1090 IF( result( j ).GE.thresh )
THEN
1091 IF( nfail.EQ.0 )
THEN
1092 WRITE( nout, fmt = 9999 )
1093 WRITE( nout, fmt = 9998 )
1095 WRITE( nout, fmt = 9997 )m, n, jtype, iws, ioldsd,
1107 CALL alasvm( path, nout, nfail, ntest, 0 )
1109 9999
FORMAT(
' SVD -- Real Singular Value Decomposition Driver ',
1110 $ /
' Matrix types (see SDRVBD for details):',
1111 $ / /
' 1 = Zero matrix', /
' 2 = Identity matrix',
1112 $ /
' 3 = Evenly spaced singular values near 1',
1113 $ /
' 4 = Evenly spaced singular values near underflow',
1114 $ /
' 5 = Evenly spaced singular values near overflow', / /
1115 $
' Tests performed: ( A is dense, U and V are orthogonal,',
1116 $ / 19x,
' S is an array, and Upartial, VTpartial, and',
1117 $ / 19x,
' Spartial are partially computed U, VT and S),', / )
1118 9998
FORMAT(
' 1 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
1119 $ /
' 2 = | I - U**T U | / ( M ulp ) ',
1120 $ /
' 3 = | I - VT VT**T | / ( N ulp ) ',
1121 $ /
' 4 = 0 if S contains min(M,N) nonnegative values in',
1122 $
' decreasing order, else 1/ulp',
1123 $ /
' 5 = | U - Upartial | / ( M ulp )',
1124 $ /
' 6 = | VT - VTpartial | / ( N ulp )',
1125 $ /
' 7 = | S - Spartial | / ( min(M,N) ulp |S| )',
1126 $ /
' 8 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
1127 $ /
' 9 = | I - U**T U | / ( M ulp ) ',
1128 $ /
'10 = | I - VT VT**T | / ( N ulp ) ',
1129 $ /
'11 = 0 if S contains min(M,N) nonnegative values in',
1130 $
' decreasing order, else 1/ulp',
1131 $ /
'12 = | U - Upartial | / ( M ulp )',
1132 $ /
'13 = | VT - VTpartial | / ( N ulp )',
1133 $ /
'14 = | S - Spartial | / ( min(M,N) ulp |S| )',
1134 $ /
'15 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
1135 $ /
'16 = | I - U**T U | / ( M ulp ) ',
1136 $ /
'17 = | I - VT VT**T | / ( N ulp ) ',
1137 $ /
'18 = 0 if S contains min(M,N) nonnegative values in',
1138 $
' decreasing order, else 1/ulp',
1139 $ /
'19 = | U - Upartial | / ( M ulp )',
1140 $ /
'20 = | VT - VTpartial | / ( N ulp )',
1141 $ /
'21 = | S - Spartial | / ( min(M,N) ulp |S| )',
1142 $ /
'22 = 0 if S contains min(M,N) nonnegative values in',
1143 $
' decreasing order, else 1/ulp',
1144 $
' SGESVDX(V,V,A) ',
1145 $ /
'23 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ),'
1146 $ /
'24 = | I - U**T U | / ( M ulp ) ',
1147 $ /
'25 = | I - VT VT**T | / ( N ulp ) ',
1148 $ /
'26 = 0 if S contains min(M,N) nonnegative values in',
1149 $
' decreasing order, else 1/ulp',
1150 $ /
'27 = | U - Upartial | / ( M ulp )',
1151 $ /
'28 = | VT - VTpartial | / ( N ulp )',
1152 $ /
'29 = | S - Spartial | / ( min(M,N) ulp |S| )',
1153 $ /
'30 = | U**T A VT**T - diag(S) | / ( |A| max(M,N) ulp ),',
1154 $
' SGESVDX(V,V,I) ',
1155 $ /
'31 = | I - U**T U | / ( M ulp ) ',
1156 $ /
'32 = | I - VT VT**T | / ( N ulp ) ',
1157 $ /
'33 = | U**T A VT**T - diag(S) | / ( |A| max(M,N) ulp ),',
1158 $
' SGESVDX(V,V,V) ',
1159 $ /
'34 = | I - U**T U | / ( M ulp ) ',
1160 $ /
'35 = | I - VT VT**T | / ( N ulp ) ',
1162 9997
FORMAT(
' M=', i5,
', N=', i5,
', type ', i1,
', IWS=', i1,
1163 $
', seed=', 4( i4,
',' ),
' test(', i2,
')=', g11.4 )
1164 9996
FORMAT(
' SDRVBD: ', a,
' returned INFO=', i6,
'.', / 9x,
'M=',
1165 $ i6,
', N=', i6,
', JTYPE=', i6,
', ISEED=(', 3( i5,
',' ),
1167 9995
FORMAT(
' SDRVBD: ', a,
' returned INFO=', i6,
'.', / 9x,
'M=',
1168 $ i6,
', N=', i6,
', JTYPE=', i6,
', LSWORK=', i6, / 9x,
1169 $
'ISEED=(', 3( i5,
',' ), i5,
')' )
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
subroutine sgesvj(JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, LDV, WORK, LWORK, INFO)
SGESVJ
subroutine slabad(SMALL, LARGE)
SLABAD
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine sort01(ROWCOL, M, N, U, LDU, WORK, LWORK, RESID)
SORT01
subroutine slatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
SLATMS
subroutine sbdt01(M, N, KD, A, LDA, Q, LDQ, D, E, PT, LDPT, WORK, RESID)
SBDT01
subroutine sort03(RC, MU, MV, N, K, U, LDU, V, LDV, WORK, LWORK, RESULT, INFO)
SORT03
subroutine slaset(UPLO, M, N, ALPHA, BETA, A, LDA)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine sgejsv(JOBA, JOBU, JOBV, JOBR, JOBT, JOBP, M, N, A, LDA, SVA, U, LDU, V, LDV, WORK, LWORK, IWORK, INFO)
SGEJSV
subroutine sgesvdx(JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU, IL, IU, NS, S, U, LDU, VT, LDVT, WORK, LWORK, IWORK, INFO)
SGESVDX computes the singular value decomposition (SVD) for GE matrices
real function slarnd(IDIST, ISEED)
SLARND
subroutine sgesvd(JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, INFO)
SGESVD computes the singular value decomposition (SVD) for GE matrices
subroutine sgesdd(JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, IWORK, INFO)
SGESDD
real function slamch(CMACH)
SLAMCH
subroutine sbdt05(M, N, A, LDA, S, NS, U, LDU, VT, LDVT, WORK, RESID)