491 SUBROUTINE schkbd( NSIZES, MVAL, NVAL, NTYPES, DOTYPE, NRHS,
492 $ iseed, thresh, a, lda, bd, be, s1, s2, x, ldx,
493 $ y, z, q, ldq, pt, ldpt, u, vt, work, lwork,
494 $ iwork, nout, info )
502 INTEGER INFO, LDA, LDPT, LDQ, LDX, LWORK, NOUT, NRHS,
508 INTEGER ISEED( 4 ), IWORK( * ), MVAL( * ), NVAL( * )
509 REAL A( lda, * ), BD( * ), BE( * ), PT( ldpt, * ),
510 $ q( ldq, * ), s1( * ), s2( * ), u( ldpt, * ),
511 $ vt( ldpt, * ), work( * ), x( ldx, * ),
512 $ y( ldx, * ), z( ldx, * )
518 REAL ZERO, ONE, TWO, HALF
519 parameter ( zero = 0.0e0, one = 1.0e0, two = 2.0e0,
522 parameter ( maxtyp = 16 )
525 LOGICAL BADMM, BADNN, BIDIAG
528 INTEGER I, IINFO, IL, IMODE, ITEMP, ITYPE, IU, IWBD,
529 $ iwbe, iwbs, iwbz, iwwork, j, jcol, jsize,
530 $ jtype, log2ui, m, minwrk, mmax, mnmax, mnmin,
531 $ mnmin2, mq, mtypes, n, nfail, nmax,
533 REAL ABSTOL, AMNINV, ANORM, COND, OVFL, RTOVFL,
534 $ rtunfl, temp1, temp2, ulp, ulpinv, unfl,
538 INTEGER IDUM( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
539 $ kmagn( maxtyp ), kmode( maxtyp ),
541 REAL DUM( 1 ), DUMMA( 1 ), RESULT( 40 )
544 REAL SLAMCH, SLARND, SSXT1
545 EXTERNAL slamch, slarnd, ssxt1
554 INTRINSIC abs, exp, int, log, max, min, sqrt
562 COMMON / infoc / infot, nunit, ok, lerr
563 COMMON / srnamc / srnamt
566 DATA ktype / 1, 2, 5*4, 5*6, 3*9, 10 /
567 DATA kmagn / 2*1, 3*1, 2, 3, 3*1, 2, 3, 1, 2, 3, 0 /
568 DATA kmode / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
584 mmax = max( mmax, mval( j ) )
587 nmax = max( nmax, nval( j ) )
590 mnmax = max( mnmax, min( mval( j ), nval( j ) ) )
591 minwrk = max( minwrk, 3*( mval( j )+nval( j ) ),
592 $ mval( j )*( mval( j )+max( mval( j ), nval( j ),
593 $ nrhs )+1 )+nval( j )*min( nval( j ), mval( j ) ) )
598 IF( nsizes.LT.0 )
THEN
600 ELSE IF( badmm )
THEN
602 ELSE IF( badnn )
THEN
604 ELSE IF( ntypes.LT.0 )
THEN
606 ELSE IF( nrhs.LT.0 )
THEN
608 ELSE IF( lda.LT.mmax )
THEN
610 ELSE IF( ldx.LT.mmax )
THEN
612 ELSE IF( ldq.LT.mmax )
THEN
614 ELSE IF( ldpt.LT.mnmax )
THEN
616 ELSE IF( minwrk.GT.lwork )
THEN
621 CALL xerbla(
'SCHKBD', -info )
627 path( 1: 1 ) =
'Single precision'
631 unfl = slamch(
'Safe minimum' )
632 ovfl = slamch(
'Overflow' )
634 ulp = slamch(
'Precision' )
636 log2ui = int( log( ulpinv ) / log( two ) )
637 rtunfl = sqrt( unfl )
638 rtovfl = sqrt( ovfl )
644 DO 300 jsize = 1, nsizes
648 amninv = one / max( m, n, 1 )
650 IF( nsizes.NE.1 )
THEN
651 mtypes = min( maxtyp, ntypes )
653 mtypes = min( maxtyp+1, ntypes )
656 DO 290 jtype = 1, mtypes
657 IF( .NOT.dotype( jtype ) )
661 ioldsd( j ) = iseed( j )
686 IF( mtypes.GT.maxtyp )
689 itype = ktype( jtype )
690 imode = kmode( jtype )
694 GO TO ( 40, 50, 60 )kmagn( jtype )
701 anorm = ( rtovfl*ulp )*amninv
705 anorm = rtunfl*max( m, n )*ulpinv
710 CALL slaset(
'Full', lda, n, zero, zero, a, lda )
715 IF( itype.EQ.1 )
THEN
721 ELSE IF( itype.EQ.2 )
THEN
725 DO 80 jcol = 1, mnmin
726 a( jcol, jcol ) = anorm
729 ELSE IF( itype.EQ.4 )
THEN
733 CALL slatms( mnmin, mnmin,
'S', iseed,
'N', work, imode,
734 $ cond, anorm, 0, 0,
'N', a, lda,
735 $ work( mnmin+1 ), iinfo )
737 ELSE IF( itype.EQ.5 )
THEN
741 CALL slatms( mnmin, mnmin,
'S', iseed,
'S', work, imode,
742 $ cond, anorm, m, n,
'N', a, lda,
743 $ work( mnmin+1 ), iinfo )
745 ELSE IF( itype.EQ.6 )
THEN
749 CALL slatms( m, n,
'S', iseed,
'N', work, imode, cond,
750 $ anorm, m, n,
'N', a, lda, work( mnmin+1 ),
753 ELSE IF( itype.EQ.7 )
THEN
757 CALL slatmr( mnmin, mnmin,
'S', iseed,
'N', work, 6, one,
758 $ one,
'T',
'N', work( mnmin+1 ), 1, one,
759 $ work( 2*mnmin+1 ), 1, one,
'N', iwork, 0, 0,
760 $ zero, anorm,
'NO', a, lda, iwork, iinfo )
762 ELSE IF( itype.EQ.8 )
THEN
766 CALL slatmr( mnmin, mnmin,
'S', iseed,
'S', work, 6, one,
767 $ one,
'T',
'N', work( mnmin+1 ), 1, one,
768 $ work( m+mnmin+1 ), 1, one,
'N', iwork, m, n,
769 $ zero, anorm,
'NO', a, lda, iwork, iinfo )
771 ELSE IF( itype.EQ.9 )
THEN
775 CALL slatmr( m, n,
'S', iseed,
'N', work, 6, one, one,
776 $
'T',
'N', work( mnmin+1 ), 1, one,
777 $ work( m+mnmin+1 ), 1, one,
'N', iwork, m, n,
778 $ zero, anorm,
'NO', a, lda, iwork, iinfo )
780 ELSE IF( itype.EQ.10 )
THEN
784 temp1 = -two*log( ulp )
786 bd( j ) = exp( temp1*slarnd( 2, iseed ) )
788 $ be( j ) = exp( temp1*slarnd( 2, iseed ) )
802 IF( iinfo.EQ.0 )
THEN
807 CALL slatmr( mnmin, nrhs,
'S', iseed,
'N', work, 6,
808 $ one, one,
'T',
'N', work( mnmin+1 ), 1,
809 $ one, work( 2*mnmin+1 ), 1, one,
'N',
810 $ iwork, mnmin, nrhs, zero, one,
'NO', y,
811 $ ldx, iwork, iinfo )
813 CALL slatmr( m, nrhs,
'S', iseed,
'N', work, 6, one,
814 $ one,
'T',
'N', work( m+1 ), 1, one,
815 $ work( 2*m+1 ), 1, one,
'N', iwork, m,
816 $ nrhs, zero, one,
'NO', x, ldx, iwork,
823 IF( iinfo.NE.0 )
THEN
824 WRITE( nout, fmt = 9998 )
'Generator', iinfo, m, n,
834 IF( .NOT.bidiag )
THEN
839 CALL slacpy(
' ', m, n, a, lda, q, ldq )
840 CALL sgebrd( m, n, q, ldq, bd, be, work, work( mnmin+1 ),
841 $ work( 2*mnmin+1 ), lwork-2*mnmin, iinfo )
845 IF( iinfo.NE.0 )
THEN
846 WRITE( nout, fmt = 9998 )
'SGEBRD', iinfo, m, n,
852 CALL slacpy(
' ', m, n, q, ldq, pt, ldpt )
864 CALL sorgbr(
'Q', m, mq, n, q, ldq, work,
865 $ work( 2*mnmin+1 ), lwork-2*mnmin, iinfo )
869 IF( iinfo.NE.0 )
THEN
870 WRITE( nout, fmt = 9998 )
'SORGBR(Q)', iinfo, m, n,
878 CALL sorgbr(
'P', mnmin, n, m, pt, ldpt, work( mnmin+1 ),
879 $ work( 2*mnmin+1 ), lwork-2*mnmin, iinfo )
883 IF( iinfo.NE.0 )
THEN
884 WRITE( nout, fmt = 9998 )
'SORGBR(P)', iinfo, m, n,
892 CALL sgemm(
'Transpose',
'No transpose', m, nrhs, m, one,
893 $ q, ldq, x, ldx, zero, y, ldx )
899 CALL sbdt01( m, n, 1, a, lda, q, ldq, bd, be, pt, ldpt,
900 $ work, result( 1 ) )
901 CALL sort01(
'Columns', m, mq, q, ldq, work, lwork,
903 CALL sort01(
'Rows', mnmin, n, pt, ldpt, work, lwork,
910 CALL scopy( mnmin, bd, 1, s1, 1 )
912 $
CALL scopy( mnmin-1, be, 1, work, 1 )
913 CALL slacpy(
' ', m, nrhs, y, ldx, z, ldx )
914 CALL slaset(
'Full', mnmin, mnmin, zero, one, u, ldpt )
915 CALL slaset(
'Full', mnmin, mnmin, zero, one, vt, ldpt )
917 CALL sbdsqr( uplo, mnmin, mnmin, mnmin, nrhs, s1, work, vt,
918 $ ldpt, u, ldpt, z, ldx, work( mnmin+1 ), iinfo )
922 IF( iinfo.NE.0 )
THEN
923 WRITE( nout, fmt = 9998 )
'SBDSQR(vects)', iinfo, m, n,
926 IF( iinfo.LT.0 )
THEN
937 CALL scopy( mnmin, bd, 1, s2, 1 )
939 $
CALL scopy( mnmin-1, be, 1, work, 1 )
941 CALL sbdsqr( uplo, mnmin, 0, 0, 0, s2, work, vt, ldpt, u,
942 $ ldpt, z, ldx, work( mnmin+1 ), iinfo )
946 IF( iinfo.NE.0 )
THEN
947 WRITE( nout, fmt = 9998 )
'SBDSQR(values)', iinfo, m, n,
950 IF( iinfo.LT.0 )
THEN
963 CALL sbdt03( uplo, mnmin, 1, bd, be, u, ldpt, s1, vt, ldpt,
964 $ work, result( 4 ) )
965 CALL sbdt02( mnmin, nrhs, y, ldx, z, ldx, u, ldpt, work,
967 CALL sort01(
'Columns', mnmin, mnmin, u, ldpt, work, lwork,
969 CALL sort01(
'Rows', mnmin, mnmin, vt, ldpt, work, lwork,
976 DO 110 i = 1, mnmin - 1
977 IF( s1( i ).LT.s1( i+1 ) )
978 $ result( 8 ) = ulpinv
979 IF( s1( i ).LT.zero )
980 $ result( 8 ) = ulpinv
982 IF( mnmin.GE.1 )
THEN
983 IF( s1( mnmin ).LT.zero )
984 $ result( 8 ) = ulpinv
992 temp1 = abs( s1( j )-s2( j ) ) /
993 $ max( sqrt( unfl )*max( s1( 1 ), one ),
994 $ ulp*max( abs( s1( j ) ), abs( s2( j ) ) ) )
995 temp2 = max( temp1, temp2 )
1003 temp1 = thresh*( half-ulp )
1005 DO 130 j = 0, log2ui
1013 result( 10 ) = temp1
1018 IF( .NOT.bidiag )
THEN
1019 CALL scopy( mnmin, bd, 1, s2, 1 )
1021 $
CALL scopy( mnmin-1, be, 1, work, 1 )
1023 CALL sbdsqr( uplo, mnmin, n, m, nrhs, s2, work, pt, ldpt,
1024 $ q, ldq, y, ldx, work( mnmin+1 ), iinfo )
1031 CALL sbdt01( m, n, 0, a, lda, q, ldq, s2, dumma, pt,
1032 $ ldpt, work, result( 11 ) )
1033 CALL sbdt02( m, nrhs, x, ldx, y, ldx, q, ldq, work,
1035 CALL sort01(
'Columns', m, mq, q, ldq, work, lwork,
1037 CALL sort01(
'Rows', mnmin, n, pt, ldpt, work, lwork,
1044 CALL scopy( mnmin, bd, 1, s1, 1 )
1046 $
CALL scopy( mnmin-1, be, 1, work, 1 )
1047 CALL slaset(
'Full', mnmin, mnmin, zero, one, u, ldpt )
1048 CALL slaset(
'Full', mnmin, mnmin, zero, one, vt, ldpt )
1050 CALL sbdsdc( uplo,
'I', mnmin, s1, work, u, ldpt, vt, ldpt,
1051 $ dum, idum, work( mnmin+1 ), iwork, iinfo )
1055 IF( iinfo.NE.0 )
THEN
1056 WRITE( nout, fmt = 9998 )
'SBDSDC(vects)', iinfo, m, n,
1059 IF( iinfo.LT.0 )
THEN
1062 result( 15 ) = ulpinv
1070 CALL scopy( mnmin, bd, 1, s2, 1 )
1072 $
CALL scopy( mnmin-1, be, 1, work, 1 )
1074 CALL sbdsdc( uplo,
'N', mnmin, s2, work, dum, 1, dum, 1,
1075 $ dum, idum, work( mnmin+1 ), iwork, iinfo )
1079 IF( iinfo.NE.0 )
THEN
1080 WRITE( nout, fmt = 9998 )
'SBDSDC(values)', iinfo, m, n,
1083 IF( iinfo.LT.0 )
THEN
1086 result( 18 ) = ulpinv
1095 CALL sbdt03( uplo, mnmin, 1, bd, be, u, ldpt, s1, vt, ldpt,
1096 $ work, result( 15 ) )
1097 CALL sort01(
'Columns', mnmin, mnmin, u, ldpt, work, lwork,
1099 CALL sort01(
'Rows', mnmin, mnmin, vt, ldpt, work, lwork,
1106 DO 150 i = 1, mnmin - 1
1107 IF( s1( i ).LT.s1( i+1 ) )
1108 $ result( 18 ) = ulpinv
1109 IF( s1( i ).LT.zero )
1110 $ result( 18 ) = ulpinv
1112 IF( mnmin.GE.1 )
THEN
1113 IF( s1( mnmin ).LT.zero )
1114 $ result( 18 ) = ulpinv
1122 temp1 = abs( s1( j )-s2( j ) ) /
1123 $ max( sqrt( unfl )*max( s1( 1 ), one ),
1124 $ ulp*max( abs( s1( 1 ) ), abs( s2( 1 ) ) ) )
1125 temp2 = max( temp1, temp2 )
1128 result( 19 ) = temp2
1134 IF( jtype.EQ.10 .OR. jtype.EQ.16 )
THEN
1138 result( 20:34 ) = zero
1146 iwwork = iwbz + 2*mnmin*(mnmin+1)
1147 mnmin2 = max( 1,mnmin*2 )
1149 CALL scopy( mnmin, bd, 1, work( iwbd ), 1 )
1151 $
CALL scopy( mnmin-1, be, 1, work( iwbe ), 1 )
1153 CALL sbdsvdx( uplo,
'V',
'A', mnmin, work( iwbd ),
1154 $ work( iwbe ), zero, zero, 0, 0, ns1, s1,
1155 $ work( iwbz ), mnmin2, work( iwwork ),
1160 IF( iinfo.NE.0 )
THEN
1161 WRITE( nout, fmt = 9998 )
'SBDSVDX(vects,A)', iinfo, m, n,
1164 IF( iinfo.LT.0 )
THEN
1167 result( 20 ) = ulpinv
1174 CALL scopy( mnmin, work( j ), 1, u( 1,i ), 1 )
1176 CALL scopy( mnmin, work( j ), 1, vt( i,1 ), ldpt )
1183 IF( jtype.EQ.9 )
THEN
1191 CALL scopy( mnmin, bd, 1, work( iwbd ), 1 )
1193 $
CALL scopy( mnmin-1, be, 1, work( iwbe ), 1 )
1195 CALL sbdsvdx( uplo,
'N',
'A', mnmin, work( iwbd ),
1196 $ work( iwbe ), zero, zero, 0, 0, ns2, s2,
1197 $ work( iwbz ), mnmin2, work( iwwork ),
1202 IF( iinfo.NE.0 )
THEN
1203 WRITE( nout, fmt = 9998 )
'SBDSVDX(values,A)', iinfo,
1204 $ m, n, jtype, ioldsd
1206 IF( iinfo.LT.0 )
THEN
1209 result( 24 ) = ulpinv
1216 CALL scopy( mnmin, s1, 1, work( iwbs ), 1 )
1225 CALL sbdt03( uplo, mnmin, 1, bd, be, u, ldpt, s1, vt,
1226 $ ldpt, work( iwbs+mnmin ), result( 20 ) )
1227 CALL sort01(
'Columns', mnmin, mnmin, u, ldpt,
1228 $ work( iwbs+mnmin ), lwork-mnmin,
1230 CALL sort01(
'Rows', mnmin, mnmin, vt, ldpt,
1231 $ work( iwbs+mnmin ), lwork-mnmin,
1235 DO 180 i = 1, mnmin - 1
1236 IF( s1( i ).LT.s1( i+1 ) )
1237 $ result( 23 ) = ulpinv
1238 IF( s1( i ).LT.zero )
1239 $ result( 23 ) = ulpinv
1241 IF( mnmin.GE.1 )
THEN
1242 IF( s1( mnmin ).LT.zero )
1243 $ result( 23 ) = ulpinv
1248 temp1 = abs( s1( j )-s2( j ) ) /
1249 $ max( sqrt( unfl )*max( s1( 1 ), one ),
1250 $ ulp*max( abs( s1( 1 ) ), abs( s2( 1 ) ) ) )
1251 temp2 = max( temp1, temp2 )
1253 result( 24 ) = temp2
1261 iseed2( i ) = iseed( i )
1263 IF( mnmin.LE.1 )
THEN
1267 il = 1 + int( ( mnmin-1 )*slarnd( 1, iseed2 ) )
1268 iu = 1 + int( ( mnmin-1 )*slarnd( 1, iseed2 ) )
1276 CALL scopy( mnmin, bd, 1, work( iwbd ), 1 )
1278 $
CALL scopy( mnmin-1, be, 1, work( iwbe ), 1 )
1280 CALL sbdsvdx( uplo,
'V',
'I', mnmin, work( iwbd ),
1281 $ work( iwbe ), zero, zero, il, iu, ns1, s1,
1282 $ work( iwbz ), mnmin2, work( iwwork ),
1287 IF( iinfo.NE.0 )
THEN
1288 WRITE( nout, fmt = 9998 )
'SBDSVDX(vects,I)', iinfo,
1289 $ m, n, jtype, ioldsd
1291 IF( iinfo.LT.0 )
THEN
1294 result( 25 ) = ulpinv
1301 CALL scopy( mnmin, work( j ), 1, u( 1,i ), 1 )
1303 CALL scopy( mnmin, work( j ), 1, vt( i,1 ), ldpt )
1310 CALL scopy( mnmin, bd, 1, work( iwbd ), 1 )
1312 $
CALL scopy( mnmin-1, be, 1, work( iwbe ), 1 )
1314 CALL sbdsvdx( uplo,
'N',
'I', mnmin, work( iwbd ),
1315 $ work( iwbe ), zero, zero, il, iu, ns2, s2,
1316 $ work( iwbz ), mnmin2, work( iwwork ),
1321 IF( iinfo.NE.0 )
THEN
1322 WRITE( nout, fmt = 9998 )
'SBDSVDX(values,I)', iinfo,
1323 $ m, n, jtype, ioldsd
1325 IF( iinfo.LT.0 )
THEN
1328 result( 29 ) = ulpinv
1340 CALL sbdt04( uplo, mnmin, bd, be, s1, ns1, u,
1341 $ ldpt, vt, ldpt, work( iwbs+mnmin ),
1343 CALL sort01(
'Columns', mnmin, ns1, u, ldpt,
1344 $ work( iwbs+mnmin ), lwork-mnmin,
1346 CALL sort01(
'Rows', ns1, mnmin, vt, ldpt,
1347 $ work( iwbs+mnmin ), lwork-mnmin,
1351 DO 220 i = 1, ns1 - 1
1352 IF( s1( i ).LT.s1( i+1 ) )
1353 $ result( 28 ) = ulpinv
1354 IF( s1( i ).LT.zero )
1355 $ result( 28 ) = ulpinv
1358 IF( s1( ns1 ).LT.zero )
1359 $ result( 28 ) = ulpinv
1364 temp1 = abs( s1( j )-s2( j ) ) /
1365 $ max( sqrt( unfl )*max( s1( 1 ), one ),
1366 $ ulp*max( abs( s1( 1 ) ), abs( s2( 1 ) ) ) )
1367 temp2 = max( temp1, temp2 )
1369 result( 29 ) = temp2
1375 CALL scopy( mnmin, work( iwbs ), 1, s1, 1 )
1377 IF( mnmin.GT.0 )
THEN
1379 vu = s1( il ) + max( half*abs( s1( il )-s1( il-1 ) ),
1380 $ ulp*anorm, two*rtunfl )
1382 vu = s1( 1 ) + max( half*abs( s1( mnmin )-s1( 1 ) ),
1383 $ ulp*anorm, two*rtunfl )
1385 IF( iu.NE.ns1 )
THEN
1386 vl = s1( iu ) - max( ulp*anorm, two*rtunfl,
1387 $ half*abs( s1( iu+1 )-s1( iu ) ) )
1389 vl = s1( ns1 ) - max( ulp*anorm, two*rtunfl,
1390 $ half*abs( s1( mnmin )-s1( 1 ) ) )
1394 IF( vl.GE.vu ) vu = max( vu*2, vu+vl+half )
1400 CALL scopy( mnmin, bd, 1, work( iwbd ), 1 )
1402 $
CALL scopy( mnmin-1, be, 1, work( iwbe ), 1 )
1404 CALL sbdsvdx( uplo,
'V',
'V', mnmin, work( iwbd ),
1405 $ work( iwbe ), vl, vu, 0, 0, ns1, s1,
1406 $ work( iwbz ), mnmin2, work( iwwork ),
1411 IF( iinfo.NE.0 )
THEN
1412 WRITE( nout, fmt = 9998 )
'SBDSVDX(vects,V)', iinfo,
1413 $ m, n, jtype, ioldsd
1415 IF( iinfo.LT.0 )
THEN
1418 result( 30 ) = ulpinv
1425 CALL scopy( mnmin, work( j ), 1, u( 1,i ), 1 )
1427 CALL scopy( mnmin, work( j ), 1, vt( i,1 ), ldpt )
1434 CALL scopy( mnmin, bd, 1, work( iwbd ), 1 )
1436 $
CALL scopy( mnmin-1, be, 1, work( iwbe ), 1 )
1438 CALL sbdsvdx( uplo,
'N',
'V', mnmin, work( iwbd ),
1439 $ work( iwbe ), vl, vu, 0, 0, ns2, s2,
1440 $ work( iwbz ), mnmin2, work( iwwork ),
1445 IF( iinfo.NE.0 )
THEN
1446 WRITE( nout, fmt = 9998 )
'SBDSVDX(values,V)', iinfo,
1447 $ m, n, jtype, ioldsd
1449 IF( iinfo.LT.0 )
THEN
1452 result( 34 ) = ulpinv
1464 CALL sbdt04( uplo, mnmin, bd, be, s1, ns1, u,
1465 $ ldpt, vt, ldpt, work( iwbs+mnmin ),
1467 CALL sort01(
'Columns', mnmin, ns1, u, ldpt,
1468 $ work( iwbs+mnmin ), lwork-mnmin,
1470 CALL sort01(
'Rows', ns1, mnmin, vt, ldpt,
1471 $ work( iwbs+mnmin ), lwork-mnmin,
1475 DO 250 i = 1, ns1 - 1
1476 IF( s1( i ).LT.s1( i+1 ) )
1477 $ result( 28 ) = ulpinv
1478 IF( s1( i ).LT.zero )
1479 $ result( 28 ) = ulpinv
1482 IF( s1( ns1 ).LT.zero )
1483 $ result( 28 ) = ulpinv
1488 temp1 = abs( s1( j )-s2( j ) ) /
1489 $ max( sqrt( unfl )*max( s1( 1 ), one ),
1490 $ ulp*max( abs( s1( 1 ) ), abs( s2( 1 ) ) ) )
1491 temp2 = max( temp1, temp2 )
1493 result( 34 ) = temp2
1500 IF( result( j ).GE.thresh )
THEN
1502 $
CALL slahd2( nout, path )
1503 WRITE( nout, fmt = 9999 )m, n, jtype, ioldsd, j,
1508 IF( .NOT.bidiag )
THEN
1519 CALL alasum( path, nout, nfail, ntest, 0 )
1525 9999
FORMAT(
' M=', i5,
', N=', i5,
', type ', i2,
', seed=',
1526 $ 4( i4,
',' ),
' test(', i2,
')=', g11.4 )
1527 9998
FORMAT(
' SCHKBD: ', a,
' returned INFO=', i6,
'.', / 9x,
'M=',
1528 $ i6,
', N=', i6,
', JTYPE=', i6,
', ISEED=(', 3( i5,
',' ),
subroutine sbdsvdx(UPLO, JOBZ, RANGE, N, D, E, VL, VU, IL, IU, NS, S, Z, LDZ, WORK, IWORK, INFO)
SBDSVDX
subroutine sbdsdc(UPLO, COMPQ, N, D, E, U, LDU, VT, LDVT, Q, IQ, WORK, IWORK, INFO)
SBDSDC
subroutine slatmr(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)
SLATMR
subroutine sbdt04(UPLO, N, D, E, S, NS, U, LDU, VT, LDVT, WORK, RESID)
SBDT04
subroutine sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM
subroutine slahd2(IOUNIT, PATH)
SLAHD2
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 sbdsqr(UPLO, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C, LDC, WORK, INFO)
SBDSQR
subroutine xerbla(SRNAME, INFO)
XERBLA
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 slabad(SMALL, LARGE)
SLABAD
subroutine schkbd(NSIZES, MVAL, NVAL, NTYPES, DOTYPE, NRHS, ISEED, THRESH, A, LDA, BD, BE, S1, S2, X, LDX, Y, Z, Q, LDQ, PT, LDPT, U, VT, WORK, LWORK, IWORK, NOUT, INFO)
SCHKBD
subroutine sgebrd(M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK, INFO)
SGEBRD
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine sbdt03(UPLO, N, KD, D, E, U, LDU, S, VT, LDVT, WORK, RESID)
SBDT03
subroutine sorgbr(VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO)
SORGBR
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine sbdt02(M, N, B, LDB, C, LDC, U, LDU, WORK, RESID)
SBDT02
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM