1051 parameter( nmax = 132 )
1053 parameter( ncmax = 20 )
1055 parameter( need = 14 )
1057 parameter( lwork = nmax*( 5*nmax+5 )+1 )
1059 parameter( liwork = nmax*( 5*nmax+20 ) )
1061 parameter( maxin = 20 )
1063 parameter( maxt = 30 )
1065 parameter( nin = 5, nout = 6 )
1068 LOGICAL csd, dbb, dgg, dsb, fatal, glm, gqr, gsv,
lse,
1069 $ nep, dbk, dbl, sep, des, dev, dgk, dgl, dgs,
1070 $ dgv, dgx, dsx, svd, dvx, dxv, tstchk, tstdif,
1073 CHARACTER*3 c3, path
1077 INTEGER i, i1, ic, info, itmp, k, lenp, maxtyp, newsd,
1078 $ nk, nn, nparms, nrhs, ntypes,
1079 $ vers_major, vers_minor, vers_patch
1080 DOUBLE PRECISION eps, s1, s2, thresh, thrshn
1083 LOGICAL dotype( maxt ), logwrk( nmax )
1084 INTEGER ioldsd( 4 ), iseed( 4 ), iwork( liwork ),
1085 $ kval( maxin ), mval( maxin ), mxbval( maxin ),
1086 $ nbcol( maxin ), nbmin( maxin ), nbval( maxin ),
1087 $ nsval( maxin ), nval( maxin ), nxval( maxin ),
1089 INTEGER inmin( maxin ), inwin( maxin ), inibl( maxin ),
1090 $ ishfts( maxin ), iacc22( maxin )
1091 DOUBLE PRECISION a( nmax*nmax, need ), b( nmax*nmax, 5 ),
1092 $ c( ncmax*ncmax, ncmax*ncmax ), d( nmax, 12 ),
1093 $ result( 500 ), taua( nmax ), taub( nmax ),
1094 $ work( lwork ), x( 5*nmax )
1115 INTEGER infot, maxb, nproc, nshift, nunit, seldim,
1119 LOGICAL selval( 20 )
1120 INTEGER iparms( 100 )
1121 DOUBLE PRECISION selwi( 20 ), selwr( 20 )
1124 common / cenvir / nproc, nshift, maxb
1125 common / infoc / infot, nunit, ok, lerr
1126 common / srnamc / srnamt
1127 common / sslct / selopt, seldim, selval, selwr, selwi
1128 common / claenv / iparms
1131 DATA intstr /
'0123456789' /
1132 DATA ioldsd / 0, 0, 0, 1 /
1146 READ( nin, fmt =
'(A80)',
END = 380 )line
1148 nep =
lsamen( 3, path,
'NEP' ) .OR.
lsamen( 3, path,
'DHS' )
1149 sep =
lsamen( 3, path,
'SEP' ) .OR.
lsamen( 3, path,
'DST' ) .OR.
1150 $
lsamen( 3, path,
'DSG' )
1151 svd =
lsamen( 3, path,
'SVD' ) .OR.
lsamen( 3, path,
'DBD' )
1152 dev =
lsamen( 3, path,
'DEV' )
1153 des =
lsamen( 3, path,
'DES' )
1154 dvx =
lsamen( 3, path,
'DVX' )
1155 dsx =
lsamen( 3, path,
'DSX' )
1156 dgg =
lsamen( 3, path,
'DGG' )
1157 dgs =
lsamen( 3, path,
'DGS' )
1158 dgx =
lsamen( 3, path,
'DGX' )
1159 dgv =
lsamen( 3, path,
'DGV' )
1160 dxv =
lsamen( 3, path,
'DXV' )
1161 dsb =
lsamen( 3, path,
'DSB' )
1162 dbb =
lsamen( 3, path,
'DBB' )
1163 glm =
lsamen( 3, path,
'GLM' )
1164 gqr =
lsamen( 3, path,
'GQR' ) .OR.
lsamen( 3, path,
'GRQ' )
1165 gsv =
lsamen( 3, path,
'GSV' )
1166 csd =
lsamen( 3, path,
'CSD' )
1168 dbl =
lsamen( 3, path,
'DBL' )
1169 dbk =
lsamen( 3, path,
'DBK' )
1170 dgl =
lsamen( 3, path,
'DGL' )
1171 dgk =
lsamen( 3, path,
'DGK' )
1175 IF( path.EQ.
' ' )
THEN
1178 WRITE( nout, fmt = 9987 )
1180 WRITE( nout, fmt = 9986 )
1182 WRITE( nout, fmt = 9985 )
1184 WRITE( nout, fmt = 9979 )
1186 WRITE( nout, fmt = 9978 )
1188 WRITE( nout, fmt = 9977 )
1190 WRITE( nout, fmt = 9976 )
1192 WRITE( nout, fmt = 9975 )
1194 WRITE( nout, fmt = 9964 )
1196 WRITE( nout, fmt = 9965 )
1198 WRITE( nout, fmt = 9963 )
1200 WRITE( nout, fmt = 9962 )
1202 WRITE( nout, fmt = 9974 )
1204 WRITE( nout, fmt = 9967 )
1206 WRITE( nout, fmt = 9971 )
1208 WRITE( nout, fmt = 9970 )
1210 WRITE( nout, fmt = 9969 )
1212 WRITE( nout, fmt = 9960 )
1214 WRITE( nout, fmt = 9968 )
1239 ELSE IF(
lsamen( 3, path,
'DEC' ) )
THEN
1243 READ( nin, fmt = * )thresh
1251 CALL
dchkec( thresh, tsterr, nin, nout )
1254 WRITE( nout, fmt = 9992 )path
1257 CALL
ilaver( vers_major, vers_minor, vers_patch )
1258 WRITE( nout, fmt = 9972 ) vers_major, vers_minor, vers_patch
1259 WRITE( nout, fmt = 9984 )
1263 READ( nin, fmt = * )nn
1265 WRITE( nout, fmt = 9989 )
' NN ', nn, 1
1268 ELSE IF( nn.GT.maxin )
THEN
1269 WRITE( nout, fmt = 9988 )
' NN ', nn, maxin
1276 IF( .NOT.( dgx .OR. dxv ) )
THEN
1277 READ( nin, fmt = * )( mval( i ), i = 1, nn )
1284 IF( mval( i ).LT.0 )
THEN
1285 WRITE( nout, fmt = 9989 )vname, mval( i ), 0
1287 ELSE IF( mval( i ).GT.nmax )
THEN
1288 WRITE( nout, fmt = 9988 )vname, mval( i ), nmax
1292 WRITE( nout, fmt = 9983 )
'M: ', ( mval( i ), i = 1, nn )
1297 IF( glm .OR. gqr .OR. gsv .OR. csd .OR.
lse )
THEN
1298 READ( nin, fmt = * )( pval( i ), i = 1, nn )
1300 IF( pval( i ).LT.0 )
THEN
1301 WRITE( nout, fmt = 9989 )
' P ', pval( i ), 0
1303 ELSE IF( pval( i ).GT.nmax )
THEN
1304 WRITE( nout, fmt = 9988 )
' P ', pval( i ), nmax
1308 WRITE( nout, fmt = 9983 )
'P: ', ( pval( i ), i = 1, nn )
1313 IF( svd .OR. dbb .OR. glm .OR. gqr .OR. gsv .OR. csd .OR.
1315 READ( nin, fmt = * )( nval( i ), i = 1, nn )
1317 IF( nval( i ).LT.0 )
THEN
1318 WRITE( nout, fmt = 9989 )
' N ', nval( i ), 0
1320 ELSE IF( nval( i ).GT.nmax )
THEN
1321 WRITE( nout, fmt = 9988 )
' N ', nval( i ), nmax
1327 nval( i ) = mval( i )
1330 IF( .NOT.( dgx .OR. dxv ) )
THEN
1331 WRITE( nout, fmt = 9983 )
'N: ', ( nval( i ), i = 1, nn )
1333 WRITE( nout, fmt = 9983 )
'N: ', nn
1338 IF( dsb .OR. dbb )
THEN
1339 READ( nin, fmt = * )nk
1340 READ( nin, fmt = * )( kval( i ), i = 1, nk )
1342 IF( kval( i ).LT.0 )
THEN
1343 WRITE( nout, fmt = 9989 )
' K ', kval( i ), 0
1345 ELSE IF( kval( i ).GT.nmax )
THEN
1346 WRITE( nout, fmt = 9988 )
' K ', kval( i ), nmax
1350 WRITE( nout, fmt = 9983 )
'K: ', ( kval( i ), i = 1, nk )
1353 IF( dev .OR. des .OR. dvx .OR. dsx )
THEN
1358 READ( nin, fmt = * )nbval( 1 ), nbmin( 1 ), nxval( 1 ),
1359 $ inmin( 1 ), inwin( 1 ), inibl(1), ishfts(1), iacc22(1)
1360 IF( nbval( 1 ).LT.1 )
THEN
1361 WRITE( nout, fmt = 9989 )
' NB ', nbval( 1 ), 1
1363 ELSE IF( nbmin( 1 ).LT.1 )
THEN
1364 WRITE( nout, fmt = 9989 )
'NBMIN ', nbmin( 1 ), 1
1366 ELSE IF( nxval( 1 ).LT.1 )
THEN
1367 WRITE( nout, fmt = 9989 )
' NX ', nxval( 1 ), 1
1369 ELSE IF( inmin( 1 ).LT.1 )
THEN
1370 WRITE( nout, fmt = 9989 )
' INMIN ', inmin( 1 ), 1
1372 ELSE IF( inwin( 1 ).LT.1 )
THEN
1373 WRITE( nout, fmt = 9989 )
' INWIN ', inwin( 1 ), 1
1375 ELSE IF( inibl( 1 ).LT.1 )
THEN
1376 WRITE( nout, fmt = 9989 )
' INIBL ', inibl( 1 ), 1
1378 ELSE IF( ishfts( 1 ).LT.1 )
THEN
1379 WRITE( nout, fmt = 9989 )
' ISHFTS ', ishfts( 1 ), 1
1381 ELSE IF( iacc22( 1 ).LT.0 )
THEN
1382 WRITE( nout, fmt = 9989 )
' IACC22 ', iacc22( 1 ), 0
1385 CALL
xlaenv( 1, nbval( 1 ) )
1386 CALL
xlaenv( 2, nbmin( 1 ) )
1387 CALL
xlaenv( 3, nxval( 1 ) )
1388 CALL
xlaenv(12, max( 11, inmin( 1 ) ) )
1389 CALL
xlaenv(13, inwin( 1 ) )
1390 CALL
xlaenv(14, inibl( 1 ) )
1391 CALL
xlaenv(15, ishfts( 1 ) )
1392 CALL
xlaenv(16, iacc22( 1 ) )
1393 WRITE( nout, fmt = 9983 )
'NB: ', nbval( 1 )
1394 WRITE( nout, fmt = 9983 )
'NBMIN:', nbmin( 1 )
1395 WRITE( nout, fmt = 9983 )
'NX: ', nxval( 1 )
1396 WRITE( nout, fmt = 9983 )
'INMIN: ', inmin( 1 )
1397 WRITE( nout, fmt = 9983 )
'INWIN: ', inwin( 1 )
1398 WRITE( nout, fmt = 9983 )
'INIBL: ', inibl( 1 )
1399 WRITE( nout, fmt = 9983 )
'ISHFTS: ', ishfts( 1 )
1400 WRITE( nout, fmt = 9983 )
'IACC22: ', iacc22( 1 )
1402 elseif( dgs .OR. dgx .OR. dgv .OR. dxv )
THEN
1407 READ( nin, fmt = * )nbval( 1 ), nbmin( 1 ), nxval( 1 ),
1408 $ nsval( 1 ), mxbval( 1 )
1409 IF( nbval( 1 ).LT.1 )
THEN
1410 WRITE( nout, fmt = 9989 )
' NB ', nbval( 1 ), 1
1412 ELSE IF( nbmin( 1 ).LT.1 )
THEN
1413 WRITE( nout, fmt = 9989 )
'NBMIN ', nbmin( 1 ), 1
1415 ELSE IF( nxval( 1 ).LT.1 )
THEN
1416 WRITE( nout, fmt = 9989 )
' NX ', nxval( 1 ), 1
1418 ELSE IF( nsval( 1 ).LT.2 )
THEN
1419 WRITE( nout, fmt = 9989 )
' NS ', nsval( 1 ), 2
1421 ELSE IF( mxbval( 1 ).LT.1 )
THEN
1422 WRITE( nout, fmt = 9989 )
' MAXB ', mxbval( 1 ), 1
1425 CALL
xlaenv( 1, nbval( 1 ) )
1426 CALL
xlaenv( 2, nbmin( 1 ) )
1427 CALL
xlaenv( 3, nxval( 1 ) )
1428 CALL
xlaenv( 4, nsval( 1 ) )
1429 CALL
xlaenv( 8, mxbval( 1 ) )
1430 WRITE( nout, fmt = 9983 )
'NB: ', nbval( 1 )
1431 WRITE( nout, fmt = 9983 )
'NBMIN:', nbmin( 1 )
1432 WRITE( nout, fmt = 9983 )
'NX: ', nxval( 1 )
1433 WRITE( nout, fmt = 9983 )
'NS: ', nsval( 1 )
1434 WRITE( nout, fmt = 9983 )
'MAXB: ', mxbval( 1 )
1436 ELSE IF( .NOT.dsb .AND. .NOT.glm .AND. .NOT.gqr .AND. .NOT.
1437 $ gsv .AND. .NOT.csd .AND. .NOT.
lse )
THEN
1442 READ( nin, fmt = * )nparms
1443 IF( nparms.LT.1 )
THEN
1444 WRITE( nout, fmt = 9989 )
'NPARMS', nparms, 1
1447 ELSE IF( nparms.GT.maxin )
THEN
1448 WRITE( nout, fmt = 9988 )
'NPARMS', nparms, maxin
1456 READ( nin, fmt = * )( nbval( i ), i = 1, nparms )
1458 IF( nbval( i ).LT.0 )
THEN
1459 WRITE( nout, fmt = 9989 )
' NB ', nbval( i ), 0
1461 ELSE IF( nbval( i ).GT.nmax )
THEN
1462 WRITE( nout, fmt = 9988 )
' NB ', nbval( i ), nmax
1466 WRITE( nout, fmt = 9983 )
'NB: ',
1467 $ ( nbval( i ), i = 1, nparms )
1472 IF( nep .OR. sep .OR. svd .OR. dgg )
THEN
1473 READ( nin, fmt = * )( nbmin( i ), i = 1, nparms )
1475 IF( nbmin( i ).LT.0 )
THEN
1476 WRITE( nout, fmt = 9989 )
'NBMIN ', nbmin( i ), 0
1478 ELSE IF( nbmin( i ).GT.nmax )
THEN
1479 WRITE( nout, fmt = 9988 )
'NBMIN ', nbmin( i ), nmax
1483 WRITE( nout, fmt = 9983 )
'NBMIN:',
1484 $ ( nbmin( i ), i = 1, nparms )
1493 IF( nep .OR. sep .OR. svd )
THEN
1494 READ( nin, fmt = * )( nxval( i ), i = 1, nparms )
1495 DO 100 i = 1, nparms
1496 IF( nxval( i ).LT.0 )
THEN
1497 WRITE( nout, fmt = 9989 )
' NX ', nxval( i ), 0
1499 ELSE IF( nxval( i ).GT.nmax )
THEN
1500 WRITE( nout, fmt = 9988 )
' NX ', nxval( i ), nmax
1504 WRITE( nout, fmt = 9983 )
'NX: ',
1505 $ ( nxval( i ), i = 1, nparms )
1507 DO 110 i = 1, nparms
1515 IF( svd .OR. dbb .OR. dgg )
THEN
1516 READ( nin, fmt = * )( nsval( i ), i = 1, nparms )
1517 DO 120 i = 1, nparms
1518 IF( nsval( i ).LT.0 )
THEN
1519 WRITE( nout, fmt = 9989 )
' NS ', nsval( i ), 0
1521 ELSE IF( nsval( i ).GT.nmax )
THEN
1522 WRITE( nout, fmt = 9988 )
' NS ', nsval( i ), nmax
1526 WRITE( nout, fmt = 9983 )
'NS: ',
1527 $ ( nsval( i ), i = 1, nparms )
1529 DO 130 i = 1, nparms
1537 READ( nin, fmt = * )( mxbval( i ), i = 1, nparms )
1538 DO 140 i = 1, nparms
1539 IF( mxbval( i ).LT.0 )
THEN
1540 WRITE( nout, fmt = 9989 )
' MAXB ', mxbval( i ), 0
1542 ELSE IF( mxbval( i ).GT.nmax )
THEN
1543 WRITE( nout, fmt = 9988 )
' MAXB ', mxbval( i ), nmax
1547 WRITE( nout, fmt = 9983 )
'MAXB: ',
1548 $ ( mxbval( i ), i = 1, nparms )
1550 DO 150 i = 1, nparms
1558 READ( nin, fmt = * )( inmin( i ), i = 1, nparms )
1559 DO 540 i = 1, nparms
1560 IF( inmin( i ).LT.0 )
THEN
1561 WRITE( nout, fmt = 9989 )
' INMIN ', inmin( i ), 0
1565 WRITE( nout, fmt = 9983 )
'INMIN: ',
1566 $ ( inmin( i ), i = 1, nparms )
1568 DO 550 i = 1, nparms
1576 READ( nin, fmt = * )( inwin( i ), i = 1, nparms )
1577 DO 560 i = 1, nparms
1578 IF( inwin( i ).LT.0 )
THEN
1579 WRITE( nout, fmt = 9989 )
' INWIN ', inwin( i ), 0
1583 WRITE( nout, fmt = 9983 )
'INWIN: ',
1584 $ ( inwin( i ), i = 1, nparms )
1586 DO 570 i = 1, nparms
1594 READ( nin, fmt = * )( inibl( i ), i = 1, nparms )
1595 DO 580 i = 1, nparms
1596 IF( inibl( i ).LT.0 )
THEN
1597 WRITE( nout, fmt = 9989 )
' INIBL ', inibl( i ), 0
1601 WRITE( nout, fmt = 9983 )
'INIBL: ',
1602 $ ( inibl( i ), i = 1, nparms )
1604 DO 590 i = 1, nparms
1612 READ( nin, fmt = * )( ishfts( i ), i = 1, nparms )
1613 DO 600 i = 1, nparms
1614 IF( ishfts( i ).LT.0 )
THEN
1615 WRITE( nout, fmt = 9989 )
' ISHFTS ', ishfts( i ), 0
1619 WRITE( nout, fmt = 9983 )
'ISHFTS: ',
1620 $ ( ishfts( i ), i = 1, nparms )
1622 DO 610 i = 1, nparms
1630 READ( nin, fmt = * )( iacc22( i ), i = 1, nparms )
1631 DO 620 i = 1, nparms
1632 IF( iacc22( i ).LT.0 )
THEN
1633 WRITE( nout, fmt = 9989 )
' IACC22 ', iacc22( i ), 0
1637 WRITE( nout, fmt = 9983 )
'IACC22: ',
1638 $ ( iacc22( i ), i = 1, nparms )
1640 DO 630 i = 1, nparms
1648 READ( nin, fmt = * )( nbcol( i ), i = 1, nparms )
1649 DO 160 i = 1, nparms
1650 IF( nbcol( i ).LT.0 )
THEN
1651 WRITE( nout, fmt = 9989 )
'NBCOL ', nbcol( i ), 0
1653 ELSE IF( nbcol( i ).GT.nmax )
THEN
1654 WRITE( nout, fmt = 9988 )
'NBCOL ', nbcol( i ), nmax
1658 WRITE( nout, fmt = 9983 )
'NBCOL:',
1659 $ ( nbcol( i ), i = 1, nparms )
1661 DO 170 i = 1, nparms
1669 WRITE( nout, fmt = * )
1670 eps =
dlamch(
'Underflow threshold' )
1671 WRITE( nout, fmt = 9981 )
'underflow', eps
1672 eps =
dlamch(
'Overflow threshold' )
1673 WRITE( nout, fmt = 9981 )
'overflow ', eps
1674 eps =
dlamch(
'Epsilon' )
1675 WRITE( nout, fmt = 9981 )
'precision', eps
1679 READ( nin, fmt = * )thresh
1680 WRITE( nout, fmt = 9982 )thresh
1681 IF( sep .OR. svd .OR. dgg )
THEN
1685 READ( nin, fmt = * )tstchk
1689 READ( nin, fmt = * )tstdrv
1694 READ( nin, fmt = * )tsterr
1698 READ( nin, fmt = * )newsd
1703 $
READ( nin, fmt = * )( ioldsd( i ), i = 1, 4 )
1706 iseed( i ) = ioldsd( i )
1710 WRITE( nout, fmt = 9999 )
1721 IF( .NOT.( dgx .OR. dxv ) )
THEN
1724 READ( nin, fmt =
'(A80)',
END = 380 )line
1732 IF( i.GT.lenp )
THEN
1740 IF( line( i: i ).NE.
' ' .AND. line( i: i ).NE.
',' )
THEN
1747 IF( c1.EQ.intstr( k: k ) )
THEN
1752 WRITE( nout, fmt = 9991 )i, line
1757 ELSE IF( i1.GT.0 )
THEN
1767 IF( .NOT.( dev .OR. des .OR. dvx .OR. dsx .OR. dgv .OR.
1768 $ dgs ) .AND. ntypes.LE.0 )
THEN
1769 WRITE( nout, fmt = 9990 )c3
1782 IF( newsd.EQ.0 )
THEN
1784 iseed( k ) = ioldsd( k )
1788 IF(
lsamen( 3, c3,
'DHS' ) .OR.
lsamen( 3, c3,
'NEP' ) )
THEN
1801 ntypes = min( maxtyp, ntypes )
1802 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
1805 $ CALL
derrhs(
'DHSEQR', nout )
1806 DO 270 i = 1, nparms
1807 CALL
xlaenv( 1, nbval( i ) )
1808 CALL
xlaenv( 2, nbmin( i ) )
1809 CALL
xlaenv( 3, nxval( i ) )
1810 CALL
xlaenv(12, max( 11, inmin( i ) ) )
1811 CALL
xlaenv(13, inwin( i ) )
1812 CALL
xlaenv(14, inibl( i ) )
1813 CALL
xlaenv(15, ishfts( i ) )
1814 CALL
xlaenv(16, iacc22( i ) )
1816 IF( newsd.EQ.0 )
THEN
1818 iseed( k ) = ioldsd( k )
1821 WRITE( nout, fmt = 9961 )c3, nbval( i ), nbmin( i ),
1822 $ nxval( i ), max( 11, inmin(i)),
1823 $ inwin( i ), inibl( i ), ishfts( i ), iacc22( i )
1824 CALL
dchkhs( nn, nval, maxtyp, dotype, iseed, thresh, nout,
1825 $ a( 1, 1 ), nmax, a( 1, 2 ), a( 1, 3 ),
1826 $ a( 1, 4 ), a( 1, 5 ), nmax, a( 1, 6 ),
1827 $ a( 1, 7 ), d( 1, 1 ), d( 1, 2 ), d( 1, 3 ),
1828 $ d( 1, 4 ), a( 1, 8 ), a( 1, 9 ), a( 1, 10 ),
1829 $ a( 1, 11 ), a( 1, 12 ), d( 1, 5 ), work, lwork,
1830 $ iwork, logwrk, result, info )
1832 $
WRITE( nout, fmt = 9980 )
'DCHKHS', info
1835 ELSE IF(
lsamen( 3, c3,
'DST' ) .OR.
lsamen( 3, c3,
'SEP' ) )
THEN
1846 ntypes = min( maxtyp, ntypes )
1847 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
1851 $ CALL
derrst(
'DST', nout )
1852 DO 290 i = 1, nparms
1853 CALL
xlaenv( 1, nbval( i ) )
1854 CALL
xlaenv( 2, nbmin( i ) )
1855 CALL
xlaenv( 3, nxval( i ) )
1857 IF( newsd.EQ.0 )
THEN
1859 iseed( k ) = ioldsd( k )
1862 WRITE( nout, fmt = 9997 )c3, nbval( i ), nbmin( i ),
1865 CALL
dchkst( nn, nval, maxtyp, dotype, iseed, thresh,
1866 $ nout, a( 1, 1 ), nmax, a( 1, 2 ), d( 1, 1 ),
1867 $ d( 1, 2 ), d( 1, 3 ), d( 1, 4 ), d( 1, 5 ),
1868 $ d( 1, 6 ), d( 1, 7 ), d( 1, 8 ), d( 1, 9 ),
1869 $ d( 1, 10 ), d( 1, 11 ), a( 1, 3 ), nmax,
1870 $ a( 1, 4 ), a( 1, 5 ), d( 1, 12 ), a( 1, 6 ),
1871 $ work, lwork, iwork, liwork, result, info )
1873 $
WRITE( nout, fmt = 9980 )
'DCHKST', info
1876 CALL
ddrvst( nn, nval, 18, dotype, iseed, thresh, nout,
1877 $ a( 1, 1 ), nmax, d( 1, 3 ), d( 1, 4 ),
1878 $ d( 1, 5 ), d( 1, 6 ), d( 1, 8 ), d( 1, 9 ),
1879 $ d( 1, 10 ), d( 1, 11 ), a( 1, 2 ), nmax,
1880 $ a( 1, 3 ), d( 1, 12 ), a( 1, 4 ), work,
1881 $ lwork, iwork, liwork, result, info )
1883 $
WRITE( nout, fmt = 9980 )
'DDRVST', info
1887 ELSE IF(
lsamen( 3, c3,
'DSG' ) )
THEN
1898 ntypes = min( maxtyp, ntypes )
1899 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
1901 DO 310 i = 1, nparms
1902 CALL
xlaenv( 1, nbval( i ) )
1903 CALL
xlaenv( 2, nbmin( i ) )
1904 CALL
xlaenv( 3, nxval( i ) )
1906 IF( newsd.EQ.0 )
THEN
1908 iseed( k ) = ioldsd( k )
1911 WRITE( nout, fmt = 9997 )c3, nbval( i ), nbmin( i ),
1914 CALL
ddrvsg( nn, nval, maxtyp, dotype, iseed, thresh,
1915 $ nout, a( 1, 1 ), nmax, a( 1, 2 ), nmax,
1916 $ d( 1, 3 ), a( 1, 3 ), nmax, a( 1, 4 ),
1917 $ a( 1, 5 ), a( 1, 6 ), a( 1, 7 ), work,
1918 $ lwork, iwork, liwork, result, info )
1920 $
WRITE( nout, fmt = 9980 )
'DDRVSG', info
1924 ELSE IF(
lsamen( 3, c3,
'DBD' ) .OR.
lsamen( 3, c3,
'SVD' ) )
THEN
1936 ntypes = min( maxtyp, ntypes )
1937 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
1943 IF( tsterr .AND. tstchk )
1944 $ CALL
derrbd(
'DBD', nout )
1945 IF( tsterr .AND. tstdrv )
1946 $ CALL
derred(
'DBD', nout )
1948 DO 330 i = 1, nparms
1950 CALL
xlaenv( 1, nbval( i ) )
1951 CALL
xlaenv( 2, nbmin( i ) )
1952 CALL
xlaenv( 3, nxval( i ) )
1953 IF( newsd.EQ.0 )
THEN
1955 iseed( k ) = ioldsd( k )
1958 WRITE( nout, fmt = 9995 )c3, nbval( i ), nbmin( i ),
1961 CALL
dchkbd( nn, mval, nval, maxtyp, dotype, nrhs, iseed,
1962 $ thresh, a( 1, 1 ), nmax, d( 1, 1 ),
1963 $ d( 1, 2 ), d( 1, 3 ), d( 1, 4 ), a( 1, 2 ),
1964 $ nmax, a( 1, 3 ), a( 1, 4 ), a( 1, 5 ), nmax,
1965 $ a( 1, 6 ), nmax, a( 1, 7 ), a( 1, 8 ), work,
1966 $ lwork, iwork, nout, info )
1968 $
WRITE( nout, fmt = 9980 )
'DCHKBD', info
1971 $ CALL
ddrvbd( nn, mval, nval, maxtyp, dotype, iseed,
1972 $ thresh, a( 1, 1 ), nmax, a( 1, 2 ), nmax,
1973 $ a( 1, 3 ), nmax, a( 1, 4 ), a( 1, 5 ),
1974 $ a( 1, 6 ), d( 1, 1 ), d( 1, 2 ), d( 1, 3 ),
1975 $ work, lwork, iwork, nout, info )
1978 ELSE IF(
lsamen( 3, c3,
'DEV' ) )
THEN
1986 ntypes = min( maxtyp, ntypes )
1987 IF( ntypes.LE.0 )
THEN
1988 WRITE( nout, fmt = 9990 )c3
1991 $ CALL
derred( c3, nout )
1992 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
1993 CALL
ddrvev( nn, nval, ntypes, dotype, iseed, thresh, nout,
1994 $ a( 1, 1 ), nmax, a( 1, 2 ), d( 1, 1 ),
1995 $ d( 1, 2 ), d( 1, 3 ), d( 1, 4 ), a( 1, 3 ),
1996 $ nmax, a( 1, 4 ), nmax, a( 1, 5 ), nmax, result,
1997 $ work, lwork, iwork, info )
1999 $
WRITE( nout, fmt = 9980 )
'DGEEV', info
2001 WRITE( nout, fmt = 9973 )
2004 ELSE IF(
lsamen( 3, c3,
'DES' ) )
THEN
2012 ntypes = min( maxtyp, ntypes )
2013 IF( ntypes.LE.0 )
THEN
2014 WRITE( nout, fmt = 9990 )c3
2017 $ CALL
derred( c3, nout )
2018 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2019 CALL
ddrves( nn, nval, ntypes, dotype, iseed, thresh, nout,
2020 $ a( 1, 1 ), nmax, a( 1, 2 ), a( 1, 3 ),
2021 $ d( 1, 1 ), d( 1, 2 ), d( 1, 3 ), d( 1, 4 ),
2022 $ a( 1, 4 ), nmax, result, work, lwork, iwork,
2025 $
WRITE( nout, fmt = 9980 )
'DGEES', info
2027 WRITE( nout, fmt = 9973 )
2030 ELSE IF(
lsamen( 3, c3,
'DVX' ) )
THEN
2038 ntypes = min( maxtyp, ntypes )
2039 IF( ntypes.LT.0 )
THEN
2040 WRITE( nout, fmt = 9990 )c3
2043 $ CALL
derred( c3, nout )
2044 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2045 CALL
ddrvvx( nn, nval, ntypes, dotype, iseed, thresh, nin,
2046 $ nout, a( 1, 1 ), nmax, a( 1, 2 ), d( 1, 1 ),
2047 $ d( 1, 2 ), d( 1, 3 ), d( 1, 4 ), a( 1, 3 ),
2048 $ nmax, a( 1, 4 ), nmax, a( 1, 5 ), nmax,
2049 $ d( 1, 5 ), d( 1, 6 ), d( 1, 7 ), d( 1, 8 ),
2050 $ d( 1, 9 ), d( 1, 10 ), d( 1, 11 ), d( 1, 12 ),
2051 $ result, work, lwork, iwork, info )
2053 $
WRITE( nout, fmt = 9980 )
'DGEEVX', info
2055 WRITE( nout, fmt = 9973 )
2058 ELSE IF(
lsamen( 3, c3,
'DSX' ) )
THEN
2066 ntypes = min( maxtyp, ntypes )
2067 IF( ntypes.LT.0 )
THEN
2068 WRITE( nout, fmt = 9990 )c3
2071 $ CALL
derred( c3, nout )
2072 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2073 CALL
ddrvsx( nn, nval, ntypes, dotype, iseed, thresh, nin,
2074 $ nout, a( 1, 1 ), nmax, a( 1, 2 ), a( 1, 3 ),
2075 $ d( 1, 1 ), d( 1, 2 ), d( 1, 3 ), d( 1, 4 ),
2076 $ d( 1, 5 ), d( 1, 6 ), a( 1, 4 ), nmax,
2077 $ a( 1, 5 ), result, work, lwork, iwork, logwrk,
2080 $
WRITE( nout, fmt = 9980 )
'DGEESX', info
2082 WRITE( nout, fmt = 9973 )
2085 ELSE IF(
lsamen( 3, c3,
'DGG' ) )
THEN
2098 ntypes = min( maxtyp, ntypes )
2099 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2100 IF( tstchk .AND. tsterr )
2101 $ CALL
derrgg( c3, nout )
2102 DO 350 i = 1, nparms
2103 CALL
xlaenv( 1, nbval( i ) )
2104 CALL
xlaenv( 2, nbmin( i ) )
2105 CALL
xlaenv( 4, nsval( i ) )
2106 CALL
xlaenv( 8, mxbval( i ) )
2107 CALL
xlaenv( 5, nbcol( i ) )
2109 IF( newsd.EQ.0 )
THEN
2111 iseed( k ) = ioldsd( k )
2114 WRITE( nout, fmt = 9996 )c3, nbval( i ), nbmin( i ),
2115 $ nsval( i ), mxbval( i ), nbcol( i )
2119 CALL
dchkgg( nn, nval, maxtyp, dotype, iseed, thresh,
2120 $ tstdif, thrshn, nout, a( 1, 1 ), nmax,
2121 $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), a( 1, 5 ),
2122 $ a( 1, 6 ), a( 1, 7 ), a( 1, 8 ), a( 1, 9 ),
2123 $ nmax, a( 1, 10 ), a( 1, 11 ), a( 1, 12 ),
2124 $ d( 1, 1 ), d( 1, 2 ), d( 1, 3 ), d( 1, 4 ),
2125 $ d( 1, 5 ), d( 1, 6 ), a( 1, 13 ),
2126 $ a( 1, 14 ), work, lwork, logwrk, result,
2129 $
WRITE( nout, fmt = 9980 )
'DCHKGG', info
2133 CALL
ddrvgg( nn, nval, maxtyp, dotype, iseed, thresh,
2134 $ thrshn, nout, a( 1, 1 ), nmax, a( 1, 2 ),
2135 $ a( 1, 3 ), a( 1, 4 ), a( 1, 5 ), a( 1, 6 ),
2136 $ a( 1, 7 ), nmax, a( 1, 8 ), d( 1, 1 ),
2137 $ d( 1, 2 ), d( 1, 3 ), d( 1, 4 ), d( 1, 5 ),
2138 $ d( 1, 6 ), a( 1, 13 ), a( 1, 14 ), work,
2139 $ lwork, result, info )
2141 $
WRITE( nout, fmt = 9980 )
'DDRVGG', info
2145 ELSE IF(
lsamen( 3, c3,
'DGS' ) )
THEN
2153 ntypes = min( maxtyp, ntypes )
2154 IF( ntypes.LE.0 )
THEN
2155 WRITE( nout, fmt = 9990 )c3
2158 $ CALL
derrgg( c3, nout )
2159 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2160 CALL
ddrges( nn, nval, maxtyp, dotype, iseed, thresh, nout,
2161 $ a( 1, 1 ), nmax, a( 1, 2 ), a( 1, 3 ),
2162 $ a( 1, 4 ), a( 1, 7 ), nmax, a( 1, 8 ),
2163 $ d( 1, 1 ), d( 1, 2 ), d( 1, 3 ), work, lwork,
2164 $ result, logwrk, info )
2167 $
WRITE( nout, fmt = 9980 )
'DDRGES', info
2169 WRITE( nout, fmt = 9973 )
2182 WRITE( nout, fmt = 9990 )c3
2185 $ CALL
derrgg( c3, nout )
2186 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2188 CALL
ddrgsx( nn, ncmax, thresh, nin, nout, a( 1, 1 ), nmax,
2189 $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), a( 1, 5 ),
2190 $ a( 1, 6 ), d( 1, 1 ), d( 1, 2 ), d( 1, 3 ),
2191 $ c( 1, 1 ), ncmax*ncmax, a( 1, 12 ), work,
2192 $ lwork, iwork, liwork, logwrk, info )
2194 $
WRITE( nout, fmt = 9980 )
'DDRGSX', info
2196 WRITE( nout, fmt = 9973 )
2199 ELSE IF(
lsamen( 3, c3,
'DGV' ) )
THEN
2207 ntypes = min( maxtyp, ntypes )
2208 IF( ntypes.LE.0 )
THEN
2209 WRITE( nout, fmt = 9990 )c3
2212 $ CALL
derrgg( c3, nout )
2213 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2214 CALL
ddrgev( nn, nval, maxtyp, dotype, iseed, thresh, nout,
2215 $ a( 1, 1 ), nmax, a( 1, 2 ), a( 1, 3 ),
2216 $ a( 1, 4 ), a( 1, 7 ), nmax, a( 1, 8 ),
2217 $ a( 1, 9 ), nmax, d( 1, 1 ), d( 1, 2 ),
2218 $ d( 1, 3 ), d( 1, 4 ), d( 1, 5 ), d( 1, 6 ),
2219 $ work, lwork, result, info )
2221 $
WRITE( nout, fmt = 9980 )
'DDRGEV', info
2223 WRITE( nout, fmt = 9973 )
2236 WRITE( nout, fmt = 9990 )c3
2239 $ CALL
derrgg( c3, nout )
2240 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2241 CALL
ddrgvx( nn, thresh, nin, nout, a( 1, 1 ), nmax,
2242 $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), d( 1, 1 ),
2243 $ d( 1, 2 ), d( 1, 3 ), a( 1, 5 ), a( 1, 6 ),
2244 $ iwork( 1 ), iwork( 2 ), d( 1, 4 ), d( 1, 5 ),
2245 $ d( 1, 6 ), d( 1, 7 ), d( 1, 8 ), d( 1, 9 ),
2246 $ work, lwork, iwork( 3 ), liwork-2, result,
2250 $
WRITE( nout, fmt = 9980 )
'DDRGVX', info
2252 WRITE( nout, fmt = 9973 )
2255 ELSE IF(
lsamen( 3, c3,
'DSB' ) )
THEN
2262 ntypes = min( maxtyp, ntypes )
2263 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2265 $ CALL
derrst(
'DSB', nout )
2266 CALL
dchksb( nn, nval, nk, kval, maxtyp, dotype, iseed, thresh,
2267 $ nout, a( 1, 1 ), nmax, d( 1, 1 ), d( 1, 2 ),
2268 $ a( 1, 2 ), nmax, work, lwork, result, info )
2270 $
WRITE( nout, fmt = 9980 )
'DCHKSB', info
2272 ELSE IF(
lsamen( 3, c3,
'DBB' ) )
THEN
2279 ntypes = min( maxtyp, ntypes )
2280 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2281 DO 370 i = 1, nparms
2284 IF( newsd.EQ.0 )
THEN
2286 iseed( k ) = ioldsd( k )
2289 WRITE( nout, fmt = 9966 )c3, nrhs
2290 CALL
dchkbb( nn, mval, nval, nk, kval, maxtyp, dotype, nrhs,
2291 $ iseed, thresh, nout, a( 1, 1 ), nmax,
2292 $ a( 1, 2 ), 2*nmax, d( 1, 1 ), d( 1, 2 ),
2293 $ a( 1, 4 ), nmax, a( 1, 5 ), nmax, a( 1, 6 ),
2294 $ nmax, a( 1, 7 ), work, lwork, result, info )
2296 $
WRITE( nout, fmt = 9980 )
'DCHKBB', info
2299 ELSE IF(
lsamen( 3, c3,
'GLM' ) )
THEN
2307 $ CALL
derrgg(
'GLM', nout )
2308 CALL
dckglm( nn, mval, pval, nval, ntypes, iseed, thresh, nmax,
2309 $ a( 1, 1 ), a( 1, 2 ), b( 1, 1 ), b( 1, 2 ), x,
2310 $ work, d( 1, 1 ), nin, nout, info )
2312 $
WRITE( nout, fmt = 9980 )
'DCKGLM', info
2314 ELSE IF(
lsamen( 3, c3,
'GQR' ) )
THEN
2322 $ CALL
derrgg(
'GQR', nout )
2323 CALL
dckgqr( nn, mval, nn, pval, nn, nval, ntypes, iseed,
2324 $ thresh, nmax, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
2325 $ a( 1, 4 ), taua, b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
2326 $ b( 1, 4 ), b( 1, 5 ), taub, work, d( 1, 1 ), nin,
2329 $
WRITE( nout, fmt = 9980 )
'DCKGQR', info
2331 ELSE IF(
lsamen( 3, c3,
'GSV' ) )
THEN
2338 $ CALL
derrgg(
'GSV', nout )
2339 CALL
dckgsv( nn, mval, pval, nval, ntypes, iseed, thresh, nmax,
2340 $ a( 1, 1 ), a( 1, 2 ), b( 1, 1 ), b( 1, 2 ),
2341 $ a( 1, 3 ), b( 1, 3 ), a( 1, 4 ), taua, taub,
2342 $ b( 1, 4 ), iwork, work, d( 1, 1 ), nin, nout,
2345 $
WRITE( nout, fmt = 9980 )
'DCKGSV', info
2347 ELSE IF(
lsamen( 3, c3,
'CSD' ) )
THEN
2355 $ CALL
derrgg(
'CSD', nout )
2356 CALL
dckcsd( nn, mval, pval, nval, ntypes, iseed, thresh, nmax,
2357 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), a( 1, 4 ),
2358 $ a( 1, 5 ), a( 1, 6 ), a( 1, 7 ), iwork, work,
2359 $ d( 1, 1 ), nin, nout, info )
2361 $
WRITE( nout, fmt = 9980 )
'DCKCSD', info
2363 ELSE IF(
lsamen( 3, c3,
'LSE' ) )
THEN
2371 $ CALL
derrgg(
'LSE', nout )
2372 CALL
dcklse( nn, mval, pval, nval, ntypes, iseed, thresh, nmax,
2373 $ a( 1, 1 ), a( 1, 2 ), b( 1, 1 ), b( 1, 2 ), x,
2374 $ work, d( 1, 1 ), nin, nout, info )
2376 $
WRITE( nout, fmt = 9980 )
'DCKLSE', info
2379 WRITE( nout, fmt = * )
2380 WRITE( nout, fmt = * )
2381 WRITE( nout, fmt = 9992 )c3
2383 IF( .NOT.( dgx .OR. dxv ) )
2386 WRITE( nout, fmt = 9994 )
2388 WRITE( nout, fmt = 9993 )s2 - s1
2390 9999 format( /
' Execution not attempted due to input errors' )
2391 9997 format( / / 1x, a3,
': NB =', i4,
', NBMIN =', i4,
', NX =', i4 )
2392 9996 format( / / 1x, a3,
': NB =', i4,
', NBMIN =', i4,
', NS =', i4,
2393 $
', MAXB =', i4,
', NBCOL =', i4 )
2394 9995 format( / / 1x, a3,
': NB =', i4,
', NBMIN =', i4,
', NX =', i4,
2396 9994 format( / /
' End of tests' )
2397 9993 format(
' Total time used = ', f12.2,
' seconds', / )
2398 9992 format( 1x, a3,
': Unrecognized path name' )
2399 9991 format( / /
' *** Invalid integer value in column ', i2,
2400 $
' of input',
' line:', / a79 )
2401 9990 format( / / 1x, a3,
' routines were not tested' )
2402 9989 format(
' Invalid input value: ', a,
'=', i6,
'; must be >=',
2404 9988 format(
' Invalid input value: ', a,
'=', i6,
'; must be <=',
2406 9987 format(
' Tests of the Nonsymmetric Eigenvalue Problem routines' )
2407 9986 format(
' Tests of the Symmetric Eigenvalue Problem routines' )
2408 9985 format(
' Tests of the Singular Value Decomposition routines' )
2409 9984 format( /
' The following parameter values will be used:' )
2410 9983 format( 4x, a, 10i6, / 10x, 10i6 )
2411 9982 format( /
' Routines pass computational tests if test ratio is ',
2412 $
'less than', f8.2, / )
2413 9981 format(
' Relative machine ', a,
' is taken to be', d16.6 )
2414 9980 format(
' *** Error code from ', a,
' = ', i4 )
2415 9979 format( /
' Tests of the Nonsymmetric Eigenvalue Problem Driver',
2416 $ /
' DGEEV (eigenvalues and eigevectors)' )
2417 9978 format( /
' Tests of the Nonsymmetric Eigenvalue Problem Driver',
2418 $ /
' DGEES (Schur form)' )
2419 9977 format( /
' Tests of the Nonsymmetric Eigenvalue Problem Expert',
2420 $
' Driver', /
' DGEEVX (eigenvalues, eigenvectors and',
2421 $
' condition numbers)' )
2422 9976 format( /
' Tests of the Nonsymmetric Eigenvalue Problem Expert',
2423 $
' Driver', /
' DGEESX (Schur form and condition',
2425 9975 format( /
' Tests of the Generalized Nonsymmetric Eigenvalue ',
2426 $
'Problem routines' )
2427 9974 format(
' Tests of DSBTRD', /
' (reduction of a symmetric band ',
2428 $
'matrix to tridiagonal form)' )
2429 9973 format( / 1x, 71(
'-' ) )
2430 9972 format( /
' LAPACK VERSION ', i1,
'.', i1,
'.', i1 )
2431 9971 format( /
' Tests of the Generalized Linear Regression Model ',
2433 9970 format( /
' Tests of the Generalized QR and RQ routines' )
2434 9969 format( /
' Tests of the Generalized Singular Value',
2435 $
' Decomposition routines' )
2436 9968 format( /
' Tests of the Linear Least Squares routines' )
2437 9967 format(
' Tests of DGBBRD', /
' (reduction of a general band ',
2438 $
'matrix to real bidiagonal form)' )
2439 9966 format( / / 1x, a3,
': NRHS =', i4 )
2440 9965 format( /
' Tests of the Generalized Nonsymmetric Eigenvalue ',
2441 $
'Problem Expert Driver DGGESX' )
2442 9964 format( /
' Tests of the Generalized Nonsymmetric Eigenvalue ',
2443 $
'Problem Driver DGGES' )
2444 9963 format( /
' Tests of the Generalized Nonsymmetric Eigenvalue ',
2445 $
'Problem Driver DGGEV' )
2446 9962 format( /
' Tests of the Generalized Nonsymmetric Eigenvalue ',
2447 $
'Problem Expert Driver DGGEVX' )
2448 9961 format( / / 1x, a3,
': NB =', i4,
', NBMIN =', i4,
', NX =', i4,
2450 $
', INWIN =', i4,
', INIBL =', i4,
', ISHFTS =', i4,
2452 9960 format( /
' Tests of the CS Decomposition routines' )