1045 parameter( nmax = 132 )
1047 parameter( ncmax = 20 )
1049 parameter( need = 14 )
1051 parameter( lwork = nmax*( 5*nmax+20 ) )
1053 parameter( liwork = nmax*( nmax+20 ) )
1055 parameter( maxin = 20 )
1057 parameter( maxt = 30 )
1059 parameter( nin = 5, nout = 6 )
1062 LOGICAL zbk, zbl, zes, zev, zgk, zgl, zgs, zgv, zgx,
1063 $ zsx, zvx, zxv, csd, fatal, glm, gqr, gsv,
lse,
1064 $ nep, sep, svd, tstchk, tstdif, tstdrv, tsterr,
1067 CHARACTER*3 c3, path
1071 INTEGER i, i1, ic, info, itmp, k, lenp, maxtyp, newsd,
1072 $ nk, nn, nparms, nrhs, ntypes,
1073 $ vers_major, vers_minor, vers_patch
1074 DOUBLE PRECISION eps, s1, s2, thresh, thrshn
1077 LOGICAL dotype( maxt ), logwrk( nmax )
1078 INTEGER ioldsd( 4 ), iseed( 4 ), iwork( liwork ),
1079 $ kval( maxin ), mval( maxin ), mxbval( maxin ),
1080 $ nbcol( maxin ), nbmin( maxin ), nbval( maxin ),
1081 $ nsval( maxin ), nval( maxin ), nxval( maxin ),
1083 INTEGER inmin( maxin ), inwin( maxin ), inibl( maxin ),
1084 $ ishfts( maxin ), iacc22( maxin )
1085 DOUBLE PRECISION alpha( nmax ), beta( nmax ), dr( nmax, 12 ),
1086 $ result( 500 ), rwork( lwork ), s( nmax*nmax )
1087 COMPLEX*16 a( nmax*nmax, need ),
b( nmax*nmax, 5 ),
1088 $ c( ncmax*ncmax, ncmax*ncmax ), dc( nmax, 6 ),
1089 $ taua( nmax ), taub( nmax ), work( lwork ),
1111 INTEGER infot, maxb, nproc, nshift, nunit, seldim,
1115 LOGICAL selval( 20 )
1116 INTEGER iparms( 100 )
1117 DOUBLE PRECISION selwi( 20 ), selwr( 20 )
1120 COMMON / cenvir / nproc, nshift, maxb
1121 COMMON / infoc / infot, nunit, ok, lerr
1122 COMMON / srnamc / srnamt
1123 COMMON / sslct / selopt, seldim, selval, selwr, selwi
1124 COMMON / claenv / iparms
1127 DATA intstr /
'0123456789' /
1128 DATA ioldsd / 0, 0, 0, 1 /
1146 READ( nin, fmt =
'(A80)',
END = 380 )line
1148 nep =
lsamen( 3, path,
'NEP' ) .OR.
lsamen( 3, path,
'ZHS' )
1149 sep =
lsamen( 3, path,
'SEP' ) .OR.
lsamen( 3, path,
'ZST' ) .OR.
1150 $
lsamen( 3, path,
'ZSG' )
1151 svd =
lsamen( 3, path,
'SVD' ) .OR.
lsamen( 3, path,
'ZBD' )
1152 zev =
lsamen( 3, path,
'ZEV' )
1153 zes =
lsamen( 3, path,
'ZES' )
1154 zvx =
lsamen( 3, path,
'ZVX' )
1155 zsx =
lsamen( 3, path,
'ZSX' )
1156 zgg =
lsamen( 3, path,
'ZGG' )
1157 zgs =
lsamen( 3, path,
'ZGS' )
1158 zgx =
lsamen( 3, path,
'ZGX' )
1159 zgv =
lsamen( 3, path,
'ZGV' )
1160 zxv =
lsamen( 3, path,
'ZXV' )
1161 zhb =
lsamen( 3, path,
'ZHB' )
1162 zbb =
lsamen( 3, path,
'ZBB' )
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 zbl =
lsamen( 3, path,
'ZBL' )
1169 zbk =
lsamen( 3, path,
'ZBK' )
1170 zgl =
lsamen( 3, path,
'ZGL' )
1171 zgk =
lsamen( 3, path,
'ZGK' )
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,
'ZEC' ) )
THEN
1243 READ( nin, fmt = * )thresh
1247 CALL
zchkec( thresh, tsterr, nin, nout )
1250 WRITE( nout, fmt = 9992 )path
1253 CALL
ilaver( vers_major, vers_minor, vers_patch )
1254 WRITE( nout, fmt = 9972 ) vers_major, vers_minor, vers_patch
1255 WRITE( nout, fmt = 9984 )
1259 READ( nin, fmt = * )nn
1261 WRITE( nout, fmt = 9989 )
' NN ', nn, 1
1264 ELSE IF( nn.GT.maxin )
THEN
1265 WRITE( nout, fmt = 9988 )
' NN ', nn, maxin
1272 IF( .NOT.( zgx .OR. zxv ) )
THEN
1273 READ( nin, fmt = * )( mval( i ), i = 1, nn )
1280 IF( mval( i ).LT.0 )
THEN
1281 WRITE( nout, fmt = 9989 )vname, mval( i ), 0
1283 ELSE IF( mval( i ).GT.nmax )
THEN
1284 WRITE( nout, fmt = 9988 )vname, mval( i ), nmax
1288 WRITE( nout, fmt = 9983 )
'M: ', ( mval( i ), i = 1, nn )
1293 IF( glm .OR. gqr .OR. gsv .OR. csd .OR.
lse )
THEN
1294 READ( nin, fmt = * )( pval( i ), i = 1, nn )
1296 IF( pval( i ).LT.0 )
THEN
1297 WRITE( nout, fmt = 9989 )
' P ', pval( i ), 0
1299 ELSE IF( pval( i ).GT.nmax )
THEN
1300 WRITE( nout, fmt = 9988 )
' P ', pval( i ), nmax
1304 WRITE( nout, fmt = 9983 )
'P: ', ( pval( i ), i = 1, nn )
1309 IF( svd .OR. zbb .OR. glm .OR. gqr .OR. gsv .OR. csd .OR.
1311 READ( nin, fmt = * )( nval( i ), i = 1, nn )
1313 IF( nval( i ).LT.0 )
THEN
1314 WRITE( nout, fmt = 9989 )
' N ', nval( i ), 0
1316 ELSE IF( nval( i ).GT.nmax )
THEN
1317 WRITE( nout, fmt = 9988 )
' N ', nval( i ), nmax
1323 nval( i ) = mval( i )
1326 IF( .NOT.( zgx .OR. zxv ) )
THEN
1327 WRITE( nout, fmt = 9983 )
'N: ', ( nval( i ), i = 1, nn )
1329 WRITE( nout, fmt = 9983 )
'N: ', nn
1334 IF( zhb .OR. zbb )
THEN
1335 READ( nin, fmt = * )nk
1336 READ( nin, fmt = * )( kval( i ), i = 1, nk )
1338 IF( kval( i ).LT.0 )
THEN
1339 WRITE( nout, fmt = 9989 )
' K ', kval( i ), 0
1341 ELSE IF( kval( i ).GT.nmax )
THEN
1342 WRITE( nout, fmt = 9988 )
' K ', kval( i ), nmax
1346 WRITE( nout, fmt = 9983 )
'K: ', ( kval( i ), i = 1, nk )
1349 IF( zev .OR. zes .OR. zvx .OR. zsx )
THEN
1354 READ( nin, fmt = * )nbval( 1 ), nbmin( 1 ), nxval( 1 ),
1355 $ inmin( 1 ), inwin( 1 ), inibl(1), ishfts(1), iacc22(1)
1356 IF( nbval( 1 ).LT.1 )
THEN
1357 WRITE( nout, fmt = 9989 )
' NB ', nbval( 1 ), 1
1359 ELSE IF( nbmin( 1 ).LT.1 )
THEN
1360 WRITE( nout, fmt = 9989 )
'NBMIN ', nbmin( 1 ), 1
1362 ELSE IF( nxval( 1 ).LT.1 )
THEN
1363 WRITE( nout, fmt = 9989 )
' NX ', nxval( 1 ), 1
1365 ELSE IF( inmin( 1 ).LT.1 )
THEN
1366 WRITE( nout, fmt = 9989 )
' INMIN ', inmin( 1 ), 1
1368 ELSE IF( inwin( 1 ).LT.1 )
THEN
1369 WRITE( nout, fmt = 9989 )
' INWIN ', inwin( 1 ), 1
1371 ELSE IF( inibl( 1 ).LT.1 )
THEN
1372 WRITE( nout, fmt = 9989 )
' INIBL ', inibl( 1 ), 1
1374 ELSE IF( ishfts( 1 ).LT.1 )
THEN
1375 WRITE( nout, fmt = 9989 )
' ISHFTS ', ishfts( 1 ), 1
1377 ELSE IF( iacc22( 1 ).LT.0 )
THEN
1378 WRITE( nout, fmt = 9989 )
' IACC22 ', iacc22( 1 ), 0
1381 CALL
xlaenv( 1, nbval( 1 ) )
1382 CALL
xlaenv( 2, nbmin( 1 ) )
1383 CALL
xlaenv( 3, nxval( 1 ) )
1384 CALL
xlaenv(12, max( 11, inmin( 1 ) ) )
1385 CALL
xlaenv(13, inwin( 1 ) )
1386 CALL
xlaenv(14, inibl( 1 ) )
1387 CALL
xlaenv(15, ishfts( 1 ) )
1388 CALL
xlaenv(16, iacc22( 1 ) )
1389 WRITE( nout, fmt = 9983 )
'NB: ', nbval( 1 )
1390 WRITE( nout, fmt = 9983 )
'NBMIN:', nbmin( 1 )
1391 WRITE( nout, fmt = 9983 )
'NX: ', nxval( 1 )
1392 WRITE( nout, fmt = 9983 )
'INMIN: ', inmin( 1 )
1393 WRITE( nout, fmt = 9983 )
'INWIN: ', inwin( 1 )
1394 WRITE( nout, fmt = 9983 )
'INIBL: ', inibl( 1 )
1395 WRITE( nout, fmt = 9983 )
'ISHFTS: ', ishfts( 1 )
1396 WRITE( nout, fmt = 9983 )
'IACC22: ', iacc22( 1 )
1398 ELSE IF( zgs .OR. zgx .OR. zgv .OR. zxv )
THEN
1403 READ( nin, fmt = * )nbval( 1 ), nbmin( 1 ), nxval( 1 ),
1404 $ nsval( 1 ), mxbval( 1 )
1405 IF( nbval( 1 ).LT.1 )
THEN
1406 WRITE( nout, fmt = 9989 )
' NB ', nbval( 1 ), 1
1408 ELSE IF( nbmin( 1 ).LT.1 )
THEN
1409 WRITE( nout, fmt = 9989 )
'NBMIN ', nbmin( 1 ), 1
1411 ELSE IF( nxval( 1 ).LT.1 )
THEN
1412 WRITE( nout, fmt = 9989 )
' NX ', nxval( 1 ), 1
1414 ELSE IF( nsval( 1 ).LT.2 )
THEN
1415 WRITE( nout, fmt = 9989 )
' NS ', nsval( 1 ), 2
1417 ELSE IF( mxbval( 1 ).LT.1 )
THEN
1418 WRITE( nout, fmt = 9989 )
' MAXB ', mxbval( 1 ), 1
1421 CALL
xlaenv( 1, nbval( 1 ) )
1422 CALL
xlaenv( 2, nbmin( 1 ) )
1423 CALL
xlaenv( 3, nxval( 1 ) )
1424 CALL
xlaenv( 4, nsval( 1 ) )
1425 CALL
xlaenv( 8, mxbval( 1 ) )
1426 WRITE( nout, fmt = 9983 )
'NB: ', nbval( 1 )
1427 WRITE( nout, fmt = 9983 )
'NBMIN:', nbmin( 1 )
1428 WRITE( nout, fmt = 9983 )
'NX: ', nxval( 1 )
1429 WRITE( nout, fmt = 9983 )
'NS: ', nsval( 1 )
1430 WRITE( nout, fmt = 9983 )
'MAXB: ', mxbval( 1 )
1431 ELSE IF( .NOT.zhb .AND. .NOT.glm .AND. .NOT.gqr .AND. .NOT.
1432 $ gsv .AND. .NOT.csd .AND. .NOT.
lse )
THEN
1437 READ( nin, fmt = * )nparms
1438 IF( nparms.LT.1 )
THEN
1439 WRITE( nout, fmt = 9989 )
'NPARMS', nparms, 1
1442 ELSE IF( nparms.GT.maxin )
THEN
1443 WRITE( nout, fmt = 9988 )
'NPARMS', nparms, maxin
1451 READ( nin, fmt = * )( nbval( i ), i = 1, nparms )
1453 IF( nbval( i ).LT.0 )
THEN
1454 WRITE( nout, fmt = 9989 )
' NB ', nbval( i ), 0
1456 ELSE IF( nbval( i ).GT.nmax )
THEN
1457 WRITE( nout, fmt = 9988 )
' NB ', nbval( i ), nmax
1461 WRITE( nout, fmt = 9983 )
'NB: ',
1462 $ ( nbval( i ), i = 1, nparms )
1467 IF( nep .OR. sep .OR. svd .OR. zgg )
THEN
1468 READ( nin, fmt = * )( nbmin( i ), i = 1, nparms )
1470 IF( nbmin( i ).LT.0 )
THEN
1471 WRITE( nout, fmt = 9989 )
'NBMIN ', nbmin( i ), 0
1473 ELSE IF( nbmin( i ).GT.nmax )
THEN
1474 WRITE( nout, fmt = 9988 )
'NBMIN ', nbmin( i ), nmax
1478 WRITE( nout, fmt = 9983 )
'NBMIN:',
1479 $ ( nbmin( i ), i = 1, nparms )
1488 IF( nep .OR. sep .OR. svd )
THEN
1489 READ( nin, fmt = * )( nxval( i ), i = 1, nparms )
1490 DO 100 i = 1, nparms
1491 IF( nxval( i ).LT.0 )
THEN
1492 WRITE( nout, fmt = 9989 )
' NX ', nxval( i ), 0
1494 ELSE IF( nxval( i ).GT.nmax )
THEN
1495 WRITE( nout, fmt = 9988 )
' NX ', nxval( i ), nmax
1499 WRITE( nout, fmt = 9983 )
'NX: ',
1500 $ ( nxval( i ), i = 1, nparms )
1502 DO 110 i = 1, nparms
1510 IF( svd .OR. zbb .OR. zgg )
THEN
1511 READ( nin, fmt = * )( nsval( i ), i = 1, nparms )
1512 DO 120 i = 1, nparms
1513 IF( nsval( i ).LT.0 )
THEN
1514 WRITE( nout, fmt = 9989 )
' NS ', nsval( i ), 0
1516 ELSE IF( nsval( i ).GT.nmax )
THEN
1517 WRITE( nout, fmt = 9988 )
' NS ', nsval( i ), nmax
1521 WRITE( nout, fmt = 9983 )
'NS: ',
1522 $ ( nsval( i ), i = 1, nparms )
1524 DO 130 i = 1, nparms
1532 READ( nin, fmt = * )( mxbval( i ), i = 1, nparms )
1533 DO 140 i = 1, nparms
1534 IF( mxbval( i ).LT.0 )
THEN
1535 WRITE( nout, fmt = 9989 )
' MAXB ', mxbval( i ), 0
1537 ELSE IF( mxbval( i ).GT.nmax )
THEN
1538 WRITE( nout, fmt = 9988 )
' MAXB ', mxbval( i ), nmax
1542 WRITE( nout, fmt = 9983 )
'MAXB: ',
1543 $ ( mxbval( i ), i = 1, nparms )
1545 DO 150 i = 1, nparms
1553 READ( nin, fmt = * )( inmin( i ), i = 1, nparms )
1554 DO 540 i = 1, nparms
1555 IF( inmin( i ).LT.0 )
THEN
1556 WRITE( nout, fmt = 9989 )
' INMIN ', inmin( i ), 0
1560 WRITE( nout, fmt = 9983 )
'INMIN: ',
1561 $ ( inmin( i ), i = 1, nparms )
1563 DO 550 i = 1, nparms
1571 READ( nin, fmt = * )( inwin( i ), i = 1, nparms )
1572 DO 560 i = 1, nparms
1573 IF( inwin( i ).LT.0 )
THEN
1574 WRITE( nout, fmt = 9989 )
' INWIN ', inwin( i ), 0
1578 WRITE( nout, fmt = 9983 )
'INWIN: ',
1579 $ ( inwin( i ), i = 1, nparms )
1581 DO 570 i = 1, nparms
1589 READ( nin, fmt = * )( inibl( i ), i = 1, nparms )
1590 DO 580 i = 1, nparms
1591 IF( inibl( i ).LT.0 )
THEN
1592 WRITE( nout, fmt = 9989 )
' INIBL ', inibl( i ), 0
1596 WRITE( nout, fmt = 9983 )
'INIBL: ',
1597 $ ( inibl( i ), i = 1, nparms )
1599 DO 590 i = 1, nparms
1607 READ( nin, fmt = * )( ishfts( i ), i = 1, nparms )
1608 DO 600 i = 1, nparms
1609 IF( ishfts( i ).LT.0 )
THEN
1610 WRITE( nout, fmt = 9989 )
' ISHFTS ', ishfts( i ), 0
1614 WRITE( nout, fmt = 9983 )
'ISHFTS: ',
1615 $ ( ishfts( i ), i = 1, nparms )
1617 DO 610 i = 1, nparms
1625 READ( nin, fmt = * )( iacc22( i ), i = 1, nparms )
1626 DO 620 i = 1, nparms
1627 IF( iacc22( i ).LT.0 )
THEN
1628 WRITE( nout, fmt = 9989 )
' IACC22 ', iacc22( i ), 0
1632 WRITE( nout, fmt = 9983 )
'IACC22: ',
1633 $ ( iacc22( i ), i = 1, nparms )
1635 DO 630 i = 1, nparms
1643 READ( nin, fmt = * )( nbcol( i ), i = 1, nparms )
1644 DO 160 i = 1, nparms
1645 IF( nbcol( i ).LT.0 )
THEN
1646 WRITE( nout, fmt = 9989 )
'NBCOL ', nbcol( i ), 0
1648 ELSE IF( nbcol( i ).GT.nmax )
THEN
1649 WRITE( nout, fmt = 9988 )
'NBCOL ', nbcol( i ), nmax
1653 WRITE( nout, fmt = 9983 )
'NBCOL:',
1654 $ ( nbcol( i ), i = 1, nparms )
1656 DO 170 i = 1, nparms
1664 WRITE( nout, fmt = * )
1665 eps =
dlamch(
'Underflow threshold' )
1666 WRITE( nout, fmt = 9981 )
'underflow', eps
1667 eps =
dlamch(
'Overflow threshold' )
1668 WRITE( nout, fmt = 9981 )
'overflow ', eps
1669 eps =
dlamch(
'Epsilon' )
1670 WRITE( nout, fmt = 9981 )
'precision', eps
1674 READ( nin, fmt = * )thresh
1675 WRITE( nout, fmt = 9982 )thresh
1676 IF( sep .OR. svd .OR. zgg )
THEN
1680 READ( nin, fmt = * )tstchk
1684 READ( nin, fmt = * )tstdrv
1689 READ( nin, fmt = * )tsterr
1693 READ( nin, fmt = * )newsd
1698 $
READ( nin, fmt = * )( ioldsd( i ), i = 1, 4 )
1701 iseed( i ) = ioldsd( i )
1705 WRITE( nout, fmt = 9999 )
1716 IF( .NOT.( zgx .OR. zxv ) )
THEN
1719 READ( nin, fmt =
'(A80)',
END = 380 )line
1727 IF( i.GT.lenp )
THEN
1735 IF( line( i: i ).NE.
' ' .AND. line( i: i ).NE.
',' )
THEN
1742 IF( c1.EQ.intstr( k: k ) )
THEN
1747 WRITE( nout, fmt = 9991 )i, line
1752 ELSE IF( i1.GT.0 )
THEN
1762 IF( .NOT.( zev .OR. zes .OR. zvx .OR. zsx .OR. zgv .OR.
1763 $ zgs ) .AND. ntypes.LE.0 )
THEN
1764 WRITE( nout, fmt = 9990 )c3
1777 IF( newsd.EQ.0 )
THEN
1779 iseed( k ) = ioldsd( k )
1783 IF(
lsamen( 3, c3,
'ZHS' ) .OR.
lsamen( 3, c3,
'NEP' ) )
THEN
1796 ntypes = min( maxtyp, ntypes )
1797 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
1800 $ CALL
zerrhs(
'ZHSEQR', nout )
1801 DO 270 i = 1, nparms
1802 CALL
xlaenv( 1, nbval( i ) )
1803 CALL
xlaenv( 2, nbmin( i ) )
1804 CALL
xlaenv( 3, nxval( i ) )
1805 CALL
xlaenv(12, max( 11, inmin( i ) ) )
1806 CALL
xlaenv(13, inwin( i ) )
1807 CALL
xlaenv(14, inibl( i ) )
1808 CALL
xlaenv(15, ishfts( i ) )
1809 CALL
xlaenv(16, iacc22( i ) )
1811 IF( newsd.EQ.0 )
THEN
1813 iseed( k ) = ioldsd( k )
1816 WRITE( nout, fmt = 9961 )c3, nbval( i ), nbmin( i ),
1817 $ nxval( i ), max( 11, inmin(i)),
1818 $ inwin( i ), inibl( i ), ishfts( i ), iacc22( i )
1819 CALL
zchkhs( nn, nval, maxtyp, dotype, iseed, thresh, nout,
1820 $ a( 1, 1 ), nmax, a( 1, 2 ), a( 1, 3 ),
1821 $ a( 1, 4 ), a( 1, 5 ), nmax, a( 1, 6 ),
1822 $ a( 1, 7 ), dc( 1, 1 ), dc( 1, 2 ), a( 1, 8 ),
1823 $ a( 1, 9 ), a( 1, 10 ), a( 1, 11 ), a( 1, 12 ),
1824 $ dc( 1, 3 ), work, lwork, rwork, iwork, logwrk,
1827 $
WRITE( nout, fmt = 9980 )
'ZCHKHS', info
1830 ELSE IF(
lsamen( 3, c3,
'ZST' ) .OR.
lsamen( 3, c3,
'SEP' ) )
THEN
1841 ntypes = min( maxtyp, ntypes )
1842 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
1846 $ CALL
zerrst(
'ZST', nout )
1847 DO 290 i = 1, nparms
1848 CALL
xlaenv( 1, nbval( i ) )
1849 CALL
xlaenv( 2, nbmin( i ) )
1850 CALL
xlaenv( 3, nxval( i ) )
1852 IF( newsd.EQ.0 )
THEN
1854 iseed( k ) = ioldsd( k )
1857 WRITE( nout, fmt = 9997 )c3, nbval( i ), nbmin( i ),
1860 CALL
zchkst( nn, nval, maxtyp, dotype, iseed, thresh,
1861 $ nout, a( 1, 1 ), nmax, a( 1, 2 ),
1862 $ dr( 1, 1 ), dr( 1, 2 ), dr( 1, 3 ),
1863 $ dr( 1, 4 ), dr( 1, 5 ), dr( 1, 6 ),
1864 $ dr( 1, 7 ), dr( 1, 8 ), dr( 1, 9 ),
1865 $ dr( 1, 10 ), dr( 1, 11 ), a( 1, 3 ), nmax,
1866 $ a( 1, 4 ), a( 1, 5 ), dc( 1, 1 ), a( 1, 6 ),
1867 $ work, lwork, rwork, lwork, iwork, liwork,
1870 $
WRITE( nout, fmt = 9980 )
'ZCHKST', info
1873 CALL
zdrvst( nn, nval, 18, dotype, iseed, thresh, nout,
1874 $ a( 1, 1 ), nmax, dr( 1, 3 ), dr( 1, 4 ),
1875 $ dr( 1, 5 ), dr( 1, 8 ), dr( 1, 9 ),
1876 $ dr( 1, 10 ), a( 1, 2 ), nmax, a( 1, 3 ),
1877 $ dc( 1, 1 ), a( 1, 4 ), work, lwork, rwork,
1878 $ lwork, iwork, liwork, result, info )
1880 $
WRITE( nout, fmt = 9980 )
'ZDRVST', info
1884 ELSE IF(
lsamen( 3, c3,
'ZSG' ) )
THEN
1895 ntypes = min( maxtyp, ntypes )
1896 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
1898 DO 310 i = 1, nparms
1899 CALL
xlaenv( 1, nbval( i ) )
1900 CALL
xlaenv( 2, nbmin( i ) )
1901 CALL
xlaenv( 3, nxval( i ) )
1903 IF( newsd.EQ.0 )
THEN
1905 iseed( k ) = ioldsd( k )
1908 WRITE( nout, fmt = 9997 )c3, nbval( i ), nbmin( i ),
1911 CALL
zdrvsg( nn, nval, maxtyp, dotype, iseed, thresh,
1912 $ nout, a( 1, 1 ), nmax, a( 1, 2 ), nmax,
1913 $ dr( 1, 3 ), a( 1, 3 ), nmax, a( 1, 4 ),
1914 $ a( 1, 5 ), a( 1, 6 ), a( 1, 7 ), work,
1915 $ lwork, rwork, lwork, iwork, liwork, result,
1918 $
WRITE( nout, fmt = 9980 )
'ZDRVSG', info
1922 ELSE IF(
lsamen( 3, c3,
'ZBD' ) .OR.
lsamen( 3, c3,
'SVD' ) )
THEN
1934 ntypes = min( maxtyp, ntypes )
1935 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
1941 IF( tsterr .AND. tstchk )
1942 $ CALL
zerrbd(
'ZBD', nout )
1943 IF( tsterr .AND. tstdrv )
1944 $ CALL
zerred(
'ZBD', nout )
1946 DO 330 i = 1, nparms
1948 CALL
xlaenv( 1, nbval( i ) )
1949 CALL
xlaenv( 2, nbmin( i ) )
1950 CALL
xlaenv( 3, nxval( i ) )
1951 IF( newsd.EQ.0 )
THEN
1953 iseed( k ) = ioldsd( k )
1956 WRITE( nout, fmt = 9995 )c3, nbval( i ), nbmin( i ),
1959 CALL
zchkbd( nn, mval, nval, maxtyp, dotype, nrhs, iseed,
1960 $ thresh, a( 1, 1 ), nmax, dr( 1, 1 ),
1961 $ dr( 1, 2 ), dr( 1, 3 ), dr( 1, 4 ),
1962 $ a( 1, 2 ), nmax, a( 1, 3 ), a( 1, 4 ),
1963 $ a( 1, 5 ), nmax, a( 1, 6 ), nmax, a( 1, 7 ),
1964 $ a( 1, 8 ), work, lwork, rwork, nout, info )
1966 $
WRITE( nout, fmt = 9980 )
'ZCHKBD', info
1969 $ CALL
zdrvbd( nn, mval, nval, maxtyp, dotype, iseed,
1970 $ thresh, a( 1, 1 ), nmax, a( 1, 2 ), nmax,
1971 $ a( 1, 3 ), nmax, a( 1, 4 ), a( 1, 5 ),
1972 $ a( 1, 6 ), dr( 1, 1 ), dr( 1, 2 ),
1973 $ dr( 1, 3 ), work, lwork, rwork, iwork, nout,
1977 ELSE IF(
lsamen( 3, c3,
'ZEV' ) )
THEN
1985 ntypes = min( maxtyp, ntypes )
1986 IF( ntypes.LE.0 )
THEN
1987 WRITE( nout, fmt = 9990 )c3
1990 $ CALL
zerred( c3, nout )
1991 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
1992 CALL
zdrvev( nn, nval, ntypes, dotype, iseed, thresh, nout,
1993 $ a( 1, 1 ), nmax, a( 1, 2 ), dc( 1, 1 ),
1994 $ dc( 1, 2 ), a( 1, 3 ), nmax, a( 1, 4 ), nmax,
1995 $ a( 1, 5 ), nmax, result, work, lwork, rwork,
1998 $
WRITE( nout, fmt = 9980 )
'ZGEEV', info
2000 WRITE( nout, fmt = 9973 )
2003 ELSE IF(
lsamen( 3, c3,
'ZES' ) )
THEN
2011 ntypes = min( maxtyp, ntypes )
2012 IF( ntypes.LE.0 )
THEN
2013 WRITE( nout, fmt = 9990 )c3
2016 $ CALL
zerred( c3, nout )
2017 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2018 CALL
zdrves( nn, nval, ntypes, dotype, iseed, thresh, nout,
2019 $ a( 1, 1 ), nmax, a( 1, 2 ), a( 1, 3 ),
2020 $ dc( 1, 1 ), dc( 1, 2 ), a( 1, 4 ), nmax,
2021 $ result, work, lwork, rwork, iwork, logwrk,
2024 $
WRITE( nout, fmt = 9980 )
'ZGEES', info
2026 WRITE( nout, fmt = 9973 )
2029 ELSE IF(
lsamen( 3, c3,
'ZVX' ) )
THEN
2037 ntypes = min( maxtyp, ntypes )
2038 IF( ntypes.LT.0 )
THEN
2039 WRITE( nout, fmt = 9990 )c3
2042 $ CALL
zerred( c3, nout )
2043 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2044 CALL
zdrvvx( nn, nval, ntypes, dotype, iseed, thresh, nin,
2045 $ nout, a( 1, 1 ), nmax, a( 1, 2 ), dc( 1, 1 ),
2046 $ dc( 1, 2 ), a( 1, 3 ), nmax, a( 1, 4 ), nmax,
2047 $ a( 1, 5 ), nmax, dr( 1, 1 ), dr( 1, 2 ),
2048 $ dr( 1, 3 ), dr( 1, 4 ), dr( 1, 5 ), dr( 1, 6 ),
2049 $ dr( 1, 7 ), dr( 1, 8 ), result, work, lwork,
2052 $
WRITE( nout, fmt = 9980 )
'ZGEEVX', info
2054 WRITE( nout, fmt = 9973 )
2057 ELSE IF(
lsamen( 3, c3,
'ZSX' ) )
THEN
2065 ntypes = min( maxtyp, ntypes )
2066 IF( ntypes.LT.0 )
THEN
2067 WRITE( nout, fmt = 9990 )c3
2070 $ CALL
zerred( c3, nout )
2071 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2072 CALL
zdrvsx( nn, nval, ntypes, dotype, iseed, thresh, nin,
2073 $ nout, a( 1, 1 ), nmax, a( 1, 2 ), a( 1, 3 ),
2074 $ dc( 1, 1 ), dc( 1, 2 ), dc( 1, 3 ), a( 1, 4 ),
2075 $ nmax, a( 1, 5 ), result, work, lwork, rwork,
2078 $
WRITE( nout, fmt = 9980 )
'ZGEESX', info
2080 WRITE( nout, fmt = 9973 )
2083 ELSE IF(
lsamen( 3, c3,
'ZGG' ) )
THEN
2096 ntypes = min( maxtyp, ntypes )
2097 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2098 IF( tstchk .AND. tsterr )
2099 $ CALL
zerrgg( c3, nout )
2100 DO 350 i = 1, nparms
2101 CALL
xlaenv( 1, nbval( i ) )
2102 CALL
xlaenv( 2, nbmin( i ) )
2103 CALL
xlaenv( 4, nsval( i ) )
2104 CALL
xlaenv( 8, mxbval( i ) )
2105 CALL
xlaenv( 5, nbcol( i ) )
2107 IF( newsd.EQ.0 )
THEN
2109 iseed( k ) = ioldsd( k )
2112 WRITE( nout, fmt = 9996 )c3, nbval( i ), nbmin( i ),
2113 $ nsval( i ), mxbval( i ), nbcol( i )
2117 CALL
zchkgg( nn, nval, maxtyp, dotype, iseed, thresh,
2118 $ tstdif, thrshn, nout, a( 1, 1 ), nmax,
2119 $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), a( 1, 5 ),
2120 $ a( 1, 6 ), a( 1, 7 ), a( 1, 8 ), a( 1, 9 ),
2121 $ nmax, a( 1, 10 ), a( 1, 11 ), a( 1, 12 ),
2122 $ dc( 1, 1 ), dc( 1, 2 ), dc( 1, 3 ),
2123 $ dc( 1, 4 ), a( 1, 13 ), a( 1, 14 ), work,
2124 $ lwork, rwork, logwrk, result, info )
2126 $
WRITE( nout, fmt = 9980 )
'ZCHKGG', info
2130 CALL
zdrvgg( nn, nval, maxtyp, dotype, iseed, thresh,
2131 $ thrshn, nout, a( 1, 1 ), nmax, a( 1, 2 ),
2132 $ a( 1, 3 ), a( 1, 4 ), a( 1, 5 ), a( 1, 6 ),
2133 $ a( 1, 7 ), nmax, a( 1, 8 ), dc( 1, 1 ),
2134 $ dc( 1, 2 ), dc( 1, 3 ), dc( 1, 4 ),
2135 $ a( 1, 8 ), a( 1, 9 ), work, lwork, rwork,
2138 $
WRITE( nout, fmt = 9980 )
'ZDRVGG', info
2142 ELSE IF(
lsamen( 3, c3,
'ZGS' ) )
THEN
2150 ntypes = min( maxtyp, ntypes )
2151 IF( ntypes.LE.0 )
THEN
2152 WRITE( nout, fmt = 9990 )c3
2155 $ CALL
zerrgg( c3, nout )
2156 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2157 CALL
zdrges( nn, nval, maxtyp, dotype, iseed, thresh, nout,
2158 $ a( 1, 1 ), nmax, a( 1, 2 ), a( 1, 3 ),
2159 $ a( 1, 4 ), a( 1, 7 ), nmax, a( 1, 8 ),
2160 $ dc( 1, 1 ), dc( 1, 2 ), work, lwork, rwork,
2161 $ result, logwrk, info )
2164 $
WRITE( nout, fmt = 9980 )
'ZDRGES', info
2166 WRITE( nout, fmt = 9973 )
2179 WRITE( nout, fmt = 9990 )c3
2182 $ CALL
zerrgg( c3, nout )
2183 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2185 CALL
zdrgsx( nn, ncmax, thresh, nin, nout, a( 1, 1 ), nmax,
2186 $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), a( 1, 5 ),
2187 $ a( 1, 6 ), dc( 1, 1 ), dc( 1, 2 ), c,
2188 $ ncmax*ncmax, s, work, lwork, rwork, iwork,
2189 $ liwork, logwrk, info )
2191 $
WRITE( nout, fmt = 9980 )
'ZDRGSX', info
2193 WRITE( nout, fmt = 9973 )
2196 ELSE IF(
lsamen( 3, c3,
'ZGV' ) )
THEN
2204 ntypes = min( maxtyp, ntypes )
2205 IF( ntypes.LE.0 )
THEN
2206 WRITE( nout, fmt = 9990 )c3
2209 $ CALL
zerrgg( c3, nout )
2210 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2211 CALL
zdrgev( 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 $ a( 1, 9 ), nmax, dc( 1, 1 ), dc( 1, 2 ),
2215 $ dc( 1, 3 ), dc( 1, 4 ), work, lwork, rwork,
2218 $
WRITE( nout, fmt = 9980 )
'ZDRGEV', info
2220 WRITE( nout, fmt = 9973 )
2233 WRITE( nout, fmt = 9990 )c3
2236 $ CALL
zerrgg( c3, nout )
2237 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2238 CALL
zdrgvx( nn, thresh, nin, nout, a( 1, 1 ), nmax,
2239 $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), dc( 1, 1 ),
2240 $ dc( 1, 2 ), a( 1, 5 ), a( 1, 6 ), iwork( 1 ),
2241 $ iwork( 2 ), dr( 1, 1 ), dr( 1, 2 ), dr( 1, 3 ),
2242 $ dr( 1, 4 ), dr( 1, 5 ), dr( 1, 6 ), work,
2243 $ lwork, rwork, iwork( 3 ), liwork-2, result,
2247 $
WRITE( nout, fmt = 9980 )
'ZDRGVX', info
2249 WRITE( nout, fmt = 9973 )
2252 ELSE IF(
lsamen( 3, c3,
'ZHB' ) )
THEN
2259 ntypes = min( maxtyp, ntypes )
2260 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2262 $ CALL
zerrst(
'ZHB', nout )
2263 CALL
zchkhb( nn, nval, nk, kval, maxtyp, dotype, iseed, thresh,
2264 $ nout, a( 1, 1 ), nmax, dr( 1, 1 ), dr( 1, 2 ),
2265 $ a( 1, 2 ), nmax, work, lwork, rwork, result,
2268 $
WRITE( nout, fmt = 9980 )
'ZCHKHB', info
2270 ELSE IF(
lsamen( 3, c3,
'ZBB' ) )
THEN
2277 ntypes = min( maxtyp, ntypes )
2278 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2279 DO 370 i = 1, nparms
2282 IF( newsd.EQ.0 )
THEN
2284 iseed( k ) = ioldsd( k )
2287 WRITE( nout, fmt = 9966 )c3, nrhs
2288 CALL
zchkbb( nn, mval, nval, nk, kval, maxtyp, dotype, nrhs,
2289 $ iseed, thresh, nout, a( 1, 1 ), nmax,
2290 $ a( 1, 2 ), 2*nmax, dr( 1, 1 ), dr( 1, 2 ),
2291 $ a( 1, 4 ), nmax, a( 1, 5 ), nmax, a( 1, 6 ),
2292 $ nmax, a( 1, 7 ), work, lwork, rwork, result,
2295 $
WRITE( nout, fmt = 9980 )
'ZCHKBB', info
2298 ELSE IF(
lsamen( 3, c3,
'GLM' ) )
THEN
2306 $ CALL
zerrgg(
'GLM', nout )
2307 CALL
zckglm( nn, nval, mval, pval, ntypes, iseed, thresh, nmax,
2308 $ a( 1, 1 ), a( 1, 2 ),
b( 1, 1 ),
b( 1, 2 ), x,
2309 $ work, dr( 1, 1 ), nin, nout, info )
2311 $
WRITE( nout, fmt = 9980 )
'ZCKGLM', info
2313 ELSE IF(
lsamen( 3, c3,
'GQR' ) )
THEN
2321 $ CALL
zerrgg(
'GQR', nout )
2322 CALL
zckgqr( nn, mval, nn, pval, nn, nval, ntypes, iseed,
2323 $ thresh, nmax, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
2324 $ a( 1, 4 ), taua,
b( 1, 1 ),
b( 1, 2 ),
b( 1, 3 ),
2325 $
b( 1, 4 ),
b( 1, 5 ), taub, work, dr( 1, 1 ), nin,
2328 $
WRITE( nout, fmt = 9980 )
'ZCKGQR', info
2330 ELSE IF(
lsamen( 3, c3,
'GSV' ) )
THEN
2337 $ CALL
zerrgg(
'GSV', nout )
2338 CALL
zckgsv( nn, mval, pval, nval, ntypes, iseed, thresh, nmax,
2339 $ a( 1, 1 ), a( 1, 2 ),
b( 1, 1 ),
b( 1, 2 ),
2340 $ a( 1, 3 ),
b( 1, 3 ), a( 1, 4 ), alpha, beta,
2341 $
b( 1, 4 ), iwork, work, dr( 1, 1 ), nin, nout,
2344 $
WRITE( nout, fmt = 9980 )
'ZCKGSV', info
2346 ELSE IF(
lsamen( 3, c3,
'CSD' ) )
THEN
2354 $ CALL
zerrgg(
'CSD', nout )
2355 CALL
zckcsd( nn, mval, pval, nval, ntypes, iseed, thresh, nmax,
2356 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), a( 1, 4 ),
2357 $ a( 1, 5 ), a( 1, 6 ), rwork, iwork, work,
2358 $ dr( 1, 1 ), nin, nout, info )
2360 $
WRITE( nout, fmt = 9980 )
'ZCKCSD', info
2362 ELSE IF(
lsamen( 3, c3,
'LSE' ) )
THEN
2370 $ CALL
zerrgg(
'LSE', nout )
2371 CALL
zcklse( nn, mval, pval, nval, ntypes, iseed, thresh, nmax,
2372 $ a( 1, 1 ), a( 1, 2 ),
b( 1, 1 ),
b( 1, 2 ), x,
2373 $ work, dr( 1, 1 ), nin, nout, info )
2375 $
WRITE( nout, fmt = 9980 )
'ZCKLSE', info
2377 WRITE( nout, fmt = * )
2378 WRITE( nout, fmt = * )
2379 WRITE( nout, fmt = 9992 )c3
2381 IF( .NOT.( zgx .OR. zxv ) )
2384 WRITE( nout, fmt = 9994 )
2386 WRITE( nout, fmt = 9993 )s2 - s1
2388 9999
FORMAT( /
' Execution not attempted due to input errors' )
2389 9997
FORMAT( / / 1x, a3,
': NB =', i4,
', NBMIN =', i4,
', NX =', i4 )
2390 9996
FORMAT( / / 1x, a3,
': NB =', i4,
', NBMIN =', i4,
', NS =', i4,
2391 $
', MAXB =', i4,
', NBCOL =', i4 )
2392 9995
FORMAT( / / 1x, a3,
': NB =', i4,
', NBMIN =', i4,
', NX =', i4,
2394 9994
FORMAT( / /
' End of tests' )
2395 9993
FORMAT(
' Total time used = ', f12.2,
' seconds', / )
2396 9992
FORMAT( 1x, a3,
': Unrecognized path name' )
2397 9991
FORMAT( / /
' *** Invalid integer value in column ', i2,
2398 $
' of input',
' line:', / a79 )
2399 9990
FORMAT( / / 1x, a3,
' routines were not tested' )
2400 9989
FORMAT(
' Invalid input value: ', a,
'=', i6,
'; must be >=',
2402 9988
FORMAT(
' Invalid input value: ', a,
'=', i6,
'; must be <=',
2404 9987
FORMAT(
' Tests of the Nonsymmetric Eigenvalue Problem routines' )
2405 9986
FORMAT(
' Tests of the Hermitian Eigenvalue Problem routines' )
2406 9985
FORMAT(
' Tests of the Singular Value Decomposition routines' )
2407 9984
FORMAT( /
' The following parameter values will be used:' )
2408 9983
FORMAT( 4x, a, 10i6, / 10x, 10i6 )
2409 9982
FORMAT( /
' Routines pass computational tests if test ratio is ',
2410 $
'less than', f8.2, / )
2411 9981
FORMAT(
' Relative machine ', a,
' is taken to be', d16.6 )
2412 9980
FORMAT(
' *** Error code from ', a,
' = ', i4 )
2413 9979
FORMAT( /
' Tests of the Nonsymmetric Eigenvalue Problem Driver',
2414 $ /
' ZGEEV (eigenvalues and eigevectors)' )
2415 9978
FORMAT( /
' Tests of the Nonsymmetric Eigenvalue Problem Driver',
2416 $ /
' ZGEES (Schur form)' )
2417 9977
FORMAT( /
' Tests of the Nonsymmetric Eigenvalue Problem Expert',
2418 $
' Driver', /
' ZGEEVX (eigenvalues, eigenvectors and',
2419 $
' condition numbers)' )
2420 9976
FORMAT( /
' Tests of the Nonsymmetric Eigenvalue Problem Expert',
2421 $
' Driver', /
' ZGEESX (Schur form and condition',
2423 9975
FORMAT( /
' Tests of the Generalized Nonsymmetric Eigenvalue ',
2424 $
'Problem routines' )
2425 9974
FORMAT(
' Tests of ZHBTRD', /
' (reduction of a Hermitian band ',
2426 $
'matrix to real tridiagonal form)' )
2427 9973
FORMAT( / 1x, 71(
'-' ) )
2428 9972
FORMAT( /
' LAPACK VERSION ', i1,
'.', i1,
'.', i1 )
2429 9971
FORMAT( /
' Tests of the Generalized Linear Regression Model ',
2431 9970
FORMAT( /
' Tests of the Generalized QR and RQ routines' )
2432 9969
FORMAT( /
' Tests of the Generalized Singular Value',
2433 $
' Decomposition routines' )
2434 9968
FORMAT( /
' Tests of the Linear Least Squares routines' )
2435 9967
FORMAT(
' Tests of ZGBBRD', /
' (reduction of a general band ',
2436 $
'matrix to real bidiagonal form)' )
2437 9966
FORMAT( / / 1x, a3,
': NRHS =', i4 )
2438 9965
FORMAT( /
' Tests of the Generalized Nonsymmetric Eigenvalue ',
2439 $
'Problem Expert Driver ZGGESX' )
2440 9964
FORMAT( /
' Tests of the Generalized Nonsymmetric Eigenvalue ',
2441 $
'Problem Driver ZGGES' )
2442 9963
FORMAT( /
' Tests of the Generalized Nonsymmetric Eigenvalue ',
2443 $
'Problem Driver ZGGEV' )
2444 9962
FORMAT( /
' Tests of the Generalized Nonsymmetric Eigenvalue ',
2445 $
'Problem Expert Driver ZGGEVX' )
2446 9961
FORMAT( / / 1x, a3,
': NB =', i4,
', NBMIN =', i4,
', NX =', i4,
2448 $
', INWIN =', i4,
', INIBL =', i4,
', ISHFTS =', i4,
2450 9960
FORMAT( /
' Tests of the CS Decomposition routines' )