SCM

SCM Repository

[matrix] Diff of /branches/Matrix-mer2/src/dppMatrix.c
ViewVC logotype

Diff of /branches/Matrix-mer2/src/dppMatrix.c

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

revision 653, Wed Mar 16 16:17:43 2005 UTC revision 654, Wed Mar 16 16:18:33 2005 UTC
# Line 76  Line 76 
76      return val;      return val;
77  }  }
78    
79  SEXP dppMatrix_matrix_solve(SEXP a, SEXP b, SEXP classedP)  SEXP dppMatrix_matrix_solve(SEXP a, SEXP b, SEXP classed)
80  {  {
81      int classed = asLogical(classedP);      int cl = asLogical(classed);
82      SEXP Chol = dppMatrix_chol(a),      SEXP Chol = dppMatrix_chol(a),
83          val = PROTECT(NEW_OBJECT(MAKE_CLASS("dgeMatrix")));          val = PROTECT(NEW_OBJECT(MAKE_CLASS("dgeMatrix")));
84      int *adims = INTEGER(GET_SLOT(a, Matrix_DimSym)),      int *adims = INTEGER(GET_SLOT(a, Matrix_DimSym)),
85          *bdims = (classed ? INTEGER(GET_SLOT(b, Matrix_DimSym)) :          *bdims = (cl ? INTEGER(GET_SLOT(b, Matrix_DimSym)) :
86                    INTEGER(getAttrib(b, R_DimSymbol)));                    INTEGER(getAttrib(b, R_DimSymbol)));
87      int n = bdims[0], nrhs = bdims[1], info;      int n = bdims[0], nrhs = bdims[1], info;
88      int sz = n * nrhs;      int sz = n * nrhs;
     double *bx = (classed ? REAL(GET_SLOT(b, Matrix_xSym)) : REAL(b));  
89    
90      if (!classed && !(isReal(b) && isMatrix(b)))      if (!cl && !(isReal(b) && isMatrix(b)))
91          error(_("Argument b must be a numeric matrix"));          error(_("Argument b must be a numeric matrix"));
92      if (*adims != *bdims || bdims[1] < 1 || *adims < 1)      if (*adims != *bdims || bdims[1] < 1 || *adims < 1)
93          error(_("Dimensions of system to be solved are inconsistent"));          error(_("Dimensions of system to be solved are inconsistent"));
94      Memcpy(INTEGER(ALLOC_SLOT(val, Matrix_DimSym, INTSXP, 2)), bdims, 2);      Memcpy(INTEGER(ALLOC_SLOT(val, Matrix_DimSym, INTSXP, 2)), bdims, 2);
95      F77_CALL(dpptrs)(CHAR(asChar(GET_SLOT(Chol, Matrix_uploSym))),      F77_CALL(dpptrs)
96                       &n, &nrhs, REAL(GET_SLOT(Chol, Matrix_xSym)),          (CHAR(asChar(GET_SLOT(Chol, Matrix_uploSym))), &n, &nrhs,
97             REAL(GET_SLOT(Chol, Matrix_xSym)),
98                       Memcpy(REAL(ALLOC_SLOT(val, Matrix_xSym, REALSXP, sz)),                       Memcpy(REAL(ALLOC_SLOT(val, Matrix_xSym, REALSXP, sz)),
99                              bx, sz), &n, &info);                  REAL(cl ? GET_SLOT(b, Matrix_xSym) : b), sz), &n, &info);
100      UNPROTECT(1);      UNPROTECT(1);
101      return val;      return val;
102  }  }

Legend:
Removed from v.653  
changed lines
  Added in v.654

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