summaryrefslogtreecommitdiff
path: root/packages/base/src/C
diff options
context:
space:
mode:
Diffstat (limited to 'packages/base/src/C')
-rw-r--r--packages/base/src/C/vector-aux.c104
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
477inline 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 }
500int mapQ(int code, KQVEC(x), QVEC(r)) { 466int 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 }
571int mapValC(int code, doublecomplex* pval, KCVEC(x), CVEC(r)) { 537int 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
588int mapValQ(int code, complex* pval, KQVEC(x), QVEC(r)) { 556int 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 }
641int zipC(int code, KCVEC(a), KCVEC(b), CVEC(r)) { 612int 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
661int zipQ(int code, KQVEC(a), KQVEC(b), QVEC(r)) { 634int 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}