Tpetra parallel linear algebra Version of the Day
Loading...
Searching...
No Matches
Tpetra_Util_iohb.cpp
1/*
2Fri Aug 15 16:29:47 EDT 1997
3
4 Harwell-Boeing File I/O in C
5 V. 1.0
6
7 National Institute of Standards and Technology, MD.
8 K.A. Remington
9
10++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
11 NOTICE
12
13 Permission to use, copy, modify, and distribute this software and
14 its documentation for any purpose and without fee is hereby granted
15 provided that the above copyright notice appear in all copies and
16 that both the copyright notice and this permission notice appear in
17 supporting documentation.
18
19 Neither the Author nor the Institution (National Institute of Standards
20 and Technology) make any representations about the suitability of this
21 software for any purpose. This software is provided "as is" without
22 expressed or implied warranty.
23++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
24
25 ---------------------
26 INTERFACE DESCRIPTION
27 ---------------------
28 ---------------
29 QUERY FUNCTIONS
30 ---------------
31
32 FUNCTION:
33
34 int readHB_info(const char *filename, int *M, int *N, int *nz,
35 char **Type, int *Nrhs)
36
37 DESCRIPTION:
38
39 The readHB_info function opens and reads the header information from
40 the specified Harwell-Boeing file, and reports back the number of rows
41 and columns in the stored matrix (M and N), the number of nonzeros in
42 the matrix (nz), the 3-character matrix type(Type), and the number of
43 right-hand-sides stored along with the matrix (Nrhs). This function
44 is designed to retrieve basic size information which can be used to
45 allocate arrays.
46
47 FUNCTION:
48
49 int readHB_header(std::FILE* in_file, char* Title, char* Key, char* Type,
50 int* Nrow, int* Ncol, int* Nnzero, int* Nrhs,
51 char* Ptrfmt, char* Indfmt, char* Valfmt, char* Rhsfmt,
52 int* Ptrcrd, int* Indcrd, int* Valcrd, int* Rhscrd,
53 char *Rhstype)
54
55 DESCRIPTION:
56
57 More detailed than the readHB_info function, readHB_header() reads from
58 the specified Harwell-Boeing file all of the header information.
59
60
61 ------------------------------
62 DOUBLE PRECISION I/O FUNCTIONS
63 ------------------------------
64 FUNCTION:
65
66 int readHB_newmat_double(const char *filename, int *M, int *N, *int nz,
67 int **colptr, int **rowind, double**val)
68
69 int readHB_mat_double(const char *filename, int *colptr, int *rowind,
70 double*val)
71
72
73 DESCRIPTION:
74
75 This function opens and reads the specified file, interpreting its
76 contents as a sparse matrix stored in the Harwell/Boeing standard
77 format. (See readHB_aux_double to read auxillary vectors.)
78 -- Values are interpreted as double precision numbers. --
79
80 The "mat" function uses _pre-allocated_ vectors to hold the index and
81 nonzero value information.
82
83 The "newmat" function allocates vectors to hold the index and nonzero
84 value information, and returns pointers to these vectors along with
85 matrix dimension and number of nonzeros.
86
87 FUNCTION:
88
89 int readHB_aux_double(const char* filename, const char AuxType, double b[])
90
91 int readHB_newaux_double(const char* filename, const char AuxType, double** b)
92
93 DESCRIPTION:
94
95 This function opens and reads from the specified file auxillary vector(s).
96 The char argument Auxtype determines which type of auxillary vector(s)
97 will be read (if present in the file).
98
99 AuxType = 'F' right-hand-side
100 AuxType = 'G' initial estimate (Guess)
101 AuxType = 'X' eXact solution
102
103 If Nrhs > 1, all of the Nrhs vectors of the given type are read and
104 stored in column-major order in the vector b.
105
106 The "newaux" function allocates a vector to hold the values retrieved.
107 The "mat" function uses a _pre-allocated_ vector to hold the values.
108
109 FUNCTION:
110
111 int writeHB_mat_double(const char* filename, int M, int N,
112 int nz, const int colptr[], const int rowind[],
113 const double val[], int Nrhs, const double rhs[],
114 const double guess[], const double exact[],
115 const char* Title, const char* Key, const char* Type,
116 char* Ptrfmt, char* Indfmt, char* Valfmt, char* Rhsfmt,
117 const char* Rhstype)
118
119 DESCRIPTION:
120
121 The writeHB_mat_double function opens the named file and writes the specified
122 matrix and optional auxillary vector(s) to that file in Harwell-Boeing
123 format. The format arguments (Ptrfmt,Indfmt,Valfmt, and Rhsfmt) are
124 character strings specifying "Fortran-style" output formats -- as they
125 would appear in a Harwell-Boeing file. They are used to produce output
126 which is as close as possible to what would be produced by Fortran code,
127 but note that "D" and "P" edit descriptors are not supported.
128 If NULL, the following defaults will be used:
129 Ptrfmt = Indfmt = "(8I10)"
130 Valfmt = Rhsfmt = "(4E20.13)"
131
132 -----------------------
133 CHARACTER I/O FUNCTIONS
134 -----------------------
135 FUNCTION:
136
137 int readHB_mat_char(const char* filename, int colptr[], int rowind[],
138 char val[], char* Valfmt)
139 int readHB_newmat_char(const char* filename, int* M, int* N, int* nonzeros,
140 int** colptr, int** rowind, char** val, char** Valfmt)
141
142 DESCRIPTION:
143
144 This function opens and reads the specified file, interpreting its
145 contents as a sparse matrix stored in the Harwell/Boeing standard
146 format. (See readHB_aux_char to read auxillary vectors.)
147 -- Values are interpreted as char strings. --
148 (Used to translate exact values from the file into a new storage format.)
149
150 The "mat" function uses _pre-allocated_ arrays to hold the index and
151 nonzero value information.
152
153 The "newmat" function allocates char arrays to hold the index
154 and nonzero value information, and returns pointers to these arrays
155 along with matrix dimension and number of nonzeros.
156
157 FUNCTION:
158
159 int readHB_aux_char(const char* filename, const char AuxType, char b[])
160 int readHB_newaux_char(const char* filename, const char AuxType, char** b,
161 char** Rhsfmt)
162
163 DESCRIPTION:
164
165 This function opens and reads from the specified file auxillary vector(s).
166 The char argument Auxtype determines which type of auxillary vector(s)
167 will be read (if present in the file).
168
169 AuxType = 'F' right-hand-side
170 AuxType = 'G' initial estimate (Guess)
171 AuxType = 'X' eXact solution
172
173 If Nrhs > 1, all of the Nrhs vectors of the given type are read and
174 stored in column-major order in the vector b.
175
176 The "newaux" function allocates a character array to hold the values
177 retrieved.
178 The "mat" function uses a _pre-allocated_ array to hold the values.
179
180 FUNCTION:
181
182 int writeHB_mat_char(const char* filename, int M, int N,
183 int nz, const int colptr[], const int rowind[],
184 const char val[], int Nrhs, const char rhs[],
185 const char guess[], const char exact[],
186 const char* Title, const char* Key, const char* Type,
187 char* Ptrfmt, char* Indfmt, char* Valfmt, char* Rhsfmt,
188 const char* Rhstype)
189
190 DESCRIPTION:
191
192 The writeHB_mat_char function opens the named file and writes the specified
193 matrix and optional auxillary vector(s) to that file in Harwell-Boeing
194 format. The format arguments (Ptrfmt,Indfmt,Valfmt, and Rhsfmt) are
195 character strings specifying "Fortran-style" output formats -- as they
196 would appear in a Harwell-Boeing file. Valfmt and Rhsfmt must accurately
197 represent the character representation of the values stored in val[]
198 and rhs[].
199
200 If NULL, the following defaults will be used for the integer vectors:
201 Ptrfmt = Indfmt = "(8I10)"
202 Valfmt = Rhsfmt = "(4E20.13)"
203
204
205*/
206
207/*---------------------------------------------------------------------*/
208/* If zero-based indexing is desired, _SP_base should be set to 0 */
209/* This will cause indices read from H-B files to be decremented by 1 */
210/* and indices written to H-B files to be incremented by 1 */
211/* <<< Standard usage is _SP_base = 1 >>> */
212#ifndef _SP_base
213#define _SP_base 1
214#endif
215/*---------------------------------------------------------------------*/
216
217#include "Tpetra_Util_iohb.h"
218
219#include <cstring>
220#include <cmath>
221#include <cstdlib>
222#include <cctype>
223
224namespace Tpetra::HB {
225
226using ::std::free;
227using ::std::malloc;
228using ::std::size_t;
229
230char* substr(const char* S, const int pos, const int len);
231void upcase(char* S);
232void IOHBTerminate(const char* message);
233
234int readHB_info(const char* filename, int* M, int* N, int* nz, std::string& Type,
235 int* Nrhs) {
236 /****************************************************************************/
237 /* The readHB_info function opens and reads the header information from */
238 /* the specified Harwell-Boeing file, and reports back the number of rows */
239 /* and columns in the stored matrix (M and N), the number of nonzeros in */
240 /* the matrix (nz), and the number of right-hand-sides stored along with */
241 /* the matrix (Nrhs). */
242 /* */
243 /* For a description of the Harwell Boeing standard, see: */
244 /* Duff, et al., ACM TOMS Vol.15, No.1, March 1989 */
245 /* */
246 /* ---------- */
247 /* **CAVEAT** */
248 /* ---------- */
249 /* ** If the input file does not adhere to the H/B format, the ** */
250 /* ** results will be unpredictable. ** */
251 /* */
252 /****************************************************************************/
253 std::FILE* in_file;
254 int Ptrcrd, Indcrd, Valcrd, Rhscrd;
255 int Nrow, Ncol, Nnzero;
256 char mat_type[4];
257 char Title[73], Key[9], Rhstype[4];
258 char Ptrfmt[17], Indfmt[17], Valfmt[21], Rhsfmt[21];
259
260 if ((in_file = std::fopen(filename, "r")) == NULL) {
261 std::fprintf(stderr, "Error: Cannot open file: %s\n", filename);
262 return 0;
263 }
264
265 readHB_header(in_file, Title, Key, mat_type, &Nrow, &Ncol, &Nnzero, Nrhs,
266 Ptrfmt, Indfmt, Valfmt, Rhsfmt,
267 &Ptrcrd, &Indcrd, &Valcrd, &Rhscrd, Rhstype);
268 std::fclose(in_file);
269 Type = std::string(mat_type, 3);
270 *M = Nrow;
271 *N = Ncol;
272 *nz = Nnzero;
273 if (Rhscrd == 0) {
274 *Nrhs = 0;
275 }
276
277 /* In verbose mode, print some of the header information: */
278 /*
279 if (verbose == 1)
280 {
281 printf("Reading from Harwell-Boeing file %s (verbose on)...\n",filename);
282 printf(" Title: %s\n",Title);
283 printf(" Key: %s\n",Key);
284 printf(" The stored matrix is %i by %i with %i nonzeros.\n",
285 *M, *N, *nz );
286 printf(" %i right-hand--side(s) stored.\n",*Nrhs);
287 }
288 */
289
290 return 1;
291}
292
293int readHB_header(std::FILE* in_file, char* Title, char* Key, char* Type,
294 int* Nrow, int* Ncol, int* Nnzero, int* Nrhs,
295 char* Ptrfmt, char* Indfmt, char* Valfmt, char* Rhsfmt,
296 int* Ptrcrd, int* Indcrd, int* Valcrd, int* Rhscrd,
297 char* Rhstype) {
298 /*************************************************************************/
299 /* Read header information from the named H/B file... */
300 /*************************************************************************/
301 int Totcrd, Neltvl, Nrhsix;
302 char line[BUFSIZ];
303
304 /* First line: */
305 if (std::fgets(line, BUFSIZ, in_file) == NULL) {
306 std::fprintf(stderr, "Error: Failed to read from file.\n");
307 return 0;
308 }
309 if (std::sscanf(line, "%*s") < 0)
310 IOHBTerminate("Trilinos_Util_iohb.cpp: Null (or blank) first line of HB file.\n");
311 (void)std::sscanf(line, "%72c%8[^\n]", Title, Key);
312 *(Key + 8) = '\0';
313 *(Title + 72) = '\0';
314
315 /* Second line: */
316 if (std::fgets(line, BUFSIZ, in_file) == NULL) {
317 std::fprintf(stderr, "Error: Failed to read from file.\n");
318 return 0;
319 }
320 if (std::sscanf(line, "%*s") < 0)
321 IOHBTerminate("Trilinos_Util_iohb.cpp: Null (or blank) second line of HB file.\n");
322 if (std::sscanf(line, "%i", &Totcrd) != 1) Totcrd = 0;
323 if (std::sscanf(line, "%*i%i", Ptrcrd) != 1) *Ptrcrd = 0;
324 if (std::sscanf(line, "%*i%*i%i", Indcrd) != 1) *Indcrd = 0;
325 if (std::sscanf(line, "%*i%*i%*i%i", Valcrd) != 1) *Valcrd = 0;
326 if (std::sscanf(line, "%*i%*i%*i%*i%i", Rhscrd) != 1) *Rhscrd = 0;
327
328 /* Third line: */
329 if (std::fgets(line, BUFSIZ, in_file) == NULL) {
330 std::fprintf(stderr, "Error: Failed to read from file.\n");
331 return 0;
332 }
333 if (std::sscanf(line, "%*s") < 0)
334 IOHBTerminate("Trilinos_Util_iohb.cpp: Null (or blank) third line of HB file.\n");
335 *(Type + 3) = '\0';
336 if (std::sscanf(line, "%3c", Type) != 1)
337 IOHBTerminate("Trilinos_Util_iohb.cpp: Invalid Type info, line 3 of Harwell-Boeing file.\n");
338 upcase(Type);
339 if (std::sscanf(line, "%*3c%i", Nrow) != 1) *Nrow = 0;
340 if (std::sscanf(line, "%*3c%*i%i", Ncol) != 1) *Ncol = 0;
341 if (std::sscanf(line, "%*3c%*i%*i%i", Nnzero) != 1) *Nnzero = 0;
342 if (std::sscanf(line, "%*3c%*i%*i%*i%i", &Neltvl) != 1) Neltvl = 0;
343
344 /* Fourth line: */
345 if (std::fgets(line, BUFSIZ, in_file) == NULL) {
346 std::fprintf(stderr, "Error: Failed to read from file.\n");
347 return 0;
348 }
349 if (std::sscanf(line, "%*s") < 0)
350 IOHBTerminate("Trilinos_Util_iohb.cpp: Null (or blank) fourth line of HB file.\n");
351 if (std::sscanf(line, "%16c", Ptrfmt) != 1)
352 IOHBTerminate("Trilinos_Util_iohb.cpp: Invalid format info, line 4 of Harwell-Boeing file.\n");
353 if (std::sscanf(line, "%*16c%16c", Indfmt) != 1)
354 IOHBTerminate("Trilinos_Util_iohb.cpp: Invalid format info, line 4 of Harwell-Boeing file.\n");
355 if (std::sscanf(line, "%*16c%*16c%20c", Valfmt) != 1)
356 IOHBTerminate("Trilinos_Util_iohb.cpp: Invalid format info, line 4 of Harwell-Boeing file.\n");
357 std::sscanf(line, "%*16c%*16c%*20c%20c", Rhsfmt);
358 *(Ptrfmt + 16) = '\0';
359 *(Indfmt + 16) = '\0';
360 *(Valfmt + 20) = '\0';
361 *(Rhsfmt + 20) = '\0';
362
363 /* (Optional) Fifth line: */
364 if (*Rhscrd != 0) {
365 if (std::fgets(line, BUFSIZ, in_file) == NULL) {
366 std::fprintf(stderr, "Error: Failed to read from file.\n");
367 return 0;
368 }
369 if (std::sscanf(line, "%*s") < 0)
370 IOHBTerminate("Trilinos_Util_iohb.cpp: Null (or blank) fifth line of HB file.\n");
371 if (std::sscanf(line, "%3c", Rhstype) != 1)
372 IOHBTerminate("Trilinos_Util_iohb.cpp: Invalid RHS type information, line 5 of Harwell-Boeing file.\n");
373 if (std::sscanf(line, "%*3c%i", Nrhs) != 1) *Nrhs = 0;
374 if (std::sscanf(line, "%*3c%*i%i", &Nrhsix) != 1) Nrhsix = 0;
375 }
376 return 1;
377}
378
379int readHB_mat_double(const char* filename, int colptr[], int rowind[],
380 double val[]) {
381 /****************************************************************************/
382 /* This function opens and reads the specified file, interpreting its */
383 /* contents as a sparse matrix stored in the Harwell/Boeing standard */
384 /* format and creating compressed column storage scheme vectors to hold */
385 /* the index and nonzero value information. */
386 /* */
387 /* ---------- */
388 /* **CAVEAT** */
389 /* ---------- */
390 /* Parsing real formats from Fortran is tricky, and this file reader */
391 /* does not claim to be foolproof. It has been tested for cases when */
392 /* the real values are printed consistently and evenly spaced on each */
393 /* line, with Fixed (F), and Exponential (E or D) formats. */
394 /* */
395 /* ** If the input file does not adhere to the H/B format, the ** */
396 /* ** results will be unpredictable. ** */
397 /* */
398 /****************************************************************************/
399 std::FILE* in_file;
400 int i, j, ind, col, offset, count, last, Nrhs;
401 int Ptrcrd, Indcrd, Valcrd, Rhscrd;
402 int Nrow, Ncol, Nnzero, Nentries;
403 int Ptrperline, Ptrwidth, Indperline, Indwidth;
404 int Valperline, Valwidth, Valprec;
405 int Valflag; /* Indicates 'E','D', or 'F' float format */
406 char* ThisElement;
407 char Title[73], Key[9], Type[4] = "XXX", Rhstype[4];
408 char Ptrfmt[17], Indfmt[17], Valfmt[21], Rhsfmt[21];
409 char line[BUFSIZ];
410
411 if ((in_file = std::fopen(filename, "r")) == NULL) {
412 std::fprintf(stderr, "Error: Cannot open file: %s\n", filename);
413 return 0;
414 }
415
416 readHB_header(in_file, Title, Key, Type, &Nrow, &Ncol, &Nnzero, &Nrhs,
417 Ptrfmt, Indfmt, Valfmt, Rhsfmt,
418 &Ptrcrd, &Indcrd, &Valcrd, &Rhscrd, Rhstype);
419
420 /* Parse the array input formats from Line 3 of HB file */
421 ParseIfmt(Ptrfmt, &Ptrperline, &Ptrwidth);
422 ParseIfmt(Indfmt, &Indperline, &Indwidth);
423 if (Type[0] != 'P') { /* Skip if pattern only */
424 ParseRfmt(Valfmt, &Valperline, &Valwidth, &Valprec, &Valflag);
425 }
426
427 /* Read column pointer array: */
428
429 offset = 1 - _SP_base; /* if base 0 storage is declared (via macro definition), */
430 /* then storage entries are offset by 1 */
431
432 ThisElement = (char*)malloc(Ptrwidth + 1);
433 if (ThisElement == NULL) IOHBTerminate("Insufficient memory for ThisElement.");
434 *(ThisElement + Ptrwidth) = '\0';
435 count = 0;
436 for (i = 0; i < Ptrcrd; i++) {
437 if (std::fgets(line, BUFSIZ, in_file) == NULL) {
438 std::fprintf(stderr, "Error: Failed to read from file.\n");
439 return 0;
440 }
441 if (std::sscanf(line, "%*s") < 0)
442 IOHBTerminate("Trilinos_Util_iohb.cpp: Null (or blank) line in pointer data region of HB file.\n");
443 col = 0;
444 for (ind = 0; ind < Ptrperline; ind++) {
445 if (count > Ncol) break;
446 std::strncpy(ThisElement, line + col, Ptrwidth);
447 /* ThisElement = substr(line,col,Ptrwidth); */
448 colptr[count] = std::atoi(ThisElement) - offset;
449 count++;
450 col += Ptrwidth;
451 }
452 }
453 free(ThisElement);
454
455 /* Read row index array: */
456
457 ThisElement = (char*)malloc(Indwidth + 1);
458 if (ThisElement == NULL) IOHBTerminate("Insufficient memory for ThisElement.");
459 *(ThisElement + Indwidth) = '\0';
460 count = 0;
461 for (i = 0; i < Indcrd; i++) {
462 if (std::fgets(line, BUFSIZ, in_file) == NULL) {
463 std::fprintf(stderr, "Error: Failed to read from file.\n");
464 return 0;
465 }
466 if (std::sscanf(line, "%*s") < 0)
467 IOHBTerminate("Trilinos_Util_iohb.cpp: Null (or blank) line in index data region of HB file.\n");
468 col = 0;
469 for (ind = 0; ind < Indperline; ind++) {
470 if (count == Nnzero) break;
471 std::strncpy(ThisElement, line + col, Indwidth);
472 /* ThisElement = substr(line,col,Indwidth); */
473 rowind[count] = std::atoi(ThisElement) - offset;
474 count++;
475 col += Indwidth;
476 }
477 }
478 free(ThisElement);
479
480 /* Read array of values: */
481
482 if (Type[0] != 'P') { /* Skip if pattern only */
483
484 if (Type[0] == 'C')
485 Nentries = 2 * Nnzero;
486 else
487 Nentries = Nnzero;
488
489 ThisElement = (char*)malloc(Valwidth + 2);
490 if (ThisElement == NULL) IOHBTerminate("Insufficient memory for ThisElement.");
491 *(ThisElement + Valwidth) = '\0';
492 *(ThisElement + Valwidth + 1) = '\0';
493 count = 0;
494 for (i = 0; i < Valcrd; i++) {
495 if (std::fgets(line, BUFSIZ, in_file) == NULL) {
496 std::fprintf(stderr, "Error: Failed to read from file.\n");
497 return 0;
498 }
499 if (std::sscanf(line, "%*s") < 0)
500 IOHBTerminate("Trilinos_Util_iohb.cpp: Null (or blank) line in value data region of HB file.\n");
501 if (Valflag == 'D') {
502 while (std::strchr(line, 'D')) *std::strchr(line, 'D') = 'E';
503 /* *std::strchr(Valfmt,'D') = 'E'; */
504 }
505 col = 0;
506 for (ind = 0; ind < Valperline; ind++) {
507 if (count == Nentries) break;
508 std::strncpy(ThisElement, line + col, Valwidth);
509 /*ThisElement = substr(line,col,Valwidth);*/
510 if (Valflag != 'F' && std::strchr(ThisElement, 'E') == NULL) {
511 /* insert a char prefix for exp */
512 last = std::strlen(ThisElement);
513 for (j = last + 1; j >= 0; j--) {
514 ThisElement[j] = ThisElement[j - 1];
515 if (ThisElement[j] == '+' || ThisElement[j] == '-') {
516 ThisElement[j - 1] = Valflag;
517 break;
518 }
519 }
520 }
521 val[count] = std::atof(ThisElement);
522 count++;
523 col += Valwidth;
524 *(ThisElement + Valwidth) = '\0';
525 *(ThisElement + Valwidth + 1) = '\0';
526 }
527 }
528 free(ThisElement);
529 }
530
531 std::fclose(in_file);
532 return 1;
533}
534
535int readHB_newmat_double(const char* filename, int* M, int* N, int* nonzeros,
536 int** colptr, int** rowind, double** val) {
537 int Nrhs;
538 std::string Type;
539
540 if (readHB_info(filename, M, N, nonzeros, Type, &Nrhs) == 0) {
541 return 0;
542 }
543
544 *colptr = (int*)malloc((*N + 1) * sizeof(int));
545 if (*colptr == NULL) IOHBTerminate("Insufficient memory for colptr.\n");
546 *rowind = (int*)malloc(*nonzeros * sizeof(int));
547 if (*rowind == NULL) IOHBTerminate("Insufficient memory for rowind.\n");
548 if (Type[0] == 'C') {
549 /* Malloc enough space for real AND imaginary parts of val[] */
550 *val = (double*)malloc(*nonzeros * sizeof(double) * 2);
551 if (*val == NULL) IOHBTerminate("Insufficient memory for val.\n");
552 } else {
553 if (Type[0] != 'P') {
554 /* Malloc enough space for real array val[] */
555 *val = (double*)malloc(*nonzeros * sizeof(double));
556 if (*val == NULL) IOHBTerminate("Insufficient memory for val.\n");
557 }
558 } /* No val[] space needed if pattern only */
559 return readHB_mat_double(filename, *colptr, *rowind, *val);
560}
561
562int readHB_aux_double(const char* filename, const char AuxType, double b[]) {
563 /****************************************************************************/
564 /* This function opens and reads the specified file, placing auxillary */
565 /* vector(s) of the given type (if available) in b. */
566 /* Return value is the number of vectors successfully read. */
567 /* */
568 /* AuxType = 'F' full right-hand-side vector(s) */
569 /* AuxType = 'G' initial Guess vector(s) */
570 /* AuxType = 'X' eXact solution vector(s) */
571 /* */
572 /* ---------- */
573 /* **CAVEAT** */
574 /* ---------- */
575 /* Parsing real formats from Fortran is tricky, and this file reader */
576 /* does not claim to be foolproof. It has been tested for cases when */
577 /* the real values are printed consistently and evenly spaced on each */
578 /* line, with Fixed (F), and Exponential (E or D) formats. */
579 /* */
580 /* ** If the input file does not adhere to the H/B format, the ** */
581 /* ** results will be unpredictable. ** */
582 /* */
583 /****************************************************************************/
584 std::FILE* in_file;
585 int i, j, n, maxcol, start, stride, col, last, linel;
586 int Ptrcrd, Indcrd, Valcrd, Rhscrd;
587 int Nrow, Ncol, Nnzero, Nentries;
588 int Nrhs, nvecs, rhsi;
589 int Rhsperline, Rhswidth, Rhsprec;
590 int Rhsflag;
591 char* ThisElement;
592 char Title[73], Key[9], Type[4] = "XXX", Rhstype[4];
593 char Ptrfmt[17], Indfmt[17], Valfmt[21], Rhsfmt[21];
594 char line[BUFSIZ];
595
596 if ((in_file = std::fopen(filename, "r")) == NULL) {
597 std::fprintf(stderr, "Error: Cannot open file: %s\n", filename);
598 return 0;
599 }
600
601 readHB_header(in_file, Title, Key, Type, &Nrow, &Ncol, &Nnzero, &Nrhs,
602 Ptrfmt, Indfmt, Valfmt, Rhsfmt,
603 &Ptrcrd, &Indcrd, &Valcrd, &Rhscrd, Rhstype);
604
605 if (Nrhs <= 0) {
606 std::fprintf(stderr, "Warn: Attempt to read auxillary vector(s) when none are present.\n");
607 return 0;
608 }
609 if (Rhstype[0] != 'F') {
610 std::fprintf(stderr, "Warn: Attempt to read auxillary vector(s) which are not stored in Full form.\n");
611 std::fprintf(stderr, " Rhs must be specified as full. \n");
612 return 0;
613 }
614
615 /* If reading complex data, allow for interleaved real and imaginary values. */
616 if (Type[0] == 'C') {
617 Nentries = 2 * Nrow;
618 } else {
619 Nentries = Nrow;
620 }
621
622 nvecs = 1;
623
624 if (Rhstype[1] == 'G') nvecs++;
625 if (Rhstype[2] == 'X') nvecs++;
626
627 if (AuxType == 'G' && Rhstype[1] != 'G') {
628 std::fprintf(stderr, "Warn: Attempt to read auxillary Guess vector(s) when none are present.\n");
629 return 0;
630 }
631 if (AuxType == 'X' && Rhstype[2] != 'X') {
632 std::fprintf(stderr, "Warn: Attempt to read auxillary eXact solution vector(s) when none are present.\n");
633 return 0;
634 }
635
636 ParseRfmt(Rhsfmt, &Rhsperline, &Rhswidth, &Rhsprec, &Rhsflag);
637 maxcol = Rhsperline * Rhswidth;
638
639 /* Lines to skip before starting to read RHS values... */
640 n = Ptrcrd + Indcrd + Valcrd;
641
642 for (i = 0; i < n; i++) {
643 if (std::fgets(line, BUFSIZ, in_file) == NULL) {
644 std::fprintf(stderr, "Error: Failed to read from file.\n");
645 return 0;
646 }
647 }
648
649 /* start - number of initial aux vector entries to skip */
650 /* to reach first vector requested */
651 /* stride - number of aux vector entries to skip between */
652 /* requested vectors */
653 if (AuxType == 'F')
654 start = 0;
655 else if (AuxType == 'G')
656 start = Nentries;
657 else
658 start = (nvecs - 1) * Nentries;
659 stride = (nvecs - 1) * Nentries;
660
661 if (std::fgets(line, BUFSIZ, in_file) == NULL) {
662 std::fprintf(stderr, "Error: Failed to read from file.\n");
663 return 0;
664 }
665 linel = std::strchr(line, '\n') - line;
666 col = 0;
667 /* Skip to initial offset */
668
669 for (i = 0; i < start; i++) {
670 if (col >= (maxcol < linel ? maxcol : linel)) {
671 if (std::fgets(line, BUFSIZ, in_file) == NULL) {
672 std::fprintf(stderr, "Error: Failed to read from file.\n");
673 return 0;
674 }
675 linel = std::strchr(line, '\n') - line;
676 col = 0;
677 }
678 col += Rhswidth;
679 }
680 if (Rhsflag == 'D') {
681 while (std::strchr(line, 'D')) *std::strchr(line, 'D') = 'E';
682 }
683
684 /* Read a vector of desired type, then skip to next */
685 /* repeating to fill Nrhs vectors */
686
687 ThisElement = (char*)malloc(Rhswidth + 1);
688 if (ThisElement == NULL) IOHBTerminate("Insufficient memory for ThisElement.");
689 *(ThisElement + Rhswidth) = '\0';
690 for (rhsi = 0; rhsi < Nrhs; rhsi++) {
691 for (i = 0; i < Nentries; i++) {
692 if (col >= (maxcol < linel ? maxcol : linel)) {
693 if (std::fgets(line, BUFSIZ, in_file) == NULL) {
694 std::fprintf(stderr, "Error: Failed to read from file.\n");
695 return 0;
696 }
697 linel = std::strchr(line, '\n') - line;
698 if (Rhsflag == 'D') {
699 while (std::strchr(line, 'D')) *std::strchr(line, 'D') = 'E';
700 }
701 col = 0;
702 }
703 std::strncpy(ThisElement, line + col, Rhswidth);
704 /*ThisElement = substr(line, col, Rhswidth);*/
705 if (Rhsflag != 'F' && std::strchr(ThisElement, 'E') == NULL) {
706 /* insert a char prefix for exp */
707 last = std::strlen(ThisElement);
708 for (j = last + 1; j >= 0; j--) {
709 ThisElement[j] = ThisElement[j - 1];
710 if (ThisElement[j] == '+' || ThisElement[j] == '-') {
711 ThisElement[j - 1] = Rhsflag;
712 break;
713 }
714 }
715 }
716 b[i] = std::atof(ThisElement);
717 col += Rhswidth;
718 }
719
720 /* Skip any interleaved Guess/eXact vectors */
721
722 for (i = 0; i < stride; i++) {
723 if (col >= (maxcol < linel ? maxcol : linel)) {
724 if (std::fgets(line, BUFSIZ, in_file) == NULL) {
725 std::fprintf(stderr, "Error: Failed to read from file.\n");
726 return 0;
727 }
728 linel = std::strchr(line, '\n') - line;
729 col = 0;
730 }
731 col += Rhswidth;
732 }
733 }
734 free(ThisElement);
735
736 std::fclose(in_file);
737 return Nrhs;
738}
739
740int readHB_newaux_double(const char* filename, const char AuxType, double** b) {
741 int Nrhs = 0;
742 int M = 0;
743 int N = 0;
744 int nonzeros = 0;
745 std::string Type;
746
747 readHB_info(filename, &M, &N, &nonzeros, Type, &Nrhs);
748 if (Nrhs <= 0) {
749 std::fprintf(stderr, "Warn: Requested read of aux vector(s) when none are present.\n");
750 return 0;
751 } else {
752 if (Type[0] == 'C') {
753 std::fprintf(stderr, "Warning: Reading complex aux vector(s) from HB file %s.", filename);
754 std::fprintf(stderr, " Real and imaginary parts will be interlaced in b[].");
755 *b = (double*)malloc(M * Nrhs * sizeof(double) * 2);
756 if (*b == NULL) IOHBTerminate("Insufficient memory for rhs.\n");
757 return readHB_aux_double(filename, AuxType, *b);
758 } else {
759 *b = (double*)malloc(M * Nrhs * sizeof(double));
760 if (*b == NULL) IOHBTerminate("Insufficient memory for rhs.\n");
761 return readHB_aux_double(filename, AuxType, *b);
762 }
763 }
764}
765
766int writeHB_mat_double(const char* filename, int M, int N,
767 int nz, const int colptr[], const int rowind[],
768 const double val[], int Nrhs, const double rhs[],
769 const double guess[], const double exact[],
770 const char* Title, const char* Key, const char* Type,
771 char* Ptrfmt, char* Indfmt, char* Valfmt, char* Rhsfmt,
772 const char* Rhstype) {
773 /****************************************************************************/
774 /* The writeHB function opens the named file and writes the specified */
775 /* matrix and optional right-hand-side(s) to that file in Harwell-Boeing */
776 /* format. */
777 /* */
778 /* For a description of the Harwell Boeing standard, see: */
779 /* Duff, et al., ACM TOMS Vol.15, No.1, March 1989 */
780 /* */
781 /****************************************************************************/
782 std::FILE* out_file;
783 int i, j, entry, offset, acount, linemod;
784 int totcrd, ptrcrd, indcrd, valcrd, rhscrd;
785 int nvalentries, nrhsentries;
786 int Ptrperline, Ptrwidth, Indperline, Indwidth;
787 int Rhsperline, Rhswidth, Rhsprec;
788 int Rhsflag;
789 int Valperline, Valwidth, Valprec;
790 int Valflag; /* Indicates 'E','D', or 'F' float format */
791 char pformat[16], iformat[16], vformat[19], rformat[19];
792
793 if (Type[0] == 'C') {
794 nvalentries = 2 * nz;
795 nrhsentries = 2 * M;
796 } else {
797 nvalentries = nz;
798 nrhsentries = M;
799 }
800
801 if (filename != NULL) {
802 if ((out_file = std::fopen(filename, "w")) == NULL) {
803 std::fprintf(stderr, "Error: Cannot open file: %s\n", filename);
804 return 0;
805 }
806 } else
807 out_file = stdout;
808
809 if (Ptrfmt != NULL) strcpy(Ptrfmt, "(8I10)");
810 ParseIfmt(Ptrfmt, &Ptrperline, &Ptrwidth);
811 std::sprintf(pformat, "%%%dd", Ptrwidth);
812 ptrcrd = (N + 1) / Ptrperline;
813 if ((N + 1) % Ptrperline != 0) ptrcrd++;
814
815 if (Indfmt == NULL) Indfmt = Ptrfmt;
816 ParseIfmt(Indfmt, &Indperline, &Indwidth);
817 std::sprintf(iformat, "%%%dd", Indwidth);
818 indcrd = nz / Indperline;
819 if (nz % Indperline != 0) indcrd++;
820
821 if (Type[0] != 'P') { /* Skip if pattern only */
822 if (Valfmt != NULL) strcpy(Valfmt, "(4E20.13)");
823 ParseRfmt(Valfmt, &Valperline, &Valwidth, &Valprec, &Valflag);
824 if (Valflag == 'D') *std::strchr(Valfmt, 'D') = 'E';
825 if (Valflag == 'F')
826 std::sprintf(vformat, "%% %d.%df", Valwidth, Valprec);
827 else
828 std::sprintf(vformat, "%% %d.%dE", Valwidth, Valprec);
829 valcrd = nvalentries / Valperline;
830 if (nvalentries % Valperline != 0) valcrd++;
831 } else
832 valcrd = 0;
833
834 if (Nrhs > 0) {
835 if (Rhsfmt == NULL) Rhsfmt = Valfmt;
836 ParseRfmt(Rhsfmt, &Rhsperline, &Rhswidth, &Rhsprec, &Rhsflag);
837 if (Rhsflag == 'F')
838 std::sprintf(rformat, "%% %d.%df", Rhswidth, Rhsprec);
839 else
840 std::sprintf(rformat, "%% %d.%dE", Rhswidth, Rhsprec);
841 if (Rhsflag == 'D') *std::strchr(Rhsfmt, 'D') = 'E';
842 rhscrd = nrhsentries / Rhsperline;
843 if (nrhsentries % Rhsperline != 0) rhscrd++;
844 if (Rhstype[1] == 'G') rhscrd += rhscrd;
845 if (Rhstype[2] == 'X') rhscrd += rhscrd;
846 rhscrd *= Nrhs;
847 } else
848 rhscrd = 0;
849
850 totcrd = 4 + ptrcrd + indcrd + valcrd + rhscrd;
851
852 /* Print header information: */
853
854 std::fprintf(out_file, "%-72s%-8s\n%14d%14d%14d%14d%14d\n", Title, Key, totcrd,
855 ptrcrd, indcrd, valcrd, rhscrd);
856 std::fprintf(out_file, "%3s%11s%14d%14d%14d\n", Type, " ", M, N, nz);
857 std::fprintf(out_file, "%-16s%-16s%-20s", Ptrfmt, Indfmt, Valfmt);
858 if (Nrhs != 0) {
859 /* Print Rhsfmt on fourth line and */
860 /* optional fifth header line for auxillary vector information: */
861 std::fprintf(out_file, "%-20s\n%-14s%d\n", Rhsfmt, Rhstype, Nrhs);
862 } else
863 std::fprintf(out_file, "\n");
864
865 offset = 1 - _SP_base; /* if base 0 storage is declared (via macro definition), */
866 /* then storage entries are offset by 1 */
867
868 /* Print column pointers: */
869 for (i = 0; i < N + 1; i++) {
870 entry = colptr[i] + offset;
871 std::fprintf(out_file, pformat, entry);
872 if ((i + 1) % Ptrperline == 0) std::fprintf(out_file, "\n");
873 }
874
875 if ((N + 1) % Ptrperline != 0) std::fprintf(out_file, "\n");
876
877 /* Print row indices: */
878 for (i = 0; i < nz; i++) {
879 entry = rowind[i] + offset;
880 std::fprintf(out_file, iformat, entry);
881 if ((i + 1) % Indperline == 0) std::fprintf(out_file, "\n");
882 }
883
884 if (nz % Indperline != 0) std::fprintf(out_file, "\n");
885
886 /* Print values: */
887
888 if (Type[0] != 'P') { /* Skip if pattern only */
889
890 for (i = 0; i < nvalentries; i++) {
891 std::fprintf(out_file, vformat, val[i]);
892 if ((i + 1) % Valperline == 0) std::fprintf(out_file, "\n");
893 }
894
895 if (nvalentries % Valperline != 0) std::fprintf(out_file, "\n");
896
897 /* If available, print right hand sides,
898 guess vectors and exact solution vectors: */
899 acount = 1;
900 linemod = 0;
901 if (Nrhs > 0) {
902 for (i = 0; i < Nrhs; i++) {
903 for (j = 0; j < nrhsentries; j++) {
904 std::fprintf(out_file, rformat, rhs[j]);
905 if (acount++ % Rhsperline == linemod) std::fprintf(out_file, "\n");
906 }
907 if ((acount - 1) % Rhsperline != linemod) {
908 std::fprintf(out_file, "\n");
909 linemod = (acount - 1) % Rhsperline;
910 }
911 rhs += nrhsentries;
912 if (Rhstype[1] == 'G') {
913 for (j = 0; j < nrhsentries; j++) {
914 std::fprintf(out_file, rformat, guess[j]);
915 if (acount++ % Rhsperline == linemod) std::fprintf(out_file, "\n");
916 }
917 if ((acount - 1) % Rhsperline != linemod) {
918 std::fprintf(out_file, "\n");
919 linemod = (acount - 1) % Rhsperline;
920 }
921 guess += nrhsentries;
922 }
923 if (Rhstype[2] == 'X') {
924 for (j = 0; j < nrhsentries; j++) {
925 std::fprintf(out_file, rformat, exact[j]);
926 if (acount++ % Rhsperline == linemod) std::fprintf(out_file, "\n");
927 }
928 if ((acount - 1) % Rhsperline != linemod) {
929 std::fprintf(out_file, "\n");
930 linemod = (acount - 1) % Rhsperline;
931 }
932 exact += nrhsentries;
933 }
934 }
935 }
936 }
937
938 if (std::fclose(out_file) != 0) {
939 std::fprintf(stderr, "Error closing file in writeHB_mat_double().\n");
940 return 0;
941 } else
942 return 1;
943}
944
945int readHB_mat_char(const char* filename, int colptr[], int rowind[],
946 char val[], char* Valfmt) {
947 /****************************************************************************/
948 /* This function opens and reads the specified file, interpreting its */
949 /* contents as a sparse matrix stored in the Harwell/Boeing standard */
950 /* format and creating compressed column storage scheme vectors to hold */
951 /* the index and nonzero value information. */
952 /* */
953 /* ---------- */
954 /* **CAVEAT** */
955 /* ---------- */
956 /* Parsing real formats from Fortran is tricky, and this file reader */
957 /* does not claim to be foolproof. It has been tested for cases when */
958 /* the real values are printed consistently and evenly spaced on each */
959 /* line, with Fixed (F), and Exponential (E or D) formats. */
960 /* */
961 /* ** If the input file does not adhere to the H/B format, the ** */
962 /* ** results will be unpredictable. ** */
963 /* */
964 /****************************************************************************/
965 std::FILE* in_file;
966 int i, j, ind, col, offset, count, last;
967 int Nrow, Ncol, Nnzero, Nentries, Nrhs;
968 int Ptrcrd, Indcrd, Valcrd, Rhscrd;
969 int Ptrperline, Ptrwidth, Indperline, Indwidth;
970 int Valperline, Valwidth, Valprec;
971 int Valflag; /* Indicates 'E','D', or 'F' float format */
972 char* ThisElement;
973 char line[BUFSIZ];
974 char Title[73], Key[9], Type[4] = "XXX", Rhstype[4];
975 char Ptrfmt[17], Indfmt[17], Rhsfmt[21];
976
977 if ((in_file = std::fopen(filename, "r")) == NULL) {
978 std::fprintf(stderr, "Error: Cannot open file: %s\n", filename);
979 return 0;
980 }
981
982 readHB_header(in_file, Title, Key, Type, &Nrow, &Ncol, &Nnzero, &Nrhs,
983 Ptrfmt, Indfmt, Valfmt, Rhsfmt,
984 &Ptrcrd, &Indcrd, &Valcrd, &Rhscrd, Rhstype);
985
986 /* Parse the array input formats from Line 3 of HB file */
987 ParseIfmt(Ptrfmt, &Ptrperline, &Ptrwidth);
988 ParseIfmt(Indfmt, &Indperline, &Indwidth);
989 if (Type[0] != 'P') { /* Skip if pattern only */
990 ParseRfmt(Valfmt, &Valperline, &Valwidth, &Valprec, &Valflag);
991 if (Valflag == 'D') {
992 *std::strchr(Valfmt, 'D') = 'E';
993 }
994 }
995
996 /* Read column pointer array: */
997
998 offset = 1 - _SP_base; /* if base 0 storage is declared (via macro definition), */
999 /* then storage entries are offset by 1 */
1000
1001 ThisElement = (char*)malloc(Ptrwidth + 1);
1002 if (ThisElement == NULL) IOHBTerminate("Insufficient memory for ThisElement.");
1003 *(ThisElement + Ptrwidth) = '\0';
1004 count = 0;
1005 for (i = 0; i < Ptrcrd; i++) {
1006 if (std::fgets(line, BUFSIZ, in_file) == NULL) {
1007 std::fprintf(stderr, "Error: Failed to read from file.\n");
1008 return 0;
1009 }
1010 if (std::sscanf(line, "%*s") < 0)
1011 IOHBTerminate("Trilinos_Util_iohb.cpp: Null (or blank) line in pointer data region of HB file.\n");
1012 col = 0;
1013 for (ind = 0; ind < Ptrperline; ind++) {
1014 if (count > Ncol) break;
1015 std::strncpy(ThisElement, line + col, Ptrwidth);
1016 /*ThisElement = substr(line,col,Ptrwidth);*/
1017 colptr[count] = std::atoi(ThisElement) - offset;
1018 count++;
1019 col += Ptrwidth;
1020 }
1021 }
1022 free(ThisElement);
1023
1024 /* Read row index array: */
1025
1026 ThisElement = (char*)malloc(Indwidth + 1);
1027 if (ThisElement == NULL) IOHBTerminate("Insufficient memory for ThisElement.");
1028 *(ThisElement + Indwidth) = '\0';
1029 count = 0;
1030 for (i = 0; i < Indcrd; i++) {
1031 if (std::fgets(line, BUFSIZ, in_file) == NULL) {
1032 std::fprintf(stderr, "Error: Failed to read from file.\n");
1033 return 0;
1034 }
1035 if (std::sscanf(line, "%*s") < 0)
1036 IOHBTerminate("Trilinos_Util_iohb.cpp: Null (or blank) line in index data region of HB file.\n");
1037 col = 0;
1038 for (ind = 0; ind < Indperline; ind++) {
1039 if (count == Nnzero) break;
1040 std::strncpy(ThisElement, line + col, Indwidth);
1041 /*ThisElement = substr(line,col,Indwidth);*/
1042 rowind[count] = std::atoi(ThisElement) - offset;
1043 count++;
1044 col += Indwidth;
1045 }
1046 }
1047 free(ThisElement);
1048
1049 /* Read array of values: AS CHARACTERS*/
1050
1051 if (Type[0] != 'P') { /* Skip if pattern only */
1052
1053 if (Type[0] == 'C')
1054 Nentries = 2 * Nnzero;
1055 else
1056 Nentries = Nnzero;
1057
1058 ThisElement = (char*)malloc(Valwidth + 1);
1059 if (ThisElement == NULL) IOHBTerminate("Insufficient memory for ThisElement.");
1060 *(ThisElement + Valwidth) = '\0';
1061 count = 0;
1062 for (i = 0; i < Valcrd; i++) {
1063 if (std::fgets(line, BUFSIZ, in_file) == NULL) {
1064 std::fprintf(stderr, "Error: Failed to read from file.\n");
1065 return 0;
1066 }
1067 if (std::sscanf(line, "%*s") < 0)
1068 IOHBTerminate("Trilinos_Util_iohb.cpp: Null (or blank) line in value data region of HB file.\n");
1069 if (Valflag == 'D') {
1070 while (std::strchr(line, 'D')) *std::strchr(line, 'D') = 'E';
1071 }
1072 col = 0;
1073 for (ind = 0; ind < Valperline; ind++) {
1074 if (count == Nentries) break;
1075 ThisElement = &val[count * Valwidth];
1076 std::strncpy(ThisElement, line + col, Valwidth);
1077 /*std::strncpy(ThisElement,substr(line,col,Valwidth),Valwidth);*/
1078 if (Valflag != 'F' && std::strchr(ThisElement, 'E') == NULL) {
1079 /* insert a char prefix for exp */
1080 last = std::strlen(ThisElement);
1081 for (j = last + 1; j >= 0; j--) {
1082 ThisElement[j] = ThisElement[j - 1];
1083 if (ThisElement[j] == '+' || ThisElement[j] == '-') {
1084 ThisElement[j - 1] = Valflag;
1085 break;
1086 }
1087 }
1088 }
1089 count++;
1090 col += Valwidth;
1091 }
1092 }
1093 }
1094
1095 return 1;
1096}
1097
1098int readHB_newmat_char(const char* filename, int* M, int* N, int* nonzeros, int** colptr,
1099 int** rowind, char** val, char** Valfmt) {
1100 std::FILE* in_file;
1101 int Nrhs;
1102 int Ptrcrd, Indcrd, Valcrd, Rhscrd;
1103 int Valperline, Valwidth, Valprec;
1104 int Valflag; /* Indicates 'E','D', or 'F' float format */
1105 char Title[73], Key[9], Type[4] = "XXX", Rhstype[4];
1106 char Ptrfmt[17], Indfmt[17], Rhsfmt[21];
1107
1108 if ((in_file = std::fopen(filename, "r")) == NULL) {
1109 std::fprintf(stderr, "Error: Cannot open file: %s\n", filename);
1110 return 0;
1111 }
1112
1113 *Valfmt = (char*)malloc(21 * sizeof(char));
1114 if (*Valfmt == NULL) IOHBTerminate("Insufficient memory for Valfmt.");
1115 readHB_header(in_file, Title, Key, Type, M, N, nonzeros, &Nrhs,
1116 Ptrfmt, Indfmt, (*Valfmt), Rhsfmt,
1117 &Ptrcrd, &Indcrd, &Valcrd, &Rhscrd, Rhstype);
1118 std::fclose(in_file);
1119 ParseRfmt(*Valfmt, &Valperline, &Valwidth, &Valprec, &Valflag);
1120
1121 *colptr = (int*)malloc((*N + 1) * sizeof(int));
1122 if (*colptr == NULL) IOHBTerminate("Insufficient memory for colptr.\n");
1123 *rowind = (int*)malloc(*nonzeros * sizeof(int));
1124 if (*rowind == NULL) IOHBTerminate("Insufficient memory for rowind.\n");
1125 if (Type[0] == 'C') {
1126 /*
1127 std::fprintf(stderr, "Warning: Reading complex data from HB file %s.\n",filename);
1128 std::fprintf(stderr, " Real and imaginary parts will be interlaced in val[].\n");
1129 */
1130 /* Malloc enough space for real AND imaginary parts of val[] */
1131 *val = (char*)malloc(*nonzeros * Valwidth * sizeof(char) * 2);
1132 if (*val == NULL) IOHBTerminate("Insufficient memory for val.\n");
1133 } else {
1134 if (Type[0] != 'P') {
1135 /* Malloc enough space for real array val[] */
1136 *val = (char*)malloc(*nonzeros * Valwidth * sizeof(char));
1137 if (*val == NULL) IOHBTerminate("Insufficient memory for val.\n");
1138 }
1139 } /* No val[] space needed if pattern only */
1140 return readHB_mat_char(filename, *colptr, *rowind, *val, *Valfmt);
1141}
1142
1143int readHB_aux_char(const char* filename, const char AuxType, char b[]) {
1144 /****************************************************************************/
1145 /* This function opens and reads the specified file, placing auxilary */
1146 /* vector(s) of the given type (if available) in b : */
1147 /* Return value is the number of vectors successfully read. */
1148 /* */
1149 /* AuxType = 'F' full right-hand-side vector(s) */
1150 /* AuxType = 'G' initial Guess vector(s) */
1151 /* AuxType = 'X' eXact solution vector(s) */
1152 /* */
1153 /* ---------- */
1154 /* **CAVEAT** */
1155 /* ---------- */
1156 /* Parsing real formats from Fortran is tricky, and this file reader */
1157 /* does not claim to be foolproof. It has been tested for cases when */
1158 /* the real values are printed consistently and evenly spaced on each */
1159 /* line, with Fixed (F), and Exponential (E or D) formats. */
1160 /* */
1161 /* ** If the input file does not adhere to the H/B format, the ** */
1162 /* ** results will be unpredictable. ** */
1163 /* */
1164 /****************************************************************************/
1165 std::FILE* in_file;
1166 int i, j, n, maxcol, start, stride, col, last, linel, nvecs, rhsi;
1167 int Nrow, Ncol, Nnzero, Nentries, Nrhs;
1168 int Ptrcrd, Indcrd, Valcrd, Rhscrd;
1169 int Rhsperline, Rhswidth, Rhsprec;
1170 int Rhsflag;
1171 char Title[73], Key[9], Type[4] = "XXX", Rhstype[4];
1172 char Ptrfmt[17], Indfmt[17], Valfmt[21], Rhsfmt[21];
1173 char line[BUFSIZ];
1174 char* ThisElement;
1175
1176 if ((in_file = std::fopen(filename, "r")) == NULL) {
1177 std::fprintf(stderr, "Error: Cannot open file: %s\n", filename);
1178 return 0;
1179 }
1180
1181 readHB_header(in_file, Title, Key, Type, &Nrow, &Ncol, &Nnzero, &Nrhs,
1182 Ptrfmt, Indfmt, Valfmt, Rhsfmt,
1183 &Ptrcrd, &Indcrd, &Valcrd, &Rhscrd, Rhstype);
1184
1185 if (Nrhs <= 0) {
1186 std::fprintf(stderr, "Warn: Attempt to read auxillary vector(s) when none are present.\n");
1187 return 0;
1188 }
1189 if (Rhstype[0] != 'F') {
1190 std::fprintf(stderr, "Warn: Attempt to read auxillary vector(s) which are not stored in Full form.\n");
1191 std::fprintf(stderr, " Rhs must be specified as full. \n");
1192 return 0;
1193 }
1194
1195 /* If reading complex data, allow for interleaved real and imaginary values. */
1196 if (Type[0] == 'C') {
1197 Nentries = 2 * Nrow;
1198 } else {
1199 Nentries = Nrow;
1200 }
1201
1202 nvecs = 1;
1203
1204 if (Rhstype[1] == 'G') nvecs++;
1205 if (Rhstype[2] == 'X') nvecs++;
1206
1207 if (AuxType == 'G' && Rhstype[1] != 'G') {
1208 std::fprintf(stderr, "Warn: Attempt to read auxillary Guess vector(s) when none are present.\n");
1209 return 0;
1210 }
1211 if (AuxType == 'X' && Rhstype[2] != 'X') {
1212 std::fprintf(stderr, "Warn: Attempt to read auxillary eXact solution vector(s) when none are present.\n");
1213 return 0;
1214 }
1215
1216 ParseRfmt(Rhsfmt, &Rhsperline, &Rhswidth, &Rhsprec, &Rhsflag);
1217 maxcol = Rhsperline * Rhswidth;
1218
1219 /* Lines to skip before starting to read RHS values... */
1220 n = Ptrcrd + Indcrd + Valcrd;
1221
1222 for (i = 0; i < n; i++) {
1223 if (std::fgets(line, BUFSIZ, in_file) == NULL) {
1224 std::fprintf(stderr, "Error: Failed to read from file.\n");
1225 return 0;
1226 }
1227 }
1228
1229 /* start - number of initial aux vector entries to skip */
1230 /* to reach first vector requested */
1231 /* stride - number of aux vector entries to skip between */
1232 /* requested vectors */
1233 if (AuxType == 'F')
1234 start = 0;
1235 else if (AuxType == 'G')
1236 start = Nentries;
1237 else
1238 start = (nvecs - 1) * Nentries;
1239 stride = (nvecs - 1) * Nentries;
1240
1241 if (std::fgets(line, BUFSIZ, in_file) == NULL) {
1242 std::fprintf(stderr, "Error: Failed to read from file.\n");
1243 return 0;
1244 }
1245 linel = std::strchr(line, '\n') - line;
1246 if (std::sscanf(line, "%*s") < 0)
1247 IOHBTerminate("Trilinos_Util_iohb.cpp: Null (or blank) line in auxillary vector data region of HB file.\n");
1248 col = 0;
1249 /* Skip to initial offset */
1250
1251 for (i = 0; i < start; i++) {
1252 col += Rhswidth;
1253 if (col >= (maxcol < linel ? maxcol : linel)) {
1254 if (std::fgets(line, BUFSIZ, in_file) == NULL) {
1255 std::fprintf(stderr, "Error: Failed to read from file.\n");
1256 return 0;
1257 }
1258 linel = std::strchr(line, '\n') - line;
1259 if (std::sscanf(line, "%*s") < 0)
1260 IOHBTerminate("Trilinos_Util_iohb.cpp: Null (or blank) line in auxillary vector data region of HB file.\n");
1261 col = 0;
1262 }
1263 }
1264
1265 if (Rhsflag == 'D') {
1266 while (std::strchr(line, 'D')) *std::strchr(line, 'D') = 'E';
1267 }
1268 /* Read a vector of desired type, then skip to next */
1269 /* repeating to fill Nrhs vectors */
1270
1271 for (rhsi = 0; rhsi < Nrhs; rhsi++) {
1272 for (i = 0; i < Nentries; i++) {
1273 if (col >= (maxcol < linel ? maxcol : linel)) {
1274 if (std::fgets(line, BUFSIZ, in_file) == NULL) {
1275 std::fprintf(stderr, "Error: Failed to read from file.\n");
1276 return 0;
1277 }
1278 linel = std::strchr(line, '\n') - line;
1279 if (std::sscanf(line, "%*s") < 0)
1280 IOHBTerminate("Trilinos_Util_iohb.cpp: Null (or blank) line in auxillary vector data region of HB file.\n");
1281 if (Rhsflag == 'D') {
1282 while (std::strchr(line, 'D')) *std::strchr(line, 'D') = 'E';
1283 }
1284 col = 0;
1285 }
1286 ThisElement = &b[i * Rhswidth];
1287 std::strncpy(ThisElement, line + col, Rhswidth);
1288 if (Rhsflag != 'F' && std::strchr(ThisElement, 'E') == NULL) {
1289 /* insert a char prefix for exp */
1290 last = std::strlen(ThisElement);
1291 for (j = last + 1; j >= 0; j--) {
1292 ThisElement[j] = ThisElement[j - 1];
1293 if (ThisElement[j] == '+' || ThisElement[j] == '-') {
1294 ThisElement[j - 1] = Rhsflag;
1295 break;
1296 }
1297 }
1298 }
1299 col += Rhswidth;
1300 }
1301 b += Nentries * Rhswidth;
1302
1303 /* Skip any interleaved Guess/eXact vectors */
1304
1305 for (i = 0; i < stride; i++) {
1306 col += Rhswidth;
1307 if (col >= (maxcol < linel ? maxcol : linel)) {
1308 if (std::fgets(line, BUFSIZ, in_file) == NULL) {
1309 std::fprintf(stderr, "Error: Failed to read from file.\n");
1310 return 0;
1311 }
1312 linel = std::strchr(line, '\n') - line;
1313 if (std::sscanf(line, "%*s") < 0)
1314 IOHBTerminate("Trilinos_Util_iohb.cpp: Null (or blank) line in auxillary vector data region of HB file.\n");
1315 col = 0;
1316 }
1317 }
1318 }
1319
1320 std::fclose(in_file);
1321 return Nrhs;
1322}
1323
1324int readHB_newaux_char(const char* filename, const char AuxType, char** b, char** Rhsfmt) {
1325 std::FILE* in_file;
1326 int Ptrcrd, Indcrd, Valcrd, Rhscrd;
1327 int Nrow, Ncol, Nnzero, Nrhs;
1328 int Rhsperline, Rhswidth, Rhsprec;
1329 int Rhsflag;
1330 char Title[73], Key[9], Type[4] = "XXX", Rhstype[4];
1331 char Ptrfmt[17], Indfmt[17], Valfmt[21];
1332
1333 if ((in_file = std::fopen(filename, "r")) == NULL) {
1334 std::fprintf(stderr, "Error: Cannot open file: %s\n", filename);
1335 return 0;
1336 }
1337
1338 *Rhsfmt = (char*)malloc(21 * sizeof(char));
1339 if (*Rhsfmt == NULL) IOHBTerminate("Insufficient memory for Rhsfmt.");
1340 readHB_header(in_file, Title, Key, Type, &Nrow, &Ncol, &Nnzero, &Nrhs,
1341 Ptrfmt, Indfmt, Valfmt, (*Rhsfmt),
1342 &Ptrcrd, &Indcrd, &Valcrd, &Rhscrd, Rhstype);
1343 std::fclose(in_file);
1344 if (Nrhs == 0) {
1345 std::fprintf(stderr, "Warn: Requested read of aux vector(s) when none are present.\n");
1346 return 0;
1347 } else {
1348 ParseRfmt(*Rhsfmt, &Rhsperline, &Rhswidth, &Rhsprec, &Rhsflag);
1349 if (Type[0] == 'C') {
1350 std::fprintf(stderr, "Warning: Reading complex aux vector(s) from HB file %s.", filename);
1351 std::fprintf(stderr, " Real and imaginary parts will be interlaced in b[].");
1352 *b = (char*)malloc(Nrow * Nrhs * Rhswidth * sizeof(char) * 2);
1353 if (*b == NULL) IOHBTerminate("Insufficient memory for rhs.\n");
1354 return readHB_aux_char(filename, AuxType, *b);
1355 } else {
1356 *b = (char*)malloc(Nrow * Nrhs * Rhswidth * sizeof(char));
1357 if (*b == NULL) IOHBTerminate("Insufficient memory for rhs.\n");
1358 return readHB_aux_char(filename, AuxType, *b);
1359 }
1360 }
1361}
1362
1363int writeHB_mat_char(const char* filename, int M, int N,
1364 int nz, const int colptr[], const int rowind[],
1365 const char val[], int Nrhs, const char rhs[],
1366 const char guess[], const char exact[],
1367 const char* Title, const char* Key, const char* Type,
1368 char* Ptrfmt, char* Indfmt, char* Valfmt, char* Rhsfmt,
1369 const char* Rhstype) {
1370 /****************************************************************************/
1371 /* The writeHB function opens the named file and writes the specified */
1372 /* matrix and optional right-hand-side(s) to that file in Harwell-Boeing */
1373 /* format. */
1374 /* */
1375 /* For a description of the Harwell Boeing standard, see: */
1376 /* Duff, et al., ACM TOMS Vol.15, No.1, March 1989 */
1377 /* */
1378 /****************************************************************************/
1379 std::FILE* out_file;
1380 int i, j, acount, linemod, entry, offset;
1381 int totcrd, ptrcrd, indcrd, valcrd, rhscrd;
1382 int nvalentries, nrhsentries;
1383 int Ptrperline, Ptrwidth, Indperline, Indwidth;
1384 int Rhsperline, Rhswidth, Rhsprec;
1385 int Rhsflag;
1386 int Valperline, Valwidth, Valprec;
1387 int Valflag; /* Indicates 'E','D', or 'F' float format */
1388 char pformat[16], iformat[16], vformat[19], rformat[19];
1389
1390 if (Type[0] == 'C') {
1391 nvalentries = 2 * nz;
1392 nrhsentries = 2 * M;
1393 } else {
1394 nvalentries = nz;
1395 nrhsentries = M;
1396 }
1397
1398 if (filename != NULL) {
1399 if ((out_file = std::fopen(filename, "w")) == NULL) {
1400 std::fprintf(stderr, "Error: Cannot open file: %s\n", filename);
1401 return 0;
1402 }
1403 } else
1404 out_file = stdout;
1405
1406 if (Ptrfmt != NULL) strcpy(Ptrfmt, "(8I10)");
1407 ParseIfmt(Ptrfmt, &Ptrperline, &Ptrwidth);
1408 std::sprintf(pformat, "%%%dd", Ptrwidth);
1409
1410 if (Indfmt == NULL) Indfmt = Ptrfmt;
1411 ParseIfmt(Indfmt, &Indperline, &Indwidth);
1412 std::sprintf(iformat, "%%%dd", Indwidth);
1413
1414 if (Type[0] != 'P') { /* Skip if pattern only */
1415 if (Valfmt != NULL) strcpy(Valfmt, "(4E20.13)");
1416 ParseRfmt(Valfmt, &Valperline, &Valwidth, &Valprec, &Valflag);
1417 std::sprintf(vformat, "%%%ds", Valwidth);
1418 }
1419
1420 ptrcrd = (N + 1) / Ptrperline;
1421 if ((N + 1) % Ptrperline != 0) ptrcrd++;
1422
1423 indcrd = nz / Indperline;
1424 if (nz % Indperline != 0) indcrd++;
1425
1426 valcrd = nvalentries / Valperline;
1427 if (nvalentries % Valperline != 0) valcrd++;
1428
1429 if (Nrhs > 0) {
1430 if (Rhsfmt == NULL) Rhsfmt = Valfmt;
1431 ParseRfmt(Rhsfmt, &Rhsperline, &Rhswidth, &Rhsprec, &Rhsflag);
1432 std::sprintf(rformat, "%%%ds", Rhswidth);
1433 rhscrd = nrhsentries / Rhsperline;
1434 if (nrhsentries % Rhsperline != 0) rhscrd++;
1435 if (Rhstype[1] == 'G') rhscrd += rhscrd;
1436 if (Rhstype[2] == 'X') rhscrd += rhscrd;
1437 rhscrd *= Nrhs;
1438 } else
1439 rhscrd = 0;
1440
1441 totcrd = 4 + ptrcrd + indcrd + valcrd + rhscrd;
1442
1443 /* Print header information: */
1444
1445 std::fprintf(out_file, "%-72s%-8s\n%14d%14d%14d%14d%14d\n", Title, Key, totcrd,
1446 ptrcrd, indcrd, valcrd, rhscrd);
1447 std::fprintf(out_file, "%3s%11s%14d%14d%14d\n", Type, " ", M, N, nz);
1448 std::fprintf(out_file, "%-16s%-16s%-20s", Ptrfmt, Indfmt, Valfmt);
1449 if (Nrhs != 0) {
1450 /* Print Rhsfmt on fourth line and */
1451 /* optional fifth header line for auxillary vector information: */
1452 std::fprintf(out_file, "%-20s\n%-14s%d\n", Rhsfmt, Rhstype, Nrhs);
1453 } else
1454 std::fprintf(out_file, "\n");
1455
1456 offset = 1 - _SP_base; /* if base 0 storage is declared (via macro definition), */
1457 /* then storage entries are offset by 1 */
1458
1459 /* Print column pointers: */
1460 for (i = 0; i < N + 1; i++) {
1461 entry = colptr[i] + offset;
1462 std::fprintf(out_file, pformat, entry);
1463 if ((i + 1) % Ptrperline == 0) std::fprintf(out_file, "\n");
1464 }
1465
1466 if ((N + 1) % Ptrperline != 0) std::fprintf(out_file, "\n");
1467
1468 /* Print row indices: */
1469 for (i = 0; i < nz; i++) {
1470 entry = rowind[i] + offset;
1471 std::fprintf(out_file, iformat, entry);
1472 if ((i + 1) % Indperline == 0) std::fprintf(out_file, "\n");
1473 }
1474
1475 if (nz % Indperline != 0) std::fprintf(out_file, "\n");
1476
1477 /* Print values: */
1478
1479 if (Type[0] != 'P') { /* Skip if pattern only */
1480 for (i = 0; i < nvalentries; i++) {
1481 std::fprintf(out_file, vformat, val + i * Valwidth);
1482 if ((i + 1) % Valperline == 0) std::fprintf(out_file, "\n");
1483 }
1484
1485 if (nvalentries % Valperline != 0) std::fprintf(out_file, "\n");
1486
1487 /* Print right hand sides: */
1488 acount = 1;
1489 linemod = 0;
1490 if (Nrhs > 0) {
1491 for (j = 0; j < Nrhs; j++) {
1492 for (i = 0; i < nrhsentries; i++) {
1493 std::fprintf(out_file, rformat, rhs + i * Rhswidth);
1494 if (acount++ % Rhsperline == linemod) std::fprintf(out_file, "\n");
1495 }
1496 if (acount % Rhsperline != linemod) {
1497 std::fprintf(out_file, "\n");
1498 linemod = (acount - 1) % Rhsperline;
1499 }
1500 if (Rhstype[1] == 'G') {
1501 for (i = 0; i < nrhsentries; i++) {
1502 std::fprintf(out_file, rformat, guess + i * Rhswidth);
1503 if (acount++ % Rhsperline == linemod) std::fprintf(out_file, "\n");
1504 }
1505 if (acount % Rhsperline != linemod) {
1506 std::fprintf(out_file, "\n");
1507 linemod = (acount - 1) % Rhsperline;
1508 }
1509 }
1510 if (Rhstype[2] == 'X') {
1511 for (i = 0; i < nrhsentries; i++) {
1512 std::fprintf(out_file, rformat, exact + i * Rhswidth);
1513 if (acount++ % Rhsperline == linemod) std::fprintf(out_file, "\n");
1514 }
1515 if (acount % Rhsperline != linemod) {
1516 std::fprintf(out_file, "\n");
1517 linemod = (acount - 1) % Rhsperline;
1518 }
1519 }
1520 }
1521 }
1522 }
1523
1524 if (std::fclose(out_file) != 0) {
1525 std::fprintf(stderr, "Error closing file in writeHB_mat_char().\n");
1526 return 0;
1527 } else
1528 return 1;
1529}
1530
1531int ParseIfmt(char* fmt, int* perline, int* width) {
1532 /*************************************************/
1533 /* Parse an *integer* format field to determine */
1534 /* width and number of elements per line. */
1535 /*************************************************/
1536 char* tmp;
1537 if (fmt == NULL) {
1538 *perline = 0;
1539 *width = 0;
1540 return 0;
1541 }
1542 upcase(fmt);
1543 tmp = std::strchr(fmt, '(');
1544 tmp = substr(fmt, tmp - fmt + 1, std::strchr(fmt, 'I') - tmp - 1);
1545 *perline = std::atoi(tmp);
1546 if (*perline == 0) *perline = 1;
1547 if (tmp != NULL) free((void*)tmp);
1548 tmp = std::strchr(fmt, 'I');
1549 tmp = substr(fmt, tmp - fmt + 1, std::strchr(fmt, ')') - tmp - 1);
1550 *width = std::atoi(tmp);
1551 if (tmp != NULL) free((void*)tmp);
1552 return *width;
1553}
1554
1555int ParseRfmt(char* fmt, int* perline, int* width, int* prec, int* flag) {
1556 /*************************************************/
1557 /* Parse a *real* format field to determine */
1558 /* width and number of elements per line. */
1559 /* Also sets flag indicating 'E' 'F' 'P' or 'D' */
1560 /* format. */
1561 /*************************************************/
1562 char* tmp;
1563 char* tmp1;
1564 char* tmp2;
1565 char* tmp3;
1566 int len;
1567
1568 if (fmt == NULL) {
1569 *perline = 0;
1570 *width = 0;
1571 flag = NULL;
1572 return 0;
1573 }
1574
1575 upcase(fmt);
1576 if (std::strchr(fmt, '(') != NULL) fmt = std::strchr(fmt, '(');
1577 if (std::strchr(fmt, ')') != NULL) {
1578 tmp2 = std::strchr(fmt, ')');
1579 while (std::strchr(tmp2 + 1, ')') != NULL) {
1580 tmp2 = std::strchr(tmp2 + 1, ')');
1581 }
1582 *(tmp2 + 1) = '\0';
1583 }
1584 if (std::strchr(fmt, 'P') != NULL) /* Remove any scaling factor, which */
1585 { /* affects output only, not input */
1586 if (std::strchr(fmt, '(') != NULL) {
1587 tmp = std::strchr(fmt, 'P');
1588 if (*(++tmp) == ',') tmp++;
1589 tmp3 = std::strchr(fmt, '(') + 1;
1590 len = tmp - tmp3;
1591 tmp2 = tmp3;
1592 while (*(tmp2 + len) != '\0') {
1593 *tmp2 = *(tmp2 + len);
1594 tmp2++;
1595 }
1596 *(std::strchr(fmt, ')') + 1) = '\0';
1597 }
1598 }
1599 if (std::strchr(fmt, 'E') != NULL) {
1600 *flag = 'E';
1601 } else if (std::strchr(fmt, 'D') != NULL) {
1602 *flag = 'D';
1603 } else if (std::strchr(fmt, 'F') != NULL) {
1604 *flag = 'F';
1605 } else {
1606 std::fprintf(stderr, "Real format %s in H/B file not supported.\n", fmt);
1607 return 0;
1608 }
1609 tmp = std::strchr(fmt, '(');
1610 tmp = substr(fmt, tmp - fmt + 1, std::strchr(fmt, *flag) - tmp - 1);
1611 *perline = std::atoi(tmp);
1612 if (*perline == 0) *perline = 1;
1613 if (tmp != NULL) free((void*)tmp);
1614 tmp = std::strchr(fmt, *flag);
1615 if (std::strchr(fmt, '.')) {
1616 tmp1 = substr(fmt, std::strchr(fmt, '.') - fmt + 1, std::strchr(fmt, ')') - std::strchr(fmt, '.') - 1);
1617 *prec = std::atoi(tmp1);
1618 if (tmp1 != NULL) free((void*)tmp1);
1619 tmp1 = substr(fmt, tmp - fmt + 1, std::strchr(fmt, '.') - tmp - 1);
1620 } else {
1621 tmp1 = substr(fmt, tmp - fmt + 1, std::strchr(fmt, ')') - tmp - 1);
1622 }
1623 *width = std::atoi(tmp1);
1624 if (tmp1 != NULL) free((void*)tmp1);
1625 return *width;
1626}
1627
1628char* substr(const char* S, const int pos, const int len) {
1629 int i;
1630 char* SubS;
1631 if ((size_t)pos + len <= std::strlen(S)) {
1632 SubS = (char*)malloc(len + 1);
1633 if (SubS == NULL) IOHBTerminate("Insufficient memory for SubS.");
1634 for (i = 0; i < len; i++) SubS[i] = S[pos + i];
1635 SubS[len] = '\0';
1636 } else {
1637 SubS = NULL;
1638 }
1639 return SubS;
1640}
1641
1642void upcase(char* S) {
1643 /* Convert S to uppercase */
1644 int i, len;
1645 len = ::std::strlen(S);
1646 for (i = 0; i < len; i++)
1647 S[i] = ::std::toupper(S[i]);
1648}
1649
1650void IOHBTerminate(const char* message) {
1651 ::std::fprintf(stderr, "%s", message);
1652 ::std::exit(1);
1653}
1654
1655} // namespace Tpetra::HB
void start()
Start the deep_copy counter.