/*
 * PDFIA.C - FORTRAN interface routines for PDBLib (in PDBX)
 *
 * Source Version: 9.0
 * Software Release #92-0043
 *
 */

#include "cpyright.h"

#include "pdb.h"


#ifndef F77_INT_SIZE_PTR_DIFFER

# define _PD_read_aux(file, name, type, vr, ind)                             \
    ((FIXNUM) PD_read_as_alt(file, name, type, vr, (long *) (ind)))

# define _PD_write_aux(file, name, typi, typo, space, nd, dims)              \
    ((FIXNUM) PD_write_as_alt(file, name, typi, typo, space, nd, (long *) (dims)))

# define _PD_append_aux(file, name, type, space, nd, dims)                   \
    ((FIXNUM) PD_append_as_alt(file, name, type, space, nd, (long *) dims))

# define _PD_defent_aux(file, name, type, nd, dims)                          \
    ((FIXNUM) PD_defent_alt(file, name, type, nd, (long *) dims))

#endif

struct s_file_static
   {char **outlist;
    int n_entries;};

typedef struct s_file_static FILE_STATIC;

#ifdef HAVE_THREADS

#define OUTLIST(x)   _PD_fia_static[x].outlist
#define N_ENTRIES(x) _PD_fia_static[x].n_entries

static FILE_STATIC
 *_PD_fia_static = NULL;

#else

#define OUTLIST(x) outlist
#define N_ENTRIES(x) n_entries

static char **outlist = NULL;
static int n_entries = 0;

#endif

data_standard
 *PD_std_standards[] = {&IEEEA_STD,
                        &IEEEB_STD,
                        &IEEEC_STD,
                        &INTELA_STD,
                        &INTELB_STD,
                        &VAX_STD,
                        &CRAY_STD,
                        &IEEED_STD,
                        &IEEEE_STD,
                        NULL};

data_alignment
 *PD_std_alignments[] = {&M68000_ALIGNMENT,
                         &SPARC_ALIGNMENT,
                         &MIPS_ALIGNMENT,
                         &INTELA_ALIGNMENT,
                         &DEF_ALIGNMENT,

/* place holder for defunct CRAY ALIGNMENT */
                         &UNICOS_ALIGNMENT,

                         &UNICOS_ALIGNMENT,
                         &RS6000_ALIGNMENT,
                         &MIPS64_ALIGNMENT,
                         &ALPHA64_ALIGNMENT,
                         NULL};

static PM_set
 SC_DECLARE(*_PD_build_set, (FIXNUM *si, REAL *sd, char *sname));

/*--------------------------------------------------------------------------*/

#ifdef F77_INT_SIZE_PTR_DIFFER

/*--------------------------------------------------------------------------*/

/* _PD_READ_AUX - read a variable in via _PD_indexed_read_as but map the
 *              - indexing information to the correct type first
 *              - NOTE: this would be symmetric with _PD_WRITE_AUX if
 *              - the read calls required the number of dimensions as the
 *              - write calls do!!!!
 */

static FIXNUM _PD_read_aux(file, name, type, vr, ind)
   PDBfile *file;
   char *name, *type;
   byte *vr;
   FIXNUM *ind;
   {char fullpath[MAXLINE];
    dimdes *pd, *dims;
    syment *ep;
    long *pi;
    FIXNUM i, ne, nd, ret;
    SC_THREAD_ID(_t_index);

    switch (setjmp(_PD_READ_ERR(_t_index)))
       {case ABORT    : return(FALSE);
        case ERR_FREE : return(TRUE);
        default       : memset(PD_ERR(_t_index), 0, MAXLINE);
                        break;};

/* look up the variable name and return FALSE if it is not there */
    ep = _PD_effective_ep(file, name, TRUE, fullpath);
    if (ep == NULL)
       PD_error("ENTRY NOT IN SYMBOL TABLE - _PD_READ_AUX", PD_READ);

    dims = PD_entry_dimensions(ep);
    for (nd = 0, pd = dims; pd != NULL; pd = pd->next, nd++);

    ne = 3*nd;

    pi = FMAKE_N(long, ne, "_PD_READ_AUX:pi");
    for (i = 0; i < ne; i++)
        pi[i] = ind[i];

    ret = _PD_indexed_read_as(file, fullpath, type, vr, nd, pi, ep);

    SFREE(pi);

    return(ret);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_WRITE_AUX - write a variable out via PD_write_as_alt but map the
 *               - indexing information to the correct type first
 */

static FIXNUM _PD_write_aux(file, name, typi, typo, space, nd, dims)
   PDBfile *file;
   char *name, *typi, *typo;
   byte *space;
   FIXNUM nd;
   FIXNUM *dims;
   {long i, ne, *pi;
    FIXNUM ret;

    ne = 3*nd;
    pi = FMAKE_N(long, ne, "_PD_WRITE_AUX:pi");
    for (i = 0; i < ne; i++)
        pi[i] = dims[i];

    ret = PD_write_as_alt(file, name, typi, typo, space, nd, pi);

    SFREE(pi);

    return(ret);}
    
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_APPEND_AUX - append to a variable via PD_append_as_alt but map the
 *                - indexing information to the correct type first
 */

static FIXNUM _PD_append_aux(file, name, type, space, nd, dims)
   PDBfile *file;
   char *name, *type;
   byte *space;
   FIXNUM nd, *dims;
   {long i, ne, *pi;
    FIXNUM ret;

    ne = 3*nd;
    pi = FMAKE_N(long, ne, "_PD_APPEND_AUX:pi");
    for (i = 0; i < ne; i++)
        pi[i] = dims[i];

    ret = PD_append_as_alt(file, name, type, space, nd, pi);

    SFREE(pi);

    return(ret);}
    
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_DEFENT_AUX - define a variable via PD_defent_alt but map the
 *                - indexing information to the correct type first
 */

static FIXNUM _PD_defent_aux(file, name, type, nd, dims)
   PDBfile *file;
   char *name, *type;
   FIXNUM nd, *dims;
   {long i, ne, *pi;
    syment *ep;

    ne = 3*nd;
    pi = FMAKE_N(long, ne, "_PD_DEFENT_AUX:pi");
    for (i = 0; i < ne; i++)
        pi[i] = dims[i];

    ep = PD_defent_alt(file, name, type, nd, pi);

    SFREE(pi);

    return(ep != NULL);}
    
/*--------------------------------------------------------------------------*/

#endif

/*--------------------------------------------------------------------------*/

/* PFGERR - FORTRAN interface routine to fetch PD_ERR */

FIXNUM F77_ID(pfgerr_, pfgerr, PFGERR)(nchr, err)
   FIXNUM *nchr;
   F77_string err;
   {SC_THREAD_ID(_t_index);

    strncpy(SC_F77_C_STRING(err), PD_ERR(_t_index), MAXLINE);
    *nchr = strlen(PD_ERR(_t_index));

    return((FIXNUM) TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFGFNM - FORTRAN interface routine to fetch the name of the file */

FIXNUM F77_ID(pfgfnm_, pfgfnm, PFGFNM)(fileid, pnc, name)
   FIXNUM *fileid, *pnc;
   F77_string name;
   {PDBfile *file;
    int nc, lc;
    SC_THREAD_ID(_t_index);

    nc = *pnc;

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);
    lc   = strlen(file->name);
    *pnc = lc;

    if (nc >= lc)
       {strncpy(SC_F77_C_STRING(name), file->name, nc);
        return((FIXNUM) TRUE);}
    else
       {sprintf(PD_ERR(_t_index), "ERROR: BUFFER TOO SMALL TO HOLD FILE NAME - PFGFNM\n");
        return((FIXNUM) FALSE);};}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFGTPT - FORTRAN interface routine to fetch file->track_pointers */

FIXNUM F77_ID(pfgtpt_, pfgtpt, PFGTPT)(fileid, v)
   FIXNUM *fileid, *v;
   {PDBfile *file;
    SC_THREAD_ID(_t_index);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    return((FIXNUM) file->track_pointers);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFSTPT - FORTRAN interface routine to set file->track_pointers */

FIXNUM F77_ID(pfstpt_, pfstpt, PFSTPT)(fileid, v)
   FIXNUM *fileid, *v;
   {PDBfile *file;
    SC_THREAD_ID(_t_index);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);
    file->track_pointers = (int) *v;

    return(*v);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFGBFS - FORTRAN interface routine to fetch PD_buffer_size */

FIXNUM F77_ID(pfgbfs_, pfgbfs, PFGBFS)()
   {SC_THREAD_ID(_t_index);

    return((FIXNUM) PD_BUFFER_SIZE(_t_index));}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFSBFS - FORTRAN interface routine to set PD_buffer_size */

FIXNUM F77_ID(pfsbfs_, pfsbfs, PFSBFS)(v)
   FIXNUM *v;
   {SC_THREAD_ID(_t_index);

    return((FIXNUM) (PD_BUFFER_SIZE(_t_index) = *v));}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFGOFF - FORTRAN interface routine to fetch
 *        - file's default_offset
 */

FIXNUM F77_ID(pfgoff_, pfgoff, PFGOFF)(fileid)
   FIXNUM *fileid;
   {PDBfile *file;
    SC_THREAD_ID(_t_index);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);
    return((FIXNUM) (file->default_offset));}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFSOFF - FORTRAN interface routine to set
 *        - file's default_offset
 */

FIXNUM F77_ID(pfsoff_, pfsoff, PFSOFF)(fileid, v)
   FIXNUM *fileid, *v;
   {PDBfile *file;
    SC_THREAD_ID(_t_index);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);
    return((FIXNUM) (file->default_offset = *v));}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFGMXS - FORTRAN interface routine to fetch
 *        - file's maximum size
 */

FIXNUM F77_ID(pfgmxs_, pfgmxs, PFGMXS)(fileid)
   FIXNUM *fileid;
   {PDBfile *file;
    SC_THREAD_ID(_t_index);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);
    return((FIXNUM) (file->maximum_size));}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFSMXS - FORTRAN interface routine to set
 *        - file's maximum size
 */

FIXNUM F77_ID(pfsmxs_, pfsmxs, PFSMXS)(fileid, v)
   FIXNUM *fileid, *v;
   {PDBfile *file;
    SC_THREAD_ID(_t_index);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);
    return((FIXNUM) (file->maximum_size = *v));}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFGMOD - FORTRAN interface routine to fetch
 *        - file's mode
 */

FIXNUM F77_ID(pfgmod_, pfgmod, PFGMOD)(fileid)
   FIXNUM *fileid;
   {PDBfile *file;
    SC_THREAD_ID(_t_index);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);
    return((FIXNUM) (file->mode));}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFINTH - FORTRAN interface routine to initialize pdblib for threads
 * 
 */

FIXNUM F77_ID(pfinth_, pfinth, PFINTH)(pnthreads, tid)
   FIXNUM *pnthreads;
   PFVoid tid;
   {
#ifdef HAVE_THREADS
    PD_init_threads(*pnthreads, tid);
#endif
    return(TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFVART - FORTRAN interface routine to set up a list of file variables
 *        - sorted in the specified order
 *        - returns 1 if successful and 0 otherwise
 */

FIXNUM F77_ID(pfvart_, pfvart, PFVART)(fileid, pord, n)
   FIXNUM *fileid, *pord, *n;
   {PDBfile *file;
    PFInt fun;
    int entries;
    SC_THREAD_ID(_t_index);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    switch (*pord)
       {case PF_ALPHABETIC : fun = NULL;
                             break;
        case PF_DISK_ORDER : fun = _PD_disk_addr_sort;
                             break;
        default            : sprintf(PD_ERR(_t_index), "ERROR: BAD ORDER ARGUMENT - PFVART\n");
                             return(FALSE);};

    entries = SC_set_hash_dump(file->symtab, fun);

    if (entries == -1)
       {sprintf(PD_ERR(_t_index), "ERROR: HASH DUMP FAILED - PFVART\n");
        return(FALSE);}
    else
       {*n = entries;
        return(TRUE);};}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFDVAR - FORTRAN interface routine to delete internal table set up by a
 *        - call to PFVART.
 */

FIXNUM F77_ID(pfdvar_, pfdvar, PFDVAR)()
   {SC_free_hash_dump();
    return(TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFGVAR - get name of the nth variable in the internal sorted table set up
 *        - by a call to PFVART. return 1 if successful and 0 otherwise.
 */

FIXNUM F77_ID(pfgvar_, pfgvar, PFGVAR)(pn, pnchr, pname)
   FIXNUM *pn, *pnchr;
   F77_string pname;
   {char *s;
    int n;
    SC_THREAD_ID(_t_index);

    n = *pn - 1;
    s = SC_get_entry(n);
    if (s == NULL)
       {sprintf(PD_ERR(_t_index), "ERROR: VARIABLE ORDINAL OUT OF RANGE - PFGVAR\n");
       return(FALSE);}
    else
       {strcpy(SC_F77_C_STRING(pname), s);
        *pnchr = strlen(s);
        return(TRUE);};}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFIVAR - inquire about a variable in a PDBfile
 *        - this probably won't do everything but it will do some of the
 *        - useful stuff
 *        - return TRUE iff successful
 */

FIXNUM F77_ID(pfivar_, pfivar, PFIVAR)(fileid, pnchr, name, pntyp, type,
                                       psize, pndims, dims)
   FIXNUM *fileid, *pnchr;
   F77_string name;
   FIXNUM *pntyp;
   F77_string type;
   FIXNUM *psize, *pndims, *dims;
   {PDBfile *file;
    char s[MAXLINE], *ltype;
    FIXNUM nd;
    syment *ep;
    dimdes *pd;
    SC_THREAD_ID(_t_index);

    SC_FORTRAN_STR_C(s, name, *pnchr);

    ltype = SC_F77_C_STRING(type);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    ep = _PD_effective_ep(file, s, TRUE, NULL);
    if (ep == NULL)
       {sprintf(PD_ERR(_t_index), "ERROR: VARIABLE %s NOT FOUND - PFIVAR\n", s);
        return(FALSE);};

    strcpy(ltype, PD_entry_type(ep));
    *pntyp = strlen(ltype);
    *psize = PD_entry_number(ep);

    for (nd = (FIXNUM) 0, pd = PD_entry_dimensions(ep);
         pd != NULL;
         pd = pd->next)
        {dims[nd++] = pd->index_min;
         dims[nd++] = pd->index_max;};
    *pndims = nd/2;

    _PD_rl_syment_d(ep);

    return(TRUE);}
    
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFCTYP - copy a type definition from source file to destination file
 *        - return TRUE iff successful
 */

FIXNUM F77_ID(pfctyp_, pfctyp, PFCTYP)(sfid, dfid, pntyp, type)
   FIXNUM *sfid, *dfid, *pntyp;
   F77_string type;
   {PDBfile *sf, *df;
    char s[MAXLINE];
    defstr *dp;
    memdes *lst;
    SC_THREAD_ID(_t_index);

    SC_FORTRAN_STR_C(s, type, *pntyp);

    sf = SC_T_GET_POINTER(_t_index, PDBfile, *sfid);
    df = SC_T_GET_POINTER(_t_index, PDBfile, *dfid);

    dp = PD_inquire_type(sf, s);
    if (dp == NULL)
       {sprintf(PD_ERR(_t_index), "ERROR: TYPE %s NOT FOUND - PFCTYP\n", s);
        return(FALSE);};

    lst = PD_copy_members(dp->members);
    dp = _PD_defstr_inst(s, lst, -1, NULL, NULL,
                         df->chart, df->host_chart,
                         df->align, df->host_align,
                         FALSE);
    if (dp == NULL)
       {sprintf(PD_ERR(_t_index), "ERROR: CANNOT CREATE TYPE %s - PFCTYP\n", s);
        return(FALSE);};

    return(TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFITYP - inquire about a type in a PDBfile
 *        - this probably won't do everything but it will do some of the
 *        - useful stuff
 *        - return TRUE iff successful
 */

FIXNUM F77_ID(pfityp_, pfityp, PFITYP)(fileid, pntyp, type, psize,
                                       palgn, pind)
   FIXNUM *fileid, *pntyp;
   F77_string type;
   FIXNUM *psize, *palgn, *pind;
   {PDBfile *file;
    char s[MAXLINE];
    defstr *dp;
    SC_THREAD_ID(_t_index);

    SC_FORTRAN_STR_C(s, type, *pntyp);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    dp = PD_inquire_type(file, s);
    if (dp == NULL)
       {sprintf(PD_ERR(_t_index), "ERROR: TYPE %s NOT FOUND - PFITYP\n", s);
        return(FALSE);};

    *psize = dp->size;
    *palgn = dp->alignment;
    *pind  = dp->n_indirects;

/* forget about members for the moment */

    return(TRUE);}
    
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFIMBR - inquire about the nth member of a type in a PDBfile
 *        - return the member in the space provided
 *        - return TRUE iff successful
 */

FIXNUM F77_ID(pfimbr_, pfimbr, PFIMBR)(fileid, pntyp, type, pn, psize,
                                       space)
   FIXNUM *fileid, *pntyp;
   F77_string type;
   FIXNUM *pn, *psize;
   F77_string space;
   {int i, n, sz, nc;
    PDBfile *file;
    char s[MAXLINE], *ps;
    defstr *dp;
    memdes *desc;
    SC_THREAD_ID(_t_index);

    SC_FORTRAN_STR_C(s, type, *pntyp);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    dp = PD_inquire_type(file, s);
    if (dp == NULL)
       {sprintf(PD_ERR(_t_index), "ERROR: TYPE %s NOT FOUND - PFIMBR\n", s);
        return(FALSE);};

    n = *pn;
    for (i = 1, desc = dp->members;
	 (i < n) && (desc != NULL);
	 i++, desc = desc->next);

    if (desc != NULL)
       {ps = desc->member;
        nc = strlen(ps);

	sz     = *psize;
        *psize = nc;

        if (sz >= nc)
           strncpy(SC_F77_C_STRING(space), ps, sz);
        else
          {sprintf(PD_ERR(_t_index), "ERROR: BUFFER TOO SMALL TO HOLD DESCRIPTION - PFIMBR\n");
           return((FIXNUM) FALSE);};}
    else
       {*psize = -1;
        sprintf(PD_ERR(_t_index), "ERROR: MEMBER %i NOT FOUND - PFIMBR\n", n);
        return((FIXNUM) FALSE);};

    return(TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFQMBR - inquire about the nth member of a type in a PDBfile
 *        - return the name, type and dimensions
 *        - return TRUE iff successful
 */

FIXNUM F77_ID(pfqmbr_, pfqmbr, PFQMBR)(fileid, pntyp, type, pn, pname, name,
                                       pntout, tout, pndims, dims)
   FIXNUM *fileid, *pntyp;
   F77_string type;
   FIXNUM *pn, *pname;
   F77_string name;
   FIXNUM *pntout;
   F77_string tout;
   FIXNUM *pndims, *dims;
   {PDBfile *file;
    char s[MAXLINE], *ps, errmsg[MAXLINE];
    defstr *dp;
    int i, n, ndims, nc, sz;
    memdes *desc;
    dimdes *dimens;
    FIXNUM err;
    SC_THREAD_ID(_t_index);

    err = (FIXNUM) FALSE;
    strcpy(errmsg, "ERROR: ");

    SC_FORTRAN_STR_C(s, type, *pntyp);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    dp = PD_inquire_type(file, s);
    if (dp == NULL)
       {sprintf(PD_ERR(_t_index), "ERROR: TYPE %s NOT FOUND - PFQMBR\n", s);
        return(FALSE);};

    n = *pn;
    for (i = 1, desc = dp->members;
         (i < n) && (desc != NULL);
         i++, desc = desc->next);

    if (desc != NULL)
       {ps = desc->name;
        nc = strlen(ps);

        sz = *pname;
        *pname = nc;

        if (sz >= nc)
           strncpy(SC_F77_C_STRING(name), ps, sz);
        else
           {err = (FIXNUM) TRUE;
            strcat(errmsg, "NAME BUFFER TOO SMALL TO HOLD NAME\n");};

        ps = desc->type;
        nc = strlen(ps);

        sz = *pntout;
        *pntout = nc;

        if (sz >= nc)
           strncpy(SC_F77_C_STRING(tout), ps, sz);
        else
           {err = (FIXNUM) TRUE;
            strcat(errmsg, "TYPE BUFFER TOO SMALL TO HOLD TYPE\n");};

        ndims = desc->number;
 
        if ((int)*pndims > (ndims * 2))
           {for (n = 0, dimens = desc->dimensions; 
                 dimens != NULL; 
                 dimens = dimens->next)
                {dims[n++] = dimens->index_min;
                 dims[n++] = dimens->index_max;};
            *pndims = n/2;}
        else 
           {err = (FIXNUM) TRUE;
            strcat(errmsg, "DIMENSIONS ARRAY TOO SMALL TO HOLD DIMENSIONS\n");};}
    else
        {sprintf(PD_ERR(_t_index), "ERROR: MEMBER %i NOT FOUND - PFQMBR\n", n); 
         return((FIXNUM) FALSE);};

    if (err)
       {sprintf(PD_ERR(_t_index), "%s", errmsg);
        return((FIXNUM) FALSE);}
    else
       return(TRUE);}
    
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFREAD - read a variable from a PDBfile
 *        - this probably won't do everything but it will do some of the
 *        - useful stuff
 *        - return the number of item successfully read
 *        -
 *        - NOTE: SPACE must be a pointer to an object with the type
 *        - given by TYPE (PDBLib will allocated space if necessary)!
 */

FIXNUM F77_ID(pfread_, pfread, PFREAD)(fileid, pnchr, name, space)
   FIXNUM *fileid, *pnchr;
   F77_string name;
   byte *space;
   {PDBfile *file;
    char s[MAXLINE];
    SC_THREAD_ID(_t_index);

    SC_FORTRAN_STR_C(s, name, *pnchr);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    return(PD_read(file, s, space));}
    
    
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFRDAS - read a variable from a PDBfile
 *        - convert to type TYPE regardless of symbol entry type
 *        - this probably won't do everything but it will do some of the
 *        - useful stuff
 *        - return the number of item successfully read
 *        -
 *        - NOTE: SPACE must be a pointer to an object with the type
 *        - given by TYPE (PDBLib will allocated space if necessary)!
 */

FIXNUM F77_ID(pfrdas_, pfrdas, PFRDAS)(fileid, pnchr, name,
				       pntyp, type, space)
   FIXNUM *fileid, *pnchr;
   F77_string name;
   FIXNUM *pntyp;
   F77_string type;
   byte *space;
   {PDBfile *file;
    char s[MAXLINE], t[MAXLINE];
    SC_THREAD_ID(_t_index);

    SC_FORTRAN_STR_C(s, name, *pnchr);
    SC_FORTRAN_STR_C(t, type, *pntyp);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    return(PD_read_as(file, s, t,  space));}
    
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFRDAI - FORTRAN interface to PD_read_as_dwim */

FIXNUM F77_ID(pfrdai_, pfrdai, PFRDAI)(fileid, pnchr, name,
				       pntyp, type, pni, space)
   FIXNUM *fileid, *pnchr;
   F77_string name;
   FIXNUM *pntyp;
   F77_string type;
   FIXNUM *pni;
   byte *space;
   {long ni;
    char s[MAXLINE], t[MAXLINE];
    PDBfile *file;
    SC_THREAD_ID(_t_index);

    SC_FORTRAN_STR_C(s, name, *pnchr);
    SC_FORTRAN_STR_C(t, type, *pntyp);

    ni   = (long) *pni;
    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    return(PD_read_as_dwim(file, s, t, ni, space));}
    
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFRPTR - read an indirect variable from a PDBfile
 *        - this probably won't do everything but it will do some of the
 *        - useful stuff
 *        - return the number of item successfully read
 *        -
 *        - NOTE: SPACE must be an object with the type
 *        - given by TYPE (differs from the conventional PDB rule)
 */

FIXNUM F77_ID(pfrptr_, pfrptr, PFRPTR)(fileid, pnchr, name, pni, space)
   FIXNUM *fileid, *pnchr;
   F77_string name;
   FIXNUM *pni;
   byte *space;
   {PDBfile *file;
    char s[MAXLINE], fullpath[MAXLINE], *type;
    syment *ep;
    FIXNUM err;
    SC_THREAD_ID(_t_index);

    SC_FORTRAN_STR_C(s, name, *pnchr);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    switch (setjmp(_PD_READ_ERR(_t_index)))
       {case ABORT    : return((FIXNUM) FALSE);
        case ERR_FREE : return((FIXNUM) TRUE);
        default       : memset(PD_ERR(_t_index), 0, MAXLINE);
                        break;};

/* find the effective symbol table entry for the named item */
    ep = _PD_effective_ep(file, s, TRUE, fullpath);
    if (ep == NULL)
       {sprintf(s, "UNREADABLE OR MISSING ENTRY \"%s\" - PFRPTR",
                   fullpath);
        PD_error(s, PD_READ);};

    err  = FALSE;
    type = PD_entry_type(ep);
    if (_PD_indirection(type))
       {byte *vr;
        size_t nb;
        long nir, nis, bytepitem;

        err = _PD_hyper_read(file, fullpath, type, ep, &vr);

        strcpy(s, type);
        PD_dereference(s);
        bytepitem = _PD_lookup_size(s, file->host_chart);
        nis       = (*pni)*bytepitem;
        nir       = SC_arrlen(vr);
        if (nir > nis)
           {err = FALSE;
            nb  = nis;}
        else
           nb = nir;

        memcpy(space, vr, nb);

        SFREE(vr);

        _PD_rl_syment_d(ep);};

    return(err);}
    
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFPTRD - read a part of a variable from a PDBfile
 *        - this probably won't do everything but it will do some of the
 *        - useful stuff
 *        - return the number of item successfully read
 *
 *        - NOTE: the entry MUST be an array (either a static array or
 *        - a pointer)
 *        -
 *        - NOTE: SPACE must be a pointer to an object with the type
 *        - of the object associated with NAME (PDBLib will allocate
 *        - space if necessary)!
 */

FIXNUM F77_ID(pfptrd_, pfptrd, PFPTRD)(fileid, pnchr, name, space, ind)
   FIXNUM *fileid, *pnchr;
   F77_string name;
   byte *space;
   FIXNUM *ind;
   {PDBfile *file;
    char s[MAXLINE];
    SC_THREAD_ID(_t_index);

    SC_FORTRAN_STR_C(s, name, *pnchr);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    return(_PD_read_aux(file, s, (char *) NULL, space, ind));}
    
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFRDAD - read a part of a variable from a PDBfile
 *        - convert to type TYPE regardless of symbol entry type
 *        - this probably won't do everything but it will do some of the
 *        - useful stuff
 *        - return the number of item successfully read
 *
 *        - NOTE: the entry MUST be an array (either a static array or
 *        - a pointer)
 *        -
 *        - NOTE: SPACE must be a pointer to an object with the type
 *        - of the object associated with NAME (PDBLib will allocate
 *        - space if necessary)!
 */

FIXNUM F77_ID(pfrdad_, pfrdad, PFRDAD)(fileid, pnchr, name,
                                               pntyp, type, space, ind)
   FIXNUM *fileid, *pnchr;
   F77_string name;
   FIXNUM *pntyp;
   F77_string type;
   byte *space;
   FIXNUM *ind;
   {PDBfile *file;
    char s[MAXLINE], t[MAXLINE];
    SC_THREAD_ID(_t_index);

    SC_FORTRAN_STR_C(s, name, *pnchr);
    SC_FORTRAN_STR_C(t, type, *pntyp);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    return(_PD_read_aux(file, s, t, space, ind));}
    
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFAPPA - append to a variable in a PDBfile
 *        - ASCII encode the dimensions in the name
 *        - this probably won't do everything but it will do some of the
 *        - useful stuff
 *        - return TRUE iff successful
 */

FIXNUM F77_ID(pfappa_, pfappa, PFAPPA)(fileid, pnchr, name, space)
   FIXNUM *fileid, *pnchr;
   F77_string name;
   byte *space;
   {PDBfile *file;
    char s[MAXLINE];
    SC_THREAD_ID(_t_index);

    SC_FORTRAN_STR_C(s, name, *pnchr);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    return(PD_append(file, s, space));}
    
    
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFAPAS - append to a variable in a PDBfile
 *        - convert from INTYPE to the type of the existing data
 *        - ASCII encode the dimensions in the name
 *        - this probably won't do everything but it will do some of the
 *        - useful stuff
 *        - return TRUE iff successful
 */

FIXNUM F77_ID(pfapas_, pfapas, PFAPAS)(fileid, pnchr, name, 
                                                     pntyp, intype, space)
   FIXNUM *fileid, *pnchr;
   F77_string name;
   FIXNUM *pntyp;
   F77_string intype;
   byte *space;
   {PDBfile *file;
    char s[MAXLINE], t[MAXLINE];
    SC_THREAD_ID(_t_index);

    SC_FORTRAN_STR_C(s, name, *pnchr);
    SC_FORTRAN_STR_C(t, intype, *pntyp);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    return(PD_append_as(file, s, t, space));}
    
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFAPPD - append to a variable in a PDBfile
 *        - the dimensions are specified in an array of (min,max) pairs
 *        - return TRUE iff successful
 */

FIXNUM F77_ID(pfappd_, pfappd, PFAPPD)(fileid, pnchr, name,
                                       space, pndims, dims)
   FIXNUM *fileid, *pnchr;
   F77_string name;
   byte *space;
   FIXNUM *pndims, *dims;
   {PDBfile *file;
    char s[MAXLINE];
    SC_THREAD_ID(_t_index);

    SC_FORTRAN_STR_C(s, name, *pnchr);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    return(_PD_append_aux(file, s, (char *) NULL, space, *pndims, dims));}
    
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFAPAD - append to a variable in a PDBfile
 *        - convert from INTYPE to the type of the existing data
 *        - the dimensions are specified in an array of (min,max) pairs
 *        - return TRUE iff successful
 */

FIXNUM F77_ID(pfapad_, pfapad, PFAPAD)(fileid, pnchr, name, pntyp, intype,
                                       space, pndims, dims)
   FIXNUM *fileid, *pnchr;
   F77_string name;
   FIXNUM *pntyp;
   F77_string intype;
   byte *space;
   FIXNUM *pndims, *dims;
   {PDBfile *file;
    char s[MAXLINE], t[MAXLINE];
    SC_THREAD_ID(_t_index);

    SC_FORTRAN_STR_C(s, name, *pnchr);
    SC_FORTRAN_STR_C(t, intype, *pntyp);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    return(_PD_append_aux(file, s, t, space, *pndims, dims));}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFWRTA - write a variable to a PDBfile
 *        - ASCII encode the dimensions in the name
 *        - this probably won't do everything but it will do some of the
 *        - useful stuff
 *        - return TRUE iff successful
 */

FIXNUM F77_ID(pfwrta_, pfwrta, PFWRTA)(fileid, pnchr, name, pntyp,
                                       type, space)
   FIXNUM *fileid, *pnchr;
   F77_string name;
   FIXNUM *pntyp;
   F77_string type;
   byte *space;
   {PDBfile *file;
    char s[MAXLINE], t[MAXLINE];
    SC_THREAD_ID(_t_index);

    SC_FORTRAN_STR_C(s, name, *pnchr);
    SC_FORTRAN_STR_C(t, type, *pntyp);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    return(PD_write(file, s, t, space));}
    

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFWRAS - write a variable of type INTYPE to a PDBfile as type OUTTYPE
 *        - ASCII encode the dimensions in the name
 *        - this probably won't do everything but it will do some of the
 *        - useful stuff
 *        - return TRUE iff successful
 */

FIXNUM F77_ID(pfwras_, pfwras, PFWRAS)(fileid, pnchr, name, pintyp,
                                       intype, poutyp, outtype, space)
   FIXNUM *fileid, *pnchr;
   F77_string name;
   FIXNUM *pintyp, *poutyp;
   F77_string intype, outtype;
   byte *space;
   {PDBfile *file;
    char s[MAXLINE], t1[MAXLINE], t2[MAXLINE];
    SC_THREAD_ID(_t_index);

    SC_FORTRAN_STR_C(s, name, *pnchr);
    SC_FORTRAN_STR_C(t1, intype, *pintyp);
    SC_FORTRAN_STR_C(t2, outtype, *poutyp);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    return(PD_write_as(file, s, t1, t2, space));}
    
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFWRTD - write a variable to a PDBfile
 *        - the dimensions are specified in an array of (min,max) pairs
 *        - return TRUE iff successful
 */

FIXNUM F77_ID(pfwrtd_, pfwrtd, PFWRTD)(fileid, pnchr, name, pntyp,
                                       type, space, pndims, dims)
   FIXNUM *fileid, *pnchr;
   F77_string name;
   FIXNUM *pntyp;
   F77_string type;
   byte *space;
   FIXNUM *pndims, *dims;
   {PDBfile *file;
    char s[MAXLINE], t[MAXLINE];
    SC_THREAD_ID(_t_index);

    SC_FORTRAN_STR_C(s, name, *pnchr);
    SC_FORTRAN_STR_C(t, type, *pntyp);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    return(_PD_write_aux(file, s, t, t, space, *pndims, dims));}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFWRAD - write a variable INTYPE to a PDBfile as type OUTTYPE
 *        - the dimensions are specified in an array of (min,max) pairs
 *        - return TRUE iff successful
 */

FIXNUM F77_ID(pfwrad_, pfwrad, PFWRAD)(fileid, pnchr, name, pintyp,
                          intype, poutyp, outtype, space, pndims, dims)
   FIXNUM *fileid, *pnchr;
   F77_string name;
   FIXNUM *pintyp, *poutyp;
   F77_string intype, outtype;
   byte *space;
   FIXNUM *pndims, *dims;
   {PDBfile *file;
    char s[MAXLINE], ti[MAXLINE], to[MAXLINE];
    SC_THREAD_ID(_t_index);

    SC_FORTRAN_STR_C(s, name, *pnchr);
    SC_FORTRAN_STR_C(ti, intype, *pintyp);
    SC_FORTRAN_STR_C(to, outtype, *poutyp);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    return(_PD_write_aux(file, s, ti, to, space, *pndims, dims));}
    
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFDEFA - define a symbol table entry and reserve disk space
 *        - dimension information is encoded in name
 *        - return TRUE if successful, FALSE otherwise
 */

FIXNUM F77_ID(pfdefa_, pfdefa, PFDEFA)(fileid, pnchr, name, pntyp, type)

   FIXNUM *fileid, *pnchr;
   F77_string name;
   FIXNUM *pntyp;
   F77_string type;
   {PDBfile *file;
    char s[MAXLINE], t[MAXLINE];
    SC_THREAD_ID(_t_index);

    SC_FORTRAN_STR_C(s, name, *pnchr);
    SC_FORTRAN_STR_C(t, type, *pntyp);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    return((PD_defent(file, s, t) != NULL));}
    

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFDEFD - define a symbol table entry and reserve disk space
 *        - dimension information is provided in index range array
 *        - return TRUE if successful, FALSE otherwise
 */

FIXNUM F77_ID(pfdefd_, pfdefd, PFDEFD)(fileid, pnchr, name, pntyp,
                                       type, pndims, dims)
   FIXNUM *fileid, *pnchr;
   F77_string name;
   FIXNUM *pntyp;
   F77_string type;
   FIXNUM *pndims, *dims;
   {PDBfile *file;
    char s[MAXLINE], t[MAXLINE];
    SC_THREAD_ID(_t_index);

    SC_FORTRAN_STR_C(s, name, *pnchr);
    SC_FORTRAN_STR_C(t, type, *pntyp);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    return(_PD_defent_aux(file, s, t, *pndims, dims));}
    
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFDEFS - define a structure for the FORTRAN interface
 *        - return TRUE iff successful
 */

#ifdef PCC

FIXNUM F77_ID(pfdefs_, pfdefs, PFDEFS)(fileid, pnchr, name, va_alist)
   FIXNUM *fileid;
   FIXNUM *pnchr;
   F77_string name;
   va_dcl

#endif

#ifdef ANSI

FIXNUM F77_ID(pfdefs_, pfdefs, PFDEFS)(FIXNUM *fileid,
                                       FIXNUM *pnchr, F77_string name, ...)

#endif

   {int n, *pn;
    F77_string ps;
    char *ptype, *type;
    char s[MAXLINE], lname[MAXLINE];
    HASHTAB *fchrt;
    defstr *dp;
    memdes *desc, *lst, *prev;
    PDBfile *file;
    SC_THREAD_ID(_t_index);

    SC_VA_START(name);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    SC_FORTRAN_STR_C(lname, name, *pnchr);

    prev  = NULL;
    lst   = NULL;
    fchrt = file->chart;
    for (pn = SC_VA_ARG(int *); (n = *pn) != 0;
         pn = SC_VA_ARG(int *))
        {ps = SC_VA_ARG(F77_string);
         SC_FORTRAN_STR_C(s, ps, n);

         desc  = _PD_mk_descriptor(s, file->default_offset);
         type  = SC_strsavef(s, "char*:PFDEFS:type");
         ptype = SC_firsttok(type, " \n");
         if (SC_lookup(ptype, fchrt) == NULL)
            if ((strcmp(ptype, lname) != 0) || !_PD_indirection(s))
               {sprintf(PD_ERR(_t_index), "ERROR: %s BAD MEMBER TYPE - PFDEFS\n",
                                s);
                return(FALSE);};
         SFREE(type);
         if (lst == NULL)
            lst = desc;
         else
            prev->next = desc;
         prev = desc;};
    SC_VA_END;

/* install the type in both charts */
    dp = _PD_defstr_inst(lname, lst, -1, NULL, NULL,
                         fchrt, file->host_chart,
                         file->align, file->host_align, FALSE);

    if (dp == NULL)
       {sprintf(PD_ERR(_t_index), "ERROR: CAN'T HANDLE PRIMITIVE TYPE - PFDEFS\n");
        return(FALSE);}
    else
       return(TRUE);}
    
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFDEFT - define a structure for the FORTRAN interface
 *        - return TRUE iff successful
 */

FIXNUM F77_ID(pfdeft_, pfdeft, PFDEFT)(fileid, pnchr, name, pnm, nc, nm)
   FIXNUM *fileid;
   FIXNUM *pnchr;
   F77_string name;
   FIXNUM *pnm, *nc;
   F77_string nm;
   {int i, n, indx, mc;
    char lname[MAXLINE], bf[MAXLINE], *lnm, **members;
    defstr *dp;
    PDBfile *file;
    SC_THREAD_ID(_t_index);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);
    lnm  = SC_F77_C_STRING(nm);

    SC_FORTRAN_STR_C(lname, name, *pnchr);

    n = *pnm;
    members = FMAKE_N(char *, n, "PFDEFT:members");
    for (i = 0; i < n; i++)
        {indx = nc[2*i];
         mc   = nc[2*i + 1];

         strncpy(bf, lnm+indx, mc);
         bf[mc] = '\0';

         members[i] = SC_strsavef(bf, "char*:PFDEFT:bf");};

/* install the type in both charts */
    dp = PD_defstr_alt(file, lname, n, members);

    for (i = 0; i < n; i++)
        SFREE(members[i]);
    SFREE(members);

    return((FIXNUM) (dp != NULL));}
    
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFTRGT - target the next file to be opened
 *        - given an index from the following list:
 *        -
 *        -   (1,  1)  - Sun3
 *        -   (1,  2)  - Sun4
 *        -   (1,  3)  - Mips, Stardent, SGI
 *        -   (1,  8)  - IBM R6000
 *        -   (2,  1)  - Macintosh A (Think C)
 *        -   (3,  1)  - Macintosh B (MPW)
 *        -   (4,  4)  - DOS
 *        -   (5,  4)  - Intel 80x86 UNIX
 *        -   (6,  5)  - DEC VAX
 *        -   (5,  3)  - DEC 3100
 *        -   (7,  7)  - UNICOS Cray
 *        -
 *        - return TRUE iff successful
 */

FIXNUM F77_ID(pftrgt_, pftrgt, PFTRGT)(pis, pia)
   FIXNUM *pis, *pia;
   {int ret, al, st;
    SC_THREAD_ID(_t_index);

    al  = *pia;
    st  = *pis;
    ret = (al != 6);
    if (ret)
       {_PD_REQ_STANDARD(_t_index)  = PD_std_standards[st - 1];
        _PD_REQ_ALIGNMENT(_t_index) = PD_std_alignments[al - 1];}

    else
       {_PD_REQ_STANDARD(_t_index)  = NULL;
        _PD_REQ_ALIGNMENT(_t_index) = NULL;

        sprintf(PD_ERR(_t_index),
		"ERROR: REQUESTED ALIGNMENT NO LONGER EXISTS - PFTRGT");};

    return(ret);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFOPEN - open a PDBfile
 *        - save the PDBfile pointer in an internal array
 *        - and return an integer index to the pointer if successful
 *        - return 0 otherwise
 */

FIXNUM F77_ID(pfopen_, pfopen, PFOPEN)(pnchr, name, mode)
   FIXNUM *pnchr;
   F77_string name, mode;
   {PDBfile *file;
    char s[MAXLINE], t[2];
    SC_THREAD_ID(_t_index);

    SC_FORTRAN_STR_C(s, name, *pnchr);
    SC_FORTRAN_STR_C(t, mode, 1);

    file = PD_open(s, t);
    if (file == NULL)
       return((FIXNUM) 0);
    else
       {file->major_order    = COLUMN_MAJOR_ORDER;
        file->default_offset = 1;

        return((FIXNUM) SC_T_ADD_POINTER(_t_index, file));};}
    
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFCLOS - close the PDBfile associated with the integer index
 *        - return TRUE if successful and FALSE otherwise
 */

FIXNUM F77_ID(pfclos_, pfclos, PFCLOS)(fileid)
   FIXNUM *fileid;
   {PDBfile *file;
    SC_THREAD_ID(_t_index);

    file = SC_T_DEL_POINTER(_t_index, PDBfile, *fileid);

    *fileid = 0;

    return((FIXNUM) PD_close(file));}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFWULC - write an ULTRA curve into a PDB file */

FIXNUM F77_ID(pfwulc_, pfwulc, PFWULC)(fileid, pnchr, labl, pnpts,
                                       px, py, pic)
   FIXNUM *fileid, *pnchr;
   F77_string labl;
   FIXNUM *pnpts;
   REAL *px, *py;
   FIXNUM *pic;
   {PDBfile *file;
    char s[MAXLINE];
    int i, n, err;
    SC_THREAD_ID(_t_index);

    SC_FORTRAN_STR_C(s, labl, *pnchr);

    i    = *pic;
    n    = *pnpts;
    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    err = PD_wrt_pdb_curve(file, s, n, px, py, i);

/* increment the curve count if no error */
    if (err)
       (*pic)++;

    return(err);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFWULY - write the y values for an ULTRA curve into a PDB file */

FIXNUM F77_ID(pfwuly_, pfwuly, PFWULY)(fileid, pnchr, labl, pnpts,
                                       pix, py, pic)
   FIXNUM *fileid, *pnchr;
   F77_string labl;
   FIXNUM *pnpts, *pix;
   REAL *py;
   FIXNUM *pic;
   {PDBfile *file;
    char s[MAXLINE];
    int i, n, err;
    SC_THREAD_ID(_t_index);

    SC_FORTRAN_STR_C(s, labl, *pnchr);

    i    = *pic;
    n    = *pnpts;
    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    err = PD_wrt_pdb_curve_y(file, s, n, (int) *pix, py, i);

/* increment the curve count if no error */
    if (err)
       (*pic)++;

    return(err);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFWMAP - write an PM_mapping into a PDB file
 *        - the domain information (dname, dp, dm) and range 
 *        - information (rname, rp, rm) are structured the same
 *        - and are as follows:
 *        -
 *        - dname : the FORTRAN version of the set name left justified
 *        -
 *        - dp[1]              : the number of characters in dname
 *        - dp[2]              : the dimensionality of the set - nd
 *        - dp[3]              : the dimensionality of the elements - nde
 *        - dp[4]              : the number of elements in the set - ne
 *        - dp[5] ... dp[5+nd] : the sizes in each dimension
 *        -
 *        - dm[1]      - dm[ne]          : values of first component of
 *        -                                elements
 *        -            .
 *        -            .
 *        -            .
 *        -
 *        - dm[nde*ne] - dm[nde*ne + ne] : values of nde'th component of
 *        -                                elements
 */

FIXNUM F77_ID(pfwmap_, pfwmap, PFWMAP)(fileid, dname, dp, dm,
                                               rname, rp, rm, pim)
   FIXNUM *fileid;
   F77_string dname;
   FIXNUM *dp;
   REAL *dm;
   F77_string rname;
   FIXNUM *rp;
   REAL *rm;
   FIXNUM *pim;
   {PDBfile *file;
    char s[MAXLINE];
    PM_mapping *f;
    PM_set *domain, *range;
    SC_THREAD_ID(_t_index);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    if (SC_lookup("PM_mapping", file->chart) == NULL)
       {if (!PD_def_mapping(file))
           return(FALSE);};

    SC_FORTRAN_STR_C(s, dname, dp[0]);
    domain = _PD_build_set(dp+1, dm, s);

    SC_FORTRAN_STR_C(s, rname, rp[0]);
    range  = _PD_build_set(rp+1, rm, s);

    sprintf(s, "%s->%s", domain->name, range->name);
    f = PM_make_mapping(s, PM_LR_S, domain, range, N_CENT, NULL);

/* disconnect the function pointers or undefined structs/members */
    f->domain->opers = NULL;
    f->range->opers  = NULL;

    if (!PD_put_mapping(file, f, (*pim)++))
       return(FALSE);

    PM_rel_mapping(f, TRUE, TRUE);

    return(TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFWIMA - write a PG_image into a PDB file */

FIXNUM F77_ID(pfwima_, pfwima, PFWIMA)(fileid, nchr, name, pkn, pkx, pln, plx,
                                       data, pxn, pxx, pyn, pyx, image)
   FIXNUM *fileid, *nchr;
   F77_string name;
   FIXNUM *pkn, *pkx, *pln, *plx;
   REAL *data, *pxn, *pxx, *pyn, *pyx;
   FIXNUM *image;
   {PDBfile *file;
    char s[MAXLINE];
    PD_image *im;
    REAL *pd, *d, xmin, xmax, ymin, ymax, zmin, zmax, z;
    int n, kx, lx, kmin, kmax, lmin, k1, k2, l1, l2, k, l, i;
    SC_THREAD_ID(_t_index);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    if (SC_lookup("PG_image", file->chart) == NULL)
       {if (!PD_def_mapping(file))
           return(FALSE);};

    SC_FORTRAN_STR_C(s, name, *nchr);

    xmin = *pxn;
    xmax = *pxx;
    ymin = *pyn;
    ymax = *pyx;
    kmin = *pkn;
    kmax = *pkx;
    lmin = *pln;
    k1   = xmin;
    k2   = xmax;
    l1   = ymin;
    l2   = ymax;
    kx   = k2 - k1 + 1;
    lx   = l2 - l1 + 1;
    n    = kx*lx;
    d    = pd = FMAKE_N(REAL, n, "PFWIMA:d");
    zmax = -HUGE;
    zmin =  HUGE;
    for (l = l1; l <= l2; l++)
        for (k = k1; k <= k2; k++)
            {i     = (l - lmin)*(kmax - kmin + 1) + k - kmin;
             z     = data[i];
             zmax  = max(zmax, z);
             zmin  = min(zmin, z);
             *pd++ = z;}

    im = PD_make_image(s, "double *", d, kx, lx, 8, xmin, xmax,
                       ymin, ymax, zmin, zmax);

    if (!PD_put_image(file, im, *image))
       return(FALSE);

    PD_rel_image(im);

    return(TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFWSET - write a PM_set into a PDB file
 *        - the set information (dname, dp, dm) is structured
 *        - as follows:
 *        -
 *        - dname : the FORTRAN version of the set name left justified
 *        -
 *        - dp[1]              : the number of characters in dname
 *        - dp[2]              : the dimensionality of the set - nd
 *        - dp[3]              : the dimensionality of the elements - nde
 *        - dp[4]              : the number of elements in the set - ne
 *        - dp[5] ... dp[5+nd] : the sizes in each dimension
 *        -
 *        - dm[1]      - dm[ne]          : values of first component of
 *        -                                elements
 *        -            .
 *        -            .
 *        -            .
 *        -
 *        - dm[nde*ne] - dm[nde*ne + ne] : values of nde'th component of
 *        -                                elements
 */

FIXNUM F77_ID(pfwset_, pfwset, PFWSET)(fileid, dname, dp, dm)
   FIXNUM *fileid;
   F77_string dname;
   FIXNUM *dp;
   REAL *dm;
   {PDBfile *file;
    char s[MAXLINE];
    PM_set *set;
    SC_THREAD_ID(_t_index);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    if (SC_lookup("PM_set", file->chart) == NULL)
       {if (!PD_def_mapping(file))
           return(FALSE);};

    SC_FORTRAN_STR_C(s, dname, dp[0]);
    set = _PD_build_set(dp+1, dm, s);

/* disconnect the function pointers or undefined structs/members */
    set->opers = NULL;

    if (!PD_put_set(file, set))
       return(FALSE);

    PM_rel_set(set, FALSE);

    return(TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFWRAN - write a PM_mapping into a PDB file
 *        - only the range part of the mapping is given
 *        - the domain (common to many mappings) is written separately
 *        -
 *        - the domain name is the only part of the domain specified
 *        -
 *        - the range information (rname, rp, rm) is structured
 *        - as follows:
 *        -
 *        - rname : the FORTRAN version of the set name left justified
 *        -
 *        - rp[1]              : the number of characters in rname
 *        - rp[2]              : the dimensionality of the set - nd
 *        - rp[3]              : the dimensionality of the elements - nde
 *        - rp[4]              : the number of elements in the set - ne
 *        - rp[5] ... rp[5+nd] : the sizes in each dimension
 *        -
 *        - rm[1]      - rm[ne]          : values of first component of
 *        -                                elements
 *        -            .
 *        -            .
 *        -            .
 *        -
 *        - rm[nde*ne] - rm[nde*ne + ne] : values of nde'th component of
 *        -                                elements
 */

FIXNUM F77_ID(pfwran_, pfwran, PFWRAN)(fileid, dname, nchr,
                                               rname, rp, rm, pim)
   FIXNUM *fileid;
   F77_string dname;
   FIXNUM *nchr;
   F77_string rname;
   FIXNUM *rp;
   REAL *rm;
   FIXNUM *pim;
   {PDBfile *file;
    char d[MAXLINE], r[MAXLINE], s[MAXLINE];
    PM_mapping *f;
    PM_set *range;
    SC_THREAD_ID(_t_index);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    if (SC_lookup("PM_mapping", file->chart) == NULL)
       {if (!PD_def_mapping(file))
           return(FALSE);};

    SC_FORTRAN_STR_C(d, dname, *nchr);

    SC_FORTRAN_STR_C(r, rname, rp[0]);
    range = _PD_build_set(rp+1, rm, r);

    sprintf(s, "%s->%s", d, range->name);
    f = PM_make_mapping(s, PM_LR_S, NULL, range, N_CENT, NULL);

/* disconnect the function pointers or undefined structs/members */
    f->range->opers = NULL;

    if (!PD_put_mapping(file, f, (*pim)++))
       return(FALSE);

    PM_rel_mapping(f, TRUE, TRUE);

    return((FIXNUM) TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_BUILD_SET - build and return a set from FORTRAN type information */

static PM_set *_PD_build_set(si, sd, sname)
   FIXNUM *si;
   REAL *sd;
   char *sname;
   {int i, j, nd, nde, ne;
    int *maxes;
    byte **elem;
    double *data;
    double tmp;
    PM_set *set;

    nd  = si[0];
    nde = si[1];
    ne  = si[2];

    maxes = FMAKE_N(int, nd, "_PD_BUILD_SET:maxes");
    for (i = 0; i < nd; i++)
        maxes[i] = (int) si[i+3];

    elem = FMAKE_N(byte *, nde, "_PD_BUILD_SET:elem");
    for (i = 0; i < nde; i++)
        {data    = FMAKE_N(double, ne, "_PD_BUILD_SET:data");
         elem[i] = (byte *) data;
         for (j = 0; j < ne; j++)
             {tmp = *sd++;
              *data++ = tmp;};};

    set = _PM_make_set(sname, SC_DOUBLE_S, FALSE,
                       ne, nd, nde, maxes, elem,
                       PM_REAL_Opers, NULL,
                       NULL, NULL, NULL, NULL, NULL, NULL,
                       NULL);

    return(set);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFDATT - FORTRAN interface routine to define an attribute */

FIXNUM F77_ID(pfdatt_, pfdatt, PFDATT)(fileid, pna, fattr, pnt, ftype)
   FIXNUM *fileid, *pna;
   F77_string fattr;
   FIXNUM *pnt;
   F77_string ftype;
   {PDBfile *file;
    int ret, nc;
    char lattr[MAXLINE], ltype[MAXLINE];
    SC_THREAD_ID(_t_index);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    nc = *pna;
    SC_FORTRAN_STR_C(lattr, fattr, nc);

    nc = *pnt;
    SC_FORTRAN_STR_C(ltype, ftype, nc);

    ret = PD_def_attribute(file, lattr, ltype);

    return((FIXNUM) ret);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFRATT - FORTRAN interface routine to remove an attribute */

FIXNUM F77_ID(pfratt_, pfratt, PFRATT)(fileid, pna, fattr)
   FIXNUM *fileid, *pna;
   F77_string fattr;
   {PDBfile *file;
    int ret, nc;
    char lattr[MAXLINE];
    SC_THREAD_ID(_t_index);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    nc = *pna;
    SC_FORTRAN_STR_C(lattr, fattr, nc);

    ret = PD_rem_attribute(file, lattr);

    return((FIXNUM) ret);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFSVAT - FORTRAN interface routine to assign an attribute value to
 *        - a variable
 */

FIXNUM F77_ID(pfsvat_, pfsvat, PFSVAT)(fileid, pnv, fvar, pna, fattr, vl)
   FIXNUM *fileid, *pnv;
   F77_string fvar;
   FIXNUM *pna;
   F77_string fattr;
   byte *vl;
   {PDBfile *file;
    int ret, nc;
    char lattr[MAXLINE], lvar[MAXLINE], **lvl;
    attribute *attr;
    SC_THREAD_ID(_t_index);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    nc = *pnv;
    SC_FORTRAN_STR_C(lvar, fvar, nc);

    nc = *pna;
    SC_FORTRAN_STR_C(lattr, fattr, nc);

    attr = PD_inquire_attribute(file, lattr, NULL);
    lvl  = FMAKE(char *, "PFSVAT:lvl");
    if (strcmp(attr->type, "char ***") == 0)
       *lvl = SC_strsavef(vl, "char*:PFSVAT:vl");
    else
       *lvl = vl;

    ret = PD_set_attribute(file, lvar, lattr, (byte *) lvl);

    return((FIXNUM) ret);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFGVAT - FORTRAN interface routine to get an attribute value of
 *        - a variable
 */

FIXNUM F77_ID(pfgvat_, pfgvat, PFGVAT)(fileid, pnv, fvar, pna, fattr, vl)
   FIXNUM *fileid, *pnv;
   F77_string fvar;
   FIXNUM *pna;
   F77_string fattr;
   byte *vl;
   {PDBfile *file;
    int nc;
    char lvar[MAXLINE], lattr[MAXLINE];
    byte *lvl;
    SC_THREAD_ID(_t_index);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    nc = *pnv;
    SC_FORTRAN_STR_C(lvar, fvar, nc);

    nc = *pna;
    SC_FORTRAN_STR_C(lattr, fattr, nc);

    lvl = PD_get_attribute(file, lvar, lattr);
    if (lvl != NULL)
       {nc  = SC_arrlen(*(char **)lvl);
        memcpy(vl, *(char **)lvl, nc);};

    return((FIXNUM) (lvl != NULL));}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFFLSH - FORTRAN interface routine to PD_flush */

FIXNUM F77_ID(pfflsh_, pfflsh, PFFLSH)(fileid)
   FIXNUM *fileid;
   {PDBfile *file;
    SC_THREAD_ID(_t_index);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    return((FIXNUM) PD_flush(file));}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFFAMI - FORTRAN interface routine to PD_family */

FIXNUM F77_ID(pffami_, pffami, PFFAMI)(fileid, pf)
   FIXNUM *fileid, *pf;
   {PDBfile *file, *nfile;
    SC_THREAD_ID(_t_index);

    file = SC_T_DEL_POINTER(_t_index, PDBfile, *fileid);

    nfile = PD_family(file, (int) *pf);
    if ((nfile != file) && (*pf != 0))
       *fileid = 0;

    return((FIXNUM) SC_T_ADD_POINTER(_t_index, nfile));}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFCD - FORTRAN interface routine to change currrent working directory */

FIXNUM F77_ID(pfcd_, pfcd, PFCD)(fileid, nchr, dirname)
   FIXNUM *fileid, *nchr;
   F77_string dirname;
   {PDBfile *file;
    char dir[MAXLINE];
    SC_THREAD_ID(_t_index);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    if (*nchr > MAXLINE)
       {sprintf(PD_ERR(_t_index), "ERROR: DIRECTORY NAME TOO LONG - PFCD\n");
        return(FALSE);};

    SC_FORTRAN_STR_C(dir, dirname, *nchr);

    return((FIXNUM) PD_cd(file, dir));}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFLN - FORTRAN interface routine to create a link to a variable */

FIXNUM F77_ID(pfln_, pfln, PFLN)(fileid, ochr, oname, nchr, nname)
   FIXNUM *fileid, *ochr;
   F77_string oname;
   FIXNUM *nchr;
   F77_string nname;
   {PDBfile *file;
    char oldname[MAXLINE], newname[MAXLINE];
    SC_THREAD_ID(_t_index);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    if ((*ochr > MAXLINE) || (*nchr > MAXLINE))
       {sprintf(PD_ERR(_t_index), "ERROR: VARIABLE NAME TOO LONG - PFLN\n");
        return(FALSE);};

    SC_FORTRAN_STR_C(oldname, oname, *ochr);
    SC_FORTRAN_STR_C(newname, nname, *nchr);

    return((FIXNUM) PD_ln(file, oldname, newname));}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFLST - FORTRAN interface routine to get an alphabetical list of file
 *       - variables and directories in the current working directory that
 *       - match the specified pattern and type. Previous lists are deleted.
 */

FIXNUM F77_ID(pflst_, pflst, PFLST)(fileid, npath, path, ntype, type, num)
   FIXNUM *fileid, *npath;
   F77_string path;
   FIXNUM *ntype;
   F77_string type;
   FIXNUM *num;
   {PDBfile *file;
    char *ppath, *ptype;
    char lpath[MAXLINE], ltype[MAXLINE];
    SC_THREAD_ID(_t_index);

    N_ENTRIES(_t_index) = 0;
    if (OUTLIST(_t_index) != NULL)
       SFREE(OUTLIST(_t_index));

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    if (*npath > MAXLINE)
       {sprintf(PD_ERR(_t_index), "ERROR: VARIABLE NAME TOO LONG - PFLST\n");
        return(FALSE);};

    if (*ntype > MAXLINE)
       {sprintf(PD_ERR(_t_index), "ERROR: VARIABLE TYPE TOO LONG - PFLST\n");
        return(FALSE);};

    if (*npath == 0)
       ppath = NULL;
    else
       {ppath = lpath;
        SC_FORTRAN_STR_C(lpath, path, *npath);};

    if (*ntype == 0)
       ptype = NULL;
    else
       {ptype = ltype;
        SC_FORTRAN_STR_C(ltype, type, *ntype);};

    OUTLIST(_t_index) = PD_ls(file, ppath, ptype, &N_ENTRIES(_t_index));

    if ((OUTLIST(_t_index) == NULL) && (PD_ERR(_t_index)[0] != '\0'))
       return(FALSE);

    *num = N_ENTRIES(_t_index);

    return(TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFGLS - FORTRAN interface routine to get the name of the nth variable or
 *       - directory in the internal sorted table set up by a call to PFLST.
 */

FIXNUM F77_ID(pfgls_, pfgls, PFGLS)(ord, len, name)
   FIXNUM *ord, *len;
   F77_string name;
   {char *s;
    int n;
    SC_THREAD_ID(_t_index);

    n = *ord - 1;

    if ((n < 0) || (n >= N_ENTRIES(_t_index)))
       {sprintf(PD_ERR(_t_index), "ERROR: VARIABLE ORDINAL OUT OF RANGE - PFGLS\n");
        return(FALSE);};

    s = OUTLIST(_t_index)[n];
    strcpy(SC_F77_C_STRING(name), s);
    *len = strlen(s);

    return(TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFDLS - FORTRAN interface routine to delete internal table set up by a call
 *       - to PFLST.
 */

FIXNUM F77_ID(pfdls_, pfdls, PFDLS)()
   {SC_THREAD_ID(_t_index);

    if (OUTLIST(_t_index) != NULL)
       SFREE(OUTLIST(_t_index));

    return(TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFMKDR - FORTRAN interface routine to create a directory */

FIXNUM F77_ID(pfmkdr_, pfmkdr, PFMKDR)(fileid, nchr, dirname)
   FIXNUM *fileid, *nchr;
   F77_string dirname;
   {PDBfile *file;
    char dir[MAXLINE];
    SC_THREAD_ID(_t_index);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    if (*nchr > MAXLINE)
       {sprintf(PD_ERR(_t_index), "ERROR: DIRECTORY NAME TOO LONG - PFMKDR\n");
        return(FALSE);};

    SC_FORTRAN_STR_C(dir, dirname, *nchr);

    return((FIXNUM) PD_mkdir(file, dir));}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFPWD - FORTRAN interface routine to return currrent working directory */

FIXNUM F77_ID(pfpwd_, pfpwd, PFPWD)(fileid, nchr, cwd)
   FIXNUM *fileid, *nchr;
   F77_string cwd;
   {PDBfile *file;
    char *pwd, *lcwd;
    SC_THREAD_ID(_t_index);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);
    lcwd = SC_F77_C_STRING(cwd);

    pwd = PD_pwd(file);
    if (pwd == NULL)
       return(FALSE);

    strcpy(lcwd, pwd);
    *nchr = strlen(lcwd);

    return(TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFNCIN - FORTRAN interface routine to convert a buffer full of data 
 *          in the format of a remote machine of a different architecture
 *          to the format of the host machine.                           
 */

FIXNUM F77_ID(pfncin_, pfncin, PFNCIN)(out, in, nitems, chart, pntyp, type)
   byte *out, *in;
   FIXNUM *nitems, *chart, *pntyp;
   F77_string type;
   {char s[MAXLINE];
    HASHTAB *chrt;
    SC_THREAD_ID(_t_index);

    SC_FORTRAN_STR_C(s, type, *pntyp);

    chrt = SC_T_GET_POINTER(_t_index, HASHTAB, *chart);

    PN_conv_in(out, in, s, *nitems, chrt);

    return((FIXNUM) TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFNCOT - FORTRAN interface routine to convert a buffer full of
 *          data in the host machine format to the format of a machine
 *          with a different architecture.
 */

FIXNUM F77_ID(pfncot_, pfncot, PFNCOT)(out, in, nitems, chart, pntyp, type)
   byte *out, *in;
   FIXNUM *nitems, *chart, *pntyp;
   F77_string type;
   {char s[MAXLINE];
    HASHTAB *chrt;
    SC_THREAD_ID(_t_index);

    SC_FORTRAN_STR_C(s, type, *pntyp);

    chrt = SC_T_GET_POINTER(_t_index, HASHTAB, *chart);

    PN_conv_out(out, in, s, *nitems, chrt);

    return((FIXNUM) TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFNTGT - FORTRAN interface to a routine to allocate, initialize, and
 *          return a structure chart
 */

FIXNUM F77_ID(pfntgt_, pfntgt, PFNTGT)(pis, pia)
   FIXNUM *pis, *pia;
   {int al, st, ret;
    HASHTAB *chart;
    SC_THREAD_ID(_t_index);

    al = *pia;
    st = *pis;
    ret = (al != 6);
    if (ret)
       {chart = PN_target(PD_std_standards[st - 1], PD_std_alignments[al - 1]);
        return((FIXNUM) SC_T_ADD_POINTER(_t_index, chart));}
    else
       {sprintf(PD_ERR(_t_index),
                "ERROR: REQUESTED ALIGNMENT NO LONGER EXISTS - PFNTGT");
        return((FIXNUM) -1);}}


/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PFRDBT - FORTRAN interface to a routine to read a bitstream
 *
 */

FIXNUM F77_ID(pfrdbt_, pfrdbt, PFRDBT)(fileid, nchrnm, name, nchrtp, type, nitems, 
                                       sgned, nbits, padsz, fpp, offs, pan, pdata)
   FIXNUM *fileid, *nchrnm;
   F77_string name;
   FIXNUM *nchrtp;
   F77_string type;
   FIXNUM *nitems, *sgned, *nbits, *padsz, *fpp, *offs, *pan;
   byte *pdata;
   {PDBfile *file;
    char s[MAXLINE], t[MAXLINE];
    char *dataout;
    long numitems;
    FIXNUM ret;
    SC_THREAD_ID(_t_index);

    SC_FORTRAN_STR_C(s, name, *nchrnm);
    SC_FORTRAN_STR_C(t, type, *nchrtp);

    file = SC_T_GET_POINTER(_t_index, PDBfile, *fileid);

    numitems = *nitems;

    if ((ret = (FIXNUM) PD_read_bits(file, s, t, *nitems, *sgned, *nbits, *padsz,
                                     *fpp, *offs, (long *) pan, &dataout)))
       {if (strcmp(t, "long") == 0)
           memcpy(pdata, dataout, numitems * sizeof(long));
        else if ((strcmp(t, "int") == 0) || (strcmp(t, "integer") == 0))
           memcpy(pdata, dataout, numitems * sizeof(int));
        else if (strcmp(t, "short") == 0)
           memcpy(pdata, dataout, numitems * sizeof(short));
        else if (strcmp(t, "char")  == 0)
           memcpy(pdata, dataout, numitems);
        else
           ret = (FIXNUM)FALSE;}

    if (ret)
       SFREE(dataout);

    return(ret);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_FIA_PINIT - initialize the file static variables for
 *                 parallel execution.
 */

void _PD_fia_pinit()
  {

#ifdef HAVE_THREADS
   int i;

   if (_PD_fia_static == NULL)
      {_PD_fia_static = NMAKE_N(FILE_STATIC, _PD_nthreads,
                                "_PD_FIA_PINIT:_PD_fia_static");

       for (i = 0; i < _PD_nthreads; i++)
           {_PD_fia_static[i].outlist = NULL;
            _PD_fia_static[i].n_entries = 0;};}
#endif

   return;}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

