ungrib/src/ngl/w3/bacio.v1.3.c

   1 /* Fortran-callable routines to read and write characther (ba_cio) and */
   2 /*   numeric (banio) data byte addressably                            */
   3 /* Robert Grumbine  16 March 1998 */
   4 /*  v1.1: Put diagnostic output under control of define VERBOSE or QUIET */
   5 /*        Add option of non-seeking read/write                           */
   6 /*        Return code for fewer data read/written than requested */
   7 /*  v1.2: Add cray compatibility  20 April 1998                  */
   8
   9 #include <stdio.h>
  10 #include <sys/types.h>
  11 #include <sys/stat.h>
  12 #include <fcntl.h>
  13 #ifndef _WIN32
  14 # include <unistd.h>
  15 #else
  16 # define S_IRWXU 00700
  17 # define S_IRWXG 00070
  18 # define S_IRWXO 00007
  19 #endif
  20 #ifdef MACOS
  21 #include <malloc/malloc.h>
  22 #else
  23 #include <malloc.h>
  24 #endif
  25 #include <ctype.h>
  26 #include <string.h>
  27
  28 /* Include the C library file for definition/control */
  29 /* Things that might be changed for new systems are there. */
  30 /* This source file should not (need to) be edited, merely recompiled */
  31 #include "clib.h"
  32
  33
  34 /* Return Codes:  */
  35 /*  0    All was well                                   */
  36 /* -1    Tried to open read only _and_ write only       */
  37 /* -2    Tried to read and write in the same call       */
  38 /* -3    Internal failure in name processing            */
  39 /* -4    Failure in opening file                        */
  40 /* -5    Tried to read on a write-only file             */
  41 /* -6    Failed in read to find the 'start' location    */
  42 /* -7    Tried to write to a read only file             */
  43 /* -8    Failed in write to find the 'start' location   */
  44 /* -9    Error in close                                 */
  45 /* -10   Read or wrote fewer data than requested        */
  46
  47 /* Note: In your Fortran code, call ba_cio, not ba_cio_.  */
  48 /*int ba_cio_(int * mode, int * start, int * size, int * no, int * nactual,   */
  49 /*          int * fdes, const char *fname, char *data, int  namelen,         */
  50 /*          int  datanamelen)                                                */
  51 /* Arguments: */
  52 /* Mode is the integer specifying operations to be performed                 */
  53 /*    see the clib.inc file for the values.  Mode is obtained                */
  54 /*    by adding together the values corresponding to the operations          */
  55 /*    The best method is to include the clib.inc file and refer to the       */
  56 /*    names for the operations rather than rely on hard-coded values         */
  57 /* Start is the byte number to start your operation from.  0 is the first    */
  58 /*    byte in the file, not 1.                                               */
  59 /* Newpos is the position in the file after a read or write has been         */
  60 /*    performed.  You'll need this if you're doing 'seeking' read/write      */
  61 /* Size is the size of the objects you are trying to read.  Rely on the      */
  62 /*    values in the locale.inc file.  Types are CHARACTER, INTEGER, REAL,    */
  63 /*    COMPLEX.  Specify the correct value by using SIZEOF_type, where type   */
  64 /*    is one of these.  (After having included the locale.inc file)          */
  65 /* no is the number of things to read or write (characters, integers,        */
  66 /*                                                              whatever)    */
  67 /* nactual is the number of things actually read or written.  Check that     */
  68 /*    you got what you wanted.                                               */
  69 /* fdes is an integer 'file descriptor'.  This is not a Fortran Unit Number  */
  70 /*    You can use it, however, to refer to files you've previously opened.   */
  71 /* fname is the name of the file.  This only needs to be defined when you    */
  72 /*    are opening a file.  It must be (on the Fortran side) declared as      */
  73 /*    CHARACTER*N, where N is a length greater than or equal to the length   */
  74 /*    of the file name.  CHARACTER*1 fname[80] (for example) will fail.      */
  75 /* data is the name of the entity (variable, vector, array) that you want    */
  76 /*    to write data out from or read it in to.  The fact that C is declaring */
  77 /*    it to be a char * does not affect your fortran.                        */
  78 /* namelen - Do NOT specify this.  It is created automagically by the        */
  79 /*    Fortran compiler                                                       */
  80 /* datanamelen - Ditto                                                       */
  81
  82
  83 /* What is going on here is that although the Fortran caller will always */
  84 /*   be calling ba_cio, the called C routine name will change from system */
  85 /*   to system. */
  86 #if defined _UNDERSCORE
  87   int ba_cio_
  88          (int * mode, int * start, int *newpos, int * size, int * no,
  89           int * nactual, int * fdes, const char *fname, char *datary,
  90           int  namelen, int  datanamelen) {
  91 #elif defined _DOUBLEUNDERSCORE
  92   int ba_cio__
  93          (int * mode, int * start, int *newpos, int * size, int * no,
  94           int * nactual, int * fdes, const char *fname, char *datary,
  95           int  namelen, int  datanamelen) {
  96 #else
  97   int ba_cio
  98          (int * mode, int * start, int *newpos, int * size, int * no,
  99           int * nactual, int * fdes, const char *fname, char *datary,
 100           int  namelen, int  datanamelen) {
 101 #endif
 102   int i, j, jret, seekret;
 103   char *realname, *tempchar;
 104   int tcharval;
 105   size_t count;
 106
 107 /* Initialization(s) */
 108   *nactual = 0;
 109
 110 /* Check for illegal combinations of options */
 111   if (( BAOPEN_RONLY & *mode) &&
 112      ( (BAOPEN_WONLY & *mode) || (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ) ) {
 113      #ifdef VERBOSE
 114        printf("illegal -- trying to open both read only and write only\n");
 115      #endif
 116      return -1;
 117   }
 118   if ( (BAREAD & *mode ) && (BAWRITE & *mode) ) {
 119      #ifdef VERBOSE
 120        printf("illegal -- trying to both read and write in the same call\n");
 121      #endif
 122      return -2;
 123   }
 124
 125 /* This section handles Fortran to C translation of strings so as to */
 126 /*   be able to open the files Fortran is expecting to be opened.    */
 127   #ifdef CRAY90
 128     namelen = _fcdlen(fcd_fname);
 129     fname   = _fcdtocp(fcd_fname);
 130   #endif
 131   if ( (BAOPEN_RONLY & *mode) || (BAOPEN_WONLY & *mode) ||
 132        (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ||
 133        (BAOPEN_RW & *mode) ) {
 134     #ifdef VERBOSE
 135       printf("Will be opening a file %s %d\n", fname, namelen); fflush(stdout);
 136       printf("Strlen %d namelen %d\n", strlen(fname), namelen); fflush(stdout);
 137     #endif
 138     realname = (char *) malloc( namelen * sizeof(char) ) ;
 139     if (realname == NULL) {
 140       #ifdef VERBOSE
 141         printf("failed to mallocate realname %d = namelen\n", namelen);
 142         fflush(stdout);
 143       #endif
 144       return -3;
 145     }
 146     tempchar = (char *) malloc(sizeof(char) * 1 ) ;
 147     i = 0;
 148     j = 0;
 149     *tempchar = fname[i];
 150     tcharval = *tempchar;
 151     while (i == j && i < namelen ) {
 152        fflush(stdout);
 153        if ( isgraph(tcharval) ) {
 154          realname[j] = fname[i];
 155          j += 1;
 156        }
 157        i += 1;
 158        *tempchar = fname[i];
 159        tcharval = *tempchar;
 160     }
 161     #ifdef VERBOSE
 162       printf("i,j = %d %d\n",i,j); fflush(stdout);
 163     #endif
 164     realname[j] = '\0';
 165   }
 166
 167 /* Open files with correct read/write and file permission. */
 168   if (BAOPEN_RONLY & *mode) {
 169     #ifdef VERBOSE
 170       printf("open read only %s\n", realname);
 171     #endif
 172      *fdes = open(realname, O_RDONLY , S_IRWXU | S_IRWXG | S_IRWXO );
 173   }
 174   else if (BAOPEN_WONLY & *mode ) {
 175     #ifdef VERBOSE
 176       printf("open write only %s\n", realname);
 177     #endif
 178      *fdes = open(realname, O_WRONLY | O_CREAT , S_IRWXU | S_IRWXG | S_IRWXO );
 179   }
 180   else if (BAOPEN_WONLY_TRUNC & *mode ) {
 181     #ifdef VERBOSE
 182       printf("open write only with truncation %s\n", realname);
 183     #endif
 184      *fdes = open(realname, O_WRONLY | O_CREAT | O_TRUNC , S_IRWXU | S_IRWXG | S_IRWXO );
 185   }
 186   else if (BAOPEN_WONLY_APPEND & *mode ) {
 187     #ifdef VERBOSE
 188       printf("open write only with append %s\n", realname);
 189     #endif
 190      *fdes = open(realname, O_WRONLY | O_CREAT | O_APPEND , S_IRWXU | S_IRWXG | S_IRWXO );
 191   }
 192   else if (BAOPEN_RW & *mode) {
 193     #ifdef VERBOSE
 194       printf("open read-write %s\n", realname);
 195     #endif
 196      *fdes = open(realname, O_RDWR | O_CREAT , S_IRWXU | S_IRWXG | S_IRWXO );
 197   }
 198   else {
 199     #ifdef VERBOSE
 200       printf("no openings\n");
 201     #endif
 202   }
 203   if (*fdes < 0) {
 204     #ifdef VERBOSE
 205       printf("error in file descriptor! *fdes %d\n", *fdes);
 206     #endif
 207     return -4;
 208   }
 209   else {
 210     #ifdef VERBOSE
 211       printf("file descriptor = %d\n",*fdes );
 212     #endif
 213   }
 214
 215
 216 /* Read data as requested */
 217   if (BAREAD & *mode &&
 218    ( (BAOPEN_WONLY & *mode) || (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ) ) {
 219     #ifdef VERBOSE
 220       printf("Error, trying to read while in write only mode!\n");
 221     #endif
 222     return -5;
 223   }
 224   else if (BAREAD & *mode ) {
 225   /* Read in some data */
 226     if (! (*mode & NOSEEK) ) {
 227       seekret = lseek(*fdes, *start, SEEK_SET);
 228       if (seekret == -1) {
 229         #ifdef VERBOSE
 230           printf("error in seeking to %d\n",*start);
 231         #endif
 232         return -6;
 233       }
 234       #ifdef VERBOSE
 235       else {
 236          printf("Seek successful, seek ret %d, start %d\n", seekret, *start);
 237       }
 238       #endif
 239     }
 240     #ifdef CRAY90
 241       datary = _fcdtocp(fcd_datary);
 242     #endif
 243     if (datary == NULL) {
 244       printf("Massive catastrophe -- datary pointer is NULL\n");
 245       return -666;
 246     }
 247     #ifdef VERBOSE
 248       printf("file descriptor, datary = %d %d\n", *fdes, (int) datary);
 249     #endif
 250     count = (size_t) *no;
 251     jret = read(*fdes, (void *) datary, count);
 252     if (jret != *no) {
 253       #ifdef VERBOSE
 254         printf("did not read in the requested number of bytes\n");
 255         printf("read in %d bytes instead of %d \n",jret, *no);
 256       #endif
 257     }
 258     else {
 259     #ifdef VERBOSE
 260       printf("read in %d bytes requested \n", *no);
 261     #endif
 262     }
 263     *nactual = jret;
 264     *newpos = *start + jret;
 265   }
 266 /* Done with reading */
 267
 268 /* See if we should be writing */
 269   if ( BAWRITE & *mode && BAOPEN_RONLY & *mode ) {
 270     #ifdef VERBOSE
 271       printf("Trying to write on a read only file \n");
 272     #endif
 273      return -7;
 274   }
 275   else if ( BAWRITE & *mode ) {
 276     if (! (*mode & NOSEEK) ) {
 277       seekret = lseek(*fdes, *start, SEEK_SET);
 278       if (seekret == -1) {
 279       #ifdef VERBOSE
 280         printf("error in seeking to %d\n",*start);
 281       #endif
 282         return -8;
 283       }
 284     }
 285     #ifdef CRAY90
 286       datary = _fcdtocp(fcd_datary);
 287     #endif
 288     if (datary == NULL) {
 289       printf("Massive catastrophe -- datary pointer is NULL\n");
 290       return -666;
 291     }
 292     #ifdef VERBOSE
 293       printf("write file descriptor, datary = %d %d\n", *fdes, (int) datary);
 294     #endif
 295     count = (size_t) *no;
 296     jret = write(*fdes, (void *) datary, count);
 297     if (jret != *no) {
 298     #ifdef VERBOSE
 299       printf("did not write out the requested number of bytes\n");
 300       printf("wrote %d bytes instead\n", jret);
 301     #endif
 302       *nactual = jret;
 303       *newpos = *start + jret;
 304     }
 305     else {
 306     #ifdef VERBOSE
 307        printf("wrote %d bytes \n", jret);
 308     #endif
 309        *nactual = jret;
 310        *newpos = *start + jret;
 311     }
 312   }
 313 /* Done with writing */
 314
 315
 316 /* Close file if requested */
 317   if (BACLOSE & *mode ) {
 318     jret = close(*fdes);
 319     if (jret != 0) {
 320     #ifdef VERBOSE
 321       printf("close failed! jret = %d\n",jret);
 322     #endif
 323       return -9;
 324     }
 325   }
 326 /* Done closing */
 327
 328 /* Check that if we were reading or writing, that we actually got what */
 329 /*  we expected, else return a -10.  Return 0 (success) if we're here  */
 330 /*  and weren't reading or writing */
 331   if ( (*mode & BAREAD || *mode & BAWRITE) && (*nactual != *no) ) {
 332     return -10;
 333   }
 334   else {
 335     return 0;
 336   }
 337 }
 338 #if defined _UNDERSCORE
 339   int banio_
 340          (int * mode, int * start, int *newpos, int * size, int * no,
 341           int * nactual, int * fdes, const char *fname, char *datary,
 342           int  namelen ) {
 343 #elif defined _DOUBLEUNDERSCORE
 344   int banio__
 345          (int * mode, int * start, int *newpos, int * size, int * no,
 346           int * nactual, int * fdes, const char *fname, char *datary,
 347           int  namelen ) {
 348 #else
 349   int banio
 350          (int * mode, int * start, int *newpos, int * size, int * no,
 351           int * nactual, int * fdes, const char *fname, char *datary,
 352           int  namelen ) {
 353 #endif
 354   int i, j, jret, seekret;
 355   char *realname, *tempchar;
 356   int tcharval;
 357
 358 /* Initialization(s) */
 359   *nactual = 0;
 360
 361 /* Check for illegal combinations of options */
 362   if (( BAOPEN_RONLY & *mode) &&
 363      ( (BAOPEN_WONLY & *mode) || (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ) ) {
 364      #ifdef VERBOSE
 365        printf("illegal -- trying to open both read only and write only\n");
 366      #endif
 367      return -1;
 368   }
 369   if ( (BAREAD & *mode ) && (BAWRITE & *mode) ) {
 370      #ifdef VERBOSE
 371        printf("illegal -- trying to both read and write in the same call\n");
 372      #endif
 373      return -2;
 374   }
 375
 376 /* This section handles Fortran to C translation of strings so as to */
 377 /*   be able to open the files Fortran is expecting to be opened.    */
 378   #ifdef CRAY90
 379     namelen = _fcdlen(fcd_fname);
 380     fname   = _fcdtocp(fcd_fname);
 381   #endif
 382   if ( (BAOPEN_RONLY & *mode) || (BAOPEN_WONLY & *mode) ||
 383        (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ||
 384        (BAOPEN_RW & *mode) ) {
 385     #ifdef VERBOSE
 386       printf("Will be opening a file %s %d\n", fname, namelen); fflush(stdout);
 387       printf("Strlen %d namelen %d\n", strlen(fname), namelen); fflush(stdout);
 388     #endif
 389     realname = (char *) malloc( namelen * sizeof(char) ) ;
 390     if (realname == NULL) {
 391       #ifdef VERBOSE
 392         printf("failed to mallocate realname %d = namelen\n", namelen);
 393         fflush(stdout);
 394       #endif
 395       return -3;
 396     }
 397     tempchar = (char *) malloc(sizeof(char) * 1 ) ;
 398     i = 0;
 399     j = 0;
 400     *tempchar = fname[i];
 401     tcharval = *tempchar;
 402     while (i == j && i < namelen ) {
 403        fflush(stdout);
 404        if ( isgraph(tcharval) ) {
 405          realname[j] = fname[i];
 406          j += 1;
 407        }
 408        i += 1;
 409        *tempchar = fname[i];
 410        tcharval = *tempchar;
 411     }
 412     #ifdef VERBOSE
 413       printf("i,j = %d %d\n",i,j); fflush(stdout);
 414     #endif
 415     realname[j] = '\0';
 416   }
 417
 418 /* Open files with correct read/write and file permission. */
 419   if (BAOPEN_RONLY & *mode) {
 420     #ifdef VERBOSE
 421       printf("open read only %s\n", realname);
 422     #endif
 423      *fdes = open(realname, O_RDONLY , S_IRWXU | S_IRWXG | S_IRWXO );
 424   }
 425   else if (BAOPEN_WONLY & *mode ) {
 426     #ifdef VERBOSE
 427       printf("open write only %s\n", realname);
 428     #endif
 429      *fdes = open(realname, O_WRONLY | O_CREAT , S_IRWXU | S_IRWXG | S_IRWXO );
 430   }
 431   else if (BAOPEN_WONLY_TRUNC & *mode ) {
 432     #ifdef VERBOSE
 433       printf("open write only with truncation %s\n", realname);
 434     #endif
 435      *fdes = open(realname, O_WRONLY | O_CREAT | O_TRUNC , S_IRWXU | S_IRWXG | S_IRWXO );
 436   }
 437   else if (BAOPEN_WONLY_APPEND & *mode ) {
 438     #ifdef VERBOSE
 439       printf("open write only with append %s\n", realname);
 440     #endif
 441      *fdes = open(realname, O_WRONLY | O_CREAT | O_APPEND , S_IRWXU | S_IRWXG | S_IRWXO );
 442   }
 443   else if (BAOPEN_RW & *mode) {
 444     #ifdef VERBOSE
 445       printf("open read-write %s\n", realname);
 446     #endif
 447      *fdes = open(realname, O_RDWR | O_CREAT , S_IRWXU | S_IRWXG | S_IRWXO );
 448   }
 449   else {
 450     #ifdef VERBOSE
 451       printf("no openings\n");
 452     #endif
 453   }
 454   if (*fdes < 0) {
 455     #ifdef VERBOSE
 456       printf("error in file descriptor! *fdes %d\n", *fdes);
 457     #endif
 458     return -4;
 459   }
 460   else {
 461     #ifdef VERBOSE
 462       printf("file descriptor = %d\n",*fdes );
 463     #endif
 464   }
 465
 466
 467 /* Read data as requested */
 468   if (BAREAD & *mode &&
 469    ( (BAOPEN_WONLY & *mode) || (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ) ) {
 470     #ifdef VERBOSE
 471       printf("Error, trying to read while in write only mode!\n");
 472     #endif
 473     return -5;
 474   }
 475   else if (BAREAD & *mode ) {
 476   /* Read in some data */
 477     if (! (*mode & NOSEEK) ) {
 478       seekret = lseek(*fdes, *start, SEEK_SET);
 479       if (seekret == -1) {
 480         #ifdef VERBOSE
 481           printf("error in seeking to %d\n",*start);
 482         #endif
 483         return -6;
 484       }
 485       #ifdef VERBOSE
 486       else {
 487          printf("Seek successful, seek ret %d, start %d\n", seekret, *start);
 488       }
 489       #endif
 490     }
 491     jret = read(*fdes, datary, *no*(*size) );
 492     if (jret != *no*(*size) ) {
 493       #ifdef VERBOSE
 494         printf("did not read in the requested number of items\n");
 495         printf("read in %d items of %d \n",jret/(*size), *no);
 496       #endif
 497       *nactual = jret/(*size);
 498       *newpos = *start + jret;
 499     }
 500     #ifdef VERBOSE
 501       printf("read in %d items \n", jret/(*size));
 502     #endif
 503     *nactual = jret/(*size);
 504     *newpos = *start + jret;
 505   }
 506 /* Done with reading */
 507
 508 /* See if we should be writing */
 509   if ( BAWRITE & *mode && BAOPEN_RONLY & *mode ) {
 510     #ifdef VERBOSE
 511       printf("Trying to write on a read only file \n");
 512     #endif
 513      return -7;
 514   }
 515   else if ( BAWRITE & *mode ) {
 516     if (! (*mode & NOSEEK) ) {
 517       seekret = lseek(*fdes, *start, SEEK_SET);
 518       if (seekret == -1) {
 519       #ifdef VERBOSE
 520         printf("error in seeking to %d\n",*start);
 521       #endif
 522         return -8;
 523       }
 524       #ifdef VERBOSE
 525       else {
 526         printf("Seek successful, seek ret %d, start %d\n", seekret, *start);
 527       }
 528       #endif
 529     }
 530     jret = write(*fdes, datary, *no*(*size));
 531     if (jret != *no*(*size)) {
 532     #ifdef VERBOSE
 533       printf("did not write out the requested number of items\n");
 534       printf("wrote %d items instead\n", jret/(*size) );
 535     #endif
 536       *nactual = jret/(*size) ;
 537       *newpos = *start + jret;
 538     }
 539     else {
 540     #ifdef VERBOSE
 541        printf("wrote %d items \n", jret/(*size) );
 542     #endif
 543        *nactual = jret/(*size) ;
 544        *newpos = *start + jret;
 545     }
 546   }
 547 /* Done with writing */
 548
 549
 550 /* Close file if requested */
 551   if (BACLOSE & *mode ) {
 552     jret = close(*fdes);
 553     if (jret != 0) {
 554     #ifdef VERBOSE
 555       printf("close failed! jret = %d\n",jret);
 556     #endif
 557       return -9;
 558     }
 559   }
 560 /* Done closing */
 561
 562 /* Check that if we were reading or writing, that we actually got what */
 563 /*  we expected, else return a -10.  Return 0 (success) if we're here  */
 564 /*  and weren't reading or writing */
 565   if ( (*mode & BAREAD || *mode & BAWRITE) && (*nactual != *no) ) {
 566     return -10;
 567   }
 568   else {
 569     return 0;
 570   }
 571 }