1053 parameter( nmax = 132 )
1055 parameter( ncmax = 20 )
1057 parameter( need = 14 )
1059 parameter( lwork = nmax*( 5*nmax+5 )+1 )
1061 parameter( liwork = nmax*( 5*nmax+20 ) )
1063 parameter( maxin = 20 )
1065 parameter( maxt = 30 )
1067 parameter( nin = 5, nout = 6 )
1070 LOGICAL csd,
fatal, glm, , gsv,
lse, nep, sbb, sbk,
1071 $ sbl, sep, ses, sev, , sgk, sgl, sgs, sgv,
1072 $ sgx, ssb, ssx, svd, svx, sxv, tstchk, tstdif,
1075 CHARACTER*3 c3, path
1079 INTEGER i, i1, ic, info, itmp, k, lenp, maxtyp, newsd,
1080 $ nk, , nparms, nrhs, ntypes,
1081 $ , vers_minor, vers_patch
1082 INTEGER*4 n_threads, one_thread
1083 REAL eps, s1, s2, thresh, thrshn
1086 LOGICAL dotype( maxt ), logwrk( nmax )
1087 INTEGER ioldsd( 4 ), iseed( 4 ), iwork( liwork ),
1088 $ kval( maxin ), mval( maxin ), mxbval( maxin ),
1089 $ nbcol( maxin ), nbmin( maxin ), nbval( maxin ),
1090 $ nsval( maxin ), nval( maxin ), nxval( maxin ),
1092 INTEGER inmin( maxin ), inwin( maxin ), inibl( maxin ),
1093 $ ishfts( maxin ), iacc22( maxin )
1094 REAL d( nmax, 12 ), result( 500 ), taua( nmax ),
1095 $ taub( nmax ), x( 5* )
1098 INTEGER allocatestatus
1099 REAL,
DIMENSION(:),
ALLOCATABLE :: work
1100 REAL,
DIMENSION(:,:),
ALLOCATABLE :: a, b, c
1123 INTEGER infot, maxb, nproc, nshift, nunit, seldim,
1127 LOGICAL selval( 20 )
1128 INTEGER iparms( 100 )
1129 REAL selwi( 20 ), ( 20 )
1132 COMMON / cenvir / nproc, nshift, maxb
1133 COMMON / claenv / iparms
1134 COMMON / infoc / infot, nunit, ok, lerr
1135 COMMON / srnamc / srnamt
1136 COMMON / sslct / selopt, seldim, selval, selwr, selwi
1139 DATA intstr /
'0123456789' /
1140 DATA ioldsd / 0, 0, 0, 1 /
1144 ALLOCATE ( a(nmax*nmax,need), stat = allocatestatus )
1145 IF (allocatestatus /= 0) stop
"*** Not enough memory ***"
1146 ALLOCATE ( b(nmax*nmax,5), stat = allocatestatus )
1147 IF (allocatestatus /= 0) stop
"*** Not enough memory ***"
1148 ALLOCATE ( c(ncmax*ncmax,ncmax*ncmax), stat = allocatestatus )
1149 IF (allocatestatus /= 0) stop
"*** Not enough memory ***"
1150 ALLOCATE ( work(lwork), stat = allocatestatus )
1151 IF (allocatestatus /= 0) stop
"*** Not enough memory ***"
1169 READ( nin, fmt =
'(A80)',
END = 380 )line
1171 nep =
lsamen( 3, path,
'NEP' ) .OR.
lsamen( 3, path,
'SHS' )
1172 sep =
lsamen( 3, path,
'SEP' ) .OR.
lsamen( 3, path,
'SST' ) .OR.
1173 $
lsamen( 3, path,
'SSG' ) .OR.
lsamen( 3, path,
'SE2' )
1174 svd =
lsamen( 3, path,
'SVD' ) .OR.
lsamen( 3, path,
'DBD' )
1175 svd =
lsamen( 3, path,
'SVD' ) .OR.
lsamen( 3, path,
'SBD' )
1176 sev =
lsamen( 3, path,
'SEV' )
1177 ses =
lsamen( 3, path,
'SES' )
1178 svx =
lsamen( 3, path,
'SVX' )
1179 ssx =
lsamen( 3, path,
'SSX' )
1180 sgg =
lsamen( 3, path, 'sgg
' )
1181 SGS = LSAMEN( 3, PATH, 'sgs
' )
1182 SGX = LSAMEN( 3, PATH, 'sgx
' )
1183 SGV = LSAMEN( 3, PATH, 'sgv
' )
1184 SXV = LSAMEN( 3, PATH, 'sxv
' )
1185 SSB = LSAMEN( 3, PATH, 'ssb
' )
1186 SBB = LSAMEN( 3, PATH, 'sbb' )
1187 glm =
lsamen( 3, path,
'GLM' )
1188 gqr =
lsamen( 3, path,
'GQR' ) .OR.
lsamen( 3, path,
'GRQ' )
1189 gsv =
lsamen( 3, path,
'GSV' )
1190 csd =
lsamen( 3, path,
'CSD' )
1192 sbl =
lsamen( 3, path, 'sbl
' )
1193 SBK = LSAMEN( 3, PATH, 'sbk
' )
1194 SGL = LSAMEN( 3, PATH, 'sgl
' )
1195 SGK = LSAMEN( 3, PATH, 'sgk
' )
1199.EQ.
IF( PATH' ' ) THEN
1202 WRITE( NOUT, FMT = 9987 )
1204 WRITE( NOUT, FMT = 9986 )
1206 WRITE( NOUT, FMT = 9985 )
1208 WRITE( NOUT, FMT = 9979 )
1210 WRITE( NOUT, FMT = 9978 )
1212 WRITE( NOUT, FMT = 9977 )
1214 WRITE( NOUT, FMT = 9976 )
1216 WRITE( NOUT, FMT = 9975 )
1218 WRITE( NOUT, FMT = 9964 )
1220 WRITE( NOUT, FMT = 9965 )
1222 WRITE( NOUT, FMT = 9963 )
1224 WRITE( NOUT, FMT = 9962 )
1226 WRITE( NOUT, FMT = 9974 )
1228 WRITE( NOUT, FMT = 9967 )
1230 WRITE( NOUT, FMT = 9971 )
1232 WRITE( NOUT, FMT = 9970 )
1234 WRITE( NOUT, FMT = 9969 )
1236 WRITE( NOUT, FMT = 9960 )
1238 WRITE( NOUT, FMT = 9968 )
1243 CALL SCHKBL( NIN, NOUT )
1249 CALL SCHKBK( NIN, NOUT )
1255 CALL SCHKGL( NIN, NOUT )
1261 CALL SCHKGK( NIN, NOUT )
1263 ELSE IF( LSAMEN( 3, PATH, 'sec
' ) ) THEN
1267 READ( NIN, FMT = * )THRESH
1269 CALL XLAENV( 12, 11 )
1270 CALL XLAENV( 13, 2 )
1271 CALL XLAENV( 14, 0 )
1272 CALL XLAENV( 15, 2 )
1273 CALL XLAENV( 16, 2 )
1275 CALL SCHKEC( THRESH, TSTERR, NIN, NOUT )
1278 WRITE( NOUT, FMT = 9992 )PATH
1281 CALL ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH )
1282 WRITE( NOUT, FMT = 9972 ) VERS_MAJOR, VERS_MINOR, VERS_PATCH
1283 WRITE( NOUT, FMT = 9984 )
1287 READ( NIN, FMT = * )NN
1289 WRITE( NOUT, FMT = 9989 )' nn
', NN, 1
1292.GT.
ELSE IF( NNMAXIN ) THEN
1293 WRITE( NOUT, FMT = 9988 )' nn
', NN, MAXIN
1300.NOT..OR.
IF( ( SGX SXV ) ) THEN
1301 READ( NIN, FMT = * )( MVAL( I ), I = 1, NN )
1308.LT.
IF( MVAL( I )0 ) THEN
1309 WRITE( NOUT, FMT = 9989 )VNAME, MVAL( I ), 0
1311.GT.
ELSE IF( MVAL( I )NMAX ) THEN
1312 WRITE( NOUT, FMT = 9988 )VNAME, MVAL( I ), NMAX
1316 WRITE( NOUT, FMT = 9983 )'m:
', ( MVAL( I ), I = 1, NN )
1321.OR..OR..OR..OR.
IF( GLM GQR GSV CSD LSE ) THEN
1322 READ( NIN, FMT = * )( PVAL( I ), I = 1, NN )
1324.LT.
IF( PVAL( I )0 ) THEN
1325 WRITE( NOUT, FMT = 9989 )' p
', PVAL( I ), 0
1327.GT.
ELSE IF( PVAL( I )NMAX ) THEN
1328 WRITE( NOUT, FMT = 9988 )' p
', PVAL( I ), NMAX
1332 WRITE( NOUT, FMT = 9983 )'p:
', ( PVAL( I ), I = 1, NN )
1337.OR..OR..OR..OR..OR..OR.
IF( SVD SBB GLM GQR GSV CSD
1339 READ( NIN, FMT = * )( NVAL( I ), I = 1, NN )
1341.LT.
IF( NVAL( I )0 ) THEN
1342 WRITE( NOUT, FMT = 9989 )' n
', NVAL( I ), 0
1344.GT.
ELSE IF( NVAL( I )NMAX ) THEN
1345 WRITE( NOUT, FMT = 9988 )' n
', NVAL( I ), NMAX
1351 NVAL( I ) = MVAL( I )
1354.NOT..OR.
IF( ( SGX SXV ) ) THEN
1355 WRITE( NOUT, FMT = 9983 )'n:
', ( NVAL( I ), I = 1, NN )
1357 WRITE( NOUT, FMT = 9983 )'n:
', NN
1362.OR.
IF( SSB SBB ) THEN
1363 READ( NIN, FMT = * )NK
1364 READ( NIN, FMT = * )( KVAL( I ), I = 1, NK )
1366.LT.
IF( KVAL( I )0 ) THEN
1367 WRITE( NOUT, FMT = 9989 )' k
', KVAL( I ), 0
1369.GT.
ELSE IF( KVAL( I )NMAX ) THEN
1370 WRITE( NOUT, FMT = 9988 )' k
', KVAL( I ), NMAX
1374 WRITE( NOUT, FMT = 9983 )'k:
', ( KVAL( I ), I = 1, NK )
1377.OR..OR..OR.
IF( SEV SES SVX SSX ) THEN
1382 READ( NIN, FMT = * )NBVAL( 1 ), NBMIN( 1 ), NXVAL( 1 ),
1383 $ INMIN( 1 ), INWIN( 1 ), INIBL(1), ISHFTS(1), IACC22(1)
1384.LT.
IF( NBVAL( 1 )1 ) THEN
1385 WRITE( NOUT, FMT = 9989 )' nb
', NBVAL( 1 ), 1
1387.LT.
ELSE IF( NBMIN( 1 )1 ) THEN
1388 WRITE( NOUT, FMT = 9989 )'nbmin
', NBMIN( 1 ), 1
1390.LT.
ELSE IF( NXVAL( 1 )1 ) THEN
1391 WRITE( NOUT, FMT = 9989 )' nx
', NXVAL( 1 ), 1
1393.LT.
ELSE IF( INMIN( 1 )1 ) THEN
1394 WRITE( NOUT, FMT = 9989 )' inmin
', INMIN( 1 ), 1
1396.LT.
ELSE IF( INWIN( 1 )1 ) THEN
1397 WRITE( NOUT, FMT = 9989 )' inwin
', INWIN( 1 ), 1
1399.LT.
ELSE IF( INIBL( 1 )1 ) THEN
1400 WRITE( NOUT, FMT = 9989 )' inibl
', INIBL( 1 ), 1
1402.LT.
ELSE IF( ISHFTS( 1 )1 ) THEN
1403 WRITE( NOUT, FMT = 9989 )' ishfts
', ISHFTS( 1 ), 1
1405.LT.
ELSE IF( IACC22( 1 )0 ) THEN
1406 WRITE( NOUT, FMT = 9989 )' iacc22
', IACC22( 1 ), 0
1409 CALL XLAENV( 1, NBVAL( 1 ) )
1410 CALL XLAENV( 2, NBMIN( 1 ) )
1411 CALL XLAENV( 3, NXVAL( 1 ) )
1412 CALL XLAENV(12, MAX( 11, INMIN( 1 ) ) )
1413 CALL XLAENV(13, INWIN( 1 ) )
1414 CALL XLAENV(14, INIBL( 1 ) )
1415 CALL XLAENV(15, ISHFTS( 1 ) )
1416 CALL XLAENV(16, IACC22( 1 ) )
1417 WRITE( NOUT, FMT = 9983 )'nb:
', NBVAL( 1 )
1418 WRITE( NOUT, FMT = 9983 )'nbmin:
', NBMIN( 1 )
1419 WRITE( NOUT, FMT = 9983 )'nx:
', NXVAL( 1 )
1420 WRITE( NOUT, FMT = 9983 )'inmin:
', INMIN( 1 )
1421 WRITE( NOUT, FMT = 9983 )'inwin:
', INWIN( 1 )
1422 WRITE( NOUT, FMT = 9983 )'inibl:
', INIBL( 1 )
1423 WRITE( NOUT, FMT = 9983 )'ishfts:
', ISHFTS( 1 )
1424 WRITE( NOUT, FMT = 9983 )'iacc22:
', IACC22( 1 )
1426.OR..OR..OR.
ELSE IF( SGS SGX SGV SXV ) THEN
1431 READ( NIN, FMT = * )NBVAL( 1 ), NBMIN( 1 ), NXVAL( 1 ),
1432 $ NSVAL( 1 ), MXBVAL( 1 )
1433.LT.
IF( NBVAL( 1 )1 ) THEN
1434 WRITE( NOUT, FMT = 9989 )' nb
', NBVAL( 1 ), 1
1436.LT.
ELSE IF( NBMIN( 1 )1 ) THEN
1437 WRITE( NOUT, FMT = 9989 )'nbmin
', NBMIN( 1 ), 1
1439.LT.
ELSE IF( NXVAL( 1 )1 ) THEN
1440 WRITE( NOUT, FMT = 9989 )' nx
', NXVAL( 1 ), 1
1442.LT.
ELSE IF( NSVAL( 1 )2 ) THEN
1443 WRITE( NOUT, FMT = 9989 )' ns
', NSVAL( 1 ), 2
1445.LT.
ELSE IF( MXBVAL( 1 )1 ) THEN
1446 WRITE( NOUT, FMT = 9989 )' maxb
', MXBVAL( 1 ), 1
1449 CALL XLAENV( 1, NBVAL( 1 ) )
1450 CALL XLAENV( 2, NBMIN( 1 ) )
1451 CALL XLAENV( 3, NXVAL( 1 ) )
1452 CALL XLAENV( 4, NSVAL( 1 ) )
1453 CALL XLAENV( 8, MXBVAL( 1 ) )
1454 WRITE( NOUT, FMT = 9983 )'nb:
', NBVAL( 1 )
1455 WRITE( NOUT, FMT = 9983 )'nbmin:
', NBMIN( 1 )
1456 WRITE( NOUT, FMT = 9983 )'nx:
', NXVAL( 1 )
1457 WRITE( NOUT, FMT = 9983 )'ns:
', NSVAL( 1 )
1458 WRITE( NOUT, FMT = 9983 )'maxb:
', MXBVAL( 1 )
1460.NOT..AND..NOT..AND..NOT..AND..NOT.
ELSE IF( SSB GLM GQR
1461.AND..NOT..AND..NOT.
$ GSV CSD LSE ) THEN
1466 READ( NIN, FMT = * )NPARMS
1467.LT.
IF( NPARMS1 ) THEN
1468 WRITE( NOUT, FMT = 9989 )'nparms
', NPARMS, 1
1471.GT.
ELSE IF( NPARMSMAXIN ) THEN
1472 WRITE( NOUT, FMT = 9988 )'nparms
', NPARMS, MAXIN
1480 READ( NIN, FMT = * )( NBVAL( I ), I = 1, NPARMS )
1482.LT.
IF( NBVAL( I )0 ) THEN
1483 WRITE( NOUT, FMT = 9989 )' nb
', NBVAL( I ), 0
1485.GT.
ELSE IF( NBVAL( I )NMAX ) THEN
1486 WRITE( NOUT, FMT = 9988 )' nb
', NBVAL( I ), NMAX
1490 WRITE( NOUT, FMT = 9983 )'nb:
',
1491 $ ( NBVAL( I ), I = 1, NPARMS )
1496.OR..OR..OR.
IF( NEP SEP SVD SGG ) THEN
1497 READ( NIN, FMT = * )( NBMIN( I ), I = 1, NPARMS )
1499.LT.
IF( NBMIN( I )0 ) THEN
1500 WRITE( NOUT, FMT = 9989 )'nbmin
', NBMIN( I ), 0
1502.GT.
ELSE IF( NBMIN( I )NMAX ) THEN
1503 WRITE( NOUT, FMT = 9988 )'nbmin
', NBMIN( I ), NMAX
1507 WRITE( NOUT, FMT = 9983 )'nbmin:
',
1508 $ ( NBMIN( I ), I = 1, NPARMS )
1517.OR..OR.
IF( NEP SEP SVD ) THEN
1518 READ( NIN, FMT = * )( NXVAL( I ), I = 1, NPARMS )
1519 DO 100 I = 1, NPARMS
1520.LT.
IF( NXVAL( I )0 ) THEN
1521 WRITE( NOUT, FMT = 9989 )' nx
', NXVAL( I ), 0
1523.GT.
ELSE IF( NXVAL( I )NMAX ) THEN
1524 WRITE( NOUT, FMT = 9988 )' nx
', NXVAL( I ), NMAX
1528 WRITE( NOUT, FMT = 9983 )'nx:
',
1529 $ ( NXVAL( I ), I = 1, NPARMS )
1531 DO 110 I = 1, NPARMS
1539.OR..OR.
IF( SVD SBB SGG ) THEN
1540 READ( NIN, FMT = * )( NSVAL( I ), I = 1, NPARMS )
1541 DO 120 I = 1, NPARMS
1542.LT.
IF( NSVAL( I )0 ) THEN
1543 WRITE( NOUT, FMT = 9989 )' ns
', NSVAL( I ), 0
1545.GT.
ELSE IF( NSVAL( I )NMAX ) THEN
1546 WRITE( NOUT, FMT = 9988 )' ns
', NSVAL( I ), NMAX
1550 WRITE( NOUT, FMT = 9983 )'ns:
',
1551 $ ( NSVAL( I ), I = 1, NPARMS )
1553 DO 130 I = 1, NPARMS
1561 READ( NIN, FMT = * )( MXBVAL( I ), I = 1, NPARMS )
1562 DO 140 I = 1, NPARMS
1563.LT.
IF( MXBVAL( I )0 ) THEN
1564 WRITE( NOUT, FMT = 9989 )' maxb
', MXBVAL( I ), 0
1566.GT.
ELSE IF( MXBVAL( I )NMAX ) THEN
1567 WRITE( NOUT, FMT = 9988 )' maxb
', MXBVAL( I ), NMAX
1571 WRITE( NOUT, FMT = 9983 )'maxb:
',
1572 $ ( MXBVAL( I ), I = 1, NPARMS )
1574 DO 150 I = 1, NPARMS
1582 READ( NIN, FMT = * )( INMIN( I ), I = 1, NPARMS )
1583 DO 540 I = 1, NPARMS
1584.LT.
IF( INMIN( I )0 ) THEN
1585 WRITE( NOUT, FMT = 9989 )' inmin
', INMIN( I ), 0
1589 WRITE( NOUT, FMT = 9983 )'inmin:
',
1590 $ ( INMIN( I ), I = 1, NPARMS )
1592 DO 550 I = 1, NPARMS
1600 READ( NIN, FMT = * )( INWIN( I ), I = 1, NPARMS )
1601 DO 560 I = 1, NPARMS
1602.LT.
IF( INWIN( I )0 ) THEN
1603 WRITE( NOUT, FMT = 9989 )' inwin
', INWIN( I ), 0
1607 WRITE( NOUT, FMT = 9983 )'inwin:
',
1608 $ ( INWIN( I ), I = 1, NPARMS )
1610 DO 570 I = 1, NPARMS
1618 READ( NIN, FMT = * )( INIBL( I ), I = 1, NPARMS )
1619 DO 580 I = 1, NPARMS
1620.LT.
IF( INIBL( I )0 ) THEN
1621 WRITE( NOUT, FMT = 9989 )' inibl
', INIBL( I ), 0
1625 WRITE( NOUT, FMT = 9983 )'inibl:
',
1626 $ ( INIBL( I ), I = 1, NPARMS )
1628 DO 590 I = 1, NPARMS
1636 READ( NIN, FMT = * )( ISHFTS( I ), I = 1, NPARMS )
1637 DO 600 I = 1, NPARMS
1638.LT.
IF( ISHFTS( I )0 ) THEN
1639 WRITE( NOUT, FMT = 9989 )' ishfts
', ISHFTS( I ), 0
1643 WRITE( NOUT, FMT = 9983 )'ishfts:
',
1644 $ ( ISHFTS( I ), I = 1, NPARMS )
1646 DO 610 I = 1, NPARMS
1653.OR.
IF( NEP SGG ) THEN
1654 READ( NIN, FMT = * )( IACC22( I ), I = 1, NPARMS )
1655 DO 620 I = 1, NPARMS
1656.LT.
IF( IACC22( I )0 ) THEN
1657 WRITE( NOUT, FMT = 9989 )' iacc22
', IACC22( I ), 0
1661 WRITE( NOUT, FMT = 9983 )'iacc22:
',
1662 $ ( IACC22( I ), I = 1, NPARMS )
1664 DO 630 I = 1, NPARMS
1672 READ( NIN, FMT = * )( NBCOL( I ), I = 1, NPARMS )
1673 DO 160 I = 1, NPARMS
1674.LT.
IF( NBCOL( I )0 ) THEN
1675 WRITE( NOUT, FMT = 9989 )'nbcol
', NBCOL( I ), 0
1677.GT.
ELSE IF( NBCOL( I )NMAX ) THEN
1678 WRITE( NOUT, FMT = 9988 )'nbcol
', NBCOL( I ), NMAX
1682 WRITE( NOUT, FMT = 9983 )'nbcol:
',
1683 $ ( NBCOL( I ), I = 1, NPARMS )
1685 DO 170 I = 1, NPARMS
1693 WRITE( NOUT, FMT = * )
1694 EPS = SLAMCH( 'underflow threshold
' )
1695 WRITE( NOUT, FMT = 9981 )'underflow
', EPS
1696 EPS = SLAMCH( 'overflow threshold
' )
1697 WRITE( NOUT, FMT = 9981 )'overflow
', EPS
1698 EPS = SLAMCH( 'epsilon
' )
1699 WRITE( NOUT, FMT = 9981 )'precision
', EPS
1703 READ( NIN, FMT = * )THRESH
1704 WRITE( NOUT, FMT = 9982 )THRESH
1705.OR..OR.
IF( SEP SVD SGG ) THEN
1709 READ( NIN, FMT = * )TSTCHK
1713 READ( NIN, FMT = * )TSTDRV
1718 READ( NIN, FMT = * )TSTERR
1722 READ( NIN, FMT = * )NEWSD
1727 $ READ( NIN, FMT = * )( IOLDSD( I ), I = 1, 4 )
1730 ISEED( I ) = IOLDSD( I )
1734 WRITE( NOUT, FMT = 9999 )
1745.NOT..OR.
IF( ( SGX SXV ) ) THEN
1748 READ( NIN, FMT = '(a80)
', END = 380 )LINE
1756.GT.
IF( ILENP ) THEN
1764.NE.
IF( LINE( I: I )' .AND..NE.
' LINE( I: I )',
' ) THEN
1771.EQ.
IF( C1INTSTR( K: K ) ) THEN
1776 WRITE( NOUT, FMT = 9991 )I, LINE
1781.GT.
ELSE IF( I10 ) THEN
1791.NOT..OR..OR..OR..OR..OR.
IF( ( SEV SES SVX SSX SGV
1792.AND..LE.
$ SGS ) NTYPES0 ) THEN
1793 WRITE( NOUT, FMT = 9990 )C3
1806.EQ.
IF( NEWSD0 ) THEN
1808 ISEED( K ) = IOLDSD( K )
1812 IF( LSAMEN( 3, C3, 'shs.OR.
' ) LSAMEN( 3, C3, 'nep
' ) ) THEN
1825 NTYPES = MIN( MAXTYP, NTYPES )
1826 CALL ALAREQ( C3, NTYPES, DOTYPE, MAXTYP, NIN, NOUT )
1829 $ CALL SERRHS( 'shseqr', NOUT )
1830 DO 270 I = 1, NPARMS
1831 CALL XLAENV( 1, NBVAL( I ) )
1832 CALL XLAENV( 2, NBMIN( I ) )
1833 CALL XLAENV( 3, NXVAL( I ) )
1834 CALL XLAENV(12, MAX( 11, INMIN( I ) ) )
1835 CALL XLAENV(13, INWIN( I ) )
1836 CALL XLAENV(14, INIBL( I ) )
1837 CALL XLAENV(15, ISHFTS( I ) )
1838 CALL XLAENV(16, IACC22( I ) )
1840.EQ.
IF( NEWSD0 ) THEN
1842 ISEED( K ) = IOLDSD( K )
1845 WRITE( NOUT, FMT = 9961 )C3, NBVAL( I ), NBMIN( I ),
1846 $ NXVAL( I ), MAX( 11, INMIN(I)),
1847 $ INWIN( I ), INIBL( I ), ISHFTS( I ), IACC22( I )
1848 CALL SCHKHS( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH, NOUT,
1849 $ A( 1, 1 ), NMAX, A( 1, 2 ), A( 1, 3 ),
1850 $ A( 1, 4 ), A( 1, 5 ), NMAX, A( 1, 6 ),
1851 $ A( 1, 7 ), D( 1, 1 ), D( 1, 2 ), D( 1, 3 ),
1852 $ D( 1, 4 ), D( 1, 5 ), D( 1, 6 ), A( 1, 8 ),
1853 $ A( 1, 9 ), A( 1, 10 ), A( 1, 11 ), A( 1, 12 ),
1854 $ D( 1, 7 ), WORK, LWORK, IWORK, LOGWRK, RESULT,
1857 $ WRITE( NOUT, FMT = 9980 )'schkhs', INFO
1860 ELSE IF( LSAMEN( 3, C3, 'sst.OR.
' ) LSAMEN( 3, C3, 'sep
' )
1861.OR.
$ LSAMEN( 3, C3, 'se2
' ) ) THEN
1872 NTYPES = MIN( MAXTYP, NTYPES )
1873 CALL ALAREQ( C3, NTYPES, DOTYPE, MAXTYP, NIN, NOUT )
1875 CALL XLAENV( 9, 25 )
1878 N_THREADS = OMP_GET_MAX_THREADS()
1880 CALL OMP_SET_NUM_THREADS(ONE_THREAD)
1882 CALL SERRST( 'sst
', NOUT )
1884 CALL OMP_SET_NUM_THREADS(N_THREADS)
1887 DO 290 I = 1, NPARMS
1888 CALL XLAENV( 1, NBVAL( I ) )
1889 CALL XLAENV( 2, NBMIN( I ) )
1890 CALL XLAENV( 3, NXVAL( I ) )
1892.EQ.
IF( NEWSD0 ) THEN
1894 ISEED( K ) = IOLDSD( K )
1897 WRITE( NOUT, FMT = 9997 )C3, NBVAL( I ), NBMIN( I ),
1900 IF( LSAMEN( 3, C3, 'se2
' ) ) THEN
1901 CALL SCHKST2STG( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH,
1902 $ NOUT, A( 1, 1 ), NMAX, A( 1, 2 ), D( 1, 1 ),
1903 $ D( 1, 2 ), D( 1, 3 ), D( 1, 4 ), D( 1, 5 ),
1904 $ D( 1, 6 ), D( 1, 7 ), D( 1, 8 ), D( 1, 9 ),
1905 $ D( 1, 10 ), D( 1, 11 ), A( 1, 3 ), NMAX,
1906 $ A( 1, 4 ), A( 1, 5 ), D( 1, 12 ), A( 1, 6 ),
1907 $ WORK, LWORK, IWORK, LIWORK, RESULT, INFO )
1909 CALL SCHKST( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH,
1910 $ NOUT, A( 1, 1 ), NMAX, A( 1, 2 ), D( 1, 1 ),
1911 $ D( 1, 2 ), D( 1, 3 ), D( 1, 4 ), D( 1, 5 ),
1912 $ D( 1, 6 ), D( 1, 7 ), D( 1, 8 ), D( 1, 9 ),
1913 $ D( 1, 10 ), D( 1, 11 ), A( 1, 3 ), NMAX,
1914 $ A( 1, 4 ), A( 1, 5 ), D( 1, 12 ), A( 1, 6 ),
1915 $ WORK, LWORK, IWORK, LIWORK, RESULT, INFO )
1918 $ WRITE( NOUT, FMT = 9980 )'schkst', INFO
1921 IF( LSAMEN( 3, C3, 'se2
' ) ) THEN
1922 CALL SDRVST2STG( NN, NVAL, 18, DOTYPE, ISEED, THRESH,
1923 $ NOUT, A( 1, 1 ), NMAX, D( 1, 3 ), D( 1, 4 ),
1924 $ D( 1, 5 ), D( 1, 6 ), D( 1, 8 ), D( 1, 9 ),
1925 $ D( 1, 10 ), D( 1, 11), A( 1, 2 ), NMAX,
1926 $ A( 1, 3 ), D( 1, 12 ), A( 1, 4 ), WORK,
1927 $ LWORK, IWORK, LIWORK, RESULT, INFO )
1929 CALL SDRVST( NN, NVAL, 18, DOTYPE, ISEED, THRESH,
1930 $ NOUT, A( 1, 1 ), NMAX, D( 1, 3 ), D( 1, 4 ),
1931 $ D( 1, 5 ), D( 1, 6 ), D( 1, 8 ), D( 1, 9 ),
1932 $ D( 1, 10 ), D( 1, 11), A( 1, 2 ), NMAX,
1933 $ A( 1, 3 ), D( 1, 12 ), A( 1, 4 ), WORK,
1934 $ LWORK, IWORK, LIWORK, RESULT, INFO )
1937 $ WRITE( NOUT, FMT = 9980 )'sdrvst', INFO
1941 ELSE IF( LSAMEN( 3, C3, 'ssg
' ) ) THEN
1952 NTYPES = MIN( MAXTYP, NTYPES )
1953 CALL ALAREQ( C3, NTYPES, DOTYPE, MAXTYP, NIN, NOUT )
1954 CALL XLAENV( 9, 25 )
1955 DO 310 I = 1, NPARMS
1956 CALL XLAENV( 1, NBVAL( I ) )
1957 CALL XLAENV( 2, NBMIN( I ) )
1958 CALL XLAENV( 3, NXVAL( I ) )
1960.EQ.
IF( NEWSD0 ) THEN
1962 ISEED( K ) = IOLDSD( K )
1965 WRITE( NOUT, FMT = 9997 )C3, NBVAL( I ), NBMIN( I ),
1973 CALL SDRVSG2STG( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH,
1974 $ NOUT, A( 1, 1 ), NMAX, A( 1, 2 ), NMAX,
1975 $ D( 1, 3 ), D( 1, 3 ), A( 1, 3 ), NMAX,
1976 $ A( 1, 4 ), A( 1, 5 ), A( 1, 6 ),
1977 $ A( 1, 7 ), WORK, LWORK, IWORK, LIWORK,
1980 $ WRITE( NOUT, FMT = 9980 )'sdrvsg', INFO
1984 ELSE IF( LSAMEN( 3, C3, 'sbd.OR.
' ) LSAMEN( 3, C3, 'svd
' ) ) THEN
1996 NTYPES = MIN( MAXTYP, NTYPES )
1997 CALL ALAREQ( C3, NTYPES, DOTYPE, MAXTYP, NIN, NOUT )
1999 CALL XLAENV( 9, 25 )
2003.AND.
IF( TSTERR TSTCHK )
2004 $ CALL SERRBD( 'sbd
', NOUT )
2005.AND.
IF( TSTERR TSTDRV )
2006 $ CALL SERRED( 'sbd
', NOUT )
2008 DO 330 I = 1, NPARMS
2010 CALL XLAENV( 1, NBVAL( I ) )
2011 CALL XLAENV( 2, NBMIN( I ) )
2012 CALL XLAENV( 3, NXVAL( I ) )
2013.EQ.
IF( NEWSD0 ) THEN
2015 ISEED( K ) = IOLDSD( K )
2018 WRITE( NOUT, FMT = 9995 )C3, NBVAL( I ), NBMIN( I ),
2021 CALL SCHKBD( NN, MVAL, NVAL, MAXTYP, DOTYPE, NRHS, ISEED,
2022 $ THRESH, A( 1, 1 ), NMAX, D( 1, 1 ),
2023 $ D( 1, 2 ), D( 1, 3 ), D( 1, 4 ), A( 1, 2 ),
2024 $ NMAX, A( 1, 3 ), A( 1, 4 ), A( 1, 5 ), NMAX,
2025 $ A( 1, 6 ), NMAX, A( 1, 7 ), A( 1, 8 ), WORK,
2026 $ LWORK, IWORK, NOUT, INFO )
2028 $ WRITE( NOUT, FMT = 9980 )'schkbd', INFO
2031 $ CALL SDRVBD( NN, MVAL, NVAL, MAXTYP, DOTYPE, ISEED,
2032 $ THRESH, A( 1, 1 ), NMAX, A( 1, 2 ), NMAX,
2033 $ A( 1, 3 ), NMAX, A( 1, 4 ), A( 1, 5 ),
2034 $ A( 1, 6 ), D( 1, 1 ), D( 1, 2 ), D( 1, 3 ),
2035 $ WORK, LWORK, IWORK, NOUT, INFO )
2038 ELSE IF( LSAMEN( 3, C3, 'sev
' ) ) THEN
2046 NTYPES = MIN( MAXTYP, NTYPES )
2047.LE.
IF( NTYPES0 ) THEN
2048 WRITE( NOUT, FMT = 9990 )C3
2051 $ CALL SERRED( C3, NOUT )
2052 CALL ALAREQ( C3, NTYPES, DOTYPE, MAXTYP, NIN, NOUT )
2053 CALL SDRVEV( NN, NVAL, NTYPES, DOTYPE, ISEED, THRESH, NOUT,
2054 $ A( 1, 1 ), NMAX, A( 1, 2 ), D( 1, 1 ),
2055 $ D( 1, 2 ), D( 1, 3 ), D( 1, 4 ), A( 1, 3 ),
2056 $ NMAX, A( 1, 4 ), NMAX, A( 1, 5 ), NMAX, RESULT,
2057 $ WORK, LWORK, IWORK, INFO )
2059 $ WRITE( NOUT, FMT = 9980 )'sgeev', INFO
2061 WRITE( NOUT, FMT = 9973 )
2064 ELSE IF( LSAMEN( 3, C3, 'ses
' ) ) THEN
2072 NTYPES = MIN( MAXTYP, NTYPES )
2073.LE.
IF( NTYPES0 ) THEN
2074 WRITE( NOUT, FMT = 9990 )C3
2077 $ CALL SERRED( C3, NOUT )
2078 CALL ALAREQ( C3, NTYPES, DOTYPE, MAXTYP, NIN, NOUT )
2079 CALL SDRVES( NN, NVAL, NTYPES, DOTYPE, ISEED, THRESH, NOUT,
2080 $ A( 1, 1 ), NMAX, A( 1, 2 ), A( 1, 3 ),
2081 $ D( 1, 1 ), D( 1, 2 ), D( 1, 3 ), D( 1, 4 ),
2082 $ A( 1, 4 ), NMAX, RESULT, WORK, LWORK, IWORK,
2085 $ WRITE( NOUT, FMT = 9980 )'sgees', INFO
2087 WRITE( NOUT, FMT = 9973 )
2090 ELSE IF( LSAMEN( 3, C3, 'svx
' ) ) THEN
2098 NTYPES = MIN( MAXTYP, NTYPES )
2099.LT.
IF( NTYPES0 ) THEN
2100 WRITE( NOUT, FMT = 9990 )C3
2103 $ CALL SERRED( C3, NOUT )
2104 CALL ALAREQ( C3, NTYPES, DOTYPE, MAXTYP, NIN, NOUT )
2105 CALL SDRVVX( NN, NVAL, NTYPES, DOTYPE, ISEED, THRESH, NIN,
2106 $ NOUT, A( 1, 1 ), NMAX, A( 1, 2 ), D( 1, 1 ),
2107 $ D( 1, 2 ), D( 1, 3 ), D( 1, 4 ), A( 1, 3 ),
2108 $ NMAX, A( 1, 4 ), NMAX, A( 1, 5 ), NMAX,
2109 $ D( 1, 5 ), D( 1, 6 ), D( 1, 7 ), D( 1, 8 ),
2110 $ D( 1, 9 ), D( 1, 10 ), D( 1, 11 ), D( 1, 12 ),
2111 $ RESULT, WORK, LWORK, IWORK, INFO )
2113 $ WRITE( NOUT, FMT = 9980 )'sgeevx', INFO
2115 WRITE( NOUT, FMT = 9973 )
2118 ELSE IF( LSAMEN( 3, C3, 'ssx
' ) ) THEN
2126 NTYPES = MIN( MAXTYP, NTYPES )
2127.LT.
IF( NTYPES0 ) THEN
2128 WRITE( NOUT, FMT = 9990 )C3
2131 $ CALL SERRED( C3, NOUT )
2132 CALL ALAREQ( C3, NTYPES, DOTYPE, MAXTYP, NIN, NOUT )
2133 CALL SDRVSX( NN, NVAL, NTYPES, DOTYPE, ISEED, THRESH, NIN,
2134 $ NOUT, A( 1, 1 ), NMAX, A( 1, 2 ), A( 1, 3 ),
2135 $ D( 1, 1 ), D( 1, 2 ), D( 1, 3 ), D( 1, 4 ),
2136 $ D( 1, 5 ), D( 1, 6 ), A( 1, 4 ), NMAX,
2137 $ A( 1, 5 ), RESULT, WORK, LWORK, IWORK, LOGWRK,
2140 $ WRITE( NOUT, FMT = 9980 )'sgeesx', INFO
2142 WRITE( NOUT, FMT = 9973 )
2145 ELSE IF( LSAMEN( 3, C3, 'sgg
' ) ) THEN
2159 NTYPES = MIN( MAXTYP, NTYPES )
2160 CALL ALAREQ( C3, NTYPES, DOTYPE, MAXTYP, NIN, NOUT )
2162.AND.
IF( TSTCHK TSTERR )
2163 & CALL SERRGG( C3, NOUT )
2164 DO 350 I = 1, NPARMS
2165 CALL XLAENV( 1, NBVAL( I ) )
2166 CALL XLAENV( 2, NBMIN( I ) )
2167 CALL XLAENV( 4, NSVAL( I ) )
2168 CALL XLAENV( 8, MXBVAL( I ) )
2169 CALL XLAENV( 16, IACC22( I ) )
2170 CALL XLAENV( 5, NBCOL( I ) )
2172.EQ.
IF( NEWSD0 ) THEN
2174 ISEED( K ) = IOLDSD( K )
2177 WRITE( NOUT, FMT = 9996 )C3, NBVAL( I ), NBMIN( I ),
2178 $ NSVAL( I ), MXBVAL( I ), IACC22( I ), NBCOL( I )
2182 CALL SCHKGG( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH,
2183 $ TSTDIF, THRSHN, NOUT, A( 1, 1 ), NMAX,
2184 $ A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ),
2185 $ A( 1, 6 ), A( 1, 7 ), A( 1, 8 ), A( 1, 9 ),
2186 $ NMAX, A( 1, 10 ), A( 1, 11 ), A( 1, 12 ),
2187 $ D( 1, 1 ), D( 1, 2 ), D( 1, 3 ), D( 1, 4 ),
2188 $ D( 1, 5 ), D( 1, 6 ), A( 1, 13 ),
2189 $ A( 1, 14 ), WORK, LWORK, LOGWRK, RESULT,
2192 $ WRITE( NOUT, FMT = 9980 )'schkgg', INFO
2196 ELSE IF( LSAMEN( 3, C3, 'sgs
' ) ) THEN
2204 NTYPES = MIN( MAXTYP, NTYPES )
2205.LE.
IF( NTYPES0 ) THEN
2206 WRITE( NOUT, FMT = 9990 )C3
2209 $ CALL SERRGG( C3, NOUT )
2210 CALL ALAREQ( C3, NTYPES, DOTYPE, MAXTYP, NIN, NOUT )
2211 CALL SDRGES( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH, NOUT,
2212 $ A( 1, 1 ), NMAX, A( 1, 2 ), A( 1, 3 ),
2213 $ A( 1, 4 ), A( 1, 7 ), NMAX, A( 1, 8 ),
2214 $ D( 1, 1 ), D( 1, 2 ), D( 1, 3 ), WORK, LWORK,
2215 $ RESULT, LOGWRK, INFO )
2218 $ WRITE( NOUT, FMT = 9980 )'sdrges', INFO
2223 CALL SDRGES3( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH, NOUT,
2224 $ A( 1, 1 ), NMAX, A( 1, 2 ), A( 1, 3 ),
2225 $ A( 1, 4 ), A( 1, 7 ), NMAX, A( 1, 8 ),
2226 $ D( 1, 1 ), D( 1, 2 ), D( 1, 3 ), WORK, LWORK,
2227 $ RESULT, LOGWRK, INFO )
2230 $ WRITE( NOUT, FMT = 9980 )'sdrges3', INFO
2232 WRITE( NOUT, FMT = 9973 )
2245 WRITE( NOUT, FMT = 9990 )C3
2248 $ CALL SERRGG( C3, NOUT )
2249 CALL ALAREQ( C3, NTYPES, DOTYPE, MAXTYP, NIN, NOUT )
2251 CALL SDRGSX( NN, NCMAX, THRESH, NIN, NOUT, A( 1, 1 ), NMAX,
2252 $ A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ),
2253 $ A( 1, 6 ), D( 1, 1 ), D( 1, 2 ), D( 1, 3 ),
2254 $ C( 1, 1 ), NCMAX*NCMAX, A( 1, 12 ), WORK,
2255 $ LWORK, IWORK, LIWORK, LOGWRK, INFO )
2257 $ WRITE( NOUT, FMT = 9980 )'sdrgsx', INFO
2259 WRITE( NOUT, FMT = 9973 )
2262 ELSE IF( LSAMEN( 3, C3, 'sgv
' ) ) THEN
2270 NTYPES = MIN( MAXTYP, NTYPES )
2271.LE.
IF( NTYPES0 ) THEN
2272 WRITE( NOUT, FMT = 9990 )C3
2275 $ CALL SERRGG( C3, NOUT )
2276 CALL ALAREQ( C3, NTYPES, DOTYPE, MAXTYP, NIN, NOUT )
2277 CALL SDRGEV( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH, NOUT,
2278 $ A( 1, 1 ), NMAX, A( 1, 2 ), A( 1, 3 ),
2279 $ A( 1, 4 ), A( 1, 7 ), NMAX, A( 1, 8 ),
2280 $ A( 1, 9 ), NMAX, D( 1, 1 ), D( 1, 2 ),
2281 $ D( 1, 3 ), D( 1, 4 ), D( 1, 5 ), D( 1, 6 ),
2282 $ WORK, LWORK, RESULT, INFO )
2284 $ WRITE( NOUT, FMT = 9980 )'sdrgev', info
2288 CALL sdrgev3( nn, nval, maxtyp, dotype, iseed, thresh, nout,
2289 $ a( 1, 1 ), nmax, a( 1, 2 ), a( 1, 3 ),
2290 $ a( 1, 4 ), a( 1, 7 ), nmax, a( 1, 8 ),
2291 $ a( 1, 9 ), nmax, d( 1, 1 ), d( 1, 2 ),
2293 $ work, lwork, result, info )
2295 $
WRITE( nout, fmt = 9980 )
'SDRGEV3', info
2297 WRITE( nout, fmt = 9973 )
2310 WRITE( nout, fmt = 9990 )c3
2313 $
CALL serrgg( c3, nout )
2314 CALL alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2315 CALL sdrgvx( nn, thresh, nin, nout, a( 1, 1 ), nmax,
2316 $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), d( 1, 1 ),
2317 $ d( 1, 2 ), d( 1, 3 ), a( 1, 5 ), a( 1, 6 ),
2318 $ iwork( 1 ), iwork( 2 ), d( 1, 4 ), d( 1, 5 ),
2319 $ d( 1, 6 ), d( 1, 7 ), d( 1, 8 ), d( 1, 9 ),
2320 $ work, lwork, iwork( 3 ), liwork-2, result,
2324 $
WRITE( nout, fmt = 9980 )
'SDRGVX', info
2326 WRITE( nout, fmt = 9973 )
2329 ELSE IF(
lsamen( 3, c3,
'SSB' ) )
THEN
2336 ntypes =
min( maxtyp, ntypes )
2337 CALL alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2339 $
CALL serrst(
'SSB', nout )
2343 CALL schksb2stg( nn, nval, nk, kval, maxtyp, dotype, iseed,
2344 $ thresh, nout, a( 1, 1 ), nmax, d( 1, 1 ),
2345 $ d( 1, 2 ), d( 1, 3 ), d( 1, 4 ), d( 1, 5 ),
2346 $ a( 1, 2 ), nmax, work, lwork, result, info )
2348 $
WRITE( nout, fmt = 9980 )
'SCHKSB', info
2350 ELSE IF(
lsamen( 3, c3,
'SBB' ) )
THEN
2357 ntypes =
min( maxtyp, ntypes )
2358 CALL alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2359 DO 370 i = 1, nparms
2362 IF( newsd.EQ.0 )
THEN
2364 iseed( k ) = ioldsd( k )
2367 WRITE( nout, fmt = 9966 )c3, nrhs
2368 CALL schkbb( nn, mval, nval, nk, kval, maxtyp, dotype, nrhs,
2369 $ iseed, thresh, nout, a( 1, 1 ), nmax,
2370 $ a( 1, 2 ), 2*nmax, d( 1, 1 ), d( 1, 2 ),
2371 $ a( 1, 4 ), nmax, a( 1, 5 ), nmax, a( 1, 6 ),
2372 $ nmax, a( 1, 7 ), work, lwork, result, info )
2374 $
WRITE( nout, fmt = 9980 )
'SCHKBB', info
2377 ELSE IF(
lsamen( 3, c3,
'GLM' ) )
THEN
2385 $
CALL serrgg(
'GLM', nout )
2386 CALL sckglm( nn, mval, pval, nval, ntypes, iseed
2387 $ a( 1, 1 ), a( 1, 2 ), b( 1, 1 ), b( 1, 2 ), x,
2388 $ work, d( 1, 1 ), nin, nout, info )
2390 $
WRITE( nout, fmt = 9980 )
'SCKGLM', info
2392 ELSE IF(
lsamen( 3, c3,
'GQR' ) )
THEN
2400 $
CALL serrgg(
'GQR', nout )
2401 CALL sckgqr( nn, mval, nn, pval, nn, nval, ntypes, iseed,
2402 $ thresh, nmax, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
2403 $ a( 1, 4 ), taua, b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
2404 $ b( 1, 4 ), b( 1, 5 ), taub, work, d( 1, 1 ), nin,
2407 $
WRITE( nout, fmt = 9980 )
'SCKGQR', info
2409 ELSE IF(
lsamen( 3, c3,
'GSV' ) )
THEN
2417 $
CALL serrgg(
'GSV', nout )
2418 CALL sckgsv( nn, mval, pval, nval, ntypes, iseed, thresh, nmax,
2419 $ a( 1, 1 ), a( 1, 2 ), b( 1, 1 ), b( 1, 2 ),
2420 $ a( 1, 3 ), b( 1, 3 ), a( 1, 4 ), taua, taub,
2421 $ b( 1, 4 ), iwork, work, d( 1, 1 ), nin, nout,
2424 $
WRITE( nout, fmt = 9980 )
'SCKGSV', info
2426 ELSE IF(
lsamen( 3, c3,
'CSD' ) )
THEN
2434 $
CALL serrgg(
'CSD', nout )
2435 CALL sckcsd( nn, mval, pval, nval, ntypes, iseed, thresh, nmax,
2436 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), a( 1, 4 ),
2437 $ a( 1, 5 ), a( 1, 6 ), a( 1, 7 ), iwork, work,
2438 $ d( 1, 1 ), nin, nout, info )
2440 $
WRITE( nout, fmt = 9980 )
'SCKCSD', info
2442 ELSE IF(
lsamen( 3, c3,
'LSE' ) )
THEN
2450 $
CALL serrgg(
'LSE', nout )
2451 CALL scklse( nn, mval, pval, nval, ntypes, iseed, thresh, nmax,
2452 $ a( 1, 1 ), a( 1, 2 ), b( 1, 1 ), b( 1, 2 ), x,
2453 $ work, d( 1, 1 ), nin, nout, info )
2455 $
WRITE( nout, fmt = 9980 )
'SCKLSE', info
2458 WRITE( nout, fmt = * )
2459 WRITE( nout, fmt = * )
2460 WRITE( nout, fmt = 9992 )c3
2462 IF( .NOT.( sgx .OR. sxv ) )
2465 WRITE( nout, fmt = 9994 )
2467 WRITE( nout, fmt = 9993 )s2 - s1
2469 DEALLOCATE (a, stat = allocatestatus)
2470 DEALLOCATE (b, stat = allocatestatus)
2471 DEALLOCATE (c, stat = allocatestatus)
2472 DEALLOCATE (work, stat = allocatestatus)
2474 9999
FORMAT( /
' Execution not attempted due to input errors' )
2475 9997
FORMAT( / / 1x, a3,
': NB =', i4,
', NBMIN =', i4, ', nx =
', I4 )
2476 9996 FORMAT( / / 1X, A3, ': nb =
', I4, ', nbmin =
', I4, ', ns =
', I4,
2477 $ ', maxb =
', I4, ', iacc22 =
', I4, ', nbcol =
', I4 )
2478 9995 FORMAT( / / 1X, A3, ': nb =
', I4, ', nbmin =
', I4, ', nx =
', I4,
2480 9994 FORMAT( / / ' End of tests
' )
2481 9993 FORMAT( ' Total time used =
', F12.2, ' seconds
', / )
2482 9992 FORMAT( 1X, A3, ': Unrecognized path name
' )
2483 9991 FORMAT( / / ' *** Invalid integer value in column
', I2,
2484 $ ' of input
', ' line:
', / A79 )
2485 9990 FORMAT( / / 1X, A3, ' routines were not tested
' )
2486 9989 FORMAT( ' Invalid input value:
', A, '=
', I6, '; must be >=
',
2488 9988 FORMAT( ' Invalid input value:
', A, '=
', I6, '; must be <=
',
2490 9987 FORMAT( ' Tests of the Nonsymmetric Eigenvalue Problem routines
' )
2491 9986 FORMAT( ' Tests of the Symmetric Eigenvalue Problem routines
' )
2492 9985 FORMAT( ' Tests of the Singular Value Decomposition routines
' )
2493 9984 FORMAT( / ' The following parameter values will be used:
' )
2494 9983 FORMAT( 4X, A, 10I6, / 10X, 10I6 )
2495 9982 FORMAT( / ' Routines pass computational tests if test ratio is
',
2496 $ 'less than
', F8.2, / )
2497 9981 FORMAT( ' Relative machine
', A, ' is taken to be
', E16.6 )
2498 9980 FORMAT( ' *** Error code from
', A, ' =
', I4 )
2499 9979 FORMAT( / ' Tests of the Nonsymmetric Eigenvalue Problem Driver
',
2500 $ / ' SGEEV (eigenvalues and eigevectors)
' )
2501 9978 FORMAT( / ' Tests of the Nonsymmetric Eigenvalue Problem Driver
',
2502 $ / ' SGEES (Schur form)
' )
2503 9977 FORMAT( / ' Tests of the Nonsymmetric Eigenvalue Problem Expert
',
2504 $ ' Driver
', / ' SGEEVX (eigenvalues, eigenvectors and
',
2505 $ ' condition numbers)
' )
2506 9976 FORMAT( / ' Tests of the Nonsymmetric Eigenvalue Problem Expert
',
2507 $ ' Driver
', / ' SGEESX (Schur form and condition
',
2509 9975 FORMAT( / ' Tests of the Generalized Nonsymmetric Eigenvalue
',
2510 $ 'Problem routines
' )
2511 9974 FORMAT( ' Tests of SSBTRD
', / ' (reduction of a symmetric band
',
2512 $ 'matrix to tridiagonal form)
' )
2513 9973 FORMAT( / 1X, 71( '-
' ) )
2514 9972 FORMAT( / ' LAPACK VERSION
', I1, '.
', I1, '.
', I1 )
2515 9971 FORMAT( / ' Tests of the Generalized Linear Regression Model
',
2517 9970 FORMAT( / ' Tests of the Generalized QR and RQ routines
' )
2518 9969 FORMAT( / ' Tests of the Generalized Singular Value
',
2519 $ ' Decomposition routines
' )
2520 9968 FORMAT( / ' Tests of the Linear Least Squares routines
' )
2521 9967 FORMAT( ' Tests of SGBBRD
', / ' (reduction of a general band
',
2522 $ 'matrix to real bidiagonal form)
' )
2523 9966 FORMAT( / / 1X, A3, ': NRHS =
', I4 )
2524 9965 FORMAT( / ' Tests of the Generalized Nonsymmetric Eigenvalue
',
2525 $ 'Problem Expert Driver SGGESX
' )
2526 9964 FORMAT( / ' Tests of the Generalized Nonsymmetric Eigenvalue
',
2527 $ 'Problem Driver SGGES
' )
2528 9963 FORMAT( / ' Tests of the Generalized Nonsymmetric Eigenvalue
',
2529 $ 'Problem Driver SGGEV
' )
2530 9962 FORMAT( / ' Tests of the Generalized Nonsymmetric Eigenvalue
',
2531 $ 'Problem Expert Driver SGGEVX
' )
2532 9961 FORMAT( / / 1X, A3, ': NB =
', I4, ', NBMIN =
', I4, ', NX =
', I4,
2534 $ ', INWIN =
', I4, ', INIBL =
', I4, ', ISHFTS =
', I4,
2536 9960 FORMAT( / ' Tests of the CS Decomposition routines
' )
logical function lsamen(n, ca, cb)
LSAMEN
subroutine xlaenv(ispec, nvalue)
XLAENV
subroutine alareq(path, nmats, dotype, ntypes, nin, nout)
ALAREQ
subroutine sgeev(jobvl, jobvr, n, a, lda, wr, wi, vl, ldvl, vr, ldvr, work, lwork, info)
SGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices
subroutine sgeesx(jobvs, sort, select, sense, n, a, lda, sdim, wr, wi, vs, ldvs, rconde, rcondv, work, lwork, iwork, liwork, bwork, info)
SGEESX computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE ...
subroutine sgeevx(balanc, jobvl, jobvr, sense, n, a, lda, wr, wi, vl, ldvl, vr, ldvr, ilo, ihi, scale, abnrm, rconde, rcondv, work, lwork, iwork, info)
SGEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices
subroutine sgees(jobvs, sort, select, n, a, lda, sdim, wr, wi, vs, ldvs, work, lwork, bwork, info)
SGEES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE m...
subroutine shseqr(job, compz, n, ilo, ihi, h, ldh, wr, wi, z, ldz, work, lwork, info)
SHSEQR
subroutine schkgl(nin, nout)
SCHKGL
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 serred(path, nunit)
SERRED
subroutine schkst(nsizes, nn, ntypes, dotype, iseed, thresh, nounit, a, lda, ap, sd, se, d1, d2, d3, d4, d5, wa1, wa2, wa3, wr, u, ldu, v, vp, tau, z, work, lwork, iwork, liwork, result, info)
SCHKST
subroutine sckgqr(nm, mval, np, pval, nn, nval, nmats, iseed, thresh, nmax, a, af, aq, ar, taua, b, bf, bz, bt, bwk, taub, work, rwork, nin, nout, info)
SCKGQR
subroutine schkhs(nsizes, nn, ntypes, dotype, iseed, thresh, nounit, a, lda, h, t1, t2, u, ldu, z, uz, wr1, wi1, wr2, wi2, wr3, wi3, evectl, evectr, evecty, evectx, uu, tau, work, nwork, iwork, select, result, info)
SCHKHS
subroutine scklse(nn, mval, pval, nval, nmats, iseed, thresh, nmax, a, af, b, bf, x, work, rwork, nin, nout, info)
SCKLSE
subroutine serrgg(path, nunit)
SERRGG
subroutine schksb2stg(nsizes, nn, nwdths, kk, ntypes, dotype, iseed, thresh, nounit, a, lda, sd, se, d1, d2, d3, u, ldu, work, lwork, result, info)
SCHKSB2STG
subroutine sdrvev(nsizes, nn, ntypes, dotype, iseed, thresh, nounit, a, lda, h, wr, wi, wr1, wi1, vl, ldvl, vr, ldvr, lre, ldlre, result, work, nwork, iwork, info)
SDRVEV
subroutine schkst2stg(nsizes, nn, ntypes, dotype, iseed, thresh, nounit, a, lda, ap, sd, se, d1, d2, d3, d4, d5, wa1, wa2, wa3, wr, u, ldu, v, vp, tau, z, work, lwork, iwork, liwork, result, info)
SCHKST2STG
subroutine sdrges3(nsizes, nn, ntypes, dotype, iseed, thresh, nounit, a, lda, b, s, t, q, ldq, z, alphar, alphai, beta, work, lwork, result, bwork, info)
SDRGES3
subroutine sdrgev3(nsizes, nn, ntypes, dotype, iseed, thresh, nounit, a, lda, b, s, t, q, ldq, z, qe, ldqe, alphar, alphai, beta, alphr1, alphi1, beta1, work, lwork, result, info)
SDRGEV3
subroutine schkbk(nin, nout)
SCHKBK
subroutine schkbl(nin, nout)
SCHKBL
subroutine sckcsd(nm, mval, pval, qval, nmats, iseed, thresh, mmax, x, xf, u1, u2, v1t, v2t, theta, iwork, work, rwork, nin, nout, info)
SCKCSD
subroutine schkbb(nsizes, mval, nval, nwdths, kk, ntypes, dotype, nrhs, iseed, thresh, nounit, a, lda, ab, ldab, bd, be, q, ldq, p, ldp, c, ldc, cc, work, lwork, result, info)
SCHKBB
subroutine sdrgvx(nsize, thresh, nin, nout, a, lda, b, ai, bi, alphar, alphai, beta, vl, vr, ilo, ihi, lscale, rscale, s, stru, dif, diftru, work, lwork, iwork, liwork, result, bwork, info)
SDRGVX
subroutine sckgsv(nm, mval, pval, nval, nmats, iseed, thresh, nmax, a, af, b, bf, u, v, q, alpha, beta, r, iwork, work, rwork, nin, nout, info)
SCKGSV
subroutine sdrgev(nsizes, nn, ntypes, dotype, iseed, thresh, nounit, a, lda, b, s, t, q, ldq, z, qe, ldqe, alphar, alphai, beta, alphr1, alphi1, beta1, work, lwork, result, info)
SDRGEV
subroutine schkgg(nsizes, nn, ntypes, dotype, iseed, thresh, tstdif, thrshn, nounit, a, lda, b, h, t, s1, s2, p1, p2, u, ldu, v, q, z, alphr1, alphi1, beta1, alphr3, alphi3, beta3, evectl, evectr, work, lwork, llwork, result, info)
SCHKGG
subroutine sdrvsx(nsizes, nn, ntypes, dotype, iseed, thresh, niunit, nounit, a, lda, h, ht, wr, wi, wrt, wit, wrtmp, witmp, vs, ldvs, vs1, result, work, lwork, iwork, bwork, info)
SDRVSX
subroutine sdrgsx(nsize, ncmax, thresh, nin, nout, a, lda, b, ai, bi, z, q, alphar, alphai, beta, c, ldc, s, work, lwork, iwork, liwork, bwork, info)
SDRGSX
subroutine sdrvst2stg(nsizes, nn, ntypes, dotype, iseed, thresh, nounit, a, lda, d1, d2, d3, d4, eveigs, wa1, wa2, wa3, u, ldu, v, tau, z, work, lwork, iwork, liwork, result, info)
SDRVST2STG
subroutine serrhs(path, nunit)
SERRHS
subroutine sdrges(nsizes, nn, ntypes, dotype, iseed, thresh, nounit, a, lda, b, s, t, q, ldq, z, alphar, alphai, beta, work, lwork, result, bwork, info)
SDRGES
subroutine serrst(path, nunit)
SERRST
subroutine sdrvsg(nsizes, nn, ntypes, dotype, iseed, thresh, nounit, a, lda, b, ldb, d, z, ldz, ab, bb, ap, bp, work, nwork, iwork, liwork, result, info)
SDRVSG
subroutine sdrves(nsizes, nn, ntypes, dotype, iseed, thresh, nounit, a, lda, h, ht, wr, wi, wrt, wit, vs, ldvs, result, work, nwork, iwork, bwork, info)
SDRVES
subroutine sdrvvx(nsizes, nn, ntypes, dotype, iseed, thresh, niunit, nounit, a, lda, h, wr, wi, wr1, wi1, vl, ldvl, vr, ldvr, lre, ldlre, rcondv, rcndv1, rcdvin, rconde, rcnde1, rcdein, scale, scale1, result, work, nwork, iwork, info)
SDRVVX
subroutine schkgk(nin, nout)
SCHKGK
subroutine sdrvbd(nsizes, mm, nn, ntypes, dotype, iseed, thresh, a, lda, u, ldu, vt, ldvt, asav, usav, vtsav, s, ssav, e, work, lwork, iwork, nout, info)
SDRVBD
subroutine schkec(thresh, tsterr, nin, nout)
SCHKEC
subroutine sdrvst(nsizes, nn, ntypes, dotype, iseed, thresh, nounit, a, lda, d1, d2, d3, d4, eveigs, wa1, wa2, wa3, u, ldu, v, tau, z, work, lwork, iwork, liwork, result, info)
SDRVST
subroutine sckglm(nn, mval, pval, nval, nmats, iseed, thresh, nmax, a, af, b, bf, x, work, rwork, nin, nout, info)
SCKGLM
subroutine schksb(nsizes, nn, nwdths, kk, ntypes, dotype, iseed, thresh, nounit, a, lda, sd, se, u, ldu, work, lwork, result, info)
SCHKSB
subroutine serrbd(path, nunit)
SERRBD
subroutine ilaver(vers_major, vers_minor, vers_patch)
ILAVER returns the LAPACK version.
real function slamch(cmach)
SLAMCH
logical function lse(ri, rj, lr)
subroutine sdrvsg2stg(nsizes, nn, ntypes, dotype, iseed, thresh, nounit, a, lda, b, ldb, d, d2, z, ldz, ab, bb, ap, bp, work, nwork, iwork, liwork, result, info)
SDRVSG2STG
real function second()
SECOND Using ETIME