wrfv2_fire/external/io_grib2/bacio-1.3/bacio.v1.3.c

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