SCM

SCM Repository

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

Diff of /pkg/src/dpoMatrix.c

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

revision 647, Tue Mar 15 00:56:35 2005 UTC revision 648, Tue Mar 15 00:58:37 2005 UTC
# Line 18  Line 18 
18      SEXP val = get_factors(x, "Cholesky"),      SEXP val = get_factors(x, "Cholesky"),
19          dimP = GET_SLOT(x, Matrix_DimSym),          dimP = GET_SLOT(x, Matrix_DimSym),
20          uploP = GET_SLOT(x, Matrix_uploSym);          uploP = GET_SLOT(x, Matrix_uploSym);
21      int *dims, info;      char *uplo = CHAR(STRING_ELT(uploP, 0));
22        int *dims = INTEGER(dimP), info;
23        int n = dims[0];
24        double *vx;
25    
26      if (val != R_NilValue) return val;      if (val != R_NilValue) return val;
27      dims = INTEGER(dimP);      dims = INTEGER(dimP);
28      val = PROTECT(NEW_OBJECT(MAKE_CLASS("Cholesky")));      val = PROTECT(NEW_OBJECT(MAKE_CLASS("Cholesky")));
29      SET_SLOT(val, Matrix_uploSym, duplicate(uploP));      SET_SLOT(val, Matrix_uploSym, duplicate(uploP));
30      SET_SLOT(val, Matrix_diagSym, mkString("N"));      SET_SLOT(val, Matrix_diagSym, mkString("N"));
     SET_SLOT(val, Matrix_rcondSym, allocVector(REALSXP, 0));  
     SET_SLOT(val, Matrix_factorSym, allocVector(VECSXP, 0));  
     SET_SLOT(val, Matrix_xSym, duplicate(GET_SLOT(x, Matrix_xSym)));  
31      SET_SLOT(val, Matrix_DimSym, duplicate(dimP));      SET_SLOT(val, Matrix_DimSym, duplicate(dimP));
32      F77_CALL(dpotrf)(CHAR(asChar(uploP)), dims,      vx = REAL(ALLOC_SLOT(val, Matrix_xSym, REALSXP, n * n));
33                       REAL(GET_SLOT(val, Matrix_xSym)), dims, &info);      AZERO(vx, n * n);
34      if (info) error(_("Lapack routine dpotrf returned error code %d"), info);      F77_CALL(dlacpy)(uplo, &n, &n, REAL(GET_SLOT(x, Matrix_xSym)), &n, vx, &n);
35        F77_CALL(dpotrf)(uplo, &n, vx, &n, &info);
36        if (info) error(_("Lapack routine %s returned error code %d"), "dpotrf", info);
37      UNPROTECT(1);      UNPROTECT(1);
38      return set_factors(x, val, "Cholesky");      return set_factors(x, val, "Cholesky");
39  }  }

Legend:
Removed from v.647  
changed lines
  Added in v.648

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