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 919, Fri Sep 16 17:27:06 2005 UTC revision 951, Wed Sep 28 12:42:51 2005 UTC
# Line 39  Line 39 
39      if (*typnm == 'I') {      if (*typnm == 'I') {
40          work = (double *) R_alloc(dims[0], sizeof(double));          work = (double *) R_alloc(dims[0], sizeof(double));
41      }      }
42      return F77_CALL(dlantr)(typnm,      return F77_CALL(dlantr)(typnm, uplo_P(obj), diag_P(obj), dims, dims+1,
43                              CHAR(asChar(GET_SLOT(obj, Matrix_uploSym))),                              REAL(GET_SLOT(obj, Matrix_xSym)), dims, work);
                             CHAR(asChar(GET_SLOT(obj, Matrix_diagSym))),  
                             dims, dims+1,  
                             REAL(GET_SLOT(obj, Matrix_xSym)),  
                             dims, work);  
44  }  }
45    
46    
# Line 63  Line 59 
59      typnm[0] = rcond_type(typstr);      typnm[0] = rcond_type(typstr);
60      if (R_IsNA(rcond)) {      if (R_IsNA(rcond)) {
61          int *dims = INTEGER(GET_SLOT(obj, Matrix_DimSym)), info;          int *dims = INTEGER(GET_SLOT(obj, Matrix_DimSym)), info;
62          F77_CALL(dtrcon)(typnm,          F77_CALL(dtrcon)(typnm, uplo_P(obj), diag_P(obj), dims,
63                           CHAR(asChar(GET_SLOT(obj, Matrix_uploSym))),                           REAL(GET_SLOT(obj, Matrix_xSym)), dims, &rcond,
                          CHAR(asChar(GET_SLOT(obj, Matrix_diagSym))),  
                          dims, REAL(GET_SLOT(obj, Matrix_xSym)),  
                          dims, &rcond,  
64                           (double *) R_alloc(3*dims[0], sizeof(double)),                           (double *) R_alloc(3*dims[0], sizeof(double)),
65                           (int *) R_alloc(dims[0], sizeof(int)), &info);                           (int *) R_alloc(dims[0], sizeof(int)), &info);
66          SET_SLOT(obj, Matrix_rcondSym,          SET_SLOT(obj, Matrix_rcondSym,
# Line 85  Line 78 
78  {  {
79      SEXP val = PROTECT(duplicate(a));      SEXP val = PROTECT(duplicate(a));
80      int info, *Dim = INTEGER(GET_SLOT(val, Matrix_DimSym));      int info, *Dim = INTEGER(GET_SLOT(val, Matrix_DimSym));
81      F77_CALL(dtrtri)(CHAR(asChar(GET_SLOT(val, Matrix_uploSym))),      F77_CALL(dtrtri)(uplo_P(val), diag_P(val), Dim,
82                       CHAR(asChar(GET_SLOT(val, Matrix_diagSym))),                       REAL(GET_SLOT(val, Matrix_xSym)), Dim, &info);
                      Dim, REAL(GET_SLOT(val, Matrix_xSym)), Dim, &info);  
83      UNPROTECT(1);      UNPROTECT(1);
84      return val;      return val;
85  }  }
# Line 106  Line 98 
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      Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_DimSym, INTSXP, 2)), bdims, 2);      Memcpy(INTEGER(ALLOC_SLOT(ans, Matrix_DimSym, INTSXP, 2)), bdims, 2);
101      F77_CALL(dtrsm)("L", CHAR(asChar(GET_SLOT(a, Matrix_uploSym))),      F77_CALL(dtrsm)("L", uplo_P(a),
102                      "N", CHAR(asChar(GET_SLOT(a, Matrix_diagSym))),                      "N", diag_P(a),
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(ans, 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);
# Line 136  Line 128 
128      if (m < 1 || n < 1)      if (m < 1 || n < 1)
129          error(_("Matrices with zero extents cannot be multiplied"));          error(_("Matrices with zero extents cannot be multiplied"));
130      cdims[0] = m; cdims[1] = n; sz = m * n;      cdims[0] = m; cdims[1] = n; sz = m * n;
131      F77_CALL(dtrmm)(rt ? "R" : "L", CHAR(asChar(GET_SLOT(a, Matrix_uploSym))),      F77_CALL(dtrmm)(rt ? "R" : "L", uplo_P(a),
132                      "N", CHAR(asChar(GET_SLOT(a, Matrix_diagSym))), &m, &n,                      "N", diag_P(a), &m, &n,
133                      &one, REAL(GET_SLOT(a, Matrix_xSym)), rt ? &n : &m,                      &one, REAL(GET_SLOT(a, Matrix_xSym)), rt ? &n : &m,
134                      Memcpy(REAL(ALLOC_SLOT(val, Matrix_xSym, REALSXP, sz)),                      Memcpy(REAL(ALLOC_SLOT(val, Matrix_xSym, REALSXP, sz)),
135                             REAL(cl ? GET_SLOT(b, Matrix_xSym) : b), sz),                             REAL(cl ? GET_SLOT(b, Matrix_xSym) : b), sz),
# Line 183  Line 175 
175      SEXP ret = PROTECT(allocVector(REALSXP, n)),      SEXP ret = PROTECT(allocVector(REALSXP, n)),
176          xv = GET_SLOT(x, Matrix_xSym);          xv = GET_SLOT(x, Matrix_xSym);
177    
178      if ('U' == CHAR(STRING_ELT(GET_SLOT(x, Matrix_diagSym), 0))[0]) {      if ('U' == diag_P(x)[0]) {
179          for (i = 0; i < n; i++) REAL(ret)[i] = 1.;          for (i = 0; i < n; i++) REAL(ret)[i] = 1.;
180      } else {      } else {
181          for (i = 0; i < n; i++) {          for (i = 0; i < n; i++) {
# Line 206  Line 198 
198          error(_("Matrices are not conformable for multiplication"));          error(_("Matrices are not conformable for multiplication"));
199      if (m < 1 || n < 1 || k < 1)      if (m < 1 || n < 1 || k < 1)
200          error(_("Matrices with zero extents cannot be multiplied"));          error(_("Matrices with zero extents cannot be multiplied"));
201      F77_CALL(dtrmm)("R", CHAR(asChar(GET_SLOT(a, Matrix_uploSym))), "N",      F77_CALL(dtrmm)("R", uplo_P(a), "N", diag_P(a), adims, bdims+1, &one,
                     CHAR(asChar(GET_SLOT(a, Matrix_diagSym))),  
                     adims, bdims+1, &one,  
202                      REAL(GET_SLOT(a, Matrix_xSym)), adims,                      REAL(GET_SLOT(a, Matrix_xSym)), adims,
203                      REAL(GET_SLOT(val, Matrix_xSym)), bdims);                      REAL(GET_SLOT(val, Matrix_xSym)), bdims);
204      UNPROTECT(1);      UNPROTECT(1);

Legend:
Removed from v.919  
changed lines
  Added in v.951

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