diff options
Diffstat (limited to 'packages/base/src/Internal/C/lapack-aux.c')
-rw-r--r-- | packages/base/src/Internal/C/lapack-aux.c | 291 |
1 files changed, 49 insertions, 242 deletions
diff --git a/packages/base/src/Internal/C/lapack-aux.c b/packages/base/src/Internal/C/lapack-aux.c index 1402050..36d1e57 100644 --- a/packages/base/src/Internal/C/lapack-aux.c +++ b/packages/base/src/Internal/C/lapack-aux.c | |||
@@ -1300,6 +1300,35 @@ int multiplyI(KOIMAT(a), KOIMAT(b), OIMAT(r)) { | |||
1300 | OK | 1300 | OK |
1301 | } | 1301 | } |
1302 | 1302 | ||
1303 | |||
1304 | ////////////////// sparse matrix-product /////////////////////////////////////// | ||
1305 | |||
1306 | |||
1307 | int smXv(KDVEC(vals),KIVEC(cols),KIVEC(rows),KDVEC(x),DVEC(r)) { | ||
1308 | int r, c; | ||
1309 | for (r = 0; r < rowsn - 1; r++) { | ||
1310 | rp[r] = 0; | ||
1311 | for (c = rowsp[r]; c < rowsp[r+1]; c++) { | ||
1312 | rp[r] += valsp[c-1] * xp[colsp[c-1]-1]; | ||
1313 | } | ||
1314 | } | ||
1315 | OK | ||
1316 | } | ||
1317 | |||
1318 | int smTXv(KDVEC(vals),KIVEC(cols),KIVEC(rows),KDVEC(x),DVEC(r)) { | ||
1319 | int r,c; | ||
1320 | for (c = 0; c < rn; c++) { | ||
1321 | rp[c] = 0; | ||
1322 | } | ||
1323 | for (r = 0; r < rowsn - 1; r++) { | ||
1324 | for (c = rowsp[r]; c < rowsp[r+1]; c++) { | ||
1325 | rp[colsp[c-1]-1] += valsp[c-1] * xp[r]; | ||
1326 | } | ||
1327 | } | ||
1328 | OK | ||
1329 | } | ||
1330 | |||
1331 | |||
1303 | //////////////////// transpose ///////////////////////// | 1332 | //////////////////// transpose ///////////////////////// |
1304 | 1333 | ||
1305 | int transF(KFMAT(x),FMAT(t)) { | 1334 | int transF(KFMAT(x),FMAT(t)) { |
@@ -1376,248 +1405,6 @@ int transI(KIMAT(x),IMAT(t)) { | |||
1376 | } | 1405 | } |
1377 | 1406 | ||
1378 | 1407 | ||
1379 | //////////////////// constant ///////////////////////// | ||
1380 | |||
1381 | int constantF(float * pval, FVEC(r)) { | ||
1382 | DEBUGMSG("constantF") | ||
1383 | int k; | ||
1384 | double val = *pval; | ||
1385 | for(k=0;k<rn;k++) { | ||
1386 | rp[k]=val; | ||
1387 | } | ||
1388 | OK | ||
1389 | } | ||
1390 | |||
1391 | int constantR(double * pval, DVEC(r)) { | ||
1392 | DEBUGMSG("constantR") | ||
1393 | int k; | ||
1394 | double val = *pval; | ||
1395 | for(k=0;k<rn;k++) { | ||
1396 | rp[k]=val; | ||
1397 | } | ||
1398 | OK | ||
1399 | } | ||
1400 | |||
1401 | int constantQ(complex* pval, QVEC(r)) { | ||
1402 | DEBUGMSG("constantQ") | ||
1403 | int k; | ||
1404 | complex val = *pval; | ||
1405 | for(k=0;k<rn;k++) { | ||
1406 | rp[k]=val; | ||
1407 | } | ||
1408 | OK | ||
1409 | } | ||
1410 | |||
1411 | int constantC(doublecomplex* pval, CVEC(r)) { | ||
1412 | DEBUGMSG("constantC") | ||
1413 | int k; | ||
1414 | doublecomplex val = *pval; | ||
1415 | for(k=0;k<rn;k++) { | ||
1416 | rp[k]=val; | ||
1417 | } | ||
1418 | OK | ||
1419 | } | ||
1420 | |||
1421 | int constantP(void* pval, PVEC(r)) { | ||
1422 | DEBUGMSG("constantP") | ||
1423 | int k; | ||
1424 | for(k=0;k<rn;k++) { | ||
1425 | memcpy(rp+k*rs,pval,rs); | ||
1426 | } | ||
1427 | OK | ||
1428 | } | ||
1429 | |||
1430 | |||
1431 | int constantI(int * pval, IVEC(r)) { | ||
1432 | DEBUGMSG("constantI") | ||
1433 | int k; | ||
1434 | int val = *pval; | ||
1435 | for(k=0;k<rn;k++) { | ||
1436 | rp[k]=val; | ||
1437 | } | ||
1438 | OK | ||
1439 | } | ||
1440 | |||
1441 | |||
1442 | //////////////////// float-double conversion ///////////////////////// | ||
1443 | |||
1444 | int float2double(FVEC(x),DVEC(y)) { | ||
1445 | DEBUGMSG("float2double") | ||
1446 | int k; | ||
1447 | for(k=0;k<xn;k++) { | ||
1448 | yp[k]=xp[k]; | ||
1449 | } | ||
1450 | OK | ||
1451 | } | ||
1452 | |||
1453 | int float2int(KFVEC(x),IVEC(y)) { | ||
1454 | DEBUGMSG("float2int") | ||
1455 | int k; | ||
1456 | for(k=0;k<xn;k++) { | ||
1457 | yp[k]=xp[k]; | ||
1458 | } | ||
1459 | OK | ||
1460 | } | ||
1461 | |||
1462 | |||
1463 | int double2float(DVEC(x),FVEC(y)) { | ||
1464 | DEBUGMSG("double2float") | ||
1465 | int k; | ||
1466 | for(k=0;k<xn;k++) { | ||
1467 | yp[k]=xp[k]; | ||
1468 | } | ||
1469 | OK | ||
1470 | } | ||
1471 | |||
1472 | |||
1473 | int double2int(KDVEC(x),IVEC(y)) { | ||
1474 | DEBUGMSG("double2int") | ||
1475 | int k; | ||
1476 | for(k=0;k<xn;k++) { | ||
1477 | yp[k]=xp[k]; | ||
1478 | } | ||
1479 | OK | ||
1480 | } | ||
1481 | |||
1482 | |||
1483 | int int2float(KIVEC(x),FVEC(y)) { | ||
1484 | DEBUGMSG("int2float") | ||
1485 | int k; | ||
1486 | for(k=0;k<xn;k++) { | ||
1487 | yp[k]=xp[k]; | ||
1488 | } | ||
1489 | OK | ||
1490 | } | ||
1491 | |||
1492 | |||
1493 | int int2double(KIVEC(x),DVEC(y)) { | ||
1494 | DEBUGMSG("int2double") | ||
1495 | int k; | ||
1496 | for(k=0;k<xn;k++) { | ||
1497 | yp[k]=xp[k]; | ||
1498 | } | ||
1499 | OK | ||
1500 | } | ||
1501 | |||
1502 | |||
1503 | //////////////////// conjugate ///////////////////////// | ||
1504 | |||
1505 | int conjugateQ(KQVEC(x),QVEC(t)) { | ||
1506 | REQUIRES(xn==tn,BAD_SIZE); | ||
1507 | DEBUGMSG("conjugateQ"); | ||
1508 | int k; | ||
1509 | for(k=0;k<xn;k++) { | ||
1510 | tp[k].r = xp[k].r; | ||
1511 | tp[k].i = -xp[k].i; | ||
1512 | } | ||
1513 | OK | ||
1514 | } | ||
1515 | |||
1516 | int conjugateC(KCVEC(x),CVEC(t)) { | ||
1517 | REQUIRES(xn==tn,BAD_SIZE); | ||
1518 | DEBUGMSG("conjugateC"); | ||
1519 | int k; | ||
1520 | for(k=0;k<xn;k++) { | ||
1521 | tp[k].r = xp[k].r; | ||
1522 | tp[k].i = -xp[k].i; | ||
1523 | } | ||
1524 | OK | ||
1525 | } | ||
1526 | |||
1527 | //////////////////// step ///////////////////////// | ||
1528 | |||
1529 | #define STEP_IMP \ | ||
1530 | int k; \ | ||
1531 | for(k=0;k<xn;k++) { \ | ||
1532 | yp[k]=xp[k]>0; \ | ||
1533 | } \ | ||
1534 | OK | ||
1535 | |||
1536 | int stepF(KFVEC(x),FVEC(y)) { | ||
1537 | STEP_IMP | ||
1538 | } | ||
1539 | |||
1540 | int stepD(KDVEC(x),DVEC(y)) { | ||
1541 | STEP_IMP | ||
1542 | } | ||
1543 | |||
1544 | int stepI(KIVEC(x),IVEC(y)) { | ||
1545 | STEP_IMP | ||
1546 | } | ||
1547 | |||
1548 | //////////////////// cond ///////////////////////// | ||
1549 | |||
1550 | #define COMPARE_IMP \ | ||
1551 | REQUIRES(xn==yn && xn==rn ,BAD_SIZE); \ | ||
1552 | int k; \ | ||
1553 | for(k=0;k<xn;k++) { \ | ||
1554 | rp[k] = xp[k]<yp[k]?-1:(xp[k]>yp[k]?1:0); \ | ||
1555 | } \ | ||
1556 | OK | ||
1557 | |||
1558 | |||
1559 | int compareF(KFVEC(x),KFVEC(y),IVEC(r)) { | ||
1560 | COMPARE_IMP | ||
1561 | } | ||
1562 | |||
1563 | int compareD(KDVEC(x),KDVEC(y),IVEC(r)) { | ||
1564 | COMPARE_IMP | ||
1565 | } | ||
1566 | |||
1567 | int compareI(KIVEC(x),KIVEC(y),IVEC(r)) { | ||
1568 | COMPARE_IMP | ||
1569 | } | ||
1570 | |||
1571 | |||
1572 | #define COND_IMP \ | ||
1573 | REQUIRES(xn==yn && xn==ltn && xn==eqn && xn==gtn && xn==rn ,BAD_SIZE); \ | ||
1574 | int k; \ | ||
1575 | for(k=0;k<xn;k++) { \ | ||
1576 | rp[k] = xp[k]<yp[k]?ltp[k]:(xp[k]>yp[k]?gtp[k]:eqp[k]); \ | ||
1577 | } \ | ||
1578 | OK | ||
1579 | |||
1580 | int condF(FVEC(x),FVEC(y),FVEC(lt),FVEC(eq),FVEC(gt),FVEC(r)) { | ||
1581 | COND_IMP | ||
1582 | } | ||
1583 | |||
1584 | int condD(DVEC(x),DVEC(y),DVEC(lt),DVEC(eq),DVEC(gt),DVEC(r)) { | ||
1585 | COND_IMP | ||
1586 | } | ||
1587 | |||
1588 | int condI(KIVEC(x),KIVEC(y),KIVEC(lt),KIVEC(eq),KIVEC(gt),IVEC(r)) { | ||
1589 | COND_IMP | ||
1590 | } | ||
1591 | |||
1592 | |||
1593 | #define CHOOSE_IMP \ | ||
1594 | REQUIRES(condn==ltn && ltn==eqn && ltn==gtn && ltn==rn ,BAD_SIZE); \ | ||
1595 | int k; \ | ||
1596 | for(k=0;k<condn;k++) { \ | ||
1597 | rp[k] = condp[k]<0?ltp[k]:(condp[k]>0?gtp[k]:eqp[k]); \ | ||
1598 | } \ | ||
1599 | OK | ||
1600 | |||
1601 | int chooseF(KIVEC(cond),KFVEC(lt),KFVEC(eq),KFVEC(gt),FVEC(r)) { | ||
1602 | CHOOSE_IMP | ||
1603 | } | ||
1604 | |||
1605 | int chooseD(KIVEC(cond),KDVEC(lt),KDVEC(eq),KDVEC(gt),DVEC(r)) { | ||
1606 | CHOOSE_IMP | ||
1607 | } | ||
1608 | |||
1609 | int chooseI(KIVEC(cond),KIVEC(lt),KIVEC(eq),KIVEC(gt),IVEC(r)) { | ||
1610 | CHOOSE_IMP | ||
1611 | } | ||
1612 | |||
1613 | int chooseC(KIVEC(cond),KCVEC(lt),KCVEC(eq),KCVEC(gt),CVEC(r)) { | ||
1614 | CHOOSE_IMP | ||
1615 | } | ||
1616 | |||
1617 | int chooseQ(KIVEC(cond),KQVEC(lt),KQVEC(eq),KQVEC(gt),QVEC(r)) { | ||
1618 | CHOOSE_IMP | ||
1619 | } | ||
1620 | |||
1621 | //////////////////////// extract ///////////////////////////////// | 1408 | //////////////////////// extract ///////////////////////////////// |
1622 | 1409 | ||
1623 | #define EXTRACT_IMP \ | 1410 | #define EXTRACT_IMP \ |
@@ -1684,3 +1471,23 @@ int remapQ(KOIMAT(i), KOIMAT(j), KOQMAT(m), OQMAT(r)) { | |||
1684 | REMAP_IMP | 1471 | REMAP_IMP |
1685 | } | 1472 | } |
1686 | 1473 | ||
1474 | //////////////////////////////////////////////////////////////////////////////// | ||
1475 | |||
1476 | int saveMatrix(char * file, char * format, KDMAT(a)){ | ||
1477 | FILE * fp; | ||
1478 | fp = fopen (file, "w"); | ||
1479 | int r, c; | ||
1480 | for (r=0;r<ar; r++) { | ||
1481 | for (c=0; c<ac; c++) { | ||
1482 | fprintf(fp,format,ap[r*ac+c]); | ||
1483 | if (c<ac-1) { | ||
1484 | fprintf(fp," "); | ||
1485 | } else { | ||
1486 | fprintf(fp,"\n"); | ||
1487 | } | ||
1488 | } | ||
1489 | } | ||
1490 | fclose(fp); | ||
1491 | OK | ||
1492 | } | ||
1493 | |||