SCM

SCM Repository

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

Diff of /pkg/src/dtrMatrix.c

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

revision 688, Sat Apr 2 13:18:16 2005 UTC revision 846, Wed Aug 10 22:08:35 2005 UTC
# Line 9  Line 9 
9  SEXP dtrMatrix_validate(SEXP obj)  SEXP dtrMatrix_validate(SEXP obj)
10  {  {
11      SEXP val;      SEXP val;
12        int *Dims = INTEGER(GET_SLOT(obj, Matrix_DimSym));
13    
14        if (Dims[0] != Dims[1])
15            return mkString(_("Matrix is not square"));
16      if (isString(val = check_scalar_string(GET_SLOT(obj, Matrix_uploSym),      if (isString(val = check_scalar_string(GET_SLOT(obj, Matrix_uploSym),
17                                             "LU", "uplo"))) return val;                                             "LU", "uplo"))) return val;
18      if (isString(val = check_scalar_string(GET_SLOT(obj, Matrix_diagSym),      if (isString(val = check_scalar_string(GET_SLOT(obj, Matrix_diagSym),
# Line 84  Line 87 
87  SEXP dtrMatrix_matrix_solve(SEXP a, SEXP b, SEXP classed)  SEXP dtrMatrix_matrix_solve(SEXP a, SEXP b, SEXP classed)
88  {  {
89      int cl = asLogical(classed);      int cl = asLogical(classed);
90      SEXP val = PROTECT(NEW_OBJECT(MAKE_CLASS("dgeMatrix")));      SEXP ans = PROTECT(NEW_OBJECT(MAKE_CLASS("dgeMatrix")));
91      int *adims = INTEGER(GET_SLOT(a, Matrix_DimSym)),      int *adims = INTEGER(GET_SLOT(a, Matrix_DimSym)),
92          *bdims = INTEGER(cl ? GET_SLOT(b, Matrix_DimSym) :          *bdims = INTEGER(cl ? GET_SLOT(b, Matrix_DimSym) :
93                           getAttrib(b, R_DimSymbol));                           getAttrib(b, R_DimSymbol));
# Line 94  Line 97 
97    
98      if (*adims != *bdims || bdims[1] < 1 || *adims < 1 || *adims != adims[1])      if (*adims != *bdims || bdims[1] < 1 || *adims < 1 || *adims != adims[1])
99          error(_("Dimensions of system to be solved are inconsistent"));          error(_("Dimensions of system to be solved are inconsistent"));
100      F77_CALL(dtrsm)("L", CHAR(asChar(GET_SLOT(val, Matrix_uploSym))),      Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_DimSym, INTSXP, 2)), bdims, 2);
101                      "N", CHAR(asChar(GET_SLOT(val, Matrix_diagSym))),      F77_CALL(dtrsm)("L", CHAR(asChar(GET_SLOT(a, Matrix_uploSym))),
102                        "N", CHAR(asChar(GET_SLOT(a, Matrix_diagSym))),
103                      &n, &nrhs, &one, REAL(GET_SLOT(a, Matrix_xSym)), &n,                      &n, &nrhs, &one, REAL(GET_SLOT(a, Matrix_xSym)), &n,
104                      Memcpy(REAL(ALLOC_SLOT(val, Matrix_xSym, REALSXP, sz)),                      Memcpy(REAL(ALLOC_SLOT(ans, Matrix_xSym, REALSXP, sz)),
105                             REAL(cl ? GET_SLOT(b, Matrix_xSym):b), sz), &n);                             REAL(cl ? GET_SLOT(b, Matrix_xSym):b), sz), &n);
106      UNPROTECT(1);      UNPROTECT(1);
107      return val;      return ans;
108  }  }
109    
110  SEXP dtrMatrix_matrix_mm(SEXP a, SEXP b, SEXP classed, SEXP right)  SEXP dtrMatrix_matrix_mm(SEXP a, SEXP b, SEXP classed, SEXP right)

Legend:
Removed from v.688  
changed lines
  Added in v.846

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