SCM

SCM Repository

[matrix] Diff of /pkg/src/dspMatrix.c
ViewVC logotype

Diff of /pkg/src/dspMatrix.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1462, Tue Aug 29 16:34:49 2006 UTC revision 1463, Tue Aug 29 22:30:57 2006 UTC
# Line 75  Line 75 
75          *bdims = INTEGER(GET_SLOT(val, Matrix_DimSym));          *bdims = INTEGER(GET_SLOT(val, Matrix_DimSym));
76      int n = bdims[0], nrhs = bdims[1], info;      int n = bdims[0], nrhs = bdims[1], info;
77    
78      if (*adims != *bdims || bdims[1] < 1 || *adims < 1)      if (adims[0] != n || nrhs < 1 || n < 1)
79          error(_("Dimensions of system to be solved are inconsistent"));          error(_("Dimensions of system to be solved are inconsistent"));
80      F77_CALL(dsptrs)(uplo_P(trf),      F77_CALL(dsptrs)(uplo_P(trf),
81                       &n, &nrhs, REAL(GET_SLOT(trf, Matrix_xSym)),                       &n, &nrhs, REAL(GET_SLOT(trf, Matrix_xSym)),
# Line 103  Line 103 
103      return val;      return val;
104  }  }
105    
106  SEXP dspMatrix_matrix_mm(SEXP a, SEXP b, SEXP classedP)  SEXP dspMatrix_matrix_mm(SEXP a, SEXP b)
107  {  {
108      int classed = asLogical(classedP);      SEXP val = PROTECT(dup_mMatrix_as_dgeMatrix(b));
109      SEXP val = PROTECT(NEW_OBJECT(MAKE_CLASS("dgeMatrix"))),      int *bdims = INTEGER(GET_SLOT(val, Matrix_DimSym));
         bdimP = (classed ? GET_SLOT(b, Matrix_DimSym) :  
                  getAttrib(b, R_DimSymbol));  
     int *bdims = INTEGER(bdimP);  
110      int i, ione = 1, n = bdims[0], nrhs = bdims[1];      int i, ione = 1, n = bdims[0], nrhs = bdims[1];
     int sz = n * nrhs;  
111      char *uplo = uplo_P(a);      char *uplo = uplo_P(a);
112      double *ax = REAL(GET_SLOT(a, Matrix_xSym)), one = 1., zero = 0.,      double *ax = REAL(GET_SLOT(a, Matrix_xSym)), one = 1., zero = 0.,
113          *bx = (classed ? REAL(GET_SLOT(b, Matrix_xSym)) : REAL(b)),          *vx = REAL(GET_SLOT(val, Matrix_xSym));
114          *vx = REAL(ALLOC_SLOT(val, Matrix_xSym, REALSXP, sz));      double *bx = Memcpy(Calloc(n * nrhs, double), vx, n * nrhs);
115    
116      if (bdims[0] != n)      if (bdims[0] != n)
117          error(_("Matrices are not conformable for multiplication"));          error(_("Matrices are not conformable for multiplication"));
118      if (nrhs < 1 || n < 1)      if (nrhs < 1 || n < 1)
119          error(_("Matrices with zero extents cannot be multiplied"));          error(_("Matrices with zero extents cannot be multiplied"));
   
     SET_SLOT(val, Matrix_DimSym, duplicate(bdimP));  
120      for (i = 0; i < nrhs; i++)      for (i = 0; i < nrhs; i++)
121          F77_CALL(dspmv)(uplo, &n, &one, ax, bx + i * n, &ione,          F77_CALL(dspmv)(uplo, &n, &one, ax, bx + i * n, &ione,
122                          &zero, vx + i * n, &ione);                          &zero, vx + i * n, &ione);
123        Free(bx);
124      UNPROTECT(1);      UNPROTECT(1);
125      return val;      return val;
126  }  }

Legend:
Removed from v.1462  
changed lines
  Added in v.1463

root@r-forge.r-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business Powered By FusionForge