The R Project SVN R-packages

Rev

Rev 1282 | Rev 1856 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 1282 Rev 1285
Line 134... Line 134...
134 
{
 134 
{
135 
    int classed = asLogical(classedP);
 135 
    int classed = asLogical(classedP);
136 
    SEXP val = PROTECT(NEW_OBJECT(MAKE_CLASS("dgeMatrix"))),
 136 
    SEXP val = PROTECT(NEW_OBJECT(MAKE_CLASS("dgeMatrix"))),
137 
	bdimP = (classed ? GET_SLOT(b, Matrix_DimSym) :
 137 
	bdimP = (classed ? GET_SLOT(b, Matrix_DimSym) :
138 
		 getAttrib(b, R_DimSymbol));
 138 
		 getAttrib(b, R_DimSymbol));
139 
    int *adims = INTEGER(GET_SLOT(a, Matrix_DimSym)),
 - 
 
140 
	*bdims = INTEGER(bdimP);
 139 
    int *bdims = INTEGER(bdimP);
141 
    int i, ione = 1, n = bdims[0], nrhs = bdims[1], info;
 140 
    int i, ione = 1, n = bdims[0], nrhs = bdims[1];
142 
    int sz = n * nrhs;
 141 
    int sz = n * nrhs;
143 
    char *uplo = CHAR(STRING_ELT(GET_SLOT(a, Matrix_uploSym), 0));
 142 
    char *uplo = CHAR(STRING_ELT(GET_SLOT(a, Matrix_uploSym), 0));
144 
    double *ax = REAL(GET_SLOT(a, Matrix_xSym)), one = 1., zero = 0.,
 143 
    double *ax = REAL(GET_SLOT(a, Matrix_xSym)), one = 1., zero = 0.,
145 
	*bx = (classed ? REAL(GET_SLOT(b, Matrix_xSym)) : REAL(b)),
 144 
	*bx = (classed ? REAL(GET_SLOT(b, Matrix_xSym)) : REAL(b)),
146 
	*vx = REAL(ALLOC_SLOT(val, Matrix_xSym, REALSXP, sz));
 145 
	*vx = REAL(ALLOC_SLOT(val, Matrix_xSym, REALSXP, sz));
147 
 
 146 
 
148 
    if (bdims[0] != n)
 147 
    if (bdims[0] != n)
149 
	error(_("Matrices are not conformable for multiplication"));
 148 
	error(_("Matrices are not conformable for multiplication"));
150 
    if (nrhs < 1 || n < 1)
 149 
    if (nrhs < 1 || n < 1)
151 
	error(_("Matrices with zero extents cannot be multiplied"));
 150 
	error(_("Matrices with zero extents cannot be multiplied"));
152
151 
 
153 
    SET_SLOT(val, Matrix_DimSym, duplicate(bdimP));
 152 
    SET_SLOT(val, Matrix_DimSym, duplicate(bdimP));
154 
    for (i = 0; i < nrhs; i++)
 153 
    for (i = 0; i < nrhs; i++)
155 
	F77_CALL(dspmv)(uplo, &n, &one, ax, bx + i * n, &ione,
 154 
	F77_CALL(dspmv)(uplo, &n, &one, ax, bx + i * n, &ione,
156 
			&zero, vx + i * n, &ione);
 155 
			&zero, vx + i * n, &ione);
157 
    UNPROTECT(1);
 156 
    UNPROTECT(1);