Mercurial > hg > octave-nkf

comparison liboctave/CMatrix.cc @ 11516:53edbf95fbb6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
avoid GCC warnings
author John W. Eaton <jwe@octave.org>
date Thu, 13 Jan 2011 15:40:14 -0500
parents 5ea2644b0111
children 141b3fb5cef7
comparison
equal deleted inserted replaced
11515:6dbf9bcce90e 11516:53edbf95fbb6
3690 %!assert([rv*M.';rv*M.'],[rv;rv]*M.',1e-14) 3690 %!assert([rv*M.';rv*M.'],[rv;rv]*M.',1e-14)
3691 %!assert([rv*M';rv*M'],[rv;rv]*M',1e-14) 3691 %!assert([rv*M';rv*M'],[rv;rv]*M',1e-14)
3692 %!assert(2*rv*cv,[rv,rv]*[cv;cv],1e-14) 3692 %!assert(2*rv*cv,[rv,rv]*[cv;cv],1e-14)
3693 */ 3693 */
3694 3694
3695 static const char * 3695 static inline char
3696 get_blas_trans_arg (bool trans, bool conj) 3696 get_blas_trans_arg (bool trans, bool conj)
3697 { 3697 {
3698 static char blas_notrans = 'N', blas_trans = 'T', blas_conj_trans = 'C'; 3698 return trans ? (conj ? 'C' : 'T') : 'N';
3699 return trans ? (conj ? &blas_conj_trans : &blas_trans) : &blas_notrans;
3700 } 3699 }
3701 3700
3702 // the general GEMM operation 3701 // the general GEMM operation
3703 3702
3704 ComplexMatrix 3703 ComplexMatrix
3727 octave_idx_type lda = a.rows (); 3726 octave_idx_type lda = a.rows ();
3728 3727
3729 retval = ComplexMatrix (a_nr, b_nc); 3728 retval = ComplexMatrix (a_nr, b_nc);
3730 Complex *c = retval.fortran_vec (); 3729 Complex *c = retval.fortran_vec ();
3731 3730
3732 const char *ctra = get_blas_trans_arg (tra, cja); 3731 const char ctra = get_blas_trans_arg (tra, cja);
3733 if (cja || cjb) 3732 if (cja || cjb)
3734 { 3733 {
3735 F77_XFCN (zherk, ZHERK, (F77_CONST_CHAR_ARG2 ("U", 1), 3734 F77_XFCN (zherk, ZHERK, (F77_CONST_CHAR_ARG2 ("U", 1),
3736 F77_CONST_CHAR_ARG2 (ctra, 1), 3735 F77_CONST_CHAR_ARG2 (&ctra, 1),
3737 a_nr, a_nc, 1.0, 3736 a_nr, a_nc, 1.0,
3738 a.data (), lda, 0.0, c, a_nr 3737 a.data (), lda, 0.0, c, a_nr
3739 F77_CHAR_ARG_LEN (1) 3738 F77_CHAR_ARG_LEN (1)
3740 F77_CHAR_ARG_LEN (1))); 3739 F77_CHAR_ARG_LEN (1)));
3741 for (octave_idx_type j = 0; j < a_nr; j++) 3740 for (octave_idx_type j = 0; j < a_nr; j++)
3743 retval.xelem (j,i) = std::conj (retval.xelem (i,j)); 3742 retval.xelem (j,i) = std::conj (retval.xelem (i,j));
3744 } 3743 }
3745 else 3744 else
3746 { 3745 {
3747 F77_XFCN (zsyrk, ZSYRK, (F77_CONST_CHAR_ARG2 ("U", 1), 3746 F77_XFCN (zsyrk, ZSYRK, (F77_CONST_CHAR_ARG2 ("U", 1),
3748 F77_CONST_CHAR_ARG2 (ctra, 1), 3747 F77_CONST_CHAR_ARG2 (&ctra, 1),
3749 a_nr, a_nc, 1.0, 3748 a_nr, a_nc, 1.0,
3750 a.data (), lda, 0.0, c, a_nr 3749 a.data (), lda, 0.0, c, a_nr
3751 F77_CHAR_ARG_LEN (1) 3750 F77_CHAR_ARG_LEN (1)
3752 F77_CHAR_ARG_LEN (1))); 3751 F77_CHAR_ARG_LEN (1)));
3753 for (octave_idx_type j = 0; j < a_nr; j++) 3752 for (octave_idx_type j = 0; j < a_nr; j++)
3777 else 3776 else
3778 F77_FUNC (xzdotc, XZDOTC) (a_nc, b.data (), 1, a.data (), 1, *c); 3777 F77_FUNC (xzdotc, XZDOTC) (a_nc, b.data (), 1, a.data (), 1, *c);
3779 } 3778 }
3780 else if (b_nc == 1 && ! cjb) 3779 else if (b_nc == 1 && ! cjb)
3781 { 3780 {
3782 const char *ctra = get_blas_trans_arg (tra, cja); 3781 const char ctra = get_blas_trans_arg (tra, cja);
3783 F77_XFCN (zgemv, ZGEMV, (F77_CONST_CHAR_ARG2 (ctra, 1), 3782 F77_XFCN (zgemv, ZGEMV, (F77_CONST_CHAR_ARG2 (&ctra, 1),
3784 lda, tda, 1.0, a.data (), lda, 3783 lda, tda, 1.0, a.data (), lda,
3785 b.data (), 1, 0.0, c, 1 3784 b.data (), 1, 0.0, c, 1
3786 F77_CHAR_ARG_LEN (1))); 3785 F77_CHAR_ARG_LEN (1)));
3787 } 3786 }
3788 else if (a_nr == 1 && ! cja && ! cjb) 3787 else if (a_nr == 1 && ! cja && ! cjb)
3789 { 3788 {
3790 const char *crevtrb = get_blas_trans_arg (! trb, cjb); 3789 const char crevtrb = get_blas_trans_arg (! trb, cjb);
3791 F77_XFCN (zgemv, ZGEMV, (F77_CONST_CHAR_ARG2 (crevtrb, 1), 3790 F77_XFCN (zgemv, ZGEMV, (F77_CONST_CHAR_ARG2 (&crevtrb, 1),
3792 ldb, tdb, 1.0, b.data (), ldb, 3791 ldb, tdb, 1.0, b.data (), ldb,
3793 a.data (), 1, 0.0, c, 1 3792 a.data (), 1, 0.0, c, 1
3794 F77_CHAR_ARG_LEN (1))); 3793 F77_CHAR_ARG_LEN (1)));
3795 } 3794 }
3796 else 3795 else
3797 { 3796 {
3798 const char *ctra = get_blas_trans_arg (tra, cja); 3797 const char ctra = get_blas_trans_arg (tra, cja);
3799 const char *ctrb = get_blas_trans_arg (trb, cjb); 3798 const char ctrb = get_blas_trans_arg (trb, cjb);
3800 F77_XFCN (zgemm, ZGEMM, (F77_CONST_CHAR_ARG2 (ctra, 1), 3799 F77_XFCN (zgemm, ZGEMM, (F77_CONST_CHAR_ARG2 (&ctra, 1),
3801 F77_CONST_CHAR_ARG2 (ctrb, 1), 3800 F77_CONST_CHAR_ARG2 (&ctrb, 1),
3802 a_nr, b_nc, a_nc, 1.0, a.data (), 3801 a_nr, b_nc, a_nc, 1.0, a.data (),
3803 lda, b.data (), ldb, 0.0, c, a_nr 3802 lda, b.data (), ldb, 0.0, c, a_nr
3804 F77_CHAR_ARG_LEN (1) 3803 F77_CHAR_ARG_LEN (1)
3805 F77_CHAR_ARG_LEN (1))); 3804 F77_CHAR_ARG_LEN (1)));
3806 } 3805 }