/*
 * Copyright (C) 2009-2017 National Technology & Engineering Solutions
 * of Sandia, LLC (NTESS).  Under the terms of Contract DE-NA0003525 with
 * NTESS, the U.S. Government retains certain rights in this software.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are
 * met:
 *
 *     * Redistributions of source code must retain the above copyright
 *       notice, this list of conditions and the following disclaimer.
 *
 *     * Redistributions in binary form must reproduce the above
 *       copyright notice, this list of conditions and the following
 *       disclaimer in the documentation and/or other materials provided
 *       with the distribution.
 *
 *     * Neither the name of NTESS nor the names of its
 *       contributors may be used to endorse or promote products derived
 *       from this software without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *
 */
/* ifdef.h - ifdef file for cdr routines
 * This file is used to define the system dependent ways C is
 * called from FORTRAN.  Underscores are used by default.
 *
 * SUN DEC/ULTRIX ALLIANT : C routines must have underscores
 * SGI CONVEX             : C routines must have underscores
 *
 * VAX HP IBM/aix         : C routines do not have underscores
 *
 * CRAY/UNICOS            : C routines must be capitalized,
 *                            and no underscores
 *
 * This include file is used by all cdr routines
 */

#include <stdlib.h>
#include <unistd.h>

#if defined(ADDC_)
#endif
#if !defined(CRAY) && !defined(ADDC_) && !defined(COUGAR)
#define cdrcom_ cdrcom
#define cdrcm2_ cdrcm2
#define cdrunx_ cdrunx
#define vcjob_ vcjob
#define vconod_ vconod
#define cdr1ch_ cdr1ch
#define cdr1pk_ cdr1pk
#define cdr2cm_ cdr2cm
#define cdra2c_ cdra2c
#define cdrbit_ cdrbit
#define cdrbtr_ cdrbtr
#define cdrc2a_ cdrc2a
#define cdrc2h_ cdrc2h
#define cdrcfs_ cdrcfs
#define cdrcvt_ cdrcvt
#define cdrela_ cdrela
#define cdrgnm_ cdrgnm
#define cdri2c_ cdri2c
#define cdrinp_ cdrinp
#define cdrjob_ cdrjob
#define cdrlwr_ cdrlwr
#define cdrmon_ cdrmon
#define cdroab_ cdroab
#define cdrof3_ cdrof3
#define cdroff_ cdroff
#define cdrofs_ cdrofs
#define cdrono_ cdrono
#define cdrout_ cdrout
#define cdrpak_ cdrpak
#define cdrrfs_ cdrrfs
#define cdrrvt_ cdrrvt
#define cdrstd_ cdrstd
#define cdrtbk_ cdrtbk
#define cdrtim_ cdrtim
#define cdrtod_ cdrtod
#define cdrupk_ cdrupk
#define cdrupr_ cdrupr
#define cdrwfs_ cdrwfs
#endif
#if defined(CRA)
#define cdrcom_ CDRCOM
#define cdrcm2_ CDRCM2
#define cdrunx_ CDRUNX
#define vcjob_ VCJOB
#define vconod_ VCONOD
#define cdr1ch_ CDR1CH
#define cdr1pk_ CDR1PK
#define cdr2cm_ CDR2CM
#define cdra2c_ CDRA2C
#define cdrbit_ CDRBIT
#define cdrbtr_ CDRBTR
#define cdrc2a_ CDRC2A
#define cdrc2h_ CDRC2H
#define cdrcfs_ CDRCFS
#define cdrcvt_ CDRCVT
#define cdrela_ CDRELA
#define cdrgnm_ CDRGNM
#define cdri2c_ CDRI2C
#define cdrinp_ CDRINP
#define cdrjob_ CDRJOB
#define cdrlwr_ CDRLWR
#define cdrmon_ CDRMON
#define cdroab_ CDROAB
#define cdrof3_ CDROF3
#define cdroff_ CDROFF
#define cdrofs_ CDROFS
#define cdrono_ CDRONO
#define cdrout_ CDROUT
#define cdrpak_ CDRPAK
#define cdrrfs_ CDRRFS
#define cdrrvt_ CDRRVT
#define cdrstd_ CDRSTD
#define cdrtbk_ CDRTBK
#define cdrtim_ CDRTIM
#define cdrtod_ CDRTOD
#define cdrupk_ CDRUPK
#define cdrupr_ CDRUPR
#define cdrwfs_ CDRWFS
#endif
/* end ifdef.h */

/* Structures used to communicate with FORTRAN common blocks.
 * On all systems, except CRAY/UNICOS, structures must be declared
 * external.  On UNICOS, the structures are not external.
 */
#if defined(CRA)

/* cdrcm2_u.h */
struct cdr2
{
  char KGNAME[80];
} cdrcm2_;

/* cdrcom.h */
struct cdr
{
  int KWRTFL;
  int KRDFL;
  int KOUTFL;
  int KINFL;
  int KWRDSZ;
  int KBYTEL;
  int KCPW;
  int KBAUD;
  int KCOMTP;
} cdrcom_;

/* cdrunx.h */
struct unx
{
  int KUNTFD[1000];
} cdrunx_;

/* vcjob.h */
struct job
{
  int KIDSIZ;
  int KJOBID[4];
  int KUSRSZ;
  int KUSRID[4];
  int KSZROU;
  int KJROUT[4];
  int KSECUR;
  int KJTIME[4];
  int KJDATE[4];
  int MACHIN[3];
  int MACLEN;
} vcjob_;

/* for now, hard code this stuff in: */
#if defined(SECURITY_CODE)
#undef SECURITY_CODE
#endif
#define SECURITY_CODE 0

#if defined(CDR_MACHINE)
#undef CDR_MACHINE
#endif
#define CDR_MACHINE "UNICOS"

#if defined(ROUTE)
#undef ROUTE
#endif
#define ROUTE "BX 603"

/* vconod.h */
struct onode
{
  int ONODE;
} vconod_;

#else

/* cdrcm2.h  */
extern struct cdr2
{
  char KGNAME[80];
} cdrcm2_;

/* cdrcom.h */
extern struct cdr
{
  int KWRTFL;
  int KRDFL;
  int KOUTFL;
  int KINFL;
  int KWRDSZ;
  int KBYTEL;
  int KCPW;
  int KBAUD;
  int KCOMTP;
} cdrcom_;

/* cdrunx.h */
extern struct unx
{
  int KUNTFD[1000];
} cdrunx_;

/* vcjob.h */
extern struct job
{
  int KIDSIZ;
  int KJOBID[4];
  int KUSRSZ;
  int KUSRID[4];
  int KSZROU;
  int KJROUT[4];
  int KSECUR;
  int KJTIME[3];
  int KJDATE[3];
  int MACHIN[3];
  int MACLEN;
} vcjob_;

/* for now, hard code this stuff in: */
#if defined(SECURITY_CODE)
#undef SECURITY_CODE
#endif
#define SECURITY_CODE 0

#if defined(CDR_MACHINE)
#undef CDR_MACHINE
#endif
#define CDR_MACHINE "UNIX"

#if defined(ROUTE)
#undef ROUTE
#endif
#define ROUTE "BX 603"

/* vconod.h */
extern struct onode
{
  int ONODE;
} vconod_;

#endif

/* System includes */
#include <ctype.h>
#if !defined(__CYGWIN__)
#include <pwd.h>
#endif
#include <signal.h>
#include <stdio.h>
#include <string.h>

#if defined(CRA)
#include <fcntl.h>
#include <sys/types.h>
#endif
#include <sys/file.h>

#if defined(CRA) || defined(interix) || defined(linux)
#include <time.h>
#else
#include <sys/time.h>
#endif
#if defined(sun) && (defined(SYSV) || defined(SVR4))
#include <fcntl.h>
#include <sys/stat.h>
#include <sys/types.h>
#endif

/*  *** CDR1CH ***

  Copy the Nth KBYTEL-width character of STRING to the
  lowest order character field of NUCHAR.

  Parameters:
    n - IN - character position, counted from the left, of
             the character to be extracted from STRING
    string - IN - word from which to copy the character
    nuchar - OUT - word in which to place the character

*/

void      cdr1ch_(n, string, nuchar) int *n;
unsigned *string, *nuchar;
{
  if (*n > cdrcom_.KCPW) {
    return;
  }
  *nuchar = (*string >> (cdrcom_.KWRDSZ - *n * cdrcom_.KBYTEL) & ~(~0 << cdrcom_.KBYTEL));
}

/*  *** CDR1PK ***

  Copy the KBYTEL-width character of INCHAR (right-justified) to
  the Nth KBYTEL-width character position of BUFFER.

  Parameters:
    n - IN - character position, counted from the left, at which
             the KBYTEL-width character is copied
    inchar - IN - word containing one KBYTEL-width character, right
                  adjusted, zero-filled
    buffer - OUT - word into which the character is copied.

*/

void      cdr1pk_(n, inchar, buffer) int *n;
unsigned *inchar, *buffer;
{
  int      i;
  unsigned temp, mask;

  if (*n > cdrcom_.KCPW) {
    return;
  }
  temp    = *inchar << (i = cdrcom_.KWRDSZ - (*n * cdrcom_.KBYTEL));
  mask    = ~(~0 << cdrcom_.KBYTEL) << i;
  *buffer = ((mask & temp) | (~mask & *buffer));
}
/*  *** CDR2CM ***

  Bitwise complement, used for 2's complement.

  Parameters:
    in - IN - integer to complement
    iout - OUT - complemented integer

*/

void cdr2cm_(in, iout) int *in, *iout;
{
  *iout = ~(*in) + 1;
}

/*  *** CDRPAK ***

  Pack the IWIDTH lower order bits from NEXT into IBUF, starting at
  bit position IBUF(IWORD) + IBITLC.  Bits are counted left to right.
  IWORD and IBITLC are updated to reflect the new position in IBUF.

  Parameters:
    next - IN - word containing bits to pack into ibuf
    iwidth - IN - number of bits to get from NEXT
    iword  - IN/OUT -word in buffer to put the bits
    ibitlc - IN/OUT -number of bits currently used in IBUF(IWORD)
    ibuf - OUT - the array in which to put the bits

*/

void      cdrpak_(next, iwidth, iword, ibitlc, ibuf) int *iwidth, *iword, *ibitlc;
unsigned *next, ibuf[];
{
  int      idx, i;
  unsigned temp, mask;

  /* check boundaries */
  if (*iwidth > cdrcom_.KWRDSZ) {
    return;
  }

  /* if bitlc is bigger than the word size, increment */
  if (*ibitlc >= cdrcom_.KWRDSZ) {
    *ibitlc = 0;
    (*iword)++;
  }

  /* "C" start arrays at 0 */
  idx = *iword - 1;

  if (*ibitlc + *iwidth > cdrcom_.KWRDSZ) {

    /* word overflow - break into parts */

    temp      = *next >> (i = *iwidth + *ibitlc - cdrcom_.KWRDSZ);
    mask      = ~0 << (cdrcom_.KWRDSZ - *ibitlc);
    ibuf[idx] = ((~mask & temp) | (mask & ibuf[idx]));
    *ibitlc   = i;
    (*iword)++;
    idx++;
    temp      = *next << (i = cdrcom_.KWRDSZ - *ibitlc);
    mask      = ~0 << i;
    ibuf[idx] = ((mask & temp) | (~mask & ibuf[idx]));
  }
  else {

    /* it fits all in one word */

    temp      = *next << (i = cdrcom_.KWRDSZ - *ibitlc - *iwidth);
    mask      = ~(~0 << *iwidth) << i;
    ibuf[idx] = ((mask & temp) | (~mask & ibuf[idx]));
    *ibitlc += *iwidth;
  }
}

/*  *** CDRA2C ***

  Convert from ascii to character

  Parameters:
    asci - IN - integer representing an ascii character
    charac - OUT - the character represented by asci

*/

void  cdra2c_(asci, charac) int *asci;
char *charac;
{
  charac[0] = (char)*asci;
}
/*  *** CDRBIT ***

  This is a dummy routine to satisfy externals. See CDRPAK

  Parameters:
    next - IN -
    iwidth - IN -
    iword - IN/OUT -
    ibitlc - IN/OUT -
    ibuf - OUT -

*/

void      cdrbit_(next, iwidth, iword, ibitlc, ibuf) int *iwidth, *iword, *ibitlc;
unsigned *next, ibuf[];
{
  cdrpak_(next, iwidth, iword, ibitlc, ibuf);
}

/*  *** CDRUPK ***

  Copy IWIDTH bits from IBUF,starting at bit position IBUF(IWORD) +
  IBITLC, into low order of NEXT.  Bits are counted left to right.
  IWORD and IBITLC are updated to reflect the new position in IBUF.

  Parameters:
    ibuf - IN - the array containing the bits to copy into next
    iword  - IN/OUT - word in buffer from which to get the bits
    ibitlc - IN/OUT - number of bits already retrieved from IBUF(IWORD)
    iwidth - IN - number of bits to get from IBUF
    next - OUT - word to put the bits in, right justified, zero filled

*/

void     cdrupk_(ibuf, iword, ibitlc, iwidth, next) int *iword, *ibitlc, *iwidth;
unsigned ibuf[], *next;
{
  int      idx, i;
  unsigned temp, mask;
#if defined(DEC) || defined(linux) || defined(interix)
  unsigned char *p_temp, ctemp;
#endif
  /* check boundaries */
  if (*iwidth > cdrcom_.KWRDSZ) {
    return;
  }

  /* if ibitlc is bigger than word size, increment */
  if (*ibitlc >= cdrcom_.KWRDSZ) {
    *ibitlc = 0;
    (*iword)++;
  }

  /* "C" arrays start at 0 */
  idx = *iword - 1;

  if (*ibitlc + *iwidth > cdrcom_.KWRDSZ) {

    /* crosses word boundary - break it up */

    temp = ibuf[idx];
#if defined(DEC) || defined(linux) || defined(interix)
    /* swap byte order around */
    p_temp        = (unsigned char *)(&temp);
    ctemp         = *p_temp;
    *p_temp       = *(p_temp + 3);
    *(p_temp + 3) = ctemp;
    ctemp         = *(p_temp + 1);
    *(p_temp + 1) = *(p_temp + 2);
    *(p_temp + 2) = ctemp;
#endif
    temp    = temp << (i = *iwidth + *ibitlc - cdrcom_.KWRDSZ);
    mask    = ~(~0 << (cdrcom_.KWRDSZ - *ibitlc)) << i;
    *next   = (mask & temp);
    *ibitlc = i;
    (*iword)++;
    idx++;
    temp = ibuf[idx];
#if defined(DEC) || defined(linux) || defined(interix)
    /* swap byte order around */
    p_temp        = (unsigned char *)(&temp);
    ctemp         = *p_temp;
    *p_temp       = *(p_temp + 3);
    *(p_temp + 3) = ctemp;
    ctemp         = *(p_temp + 1);
    *(p_temp + 1) = *(p_temp + 2);
    *(p_temp + 2) = ctemp;
#endif
    temp  = temp >> (cdrcom_.KWRDSZ - *ibitlc);
    mask  = ~(~0 << *ibitlc);
    *next = ((mask & temp) | *next);
  }
  else {

    /* doesn't cross word boundary */

    temp = ibuf[idx];
#if defined(DEC) || defined(linux) || defined(interix)
    /* swap byte order around */
    p_temp        = (unsigned char *)(&temp);
    ctemp         = *p_temp;
    *p_temp       = *(p_temp + 3);
    *(p_temp + 3) = ctemp;
    ctemp         = *(p_temp + 1);
    *(p_temp + 1) = *(p_temp + 2);
    *(p_temp + 2) = ctemp;
#endif
    temp  = temp >> (cdrcom_.KWRDSZ - *ibitlc - *iwidth);
    mask  = ~(~0 << *iwidth);
    *next = mask & temp;
    *ibitlc += *iwidth;
  }
}

/*  *** CDRBTR ***

  This is a dummy routine to satisfy externals. See CDRUPK

  Parameters:
    ibuf - IN -
    iword - IN/OUT -
    ibitlc - IN/OUT -
    iwidth - IN -
    next - OUT -

*/

void     cdrbtr_(ibuf, iword, ibitlc, iwidth, next) int *iword, *ibitlc, *iwidth;
unsigned ibuf[], *next;
{
  cdrupk_(ibuf, iword, ibitlc, iwidth, next);
}
/*  *** CDRC2A ***

  Convert from character to ASCII

  Parameters:
    charac - IN - the character represented by asci
    asci - OUT - integer representing an ASCII character

*/

void cdrc2a_(charac, asci) char *charac;
int *asci;
{
  *asci = (int)charac[0];
}

/*  *** CDRC2H ***

  Convert character to hollerith. TITLE will contain at least
  LENGTH characters, and ITITLE will be dimensioned one larger
  in order to append the zero word that is required by Hollerith
  rules.

  Notes and Revisions:
    This routine just copies the input to the output and appends a
    zero word, the C/FORTRAN parameter passsing handles the rest.

  Parameters:
    title - IN - character string of any length
    length - IN - length of title
    ititle - OUT - hollerith equivalent of title

*/

void cdrc2h_(title, length, ititle) unsigned *title, *ititle;
int *length;
{
  int i, ilen;

  ilen = *length / cdrcom_.KCPW;
  for (i = 0; i < ilen; i++) {
    ititle[i] = title[i];
  }
  ititle[ilen + 1] = 0;
}

/*  *** CDRCFS ***

  Close file sequential.

  Notes and Revisions:
    This routine uses the array KUNTFD, in the FORTRAN common and
    the C external structure, cdrunx, to translate from FORTRAN
    unit number to UNIX/C file descriptors.

  Parameters:
    ifilcd - IN - FORTRAN unit number of the sequential file to close
    eof - IN - end-of-file request flag. If eof=1, an end of file
               marker is written on the end of the file.

*/

void cdrcfs_(ifilcd, eof) int *ifilcd, *eof;
{
  int  fd, istat;
  char buf[4];

  /* translate fortran unit number to file descriptor */
  fd = cdrunx_.KUNTFD[*ifilcd];

  /* if eof = 1 then write eof on file */
  if (*eof == 1) {
    *buf = EOF;
    if ((istat = write(fd, buf, 4)) == -1) {
      perror("CDRCFS error:");
    }
  }

  /* close the file */
  close(fd);
}
/*  *** CDRCVT ***

  Convert from internal character set to ASCII character set.

  Notes and Revisions:
    This routine is here to satisfy the call, since the internal
    character set is ASCII.

  Parameters:
    in - IN - character to be converted, in host internal format
    iout - OUT - character converted to ASCII

*/

void cdrcvt_(in, iout) int *in, *iout;
{
  *iout = *in;
}
/*  *** CDRELA ***

  Collect CPU time.  This is a dummy routine to satisfy calls from
  VDMONI. Monitoring isn't done on this system

  Parameters:
    icode - IN - 0 = initialize timer, 1 = save timer

*/
void cdrela_(icode) int *icode;
{
}

/*  *** CDRGNM ***

  Name graphics output file or the post processor input file

  Notes and Revisions:
    This routine is called by VDGNAM (if the user called VDGNAM),
    and VBPKG.  Whoever gets here first, wins.

  Parameters:
    gname - IN - file name to call graphics output file
    glen - IN - length of file name
*/

void cdrgnm_(gname, glen) char gname[];
int *glen;
{
  int  i;
  char blank  = ' ';
  char bslash = '\\';

  /* make sure name hasn't already been set */
  if (cdrcm2_.KGNAME[0] != blank) {
    return;
  }

  /* store it in the external (and common) variables */
  for (i = 0; i < *glen; i++) {
    cdrcm2_.KGNAME[i] = gname[i];
  }

  /* append a backslash and an endofstring character */
  cdrcm2_.KGNAME[*glen]     = bslash;
  cdrcm2_.KGNAME[*glen + 1] = '\0';
}

/*  *** CDRI2C ***

  Convert positive integer to decimal character string equivalent

  Parameters:
    intp - IN - positive integer to be converted
    ndigit - IN - number of digits to be produced in string form
                 (pad left with zeros)
    string - OUT - character string of at least ndigit characters

*/

void cdri2c_(intp, ndigit, string) int *intp, *ndigit;
char string[];
{
  int i, inbr;

  inbr = *intp;

  for (i = (*ndigit - 1); i >= 0; i--) {
    string[i] = inbr % 10 + '0';
    inbr      = inbr / 10;
  }
}
#define CDR_MAXLEN 512

/*  *** CDRINP ***

  Send the prompt, IPROMPT, to the terminal, and read ICOUNT
  characters from the terminal into buffer IBUFFER.

  Parameters:
    icount - IN - number of characters to be accepted from the
                  terminal
    ibuffer - OUT - buffer into which the characters are read
    iprompt - iN - prompt sequence to output to the terminal

*/

void cdrinp_(icount, ibuffer, iprompt) int *icount;
int *ibuffer, *iprompt;
{
  char prompt[CDR_MAXLEN], buffer[CDR_MAXLEN];
  int  i, icnt, istat, actcnt = 0;

  /* check the input */
  icnt = *icount;
  if (*icount > CDR_MAXLEN) {
    icnt = CDR_MAXLEN;
  }

  /* if prompt count is greater than 0, output the prompt */
  if (iprompt[0] > 0) {
    for (i = 1; i <= iprompt[0]; i++) {
      prompt[i - 1] = (char)iprompt[i];
    }

    if ((istat = write(1, prompt, iprompt[0])) == -1) {
      perror("CDRINP error:");
    }
  }

  /* read from the terminal */
  if ((istat = read(1, buffer, icnt)) == -1) {
    perror("CDRINP error:");
  }
  else {
    /* strip off newline if there is one */
    if (buffer[istat - 1] == '\n') {
      actcnt = istat - 1;
    }
    else {
      actcnt = istat;
    }
  }

  /* load user's buffer  */
  for (i = 0; i < actcnt; i++) {
    ibuffer[i] = (int)buffer[i];
  }

  /* zero fill left over buffer space */
  if (actcnt < icnt) {
    for (i = actcnt; i < icnt; i++) {
      ibuffer[i] = 0;
    }

    /* if there wasn't a newline, flush input */
    if (buffer[istat - 1] != '\n') {
      istat = read(1, buffer, CDR_MAXLEN);
    }
  }
}

/*  *** CDRJOB ***

Get job information and set the vars in the vcjob common block:
process id -  max 12 chars
length of process id
user name  - max 12 chars
length of user name
routing info - max 12 chars
length of routing
security classification
date  86-12-15
time  12:23:59
machine - max 12 chars
length of machine
*/

void cdrjob_() {}

/*  *** CDRLWR ***

Convert character string to all lower case

Notes and Revisions:
Only converts characters

Parameters:
in - IN - character string to be converted
iout - OUT - character string converted to all lower case
inlen - IN - length of character string in

*/

void cdrlwr_(in, iout, inlen) char in[], iout[];
int *inlen;
{
  int i;

  for (i = 0; i <= *inlen - 1; i++) {
    if (isupper(in[i])) {
      iout[i] = tolower(in[i]);
    }
    else {
      iout[i] = in[i];
    }
  }
}
/*  *** CDRMON ***

Write out monitoring information.  This is a dummy routine to
satisfy calls from VDMONI. Monitoring isn't done on this system.

Parameters:
mdev - IN -
mpkg - IN -
mpage - IN -

*/

void cdrmon_(mdev, mpkg, mpages) int *mdev, *mpkg, *mpages;
{
}

/*  *** CDROFS ***

Open a file for sequential access.

Notes and Revisions:
This routine uses the array KUNTFD, in the FORTRAN common and
the C external structure, cdrunx, to translate from FORTRAN
unit number to UNIX/C file descriptors.


Parameters:
ifilcd - IN - the FORTRAN unit number of the file to open

*/

void cdrofs_(ifilcd) int *ifilcd;
{
  int   fd;
  int   errnum, errsev;
  char  symbol[1024];
  char  err[50];
  char *env;

  int  i      = 0;
  int  j      = 0;
  char blank  = ' ';
  char bslash = '\\';

  /* check for graphics output file. file name is stored in KGNAME
     from external (common) cdrcm2. if file hasn't been named, or
     unit isn't KOUTFL, default to file{unit}          */

  if (*ifilcd == cdrcom_.KOUTFL && cdrcm2_.KGNAME[0] != blank) {
    while (cdrcm2_.KGNAME[i] != bslash) {
      symbol[i++] = cdrcm2_.KGNAME[j++];
    }
    symbol[i] = '\0';
  }
  else {
    sprintf(symbol, "file%d", *ifilcd);
  }

  /* check the environment to see if a file name has been assigned */
  env = getenv(symbol);
  if (env != 0 && strlen(env) < 1024) {
    sprintf(symbol, "%s", env);
  }

  /* open the file  - if it doesn't exist, create it with mode 664 */
  if ((fd = open(symbol, (O_CREAT | O_RDWR), 0664)) == -1) {
    errnum = 722;
    errsev = 10;
    sprintf(err, "SVDI ERROR NUMBER %d SEVERITY CODE %d", errnum, errsev);
    perror(err);
  }
  else {

    /* associate fortran unit number with file descriptor */
    cdrunx_.KUNTFD[*ifilcd] = fd;
  }
}

/*  *** CDROAB ***

Open file for the Abekas

*/

void cdroab_(ifilcd, frame) int *ifilcd;
int *frame;
{
  char ic[5];
  int  len;

  /* can't call cdrgnm, because it only lets you name
     the file once, so set the name in the common block */

  len = 4;
  cdri2c_(frame, &len, ic);
  ic[len] = '\0';
  sprintf(cdrcm2_.KGNAME, "%s.RGB", ic);

  cdrofs_(ifilcd);
}
/*  *** CDROF3 ***

Open a file for sequential access, fixed length, formatted

Notes and Revisions:
C file structures don't have the concept of record structure.
This routine calls CDROFS

Parameters:
ifilcd - IN - the FORTRAN unit number of the file to open
idum - IN - originally used for record length

*/

void cdrof3_(ifilcd, idum) int *ifilcd;
int *idum;
{
  cdrofs_(ifilcd);
}
/*  *** CDROFF ***

Open a file for sequential access, fixed length, formatted

Notes and Revisions:
C file structures don't have the concept of record structure.
This routine calls CDROFS

Parameters:
ifilcd - IN - the FORTRAN unit number of the file to open

*/

void cdroff_(ifilcd) int *ifilcd;
{
  cdrofs_(ifilcd);
}

/*  *** CDRONO ***

Set flag to designate this file is going to the output node

Parameters:
setono - IN - logical value

*/

void cdrono_(setono) int *setono;
{
  vconod_.ONODE = *setono;
}
#define MAXBUFFER 512

/*  *** CDROUT ***

Transmit ICOUNT words from BUFFER to the terminal

Parameters:
ICOUNT - IN - number of characters to be sent to the terminal
BUFFER - IN - integer array containing the characters

*/

void cdrout_(icount, buffer) int *icount;
int *buffer;
{
  int  i, istat;
  int  j = 0;
  int  c_count, count;
  char c_buffer[MAXBUFFER];

  count = *icount;

  while (count > 0) {
    c_count = (count > MAXBUFFER) ? MAXBUFFER : count;
    count   = count - c_count;

    for (i = 0; i < c_count; i++) {
      c_buffer[i] = (char)buffer[j++];
    }

    /* write to standard output */
    if ((istat = write(1, c_buffer, c_count)) == -1) {
      perror("CDROUT error");
    }
  }
}

/*  *** CDRRFS ***

Try to read LENGTH words from the file.  Return the actual number
of words read.

Notes and Revisions:
This routine uses the array KUNTFD, in the FORTRAN common and
the C external structure, cdrunx, to translate from FORTRAN
unit number to UNIX/C file descriptors.
read() will not read beyond EOF. read() returns the actual
number of bytes read, or -1 for fail.

Parameters:
ifilcd - IN - FORTRAN unit number of file to read
length - IN - number of words to try to read
buffer - OUT - array of size LENGTH into which the data is read
istat - OUT - status indicator: 0 = end of file;
>0 = actual number of words read;
<0 = error

*/

void  cdrrfs_(ifilcd, length, buffer, istat) int *ifilcd, *length, *istat;
char *buffer;
{
  int fd;

  /* translate fortran unit number to file descriptor */
  fd = cdrunx_.KUNTFD[*ifilcd];

  /* if the file hasn't been opened, open it */
  if (fd == 0) {
    cdrofs_(ifilcd);
    fd = cdrunx_.KUNTFD[*ifilcd];
  }

  /* read the data as a byte stream */
  if ((*istat = read(fd, buffer, (*length * cdrcom_.KCPW))) != -1) {
    *istat = *istat / cdrcom_.KCPW;
  }
}
/*  *** CDRRVT ***

Convert from ASCII character set to internal character set.

Notes and Revisions:
This routine is here to satisfy the call, since the internal
character set is ASCII.

Parameters:
in - IN - character to be converted in ASCII
iout - OUT - character converted to internal format

*/

void cdrrvt_(in, iout) int *in, *iout;
{
  *in = *iout;
}

/*  *** CDRSTD ***

Copy the left-most N characters from the input character string
to the output word.

Parameters:
n - IN - number of characters to copy from string
string - IN - input character string
nuchar - OUT - word in which to put the n characters

*/

void      cdrstd_(n, string, nuchar) int *n;
unsigned *string, *nuchar;
{
  if (*n > cdrcom_.KCPW) {
    return;
  }
  *nuchar = (*string >> (cdrcom_.KWRDSZ - *n * cdrcom_.KBYTEL) & ~(~0 << (*n * cdrcom_.KBYTEL)));
}
/*  *** CDRTBK ***
    Generate a traceback.  This is a dummy routine to satisfy
    externals calls.
*/
void cdrtbk_() {}

/*  *** CDRTIM ***
    Pause TIM seconds. (dummy)
*/

void cdrtim_(float *tim) {}

void cdrtod_()
{
  sprintf((char *)vcjob_.KJTIME, "%02d:%02d:%02d\\", 11, 11, 11);
  sprintf((char *)vcjob_.KJDATE, "%02d-%02d-%02d\\", 5, 5, 5);
}

/*  *** CDRUPR ***

Convert character string to all upper case

Parameters:
in - IN - character string to be converted
iout - OUT - character string converted to all upper case
inlen - IN - length of character string in

*/

void cdrupr_(in, iout, inlen) char in[], iout[];
int *inlen;
{
  int i;

  for (i = 0; i <= *inlen; i++) {
    if (islower(in[i])) {
      iout[i] = toupper(in[i]);
    }
  }
}

/*  *** CDRWFS ***

Write LENGTH words from BUFFER to the file.

Parameters:
ifilcd - IN - FORTRAN unit number of file to write
length - IN - number of words to be written
buffer - IN - array containing the words of data to be written
istat - OUT - status indicator. 0 = no error; 1 = error

*/

void  cdrwfs_(ifilcd, length, buffer, istat) int *ifilcd, *length, *istat;
char *buffer;
{
  int fd;

  /* translate fortran unit number to file descriptor */
  fd = cdrunx_.KUNTFD[*ifilcd];

  /* if the file hasn't been opened, open it */
  if (fd == 0) {
    cdrofs_(ifilcd);
    fd = cdrunx_.KUNTFD[*ifilcd];
  }

  /* write out the data as a byte stream. */
  if ((*istat = write(fd, buffer, (*length * cdrcom_.KCPW))) == -1) {
    *istat = 1;
  }
  else {
    *istat = 0;
  }
}
