SCM

SCM Repository

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

Diff of /pkg/src/HBMM.c

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

revision 1536, Fri Sep 8 12:59:48 2006 UTC revision 1537, Fri Sep 8 13:16:55 2006 UTC
# Line 4  Line 4 
4    
5  SEXP Matrix_writeHarwellBoeing(SEXP obj, SEXP file, SEXP typep)  SEXP Matrix_writeHarwellBoeing(SEXP obj, SEXP file, SEXP typep)
6  {  {
7      char *type = CHAR(asChar(typep)), Type[4] = "RUA";      char *type = CHAR(asChar(typep)), *Type = strdup("RUA");
8      int *dims = INTEGER(GET_SLOT(obj, Matrix_DimSym)),      int *dims = INTEGER(GET_SLOT(obj, Matrix_DimSym)),
9          *ii = (int *) NULL, *pp = (int *) NULL;          *ii = (int *) NULL, *pp = (int *) NULL;
10      int M = dims[0], N = dims[1], nz = -1;      int M = dims[0], N = dims[1], nz = -1;
11      double *xx = (double *) NULL;      double *xx = (double *) NULL;
12    
13      if (type[2] == 'C' || type[2] == 'T') {      if (type[2] == 'C') {
14          SEXP islot = GET_SLOT(obj, Matrix_iSym);          SEXP islot = GET_SLOT(obj, Matrix_iSym);
15          nz = LENGTH(islot);          nz = LENGTH(islot);
16          ii = INTEGER(islot);          ii = INTEGER(islot);
17          if (type[2] == 'T') {   /* create column pointers */          pp = INTEGER(GET_SLOT(obj, Matrix_pSym));
18              int *i1 = Calloc(nz, int);      } else error("Only type 'C' allowed");
             double *x1 = Calloc(nz, double);  
   
             pp = Calloc(N + 1, int);  
             triplet_to_col(M, N, nz, ii,  
                            INTEGER(GET_SLOT(obj, Matrix_jSym)), xx,  
                            pp, i1, x1);  
             nz = pp[N];  
             xx = x1;  
             ii = i1;  
         } else pp = INTEGER(GET_SLOT(obj, Matrix_pSym));  
     } else error("Only types 'C' and 'T' allowed");  
19    
20      if (type[0] == 'D') {      if (type[0] == 'D') {
21          xx = REAL(GET_SLOT(obj, Matrix_xSym));          xx = REAL(GET_SLOT(obj, Matrix_xSym));
# Line 46  Line 35 
35                         "", "", Type, (char*)NULL, (char*)NULL,                         "", "", Type, (char*)NULL, (char*)NULL,
36                         (char*)NULL, (char*)NULL, "RUA");                         (char*)NULL, (char*)NULL, "RUA");
37    
38      if (type[2] == 'T') {Free(ii); Free(pp); Free(xx);}      Free(Type);
39      return R_NilValue;      return R_NilValue;
40  }  }
41    

Legend:
Removed from v.1536  
changed lines
  Added in v.1537

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