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 cbb, cbk, cbl, ces, cev, cgg, cgk, cgl, cgs,
1063 $ cgv, cgx, chb, csd, csx, cvx, cxv, fatal, glm,
1064 $ gqr, gsv,
lse, nep, sep, svd, tstchk, tstdif,
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 REAL 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 REAL alpha( nmax ), beta( nmax ), dr( nmax, 12 ),
1086 $ result( 500 ), rwork( lwork ), s( nmax*nmax )
1087 COMPLEX 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 REAL selwi( 20 ), selwr( 20 )
1120 common / cenvir / nproc, nshift, maxb
1121 common / claenv / iparms
1122 common / infoc / infot, nunit, ok, lerr
1123 common / srnamc / srnamt
1124 common / sslct / selopt, seldim, selval, selwr, selwi
1127 DATA intstr /
'0123456789' /
1128 DATA ioldsd / 0, 0, 0, 1 /
1142 READ( nin, fmt =
'(A80)',
END = 380 )line
1144 nep =
lsamen( 3, path,
'NEP' ) .OR.
lsamen( 3, path,
'CHS' )
1145 sep =
lsamen( 3, path,
'SEP' ) .OR.
lsamen( 3, path,
'CST' ) .OR.
1146 $
lsamen( 3, path,
'CSG' )
1147 svd =
lsamen( 3, path,
'SVD' ) .OR.
lsamen( 3, path,
'CBD' )
1148 cev =
lsamen( 3, path,
'CEV' )
1149 ces =
lsamen( 3, path,
'CES' )
1150 cvx =
lsamen( 3, path,
'CVX' )
1151 csx =
lsamen( 3, path,
'CSX' )
1152 cgg =
lsamen( 3, path,
'CGG' )
1153 cgs =
lsamen( 3, path,
'CGS' )
1154 cgx =
lsamen( 3, path,
'CGX' )
1155 cgv =
lsamen( 3, path,
'CGV' )
1156 cxv =
lsamen( 3, path,
'CXV' )
1157 chb =
lsamen( 3, path,
'CHB' )
1158 cbb =
lsamen( 3, path,
'CBB' )
1159 glm =
lsamen( 3, path,
'GLM' )
1160 gqr =
lsamen( 3, path,
'GQR' ) .OR.
lsamen( 3, path,
'GRQ' )
1161 gsv =
lsamen( 3, path,
'GSV' )
1162 csd =
lsamen( 3, path,
'CSD' )
1164 cbl =
lsamen( 3, path,
'CBL' )
1165 cbk =
lsamen( 3, path,
'CBK' )
1166 cgl =
lsamen( 3, path,
'CGL' )
1167 cgk =
lsamen( 3, path,
'CGK' )
1171 IF( path.EQ.
' ' )
THEN
1174 WRITE( nout, fmt = 9987 )
1176 WRITE( nout, fmt = 9986 )
1178 WRITE( nout, fmt = 9985 )
1180 WRITE( nout, fmt = 9979 )
1182 WRITE( nout, fmt = 9978 )
1184 WRITE( nout, fmt = 9977 )
1186 WRITE( nout, fmt = 9976 )
1188 WRITE( nout, fmt = 9975 )
1190 WRITE( nout, fmt = 9964 )
1192 WRITE( nout, fmt = 9965 )
1194 WRITE( nout, fmt = 9963 )
1196 WRITE( nout, fmt = 9962 )
1198 WRITE( nout, fmt = 9974 )
1200 WRITE( nout, fmt = 9967 )
1202 WRITE( nout, fmt = 9971 )
1204 WRITE( nout, fmt = 9970 )
1206 WRITE( nout, fmt = 9969 )
1208 WRITE( nout, fmt = 9960 )
1210 WRITE( nout, fmt = 9968 )
1235 ELSE IF(
lsamen( 3, path,
'CEC' ) )
THEN
1239 READ( nin, fmt = * )thresh
1243 CALL
cchkec( thresh, tsterr, nin, nout )
1246 WRITE( nout, fmt = 9992 )path
1249 CALL
ilaver( vers_major, vers_minor, vers_patch )
1250 WRITE( nout, fmt = 9972 ) vers_major, vers_minor, vers_patch
1251 WRITE( nout, fmt = 9984 )
1255 READ( nin, fmt = * )nn
1257 WRITE( nout, fmt = 9989 )
' NN ', nn, 1
1260 ELSE IF( nn.GT.maxin )
THEN
1261 WRITE( nout, fmt = 9988 )
' NN ', nn, maxin
1268 IF( .NOT.( cgx .OR. cxv ) )
THEN
1269 READ( nin, fmt = * )( mval( i ), i = 1, nn )
1276 IF( mval( i ).LT.0 )
THEN
1277 WRITE( nout, fmt = 9989 )vname, mval( i ), 0
1279 ELSE IF( mval( i ).GT.nmax )
THEN
1280 WRITE( nout, fmt = 9988 )vname, mval( i ), nmax
1284 WRITE( nout, fmt = 9983 )
'M: ', ( mval( i ), i = 1, nn )
1289 IF( glm .OR. gqr .OR. gsv .OR. csd .OR.
lse )
THEN
1290 READ( nin, fmt = * )( pval( i ), i = 1, nn )
1292 IF( pval( i ).LT.0 )
THEN
1293 WRITE( nout, fmt = 9989 )
' P ', pval( i ), 0
1295 ELSE IF( pval( i ).GT.nmax )
THEN
1296 WRITE( nout, fmt = 9988 )
' P ', pval( i ), nmax
1300 WRITE( nout, fmt = 9983 )
'P: ', ( pval( i ), i = 1, nn )
1305 IF( svd .OR. cbb .OR. glm .OR. gqr .OR. gsv .OR. csd .OR.
1307 READ( nin, fmt = * )( nval( i ), i = 1, nn )
1309 IF( nval( i ).LT.0 )
THEN
1310 WRITE( nout, fmt = 9989 )
' N ', nval( i ), 0
1312 ELSE IF( nval( i ).GT.nmax )
THEN
1313 WRITE( nout, fmt = 9988 )
' N ', nval( i ), nmax
1319 nval( i ) = mval( i )
1322 IF( .NOT.( cgx .OR. cxv ) )
THEN
1323 WRITE( nout, fmt = 9983 )
'N: ', ( nval( i ), i = 1, nn )
1325 WRITE( nout, fmt = 9983 )
'N: ', nn
1330 IF( chb .OR. cbb )
THEN
1331 READ( nin, fmt = * )nk
1332 READ( nin, fmt = * )( kval( i ), i = 1, nk )
1334 IF( kval( i ).LT.0 )
THEN
1335 WRITE( nout, fmt = 9989 )
' K ', kval( i ), 0
1337 ELSE IF( kval( i ).GT.nmax )
THEN
1338 WRITE( nout, fmt = 9988 )
' K ', kval( i ), nmax
1342 WRITE( nout, fmt = 9983 )
'K: ', ( kval( i ), i = 1, nk )
1345 IF( cev .OR. ces .OR. cvx .OR. csx )
THEN
1350 READ( nin, fmt = * )nbval( 1 ), nbmin( 1 ), nxval( 1 ),
1351 $ inmin( 1 ), inwin( 1 ), inibl(1), ishfts(1), iacc22(1)
1352 IF( nbval( 1 ).LT.1 )
THEN
1353 WRITE( nout, fmt = 9989 )
' NB ', nbval( 1 ), 1
1355 ELSE IF( nbmin( 1 ).LT.1 )
THEN
1356 WRITE( nout, fmt = 9989 )
'NBMIN ', nbmin( 1 ), 1
1358 ELSE IF( nxval( 1 ).LT.1 )
THEN
1359 WRITE( nout, fmt = 9989 )
' NX ', nxval( 1 ), 1
1361 ELSE IF( inmin( 1 ).LT.1 )
THEN
1362 WRITE( nout, fmt = 9989 )
' INMIN ', inmin( 1 ), 1
1364 ELSE IF( inwin( 1 ).LT.1 )
THEN
1365 WRITE( nout, fmt = 9989 )
' INWIN ', inwin( 1 ), 1
1367 ELSE IF( inibl( 1 ).LT.1 )
THEN
1368 WRITE( nout, fmt = 9989 )
' INIBL ', inibl( 1 ), 1
1370 ELSE IF( ishfts( 1 ).LT.1 )
THEN
1371 WRITE( nout, fmt = 9989 )
' ISHFTS ', ishfts( 1 ), 1
1373 ELSE IF( iacc22( 1 ).LT.0 )
THEN
1374 WRITE( nout, fmt = 9989 )
' IACC22 ', iacc22( 1 ), 0
1377 CALL
xlaenv( 1, nbval( 1 ) )
1378 CALL
xlaenv( 2, nbmin( 1 ) )
1379 CALL
xlaenv( 3, nxval( 1 ) )
1380 CALL
xlaenv(12, max( 11, inmin( 1 ) ) )
1381 CALL
xlaenv(13, inwin( 1 ) )
1382 CALL
xlaenv(14, inibl( 1 ) )
1383 CALL
xlaenv(15, ishfts( 1 ) )
1384 CALL
xlaenv(16, iacc22( 1 ) )
1385 WRITE( nout, fmt = 9983 )
'NB: ', nbval( 1 )
1386 WRITE( nout, fmt = 9983 )
'NBMIN:', nbmin( 1 )
1387 WRITE( nout, fmt = 9983 )
'NX: ', nxval( 1 )
1388 WRITE( nout, fmt = 9983 )
'INMIN: ', inmin( 1 )
1389 WRITE( nout, fmt = 9983 )
'INWIN: ', inwin( 1 )
1390 WRITE( nout, fmt = 9983 )
'INIBL: ', inibl( 1 )
1391 WRITE( nout, fmt = 9983 )
'ISHFTS: ', ishfts( 1 )
1392 WRITE( nout, fmt = 9983 )
'IACC22: ', iacc22( 1 )
1394 ELSE IF( cgs .OR. cgx .OR. cgv .OR. cxv )
THEN
1399 READ( nin, fmt = * )nbval( 1 ), nbmin( 1 ), nxval( 1 ),
1400 $ nsval( 1 ), mxbval( 1 )
1401 IF( nbval( 1 ).LT.1 )
THEN
1402 WRITE( nout, fmt = 9989 )
' NB ', nbval( 1 ), 1
1404 ELSE IF( nbmin( 1 ).LT.1 )
THEN
1405 WRITE( nout, fmt = 9989 )
'NBMIN ', nbmin( 1 ), 1
1407 ELSE IF( nxval( 1 ).LT.1 )
THEN
1408 WRITE( nout, fmt = 9989 )
' NX ', nxval( 1 ), 1
1410 ELSE IF( nsval( 1 ).LT.2 )
THEN
1411 WRITE( nout, fmt = 9989 )
' NS ', nsval( 1 ), 2
1413 ELSE IF( mxbval( 1 ).LT.1 )
THEN
1414 WRITE( nout, fmt = 9989 )
' MAXB ', mxbval( 1 ), 1
1417 CALL
xlaenv( 1, nbval( 1 ) )
1418 CALL
xlaenv( 2, nbmin( 1 ) )
1419 CALL
xlaenv( 3, nxval( 1 ) )
1420 CALL
xlaenv( 4, nsval( 1 ) )
1421 CALL
xlaenv( 8, mxbval( 1 ) )
1422 WRITE( nout, fmt = 9983 )
'NB: ', nbval( 1 )
1423 WRITE( nout, fmt = 9983 )
'NBMIN:', nbmin( 1 )
1424 WRITE( nout, fmt = 9983 )
'NX: ', nxval( 1 )
1425 WRITE( nout, fmt = 9983 )
'NS: ', nsval( 1 )
1426 WRITE( nout, fmt = 9983 )
'MAXB: ', mxbval( 1 )
1427 ELSE IF( .NOT.chb .AND. .NOT.glm .AND. .NOT.gqr .AND. .NOT.
1428 $ gsv .AND. .NOT.csd .AND. .NOT.
lse )
THEN
1433 READ( nin, fmt = * )nparms
1434 IF( nparms.LT.1 )
THEN
1435 WRITE( nout, fmt = 9989 )
'NPARMS', nparms, 1
1438 ELSE IF( nparms.GT.maxin )
THEN
1439 WRITE( nout, fmt = 9988 )
'NPARMS', nparms, maxin
1447 READ( nin, fmt = * )( nbval( i ), i = 1, nparms )
1449 IF( nbval( i ).LT.0 )
THEN
1450 WRITE( nout, fmt = 9989 )
' NB ', nbval( i ), 0
1452 ELSE IF( nbval( i ).GT.nmax )
THEN
1453 WRITE( nout, fmt = 9988 )
' NB ', nbval( i ), nmax
1457 WRITE( nout, fmt = 9983 )
'NB: ',
1458 $ ( nbval( i ), i = 1, nparms )
1463 IF( nep .OR. sep .OR. svd .OR. cgg )
THEN
1464 READ( nin, fmt = * )( nbmin( i ), i = 1, nparms )
1466 IF( nbmin( i ).LT.0 )
THEN
1467 WRITE( nout, fmt = 9989 )
'NBMIN ', nbmin( i ), 0
1469 ELSE IF( nbmin( i ).GT.nmax )
THEN
1470 WRITE( nout, fmt = 9988 )
'NBMIN ', nbmin( i ), nmax
1474 WRITE( nout, fmt = 9983 )
'NBMIN:',
1475 $ ( nbmin( i ), i = 1, nparms )
1484 IF( nep .OR. sep .OR. svd )
THEN
1485 READ( nin, fmt = * )( nxval( i ), i = 1, nparms )
1486 DO 100 i = 1, nparms
1487 IF( nxval( i ).LT.0 )
THEN
1488 WRITE( nout, fmt = 9989 )
' NX ', nxval( i ), 0
1490 ELSE IF( nxval( i ).GT.nmax )
THEN
1491 WRITE( nout, fmt = 9988 )
' NX ', nxval( i ), nmax
1495 WRITE( nout, fmt = 9983 )
'NX: ',
1496 $ ( nxval( i ), i = 1, nparms )
1498 DO 110 i = 1, nparms
1506 IF( svd .OR. cbb .OR. cgg )
THEN
1507 READ( nin, fmt = * )( nsval( i ), i = 1, nparms )
1508 DO 120 i = 1, nparms
1509 IF( nsval( i ).LT.0 )
THEN
1510 WRITE( nout, fmt = 9989 )
' NS ', nsval( i ), 0
1512 ELSE IF( nsval( i ).GT.nmax )
THEN
1513 WRITE( nout, fmt = 9988 )
' NS ', nsval( i ), nmax
1517 WRITE( nout, fmt = 9983 )
'NS: ',
1518 $ ( nsval( i ), i = 1, nparms )
1520 DO 130 i = 1, nparms
1528 READ( nin, fmt = * )( mxbval( i ), i = 1, nparms )
1529 DO 140 i = 1, nparms
1530 IF( mxbval( i ).LT.0 )
THEN
1531 WRITE( nout, fmt = 9989 )
' MAXB ', mxbval( i ), 0
1533 ELSE IF( mxbval( i ).GT.nmax )
THEN
1534 WRITE( nout, fmt = 9988 )
' MAXB ', mxbval( i ), nmax
1538 WRITE( nout, fmt = 9983 )
'MAXB: ',
1539 $ ( mxbval( i ), i = 1, nparms )
1541 DO 150 i = 1, nparms
1549 READ( nin, fmt = * )( inmin( i ), i = 1, nparms )
1550 DO 540 i = 1, nparms
1551 IF( inmin( i ).LT.0 )
THEN
1552 WRITE( nout, fmt = 9989 )
' INMIN ', inmin( i ), 0
1556 WRITE( nout, fmt = 9983 )
'INMIN: ',
1557 $ ( inmin( i ), i = 1, nparms )
1559 DO 550 i = 1, nparms
1567 READ( nin, fmt = * )( inwin( i ), i = 1, nparms )
1568 DO 560 i = 1, nparms
1569 IF( inwin( i ).LT.0 )
THEN
1570 WRITE( nout, fmt = 9989 )
' INWIN ', inwin( i ), 0
1574 WRITE( nout, fmt = 9983 )
'INWIN: ',
1575 $ ( inwin( i ), i = 1, nparms )
1577 DO 570 i = 1, nparms
1585 READ( nin, fmt = * )( inibl( i ), i = 1, nparms )
1586 DO 580 i = 1, nparms
1587 IF( inibl( i ).LT.0 )
THEN
1588 WRITE( nout, fmt = 9989 )
' INIBL ', inibl( i ), 0
1592 WRITE( nout, fmt = 9983 )
'INIBL: ',
1593 $ ( inibl( i ), i = 1, nparms )
1595 DO 590 i = 1, nparms
1603 READ( nin, fmt = * )( ishfts( i ), i = 1, nparms )
1604 DO 600 i = 1, nparms
1605 IF( ishfts( i ).LT.0 )
THEN
1606 WRITE( nout, fmt = 9989 )
' ISHFTS ', ishfts( i ), 0
1610 WRITE( nout, fmt = 9983 )
'ISHFTS: ',
1611 $ ( ishfts( i ), i = 1, nparms )
1613 DO 610 i = 1, nparms
1621 READ( nin, fmt = * )( iacc22( i ), i = 1, nparms )
1622 DO 620 i = 1, nparms
1623 IF( iacc22( i ).LT.0 )
THEN
1624 WRITE( nout, fmt = 9989 )
' IACC22 ', iacc22( i ), 0
1628 WRITE( nout, fmt = 9983 )
'IACC22: ',
1629 $ ( iacc22( i ), i = 1, nparms )
1631 DO 630 i = 1, nparms
1639 READ( nin, fmt = * )( nbcol( i ), i = 1, nparms )
1640 DO 160 i = 1, nparms
1641 IF( nbcol( i ).LT.0 )
THEN
1642 WRITE( nout, fmt = 9989 )
'NBCOL ', nbcol( i ), 0
1644 ELSE IF( nbcol( i ).GT.nmax )
THEN
1645 WRITE( nout, fmt = 9988 )
'NBCOL ', nbcol( i ), nmax
1649 WRITE( nout, fmt = 9983 )
'NBCOL:',
1650 $ ( nbcol( i ), i = 1, nparms )
1652 DO 170 i = 1, nparms
1660 WRITE( nout, fmt = * )
1661 eps =
slamch(
'Underflow threshold' )
1662 WRITE( nout, fmt = 9981 )
'underflow', eps
1663 eps =
slamch(
'Overflow threshold' )
1664 WRITE( nout, fmt = 9981 )
'overflow ', eps
1665 eps =
slamch(
'Epsilon' )
1666 WRITE( nout, fmt = 9981 )
'precision', eps
1670 READ( nin, fmt = * )thresh
1671 WRITE( nout, fmt = 9982 )thresh
1672 IF( sep .OR. svd .OR. cgg )
THEN
1676 READ( nin, fmt = * )tstchk
1680 READ( nin, fmt = * )tstdrv
1685 READ( nin, fmt = * )tsterr
1689 READ( nin, fmt = * )newsd
1694 $
READ( nin, fmt = * )( ioldsd( i ), i = 1, 4 )
1697 iseed( i ) = ioldsd( i )
1701 WRITE( nout, fmt = 9999 )
1712 IF( .NOT.( cgx .OR. cxv ) )
THEN
1715 READ( nin, fmt =
'(A80)',
END = 380 )line
1723 IF( i.GT.lenp )
THEN
1731 IF( line( i: i ).NE.
' ' .AND. line( i: i ).NE.
',' )
THEN
1738 IF( c1.EQ.intstr( k: k ) )
THEN
1743 WRITE( nout, fmt = 9991 )i, line
1748 ELSE IF( i1.GT.0 )
THEN
1758 IF( .NOT.( cev .OR. ces .OR. cvx .OR. csx .OR. cgv .OR.
1759 $ cgs ) .AND. ntypes.LE.0 )
THEN
1760 WRITE( nout, fmt = 9990 )c3
1773 IF( newsd.EQ.0 )
THEN
1775 iseed( k ) = ioldsd( k )
1779 IF(
lsamen( 3, c3,
'CHS' ) .OR.
lsamen( 3, c3,
'NEP' ) )
THEN
1792 ntypes = min( maxtyp, ntypes )
1793 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
1796 $ CALL
cerrhs(
'CHSEQR', nout )
1797 DO 270 i = 1, nparms
1798 CALL
xlaenv( 1, nbval( i ) )
1799 CALL
xlaenv( 2, nbmin( i ) )
1800 CALL
xlaenv( 3, nxval( i ) )
1801 CALL
xlaenv(12, max( 11, inmin( i ) ) )
1802 CALL
xlaenv(13, inwin( i ) )
1803 CALL
xlaenv(14, inibl( i ) )
1804 CALL
xlaenv(15, ishfts( i ) )
1805 CALL
xlaenv(16, iacc22( i ) )
1807 IF( newsd.EQ.0 )
THEN
1809 iseed( k ) = ioldsd( k )
1812 WRITE( nout, fmt = 9961 )c3, nbval( i ), nbmin( i ),
1813 $ nxval( i ), max( 11, inmin(i)),
1814 $ inwin( i ), inibl( i ), ishfts( i ), iacc22( i )
1815 CALL
cchkhs( nn, nval, maxtyp, dotype, iseed, thresh, nout,
1816 $ a( 1, 1 ), nmax, a( 1, 2 ), a( 1, 3 ),
1817 $ a( 1, 4 ), a( 1, 5 ), nmax, a( 1, 6 ),
1818 $ a( 1, 7 ), dc( 1, 1 ), dc( 1, 2 ), a( 1, 8 ),
1819 $ a( 1, 9 ), a( 1, 10 ), a( 1, 11 ), a( 1, 12 ),
1820 $ dc( 1, 3 ), work, lwork, rwork, iwork, logwrk,
1823 $
WRITE( nout, fmt = 9980 )
'CCHKHS', info
1826 ELSE IF(
lsamen( 3, c3,
'CST' ) .OR.
lsamen( 3, c3,
'SEP' ) )
THEN
1837 ntypes = min( maxtyp, ntypes )
1838 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
1842 $ CALL
cerrst(
'CST', nout )
1843 DO 290 i = 1, nparms
1844 CALL
xlaenv( 1, nbval( i ) )
1845 CALL
xlaenv( 2, nbmin( i ) )
1846 CALL
xlaenv( 3, nxval( i ) )
1848 IF( newsd.EQ.0 )
THEN
1850 iseed( k ) = ioldsd( k )
1853 WRITE( nout, fmt = 9997 )c3, nbval( i ), nbmin( i ),
1856 CALL
cchkst( nn, nval, maxtyp, dotype, iseed, thresh,
1857 $ nout, a( 1, 1 ), nmax, a( 1, 2 ),
1858 $ dr( 1, 1 ), dr( 1, 2 ), dr( 1, 3 ),
1859 $ dr( 1, 4 ), dr( 1, 5 ), dr( 1, 6 ),
1860 $ dr( 1, 7 ), dr( 1, 8 ), dr( 1, 9 ),
1861 $ dr( 1, 10 ), dr( 1, 11 ), a( 1, 3 ), nmax,
1862 $ a( 1, 4 ), a( 1, 5 ), dc( 1, 1 ), a( 1, 6 ),
1863 $ work, lwork, rwork, lwork, iwork, liwork,
1866 $
WRITE( nout, fmt = 9980 )
'CCHKST', info
1869 CALL
cdrvst( nn, nval, 18, dotype, iseed, thresh, nout,
1870 $ a( 1, 1 ), nmax, dr( 1, 3 ), dr( 1, 4 ),
1871 $ dr( 1, 5 ), dr( 1, 8 ), dr( 1, 9 ),
1872 $ dr( 1, 10 ), a( 1, 2 ), nmax, a( 1, 3 ),
1873 $ dc( 1, 1 ), a( 1, 4 ), work, lwork, rwork,
1874 $ lwork, iwork, liwork, result, info )
1876 $
WRITE( nout, fmt = 9980 )
'CDRVST', info
1880 ELSE IF(
lsamen( 3, c3,
'CSG' ) )
THEN
1891 ntypes = min( maxtyp, ntypes )
1892 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
1894 DO 310 i = 1, nparms
1895 CALL
xlaenv( 1, nbval( i ) )
1896 CALL
xlaenv( 2, nbmin( i ) )
1897 CALL
xlaenv( 3, nxval( i ) )
1899 IF( newsd.EQ.0 )
THEN
1901 iseed( k ) = ioldsd( k )
1904 WRITE( nout, fmt = 9997 )c3, nbval( i ), nbmin( i ),
1907 CALL
cdrvsg( nn, nval, maxtyp, dotype, iseed, thresh,
1908 $ nout, a( 1, 1 ), nmax, a( 1, 2 ), nmax,
1909 $ dr( 1, 3 ), a( 1, 3 ), nmax, a( 1, 4 ),
1910 $ a( 1, 5 ), a( 1, 6 ), a( 1, 7 ), work,
1911 $ lwork, rwork, lwork, iwork, liwork, result,
1914 $
WRITE( nout, fmt = 9980 )
'CDRVSG', info
1918 ELSE IF(
lsamen( 3, c3,
'CBD' ) .OR.
lsamen( 3, c3,
'SVD' ) )
THEN
1930 ntypes = min( maxtyp, ntypes )
1931 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
1937 IF( tsterr .AND. tstchk )
1938 $ CALL
cerrbd(
'CBD', nout )
1939 IF( tsterr .AND. tstdrv )
1940 $ CALL
cerred(
'CBD', nout )
1942 DO 330 i = 1, nparms
1944 CALL
xlaenv( 1, nbval( i ) )
1945 CALL
xlaenv( 2, nbmin( i ) )
1946 CALL
xlaenv( 3, nxval( i ) )
1947 IF( newsd.EQ.0 )
THEN
1949 iseed( k ) = ioldsd( k )
1952 WRITE( nout, fmt = 9995 )c3, nbval( i ), nbmin( i ),
1955 CALL
cchkbd( nn, mval, nval, maxtyp, dotype, nrhs, iseed,
1956 $ thresh, a( 1, 1 ), nmax, dr( 1, 1 ),
1957 $ dr( 1, 2 ), dr( 1, 3 ), dr( 1, 4 ),
1958 $ a( 1, 2 ), nmax, a( 1, 3 ), a( 1, 4 ),
1959 $ a( 1, 5 ), nmax, a( 1, 6 ), nmax, a( 1, 7 ),
1960 $ a( 1, 8 ), work, lwork, rwork, nout, info )
1962 $
WRITE( nout, fmt = 9980 )
'CCHKBD', info
1965 $ CALL
cdrvbd( nn, mval, nval, maxtyp, dotype, iseed,
1966 $ thresh, a( 1, 1 ), nmax, a( 1, 2 ), nmax,
1967 $ a( 1, 3 ), nmax, a( 1, 4 ), a( 1, 5 ),
1968 $ a( 1, 6 ), dr( 1, 1 ), dr( 1, 2 ),
1969 $ dr( 1, 3 ), work, lwork, rwork, iwork, nout,
1973 ELSE IF(
lsamen( 3, c3,
'CEV' ) )
THEN
1981 ntypes = min( maxtyp, ntypes )
1982 IF( ntypes.LE.0 )
THEN
1983 WRITE( nout, fmt = 9990 )c3
1986 $ CALL
cerred( c3, nout )
1987 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
1988 CALL
cdrvev( nn, nval, ntypes, dotype, iseed, thresh, nout,
1989 $ a( 1, 1 ), nmax, a( 1, 2 ), dc( 1, 1 ),
1990 $ dc( 1, 2 ), a( 1, 3 ), nmax, a( 1, 4 ), nmax,
1991 $ a( 1, 5 ), nmax, result, work, lwork, rwork,
1994 $
WRITE( nout, fmt = 9980 )
'CGEEV', info
1996 WRITE( nout, fmt = 9973 )
1999 ELSE IF(
lsamen( 3, c3,
'CES' ) )
THEN
2007 ntypes = min( maxtyp, ntypes )
2008 IF( ntypes.LE.0 )
THEN
2009 WRITE( nout, fmt = 9990 )c3
2012 $ CALL
cerred( c3, nout )
2013 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2014 CALL
cdrves( nn, nval, ntypes, dotype, iseed, thresh, nout,
2015 $ a( 1, 1 ), nmax, a( 1, 2 ), a( 1, 3 ),
2016 $ dc( 1, 1 ), dc( 1, 2 ), a( 1, 4 ), nmax,
2017 $ result, work, lwork, rwork, iwork, logwrk,
2020 $
WRITE( nout, fmt = 9980 )
'CGEES', info
2022 WRITE( nout, fmt = 9973 )
2025 ELSE IF(
lsamen( 3, c3,
'CVX' ) )
THEN
2033 ntypes = min( maxtyp, ntypes )
2034 IF( ntypes.LT.0 )
THEN
2035 WRITE( nout, fmt = 9990 )c3
2038 $ CALL
cerred( c3, nout )
2039 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2040 CALL
cdrvvx( nn, nval, ntypes, dotype, iseed, thresh, nin,
2041 $ nout, a( 1, 1 ), nmax, a( 1, 2 ), dc( 1, 1 ),
2042 $ dc( 1, 2 ), a( 1, 3 ), nmax, a( 1, 4 ), nmax,
2043 $ a( 1, 5 ), nmax, dr( 1, 1 ), dr( 1, 2 ),
2044 $ dr( 1, 3 ), dr( 1, 4 ), dr( 1, 5 ), dr( 1, 6 ),
2045 $ dr( 1, 7 ), dr( 1, 8 ), result, work, lwork,
2048 $
WRITE( nout, fmt = 9980 )
'CGEEVX', info
2050 WRITE( nout, fmt = 9973 )
2053 ELSE IF(
lsamen( 3, c3,
'CSX' ) )
THEN
2061 ntypes = min( maxtyp, ntypes )
2062 IF( ntypes.LT.0 )
THEN
2063 WRITE( nout, fmt = 9990 )c3
2066 $ CALL
cerred( c3, nout )
2067 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2068 CALL
cdrvsx( nn, nval, ntypes, dotype, iseed, thresh, nin,
2069 $ nout, a( 1, 1 ), nmax, a( 1, 2 ), a( 1, 3 ),
2070 $ dc( 1, 1 ), dc( 1, 2 ), dc( 1, 3 ), a( 1, 4 ),
2071 $ nmax, a( 1, 5 ), result, work, lwork, rwork,
2074 $
WRITE( nout, fmt = 9980 )
'CGEESX', info
2076 WRITE( nout, fmt = 9973 )
2079 ELSE IF(
lsamen( 3, c3,
'CGG' ) )
THEN
2092 ntypes = min( maxtyp, ntypes )
2093 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2094 IF( tstchk .AND. tsterr )
2095 $ CALL
cerrgg( c3, nout )
2096 DO 350 i = 1, nparms
2097 CALL
xlaenv( 1, nbval( i ) )
2098 CALL
xlaenv( 2, nbmin( i ) )
2099 CALL
xlaenv( 4, nsval( i ) )
2100 CALL
xlaenv( 8, mxbval( i ) )
2101 CALL
xlaenv( 5, nbcol( i ) )
2103 IF( newsd.EQ.0 )
THEN
2105 iseed( k ) = ioldsd( k )
2108 WRITE( nout, fmt = 9996 )c3, nbval( i ), nbmin( i ),
2109 $ nsval( i ), mxbval( i ), nbcol( i )
2113 CALL
cchkgg( nn, nval, maxtyp, dotype, iseed, thresh,
2114 $ tstdif, thrshn, nout, a( 1, 1 ), nmax,
2115 $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), a( 1, 5 ),
2116 $ a( 1, 6 ), a( 1, 7 ), a( 1, 8 ), a( 1, 9 ),
2117 $ nmax, a( 1, 10 ), a( 1, 11 ), a( 1, 12 ),
2118 $ dc( 1, 1 ), dc( 1, 2 ), dc( 1, 3 ),
2119 $ dc( 1, 4 ), a( 1, 13 ), a( 1, 14 ), work,
2120 $ lwork, rwork, logwrk, result, info )
2122 $
WRITE( nout, fmt = 9980 )
'CCHKGG', info
2126 CALL
cdrvgg( nn, nval, maxtyp, dotype, iseed, thresh,
2127 $ thrshn, nout, a( 1, 1 ), nmax, a( 1, 2 ),
2128 $ a( 1, 3 ), a( 1, 4 ), a( 1, 5 ), a( 1, 6 ),
2129 $ a( 1, 7 ), nmax, a( 1, 8 ), dc( 1, 1 ),
2130 $ dc( 1, 2 ), dc( 1, 3 ), dc( 1, 4 ),
2131 $ a( 1, 8 ), a( 1, 9 ), work, lwork, rwork,
2134 $
WRITE( nout, fmt = 9980 )
'CDRVGG', info
2138 ELSE IF(
lsamen( 3, c3,
'CGS' ) )
THEN
2146 ntypes = min( maxtyp, ntypes )
2147 IF( ntypes.LE.0 )
THEN
2148 WRITE( nout, fmt = 9990 )c3
2151 $ CALL
cerrgg( c3, nout )
2152 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2153 CALL
cdrges( nn, nval, maxtyp, dotype, iseed, thresh, nout,
2154 $ a( 1, 1 ), nmax, a( 1, 2 ), a( 1, 3 ),
2155 $ a( 1, 4 ), a( 1, 7 ), nmax, a( 1, 8 ),
2156 $ dc( 1, 1 ), dc( 1, 2 ), work, lwork, rwork,
2157 $ result, logwrk, info )
2160 $
WRITE( nout, fmt = 9980 )
'CDRGES', info
2162 WRITE( nout, fmt = 9973 )
2175 WRITE( nout, fmt = 9990 )c3
2178 $ CALL
cerrgg( c3, nout )
2179 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2181 CALL
cdrgsx( nn, ncmax, thresh, nin, nout, a( 1, 1 ), nmax,
2182 $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), a( 1, 5 ),
2183 $ a( 1, 6 ), dc( 1, 1 ), dc( 1, 2 ), c,
2184 $ ncmax*ncmax, s, work, lwork, rwork, iwork,
2185 $ liwork, logwrk, info )
2187 $
WRITE( nout, fmt = 9980 )
'CDRGSX', info
2189 WRITE( nout, fmt = 9973 )
2192 ELSE IF(
lsamen( 3, c3,
'CGV' ) )
THEN
2200 ntypes = min( maxtyp, ntypes )
2201 IF( ntypes.LE.0 )
THEN
2202 WRITE( nout, fmt = 9990 )c3
2205 $ CALL
cerrgg( c3, nout )
2206 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2207 CALL
cdrgev( nn, nval, maxtyp, dotype, iseed, thresh, nout,
2208 $ a( 1, 1 ), nmax, a( 1, 2 ), a( 1, 3 ),
2209 $ a( 1, 4 ), a( 1, 7 ), nmax, a( 1, 8 ),
2210 $ a( 1, 9 ), nmax, dc( 1, 1 ), dc( 1, 2 ),
2211 $ dc( 1, 3 ), dc( 1, 4 ), work, lwork, rwork,
2214 $
WRITE( nout, fmt = 9980 )
'CDRGEV', info
2216 WRITE( nout, fmt = 9973 )
2229 WRITE( nout, fmt = 9990 )c3
2232 $ CALL
cerrgg( c3, nout )
2233 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2234 CALL
cdrgvx( nn, thresh, nin, nout, a( 1, 1 ), nmax,
2235 $ a( 1, 2 ), a( 1, 3 ), a( 1, 4 ), dc( 1, 1 ),
2236 $ dc( 1, 2 ), a( 1, 5 ), a( 1, 6 ), iwork( 1 ),
2237 $ iwork( 2 ), dr( 1, 1 ), dr( 1, 2 ), dr( 1, 3 ),
2238 $ dr( 1, 4 ), dr( 1, 5 ), dr( 1, 6 ), work,
2239 $ lwork, rwork, iwork( 3 ), liwork-2, result,
2243 $
WRITE( nout, fmt = 9980 )
'CDRGVX', info
2245 WRITE( nout, fmt = 9973 )
2248 ELSE IF(
lsamen( 3, c3,
'CHB' ) )
THEN
2255 ntypes = min( maxtyp, ntypes )
2256 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2258 $ CALL
cerrst(
'CHB', nout )
2259 CALL
cchkhb( nn, nval, nk, kval, maxtyp, dotype, iseed, thresh,
2260 $ nout, a( 1, 1 ), nmax, dr( 1, 1 ), dr( 1, 2 ),
2261 $ a( 1, 2 ), nmax, work, lwork, rwork, result,
2264 $
WRITE( nout, fmt = 9980 )
'CCHKHB', info
2266 ELSE IF(
lsamen( 3, c3,
'CBB' ) )
THEN
2273 ntypes = min( maxtyp, ntypes )
2274 CALL
alareq( c3, ntypes, dotype, maxtyp, nin, nout )
2275 DO 370 i = 1, nparms
2278 IF( newsd.EQ.0 )
THEN
2280 iseed( k ) = ioldsd( k )
2283 WRITE( nout, fmt = 9966 )c3, nrhs
2284 CALL
cchkbb( nn, mval, nval, nk, kval, maxtyp, dotype, nrhs,
2285 $ iseed, thresh, nout, a( 1, 1 ), nmax,
2286 $ a( 1, 2 ), 2*nmax, dr( 1, 1 ), dr( 1, 2 ),
2287 $ a( 1, 4 ), nmax, a( 1, 5 ), nmax, a( 1, 6 ),
2288 $ nmax, a( 1, 7 ), work, lwork, rwork, result,
2291 $
WRITE( nout, fmt = 9980 )
'CCHKBB', info
2294 ELSE IF(
lsamen( 3, c3,
'GLM' ) )
THEN
2302 $ CALL
cerrgg(
'GLM', nout )
2303 CALL
cckglm( nn, nval, mval, pval, ntypes, iseed, thresh, nmax,
2304 $ a( 1, 1 ), a( 1, 2 ), b( 1, 1 ), b( 1, 2 ), x,
2305 $ work, dr( 1, 1 ), nin, nout, info )
2307 $
WRITE( nout, fmt = 9980 )
'CCKGLM', info
2309 ELSE IF(
lsamen( 3, c3,
'GQR' ) )
THEN
2317 $ CALL
cerrgg(
'GQR', nout )
2318 CALL
cckgqr( nn, mval, nn, pval, nn, nval, ntypes, iseed,
2319 $ thresh, nmax, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
2320 $ a( 1, 4 ), taua, b( 1, 1 ), b( 1, 2 ), b( 1, 3 ),
2321 $ b( 1, 4 ), b( 1, 5 ), taub, work, dr( 1, 1 ), nin,
2324 $
WRITE( nout, fmt = 9980 )
'CCKGQR', info
2326 ELSE IF(
lsamen( 3, c3,
'GSV' ) )
THEN
2333 $ CALL
cerrgg(
'GSV', nout )
2334 CALL
cckgsv( nn, mval, pval, nval, ntypes, iseed, thresh, nmax,
2335 $ a( 1, 1 ), a( 1, 2 ), b( 1, 1 ), b( 1, 2 ),
2336 $ a( 1, 3 ), b( 1, 3 ), a( 1, 4 ), alpha, beta,
2337 $ b( 1, 4 ), iwork, work, dr( 1, 1 ), nin, nout,
2340 $
WRITE( nout, fmt = 9980 )
'CCKGSV', info
2342 ELSE IF(
lsamen( 3, c3,
'CSD' ) )
THEN
2350 $ CALL
cerrgg(
'CSD', nout )
2351 CALL
cckcsd( nn, mval, pval, nval, ntypes, iseed, thresh, nmax,
2352 $ a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), a( 1, 4 ),
2353 $ a( 1, 5 ), a( 1, 6 ), rwork, iwork, work,
2354 $ dr( 1, 1 ), nin, nout, info )
2356 $
WRITE( nout, fmt = 9980 )
'CCKCSD', info
2358 ELSE IF(
lsamen( 3, c3,
'LSE' ) )
THEN
2366 $ CALL
cerrgg(
'LSE', nout )
2367 CALL
ccklse( nn, mval, pval, nval, ntypes, iseed, thresh, nmax,
2368 $ a( 1, 1 ), a( 1, 2 ), b( 1, 1 ), b( 1, 2 ), x,
2369 $ work, dr( 1, 1 ), nin, nout, info )
2371 $
WRITE( nout, fmt = 9980 )
'CCKLSE', info
2373 WRITE( nout, fmt = * )
2374 WRITE( nout, fmt = * )
2375 WRITE( nout, fmt = 9992 )c3
2377 IF( .NOT.( cgx .OR. cxv ) )
2380 WRITE( nout, fmt = 9994 )
2382 WRITE( nout, fmt = 9993 )s2 - s1
2384 9999 format( /
' Execution not attempted due to input errors' )
2385 9997 format( / / 1x, a3,
': NB =', i4,
', NBMIN =', i4,
', NX =', i4 )
2386 9996 format( / / 1x, a3,
': NB =', i4,
', NBMIN =', i4,
', NS =', i4,
2387 $
', MAXB =', i4,
', NBCOL =', i4 )
2388 9995 format( / / 1x, a3,
': NB =', i4,
', NBMIN =', i4,
', NX =', i4,
2390 9994 format( / /
' End of tests' )
2391 9993 format(
' Total time used = ', f12.2,
' seconds', / )
2392 9992 format( 1x, a3,
': Unrecognized path name' )
2393 9991 format( / /
' *** Invalid integer value in column ', i2,
2394 $
' of input',
' line:', / a79 )
2395 9990 format( / / 1x, a3,
' routines were not tested' )
2396 9989 format(
' Invalid input value: ', a,
'=', i6,
'; must be >=',
2398 9988 format(
' Invalid input value: ', a,
'=', i6,
'; must be <=',
2400 9987 format(
' Tests of the Nonsymmetric Eigenvalue Problem routines' )
2401 9986 format(
' Tests of the Hermitian Eigenvalue Problem routines' )
2402 9985 format(
' Tests of the Singular Value Decomposition routines' )
2403 9984 format( /
' The following parameter values will be used:' )
2404 9983 format( 4x, a, 10i6, / 10x, 10i6 )
2405 9982 format( /
' Routines pass computational tests if test ratio is ',
2406 $
'less than', f8.2, / )
2407 9981 format(
' Relative machine ', a,
' is taken to be', e16.6 )
2408 9980 format(
' *** Error code from ', a,
' = ', i4 )
2409 9979 format( /
' Tests of the Nonsymmetric Eigenvalue Problem Driver',
2410 $ /
' CGEEV (eigenvalues and eigevectors)' )
2411 9978 format( /
' Tests of the Nonsymmetric Eigenvalue Problem Driver',
2412 $ /
' CGEES (Schur form)' )
2413 9977 format( /
' Tests of the Nonsymmetric Eigenvalue Problem Expert',
2414 $
' Driver', /
' CGEEVX (eigenvalues, eigenvectors and',
2415 $
' condition numbers)' )
2416 9976 format( /
' Tests of the Nonsymmetric Eigenvalue Problem Expert',
2417 $
' Driver', /
' CGEESX (Schur form and condition',
2419 9975 format( /
' Tests of the Generalized Nonsymmetric Eigenvalue ',
2420 $
'Problem routines' )
2421 9974 format(
' Tests of CHBTRD', /
' (reduction of a Hermitian band ',
2422 $
'matrix to real tridiagonal form)' )
2423 9973 format( / 1x, 71(
'-' ) )
2424 9972 format( /
' LAPACK VERSION ', i1,
'.', i1,
'.', i1 )
2425 9971 format( /
' Tests of the Generalized Linear Regression Model ',
2427 9970 format( /
' Tests of the Generalized QR and RQ routines' )
2428 9969 format( /
' Tests of the Generalized Singular Value',
2429 $
' Decomposition routines' )
2430 9968 format( /
' Tests of the Linear Least Squares routines' )
2431 9967 format(
' Tests of CGBBRD', /
' (reduction of a general band ',
2432 $
'matrix to real bidiagonal form)' )
2433 9966 format( / / 1x, a3,
': NRHS =', i4 )
2434 9965 format( /
' Tests of the Generalized Nonsymmetric Eigenvalue ',
2435 $
'Problem Expert Driver CGGESX' )
2436 9964 format( /
' Tests of the Generalized Nonsymmetric Eigenvalue ',
2437 $
'Problem Driver CGGES' )
2438 9963 format( /
' Tests of the Generalized Nonsymmetric Eigenvalue ',
2439 $
'Problem Driver CGGEV' )
2440 9962 format( /
' Tests of the Generalized Nonsymmetric Eigenvalue ',
2441 $
'Problem Expert Driver CGGEVX' )
2442 9961 format( / / 1x, a3,
': NB =', i4,
', NBMIN =', i4,
', NX =', i4,
2444 $
', INWIN =', i4,
', INIBL =', i4,
', ISHFTS =', i4,
2446 9960 format( /
' Tests of the CS Decomposition routines' )