/* Fortran-callable routines to read and write characther (bacio) and */
/*   numeric (banio) data byte addressably                            */
/* Robert Grumbine  16 March 1998                                        */
/*  v1.1: Put diagnostic output under control of define VERBOSE or QUIET */
/*        Add option of non-seeking read/write                           */
/*        Return code for fewer data read/written than requested         */
/*  v1.2: Add cray compatibility  20 April 1998  Robert Grumbine         */
/*  v1.3: Add IBMSP compatibility (IBM4, IBM8)
          Add modes BAOPEN_WONLY_TRUNC, BAOPEN_WONLY_APPEND
          Use isgraph instead of isalnum + a short list of accepted characters 
                for filename check
          12 Dec 2000 Stephen Gilbert                                    */
/*        negative return codes are wrapped to positive, revise return codes
          verify that banio and bacio have same contents
          update comments
          29 Oct 2008 Robert Grumbine                                    */
/*  v1.4: 21 Nov 2008 
          Add baciol and baniol functions, versions to work with files 
            over 2 Gb
          Robert Grumbine */
/*        Aug 2012 Jun Wang: fix c filename length because the c string 
          needs to end with "null" terminator , and free allocated cfile 
          name realname to avoid memory leak                             */
/*        Sep 2012 Jun Wang: remove execute permission on the data file  
          generated by bacio                                             */

#include <stdio.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>
#include <unistd.h>
#include <malloc.h>
#include <ctype.h>
#include <string.h>

/* Include the C library file for definition/control */
/* Things that might be changed for new systems are there. */
/* This source file should not (need to) be edited, merely recompiled */
#include "clib.h"


/* Return Codes:  */
/*  0    All was well                                   */
/* 255   Tried to open read only _and_ write only       */
/* 254   Tried to read and write in the same call       */
/* 253   Internal failure in name processing            */
/* 252   Failure in opening file                        */
/* 251   Tried to read on a write-only file             */ 
/* 250   Failed in read to find the 'start' location    */
/* 249   Tried to write to a read only file             */
/* 248   Failed in write to find the 'start' location   */
/* 247   Error in close                                 */
/* 246   Read or wrote fewer data than requested        */
/* 102   Massive catastrophe -- datary pointer is NULL  */

/* Note: In your Fortran code, call bacio, not bacio_.  */
/*int bacio_(int * mode, int * start, int * size, int * no, int * nactual,   */ 
/*          int * fdes, const char *fname, char *data, int  namelen,         */ 
/*          int  datanamelen)                                                */
/* Arguments: */
/* Mode is the integer specifying operations to be performed                 */
/*    see the clib.inc file for the values.  Mode is obtained                */
/*    by adding together the values corresponding to the operations          */
/*    The best method is to include the clib.inc file and refer to the       */
/*    names for the operations rather than rely on hard-coded values         */
/* Start is the byte number to start your operation from.  0 is the first    */
/*    byte in the file, not 1.                                               */
/* Newpos is the position in the file after a read or write has been         */
/*    performed.  You'll need this if you're doing 'seeking' read/write      */
/* Size is the size of the objects you are trying to read.  Rely on the      */
/*    values in the locale.inc file.  Types are CHARACTER, INTEGER, REAL,    */
/*    COMPLEX.  Specify the correct value by using SIZEOF_type, where type   */
/*    is one of these.  (After having included the locale.inc file)          */
/* no is the number of things to read or write (characters, integers,        */
/*                                                              whatever)    */
/* nactual is the number of things actually read or written.  Check that     */
/*    you got what you wanted.                                               */
/* fdes is an integer 'file descriptor'.  This is not a Fortran Unit Number  */
/*    You can use it, however, to refer to files you've previously opened.   */
/* fname is the name of the file.  This only needs to be defined when you    */
/*    are opening a file.  It must be (on the Fortran side) declared as      */
/*    CHARACTER*N, where N is a length greater than or equal to the length   */
/*    of the file name.  CHARACTER*1 fname[80] (for example) will fail.      */
/* data is the name of the entity (variable, vector, array) that you want    */
/*    to write data out from or read it in to.  The fact that C is declaring */
/*    it to be a char * does not affect your fortran.                        */
/* namelen - Do NOT specify this.  It is created automagically by the        */
/*    Fortran compiler                                                       */
/* datanamelen - Ditto                                                       */ 


/* What is going on here is that although the Fortran caller will always */
/*   be calling bacio, the called C routine name will change from system */
/*   to system. */
#ifdef CRAY90
  #include <fortran.h>
  int BACIO
         (int * mode, int * start, int *newpos, int * size, int * no, 
          int * nactual, int * fdes, 
          _fcd fcd_fname, _fcd fcd_datary) { 
  char *fname, *datary;
  int namelen;
#endif
#ifdef HP
  int bacio
         (int * mode, int * start, int *newpos, int * size, int * no, 
          int * nactual, int * fdes, const char *fname, char *datary, 
          int  namelen, int  datanamelen) {
#endif
#ifdef SGI
  int bacio_
         (int * mode, int * start, int *newpos, int * size, int * no, 
          int * nactual, int * fdes, const char *fname, char *datary, 
          int  namelen, int  datanamelen) {
#endif
#ifdef LINUX
  int bacio_
         (int * mode, int * start, int *newpos, int * size, int * no, 
          int * nactual, int * fdes, const char *fname, char *datary, 
          int  namelen, int  datanamelen) {
#endif
#ifdef LINUXF90
  int BACIO
         (int * mode, int * start, int *newpos, int * size, int * no, 
          int * nactual, int * fdes, const char *fname, char *datary, 
          int  namelen, int  datanamelen) {
#endif
#ifdef VPP5000
  int bacio_
         (int * mode, int * start, int *newpos, int * size, int * no, 
          int * nactual, int * fdes, const char *fname, char *datary, 
          int  namelen, int  datanamelen) {
#endif
#ifdef IBM4
  int bacio
         (int * mode, int * start, int *newpos, int * size, int * no, 
          int * nactual, int * fdes, const char *fname, char *datary, 
          int  namelen, int  datanamelen) {
#endif
#ifdef IBM8
  long long int bacio
         (long long int * mode, long long int * start, long long int *newpos,
          long long int * size, long long int * no, 
          long long int * nactual, long long int * fdes, const char *fname,
          char *datary, 
          long long int  namelen, long long int  datanamelen) {
#endif
  int i, j, jret, seekret;
  char *realname;
  int tcharval;
  size_t count;

/* Initialization(s) */
  *nactual = 0;

/* Check for illegal combinations of options */
  if (( BAOPEN_RONLY & *mode) &&
     ( (BAOPEN_WONLY & *mode) || (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ) ) {
     #ifdef VERBOSE
       printf("illegal -- trying to open both read only and write only\n");
     #endif
     return 255;
  }
  if ( (BAREAD & *mode ) && (BAWRITE & *mode) ) {
     #ifdef VERBOSE
       printf("illegal -- trying to both read and write in the same call\n");
     #endif
     return 254;
  }

/* This section handles Fortran to C translation of strings so as to */
/*   be able to open the files Fortran is expecting to be opened.    */
  #ifdef CRAY90
    namelen = _fcdlen(fcd_fname);
    fname   = _fcdtocp(fcd_fname);
  #endif
  if ( (BAOPEN_RONLY & *mode) || (BAOPEN_WONLY & *mode) || 
       (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ||
       (BAOPEN_RW & *mode) ) {
    #ifdef VERBOSE
      printf("Will be opening a file %s %d\n", fname, namelen); fflush(stdout);
      printf("Strlen %d namelen %d\n", strlen(fname), namelen); fflush(stdout);
    #endif
    realname = (char *) malloc( (namelen+1) * sizeof(char) ) ;
    if (realname == NULL) { 
      #ifdef VERBOSE
        printf("failed to mallocate realname %d = namelen\n", namelen);
        fflush(stdout);
      #endif
      return 253;
    }

    i=0;
    while (i < namelen && isgraph(fname[i])) {
      realname[i]=fname[i];
      i++;
    }
    realname[i] = '\0';
  } 
   
/* Open files with correct read/write and file permission. */
  if (BAOPEN_RONLY & *mode) {
    #ifdef VERBOSE
      printf("open read only %s\n", realname);
    #endif
     *fdes = open(realname, O_RDONLY , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
  }
  else if (BAOPEN_WONLY & *mode ) {
    #ifdef VERBOSE
      printf("open write only %s\n", realname);
    #endif
     *fdes = open(realname, O_WRONLY | O_CREAT , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
  }
  else if (BAOPEN_WONLY_TRUNC & *mode ) {
    #ifdef VERBOSE
      printf("open write only with truncation %s\n", realname);
    #endif
     *fdes = open(realname, O_WRONLY | O_CREAT | O_TRUNC , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
  }
  else if (BAOPEN_WONLY_APPEND & *mode ) {
    #ifdef VERBOSE
      printf("open write only with append %s\n", realname);
    #endif
     *fdes = open(realname, O_WRONLY | O_CREAT | O_APPEND , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
  }
  else if (BAOPEN_RW & *mode) {
    #ifdef VERBOSE
      printf("open read-write %s\n", realname);
    #endif
     *fdes = open(realname, O_RDWR | O_CREAT , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
  }
  else {
    #ifdef VERBOSE
      printf("no openings\n");
    #endif
  }
  if (*fdes < 0) {
    #ifdef VERBOSE
      printf("error in file descriptor! *fdes %d\n", *fdes);
    #endif
    return 252;
  }
  else {
    #ifdef VERBOSE
      printf("file descriptor = %d\n",*fdes );
    #endif
  }


/* Read data as requested */
  if (BAREAD & *mode &&
   ( (BAOPEN_WONLY & *mode) || (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ) ) {
    #ifdef VERBOSE
      printf("Error, trying to read while in write only mode!\n");
    #endif
    return 251;
  }
  else if (BAREAD & *mode ) {
  /* Read in some data */
    if (! (*mode & NOSEEK) ) {
      seekret = lseek(*fdes, *start, SEEK_SET);
      if (seekret == -1) {
        #ifdef VERBOSE
          printf("error in seeking to %d\n",*start);
        #endif
        return 250;
      }
      #ifdef VERBOSE
      else {
         printf("Seek successful, seek ret %d, start %d\n", seekret, *start);
      }
      #endif
    }
    #ifdef CRAY90
      datary = _fcdtocp(fcd_datary);
    #endif
    if (datary == NULL) {
      printf("Massive catastrophe -- datary pointer is NULL\n");
      return 102;
    }
    #ifdef VERBOSE
      printf("file descriptor, datary = %d %d\n", *fdes, (int) datary);
    #endif
    count = (size_t) *no;
    jret = read(*fdes, (void *) datary, count);
    if (jret != *no) {
      #ifdef VERBOSE
        printf("did not read in the requested number of bytes\n");
        printf("read in %d bytes instead of %d \n",jret, *no);
      #endif
    }  
    else {
    #ifdef VERBOSE
      printf("read in %d bytes requested \n", *no);
    #endif
    }
    *nactual = jret;
    *newpos = *start + jret;
  }
/* Done with reading */
 
/* See if we should be writing */
  if ( BAWRITE & *mode && BAOPEN_RONLY & *mode ) {
    #ifdef VERBOSE
      printf("Trying to write on a read only file \n");
    #endif
     return 249;
  }
  else if ( BAWRITE & *mode ) {
    if (! (*mode & NOSEEK) ) {
      seekret = lseek(*fdes, *start, SEEK_SET);
      if (seekret == -1) {
      #ifdef VERBOSE
        printf("error in seeking to %d\n",*start);
      #endif
        return 248;
      }
      #ifdef VERBOSE
      else {
        printf("Seek successful, seek ret %d, start %d\n", seekret, *start);
      }
      #endif
    }
    #ifdef CRAY90
      datary = _fcdtocp(fcd_datary);
    #endif
    if (datary == NULL) {
      printf("Massive catastrophe -- datary pointer is NULL\n");
      return 102;
    }
    #ifdef VERBOSE
      printf("write file descriptor, datary = %d %d\n", *fdes, (int) datary);
    #endif
    count = (size_t) *no;
    jret = write(*fdes, (void *) datary, count);
    if (jret != *no) {
    #ifdef VERBOSE
      printf("did not write out the requested number of bytes\n");
      printf("wrote %d bytes instead\n", jret);
    #endif
      *nactual = jret;
      *newpos = *start + jret;
    }
    else {
    #ifdef VERBOSE
       printf("wrote %d bytes \n", jret);
    #endif
       *nactual = jret;
       *newpos = *start + jret;
    }
  }
/* Done with writing */
    

/* Close file if requested */
  if (BACLOSE & *mode ) {
    jret = close(*fdes);
    if (jret != 0) { 
    #ifdef VERBOSE
      printf("close failed! jret = %d\n",jret);
    #endif
      return 247;
    }
  }
/* Done closing */

/* Free the realname pointer to prevent memory leak */
  if ( (BAOPEN_RONLY & *mode) || (BAOPEN_WONLY & *mode) ||
       (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ||
       (BAOPEN_RW & *mode) ) {
    free(realname);
  }

/* Check that if we were reading or writing, that we actually got what */
/*  we expected, else return a -10.  Return 0 (success) if we're here  */
/*  and weren't reading or writing */
  if ( (*mode & BAREAD || *mode & BAWRITE) && (*nactual != *no) ) {
    return 246;
  }
  else {
    return 0;
  }
} 
#ifdef CRAY90
  #include <fortran.h>
  int BANIO
         (int * mode, int * start, int *newpos, int * size, int * no, 
          int * nactual, int * fdes, 
          _fcd fcd_fname, void *datary) { 
  char *fname;
  int namelen;
#endif
#ifdef HP
  int banio
         (int * mode, int * start, int *newpos, int * size, int * no, 
          int * nactual, int * fdes, const char *fname, char *datary, 
          int  namelen ) {
#endif
#ifdef SGI
  int banio_
         (int * mode, int * start, int *newpos, int * size, int * no, 
          int * nactual, int * fdes, const char *fname, char *datary, 
          int  namelen ) {
#endif
#ifdef LINUX
  int banio_
         (int * mode, int * start, int *newpos, int * size, int * no, 
          int * nactual, int * fdes, const char *fname, char *datary, 
          int  namelen ) {
#endif
#ifdef LINUXF90
  int BANIO
         (int * mode, int * start, int *newpos, int * size, int * no, 
          int * nactual, int * fdes, const char *fname, char *datary, 
          int  namelen ) {
#endif
#ifdef VPP5000
  int banio_
         (int * mode, int * start, int *newpos, int * size, int * no, 
          int * nactual, int * fdes, const char *fname, char *datary, 
          int  namelen ) {
#endif
#ifdef IBM4
  int banio
         (int * mode, int * start, int *newpos, int * size, int * no, 
          int * nactual, int * fdes, const char *fname, char *datary, 
          int  namelen ) {
#endif
#ifdef IBM8
  long long int banio
         (long long int * mode, long long int * start, long long int *newpos,
          long long int * size, long long int * no, 
          long long int * nactual, long long int * fdes, const char *fname,
          char *datary, 
          long long int  namelen ) {
#endif
  int i, j, jret, seekret;
  char *realname;
  int tcharval;
  size_t count;

/* Initialization(s) */
  *nactual = 0;

/* Check for illegal combinations of options */
  if (( BAOPEN_RONLY & *mode) &&
     ( (BAOPEN_WONLY & *mode) || (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ) ) {
     #ifdef VERBOSE
       printf("illegal -- trying to open both read only and write only\n");
     #endif
     return 255;
  }
  if ( (BAREAD & *mode ) && (BAWRITE & *mode) ) {
     #ifdef VERBOSE
       printf("illegal -- trying to both read and write in the same call\n");
     #endif
     return 254;
  }

/* This section handles Fortran to C translation of strings so as to */
/*   be able to open the files Fortran is expecting to be opened.    */
  #ifdef CRAY90
    namelen = _fcdlen(fcd_fname);
    fname   = _fcdtocp(fcd_fname);
  #endif
  if ( (BAOPEN_RONLY & *mode) || (BAOPEN_WONLY & *mode) || 
       (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ||
       (BAOPEN_RW & *mode) ) {
    #ifdef VERBOSE
      printf("Will be opening a file %s %d\n", fname, namelen); fflush(stdout);
      printf("Strlen %d namelen %d\n", strlen(fname), namelen); fflush(stdout);
    #endif
    realname = (char *) malloc( (namelen+1) * sizeof(char) ) ;
    if (realname == NULL) { 
      #ifdef VERBOSE
        printf("failed to mallocate realname %d = namelen\n", namelen);
        fflush(stdout);
      #endif
      return 253;
    }

    i=0;
    while (i < namelen && isgraph(fname[i])) {
      realname[i]=fname[i];
      i++;
    }
    realname[i] = '\0';
  } 
   
/* Open files with correct read/write and file permission. */
  if (BAOPEN_RONLY & *mode) {
    #ifdef VERBOSE
      printf("open read only %s\n", realname);
    #endif
     *fdes = open(realname, O_RDONLY , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
  }
  else if (BAOPEN_WONLY & *mode ) {
    #ifdef VERBOSE
      printf("open write only %s\n", realname);
    #endif
     *fdes = open(realname, O_WRONLY | O_CREAT , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
  }
  else if (BAOPEN_WONLY_TRUNC & *mode ) {
    #ifdef VERBOSE
      printf("open write only with truncation %s\n", realname);
    #endif
     *fdes = open(realname, O_WRONLY | O_CREAT | O_TRUNC , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
  }
  else if (BAOPEN_WONLY_APPEND & *mode ) {
    #ifdef VERBOSE
      printf("open write only with append %s\n", realname);
    #endif
     *fdes = open(realname, O_WRONLY | O_CREAT | O_APPEND , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
  }
  else if (BAOPEN_RW & *mode) {
    #ifdef VERBOSE
      printf("open read-write %s\n", realname);
    #endif
     *fdes = open(realname, O_RDWR | O_CREAT , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
  }
  else {
    #ifdef VERBOSE
      printf("no openings\n");
    #endif
  }
  if (*fdes < 0) {
    #ifdef VERBOSE
      printf("error in file descriptor! *fdes %d\n", *fdes);
    #endif
    return 252;
  }
  else {
    #ifdef VERBOSE
      printf("file descriptor = %d\n",*fdes );
    #endif
  }


/* Read data as requested */
  if (BAREAD & *mode &&
   ( (BAOPEN_WONLY & *mode) || (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ) ) {
    #ifdef VERBOSE
      printf("Error, trying to read while in write only mode!\n");
    #endif
    return 251;
  }
  else if (BAREAD & *mode ) {
  /* Read in some data */
    if (! (*mode & NOSEEK) ) {
      seekret = lseek(*fdes, *start, SEEK_SET);
      if (seekret == -1) {
        #ifdef VERBOSE
          printf("error in seeking to %d\n",*start);
        #endif
        return 250;
      }
      #ifdef VERBOSE
      else {
         printf("Seek successful, seek ret %d, start %d\n", seekret, *start);
      }
      #endif
    }
    jret = read(*fdes, datary, *no*(*size) );
    if (jret != *no*(*size) ) {
      #ifdef VERBOSE
        printf("did not read in the requested number of items\n");
        printf("read in %d items of %d \n",jret/(*size), *no);
      #endif
      *nactual = jret/(*size);
      *newpos = *start + jret;
    }  
    #ifdef VERBOSE
      printf("read in %d items \n", jret/(*size));
    #endif
    *nactual = jret/(*size);
    *newpos = *start + jret;
  }
/* Done with reading */
 
/* See if we should be writing */
  if ( BAWRITE & *mode && BAOPEN_RONLY & *mode ) {
    #ifdef VERBOSE
      printf("Trying to write on a read only file \n");
    #endif
     return 249;
  }
  else if ( BAWRITE & *mode ) {
    if (! (*mode & NOSEEK) ) {
      seekret = lseek(*fdes, *start, SEEK_SET);
      if (seekret == -1) {
      #ifdef VERBOSE
        printf("error in seeking to %d\n",*start);
      #endif
        return 248;
      }
      #ifdef VERBOSE
      else {
        printf("Seek successful, seek ret %d, start %d\n", seekret, *start);
      }
      #endif
    }
    jret = write(*fdes, datary, *no*(*size));
    if (jret != *no*(*size)) {
    #ifdef VERBOSE
      printf("did not write out the requested number of items\n");
      printf("wrote %d items instead\n", jret/(*size) );
    #endif
      *nactual = jret/(*size) ;
      *newpos = *start + jret;
    }
    else {
    #ifdef VERBOSE
       printf("wrote %d items \n", jret/(*size) );
    #endif
       *nactual = jret/(*size) ;
       *newpos = *start + jret;
    }
  }
/* Done with writing */
    

/* Close file if requested */
  if (BACLOSE & *mode ) {
    jret = close(*fdes);
    if (jret != 0) { 
    #ifdef VERBOSE
      printf("close failed! jret = %d\n",jret);
    #endif
      return 247;
    }
  }
/* Done closing */

/* Free the realname pointer to prevent memory leak */
  if ( (BAOPEN_RONLY & *mode) || (BAOPEN_WONLY & *mode) ||
       (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ||
       (BAOPEN_RW & *mode) ) {
    free(realname);
  }

/* Check that if we were reading or writing, that we actually got what */
/*  we expected, else return a -10.  Return 0 (success) if we're here  */
/*  and weren't reading or writing */
  if ( (*mode & BAREAD || *mode & BAWRITE) && (*nactual != *no) ) {
    return 246;
  }
  else {
    return 0;
  }
} 

/*  Now repeat with new names for long int arguments, needed for */
/*    files > 2 Gb */
/*  Robert Grumbine 21 November 2008 */

/* Note: In your Fortran code, call bacio, not bacio_.  */
/*int baciol_(int * mode, long int * start, long int *newpos, int * size, long int * no, 
            long int * nactual,   */ 
/*          int * fdes, const char *fname, char *data, int  namelen,         */ 
/*          int  datanamelen)                                                */
#ifdef CRAY90
  #include <fortran.h>
  int BACIOL
         (int * mode, long int * start, long int *newpos, int * size, long int * no, 
          long int * nactual, int * fdes, 
          _fcd fcd_fname, _fcd fcd_datary) { 
  char *fname, *datary;
  int namelen;
#endif
#ifdef HP
  int baciol
         (int * mode, long int * start, long int *newpos, int * size, long int * no, 
          long int * nactual, int * fdes, const char *fname, char *datary, 
          int  namelen, int  datanamelen) {
#endif
#ifdef SGI
  int baciol_
         (int * mode, long int * start, long int *newpos, int * size, long int * no, 
          long int * nactual, int * fdes, const char *fname, char *datary, 
          int  namelen, int  datanamelen) {
#endif
#ifdef LINUX
  int baciol_
         (int * mode, long int * start, long int *newpos, int * size, long int * no, 
          long int * nactual, int * fdes, const char *fname, char *datary,
          int  namelen, int  datanamelen) {
#endif
#ifdef LINUXF90
  int BACIOL
         (int * mode, long int * start, long int *newpos, int * size, long int * no, 
          long int * nactual, int * fdes, const char *fname, char *datary, 
          int  namelen, int  datanamelen) {
#endif
#ifdef VPP5000
  int baciol_
         (int * mode, long int * start, long int *newpos, int * size, long int * no, 
          long int * nactual, int * fdes, const char *fname, char *datary, 
          int  namelen, int  datanamelen) {
#endif
#ifdef IBM4
  int baciol
         (int * mode, long int * start, long int *newpos, int * size, long int * no, 
          long int * nactual, int * fdes, const char *fname, char *datary, 
          int  namelen, int  datanamelen) {
#endif
#ifdef IBM8
  long long int baciol
         (long long int * mode, long long int * start, long long int *newpos,
          long long int * size, long long int * no, 
          long long int * nactual, long long int * fdes, const char *fname,
          char *datary, 
          long long int  namelen, long long int  datanamelen) {
#endif
  int i, j, jret, seekret;
  char *realname;
  int tcharval;
  size_t count;

/* Initialization(s) */
  *nactual = 0;

/* Check for illegal combinations of options */
  if (( BAOPEN_RONLY & *mode) &&
     ( (BAOPEN_WONLY & *mode) || (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ) ) {
     #ifdef VERBOSE
       printf("illegal -- trying to open both read only and write only\n");
     #endif
     return 255;
  }
  if ( (BAREAD & *mode ) && (BAWRITE & *mode) ) {
     #ifdef VERBOSE
       printf("illegal -- trying to both read and write in the same call\n");
     #endif
     return 254;
  }

/* This section handles Fortran to C translation of strings so as to */
/*   be able to open the files Fortran is expecting to be opened.    */
  #ifdef CRAY90
    namelen = _fcdlen(fcd_fname);
    fname   = _fcdtocp(fcd_fname);
  #endif
  if ( (BAOPEN_RONLY & *mode) || (BAOPEN_WONLY & *mode) || 
       (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ||
       (BAOPEN_RW & *mode) ) {
    #ifdef VERBOSE
      printf("Will be opening a file %s %d\n", fname, namelen); fflush(stdout);
      printf("Strlen %d namelen %d\n", strlen(fname), namelen); fflush(stdout);
    #endif
    realname = (char *) malloc( (namelen+1) * sizeof(char) ) ;
    if (realname == NULL) { 
      #ifdef VERBOSE
        printf("failed to mallocate realname %d = namelen\n", namelen);
        fflush(stdout);
      #endif
      return 253;
    }

    i=0;
    while (i < namelen && isgraph(fname[i])) {
      realname[i]=fname[i];
      i++;
    }
    realname[i] = '\0';

  } 
   
/* Open files with correct read/write and file permission. */
  if (BAOPEN_RONLY & *mode) {
    #ifdef VERBOSE
      printf("open read only %s\n", realname);
    #endif
     *fdes = open(realname, O_RDONLY , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
  }
  else if (BAOPEN_WONLY & *mode ) {
    #ifdef VERBOSE
      printf("open write only %s\n", realname);
    #endif
     *fdes = open(realname, O_WRONLY | O_CREAT , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
  }
  else if (BAOPEN_WONLY_TRUNC & *mode ) {
    #ifdef VERBOSE
      printf("open write only with truncation %s\n", realname);
    #endif
     *fdes = open(realname, O_WRONLY | O_CREAT | O_TRUNC , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
  }
  else if (BAOPEN_WONLY_APPEND & *mode ) {
    #ifdef VERBOSE
      printf("open write only with append %s\n", realname);
    #endif
     *fdes = open(realname, O_WRONLY | O_CREAT | O_APPEND , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
  }
  else if (BAOPEN_RW & *mode) {
    #ifdef VERBOSE
      printf("open read-write %s\n", realname);
    #endif
     *fdes = open(realname, O_RDWR | O_CREAT , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
  }
  else {
    #ifdef VERBOSE
      printf("no openings\n");
    #endif
  }
  if (*fdes < 0) {
    #ifdef VERBOSE
      printf("error in file descriptor! *fdes %d\n", *fdes);
    #endif
    return 252;
  }
  else {
    #ifdef VERBOSE
      printf("file descriptor = %d\n",*fdes );
    #endif
  }


/* Read data as requested */
  if (BAREAD & *mode &&
   ( (BAOPEN_WONLY & *mode) || (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ) ) {
    #ifdef VERBOSE
      printf("Error, trying to read while in write only mode!\n");
    #endif
    return 251;
  }
  else if (BAREAD & *mode ) {
  /* Read in some data */
    if (! (*mode & NOSEEK) ) {
      seekret = lseek(*fdes, *start, SEEK_SET);
      if (seekret == -1) {
        #ifdef VERBOSE
          printf("error in seeking to %d\n",*start);
        #endif
        return 250;
      }
      #ifdef VERBOSE
      else {
         printf("Seek successful, seek ret %d, start %d\n", seekret, *start);
      }
      #endif
    }
    #ifdef CRAY90
      datary = _fcdtocp(fcd_datary);
    #endif
    if (datary == NULL) {
      printf("Massive catastrophe -- datary pointer is NULL\n");
      return 102;
    }
    #ifdef VERBOSE
      printf("file descriptor, datary = %d %d\n", *fdes, (int) datary);
    #endif
    count = (size_t) *no;
    jret = read(*fdes, (void *) datary, count);
    if (jret != *no) {
      #ifdef VERBOSE
        printf("did not read in the requested number of bytes\n");
        printf("read in %d bytes instead of %d \n",jret, *no);
      #endif
    }  
    else {
    #ifdef VERBOSE
      printf("read in %d bytes requested \n", *no);
    #endif
    }
    *nactual = jret;
    *newpos = *start + jret;
  }
/* Done with reading */
 
/* See if we should be writing */
  if ( BAWRITE & *mode && BAOPEN_RONLY & *mode ) {
    #ifdef VERBOSE
      printf("Trying to write on a read only file \n");
    #endif
     return 249;
  }
  else if ( BAWRITE & *mode ) {
    if (! (*mode & NOSEEK) ) {
      seekret = lseek(*fdes, *start, SEEK_SET);
      if (seekret == -1) {
      #ifdef VERBOSE
        printf("error in seeking to %d\n",*start);
      #endif
        return 248;
      }
      #ifdef VERBOSE
      else {
        printf("Seek successful, seek ret %d, start %d\n", seekret, *start);
      }
      #endif
    }
    #ifdef CRAY90
      datary = _fcdtocp(fcd_datary);
    #endif
    if (datary == NULL) {
      printf("Massive catastrophe -- datary pointer is NULL\n");
      return 102;
    }
    #ifdef VERBOSE
      printf("write file descriptor, datary = %d %d\n", *fdes, (int) datary);
    #endif
    count = (size_t) *no;
    jret = write(*fdes, (void *) datary, count);
    if (jret != *no) {
    #ifdef VERBOSE
      printf("did not write out the requested number of bytes\n");
      printf("wrote %d bytes instead\n", jret);
    #endif
      *nactual = jret;
      *newpos = *start + jret;
    }
    else {
    #ifdef VERBOSE
       printf("wrote %d bytes \n", jret);
    #endif
       *nactual = jret;
       *newpos = *start + jret;
    }
  }
/* Done with writing */
    

/* Close file if requested */
  if (BACLOSE & *mode ) {
    jret = close(*fdes);
    if (jret != 0) { 
    #ifdef VERBOSE
      printf("close failed! jret = %d\n",jret);
    #endif
      return 247;
    }
  }
/* Done closing */

/* Free the realname pointer to prevent memory leak */
  if ( (BAOPEN_RONLY & *mode) || (BAOPEN_WONLY & *mode) ||
       (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ||
       (BAOPEN_RW & *mode) ) {
    free(realname);
  }

/* Check that if we were reading or writing, that we actually got what */
/*  we expected, else return a -10.  Return 0 (success) if we're here  */
/*  and weren't reading or writing */
  if ( (*mode & BAREAD || *mode & BAWRITE) && (*nactual != *no) ) {
    return 246;
  }
  else {
    return 0;
  }
} 
#ifdef CRAY90
  #include <fortran.h>
  int BANI0L
         (int * mode, long int * start, long int *newpos, int * size, long int * no, 
          long int * nactual, int * fdes, 
          _fcd fcd_fname, void *datary) { 
  char *fname;
  int namelen;
#endif
#ifdef HP
  int baniol
         (int * mode, long int * start, long int *newpos, int * size, long int * no, 
          long int * nactual, int * fdes, const char *fname, char *datary, 
          int  namelen ) {
#endif
#ifdef SGI
  int baniol_
         (int * mode, long int * start, long int *newpos, int * size, long int * no, 
          long int * nactual, int * fdes, const char *fname, char *datary, 
          int  namelen ) {
#endif
#ifdef LINUX
  int baniol_
         (int * mode, long int * start, long int *newpos, int * size, long int * no, 
          long int * nactual, int * fdes, const char *fname, char *datary, 
          int  namelen ) {
#endif
#ifdef LINUXF90
  int BANIO
         (int * mode, long int * start, long int *newpos, int * size, long int * no, 
          long int * nactual, int * fdes, const char *fname, char *datary, 
          int  namelen ) {
#endif
#ifdef VPP5000
  int baniol_
         (int * mode, long int * start, long int *newpos, int * size, long int * no, 
          long int * nactual, int * fdes, const char *fname, char *datary, 
          int  namelen ) {
#endif
#ifdef IBM4
  int baniol
         (int * mode, long int * start, long int *newpos, long int * size, int * no, 
          long int * nactual, int * fdes, const char *fname, char *datary, 
          int  namelen ) {
#endif
#ifdef IBM8
  long long int baniol
         (long long int * mode, long long int * start, long long int *newpos,
          long long int * size, long long int * no, 
          long long int * nactual, long long int * fdes, const char *fname,
          char *datary, 
          long long int  namelen ) {
#endif
  int i, j, jret, seekret;
  char *realname;
  int tcharval;
  size_t count;

/* Initialization(s) */
  *nactual = 0;

/* Check for illegal combinations of options */
  if (( BAOPEN_RONLY & *mode) &&
     ( (BAOPEN_WONLY & *mode) || (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ) ) {
     #ifdef VERBOSE
       printf("illegal -- trying to open both read only and write only\n");
     #endif
     return 255;
  }
  if ( (BAREAD & *mode ) && (BAWRITE & *mode) ) {
     #ifdef VERBOSE
       printf("illegal -- trying to both read and write in the same call\n");
     #endif
     return 254;
  }

/* This section handles Fortran to C translation of strings so as to */
/*   be able to open the files Fortran is expecting to be opened.    */
  #ifdef CRAY90
    namelen = _fcdlen(fcd_fname);
    fname   = _fcdtocp(fcd_fname);
  #endif
  if ( (BAOPEN_RONLY & *mode) || (BAOPEN_WONLY & *mode) || 
       (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ||
       (BAOPEN_RW & *mode) ) {
    #ifdef VERBOSE
      printf("Will be opening a file %s %d\n", fname, namelen); fflush(stdout);
      printf("Strlen %d namelen %d\n", strlen(fname), namelen); fflush(stdout);
    #endif
    realname = (char *) malloc( (namelen+1) * sizeof(char) ) ;
    if (realname == NULL) { 
      #ifdef VERBOSE
        printf("failed to mallocate realname %d = namelen\n", namelen);
        fflush(stdout);
      #endif
      return 253;
    }
    i=0;
    while (i < namelen && isgraph(fname[i])) {
      realname[i]=fname[i];
      i++;
    }
    realname[i] = '\0';

  } 
   
/* Open files with correct read/write and file permission. */
  if (BAOPEN_RONLY & *mode) {
    #ifdef VERBOSE
      printf("open read only %s\n", realname);
    #endif
     *fdes = open(realname, O_RDONLY , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
  }
  else if (BAOPEN_WONLY & *mode ) {
    #ifdef VERBOSE
      printf("open write only %s\n", realname);
    #endif
     *fdes = open(realname, O_WRONLY | O_CREAT , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
  }
  else if (BAOPEN_WONLY_TRUNC & *mode ) {
    #ifdef VERBOSE
      printf("open write only with truncation %s\n", realname);
    #endif
     *fdes = open(realname, O_WRONLY | O_CREAT | O_TRUNC , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
  }
  else if (BAOPEN_WONLY_APPEND & *mode ) {
    #ifdef VERBOSE
      printf("open write only with append %s\n", realname);
    #endif
     *fdes = open(realname, O_WRONLY | O_CREAT | O_APPEND , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
  }
  else if (BAOPEN_RW & *mode) {
    #ifdef VERBOSE
      printf("open read-write %s\n", realname);
    #endif
     *fdes = open(realname, O_RDWR | O_CREAT , S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP );
  }
  else {
    #ifdef VERBOSE
      printf("no openings\n");
    #endif
  }
  if (*fdes < 0) {
    #ifdef VERBOSE
      printf("error in file descriptor! *fdes %d\n", *fdes);
    #endif
    return 252;
  }
  else {
    #ifdef VERBOSE
      printf("file descriptor = %d\n",*fdes );
    #endif
  }


/* Read data as requested */
  if (BAREAD & *mode &&
   ( (BAOPEN_WONLY & *mode) || (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ) ) {
    #ifdef VERBOSE
      printf("Error, trying to read while in write only mode!\n");
    #endif
    return 251;
  }
  else if (BAREAD & *mode ) {
  /* Read in some data */
    if (! (*mode & NOSEEK) ) {
      seekret = lseek(*fdes, *start, SEEK_SET);
      if (seekret == -1) {
        #ifdef VERBOSE
          printf("error in seeking to %d\n",*start);
        #endif
        return 250;
      }
      #ifdef VERBOSE
      else {
         printf("Seek successful, seek ret %d, start %d\n", seekret, *start);
      }
      #endif
    }
    jret = read(*fdes, datary, *no*(*size) );
    if (jret != *no*(*size) ) {
      #ifdef VERBOSE
        printf("did not read in the requested number of items\n");
        printf("read in %d items of %d \n",jret/(*size), *no);
      #endif
      *nactual = jret/(*size);
      *newpos = *start + jret;
    }  
    #ifdef VERBOSE
      printf("read in %d items \n", jret/(*size));
    #endif
    *nactual = jret/(*size);
    *newpos = *start + jret;
  }
/* Done with reading */
 
/* See if we should be writing */
  if ( BAWRITE & *mode && BAOPEN_RONLY & *mode ) {
    #ifdef VERBOSE
      printf("Trying to write on a read only file \n");
    #endif
     return 249;
  }
  else if ( BAWRITE & *mode ) {
    if (! (*mode & NOSEEK) ) {
      seekret = lseek(*fdes, *start, SEEK_SET);
      if (seekret == -1) {
      #ifdef VERBOSE
        printf("error in seeking to %d\n",*start);
      #endif
        return 248;
      }
      #ifdef VERBOSE
      else {
        printf("Seek successful, seek ret %d, start %d\n", seekret, *start);
      }
      #endif
    }
    jret = write(*fdes, datary, *no*(*size));
    if (jret != *no*(*size)) {
    #ifdef VERBOSE
      printf("did not write out the requested number of items\n");
      printf("wrote %d items instead\n", jret/(*size) );
    #endif
      *nactual = jret/(*size) ;
      *newpos = *start + jret;
    }
    else {
    #ifdef VERBOSE
       printf("wrote %d items \n", jret/(*size) );
    #endif
       *nactual = jret/(*size) ;
       *newpos = *start + jret;
    }
  }
/* Done with writing */
    

/* Close file if requested */
  if (BACLOSE & *mode ) {
    jret = close(*fdes);
    if (jret != 0) { 
    #ifdef VERBOSE
      printf("close failed! jret = %d\n",jret);
    #endif
      return 247;
    }
  }
/* Done closing */

/* Free the realname pointer to prevent memory leak */
  if ( (BAOPEN_RONLY & *mode) || (BAOPEN_WONLY & *mode) ||
       (BAOPEN_WONLY_TRUNC & *mode) || (BAOPEN_WONLY_APPEND & *mode) ||
       (BAOPEN_RW & *mode) ) {
    free(realname);
  }

/* Check that if we were reading or writing, that we actually got what */
/*  we expected, else return a -10.  Return 0 (success) if we're here  */
/*  and weren't reading or writing */
  if ( (*mode & BAREAD || *mode & BAWRITE) && (*nactual != *no) ) {
    return 246;
  }
  else {
    return 0;
  }
} 
