Main Page | Alphabetical List | Data Structures | Directories | File List | Data Fields | Globals | Related Pages

iohb.c File Reference

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <math.h>
#include <sys/malloc.h>
#include "iohb.h"
#include <ctype.h>

Go to the source code of this file.

Defines

#define _SP_base   1

Functions

char * substr (const char *S, const int pos, const int len)
void upcase (char *S)
void IOHBTerminate (char *message)
int readHB_info (const char *filename, int *M, int *N, int *nz, char **Type, int *Nrhs)
int readHB_header (FILE *in_file, char *Title, char *Key, char *Type, int *Nrow, int *Ncol, int *Nnzero, int *Nrhs, char *Ptrfmt, char *Indfmt, char *Valfmt, char *Rhsfmt, int *Ptrcrd, int *Indcrd, int *Valcrd, int *Rhscrd, char *Rhstype)
int readHB_mat_double (const char *filename, int colptr[], int rowind[], double val[])
int readHB_newmat_double (const char *filename, int *M, int *N, int *nonzeros, int **colptr, int **rowind, double **val)
int readHB_aux_double (const char *filename, const char AuxType, double b[])
int readHB_newaux_double (const char *filename, const char AuxType, double **b)
int writeHB_mat_double (const char *filename, int M, int N, int nz, const int colptr[], const int rowind[], const double val[], int Nrhs, const double rhs[], const double guess[], const double exact[], const char *Title, const char *Key, const char *Type, char *Ptrfmt, char *Indfmt, char *Valfmt, char *Rhsfmt, const char *Rhstype)
int readHB_mat_char (const char *filename, int colptr[], int rowind[], char val[], char *Valfmt)
int readHB_newmat_char (const char *filename, int *M, int *N, int *nonzeros, int **colptr, int **rowind, char **val, char **Valfmt)
int readHB_aux_char (const char *filename, const char AuxType, char b[])
int readHB_newaux_char (const char *filename, const char AuxType, char **b, char **Rhsfmt)
int writeHB_mat_char (const char *filename, int M, int N, int nz, const int colptr[], const int rowind[], const char val[], int Nrhs, const char rhs[], const char guess[], const char exact[], const char *Title, const char *Key, const char *Type, char *Ptrfmt, char *Indfmt, char *Valfmt, char *Rhsfmt, const char *Rhstype)
int ParseIfmt (char *fmt, int *perline, int *width)
int ParseRfmt (char *fmt, int *perline, int *width, int *prec, int *flag)


Define Documentation

#define _SP_base   1
 

Definition at line 213 of file iohb.c.

Referenced by readHB_mat_char(), readHB_mat_double(), writeHB_mat_char(), and writeHB_mat_double().


Function Documentation

void IOHBTerminate char *  message  ) 
 

Definition at line 1603 of file iohb.c.

Referenced by readHB_aux_char(), readHB_aux_double(), readHB_header(), readHB_info(), readHB_mat_char(), readHB_mat_double(), readHB_newaux_char(), readHB_newaux_double(), readHB_newmat_char(), readHB_newmat_double(), and substr().

01604 {
01605    fprintf(stderr,message);
01606    exit(1);
01607 }

int ParseIfmt char *  fmt,
int *  perline,
int *  width
 

Definition at line 1492 of file iohb.c.

References substr(), tmp, and upcase().

Referenced by readHB_mat_char(), readHB_mat_double(), writeHB_mat_char(), and writeHB_mat_double().

01493 {
01494 /*************************************************/
01495 /*  Parse an *integer* format field to determine */
01496 /*  width and number of elements per line.       */
01497 /*************************************************/
01498     char *tmp;
01499     if (fmt == NULL ) {
01500       *perline = 0; *width = 0; return 0;
01501     }
01502     upcase(fmt);
01503     tmp = strchr(fmt,'(');
01504     tmp = substr(fmt,tmp - fmt + 1, strchr(fmt,'I') - tmp - 1);
01505     *perline = atoi(tmp);
01506     tmp = strchr(fmt,'I');
01507     tmp = substr(fmt,tmp - fmt + 1, strchr(fmt,')') - tmp - 1);
01508     return *width = atoi(tmp);
01509 }

int ParseRfmt char *  fmt,
int *  perline,
int *  width,
int *  prec,
int *  flag
 

Definition at line 1511 of file iohb.c.

References substr(), tmp, and upcase().

Referenced by readHB_aux_char(), readHB_aux_double(), readHB_mat_char(), readHB_mat_double(), readHB_newaux_char(), readHB_newmat_char(), writeHB_mat_char(), and writeHB_mat_double().

01512 {
01513 /*************************************************/
01514 /*  Parse a *real* format field to determine     */
01515 /*  width and number of elements per line.       */
01516 /*  Also sets flag indicating 'E' 'F' 'P' or 'D' */
01517 /*  format.                                      */
01518 /*************************************************/
01519     char* tmp;
01520     char* tmp2;
01521     char* tmp3;
01522     int len;
01523 
01524     if (fmt == NULL ) {
01525       *perline = 0; 
01526       *width = 0; 
01527       flag = NULL;  
01528       return 0;
01529     }
01530 
01531     upcase(fmt);
01532     if (strchr(fmt,'(') != NULL)  fmt = strchr(fmt,'(');
01533     if (strchr(fmt,')') != NULL)  {
01534        tmp2 = strchr(fmt,')');
01535        while ( strchr(tmp2+1,')') != NULL ) {
01536           tmp2 = strchr(tmp2+1,')');
01537        }
01538        *(tmp2+1) = (int) NULL;
01539     }
01540     if (strchr(fmt,'P') != NULL)  /* Remove any scaling factor, which */
01541     {                             /* affects output only, not input */
01542       if (strchr(fmt,'(') != NULL) {
01543         tmp = strchr(fmt,'P');
01544         if ( *(++tmp) == ',' ) tmp++;
01545         tmp3 = strchr(fmt,'(')+1;
01546         len = tmp-tmp3;
01547         tmp2 = tmp3;
01548         while ( *(tmp2+len) != (int) NULL ) {
01549            *tmp2=*(tmp2+len);
01550            tmp2++; 
01551         }
01552         *(strchr(fmt,')')+1) = (int) NULL;
01553       }
01554     }
01555     if (strchr(fmt,'E') != NULL) { 
01556        *flag = 'E';
01557     } else if (strchr(fmt,'D') != NULL) { 
01558        *flag = 'D';
01559     } else if (strchr(fmt,'F') != NULL) { 
01560        *flag = 'F';
01561     } else {
01562       fprintf(stderr,"Real format %s in H/B file not supported.\n",fmt);
01563       return 0;
01564     }
01565     tmp = strchr(fmt,'(');
01566     tmp = substr(fmt,tmp - fmt + 1, strchr(fmt,*flag) - tmp - 1);
01567     *perline = atoi(tmp);
01568     tmp = strchr(fmt,*flag);
01569     if ( strchr(fmt,'.') ) {
01570       *prec = atoi( substr( fmt, strchr(fmt,'.') - fmt + 1, strchr(fmt,')') - strchr(fmt,'.')-1) );
01571       tmp = substr(fmt,tmp - fmt + 1, strchr(fmt,'.') - tmp - 1);
01572     } else {
01573       tmp = substr(fmt,tmp - fmt + 1, strchr(fmt,')') - tmp - 1);
01574     }
01575     return *width = atoi(tmp);
01576 }

int readHB_aux_char const char *  filename,
const char  AuxType,
char  b[]
 

Definition at line 1110 of file iohb.c.

References IOHBTerminate(), last, ParseRfmt(), and readHB_header().

Referenced by readHB_newaux_char().

01111 {
01112 /****************************************************************************/
01113 /*  This function opens and reads the specified file, placing auxilary      */
01114 /*  vector(s) of the given type (if available) in b :                       */
01115 /*  Return value is the number of vectors successfully read.                */
01116 /*                                                                          */
01117 /*                AuxType = 'F'   full right-hand-side vector(s)            */
01118 /*                AuxType = 'G'   initial Guess vector(s)                   */
01119 /*                AuxType = 'X'   eXact solution vector(s)                  */
01120 /*                                                                          */
01121 /*    ----------                                                            */
01122 /*    **CAVEAT**                                                            */
01123 /*    ----------                                                            */
01124 /*  Parsing real formats from Fortran is tricky, and this file reader       */
01125 /*  does not claim to be foolproof.   It has been tested for cases when     */
01126 /*  the real values are printed consistently and evenly spaced on each      */
01127 /*  line, with Fixed (F), and Exponential (E or D) formats.                 */
01128 /*                                                                          */
01129 /*  **  If the input file does not adhere to the H/B format, the  **        */
01130 /*  **             results will be unpredictable.                 **        */
01131 /*                                                                          */
01132 /****************************************************************************/
01133     FILE *in_file;
01134     int i,j,n,maxcol,start,stride,col,last,linel,nvecs,rhsi;
01135     int Nrow, Ncol, Nnzero, Nentries,Nrhs;
01136     int Ptrcrd, Indcrd, Valcrd, Rhscrd;
01137     int Rhsperline, Rhswidth, Rhsprec;
01138     int Rhsflag;
01139     char Title[73], Key[9], Type[4], Rhstype[4];
01140     char Ptrfmt[17], Indfmt[17], Valfmt[21], Rhsfmt[21];
01141     char line[BUFSIZ];
01142     char *ThisElement;
01143 
01144     if ((in_file = fopen( filename, "r")) == NULL) {
01145       fprintf(stderr,"Error: Cannot open file: %s\n",filename);
01146       return 0;
01147      }
01148 
01149     readHB_header(in_file, Title, Key, Type, &Nrow, &Ncol, &Nnzero, &Nrhs,
01150                   Ptrfmt, Indfmt, Valfmt, Rhsfmt,
01151                   &Ptrcrd, &Indcrd, &Valcrd, &Rhscrd, Rhstype);
01152 
01153     if (Nrhs <= 0)
01154     {
01155       fprintf(stderr, "Warn: Attempt to read auxillary vector(s) when none are present.\n");
01156       return 0;
01157     }
01158     if (Rhstype[0] != 'F' )
01159     {
01160       fprintf(stderr,"Warn: Attempt to read auxillary vector(s) which are not stored in Full form.\n");
01161       fprintf(stderr,"       Rhs must be specified as full. \n");
01162       return 0;
01163     }
01164 
01165 /* If reading complex data, allow for interleaved real and imaginary values. */ 
01166     if ( Type[0] == 'C' ) {
01167        Nentries = 2*Nrow;
01168      } else {
01169        Nentries = Nrow;
01170     }
01171 
01172     nvecs = 1;
01173     
01174     if ( Rhstype[1] == 'G' ) nvecs++;
01175     if ( Rhstype[2] == 'X' ) nvecs++;
01176 
01177     if ( AuxType == 'G' && Rhstype[1] != 'G' ) {
01178       fprintf(stderr, "Warn: Attempt to read auxillary Guess vector(s) when none are present.\n");
01179       return 0;
01180     }
01181     if ( AuxType == 'X' && Rhstype[2] != 'X' ) {
01182       fprintf(stderr, "Warn: Attempt to read auxillary eXact solution vector(s) when none are present.\n");
01183       return 0;
01184     }
01185 
01186     ParseRfmt(Rhsfmt, &Rhsperline, &Rhswidth, &Rhsprec,&Rhsflag);
01187     maxcol = Rhsperline*Rhswidth;
01188 
01189 /*  Lines to skip before starting to read RHS values... */
01190     n = Ptrcrd + Indcrd + Valcrd;
01191 
01192     for (i = 0; i < n; i++)
01193       fgets(line, BUFSIZ, in_file);
01194 
01195 /*  start  - number of initial aux vector entries to skip   */
01196 /*           to reach first  vector requested               */
01197 /*  stride - number of aux vector entries to skip between   */
01198 /*           requested vectors                              */
01199     if ( AuxType == 'F' ) start = 0;
01200     else if ( AuxType == 'G' ) start = Nentries;
01201     else start = (nvecs-1)*Nentries;
01202     stride = (nvecs-1)*Nentries;
01203 
01204     fgets(line, BUFSIZ, in_file);
01205     linel= strchr(line,'\n')-line;
01206     if ( sscanf(line,"%*s") < 0 ) 
01207        IOHBTerminate("iohb.c: Null (or blank) line in auxillary vector data region of HB file.\n");
01208     col = 0;
01209 /*  Skip to initial offset */
01210 
01211     for (i=0;i<start;i++) {
01212        col += Rhswidth;
01213        if ( col >= ( maxcol<linel?maxcol:linel ) ) {
01214            fgets(line, BUFSIZ, in_file);
01215            linel= strchr(line,'\n')-line;
01216        if ( sscanf(line,"%*s") < 0 ) 
01217        IOHBTerminate("iohb.c: Null (or blank) line in auxillary vector data region of HB file.\n");
01218            col = 0;
01219        }
01220     }
01221 
01222     if (Rhsflag == 'D')  {
01223       while( strchr(line,'D') ) *strchr(line,'D') = 'E';
01224     }
01225 /*  Read a vector of desired type, then skip to next */
01226 /*  repeating to fill Nrhs vectors                   */
01227 
01228   for (rhsi=0;rhsi<Nrhs;rhsi++) {
01229 
01230     for (i=0;i<Nentries;i++) {
01231        if ( col >= ( maxcol<linel?maxcol:linel ) ) {
01232            fgets(line, BUFSIZ, in_file);
01233            linel= strchr(line,'\n')-line;
01234        if ( sscanf(line,"%*s") < 0 ) 
01235        IOHBTerminate("iohb.c: Null (or blank) line in auxillary vector data region of HB file.\n");
01236            if (Rhsflag == 'D')  {
01237               while( strchr(line,'D') ) *strchr(line,'D') = 'E';
01238            }
01239            col = 0;
01240        }
01241        ThisElement = &b[i*Rhswidth]; 
01242        strncpy(ThisElement,line+col,Rhswidth);
01243           if ( Rhsflag != 'F' && strchr(ThisElement,'E') == NULL ) { 
01244              /* insert a char prefix for exp */
01245              last = strlen(ThisElement);
01246              for (j=last+1;j>=0;j--) {
01247                 ThisElement[j] = ThisElement[j-1];
01248                 if ( ThisElement[j] == '+' || ThisElement[j] == '-' ) {
01249                    ThisElement[j-1] = Rhsflag;                    
01250                    break;
01251                 }
01252              }
01253           }
01254        col += Rhswidth;
01255     }
01256     b+=Nentries*Rhswidth;
01257  
01258 /*  Skip any interleaved Guess/eXact vectors */
01259 
01260     for (i=0;i<stride;i++) {
01261        col += Rhswidth;
01262        if ( col >= ( maxcol<linel?maxcol:linel ) ) {
01263            fgets(line, BUFSIZ, in_file);
01264            linel= strchr(line,'\n')-line;
01265        if ( sscanf(line,"%*s") < 0 ) 
01266        IOHBTerminate("iohb.c: Null (or blank) line in auxillary vector data region of HB file.\n");
01267            col = 0;
01268        }
01269     }
01270 
01271   }
01272     
01273 
01274     fclose(in_file);
01275     return Nrhs;
01276 }

int readHB_aux_double const char *  filename,
const char  AuxType,
double  b[]
 

Definition at line 546 of file iohb.c.

References IOHBTerminate(), last, ParseRfmt(), and readHB_header().

Referenced by readHB_newaux_double().

00547 {
00548 /****************************************************************************/
00549 /*  This function opens and reads the specified file, placing auxillary     */
00550 /*  vector(s) of the given type (if available) in b.                        */
00551 /*  Return value is the number of vectors successfully read.                */
00552 /*                                                                          */
00553 /*                AuxType = 'F'   full right-hand-side vector(s)            */
00554 /*                AuxType = 'G'   initial Guess vector(s)                   */
00555 /*                AuxType = 'X'   eXact solution vector(s)                  */
00556 /*                                                                          */
00557 /*    ----------                                                            */
00558 /*    **CAVEAT**                                                            */
00559 /*    ----------                                                            */
00560 /*  Parsing real formats from Fortran is tricky, and this file reader       */
00561 /*  does not claim to be foolproof.   It has been tested for cases when     */
00562 /*  the real values are printed consistently and evenly spaced on each      */
00563 /*  line, with Fixed (F), and Exponential (E or D) formats.                 */
00564 /*                                                                          */
00565 /*  **  If the input file does not adhere to the H/B format, the  **        */
00566 /*  **             results will be unpredictable.                 **        */
00567 /*                                                                          */
00568 /****************************************************************************/
00569     FILE *in_file;
00570     int i,j,n,maxcol,start,stride,col,last,linel;
00571     int Ptrcrd, Indcrd, Valcrd, Rhscrd;
00572     int Nrow, Ncol, Nnzero, Nentries;
00573     int Nrhs, nvecs, rhsi;
00574     int Rhsperline, Rhswidth, Rhsprec;
00575     int Rhsflag;
00576     char *ThisElement;
00577     char Title[73], Key[9], Type[4], Rhstype[4];
00578     char Ptrfmt[17], Indfmt[17], Valfmt[21], Rhsfmt[21];
00579     char line[BUFSIZ];
00580 
00581     if ((in_file = fopen( filename, "r")) == NULL) {
00582       fprintf(stderr,"Error: Cannot open file: %s\n",filename);
00583       return 0;
00584      }
00585 
00586     readHB_header(in_file, Title, Key, Type, &Nrow, &Ncol, &Nnzero, &Nrhs,
00587                   Ptrfmt, Indfmt, Valfmt, Rhsfmt,
00588                   &Ptrcrd, &Indcrd, &Valcrd, &Rhscrd, Rhstype);
00589 
00590     if (Nrhs <= 0)
00591     {
00592       fprintf(stderr, "Warn: Attempt to read auxillary vector(s) when none are present.\n");
00593       return 0;
00594     }
00595     if (Rhstype[0] != 'F' )
00596     {
00597       fprintf(stderr,"Warn: Attempt to read auxillary vector(s) which are not stored in Full form.\n");
00598       fprintf(stderr,"       Rhs must be specified as full. \n");
00599       return 0;
00600     }
00601 
00602 /* If reading complex data, allow for interleaved real and imaginary values. */ 
00603     if ( Type[0] == 'C' ) {
00604        Nentries = 2*Nrow;
00605      } else {
00606        Nentries = Nrow;
00607     }
00608 
00609     nvecs = 1;
00610     
00611     if ( Rhstype[1] == 'G' ) nvecs++;
00612     if ( Rhstype[2] == 'X' ) nvecs++;
00613 
00614     if ( AuxType == 'G' && Rhstype[1] != 'G' ) {
00615       fprintf(stderr, "Warn: Attempt to read auxillary Guess vector(s) when none are present.\n");
00616       return 0;
00617     }
00618     if ( AuxType == 'X' && Rhstype[2] != 'X' ) {
00619       fprintf(stderr, "Warn: Attempt to read auxillary eXact solution vector(s) when none are present.\n");
00620       return 0;
00621     }
00622 
00623     ParseRfmt(Rhsfmt, &Rhsperline, &Rhswidth, &Rhsprec,&Rhsflag);
00624     maxcol = Rhsperline*Rhswidth;
00625 
00626 /*  Lines to skip before starting to read RHS values... */
00627     n = Ptrcrd + Indcrd + Valcrd;
00628 
00629     for (i = 0; i < n; i++)
00630       fgets(line, BUFSIZ, in_file);
00631 
00632 /*  start  - number of initial aux vector entries to skip   */
00633 /*           to reach first  vector requested               */
00634 /*  stride - number of aux vector entries to skip between   */
00635 /*           requested vectors                              */
00636     if ( AuxType == 'F' ) start = 0;
00637     else if ( AuxType == 'G' ) start = Nentries;
00638     else start = (nvecs-1)*Nentries;
00639     stride = (nvecs-1)*Nentries;
00640 
00641     fgets(line, BUFSIZ, in_file);
00642     linel= strchr(line,'\n')-line;
00643     col = 0;
00644 /*  Skip to initial offset */
00645 
00646     for (i=0;i<start;i++) {
00647        if ( col >=  ( maxcol<linel?maxcol:linel ) ) {
00648            fgets(line, BUFSIZ, in_file);
00649            linel= strchr(line,'\n')-line;
00650            col = 0;
00651        }
00652        col += Rhswidth;
00653     }
00654     if (Rhsflag == 'D')  {
00655        while( strchr(line,'D') ) *strchr(line,'D') = 'E';
00656     }
00657 
00658 /*  Read a vector of desired type, then skip to next */
00659 /*  repeating to fill Nrhs vectors                   */
00660 
00661   ThisElement = (char *) malloc(Rhswidth+1);
00662   if ( ThisElement == NULL ) IOHBTerminate("Insufficient memory for ThisElement.");
00663   *(ThisElement+Rhswidth) = (char) NULL;
00664   for (rhsi=0;rhsi<Nrhs;rhsi++) {
00665 
00666     for (i=0;i<Nentries;i++) {
00667        if ( col >= ( maxcol<linel?maxcol:linel ) ) {
00668            fgets(line, BUFSIZ, in_file);
00669            linel= strchr(line,'\n')-line;
00670            if (Rhsflag == 'D')  {
00671               while( strchr(line,'D') ) *strchr(line,'D') = 'E';
00672            }
00673            col = 0;
00674        }
00675        strncpy(ThisElement,line+col,Rhswidth);
00676        /*ThisElement = substr(line, col, Rhswidth);*/
00677           if ( Rhsflag != 'F' && strchr(ThisElement,'E') == NULL ) { 
00678              /* insert a char prefix for exp */
00679              last = strlen(ThisElement);
00680              for (j=last+1;j>=0;j--) {
00681                 ThisElement[j] = ThisElement[j-1];
00682                 if ( ThisElement[j] == '+' || ThisElement[j] == '-' ) {
00683                    ThisElement[j-1] = Rhsflag;                    
00684                    break;
00685                 }
00686              }
00687           }
00688        b[i] = atof(ThisElement);
00689        col += Rhswidth;
00690     }
00691  
00692 /*  Skip any interleaved Guess/eXact vectors */
00693 
00694     for (i=0;i<stride;i++) {
00695        if ( col >= ( maxcol<linel?maxcol:linel ) ) {
00696            fgets(line, BUFSIZ, in_file);
00697            linel= strchr(line,'\n')-line;
00698            col = 0;
00699        }
00700        col += Rhswidth;
00701     }
00702 
00703   }
00704   free(ThisElement);
00705     
00706 
00707     fclose(in_file);
00708     return Nrhs;
00709 }

int readHB_header FILE *  in_file,
char *  Title,
char *  Key,
char *  Type,
int *  Nrow,
int *  Ncol,
int *  Nnzero,
int *  Nrhs,
char *  Ptrfmt,
char *  Indfmt,
char *  Valfmt,
char *  Rhsfmt,
int *  Ptrcrd,
int *  Indcrd,
int *  Valcrd,
int *  Rhscrd,
char *  Rhstype
 

Definition at line 294 of file iohb.c.

References IOHBTerminate(), and upcase().

Referenced by readHB_aux_char(), readHB_aux_double(), readHB_info(), readHB_mat_char(), readHB_mat_double(), readHB_newaux_char(), and readHB_newmat_char().

00299 {
00300 /*************************************************************************/
00301 /*  Read header information from the named H/B file...                   */
00302 /*************************************************************************/
00303     int Totcrd,Neltvl,Nrhsix;
00304     char line[BUFSIZ];
00305 
00306 /*  First line:   */
00307     fgets(line, BUFSIZ, in_file);
00308     if ( sscanf(line,"%*s") < 0 ) 
00309         IOHBTerminate("iohb.c: Null (or blank) first line of HB file.\n");
00310     (void) sscanf(line, "%72c%8[^\n]", Title, Key);
00311     *(Key+8) = (char) NULL;
00312     *(Title+72) = (char) NULL;
00313 
00314 /*  Second line:  */
00315     fgets(line, BUFSIZ, in_file);
00316     if ( sscanf(line,"%*s") < 0 ) 
00317         IOHBTerminate("iohb.c: Null (or blank) second line of HB file.\n");
00318     if ( sscanf(line,"%i",&Totcrd) != 1) Totcrd = 0;
00319     if ( sscanf(line,"%*i%i",Ptrcrd) != 1) *Ptrcrd = 0;
00320     if ( sscanf(line,"%*i%*i%i",Indcrd) != 1) *Indcrd = 0;
00321     if ( sscanf(line,"%*i%*i%*i%i",Valcrd) != 1) *Valcrd = 0;
00322     if ( sscanf(line,"%*i%*i%*i%*i%i",Rhscrd) != 1) *Rhscrd = 0;
00323 
00324 /*  Third line:   */
00325     fgets(line, BUFSIZ, in_file);
00326     if ( sscanf(line,"%*s") < 0 ) 
00327         IOHBTerminate("iohb.c: Null (or blank) third line of HB file.\n");
00328     if ( sscanf(line, "%3c", Type) != 1) 
00329         IOHBTerminate("iohb.c: Invalid Type info, line 3 of Harwell-Boeing file.\n");
00330     upcase(Type);
00331     if ( sscanf(line,"%*3c%i",Nrow) != 1) *Nrow = 0 ;
00332     if ( sscanf(line,"%*3c%*i%i",Ncol) != 1) *Ncol = 0 ;
00333     if ( sscanf(line,"%*3c%*i%*i%i",Nnzero) != 1) *Nnzero = 0 ;
00334     if ( sscanf(line,"%*3c%*i%*i%*i%i",&Neltvl) != 1) Neltvl = 0 ;
00335 
00336 /*  Fourth line:  */
00337     fgets(line, BUFSIZ, in_file);
00338     if ( sscanf(line,"%*s") < 0 ) 
00339         IOHBTerminate("iohb.c: Null (or blank) fourth line of HB file.\n");
00340     if ( sscanf(line, "%16c",Ptrfmt) != 1)
00341         IOHBTerminate("iohb.c: Invalid format info, line 4 of Harwell-Boeing file.\n"); 
00342     if ( sscanf(line, "%*16c%16c",Indfmt) != 1)
00343         IOHBTerminate("iohb.c: Invalid format info, line 4 of Harwell-Boeing file.\n"); 
00344     if ( sscanf(line, "%*16c%*16c%20c",Valfmt) != 1) 
00345         IOHBTerminate("iohb.c: Invalid format info, line 4 of Harwell-Boeing file.\n"); 
00346     sscanf(line, "%*16c%*16c%*20c%20c",Rhsfmt);
00347     *(Ptrfmt+16) = (char) NULL;
00348     *(Indfmt+16) = (char) NULL;
00349     *(Valfmt+20) = (char) NULL;
00350     *(Rhsfmt+20) = (char) NULL;
00351    
00352 /*  (Optional) Fifth line: */
00353     if (*Rhscrd != 0 )
00354     { 
00355        fgets(line, BUFSIZ, in_file);
00356        if ( sscanf(line,"%*s") < 0 ) 
00357            IOHBTerminate("iohb.c: Null (or blank) fifth line of HB file.\n");
00358        if ( sscanf(line, "%3c", Rhstype) != 1) 
00359          IOHBTerminate("iohb.c: Invalid RHS type information, line 5 of Harwell-Boeing file.\n");
00360        if ( sscanf(line, "%*3c%i", Nrhs) != 1) *Nrhs = 0;
00361        if ( sscanf(line, "%*3c%*i%i", &Nrhsix) != 1) Nrhsix = 0;
00362     }
00363     return 1;
00364 }

int readHB_info const char *  filename,
int *  M,
int *  N,
int *  nz,
char **  Type,
int *  Nrhs
 

Definition at line 229 of file iohb.c.

References IOHBTerminate(), and readHB_header().

Referenced by readHB_newaux_double(), and readHB_newmat_double().

00231 {
00232 /****************************************************************************/
00233 /*  The readHB_info function opens and reads the header information from    */
00234 /*  the specified Harwell-Boeing file, and reports back the number of rows  */
00235 /*  and columns in the stored matrix (M and N), the number of nonzeros in   */
00236 /*  the matrix (nz), and the number of right-hand-sides stored along with   */
00237 /*  the matrix (Nrhs).                                                      */
00238 /*                                                                          */
00239 /*  For a description of the Harwell Boeing standard, see:                  */
00240 /*            Duff, et al.,  ACM TOMS Vol.15, No.1, March 1989              */
00241 /*                                                                          */
00242 /*    ----------                                                            */
00243 /*    **CAVEAT**                                                            */
00244 /*    ----------                                                            */
00245 /*  **  If the input file does not adhere to the H/B format, the  **        */
00246 /*  **             results will be unpredictable.                 **        */
00247 /*                                                                          */
00248 /****************************************************************************/
00249     FILE *in_file;
00250     int Ptrcrd, Indcrd, Valcrd, Rhscrd; 
00251     int Nrow, Ncol, Nnzero;
00252     char *mat_type;
00253     char Title[73], Key[9], Rhstype[4];
00254     char Ptrfmt[17], Indfmt[17], Valfmt[21], Rhsfmt[21];
00255 
00256     mat_type = (char *) malloc(4);
00257     if ( mat_type == NULL ) IOHBTerminate("Insufficient memory for mat_typen");
00258     
00259     if ( (in_file = fopen( filename, "r")) == NULL ) {
00260        fprintf(stderr,"Error: Cannot open file: %s\n",filename);
00261        return 0;
00262     }
00263 
00264     readHB_header(in_file, Title, Key, mat_type, &Nrow, &Ncol, &Nnzero, Nrhs,
00265                   Ptrfmt, Indfmt, Valfmt, Rhsfmt, 
00266                   &Ptrcrd, &Indcrd, &Valcrd, &Rhscrd, Rhstype);
00267     fclose(in_file);
00268     *Type = mat_type;
00269     *(*Type+3) = (char) NULL;
00270     *M    = Nrow;
00271     *N    = Ncol;
00272     *nz   = Nnzero;
00273     if (Rhscrd == 0) {*Nrhs = 0;}
00274 
00275 /*  In verbose mode, print some of the header information:   */
00276 /*
00277     if (verbose == 1)
00278     {
00279         printf("Reading from Harwell-Boeing file %s (verbose on)...\n",filename);
00280         printf("  Title: %s\n",Title);
00281         printf("  Key:   %s\n",Key);
00282         printf("  The stored matrix is %i by %i with %i nonzeros.\n", 
00283                 *M, *N, *nz );
00284         printf("  %i right-hand--side(s) stored.\n",*Nrhs);
00285     }
00286 */
00287  
00288     return 1;
00289 
00290 }

int readHB_mat_char const char *  filename,
int  colptr[],
int  rowind[],
char  val[],
char *  Valfmt
 

Definition at line 917 of file iohb.c.

References _SP_base, IOHBTerminate(), last, ParseIfmt(), ParseRfmt(), and readHB_header().

Referenced by readHB_newmat_char().

00919 {
00920 /****************************************************************************/
00921 /*  This function opens and reads the specified file, interpreting its      */
00922 /*  contents as a sparse matrix stored in the Harwell/Boeing standard       */
00923 /*  format and creating compressed column storage scheme vectors to hold    */
00924 /*  the index and nonzero value information.                                */
00925 /*                                                                          */
00926 /*    ----------                                                            */
00927 /*    **CAVEAT**                                                            */
00928 /*    ----------                                                            */
00929 /*  Parsing real formats from Fortran is tricky, and this file reader       */
00930 /*  does not claim to be foolproof.   It has been tested for cases when     */
00931 /*  the real values are printed consistently and evenly spaced on each      */
00932 /*  line, with Fixed (F), and Exponential (E or D) formats.                 */
00933 /*                                                                          */
00934 /*  **  If the input file does not adhere to the H/B format, the  **        */
00935 /*  **             results will be unpredictable.                 **        */
00936 /*                                                                          */
00937 /****************************************************************************/
00938     FILE *in_file;
00939     int i,j,ind,col,offset,count,last;
00940     int Nrow,Ncol,Nnzero,Nentries,Nrhs;
00941     int Ptrcrd, Indcrd, Valcrd, Rhscrd;
00942     int Ptrperline, Ptrwidth, Indperline, Indwidth;
00943     int Valperline, Valwidth, Valprec;
00944     int Valflag;           /* Indicates 'E','D', or 'F' float format */
00945     char* ThisElement;
00946     char line[BUFSIZ];
00947     char Title[73], Key[8], Type[4], Rhstype[4];
00948     char Ptrfmt[17], Indfmt[17], Rhsfmt[21];
00949 
00950     if ( (in_file = fopen( filename, "r")) == NULL ) {
00951        fprintf(stderr,"Error: Cannot open file: %s\n",filename);
00952        return 0;
00953     }
00954 
00955     readHB_header(in_file, Title, Key, Type, &Nrow, &Ncol, &Nnzero, &Nrhs,
00956                   Ptrfmt, Indfmt, Valfmt, Rhsfmt,
00957                   &Ptrcrd, &Indcrd, &Valcrd, &Rhscrd, Rhstype);
00958 
00959 /*  Parse the array input formats from Line 3 of HB file  */
00960     ParseIfmt(Ptrfmt,&Ptrperline,&Ptrwidth);
00961     ParseIfmt(Indfmt,&Indperline,&Indwidth);
00962     if ( Type[0] != 'P' ) {          /* Skip if pattern only  */
00963        ParseRfmt(Valfmt,&Valperline,&Valwidth,&Valprec,&Valflag);
00964        if (Valflag == 'D') {
00965           *strchr(Valfmt,'D') = 'E';
00966        }
00967     }
00968 
00969 /*  Read column pointer array:   */
00970 
00971     offset = 1-_SP_base;  /* if base 0 storage is declared (via macro definition), */
00972                           /* then storage entries are offset by 1                  */
00973 
00974     ThisElement = (char *) malloc(Ptrwidth+1);
00975     if ( ThisElement == NULL ) IOHBTerminate("Insufficient memory for ThisElement.");
00976     *(ThisElement+Ptrwidth) = (char) NULL;
00977     count=0; 
00978     for (i=0;i<Ptrcrd;i++)
00979     {
00980        fgets(line, BUFSIZ, in_file);
00981        if ( sscanf(line,"%*s") < 0 ) 
00982          IOHBTerminate("iohb.c: Null (or blank) line in pointer data region of HB file.\n");
00983        col =  0;
00984        for (ind = 0;ind<Ptrperline;ind++)
00985        {
00986           if (count > Ncol) break;
00987           strncpy(ThisElement,line+col,Ptrwidth);
00988           /*ThisElement = substr(line,col,Ptrwidth);*/
00989           colptr[count] = atoi(ThisElement)-offset;
00990           count++; col += Ptrwidth;
00991        }
00992     }
00993     free(ThisElement);
00994 
00995 /*  Read row index array:  */
00996 
00997     ThisElement = (char *) malloc(Indwidth+1);
00998     if ( ThisElement == NULL ) IOHBTerminate("Insufficient memory for ThisElement.");
00999     *(ThisElement+Indwidth) = (char) NULL;
01000     count = 0;
01001     for (i=0;i<Indcrd;i++)
01002     {
01003        fgets(line, BUFSIZ, in_file);
01004        if ( sscanf(line,"%*s") < 0 ) 
01005          IOHBTerminate("iohb.c: Null (or blank) line in index data region of HB file.\n");
01006        col =  0;
01007        for (ind = 0;ind<Indperline;ind++)
01008        {
01009           if (count == Nnzero) break;
01010           strncpy(ThisElement,line+col,Indwidth);
01011           /*ThisElement = substr(line,col,Indwidth);*/
01012           rowind[count] = atoi(ThisElement)-offset;
01013           count++; col += Indwidth;
01014        }
01015     }
01016     free(ThisElement);
01017 
01018 /*  Read array of values:  AS CHARACTERS*/
01019 
01020     if ( Type[0] != 'P' ) {          /* Skip if pattern only  */
01021 
01022        if ( Type[0] == 'C' ) Nentries = 2*Nnzero;
01023            else Nentries = Nnzero;
01024 
01025     ThisElement = (char *) malloc(Valwidth+1);
01026     if ( ThisElement == NULL ) IOHBTerminate("Insufficient memory for ThisElement.");
01027     *(ThisElement+Valwidth) = (char) NULL;
01028     count = 0;
01029     for (i=0;i<Valcrd;i++)
01030     {
01031        fgets(line, BUFSIZ, in_file);
01032        if ( sscanf(line,"%*s") < 0 ) 
01033          IOHBTerminate("iohb.c: Null (or blank) line in value data region of HB file.\n");
01034        if (Valflag == 'D') {
01035           while( strchr(line,'D') ) *strchr(line,'D') = 'E';
01036        }
01037        col =  0;
01038        for (ind = 0;ind<Valperline;ind++)
01039        {
01040           if (count == Nentries) break;
01041           ThisElement = &val[count*Valwidth];
01042           strncpy(ThisElement,line+col,Valwidth);
01043           /*strncpy(ThisElement,substr(line,col,Valwidth),Valwidth);*/
01044           if ( Valflag != 'F' && strchr(ThisElement,'E') == NULL ) { 
01045              /* insert a char prefix for exp */
01046              last = strlen(ThisElement);
01047              for (j=last+1;j>=0;j--) {
01048                 ThisElement[j] = ThisElement[j-1];
01049                 if ( ThisElement[j] == '+' || ThisElement[j] == '-' ) {
01050                    ThisElement[j-1] = Valflag;                    
01051                    break;
01052                 }
01053              }
01054           }
01055           count++; col += Valwidth;
01056        }
01057     }
01058     }
01059 
01060     return 1;
01061 }

int readHB_mat_double const char *  filename,
int  colptr[],
int  rowind[],
double  val[]
 

Definition at line 367 of file iohb.c.

References _SP_base, IOHBTerminate(), last, ParseIfmt(), ParseRfmt(), and readHB_header().

Referenced by readHB_newmat_double().

00369 {
00370 /****************************************************************************/
00371 /*  This function opens and reads the specified file, interpreting its      */
00372 /*  contents as a sparse matrix stored in the Harwell/Boeing standard       */
00373 /*  format and creating compressed column storage scheme vectors to hold    */
00374 /*  the index and nonzero value information.                                */
00375 /*                                                                          */
00376 /*    ----------                                                            */
00377 /*    **CAVEAT**                                                            */
00378 /*    ----------                                                            */
00379 /*  Parsing real formats from Fortran is tricky, and this file reader       */
00380 /*  does not claim to be foolproof.   It has been tested for cases when     */
00381 /*  the real values are printed consistently and evenly spaced on each      */
00382 /*  line, with Fixed (F), and Exponential (E or D) formats.                 */
00383 /*                                                                          */
00384 /*  **  If the input file does not adhere to the H/B format, the  **        */
00385 /*  **             results will be unpredictable.                 **        */
00386 /*                                                                          */
00387 /****************************************************************************/
00388     FILE *in_file;
00389     int i,j,ind,col,offset,count,last,Nrhs;
00390     int Ptrcrd, Indcrd, Valcrd, Rhscrd;
00391     int Nrow, Ncol, Nnzero, Nentries;
00392     int Ptrperline, Ptrwidth, Indperline, Indwidth;
00393     int Valperline, Valwidth, Valprec;
00394     int Valflag;           /* Indicates 'E','D', or 'F' float format */
00395     char* ThisElement;
00396     char Title[73], Key[8], Type[4], Rhstype[4];
00397     char Ptrfmt[17], Indfmt[17], Valfmt[21], Rhsfmt[21];
00398     char line[BUFSIZ];
00399 
00400     if ( (in_file = fopen( filename, "r")) == NULL ) {
00401        fprintf(stderr,"Error: Cannot open file: %s\n",filename);
00402        return 0;
00403     }
00404 
00405     readHB_header(in_file, Title, Key, Type, &Nrow, &Ncol, &Nnzero, &Nrhs,
00406                   Ptrfmt, Indfmt, Valfmt, Rhsfmt,
00407                   &Ptrcrd, &Indcrd, &Valcrd, &Rhscrd, Rhstype);
00408 
00409 /*  Parse the array input formats from Line 3 of HB file  */
00410     ParseIfmt(Ptrfmt,&Ptrperline,&Ptrwidth);
00411     ParseIfmt(Indfmt,&Indperline,&Indwidth);
00412     if ( Type[0] != 'P' ) {          /* Skip if pattern only  */
00413     ParseRfmt(Valfmt,&Valperline,&Valwidth,&Valprec,&Valflag);
00414     }
00415 
00416 /*  Read column pointer array:   */
00417 
00418     offset = 1-_SP_base;  /* if base 0 storage is declared (via macro definition), */
00419                           /* then storage entries are offset by 1                  */
00420 
00421     ThisElement = (char *) malloc(Ptrwidth+1);
00422     if ( ThisElement == NULL ) IOHBTerminate("Insufficient memory for ThisElement.");
00423     *(ThisElement+Ptrwidth) = (char) NULL;
00424     count=0;
00425     for (i=0;i<Ptrcrd;i++)
00426     {
00427        fgets(line, BUFSIZ, in_file);
00428        if ( sscanf(line,"%*s") < 0 ) 
00429          IOHBTerminate("iohb.c: Null (or blank) line in pointer data region of HB file.\n");
00430        col =  0;
00431        for (ind = 0;ind<Ptrperline;ind++)
00432        {
00433           if (count > Ncol) break;
00434           strncpy(ThisElement,line+col,Ptrwidth);
00435   /* ThisElement = substr(line,col,Ptrwidth); */
00436           colptr[count] = atoi(ThisElement)-offset;
00437           count++; col += Ptrwidth;
00438        }
00439     }
00440     free(ThisElement);
00441 
00442 /*  Read row index array:  */
00443 
00444     ThisElement = (char *) malloc(Indwidth+1);
00445     if ( ThisElement == NULL ) IOHBTerminate("Insufficient memory for ThisElement.");
00446     *(ThisElement+Indwidth) = (char) NULL;
00447     count = 0;
00448     for (i=0;i<Indcrd;i++)
00449     {
00450        fgets(line, BUFSIZ, in_file);
00451        if ( sscanf(line,"%*s") < 0 ) 
00452          IOHBTerminate("iohb.c: Null (or blank) line in index data region of HB file.\n");
00453        col =  0;
00454        for (ind = 0;ind<Indperline;ind++)
00455        {
00456           if (count == Nnzero) break;
00457           strncpy(ThisElement,line+col,Indwidth);
00458 /*        ThisElement = substr(line,col,Indwidth); */
00459           rowind[count] = atoi(ThisElement)-offset;
00460           count++; col += Indwidth;
00461        }
00462     }
00463     free(ThisElement);
00464 
00465 /*  Read array of values:  */
00466 
00467     if ( Type[0] != 'P' ) {          /* Skip if pattern only  */
00468 
00469        if ( Type[0] == 'C' ) Nentries = 2*Nnzero;
00470            else Nentries = Nnzero;
00471 
00472     ThisElement = (char *) malloc(Valwidth+1);
00473     if ( ThisElement == NULL ) IOHBTerminate("Insufficient memory for ThisElement.");
00474     *(ThisElement+Valwidth) = (char) NULL;
00475     count = 0;
00476     for (i=0;i<Valcrd;i++)
00477     {
00478        fgets(line, BUFSIZ, in_file);
00479        if ( sscanf(line,"%*s") < 0 ) 
00480          IOHBTerminate("iohb.c: Null (or blank) line in value data region of HB file.\n");
00481        if (Valflag == 'D')  {
00482           while( strchr(line,'D') ) *strchr(line,'D') = 'E';
00483 /*           *strchr(Valfmt,'D') = 'E'; */
00484        }
00485        col =  0;
00486        for (ind = 0;ind<Valperline;ind++)
00487        {
00488           if (count == Nentries) break;
00489           strncpy(ThisElement,line+col,Valwidth);
00490           /*ThisElement = substr(line,col,Valwidth);*/
00491           if ( Valflag != 'F' && strchr(ThisElement,'E') == NULL ) { 
00492              /* insert a char prefix for exp */
00493              last = strlen(ThisElement);
00494              /* for (j=last+1; j>=0; j--) { */
00495              for (j=last; j>0; j--) {
00496                 ThisElement[j] = ThisElement[j-1];
00497                 if ( ThisElement[j] == '+' || ThisElement[j] == '-' ) {
00498                    ThisElement[j-1] = Valflag;                    
00499                    break;
00500                 }
00501              }
00502           }
00503           val[count] = atof(ThisElement);
00504           count++; col += Valwidth;
00505        }
00506     }
00507     free(ThisElement);
00508     }
00509 
00510     fclose(in_file);
00511     return 1;
00512 }

int readHB_newaux_char const char *  filename,
const char  AuxType,
char **  b,
char **  Rhsfmt
 

Definition at line 1278 of file iohb.c.

References IOHBTerminate(), ParseRfmt(), readHB_aux_char(), and readHB_header().

01279 {
01280     FILE *in_file;
01281     int Ptrcrd, Indcrd, Valcrd, Rhscrd;
01282     int Nrow,Ncol,Nnzero,Nrhs;
01283     int Rhsperline, Rhswidth, Rhsprec;
01284     int Rhsflag;
01285     char Title[73], Key[9], Type[4], Rhstype[4];
01286     char Ptrfmt[17], Indfmt[17], Valfmt[21];
01287 
01288     if ((in_file = fopen( filename, "r")) == NULL) {
01289       fprintf(stderr,"Error: Cannot open file: %s\n",filename);
01290       return 0;
01291      }
01292 
01293     *Rhsfmt = (char *)malloc(21*sizeof(char));
01294     if ( *Rhsfmt == NULL ) IOHBTerminate("Insufficient memory for Rhsfmt.");
01295     readHB_header(in_file, Title, Key, Type, &Nrow, &Ncol, &Nnzero, &Nrhs,
01296                   Ptrfmt, Indfmt, Valfmt, (*Rhsfmt),
01297                   &Ptrcrd, &Indcrd, &Valcrd, &Rhscrd, Rhstype);
01298      fclose(in_file);
01299         if ( Nrhs == 0 ) {
01300           fprintf(stderr,"Warn: Requested read of aux vector(s) when none are present.\n");
01301           return 0;
01302         } else {
01303           ParseRfmt(*Rhsfmt,&Rhsperline,&Rhswidth,&Rhsprec,&Rhsflag);
01304           if ( Type[0] == 'C' ) {
01305             fprintf(stderr, "Warning: Reading complex aux vector(s) from HB file %s.",filename);
01306             fprintf(stderr, "         Real and imaginary parts will be interlaced in b[].");
01307             *b = (char *)malloc(Nrow*Nrhs*Rhswidth*sizeof(char)*2);
01308             if ( *b == NULL ) IOHBTerminate("Insufficient memory for rhs.\n");
01309             return readHB_aux_char(filename, AuxType, *b);
01310           } else {
01311             *b = (char *)malloc(Nrow*Nrhs*Rhswidth*sizeof(char));
01312             if ( *b == NULL ) IOHBTerminate("Insufficient memory for rhs.\n");
01313             return readHB_aux_char(filename, AuxType, *b);
01314           }
01315         } 
01316 }

int readHB_newaux_double const char *  filename,
const char  AuxType,
double **  b
 

Definition at line 711 of file iohb.c.

References IOHBTerminate(), readHB_aux_double(), and readHB_info().

00712 {
00713         int Nrhs,M,N,nonzeros;
00714         char *Type;
00715 
00716         readHB_info(filename, &M, &N, &nonzeros, &Type, &Nrhs);
00717         if ( Nrhs <= 0 ) {
00718           fprintf(stderr,"Warn: Requested read of aux vector(s) when none are present.\n");
00719           return 0;
00720         } else { 
00721           if ( Type[0] == 'C' ) {
00722             fprintf(stderr, "Warning: Reading complex aux vector(s) from HB file %s.",filename);
00723             fprintf(stderr, "         Real and imaginary parts will be interlaced in b[].");
00724             *b = (double *)malloc(M*Nrhs*sizeof(double)*2);
00725             if ( *b == NULL ) IOHBTerminate("Insufficient memory for rhs.\n");
00726             return readHB_aux_double(filename, AuxType, *b);
00727           } else {
00728             *b = (double *)malloc(M*Nrhs*sizeof(double));
00729             if ( *b == NULL ) IOHBTerminate("Insufficient memory for rhs.\n");
00730             return readHB_aux_double(filename, AuxType, *b);
00731           }
00732         }
00733 }

int readHB_newmat_char const char *  filename,
int *  M,
int *  N,
int *  nonzeros,
int **  colptr,
int **  rowind,
char **  val,
char **  Valfmt
 

Definition at line 1063 of file iohb.c.

References IOHBTerminate(), ParseRfmt(), readHB_header(), and readHB_mat_char().

01065 {
01066     FILE *in_file;
01067     int Nrhs;
01068     int Ptrcrd, Indcrd, Valcrd, Rhscrd;
01069     int Valperline, Valwidth, Valprec;
01070     int Valflag;           /* Indicates 'E','D', or 'F' float format */
01071     char Title[73], Key[9], Type[4], Rhstype[4];
01072     char Ptrfmt[17], Indfmt[17], Rhsfmt[21];
01073 
01074     if ((in_file = fopen( filename, "r")) == NULL) {
01075       fprintf(stderr,"Error: Cannot open file: %s\n",filename);
01076       return 0;
01077      }
01078     
01079     *Valfmt = (char *)malloc(21*sizeof(char));
01080     if ( *Valfmt == NULL ) IOHBTerminate("Insufficient memory for Valfmt.");
01081     readHB_header(in_file, Title, Key, Type, M, N, nonzeros, &Nrhs,
01082                   Ptrfmt, Indfmt, (*Valfmt), Rhsfmt,
01083                   &Ptrcrd, &Indcrd, &Valcrd, &Rhscrd, Rhstype);
01084     fclose(in_file);
01085     ParseRfmt(*Valfmt,&Valperline,&Valwidth,&Valprec,&Valflag);
01086 
01087         *colptr = (int *)malloc((*N+1)*sizeof(int));
01088         if ( *colptr == NULL ) IOHBTerminate("Insufficient memory for colptr.\n");
01089         *rowind = (int *)malloc(*nonzeros*sizeof(int));
01090         if ( *rowind == NULL ) IOHBTerminate("Insufficient memory for rowind.\n");
01091         if ( Type[0] == 'C' ) {
01092 /*
01093    fprintf(stderr, "Warning: Reading complex data from HB file %s.\n",filename);
01094    fprintf(stderr, "         Real and imaginary parts will be interlaced in val[].\n");
01095 */
01096            /* Malloc enough space for real AND imaginary parts of val[] */
01097            *val = (char *)malloc(*nonzeros*Valwidth*sizeof(char)*2);
01098            if ( *val == NULL ) IOHBTerminate("Insufficient memory for val.\n");
01099         } else {
01100            if ( Type[0] != 'P' ) {   
01101              /* Malloc enough space for real array val[] */
01102              *val = (char *)malloc(*nonzeros*Valwidth*sizeof(char));
01103              if ( *val == NULL ) IOHBTerminate("Insufficient memory for val.\n");
01104            }
01105         }  /* No val[] space needed if pattern only */
01106         return readHB_mat_char(filename, *colptr, *rowind, *val, *Valfmt);
01107 
01108 }

int readHB_newmat_double const char *  filename,
int *  M,
int *  N,
int *  nonzeros,
int **  colptr,
int **  rowind,
double **  val
 

Definition at line 514 of file iohb.c.

References IOHBTerminate(), readHB_info(), and readHB_mat_double().

00516 {
00517         int Nrhs;
00518         char *Type;
00519 
00520         readHB_info(filename, M, N, nonzeros, &Type, &Nrhs);
00521 
00522         *colptr = (int *)malloc((*N+1)*sizeof(int));
00523         if ( *colptr == NULL ) IOHBTerminate("Insufficient memory for colptr.\n");
00524         *rowind = (int *)malloc(*nonzeros*sizeof(int));
00525         if ( *rowind == NULL ) IOHBTerminate("Insufficient memory for rowind.\n");
00526         if ( Type[0] == 'C' ) {
00527 /*
00528    fprintf(stderr, "Warning: Reading complex data from HB file %s.\n",filename);
00529    fprintf(stderr, "         Real and imaginary parts will be interlaced in val[].\n");
00530 */
00531            /* Malloc enough space for real AND imaginary parts of val[] */
00532            *val = (double *)malloc(*nonzeros*sizeof(double)*2);
00533            if ( *val == NULL ) IOHBTerminate("Insufficient memory for val.\n");
00534         } else {
00535            if ( Type[0] != 'P' ) {   
00536              /* Malloc enough space for real array val[] */
00537              *val = (double *)malloc(*nonzeros*sizeof(double));
00538              if ( *val == NULL ) IOHBTerminate("Insufficient memory for val.\n");
00539            }
00540         }  /* No val[] space needed if pattern only */
00541         /* VE */ printf("file name <%s>\n",filename);
00542         return readHB_mat_double(filename, *colptr, *rowind, *val);
00543 
00544 }

char * substr const char *  S,
const int  pos,
const int  len
 

Definition at line 1578 of file iohb.c.

References IOHBTerminate().

Referenced by ParseIfmt(), and ParseRfmt().

01579 {
01580     int i;
01581     char *SubS;
01582     if ( pos+len <= strlen(S)) {
01583     SubS = (char *)malloc(len+1);
01584     if ( SubS == NULL ) IOHBTerminate("Insufficient memory for SubS.");
01585     for (i=0;i<len;i++) SubS[i] = S[pos+i];
01586     SubS[len] = (char) NULL;
01587     } else {
01588       SubS = NULL;
01589     }
01590     return SubS;
01591 }

void upcase char *  S  ) 
 

Definition at line 1594 of file iohb.c.

Referenced by ParseIfmt(), ParseRfmt(), and readHB_header().

01595 {
01596 /*  Convert S to uppercase     */
01597     int i,len;
01598     len = strlen(S);
01599     for (i=0;i< len;i++)
01600        S[i] = toupper(S[i]);
01601 }

int writeHB_mat_char const char *  filename,
int  M,
int  N,
int  nz,
const int  colptr[],
const int  rowind[],
const char  val[],
int  Nrhs,
const char  rhs[],
const char  guess[],
const char  exact[],
const char *  Title,
const char *  Key,
const char *  Type,
char *  Ptrfmt,
char *  Indfmt,
char *  Valfmt,
char *  Rhsfmt,
const char *  Rhstype
 

Definition at line 1318 of file iohb.c.

References _SP_base, ParseIfmt(), and ParseRfmt().

01325 {
01326 /****************************************************************************/
01327 /*  The writeHB function opens the named file and writes the specified      */
01328 /*  matrix and optional right-hand-side(s) to that file in Harwell-Boeing   */
01329 /*  format.                                                                 */
01330 /*                                                                          */
01331 /*  For a description of the Harwell Boeing standard, see:                  */
01332 /*            Duff, et al.,  ACM TOMS Vol.15, No.1, March 1989              */
01333 /*                                                                          */
01334 /****************************************************************************/
01335     FILE *out_file;
01336     int i,j,acount,linemod,entry,offset;
01337     int totcrd, ptrcrd, indcrd, valcrd, rhscrd;
01338     int nvalentries, nrhsentries;
01339     int Ptrperline, Ptrwidth, Indperline, Indwidth;
01340     int Rhsperline, Rhswidth, Rhsprec;
01341     int Rhsflag;
01342     int Valperline, Valwidth, Valprec;
01343     int Valflag;           /* Indicates 'E','D', or 'F' float format */
01344     char pformat[16],iformat[16],vformat[19],rformat[19];
01345 
01346     if ( Type[0] == 'C' ) {
01347          nvalentries = 2*nz;
01348          nrhsentries = 2*M;
01349     } else {
01350          nvalentries = nz;
01351          nrhsentries = M;
01352     }
01353 
01354     if ( filename != NULL ) {
01355        if ( (out_file = fopen( filename, "w")) == NULL ) {
01356          fprintf(stderr,"Error: Cannot open file: %s\n",filename);
01357          return 0;
01358        }
01359     } else out_file = stdout;
01360 
01361     if ( Ptrfmt == NULL ) Ptrfmt = "(8I10)";
01362     ParseIfmt(Ptrfmt,&Ptrperline,&Ptrwidth);
01363     sprintf(pformat,"%%%dd",Ptrwidth);
01364    
01365     if ( Indfmt == NULL ) Indfmt =  Ptrfmt;
01366     ParseIfmt(Indfmt,&Indperline,&Indwidth);
01367     sprintf(iformat,"%%%dd",Indwidth);
01368 
01369     if ( Type[0] != 'P' ) {          /* Skip if pattern only  */
01370       if ( Valfmt == NULL ) Valfmt = "(4E20.13)";
01371       ParseRfmt(Valfmt,&Valperline,&Valwidth,&Valprec,&Valflag);
01372       sprintf(vformat,"%%%ds",Valwidth);
01373     }
01374 
01375     ptrcrd = (N+1)/Ptrperline;
01376     if ( (N+1)%Ptrperline != 0) ptrcrd++;
01377 
01378     indcrd = nz/Indperline;
01379     if ( nz%Indperline != 0) indcrd++;
01380 
01381     valcrd = nvalentries/Valperline;
01382     if ( nvalentries%Valperline != 0) valcrd++;
01383 
01384     if ( Nrhs > 0 ) {
01385        if ( Rhsfmt == NULL ) Rhsfmt = Valfmt;
01386        ParseRfmt(Rhsfmt,&Rhsperline,&Rhswidth,&Rhsprec, &Rhsflag);
01387        sprintf(rformat,"%%%ds",Rhswidth);
01388        rhscrd = nrhsentries/Rhsperline; 
01389        if ( nrhsentries%Rhsperline != 0) rhscrd++;
01390        if ( Rhstype[1] == 'G' ) rhscrd+=rhscrd;
01391        if ( Rhstype[2] == 'X' ) rhscrd+=rhscrd;
01392        rhscrd*=Nrhs;
01393     } else rhscrd = 0;
01394 
01395     totcrd = 4+ptrcrd+indcrd+valcrd+rhscrd;
01396 
01397 
01398 /*  Print header information:  */
01399 
01400     fprintf(out_file,"%-72s%-8s\n%14d%14d%14d%14d%14d\n",Title, Key, totcrd,
01401             ptrcrd, indcrd, valcrd, rhscrd);
01402     fprintf(out_file,"%3s%11s%14d%14d%14d\n",Type,"          ", M, N, nz);
01403     fprintf(out_file,"%-16s%-16s%-20s", Ptrfmt, Indfmt, Valfmt);
01404     if ( Nrhs != 0 ) {
01405 /*     Print Rhsfmt on fourth line and                                    */
01406 /*           optional fifth header line for auxillary vector information: */
01407        fprintf(out_file,"%-20s\n%-14s%d\n",Rhsfmt,Rhstype,Nrhs);
01408     } else fprintf(out_file,"\n");
01409 
01410     offset = 1-_SP_base;  /* if base 0 storage is declared (via macro definition), */
01411                           /* then storage entries are offset by 1                  */
01412 
01413 /*  Print column pointers:   */
01414     for (i=0;i<N+1;i++)
01415     {
01416        entry = colptr[i]+offset;
01417        fprintf(out_file,pformat,entry);
01418        if ( (i+1)%Ptrperline == 0 ) fprintf(out_file,"\n");
01419     }
01420 
01421    if ( (N+1) % Ptrperline != 0 ) fprintf(out_file,"\n");
01422 
01423 /*  Print row indices:       */
01424     for (i=0;i<nz;i++)
01425     {
01426        entry = rowind[i]+offset;
01427        fprintf(out_file,iformat,entry);
01428        if ( (i+1)%Indperline == 0 ) fprintf(out_file,"\n");
01429     }
01430 
01431    if ( nz % Indperline != 0 ) fprintf(out_file,"\n");
01432 
01433 /*  Print values:            */
01434 
01435     if ( Type[0] != 'P' ) {          /* Skip if pattern only  */
01436     for (i=0;i<nvalentries;i++)
01437     {
01438        fprintf(out_file,vformat,val+i*Valwidth);
01439        if ( (i+1)%Valperline == 0 ) fprintf(out_file,"\n");
01440     }
01441 
01442     if ( nvalentries % Valperline != 0 ) fprintf(out_file,"\n");
01443 
01444 /*  Print right hand sides:  */
01445     acount = 1;
01446     linemod=0;
01447     if ( Nrhs > 0 ) {
01448       for (j=0;j<Nrhs;j++) {
01449        for (i=0;i<nrhsentries;i++)
01450        {
01451           fprintf(out_file,rformat,rhs+i*Rhswidth);
01452           if ( acount++%Rhsperline == linemod ) fprintf(out_file,"\n");
01453        }
01454        if ( acount%Rhsperline != linemod ) {
01455           fprintf(out_file,"\n");
01456           linemod = (acount-1)%Rhsperline;
01457        }
01458        if ( Rhstype[1] == 'G' ) {
01459          for (i=0;i<nrhsentries;i++)
01460          {
01461            fprintf(out_file,rformat,guess+i*Rhswidth);
01462            if ( acount++%Rhsperline == linemod ) fprintf(out_file,"\n");
01463          }
01464          if ( acount%Rhsperline != linemod ) {
01465             fprintf(out_file,"\n");
01466             linemod = (acount-1)%Rhsperline;
01467          }
01468        }
01469        if ( Rhstype[2] == 'X' ) {
01470          for (i=0;i<nrhsentries;i++)
01471          {
01472            fprintf(out_file,rformat,exact+i*Rhswidth);
01473            if ( acount++%Rhsperline == linemod ) fprintf(out_file,"\n");
01474          }
01475          if ( acount%Rhsperline != linemod ) {
01476             fprintf(out_file,"\n");
01477             linemod = (acount-1)%Rhsperline;
01478          }
01479        }
01480       }
01481     }
01482 
01483     }
01484 
01485     if ( fclose(out_file) != 0){
01486       fprintf(stderr,"Error closing file in writeHB_mat_char().\n");
01487       return 0;
01488     } else return 1;
01489     
01490 }

int writeHB_mat_double const char *  filename,
int  M,
int  N,
int  nz,
const int  colptr[],
const int  rowind[],
const double  val[],
int  Nrhs,
const double  rhs[],
const double  guess[],
const double  exact[],
const char *  Title,
const char *  Key,
const char *  Type,
char *  Ptrfmt,
char *  Indfmt,
char *  Valfmt,
char *  Rhsfmt,
const char *  Rhstype
 

Definition at line 735 of file iohb.c.

References _SP_base, ParseIfmt(), and ParseRfmt().

00742 {
00743 /****************************************************************************/
00744 /*  The writeHB function opens the named file and writes the specified      */
00745 /*  matrix and optional right-hand-side(s) to that file in Harwell-Boeing   */
00746 /*  format.                                                                 */
00747 /*                                                                          */
00748 /*  For a description of the Harwell Boeing standard, see:                  */
00749 /*            Duff, et al.,  ACM TOMS Vol.15, No.1, March 1989              */
00750 /*                                                                          */
00751 /****************************************************************************/
00752     FILE *out_file;
00753     int i,j,entry,offset,acount,linemod;
00754     int totcrd, ptrcrd, indcrd, valcrd, rhscrd;
00755     int nvalentries, nrhsentries;
00756     int Ptrperline, Ptrwidth, Indperline, Indwidth;
00757     int Rhsperline, Rhswidth, Rhsprec;
00758     int Rhsflag;
00759     int Valperline, Valwidth, Valprec;
00760     int Valflag;           /* Indicates 'E','D', or 'F' float format */
00761     char pformat[16],iformat[16],vformat[19],rformat[19];
00762 
00763     if ( Type[0] == 'C' ) {
00764          nvalentries = 2*nz;
00765          nrhsentries = 2*M;
00766     } else {
00767          nvalentries = nz;
00768          nrhsentries = M;
00769     }
00770 
00771     if ( filename != NULL ) {
00772        if ( (out_file = fopen( filename, "w")) == NULL ) {
00773          fprintf(stderr,"Error: Cannot open file: %s\n",filename);
00774          return 0;
00775        }
00776     } else out_file = stdout;
00777 
00778     if ( Ptrfmt == NULL ) Ptrfmt = "(8I10)";
00779     ParseIfmt(Ptrfmt,&Ptrperline,&Ptrwidth);
00780     sprintf(pformat,"%%%dd",Ptrwidth);
00781     ptrcrd = (N+1)/Ptrperline;
00782     if ( (N+1)%Ptrperline != 0) ptrcrd++;
00783    
00784     if ( Indfmt == NULL ) Indfmt =  Ptrfmt;
00785     ParseIfmt(Indfmt,&Indperline,&Indwidth);
00786     sprintf(iformat,"%%%dd",Indwidth);
00787     indcrd = nz/Indperline;
00788     if ( nz%Indperline != 0) indcrd++;
00789 
00790     if ( Type[0] != 'P' ) {          /* Skip if pattern only  */
00791       if ( Valfmt == NULL ) Valfmt = "(4E20.13)";
00792       ParseRfmt(Valfmt,&Valperline,&Valwidth,&Valprec,&Valflag);
00793       if (Valflag == 'D') *strchr(Valfmt,'D') = 'E';
00794       if (Valflag == 'F')
00795          sprintf(vformat,"%% %d.%df",Valwidth,Valprec);
00796       else
00797          sprintf(vformat,"%% %d.%dE",Valwidth,Valprec);
00798       valcrd = nvalentries/Valperline;
00799       if ( nvalentries%Valperline != 0) valcrd++;
00800     } else valcrd = 0;
00801 
00802     if ( Nrhs > 0 ) {
00803        if ( Rhsfmt == NULL ) Rhsfmt = Valfmt;
00804        ParseRfmt(Rhsfmt,&Rhsperline,&Rhswidth,&Rhsprec, &Rhsflag);
00805        if (Rhsflag == 'F')
00806           sprintf(rformat,"%% %d.%df",Rhswidth,Rhsprec);
00807        else
00808           sprintf(rformat,"%% %d.%dE",Rhswidth,Rhsprec);
00809        if (Rhsflag == 'D') *strchr(Rhsfmt,'D') = 'E';
00810        rhscrd = nrhsentries/Rhsperline; 
00811        if ( nrhsentries%Rhsperline != 0) rhscrd++;
00812        if ( Rhstype[1] == 'G' ) rhscrd+=rhscrd;
00813        if ( Rhstype[2] == 'X' ) rhscrd+=rhscrd;
00814        rhscrd*=Nrhs;
00815     } else rhscrd = 0;
00816 
00817     totcrd = 4+ptrcrd+indcrd+valcrd+rhscrd;
00818 
00819 
00820 /*  Print header information:  */
00821 
00822     fprintf(out_file,"%-72s%-8s\n%14d%14d%14d%14d%14d\n",Title, Key, totcrd,
00823             ptrcrd, indcrd, valcrd, rhscrd);
00824     fprintf(out_file,"%3s%11s%14d%14d%14d\n",Type,"          ", M, N, nz);
00825     fprintf(out_file,"%-16s%-16s%-20s", Ptrfmt, Indfmt, Valfmt);
00826     if ( Nrhs != 0 ) {
00827 /*     Print Rhsfmt on fourth line and                                    */
00828 /*           optional fifth header line for auxillary vector information: */
00829        fprintf(out_file,"%-20s\n%-14s%d\n",Rhsfmt,Rhstype,Nrhs);
00830     } else fprintf(out_file,"\n");
00831 
00832     offset = 1-_SP_base;  /* if base 0 storage is declared (via macro definition), */
00833                           /* then storage entries are offset by 1                  */
00834 
00835 /*  Print column pointers:   */
00836     for (i=0;i<N+1;i++)
00837     {
00838        entry = colptr[i]+offset;
00839        fprintf(out_file,pformat,entry);
00840        if ( (i+1)%Ptrperline == 0 ) fprintf(out_file,"\n");
00841     }
00842 
00843    if ( (N+1) % Ptrperline != 0 ) fprintf(out_file,"\n");
00844 
00845 /*  Print row indices:       */
00846     for (i=0;i<nz;i++)
00847     {
00848        entry = rowind[i]+offset;
00849        fprintf(out_file,iformat,entry);
00850        if ( (i+1)%Indperline == 0 ) fprintf(out_file,"\n");
00851     }
00852 
00853    if ( nz % Indperline != 0 ) fprintf(out_file,"\n");
00854 
00855 /*  Print values:            */
00856 
00857     if ( Type[0] != 'P' ) {          /* Skip if pattern only  */
00858 
00859     for (i=0;i<nvalentries;i++)
00860     {
00861        fprintf(out_file,vformat,val[i]);
00862        if ( (i+1)%Valperline == 0 ) fprintf(out_file,"\n");
00863     }
00864 
00865     if ( nvalentries % Valperline != 0 ) fprintf(out_file,"\n");
00866 
00867 /*  If available,  print right hand sides, 
00868            guess vectors and exact solution vectors:  */
00869     acount = 1;
00870     linemod = 0;
00871     if ( Nrhs > 0 ) {
00872        for (i=0;i<Nrhs;i++)
00873        {
00874           for ( j=0;j<nrhsentries;j++ ) {
00875             fprintf(out_file,rformat,rhs[j]);
00876             if ( acount++%Rhsperline == linemod ) fprintf(out_file,"\n");
00877           }
00878           if ( acount%Rhsperline != linemod ) {
00879             fprintf(out_file,"\n");
00880             linemod = (acount-1)%Rhsperline;
00881           }
00882           rhs += nrhsentries;
00883           if ( Rhstype[1] == 'G' ) {
00884             for ( j=0;j<nrhsentries;j++ ) {
00885               fprintf(out_file,rformat,guess[j]);
00886               if ( acount++%Rhsperline == linemod ) fprintf(out_file,"\n");
00887             }
00888             if ( acount%Rhsperline != linemod ) {
00889               fprintf(out_file,"\n");
00890               linemod = (acount-1)%Rhsperline;
00891             }
00892             guess += nrhsentries;
00893           }
00894           if ( Rhstype[2] == 'X' ) {
00895             for ( j=0;j<nrhsentries;j++ ) {
00896               fprintf(out_file,rformat,exact[j]);
00897               if ( acount++%Rhsperline == linemod ) fprintf(out_file,"\n");
00898             }
00899             if ( acount%Rhsperline != linemod ) {
00900               fprintf(out_file,"\n");
00901               linemod = (acount-1)%Rhsperline;
00902             }
00903             exact += nrhsentries;
00904           }
00905        }
00906     }
00907 
00908     }
00909 
00910     if ( fclose(out_file) != 0){
00911       fprintf(stderr,"Error closing file in writeHB_mat_double().\n");
00912       return 0;
00913     } else return 1;
00914     
00915 }


Generated on Wed Aug 17 09:15:01 2005 for SALSA by  doxygen 1.4.2