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 /
1150 READ( nin, fmt =
'(A80)',
END = 380 )line
1152 nep =
lsamen( 3, path,
'NEP' ) .OR.
lsamen( 3, path,
'DHS' )
1153 sep =
lsamen( 3, path,
'SEP' ) .OR.
lsamen( 3, path,
'DST' ) .OR.
1154 $
lsamen( 3, path,
'DSG' )
1155 svd =
lsamen( 3, path,
'SVD' ) .OR.
lsamen( 3, path,
'DBD' )
1157 des =
lsamen( 3, path,
'DES' )
1158 dvx =
lsamen( 3, path,
'DVX' )
1159 dsx =
lsamen( 3, path,
'DSX' )
1160 dgg =
lsamen( 3, path,
'DGG' )
1161 dgs =
lsamen( 3, path,
'DGS' )
1162 dgx =
lsamen( 3, path,
'DGX' )
1163 dgv =
lsamen( 3, path,
'DGV' )
1164 dxv =
lsamen( 3, path,
'DXV' )
1165 dsb =
lsamen( 3, path,
'DSB' )
1166 dbb =
lsamen( 3, path,
'DBB' )
1167 glm =
lsamen( 3, path,
'GLM' )
1168 gqr =
lsamen( 3, path,
'GQR' ) .OR.
lsamen( 3, path,
'GRQ' )
1169 gsv =
lsamen( 3, path,
'GSV' )
1170 csd =
lsamen( 3, path,
'CSD' )
1172 dbl =
lsamen( 3, path,
'DBL' )
1173 dbk =
lsamen( 3, path,
'DBK' )
1174 dgl =
lsamen( 3, path,
'DGL' )
1175 dgk =
lsamen( 3, path,
'DGK' )
1179 IF( path.EQ.
' ' )
THEN
1182 WRITE( nout, fmt = 9987 )
1184 WRITE( nout, fmt = 9986 )
1186 WRITE( nout, fmt = 9985 )
1188 WRITE( nout, fmt = 9979 )
1190 WRITE( nout, fmt = 9978 )
1192 WRITE( nout, fmt = 9977 )
1194 WRITE( nout, fmt = 9976 )
1196 WRITE( nout, fmt = 9975 )
1198 WRITE( nout, fmt = 9964 )
1200 WRITE( nout, fmt = 9965 )
1202 WRITE( nout, fmt = 9963 )
1204 WRITE( nout, fmt = 9962 )
1206 WRITE( nout, fmt = 9974 )
1208 WRITE( nout, fmt = 9967 )
1210 WRITE( nout, fmt = 9971 )
1212 WRITE( nout, fmt = 9970 )
1214 WRITE( nout, fmt = 9969 )
1216 WRITE( nout, fmt = 9960 )
1218 WRITE( nout, fmt = 9968 )
1243 ELSE IF(
lsamen( 3, path,
'DEC' ) )
THEN
1247 READ( nin, fmt = * )thresh
1255 CALL
dchkec( thresh, tsterr, nin, nout )
1258 WRITE( nout, fmt = 9992 )path
1261 CALL
ilaver( vers_major, vers_minor, vers_patch )
1262 WRITE( nout, fmt = 9972 ) vers_major, vers_minor, vers_patch
1263 WRITE( nout, fmt = 9984 )
1267 READ( nin, fmt = * )nn
1269 WRITE( nout, fmt = 9989 )
' NN ', nn, 1
1272 ELSE IF( nn.GT.maxin )
THEN
1273 WRITE( nout, fmt = 9988 )
' NN ', nn, maxin
1280 IF( .NOT.( dgx .OR. dxv ) )
THEN
1281 READ( nin, fmt = * )( mval( i ), i = 1, nn )
1288 IF( mval( i ).LT.0 )
THEN
1289 WRITE( nout, fmt = 9989 )vname, mval( i ), 0
1291 ELSE IF( mval( i ).GT.nmax )
THEN
1292 WRITE( nout, fmt = 9988 )vname, mval( i ), nmax
1296 WRITE( nout, fmt = 9983 )
'M: ', ( mval( i ), i = 1, nn )
1301 IF( glm .OR. gqr .OR. gsv .OR. csd .OR.
lse )
THEN
1302 READ( nin, fmt = * )( pval( i ), i = 1, nn )
1304 IF( pval( i ).LT.0 )
THEN
1305 WRITE( nout, fmt = 9989 )
' P ', pval( i ), 0
1307 ELSE IF( pval( i ).GT.nmax )
THEN
1308 WRITE( nout, fmt = 9988 )
' P ', pval( i ), nmax
1312 WRITE( nout, fmt = 9983 )
'P: ', ( pval( i ), i = 1, nn )
1317 IF( svd .OR. dbb .OR. glm .OR. gqr .OR. gsv .OR. csd .OR.
1319 READ( nin, fmt = * )( nval( i ), i = 1, nn )
1321 IF( nval( i ).LT.0 )
THEN
1322 WRITE( nout, fmt = 9989 )
' N ', nval( i ), 0
1324 ELSE IF( nval( i ).GT.nmax )
THEN
1325 WRITE( nout, fmt = 9988 )
' N ', nval( i ), nmax
1331 nval( i ) = mval( i )
1334 IF( .NOT.( dgx .OR. dxv ) )
THEN
1335 WRITE( nout, fmt = 9983 )
'N: ', ( nval( i ), i = 1, nn )
1337 WRITE( nout, fmt = 9983 )
'N: ', nn
1342 IF( dsb .OR. dbb )
THEN
1343 READ( nin, fmt = * )nk
1344 READ( nin, fmt = * )( kval( i ), i = 1, nk )
1346 IF( kval( i ).LT.0 )
THEN
1347 WRITE( nout, fmt = 9989 )
' K ', kval( i ), 0
1349 ELSE IF( kval( i ).GT.nmax )
THEN
1350 WRITE( nout, fmt = 9988 )
' K ', kval( i ), nmax
1354 WRITE( nout, fmt = 9983 )
'K: ', ( kval( i ), i = 1, nk )
1357 IF(
dev .OR. des .OR. dvx .OR. dsx )
THEN
1362 READ( nin, fmt = * )nbval( 1 ), nbmin( 1 ), nxval( 1 ),
1363 $ inmin( 1 ), inwin( 1 ), inibl(1), ishfts(1), iacc22(1)
1364 IF( nbval( 1 ).LT.1 )
THEN
1365 WRITE( nout, fmt = 9989 )
' NB ', nbval( 1 ), 1
1367 ELSE IF( nbmin( 1 ).LT.1 )
THEN
1368 WRITE( nout, fmt = 9989 )
'NBMIN ', nbmin( 1 ), 1
1370 ELSE IF( nxval( 1 ).LT.1 )
THEN
1371 WRITE( nout, fmt = 9989 )
' NX ', nxval( 1 ), 1
1373 ELSE IF( inmin( 1 ).LT.1 )
THEN
1374 WRITE( nout, fmt = 9989 )
' INMIN ', inmin( 1 ), 1
1376 ELSE IF( inwin( 1 ).LT.1 )
THEN
1377 WRITE( nout, fmt = 9989 )
' INWIN ', inwin( 1 ), 1
1379 ELSE IF( inibl( 1 ).LT.1 )
THEN
1380 WRITE( nout, fmt = 9989 )
' INIBL ', inibl( 1 ), 1
1382 ELSE IF( ishfts( 1 ).LT.1 )
THEN
1383 WRITE( nout, fmt = 9989 )
' ISHFTS ', ishfts( 1 ), 1
1385 ELSE IF( iacc22( 1 ).LT.0 )
THEN
1386 WRITE( nout, fmt = 9989 )
' IACC22 ', iacc22( 1 ), 0
1389 CALL
xlaenv( 1, nbval( 1 ) )
1390 CALL
xlaenv( 2, nbmin( 1 ) )
1391 CALL
xlaenv( 3, nxval( 1 ) )
1392 CALL
xlaenv(12, max( 11, inmin( 1 ) ) )
1393 CALL
xlaenv(13, inwin( 1 ) )
1394 CALL
xlaenv(14, inibl( 1 ) )
1395 CALL
xlaenv(15, ishfts( 1 ) )
1396 CALL
xlaenv(16, iacc22( 1 ) )
1397 WRITE( nout, fmt = 9983 )
'NB: ', nbval( 1 )
1398 WRITE( nout, fmt = 9983 )
'NBMIN:', nbmin( 1 )
1399 WRITE( nout, fmt = 9983 )
'NX: ', nxval( 1 )
1400 WRITE( nout, fmt = 9983 )
'INMIN: ', inmin( 1 )
1401 WRITE( nout, fmt = 9983 )
'INWIN: ', inwin( 1 )
1402 WRITE( nout, fmt = 9983 )
'INIBL: ', inibl( 1 )
1403 WRITE( nout, fmt = 9983 )
'ISHFTS: ', ishfts( 1 )
1404 WRITE( nout, fmt = 9983 )
'IACC22: ', iacc22( 1 )
1406 ELSEIF( dgs .OR. dgx .OR. dgv .OR. dxv )
THEN
1411 READ( nin, fmt = * )nbval( 1 ), nbmin( 1 ), nxval( 1 ),
1412 $ nsval( 1 ), mxbval( 1 )
1413 IF( nbval( 1 ).LT.1 )
THEN
1414 WRITE( nout, fmt = 9989 )
' NB ', nbval( 1 ), 1
1416 ELSE IF( nbmin( 1 ).LT.1 )
THEN
1417 WRITE( nout, fmt = 9989 )
'NBMIN ', nbmin( 1 ), 1
1419 ELSE IF( nxval( 1 ).LT.1 )
THEN
1420 WRITE( nout, fmt = 9989 )
' NX ', nxval( 1 ), 1
1422 ELSE IF( nsval( 1 ).LT.2 )
THEN
1423 WRITE( nout, fmt = 9989 )
' NS ', nsval( 1 ), 2
1425 ELSE IF( mxbval( 1 ).LT.1 )
THEN
1426 WRITE( nout, fmt = 9989 )
' MAXB ', mxbval( 1 ), 1
1429 CALL
xlaenv( 1, nbval( 1 ) )
1430 CALL
xlaenv( 2, nbmin( 1 ) )
1431 CALL
xlaenv( 3, nxval( 1 ) )
1432 CALL
xlaenv( 4, nsval( 1 ) )
1433 CALL
xlaenv( 8, mxbval( 1 ) )
1434 WRITE( nout, fmt = 9983 )
'NB: ', nbval( 1 )
1435 WRITE( nout, fmt = 9983 )
'NBMIN:', nbmin( 1 )
1436 WRITE( nout, fmt = 9983 )
'NX: ', nxval( 1 )
1437 WRITE( nout, fmt = 9983 )
'NS: ', nsval( 1 )
1438 WRITE( nout, fmt = 9983 )
'MAXB: ', mxbval( 1 )
1440 ELSE IF( .NOT.dsb .AND. .NOT.glm .AND. .NOT.gqr .AND. .NOT.
1441 $ gsv .AND. .NOT.csd .AND. .NOT.
lse )
THEN
1446 READ( nin, fmt = * )nparms
1447 IF( nparms.LT.1 )
THEN
1448 WRITE( nout, fmt = 9989 )
'NPARMS', nparms, 1
1451 ELSE IF( nparms.GT.maxin )
THEN
1452 WRITE( nout, fmt = 9988 )
'NPARMS', nparms, maxin
1460 READ( nin, fmt = * )( nbval( i ), i = 1, nparms )
1462 IF( nbval( i ).LT.0 )
THEN
1463 WRITE( nout, fmt = 9989 )
' NB ', nbval( i ), 0
1465 ELSE IF( nbval( i ).GT.nmax )
THEN
1466 WRITE( nout, fmt = 9988 )
' NB ', nbval( i ), nmax
1470 WRITE( nout, fmt = 9983 )
'NB: ',
1471 $ ( nbval( i ), i = 1, nparms )
1476 IF( nep .OR. sep .OR. svd .OR. dgg )
THEN
1477 READ( nin, fmt = * )( nbmin( i ), i = 1, nparms )
1479 IF( nbmin( i ).LT.0 )
THEN
1480 WRITE( nout, fmt = 9989 )
'NBMIN ', nbmin( i ), 0
1482 ELSE IF( nbmin( i ).GT.nmax )
THEN
1483 WRITE( nout, fmt = 9988 )
'NBMIN ', nbmin( i ), nmax
1487 WRITE( nout, fmt = 9983 )
'NBMIN:',
1488 $ ( nbmin( i ), i = 1, nparms )
1497 IF( nep .OR. sep .OR. svd )
THEN
1498 READ( nin, fmt = * )( nxval( i ), i = 1, nparms )
1499 DO 100 i = 1, nparms
1500 IF( nxval( i ).LT.0 )
THEN
1501 WRITE( nout, fmt = 9989 )
' NX ', nxval( i ), 0
1503 ELSE IF( nxval( i ).GT.nmax )
THEN
1504 WRITE( nout, fmt = 9988 )
' NX ', nxval( i ), nmax
1508 WRITE( nout, fmt = 9983 )
'NX: ',
1509 $ ( nxval( i ), i = 1, nparms )
1511 DO 110 i = 1, nparms
1519 IF( svd .OR. dbb .OR. dgg )
THEN
1520 READ( nin, fmt = * )( nsval( i ), i = 1, nparms )
1521 DO 120 i = 1, nparms
1522 IF( nsval( i ).LT.0 )
THEN
1523 WRITE( nout, fmt = 9989 )
' NS ', nsval( i ), 0
1525 ELSE IF( nsval( i ).GT.nmax )
THEN
1526 WRITE( nout, fmt = 9988 )
' NS ', nsval( i ), nmax
1530 WRITE( nout, fmt = 9983 )
'NS: ',
1531 $ ( nsval( i ), i = 1, nparms )
1533 DO 130 i = 1, nparms
1541 READ( nin, fmt = * )( mxbval( i ), i = 1, nparms )
1542 DO 140 i = 1, nparms
1543 IF( mxbval( i ).LT.0 )
THEN
1544 WRITE( nout, fmt = 9989 )
' MAXB ', mxbval( i ), 0
1546 ELSE IF( mxbval( i ).GT.nmax )
THEN
1547 WRITE( nout, fmt = 9988 )
' MAXB ', mxbval( i ), nmax
1551 WRITE( nout, fmt = 9983 )
'MAXB: ',
1552 $ ( mxbval( i ), i = 1, nparms )
1554 DO 150 i = 1, nparms
1562 READ( nin, fmt = * )( inmin( i ), i = 1, nparms )
1563 DO 540 i = 1, nparms
1564 IF( inmin( i ).LT.0 )
THEN
1565 WRITE( nout, fmt = 9989 )
' INMIN ', inmin( i ), 0
1569 WRITE( nout, fmt = 9983 )
'INMIN: ',
1570 $ ( inmin( i ), i = 1, nparms )
1572 DO 550 i = 1, nparms
1580 READ( nin, fmt = * )( inwin( i ), i = 1, nparms )
1581 DO 560 i = 1, nparms
1582 IF( inwin( i ).LT.0 )
THEN
1583 WRITE( nout, fmt = 9989 )
' INWIN ', inwin( i ), 0
1587 WRITE( nout, fmt = 9983 )
'INWIN: ',
1588 $ ( inwin( i ), i = 1, nparms )
1590 DO 570 i = 1, nparms
1598 READ( nin, fmt = * )( inibl( i ), i = 1, nparms )
1599 DO 580 i = 1, nparms
1600 IF( inibl( i ).LT.0 )
THEN
1601 WRITE( nout, fmt = 9989 )
' INIBL ', inibl( i ), 0
1605 WRITE( nout, fmt = 9983 )
'INIBL: ',
1606 $ ( inibl( i ), i = 1, nparms )
1608 DO 590 i = 1, nparms
1616 READ( nin, fmt = * )( ishfts( i ), i = 1, nparms )
1617 DO 600 i = 1, nparms
1618 IF( ishfts( i ).LT.0 )
THEN
1619 WRITE( nout, fmt = 9989 )
' ISHFTS ', ishfts( i ), 0
1623 WRITE( nout, fmt = 9983 )
'ISHFTS: ',
1624 $ ( ishfts( i ), i = 1, nparms )
1626 DO 610 i = 1, nparms
1634 READ( nin, fmt = * )( iacc22( i ), i = 1, nparms )
1635 DO 620 i = 1, nparms
1636 IF( iacc22( i ).LT.0 )
THEN
1637 WRITE( nout, fmt = 9989 )
' IACC22 ', iacc22( i ), 0
1641 WRITE( nout, fmt = 9983 )
'IACC22: ',
1642 $ ( iacc22( i ), i = 1, nparms )
1644 DO 630 i = 1, nparms
1652 READ( nin, fmt = * )( nbcol( i ), i = 1, nparms )
1653 DO 160 i = 1, nparms
1654 IF( nbcol( i ).LT.0 )
THEN
1655 WRITE( nout, fmt = 9989 )
'NBCOL ', nbcol( i ), 0
1657 ELSE IF( nbcol( i ).GT.nmax )
THEN
1658 WRITE( nout, fmt = 9988 )
'NBCOL ', nbcol( i ), nmax
1662 WRITE( nout, fmt = 9983 )
'NBCOL:',
1663 $ ( nbcol( i ), i = 1, nparms )
1665 DO 170 i = 1, nparms
1673 WRITE( nout, fmt = * )
1674 eps =
dlamch(
'Underflow threshold' )
1675 WRITE( nout, fmt = 9981 )
'underflow', eps
1676 eps =
dlamch(
'Overflow threshold' )
1677 WRITE( nout, fmt = 9981 )
'overflow ', eps
1678 eps =
dlamch(
'Epsilon' )
1679 WRITE( nout, fmt = 9981 )
'precision', eps
1683 READ( nin, fmt = * )thresh
1684 WRITE( nout, fmt = 9982 )thresh
1685 IF( sep .OR. svd .OR. dgg )
THEN
1689 READ( nin, fmt = * )tstchk
1693 READ( nin, fmt = * )tstdrv
1698 READ( nin, fmt = * )tsterr
1702 READ( nin, fmt = * )newsd
1707 $
READ( nin, fmt = * )( ioldsd( i ), i = 1, 4 )
1710 iseed( i ) = ioldsd( i )
1714 WRITE( nout, fmt = 9999 )
1725 IF( .NOT.( dgx .OR. dxv ) )
THEN
1728 READ( nin, fmt =
'(A80)',
END = 380 )line
1736 IF( i.GT.lenp )
THEN
1744 IF( line( i: i ).NE.
' ' .AND. line( i: i ).NE.
',' )
THEN
1751 IF( c1.EQ.intstr( k: k ) )
THEN
1756 WRITE( nout, fmt = 9991 )i, line
1761 ELSE IF( i1.GT.0 )
THEN
1771 IF( .NOT.(
dev .OR. des .OR. dvx .OR. dsx .OR. dgv .OR.
1772 $ dgs ) .AND. ntypes.LE.0 )
THEN
1773 WRITE( nout, fmt = 9990 )c3
1786 IF( newsd.EQ.0 )
THEN
1788 iseed( k ) = ioldsd( k )
1792 IF(
lsamen( 3, c3,
'DHS' ) .OR.
lsamen( 3, c3,
'NEP' ) )
THEN
1805 ntypes = min( maxtyp, ntypes )
1806 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
1809 $ CALL
derrhs(
'DHSEQR', nout )
1810 DO 270 i = 1, nparms
1811 CALL
xlaenv( 1, nbval( i ) )
1812 CALL
xlaenv( 2, nbmin( i ) )
1813 CALL
xlaenv( 3, nxval( i ) )
1814 CALL
xlaenv(12, max( 11, inmin( i ) ) )
1815 CALL
xlaenv(13, inwin( i ) )
1816 CALL
xlaenv(14, inibl( i ) )
1817 CALL
xlaenv(15, ishfts( i ) )
1818 CALL
xlaenv(16, iacc22( i ) )
1820 IF( newsd.EQ.0 )
THEN
1822 iseed( k ) = ioldsd( k )
1825 WRITE( nout, fmt = 9961 )c3, nbval( i ), nbmin( i ),
1826 $ nxval( i ), max( 11, inmin(i)),
1827 $ inwin( i ), inibl( i ), ishfts( i ), iacc22( i )
1828 CALL
dchkhs( nn, nval, maxtyp, dotype, iseed, thresh, nout,
1829 $ a( 1, 1 ), nmax, a( 1, 2 ), a( 1, 3 ),
1830 $ a( 1, 4 ), a( 1, 5 ), nmax, a( 1, 6 ),
1831 $ a( 1, 7 ), d( 1, 1 ), d( 1, 2 ), d( 1, 3 ),
1832 $ d( 1, 4 ), a( 1, 8 ), a( 1, 9 ), a( 1, 10 ),
1833 $ a( 1, 11 ), a( 1, 12 ), d( 1, 5 ), work, lwork,
1834 $ iwork, logwrk, result, info )
1836 $
WRITE( nout, fmt = 9980 )
'DCHKHS', info
1839 ELSE IF(
lsamen( 3, c3,
'DST' ) .OR.
lsamen( 3, c3,
'SEP' ) )
THEN
1850 ntypes = min( maxtyp, ntypes )
1851 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
1855 $ CALL
derrst(
'DST', nout )
1856 DO 290 i = 1, nparms
1857 CALL
xlaenv( 1, nbval( i ) )
1858 CALL
xlaenv( 2, nbmin( i ) )
1859 CALL
xlaenv( 3, nxval( i ) )
1861 IF( newsd.EQ.0 )
THEN
1863 iseed( k ) = ioldsd( k )
1866 WRITE( nout, fmt = 9997 )c3, nbval( i ), nbmin( i ),
1869 CALL
dchkst( nn, nval, maxtyp, dotype, iseed, thresh,
1870 $ nout, a( 1, 1 ), nmax, a( 1, 2 ), d( 1, 1 ),
1871 $ d( 1, 2 ), d( 1, 3 ), d( 1, 4 ), d( 1, 5 ),
1872 $ d( 1, 6 ), d( 1, 7 ), d( 1, 8 ), d( 1, 9 ),
1873 $ d( 1, 10 ), d( 1, 11 ), a( 1, 3 ), nmax,
1874 $ a( 1, 4 ), a( 1, 5 ), d( 1, 12 ), a( 1, 6 ),
1875 $ work, lwork, iwork, liwork, result, info )
1877 $
WRITE( nout, fmt = 9980 )
'DCHKST', info
1880 CALL
ddrvst( nn, nval, 18, dotype, iseed, thresh, nout,
1881 $ a( 1, 1 ), nmax, d( 1, 3 ), d( 1, 4 ),
1882 $ d( 1, 5 ), d( 1, 6 ), d( 1, 8 ), d( 1, 9 ),
1883 $ d( 1, 10 ), d( 1, 11 ), a( 1, 2 ), nmax,
1884 $ a( 1, 3 ), d( 1, 12 ), a( 1, 4 ), work,
1885 $ lwork, iwork, liwork, result, info )
1887 $
WRITE( nout, fmt = 9980 )
'DDRVST', info
1891 ELSE IF(
lsamen( 3, c3,
'DSG' ) )
THEN
1902 ntypes = min( maxtyp, ntypes )
1903 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
1905 DO 310 i = 1, nparms
1906 CALL
xlaenv( 1, nbval( i ) )
1907 CALL
xlaenv( 2, nbmin( i ) )
1908 CALL
xlaenv( 3, nxval( i ) )
1910 IF( newsd.EQ.0 )
THEN
1912 iseed( k ) = ioldsd( k )
1915 WRITE( nout, fmt = 9997 )c3, nbval( i ), nbmin( i ),
1918 CALL
ddrvsg( nn, nval, maxtyp, dotype, iseed, thresh,
1919 $ nout, a( 1, 1 ), nmax, a( 1, 2 ), nmax,
1920 $ d( 1, 3 ), a( 1, 3 ), nmax, a( 1, 4 ),
1921 $ a( 1, 5 ), a( 1, 6 ), a( 1, 7 ), work,
1922 $ lwork, iwork, liwork, result, info )
1924 $
WRITE( nout, fmt = 9980 )
'DDRVSG', info
1928 ELSE IF(
lsamen( 3, c3,
'DBD' ) .OR.
lsamen( 3, c3,
'SVD' ) )
THEN
1940 ntypes = min( maxtyp, ntypes )
1941 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
1947 IF( tsterr .AND. tstchk )
1948 $ CALL
derrbd(
'DBD', nout )
1949 IF( tsterr .AND. tstdrv )
1950 $ CALL
derred(
'DBD', nout )
1952 DO 330 i = 1, nparms
1954 CALL
xlaenv( 1, nbval( i ) )
1955 CALL
xlaenv( 2, nbmin( i ) )
1956 CALL
xlaenv( 3, nxval( i ) )
1957 IF( newsd.EQ.0 )
THEN
1959 iseed( k ) = ioldsd( k )
1962 WRITE( nout, fmt = 9995 )c3, nbval( i ), nbmin( i ),
1965 CALL
dchkbd( nn, mval, nval, maxtyp, dotype, nrhs, iseed,
1966 $ thresh, a( 1, 1 ), nmax, d( 1, 1 ),
1967 $ d( 1, 2 ), d( 1, 3 ), d( 1, 4 ), a( 1, 2 ),
1968 $ nmax, a( 1, 3 ), a( 1, 4 ), a( 1, 5 ), nmax,
1969 $ a( 1, 6 ), nmax, a( 1, 7 ), a( 1, 8 ), work,
1970 $ lwork, iwork, nout, info )
1972 $
WRITE( nout, fmt = 9980 )
'DCHKBD', info
1975 $ CALL
ddrvbd( nn, mval, nval, maxtyp, dotype, iseed,
1976 $ thresh, a( 1, 1 ), nmax, a( 1, 2 ), nmax,
1977 $ a( 1, 3 ), nmax, a( 1, 4 ), a( 1, 5 ),
1978 $ a( 1, 6 ), d( 1, 1 ), d( 1, 2 ), d( 1, 3 ),
1979 $ work, lwork, iwork, nout, info )
1982 ELSE IF(
lsamen( 3, c3,
'DEV' ) )
THEN
1990 ntypes = min( maxtyp, ntypes )
1991 IF( ntypes.LE.0 )
THEN
1992 WRITE( nout, fmt = 9990 )c3
1995 $ CALL
derred( c3, nout )
1996 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
1997 CALL
ddrvev( nn, nval, ntypes, dotype, iseed, thresh, nout,
1998 $ a( 1, 1 ), nmax, a( 1, 2 ), d( 1, 1 ),
1999 $ d( 1, 2 ), d( 1, 3 ), d( 1, 4 ), a( 1, 3 ),
2000 $ nmax, a( 1, 4 ), nmax, a( 1, 5 ), nmax, result,
2001 $ work, lwork, iwork, info )
2003 $
WRITE( nout, fmt = 9980 )
'DGEEV', info
2005 WRITE( nout, fmt = 9973 )
2008 ELSE IF(
lsamen( 3, c3,
'DES' ) )
THEN
2016 ntypes = min( maxtyp, ntypes )
2017 IF( ntypes.LE.0 )
THEN
2018 WRITE( nout, fmt = 9990 )c3
2021 $ CALL
derred( c3, nout )
2022 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2023 CALL
ddrves( nn, nval, ntypes, dotype, iseed, thresh, nout,
2024 $ a( 1, 1 ), nmax, a( 1, 2 ), a( 1, 3 ),
2025 $ d( 1, 1 ), d( 1, 2 ), d( 1, 3 ), d( 1, 4 ),
2026 $ a( 1, 4 ), nmax, result, work, lwork, iwork,
2029 $
WRITE( nout, fmt = 9980 )
'DGEES', info
2031 WRITE( nout, fmt = 9973 )
2034 ELSE IF(
lsamen( 3, c3,
'DVX' ) )
THEN
2042 ntypes = min( maxtyp, ntypes )
2043 IF( ntypes.LT.0 )
THEN
2044 WRITE( nout, fmt = 9990 )c3
2047 $ CALL
derred( c3, nout )
2048 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2049 CALL
ddrvvx( nn, nval, ntypes, dotype, iseed, thresh, nin,
2050 $ nout, a( 1, 1 ), nmax, a( 1, 2 ), d( 1, 1 ),
2051 $ d( 1, 2 ), d( 1, 3 ), d( 1, 4 ), a( 1, 3 ),
2052 $ nmax, a( 1, 4 ), nmax, a( 1, 5 ), nmax,
2053 $ d( 1, 5 ), d( 1, 6 ), d( 1, 7 ), d( 1, 8 ),
2054 $ d( 1, 9 ), d( 1, 10 ), d( 1, 11 ), d( 1, 12 ),
2055 $ result, work, lwork, iwork, info )
2057 $
WRITE( nout, fmt = 9980 )
'DGEEVX', info
2059 WRITE( nout, fmt = 9973 )
2062 ELSE IF(
lsamen( 3, c3,
'DSX' ) )
THEN
2070 ntypes = min( maxtyp, ntypes )
2071 IF( ntypes.LT.0 )
THEN
2072 WRITE( nout, fmt = 9990 )c3
2075 $ CALL
derred( c3, nout )
2076 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2077 CALL
ddrvsx( nn, nval, ntypes, dotype, iseed, thresh, nin,
2078 $ nout, a( 1, 1 ), nmax, a( 1, 2 ), a( 1, 3 ),
2079 $ d( 1, 1 ), d( 1, 2 ), d( 1, 3 ), d( 1, 4 ),
2080 $ d( 1, 5 ), d( 1, 6 ), a( 1, 4 ), nmax,
2081 $ a( 1, 5 ), result, work, lwork, iwork, logwrk,
2084 $
WRITE( nout, fmt = 9980 )
'DGEESX', info
2086 WRITE( nout, fmt = 9973 )
2089 ELSE IF(
lsamen( 3, c3,
'DGG' ) )
THEN
2102 ntypes = min( maxtyp, ntypes )
2103 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2104 IF( tstchk .AND. tsterr )
2105 $ CALL
derrgg( c3, nout )
2106 DO 350 i = 1, nparms
2107 CALL
xlaenv( 1, nbval( i ) )
2108 CALL
xlaenv( 2, nbmin( i ) )
2109 CALL
xlaenv( 4, nsval( i ) )
2110 CALL
xlaenv( 8, mxbval( i ) )
2111 CALL
xlaenv( 5, nbcol( i ) )
2113 IF( newsd.EQ.0 )
THEN
2115 iseed( k ) = ioldsd( k )
2118 WRITE( nout, fmt = 9996 )c3, nbval( i ), nbmin( i ),
2119 $ nsval( i ), mxbval( i ), nbcol( i )
2123 CALL
dchkgg( nn, nval, maxtyp, dotype, iseed, thresh,
2124 $ tstdif, thrshn, nout, a( 1, 1 ), nmax,
2125 $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), a( 1, 5 ),
2126 $ a( 1, 6 ), a( 1, 7 ), a( 1, 8 ), a( 1, 9 ),
2127 $ nmax, a( 1, 10 ), a( 1, 11 ), a( 1, 12 ),
2128 $ d( 1, 1 ), d( 1, 2 ), d( 1, 3 ), d( 1, 4 ),
2129 $ d( 1, 5 ), d( 1, 6 ), a( 1, 13 ),
2130 $ a( 1, 14 ), work, lwork, logwrk, result,
2133 $
WRITE( nout, fmt = 9980 )
'DCHKGG', info
2137 CALL
ddrvgg( nn, nval, maxtyp, dotype, iseed, thresh,
2138 $ thrshn, nout, a( 1, 1 ), nmax, a( 1, 2 ),
2139 $ a( 1, 3 ), a( 1, 4 ), a( 1, 5 ), a( 1, 6 ),
2140 $ a( 1, 7 ), nmax, a( 1, 8 ), d( 1, 1 ),
2141 $ d( 1, 2 ), d( 1, 3 ), d( 1, 4 ), d( 1, 5 ),
2142 $ d( 1, 6 ), a( 1, 13 ), a( 1, 14 ), work,
2143 $ lwork, result, info )
2145 $
WRITE( nout, fmt = 9980 )
'DDRVGG', info
2149 ELSE IF(
lsamen( 3, c3,
'DGS' ) )
THEN
2157 ntypes = min( maxtyp, ntypes )
2158 IF( ntypes.LE.0 )
THEN
2159 WRITE( nout, fmt = 9990 )c3
2162 $ CALL
derrgg( c3, nout )
2163 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2164 CALL
ddrges( nn, nval, maxtyp, dotype, iseed, thresh, nout,
2165 $ a( 1, 1 ), nmax, a( 1, 2 ), a( 1, 3 ),
2166 $ a( 1, 4 ), a( 1, 7 ), nmax, a( 1, 8 ),
2167 $ d( 1, 1 ), d( 1, 2 ), d( 1, 3 ), work, lwork,
2168 $ result, logwrk, info )
2171 $
WRITE( nout, fmt = 9980 )
'DDRGES', info
2173 WRITE( nout, fmt = 9973 )
2186 WRITE( nout, fmt = 9990 )c3
2189 $ CALL
derrgg( c3, nout )
2190 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2192 CALL
ddrgsx( nn, ncmax, thresh, nin, nout, a( 1, 1 ), nmax,
2193 $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), a( 1, 5 ),
2194 $ a( 1, 6 ), d( 1, 1 ), d( 1, 2 ), d( 1, 3 ),
2195 $ c( 1, 1 ), ncmax*ncmax, a( 1, 12 ), work,
2196 $ lwork, iwork, liwork, logwrk, info )
2198 $
WRITE( nout, fmt = 9980 )
'DDRGSX', info
2200 WRITE( nout, fmt = 9973 )
2203 ELSE IF(
lsamen( 3, c3,
'DGV' ) )
THEN
2211 ntypes = min( maxtyp, ntypes )
2212 IF( ntypes.LE.0 )
THEN
2213 WRITE( nout, fmt = 9990 )c3
2216 $ CALL
derrgg( c3, nout )
2217 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2218 CALL
ddrgev( nn, nval, maxtyp, dotype, iseed, thresh, nout,
2219 $ a( 1, 1 ), nmax, a( 1, 2 ), a( 1, 3 ),
2220 $ a( 1, 4 ), a( 1, 7 ), nmax, a( 1, 8 ),
2221 $ a( 1, 9 ), nmax, d( 1, 1 ), d( 1, 2 ),
2222 $ d( 1, 3 ), d( 1, 4 ), d( 1, 5 ), d( 1, 6 ),
2223 $ work, lwork, result, info )
2225 $
WRITE( nout, fmt = 9980 )
'DDRGEV', info
2227 WRITE( nout, fmt = 9973 )
2240 WRITE( nout, fmt = 9990 )c3
2243 $ CALL
derrgg( c3, nout )
2244 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2245 CALL
ddrgvx( nn, thresh, nin, nout, a( 1, 1 ), nmax,
2246 $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), d( 1, 1 ),
2247 $ d( 1, 2 ), d( 1, 3 ), a( 1, 5 ), a( 1, 6 ),
2248 $ iwork( 1 ), iwork( 2 ), d( 1, 4 ), d( 1, 5 ),
2249 $ d( 1, 6 ), d( 1, 7 ), d( 1, 8 ), d( 1, 9 ),
2250 $ work, lwork, iwork( 3 ), liwork-2, result,
2254 $
WRITE( nout, fmt = 9980 )
'DDRGVX', info
2256 WRITE( nout, fmt = 9973 )
2259 ELSE IF(
lsamen( 3, c3,
'DSB' ) )
THEN
2266 ntypes = min( maxtyp, ntypes )
2267 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2269 $ CALL
derrst(
'DSB', nout )
2270 CALL
dchksb( nn, nval, nk, kval, maxtyp, dotype, iseed, thresh,
2271 $ nout, a( 1, 1 ), nmax, d( 1, 1 ), d( 1, 2 ),
2272 $ a( 1, 2 ), nmax, work, lwork, result, info )
2274 $
WRITE( nout, fmt = 9980 )
'DCHKSB', info
2276 ELSE IF(
lsamen( 3, c3,
'DBB' ) )
THEN
2283 ntypes = min( maxtyp, ntypes )
2284 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2285 DO 370 i = 1, nparms
2288 IF( newsd.EQ.0 )
THEN
2290 iseed( k ) = ioldsd( k )
2293 WRITE( nout, fmt = 9966 )c3, nrhs
2294 CALL
dchkbb( nn, mval, nval, nk, kval, maxtyp, dotype, nrhs,
2295 $ iseed, thresh, nout, a( 1, 1 ), nmax,
2296 $ a( 1, 2 ), 2*nmax, d( 1, 1 ), d( 1, 2 ),
2297 $ a( 1, 4 ), nmax, a( 1, 5 ), nmax, a( 1, 6 ),
2298 $ nmax, a( 1, 7 ), work, lwork, result, info )
2300 $
WRITE( nout, fmt = 9980 )
'DCHKBB', info
2303 ELSE IF(
lsamen( 3, c3,
'GLM' ) )
THEN
2311 $ CALL
derrgg(
'GLM', nout )
2312 CALL
dckglm( nn, mval, pval, nval, ntypes, iseed, thresh, nmax,
2313 $ a( 1, 1 ), a( 1, 2 ),
b( 1, 1 ),
b( 1, 2 ), x,
2314 $ work, d( 1, 1 ), nin, nout, info )
2316 $
WRITE( nout, fmt = 9980 )
'DCKGLM', info
2318 ELSE IF(
lsamen( 3, c3,
'GQR' ) )
THEN
2326 $ CALL
derrgg(
'GQR', nout )
2327 CALL
dckgqr( nn, mval, nn, pval, nn, nval, ntypes, iseed,
2328 $ thresh, nmax, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
2329 $ a( 1, 4 ), taua,
b( 1, 1 ),
b( 1, 2 ),
b( 1, 3 ),
2330 $
b( 1, 4 ),
b( 1, 5 ), taub, work, d( 1, 1 ), nin,
2333 $
WRITE( nout, fmt = 9980 )
'DCKGQR', info
2335 ELSE IF(
lsamen( 3, c3,
'GSV' ) )
THEN
2342 $ CALL
derrgg(
'GSV', nout )
2343 CALL
dckgsv( nn, mval, pval, nval, ntypes, iseed, thresh, nmax,
2344 $ a( 1, 1 ), a( 1, 2 ),
b( 1, 1 ),
b( 1, 2 ),
2345 $ a( 1, 3 ),
b( 1, 3 ), a( 1, 4 ), taua, taub,
2346 $
b( 1, 4 ), iwork, work, d( 1, 1 ), nin, nout,
2349 $
WRITE( nout, fmt = 9980 )
'DCKGSV', info
2351 ELSE IF(
lsamen( 3, c3,
'CSD' ) )
THEN
2359 $ CALL
derrgg(
'CSD', nout )
2360 CALL
dckcsd( nn, mval, pval, nval, ntypes, iseed, thresh, nmax,
2361 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), a( 1, 4 ),
2362 $ a( 1, 5 ), a( 1, 6 ), a( 1, 7 ), iwork, work,
2363 $ d( 1, 1 ), nin, nout, info )
2365 $
WRITE( nout, fmt = 9980 )
'DCKCSD', info
2367 ELSE IF(
lsamen( 3, c3,
'LSE' ) )
THEN
2375 $ CALL
derrgg(
'LSE', nout )
2376 CALL
dcklse( nn, mval, pval, nval, ntypes, iseed, thresh, nmax,
2377 $ a( 1, 1 ), a( 1, 2 ),
b( 1, 1 ),
b( 1, 2 ), x,
2378 $ work, d( 1, 1 ), nin, nout, info )
2380 $
WRITE( nout, fmt = 9980 )
'DCKLSE', info
2383 WRITE( nout, fmt = * )
2384 WRITE( nout, fmt = * )
2385 WRITE( nout, fmt = 9992 )c3
2387 IF( .NOT.( dgx .OR. dxv ) )
2390 WRITE( nout, fmt = 9994 )
2392 WRITE( nout, fmt = 9993 )s2 - s1
2394 9999
FORMAT( /
' Execution not attempted due to input errors' )
2395 9997
FORMAT( / / 1x, a3,
': NB =', i4,
', NBMIN =', i4,
', NX =', i4 )
2396 9996
FORMAT( / / 1x, a3,
': NB =', i4,
', NBMIN =', i4,
', NS =', i4,
2397 $
', MAXB =', i4,
', NBCOL =', i4 )
2398 9995
FORMAT( / / 1x, a3,
': NB =', i4,
', NBMIN =', i4,
', NX =', i4,
2400 9994
FORMAT( / /
' End of tests' )
2401 9993
FORMAT(
' Total time used = ', f12.2,
' seconds', / )
2402 9992
FORMAT( 1x, a3,
': Unrecognized path name' )
2403 9991
FORMAT( / /
' *** Invalid integer value in column ', i2,
2404 $
' of input',
' line:', / a79 )
2405 9990
FORMAT( / / 1x, a3,
' routines were not tested' )
2406 9989
FORMAT(
' Invalid input value: ', a,
'=', i6,
'; must be >=',
2408 9988
FORMAT(
' Invalid input value: ', a,
'=', i6,
'; must be <=',
2410 9987
FORMAT(
' Tests of the Nonsymmetric Eigenvalue Problem routines' )
2411 9986
FORMAT(
' Tests of the Symmetric Eigenvalue Problem routines' )
2412 9985
FORMAT(
' Tests of the Singular Value Decomposition routines' )
2413 9984
FORMAT( /
' The following parameter values will be used:' )
2414 9983
FORMAT( 4x, a, 10i6, / 10x, 10i6 )
2415 9982
FORMAT( /
' Routines pass computational tests if test ratio is ',
2416 $
'less than', f8.2, / )
2417 9981
FORMAT(
' Relative machine ', a,
' is taken to be', d16.6 )
2418 9980
FORMAT(
' *** Error code from ', a,
' = ', i4 )
2419 9979
FORMAT( /
' Tests of the Nonsymmetric Eigenvalue Problem Driver',
2420 $ /
' DGEEV (eigenvalues and eigevectors)' )
2421 9978
FORMAT( /
' Tests of the Nonsymmetric Eigenvalue Problem Driver',
2422 $ /
' DGEES (Schur form)' )
2423 9977
FORMAT( /
' Tests of the Nonsymmetric Eigenvalue Problem Expert',
2424 $
' Driver', /
' DGEEVX (eigenvalues, eigenvectors and',
2425 $
' condition numbers)' )
2426 9976
FORMAT( /
' Tests of the Nonsymmetric Eigenvalue Problem Expert',
2427 $
' Driver', /
' DGEESX (Schur form and condition',
2429 9975
FORMAT( /
' Tests of the Generalized Nonsymmetric Eigenvalue ',
2430 $
'Problem routines' )
2431 9974
FORMAT(
' Tests of DSBTRD', /
' (reduction of a symmetric band ',
2432 $
'matrix to tridiagonal form)' )
2433 9973
FORMAT( / 1x, 71(
'-' ) )
2434 9972
FORMAT( /
' LAPACK VERSION ', i1,
'.', i1,
'.', i1 )
2435 9971
FORMAT( /
' Tests of the Generalized Linear Regression Model ',
2437 9970
FORMAT( /
' Tests of the Generalized QR and RQ routines' )
2438 9969
FORMAT( /
' Tests of the Generalized Singular Value',
2439 $
' Decomposition routines' )
2440 9968
FORMAT( /
' Tests of the Linear Least Squares routines' )
2441 9967
FORMAT(
' Tests of DGBBRD', /
' (reduction of a general band ',
2442 $
'matrix to real bidiagonal form)' )
2443 9966
FORMAT( / / 1x, a3,
': NRHS =', i4 )
2444 9965
FORMAT( /
' Tests of the Generalized Nonsymmetric Eigenvalue ',
2445 $
'Problem Expert Driver DGGESX' )
2446 9964
FORMAT( /
' Tests of the Generalized Nonsymmetric Eigenvalue ',
2447 $
'Problem Driver DGGES' )
2448 9963
FORMAT( /
' Tests of the Generalized Nonsymmetric Eigenvalue ',
2449 $
'Problem Driver DGGEV' )
2450 9962
FORMAT( /
' Tests of the Generalized Nonsymmetric Eigenvalue ',
2451 $
'Problem Expert Driver DGGEVX' )
2452 9961
FORMAT( / / 1x, a3,
': NB =', i4,
', NBMIN =', i4,
', NX =', i4,
2454 $
', INWIN =', i4,
', INIBL =', i4,
', ISHFTS =', i4,
2456 9960
FORMAT( /
' Tests of the CS Decomposition routines' )