summaryrefslogtreecommitdiff
path: root/packages/base/src
diff options
context:
space:
mode:
authorntfrgl <ntfrgl@beronov.net>2015-08-09 00:06:32 +0200
committerntfrgl <ntfrgl@beronov.net>2015-08-09 00:06:32 +0200
commit6dc70f79414ded94e88755755ffa1c1d16509d9d (patch)
tree1c7bdc4b76a14520e16ed41bd35e2feefcfcfdb2 /packages/base/src
parent8811656fba770ba5ee6e6fe8df7b7c94300cd190 (diff)
Possible fix for #141
Diffstat (limited to 'packages/base/src')
-rw-r--r--packages/base/src/Internal/C/lapack-aux.c12
-rw-r--r--packages/base/src/Internal/C/lapack-aux.h21
-rw-r--r--packages/base/src/Internal/C/vector-aux.c20
3 files changed, 25 insertions, 28 deletions
diff --git a/packages/base/src/Internal/C/lapack-aux.c b/packages/base/src/Internal/C/lapack-aux.c
index 177d373..ff7ad92 100644
--- a/packages/base/src/Internal/C/lapack-aux.c
+++ b/packages/base/src/Internal/C/lapack-aux.c
@@ -55,10 +55,6 @@ typedef float complex TCF;
55#define NODEFPOS 2006 55#define NODEFPOS 2006
56#define NOSPRTD 2007 56#define NOSPRTD 2007
57 57
58inline int mod (int a, int b);
59
60inline int64_t mod_l (int64_t a, int64_t b);
61
62//////////////////////////////////////////////////////////////////////////////// 58////////////////////////////////////////////////////////////////////////////////
63void asm_finit() { 59void asm_finit() {
64#ifdef i386 60#ifdef i386
@@ -247,7 +243,7 @@ int svd_l_C(OCMAT(a),OCMAT(u), DVEC(s),OCMAT(v)) {
247 ldvt = q; 243 ldvt = q;
248 } 244 }
249 }DEBUGMSG("svd_l_C"); 245 }DEBUGMSG("svd_l_C");
250 246
251 double *rwork = (double*) malloc(5*q*sizeof(double)); 247 double *rwork = (double*) malloc(5*q*sizeof(double));
252 CHECK(!rwork,MEM); 248 CHECK(!rwork,MEM);
253 integer lwork = -1; 249 integer lwork = -1;
@@ -423,7 +419,7 @@ int eig_l_R(ODMAT(a),ODMAT(u), CVEC(s),ODMAT(v)) {
423//////////////////// symmetric real eigensystem //////////// 419//////////////////// symmetric real eigensystem ////////////
424 420
425int dsyev_(char *jobz, char *uplo, integer *n, doublereal *a, 421int dsyev_(char *jobz, char *uplo, integer *n, doublereal *a,
426 integer *lda, doublereal *w, doublereal *work, integer *lwork, 422 integer *lda, doublereal *w, doublereal *work, integer *lwork,
427 integer *info); 423 integer *info);
428 424
429int eig_l_S(int wantV,DVEC(s),ODMAT(v)) { 425int eig_l_S(int wantV,DVEC(s),ODMAT(v)) {
@@ -665,7 +661,7 @@ int linearSolveLSC_l(OCMAT(a),OCMAT(b)) {
665int dgelss_(integer *m, integer *n, integer *nrhs, 661int dgelss_(integer *m, integer *n, integer *nrhs,
666 doublereal *a, integer *lda, doublereal *b, integer *ldb, doublereal * 662 doublereal *a, integer *lda, doublereal *b, integer *ldb, doublereal *
667 s, doublereal *rcond, integer *rank, doublereal *work, integer *lwork, 663 s, doublereal *rcond, integer *rank, doublereal *work, integer *lwork,
668 integer *info); 664 integer *info);
669 665
670int linearSolveSVDR_l(double rcond,ODMAT(a),ODMAT(b)) { 666int linearSolveSVDR_l(double rcond,ODMAT(a),ODMAT(b)) {
671 integer m = ar; 667 integer m = ar;
@@ -955,7 +951,7 @@ int schur_l_R(ODMAT(u), ODMAT(s)) {
955int zgees_(char *jobvs, char *sort, L_fp select, integer *n, 951int zgees_(char *jobvs, char *sort, L_fp select, integer *n,
956 doublecomplex *a, integer *lda, integer *sdim, doublecomplex *w, 952 doublecomplex *a, integer *lda, integer *sdim, doublecomplex *w,
957 doublecomplex *vs, integer *ldvs, doublecomplex *work, integer *lwork, 953 doublecomplex *vs, integer *ldvs, doublecomplex *work, integer *lwork,
958 doublereal *rwork, logical *bwork, integer *info); 954 doublereal *rwork, logical *bwork, integer *info);
959 955
960int schur_l_C(OCMAT(u), OCMAT(s)) { 956int schur_l_C(OCMAT(u), OCMAT(s)) {
961 integer m = sr; 957 integer m = sr;
diff --git a/packages/base/src/Internal/C/lapack-aux.h b/packages/base/src/Internal/C/lapack-aux.h
index b38ca7a..e0dd5f6 100644
--- a/packages/base/src/Internal/C/lapack-aux.h
+++ b/packages/base/src/Internal/C/lapack-aux.h
@@ -88,3 +88,24 @@ typedef short ftnlen;
88#define AT(m,i,j) (m##p[(i)*m##Xr + (j)*m##Xc]) 88#define AT(m,i,j) (m##p[(i)*m##Xr + (j)*m##Xc])
89#define TRAV(m,i,j) int i,j; for (i=0;i<m##r;i++) for (j=0;j<m##c;j++) 89#define TRAV(m,i,j) int i,j; for (i=0;i<m##r;i++) for (j=0;j<m##c;j++)
90 90
91/********************************************************/
92
93inline
94int mod (int a, int b) {
95 int m = a % b;
96 if (b>0) {
97 return m >=0 ? m : m+b;
98 } else {
99 return m <=0 ? m : m+b;
100 }
101}
102
103inline
104int64_t mod_l (int64_t a, int64_t b) {
105 int64_t m = a % b;
106 if (b>0) {
107 return m >=0 ? m : m+b;
108 } else {
109 return m <=0 ? m : m+b;
110 }
111}
diff --git a/packages/base/src/Internal/C/vector-aux.c b/packages/base/src/Internal/C/vector-aux.c
index 5528a9d..a52b969 100644
--- a/packages/base/src/Internal/C/vector-aux.c
+++ b/packages/base/src/Internal/C/vector-aux.c
@@ -716,16 +716,6 @@ int mapValF(int code, float* pval, KFVEC(x), FVEC(r)) {
716 } 716 }
717} 717}
718 718
719inline
720int mod (int a, int b) {
721 int m = a % b;
722 if (b>0) {
723 return m >=0 ? m : m+b;
724 } else {
725 return m <=0 ? m : m+b;
726 }
727}
728
729int mapValI(int code, int* pval, KIVEC(x), IVEC(r)) { 719int mapValI(int code, int* pval, KIVEC(x), IVEC(r)) {
730 int k; 720 int k;
731 int val = *pval; 721 int val = *pval;
@@ -742,16 +732,6 @@ int mapValI(int code, int* pval, KIVEC(x), IVEC(r)) {
742 } 732 }
743} 733}
744 734
745inline
746int64_t mod_l (int64_t a, int64_t b) {
747 int64_t m = a % b;
748 if (b>0) {
749 return m >=0 ? m : m+b;
750 } else {
751 return m <=0 ? m : m+b;
752 }
753}
754
755int mapValL(int code, int64_t* pval, KLVEC(x), LVEC(r)) { 735int mapValL(int code, int64_t* pval, KLVEC(x), LVEC(r)) {
756 int k; 736 int k;
757 int64_t val = *pval; 737 int64_t val = *pval;