summaryrefslogtreecommitdiff
path: root/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c
diff options
context:
space:
mode:
authorAlberto Ruiz <aruiz@um.es>2008-10-15 15:42:12 +0000
committerAlberto Ruiz <aruiz@um.es>2008-10-15 15:42:12 +0000
commit210f0027a7a4614469f8f61eef255852c53e5fb8 (patch)
treeafedc9c7fe7ebc42511758ff71ed43abacce2eba /lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c
parent01744e1df9448a405696d91af709a7416db0cb78 (diff)
debug info for the NaN bug
Diffstat (limited to 'lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c')
-rw-r--r--lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c116
1 files changed, 60 insertions, 56 deletions
diff --git a/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c b/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c
index 0dccea2..61cb002 100644
--- a/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c
+++ b/lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c
@@ -817,20 +817,21 @@ int lu_l_C(KCMAT(a), DVEC(ipiv), CMAT(r)) {
817 817
818//////////////////////////////////////////////////////////// 818////////////////////////////////////////////////////////////
819 819
820int multiplyR(KDMAT(a),KDMAT(b),DMAT(r)) { 820// int multiplyR(KDMAT(a),KDMAT(b),DMAT(r)) {
821 REQUIRES(ac==br && ar==rr && bc==rc,BAD_SIZE); 821// REQUIRES(ac==br && ar==rr && bc==rc,BAD_SIZE);
822 int i,j,k; 822// int i,j,k;
823 for (i=0;i<ar;i++) { 823// for (i=0;i<ar;i++) {
824 for(j=0;j<bc;j++) { 824// for(j=0;j<bc;j++) {
825 double temp = 0; 825// double temp = 0;
826 for(k=0;k<ac;k++) { 826// for(k=0;k<ac;k++) {
827 temp += ap[i*ac+k]*bp[k*bc+j]; 827// temp += ap[i*ac+k]*bp[k*bc+j];
828 } 828// }
829 rp[i*rc+j] = temp; 829// rp[i*rc+j] = temp;
830 } 830// }
831 } 831// }
832 OK 832// OK
833} 833// }
834
834 835
835int multiplyC(KCMAT(a),KCMAT(b),CMAT(r)) { 836int multiplyC(KCMAT(a),KCMAT(b),CMAT(r)) {
836 REQUIRES(ac==br && ar==rr && bc==rc,BAD_SIZE); 837 REQUIRES(ac==br && ar==rr && bc==rc,BAD_SIZE);
@@ -839,52 +840,55 @@ int multiplyC(KCMAT(a),KCMAT(b),CMAT(r)) {
839 for(j=0;j<bc;j++) { 840 for(j=0;j<bc;j++) {
840 doublecomplex temp = {0,0}; 841 doublecomplex temp = {0,0};
841 for(k=0;k<ac;k++) { 842 for(k=0;k<ac;k++) {
842 doublecomplex aik = ((doublecomplex*)ap)[i*ac+k]; 843 doublecomplex A = ((doublecomplex*)ap)[i*ac+k];
843 doublecomplex bkj = ((doublecomplex*)bp)[k*bc+j]; 844 doublecomplex B = ((doublecomplex*)bp)[k*bc+j];
844 //double w = aik.r+aik.i+bkj.r+bkj.i; 845 double w = A.r * B.r - A.i * B.i;
845 //if (w>w) exit(1); 846 double w1 = A.r * B.r;
846 //printf("%d",w>w); 847 double w2 = A.i * B.i;
847 temp.r += aik.r * bkj.r - aik.i * bkj.i; 848 if(w != w) {
848 temp.i += aik.r * bkj.i + aik.i * bkj.r; 849 printf("at : %d %d %d\n",i,j,k);
849 //printf("%f %f %f %f \n",aik.r,aik.i,bkj.r,bkj.i); 850 printf("%f %f %f\n",A.i,B.i, A.i * B.i);
850 //printf("%f %f %f \n",w,temp.r,temp.i); 851 printf("%f %f %f\n",A.i,B.i, w2);
851 852 exit(1);
853 }
854 temp.r += (w + w1-w2)/2;
855 //temp.r += w;
856 temp.i += A.r * B.i + A.i * B.r;
852 } 857 }
853 ((doublecomplex*)rp)[i*rc+j] = temp; 858 ((doublecomplex*)rp)[i*rc+j] = temp;
854 //printf("%f %f\n",temp.r,temp.i);
855 } 859 }
856 } 860 }
857 OK 861 OK
858} 862}
859 863
860void dgemm_(char *, char *, integer *, integer *, integer *, 864// void dgemm_(char *, char *, integer *, integer *, integer *,
861 double *, const double *, integer *, const double *, 865// double *, const double *, integer *, const double *,
862 integer *, double *, double *, integer *); 866// integer *, double *, double *, integer *);
863 867//
864void zgemm_(char *, char *, integer *, integer *, integer *, 868// void zgemm_(char *, char *, integer *, integer *, integer *,
865 doublecomplex *, const doublecomplex *, integer *, const doublecomplex *, 869// doublecomplex *, const doublecomplex *, integer *, const doublecomplex *,
866 integer *, doublecomplex *, doublecomplex *, integer *); 870// integer *, doublecomplex *, doublecomplex *, integer *);
867 871//
868 872//
869int multiplyR2(KDMAT(a),KDMAT(b),DMAT(r)) { 873// int multiplyR2(KDMAT(a),KDMAT(b),DMAT(r)) {
870 REQUIRES(ac==br && ar==rr && bc==rc,BAD_SIZE); 874// REQUIRES(ac==br && ar==rr && bc==rc,BAD_SIZE);
871 double alpha = 1; 875// double alpha = 1;
872 double beta = 0; 876// double beta = 0;
873 integer m = ar; 877// integer m = ar;
874 integer n = bc; 878// integer n = bc;
875 integer k = ac; 879// integer k = ac;
876 int i,j; 880// int i,j;
877 dgemm_("N","N",&m,&n,&k,&alpha,ap,&m,bp,&k,&beta,rp,&m); 881// dgemm_("N","N",&m,&n,&k,&alpha,ap,&m,bp,&k,&beta,rp,&m);
878 OK 882// OK
879} 883// }
880 884//
881int multiplyC2(KCMAT(a),KCMAT(b),CMAT(r)) { 885// int multiplyC2(KCMAT(a),KCMAT(b),CMAT(r)) {
882 REQUIRES(ac==br && ar==rr && bc==rc,BAD_SIZE); 886// REQUIRES(ac==br && ar==rr && bc==rc,BAD_SIZE);
883 integer m = ar; 887// integer m = ar;
884 integer n = bc; 888// integer n = bc;
885 integer k = ac; 889// integer k = ac;
886 doublecomplex alpha = {1,0}; 890// doublecomplex alpha = {1,0};
887 doublecomplex beta = {0,0}; 891// doublecomplex beta = {0,0};
888 zgemm_("N","N",&m,&n,&k,&alpha,(doublecomplex*)ap,&m,(doublecomplex*)bp,&k,&beta,(doublecomplex*)rp,&m); 892// zgemm_("N","N",&m,&n,&k,&alpha,(doublecomplex*)ap,&m,(doublecomplex*)bp,&k,&beta,(doublecomplex*)rp,&m);
889 OK 893// OK
890} 894// }