diff options
Diffstat (limited to 'packages/base/src/C')
-rw-r--r-- | packages/base/src/C/vector-aux.c | 104 |
1 files changed, 40 insertions, 64 deletions
diff --git a/packages/base/src/C/vector-aux.c b/packages/base/src/C/vector-aux.c index be2dc3a..7cdc750 100644 --- a/packages/base/src/C/vector-aux.c +++ b/packages/base/src/C/vector-aux.c | |||
@@ -29,19 +29,6 @@ typedef float complex TCF; | |||
29 | 29 | ||
30 | #define CHECK(RES,CODE) MACRO(if(RES) return CODE;) | 30 | #define CHECK(RES,CODE) MACRO(if(RES) return CODE;) |
31 | 31 | ||
32 | #ifdef DBG | ||
33 | #define DEBUGMAT(MSG,X) printf(MSG" = \n"); gsl_matrix_fprintf(stdout,X,"%f"); printf("\n"); | ||
34 | #else | ||
35 | #define DEBUGMAT(MSG,X) | ||
36 | #endif | ||
37 | |||
38 | #ifdef DBG | ||
39 | #define DEBUGVEC(MSG,X) printf(MSG" = \n"); gsl_vector_fprintf(stdout,X,"%f"); printf("\n"); | ||
40 | #else | ||
41 | #define DEBUGVEC(MSG,X) | ||
42 | #endif | ||
43 | |||
44 | |||
45 | #define BAD_SIZE 2000 | 32 | #define BAD_SIZE 2000 |
46 | #define BAD_CODE 2001 | 33 | #define BAD_CODE 2001 |
47 | #define MEM 2002 | 34 | #define MEM 2002 |
@@ -358,7 +345,7 @@ int mapR(int code, KDVEC(x), DVEC(r)) { | |||
358 | OP(3,fabs) | 345 | OP(3,fabs) |
359 | OP(4,asin) | 346 | OP(4,asin) |
360 | OP(5,acos) | 347 | OP(5,acos) |
361 | OP(6,atan) /* atan2 using vectorZip */ | 348 | OP(6,atan) |
362 | OP(7,sinh) | 349 | OP(7,sinh) |
363 | OP(8,cosh) | 350 | OP(8,cosh) |
364 | OP(9,tanh) | 351 | OP(9,tanh) |
@@ -384,7 +371,7 @@ int mapF(int code, KFVEC(x), FVEC(r)) { | |||
384 | OP(3,fabs) | 371 | OP(3,fabs) |
385 | OP(4,asin) | 372 | OP(4,asin) |
386 | OP(5,acos) | 373 | OP(5,acos) |
387 | OP(6,atan) /* atan2 using vectorZip */ | 374 | OP(6,atan) |
388 | OP(7,sinh) | 375 | OP(7,sinh) |
389 | OP(8,cosh) | 376 | OP(8,cosh) |
390 | OP(9,tanh) | 377 | OP(9,tanh) |
@@ -474,29 +461,8 @@ inline complex complex_f_math_fun(doublecomplex (*cf)(doublecomplex), complex a) | |||
474 | return float_r; | 461 | return float_r; |
475 | } | 462 | } |
476 | 463 | ||
477 | inline complex complex_f_math_op(doublecomplex (*cf)(doublecomplex,doublecomplex), | ||
478 | complex a,complex b) | ||
479 | { | ||
480 | doublecomplex c1,c2,r; | ||
481 | |||
482 | complex float_r; | ||
483 | |||
484 | c1.r = a.r; | ||
485 | c1.i = a.i; | ||
486 | |||
487 | c2.r = b.r; | ||
488 | c2.i = b.i; | ||
489 | |||
490 | r = (*cf)(c1,c2); | ||
491 | |||
492 | float_r.r = r.r; | ||
493 | float_r.i = r.i; | ||
494 | |||
495 | return float_r; | ||
496 | } | ||
497 | 464 | ||
498 | #define OPC(C,F) case C: { for(k=0;k<xn;k++) rp[k] = complex_f_math_fun(&F,xp[k]); OK } | 465 | #define OPC(C,F) case C: { for(k=0;k<xn;k++) rp[k] = complex_f_math_fun(&F,xp[k]); OK } |
499 | #define OPCA(C,F,A,B) case C: { for(k=0;k<xn;k++) rp[k] = complex_f_math_op(&F,A,B); OK } | ||
500 | int mapQ(int code, KQVEC(x), QVEC(r)) { | 466 | int mapQ(int code, KQVEC(x), QVEC(r)) { |
501 | TCF* x2p = (TCF*)xp; | 467 | TCF* x2p = (TCF*)xp; |
502 | TCF* r2p = (TCF*)rp; | 468 | TCF* r2p = (TCF*)rp; |
@@ -567,36 +533,40 @@ inline doublecomplex complex_add(doublecomplex a, doublecomplex b) { | |||
567 | return r; | 533 | return r; |
568 | } | 534 | } |
569 | 535 | ||
570 | 536 | #define OPVb(C,E) case C: { for(k=0;k<xn;k++) r2p[k] = E; OK } | |
571 | int mapValC(int code, doublecomplex* pval, KCVEC(x), CVEC(r)) { | 537 | int mapValC(int code, doublecomplex* pval, KCVEC(x), CVEC(r)) { |
538 | TCD* x2p = (TCD*)xp; | ||
539 | TCD* r2p = (TCD*)rp; | ||
572 | int k; | 540 | int k; |
573 | doublecomplex val = *pval; | 541 | TCD val = * (TCD*)pval; |
574 | REQUIRES(xn == rn,BAD_SIZE); | 542 | REQUIRES(xn == rn,BAD_SIZE); |
575 | DEBUGMSG("mapValC"); | 543 | DEBUGMSG("mapValC"); |
576 | switch (code) { | 544 | switch (code) { |
577 | // OPV(0,gsl_complex_mul(val,xp[k])) | 545 | OPVb(0,val*x2p[k]) |
578 | // OPV(1,gsl_complex_div(val,xp[k])) | 546 | OPVb(1,val/x2p[k]) |
579 | OPV(2,complex_add(val,xp[k])) | 547 | OPVb(2,val+x2p[k]) |
580 | // OPV(3,gsl_complex_sub(val,xp[k])) | 548 | OPVb(3,val-x2p[k]) |
581 | // OPV(4,gsl_complex_pow(val,xp[k])) | 549 | OPVb(4,cpow(val,x2p[k])) |
582 | // OPV(5,gsl_complex_pow(xp[k],val)) | 550 | OPVb(5,cpow(x2p[k],val)) |
583 | default: ERROR(BAD_CODE); | 551 | default: ERROR(BAD_CODE); |
584 | } | 552 | } |
585 | } | 553 | } |
586 | 554 | ||
587 | 555 | ||
588 | int mapValQ(int code, complex* pval, KQVEC(x), QVEC(r)) { | 556 | int mapValQ(int code, complex* pval, KQVEC(x), QVEC(r)) { |
557 | TCF* x2p = (TCF*)xp; | ||
558 | TCF* r2p = (TCF*)rp; | ||
589 | int k; | 559 | int k; |
590 | complex val = *pval; | 560 | TCF val = *(TCF*)pval; |
591 | REQUIRES(xn == rn,BAD_SIZE); | 561 | REQUIRES(xn == rn,BAD_SIZE); |
592 | DEBUGMSG("mapValQ"); | 562 | DEBUGMSG("mapValQ"); |
593 | switch (code) { | 563 | switch (code) { |
594 | // OPCA(0,gsl_complex_mul,val,xp[k]) | 564 | OPVb(0,val*x2p[k]) |
595 | // OPCA(1,gsl_complex_div,val,xp[k]) | 565 | OPVb(1,val/x2p[k]) |
596 | OPCA(2,complex_add,val,xp[k]) | 566 | OPVb(2,val+x2p[k]) |
597 | // OPCA(3,gsl_complex_sub,val,xp[k]) | 567 | OPVb(3,val-x2p[k]) |
598 | // OPCA(4,gsl_complex_pow,val,xp[k]) | 568 | OPVb(4,cpow(val,x2p[k])) |
599 | // OPCA(5,gsl_complex_pow,xp[k],val) | 569 | OPVb(5,cpow(x2p[k],val)) |
600 | default: ERROR(BAD_CODE); | 570 | default: ERROR(BAD_CODE); |
601 | } | 571 | } |
602 | } | 572 | } |
@@ -637,17 +607,20 @@ REQUIRES(an == bn && an == rn, BAD_SIZE); | |||
637 | 607 | ||
638 | 608 | ||
639 | 609 | ||
640 | 610 | #define OPZOb(C,msg,O) case C: {DEBUGMSG(msg) for(k=0;k<an;k++) r2p[k] = a2p[k] O b2p[k]; OK } | |
611 | #define OPZEb(C,msg,E) case C: {DEBUGMSG(msg) for(k=0;k<an;k++) r2p[k] = E(a2p[k],b2p[k]); OK } | ||
641 | int zipC(int code, KCVEC(a), KCVEC(b), CVEC(r)) { | 612 | int zipC(int code, KCVEC(a), KCVEC(b), CVEC(r)) { |
642 | REQUIRES(an == bn && an == rn, BAD_SIZE); | 613 | REQUIRES(an == bn && an == rn, BAD_SIZE); |
614 | TCD* a2p = (TCD*)ap; | ||
615 | TCD* b2p = (TCD*)bp; | ||
616 | TCD* r2p = (TCD*)rp; | ||
643 | int k; | 617 | int k; |
644 | switch(code) { | 618 | switch(code) { |
645 | OPZE(0,"zipC Add",complex_add) | 619 | OPZOb(0,"zipC Add",+) |
646 | // OPZE(1,"zipC Sub",gsl_complex_sub) | 620 | OPZOb(1,"zipC Sub",-) |
647 | // OPZE(2,"zipC Mul",gsl_complex_mul) | 621 | OPZOb(2,"zipC Mul",*) |
648 | // OPZE(3,"zipC Div",gsl_complex_div) | 622 | OPZOb(3,"zipC Div",/) |
649 | // OPZE(4,"zipC Pow",gsl_complex_pow) | 623 | OPZEb(4,"zipC Pow",cpow) |
650 | // //OPZE(5,"zipR ATan2",atan2) | ||
651 | default: ERROR(BAD_CODE); | 624 | default: ERROR(BAD_CODE); |
652 | } | 625 | } |
653 | } | 626 | } |
@@ -660,14 +633,17 @@ int zipC(int code, KCVEC(a), KCVEC(b), CVEC(r)) { | |||
660 | 633 | ||
661 | int zipQ(int code, KQVEC(a), KQVEC(b), QVEC(r)) { | 634 | int zipQ(int code, KQVEC(a), KQVEC(b), QVEC(r)) { |
662 | REQUIRES(an == bn && an == rn, BAD_SIZE); | 635 | REQUIRES(an == bn && an == rn, BAD_SIZE); |
636 | TCF* a2p = (TCF*)ap; | ||
637 | TCF* b2p = (TCF*)bp; | ||
638 | TCF* r2p = (TCF*)rp; | ||
639 | |||
663 | int k; | 640 | int k; |
664 | switch(code) { | 641 | switch(code) { |
665 | OPCZE(0,"zipQ Add",complex_add) | 642 | OPZOb(0,"zipC Add",+) |
666 | // OPCZE(1,"zipQ Sub",gsl_complex_sub) | 643 | OPZOb(1,"zipC Sub",-) |
667 | // OPCZE(2,"zipQ Mul",gsl_complex_mul) | 644 | OPZOb(2,"zipC Mul",*) |
668 | // OPCZE(3,"zipQ Div",gsl_complex_div) | 645 | OPZOb(3,"zipC Div",/) |
669 | // OPCZE(4,"zipQ Pow",gsl_complex_pow) | 646 | OPZEb(4,"zipC Pow",cpowf) |
670 | // //OPZE(5,"zipR ATan2",atan2) | ||
671 | default: ERROR(BAD_CODE); | 647 | default: ERROR(BAD_CODE); |
672 | } | 648 | } |
673 | } | 649 | } |