diff options
Diffstat (limited to 'lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c')
-rw-r--r-- | lib/Numeric/LinearAlgebra/LAPACK/lapack-aux.c | 116 |
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 | ||
820 | int 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 | ||
835 | int multiplyC(KCMAT(a),KCMAT(b),CMAT(r)) { | 836 | int 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 | ||
860 | void 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 | // | |
864 | void 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 | // | |
869 | int 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 | // | |
881 | int 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 | // } |