The R Project SVN – R-packages – Diff – /trunk/Matrix/src/HBMM.c



	error("Invalid code: %s", mm_typecode_to_str(code));
    }
 
    if (mm_is_sparse(code)) mm_read_mtx_crd_size(conn, &M, &N, &nz);
    if (mm_is_dense(code)) mm_read_mtx_array_size(conn, &M, &N);
 
    if (mm_is_real(code)) {
	if (mm_is_sparse(code)) {
	    int *ii, *jj;
	    double *vv;
 

 
    fclose(conn);
    UNPROTECT(1);
    return ans;
}
#endif
 
SEXP Matrix_writeHarwellBoeing(SEXP obj, SEXP file, SEXP typep)
{
    char *type = CHAR(asChar(typep)), Type[4] = "RUA";
    int *dims = INTEGER(GET_SLOT(obj, Matrix_DimSym)),

	nz = LENGTH(islot);
	ii = INTEGER(islot);
	if (type[2] == 'T') {	/* create column pointers */
	    int *i1 = Calloc(nz, int);
	    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];

 
    if (type[0] == 'D') {
	xx = REAL(GET_SLOT(obj, Matrix_xSym));
    } else error("Only real matrices allowed");
 
    if (!isString(file))
	error("non-string values for file not presently accepted");
 
    if (type[1] == 'S') {
	if (*uplo_P(obj) != 'L')
	    error("Symmetric matrices must be stored in lower triangle");
	Type[1] = 'S';
    }
 
    writeHB_mat_double(CHAR(asChar(file)), M, N, nz, pp, ii, xx, 0,
		       (double *)NULL, (double *)NULL, (double *)NULL,
		       "", "", Type, (char*)NULL, (char*)NULL,
		       (char*)NULL, (char*)NULL, "RUA");
 
    if (type[2] == 'T') {Free(ii); Free(pp); Free(xx);}
    return R_NilValue;
}
 

    if (type[0] == 'D') {
	xx = REAL(GET_SLOT(obj, Matrix_xSym));
	mm_set_real(&matcode);
    } else error("Only real matrices allowed");
 
    if (!isString(file))
	error("non-string values for file not currently allowed");
 
    if (type[1] == 'S') {
	if (*uplo_P(obj) != 'L')
	    error("Symmetric matrices must be stored in lower triangle");
	mm_set_symmetric(&matcode);
    }
    if (type[1] == 'G') mm_set_general(&matcode);
 

    mm_write_mtx_crd(CHAR(STRING_ELT(file, 0)), M, N, nz, ii, jj, xx,
		     matcode);
 
    if (type[2] == 'C') Free(jj);
    return R_NilValue;
 
}

Rev 1724	Rev 1862
Line 65...	Line 65...
65	`error("Invalid code: %s", mm_typecode_to_str(code));`	65	`error("Invalid code: %s", mm_typecode_to_str(code));`
66	`}`	66	`}`
67		67
68	`if (mm_is_sparse(code)) mm_read_mtx_crd_size(conn, &M, &N, &nz);`	68	`if (mm_is_sparse(code)) mm_read_mtx_crd_size(conn, &M, &N, &nz);`
69	`if (mm_is_dense(code)) mm_read_mtx_array_size(conn, &M, &N);`	69	`if (mm_is_dense(code)) mm_read_mtx_array_size(conn, &M, &N);`
70		70
71	`if (mm_is_real(code)) {`	71	`if (mm_is_real(code)) {`
72	`if (mm_is_sparse(code)) {`	72	`if (mm_is_sparse(code)) {`
73	`int ii, jj;`	73	`int ii, jj;`
74	`double *vv;`	74	`double *vv;`
75		75
Line 127...	Line 127...
127		127
128	`fclose(conn);`	128	`fclose(conn);`
129	`UNPROTECT(1);`	129	`UNPROTECT(1);`
130	`return ans;`	130	`return ans;`
131	`}`	131	`}`
132	`#endif`	132	`#endif`
133		133
134	`SEXP Matrix_writeHarwellBoeing(SEXP obj, SEXP file, SEXP typep)`	134	`SEXP Matrix_writeHarwellBoeing(SEXP obj, SEXP file, SEXP typep)`
135	`{`	135	`{`
136	`char *type = CHAR(asChar(typep)), Type[4] = "RUA";`	136	`char *type = CHAR(asChar(typep)), Type[4] = "RUA";`
137	`int *dims = INTEGER(GET_SLOT(obj, Matrix_DimSym)),`	137	`int *dims = INTEGER(GET_SLOT(obj, Matrix_DimSym)),`
Line 144...	Line 144...
144	`nz = LENGTH(islot);`	144	`nz = LENGTH(islot);`
145	`ii = INTEGER(islot);`	145	`ii = INTEGER(islot);`
146	`if (type[2] == 'T') { /* create column pointers */`	146	`if (type[2] == 'T') { /* create column pointers */`
147	`int *i1 = Calloc(nz, int);`	147	`int *i1 = Calloc(nz, int);`
148	`double *x1 = Calloc(nz, double);`	148	`double *x1 = Calloc(nz, double);`
149		149
150	`pp = Calloc(N + 1, int);`	150	`pp = Calloc(N + 1, int);`
151	`triplet_to_col(M, N, nz, ii,`	151	`triplet_to_col(M, N, nz, ii,`
152	`INTEGER(GET_SLOT(obj, Matrix_jSym)), xx,`	152	`INTEGER(GET_SLOT(obj, Matrix_jSym)), xx,`
153	`pp, i1, x1);`	153	`pp, i1, x1);`
154	`nz = pp[N];`	154	`nz = pp[N];`
Line 159...	Line 159...
159		159
160	`if (type[0] == 'D') {`	160	`if (type[0] == 'D') {`
161	`xx = REAL(GET_SLOT(obj, Matrix_xSym));`	161	`xx = REAL(GET_SLOT(obj, Matrix_xSym));`
162	`} else error("Only real matrices allowed");`	162	`} else error("Only real matrices allowed");`
163		163
164	`if (!isString(file))`	164	`if (!isString(file))`
165	`error("non-string values for file not presently accepted");`	165	`error("non-string values for file not presently accepted");`
166		166
167	`if (type[1] == 'S') {`	167	`if (type[1] == 'S') {`
168	`if (CHAR(STRING_ELT(GET_SLOT(obj, Matrix_uploSym), 0))[0] != 'L')`	168	`if (*uplo_P(obj) != 'L')`
169	`error("Symmetric matrices must be stored in lower triangle");`	169	`error("Symmetric matrices must be stored in lower triangle");`
170	`Type[1] = 'S';`	170	`Type[1] = 'S';`
171	`}`	171	`}`
172		172
173	`writeHB_mat_double(CHAR(asChar(file)), M, N, nz, pp, ii, xx, 0,`	173	`writeHB_mat_double(CHAR(asChar(file)), M, N, nz, pp, ii, xx, 0,`
174	`(double )NULL, (double )NULL, (double *)NULL,`	174	`(double )NULL, (double )NULL, (double *)NULL,`
175	`"", "", Type, (char)NULL, (char)NULL,`	175	`"", "", Type, (char)NULL, (char)NULL,`
176	`(char)NULL, (char)NULL, "RUA");`	176	`(char)NULL, (char)NULL, "RUA");`
177		177
178	`if (type[2] == 'T') {Free(ii); Free(pp); Free(xx);}`	178	`if (type[2] == 'T') {Free(ii); Free(pp); Free(xx);}`
179	`return R_NilValue;`	179	`return R_NilValue;`
180	`}`	180	`}`
181		181
Line 199...	Line 199...
199	`if (type[0] == 'D') {`	199	`if (type[0] == 'D') {`
200	`xx = REAL(GET_SLOT(obj, Matrix_xSym));`	200	`xx = REAL(GET_SLOT(obj, Matrix_xSym));`
201	`mm_set_real(&matcode);`	201	`mm_set_real(&matcode);`
202	`} else error("Only real matrices allowed");`	202	`} else error("Only real matrices allowed");`
203		203
204	`if (!isString(file))`	204	`if (!isString(file))`
205	`error("non-string values for file not currently allowed");`	205	`error("non-string values for file not currently allowed");`
206		206
207	`if (type[1] == 'S') {`	207	`if (type[1] == 'S') {`
208	`if (CHAR(STRING_ELT(GET_SLOT(obj, Matrix_uploSym), 0))[0] != 'L')`	208	`if (*uplo_P(obj) != 'L')`
209	`error("Symmetric matrices must be stored in lower triangle");`	209	`error("Symmetric matrices must be stored in lower triangle");`
210	`mm_set_symmetric(&matcode);`	210	`mm_set_symmetric(&matcode);`
211	`}`	211	`}`
212	`if (type[1] == 'G') mm_set_general(&matcode);`	212	`if (type[1] == 'G') mm_set_general(&matcode);`
213		213
Line 221...	Line 221...
221	`mm_write_mtx_crd(CHAR(STRING_ELT(file, 0)), M, N, nz, ii, jj, xx,`	221	`mm_write_mtx_crd(CHAR(STRING_ELT(file, 0)), M, N, nz, ii, jj, xx,`
222	`matcode);`	222	`matcode);`
223		223
224	`if (type[2] == 'C') Free(jj);`	224	`if (type[2] == 'C') Free(jj);`
225	`return R_NilValue;`	225	`return R_NilValue;`
226		226
227	`}`	227	`}`

The R Project SVN R-packages

(root)/trunk/Matrix/src/HBMM.c @ 1908 – Rev 1724 → 1862