[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: Perl NetCDF module



Hi Mark,

>Date: Mon, 22 Jul 2002 15:48:41 -0600 (MDT)
>From: Mark Bradford <address@hidden>
>Organization: UCAR/Unidata
>To: "Steven R. Emmerson" <address@hidden>
>Subject: Perl NetCDF module
>Keywords: 200207222149.g6MLn3912771

The above message contained the following:

> Steve,
> 
> I'm trying to resuscitate my Perl-NetCDF module and PDL::NetCDF, having
> upgraded to Perl 5.6.1.  I'm seeing the results in the attached file when I
> try to install it -- any clues?  Thanks!
> 
> -- 
> Mark Bradford, Systems Administrator  <> address@hidden
> UCAR Joint Office for Science Support <> (303) 497-8169
...
> Script started on Mon Jul 22 15:44:34 2002
> sysadmin@thunder[~/src/netcdf/netcdf-perl-1.2/src]> ./configure
> loading cache ./config.cache
> checking for catman... (cached) catman
> checking for perl utility... /bin/perl
> checking for perl manual page directory... /usr/local/man
> checking for neqn... (cached) neqn
> checking for tbl... (cached) tbl
> checking for cc... (cached) cc
> checking type of operating system... sunos5
> checking for tar flags... -chof
> checking for netCDF header-file... -I/opt/include
> checking for netCDF library... -L/opt/lib -R/opt/lib -lnetcdf
> checking for package version... 1.2
> creating ./config.status
> creating Makefile
> creating perl/Makefile.PL
> creating port/master.mk
> creating port/Makefile
> expanding `include's in file `Makefile'
> expanding `include's in file `perl/Makefile.PL'
> expanding `include's in file `port/master.mk'
> expanding `include's in file `port/Makefile'
> sysadmin@thunder[~/src/netcdf/netcdf-perl-1.2/src]> make
> cd perl && /bin/perl Makefile.PL
> Checking if your kit is complete...
> Looks good
> Writing Makefile for NetCDF
> 
> making `dynamic' in directory 
> /home/sysadmin/src/netcdf/netcdf-perl-1.2/src/perl
> 
> /bin/perl -I/opt/perl/lib/5.6.1/sun4-solaris -I/opt/perl/lib/5.6.1 
> /opt/perl/lib/5.6.1/ExtUtils/xsubpp  -typemap 
> /opt/perl/lib/5.6.1/ExtUtils/typemap NetCDF.xs > NetCDF.xsc && mv NetCDF.xsc 
> NetCDF.c
> Please specify prototyping behavior for NetCDF.xs (see perlxs manual)
> cc -c -I/opt/include -I/usr/local/include -D_LARGEFILE_SOURCE 
> -D_FILE_OFFSET_BITS=64 -O    -DVERSION=\"1.2\"  -DXS_VERSION=\"1.2\" -KPIC 
> -I/opt/perl/lib/5.6.1/sun4-solaris/CORE  NetCDF.c
> "NetCDF.xs", line 823: undefined symbol: na
> "NetCDF.xs", line 823: warning: argument #2 is incompatible with prototype:
>       prototype: pointer to uint : 
> "/opt/perl/lib/5.6.1/sun4-solaris/CORE/proto.h", line 709
>       argument : pointer to int
> "NetCDF.xs", line 2251: undefined symbol: na
> "NetCDF.xs", line 2251: warning: argument #2 is incompatible with prototype:
>       prototype: pointer to uint : 
> "/opt/perl/lib/5.6.1/sun4-solaris/CORE/proto.h", line 709
>       argument : pointer to int
> cc: acomp failed for NetCDF.c
> *** Error code 2
> make: Fatal error: Command failed for target `NetCDF.o'
> Current working directory /home/sysadmin/src/netcdf/netcdf-perl-1.2/src/perl
> *** Error code 1
> make: Fatal error: Command failed for target `perl/dynamic'
> Current working directory /home/sysadmin/src/netcdf/netcdf-perl-1.2/src
> *** Error code 1
> make: Fatal error: Command failed for target `decision'
> Current working directory /home/sysadmin/src/netcdf/netcdf-perl-1.2/src
> *** Error code 1
> make: Fatal error: Command failed for target `all'
> script done on Mon Jul 22 15:45:06 2002

Interesting problem.  It's been so long since I wrote this package that
I've forgotten most of the Perl module API.  :-(

Try replacing your file "perl/NetCDF.xs" with the attachment.  Please let
know if it works.

Regards,
Steve Emmerson   <http://www.unidata.ucar.edu>

/*
 * Undocumented things I've learned about writing XSUB's:
 *
 *  1.  av_len(AV*) returns the 0-based index of the last element (i.e.
 *      the number of elements minus 1).
 *
 *  2.  My way to distinguish between a reference to a scalar value and a
 *      reference to an array value is to obtain the referenced value and
 *      then do `SvIOK(sv) || SvNOK(sv) || SvPOK(sv)'.
 *
 *  3.  av_push() doesn't copy the pointed-to values.
 *
 *  4.  Values returned via arguments must be immortal.
 */

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include <stdlib.h>     /* for malloc() */
#include <stdio.h>      /* for printing */
#include <string.h>     /* for memcpy() */
#include <assert.h>
#include "netcdf.h"

/*
 * Macro for setting a scalar value either directly or through a reference:
 */
#define SV_SET(func, var, val)  func(SvROK(var) ? SvRV(var) : var, val)


typedef enum IntType
{
    IT_UNKNOWN,
    IT_CHAR,
    IT_SHORT,
    IT_INT,
    IT_NCLONG,
    IT_LONG,
    IT_FLOAT,
    IT_DOUBLE
} IntType;


typedef struct Value
{
    IntType     type;
    union
    {
        char    c;
        short   s;
        int     i;
        nclong  n;
        long    l;
        float   f;
        double  d;
    }           datum;
} Value;


typedef struct Vector
{
    char        *data;
    long        nelt;
    IntType     type;
    int         initialized;
} Vector;


typedef struct Record
{
    void        **data;
    Vector      *vecs;
    int         nvar;
    int         initialized;
} Record;


static IntType
nctype_inttype(nctype)
    nc_type     nctype;
{
    IntType     vectype;

    switch (nctype)
    {
        case NC_BYTE:
            return IT_CHAR;
        case NC_CHAR:
            return IT_CHAR;
        case NC_SHORT:
            return IT_SHORT;
        case NC_LONG:
            return IT_NCLONG;
        case NC_FLOAT:
            return IT_FLOAT;
        case NC_DOUBLE:
            return IT_DOUBLE;
        default:
            return IT_UNKNOWN;
    }
}


static size_t
inttype_len(type)
    IntType     type;
{
    switch (type)
    {
        case IT_CHAR:
            return sizeof(char);
        case IT_SHORT:
            return sizeof(short);
        case IT_INT:
            return sizeof(int);
        case IT_NCLONG:
            return sizeof(nclong);
        case IT_LONG:
            return sizeof(long);
        case IT_FLOAT:
            return sizeof(float);
        case IT_DOUBLE:
            return sizeof(double);
        default:
            return 0;
    }
}


/*
 * Initialize a value from a specification.
 */
static void
value_initspec(value, type)
    Value       *value;
    IntType     type;
{
    value->type = type;
}


/*
 * Initialize a value structure from a perl reference value.
 */
static void
value_initref(value, type, ref)
    Value       *value;
    IntType     type;
    SV *        ref;
{
    value->type = type;

    switch (type)
    {
        case IT_CHAR:
            value->datum.c = SvIV(ref);
            break;
        case IT_SHORT:
            value->datum.s = SvIV(ref);
            break;
        case IT_INT:
            value->datum.i = SvIV(ref);
            break;
        case IT_NCLONG:
            value->datum.n = SvIV(ref);
            break;
        case IT_LONG:
            value->datum.l = SvIV(ref);
            break;
        case IT_FLOAT:
            value->datum.f = SvNV(ref);
            break;
        case IT_DOUBLE:
            value->datum.d = SvNV(ref);
            break;
    }
}


/*
 * Print a value structure.
 */
static void
value_print(value, stream, prefix)
    Value       *value;
    FILE        *stream;
    char        *prefix;
{
    (void) fprintf(stream, "%sType: ", prefix);

    switch (value->type)
    {
        case IT_CHAR:
            (void) fputs("IT_CHAR\n", stream);
            (void) fprintf(stream, "%sValue: %d\n",
                           prefix, value->datum.c);
            break;
        case IT_SHORT:
            (void) fputs("IT_SHORT\n", stream);
            (void) fprintf(stream, "%sValue: %d\n",
                           prefix, value->datum.s);
            break;
        case IT_INT:
            (void) fputs("IT_INT\n", stream);
            (void) fprintf(stream, "%sValue: %d\n",
                           prefix, value->datum.i);
            break;
        case IT_NCLONG:
            (void) fputs("IT_NCLONG\n", stream);
            (void) fprintf(stream, "%sValue: %ld\n",
                           prefix, (long)value->datum.n);
            break;
        case IT_LONG:
            (void) fputs("IT_LONG\n", stream);
            (void) fprintf(stream, "%sValue: %ld\n",
                           prefix, value->datum.l);
            break;
        case IT_FLOAT:
            (void) fputs("IT_FLOAT\n", stream);
            (void) fprintf(stream, "%sValue: %g\n",
                           prefix, value->datum.f);
            break;
        case IT_DOUBLE:
            (void) fputs("IT_DOUBLE\n", stream);
            (void) fprintf(stream, "%sValue: %g\n",
                           prefix, value->datum.d);
            break;
    }
}


/*
 * Initialize a perl scalar value from a value structure.
 */
static void
sv_initvalue(scalar, value)
    SV          *scalar;
    Value       *value;
{
    switch (value->type)
    {
        case IT_CHAR:
            sv_setiv(scalar, (IV)value->datum.c);
            break;
        case IT_SHORT:
            sv_setiv(scalar, (IV)value->datum.s);
            break;
        case IT_INT:
            sv_setiv(scalar, (IV)value->datum.i);
            break;
        case IT_NCLONG:
            sv_setiv(scalar, (IV)value->datum.n);
            break;
        case IT_LONG:
            sv_setiv(scalar, (IV)value->datum.l);
            break;
        case IT_FLOAT:
            sv_setnv(scalar, (double)value->datum.f);
            break;
        case IT_DOUBLE:
            sv_setnv(scalar, (double)value->datum.d);
            break;
    }
}


/*
 * Initialize a perl scalar value from an internal vector structure.
 *
 * Returns:
 *      1       Success
 *      0       Error
 */
static int
sv_initvec(sv, vec)
    SV          *sv;
    Vector      *vec;
{
    int         ok = 0;                         /* error */

    if (vec->type != IT_CHAR && vec->nelt != 1)
        warn("Can't convert multi-element vector to scalar");
    else
    {
        switch (vec->type)
        {
            case IT_CHAR:
                sv_setpvn(sv, (char*)vec->data, (int)vec->nelt);
                break;
            case IT_SHORT:
                sv_setiv(sv, (IV)*(short*)vec->data);
                break;
            case IT_INT:
                sv_setiv(sv, (IV)*(int*)vec->data);
                break;
            case IT_NCLONG:
                sv_setiv(sv, (IV)*(nclong*)vec->data);
                break;
            case IT_LONG:
                sv_setiv(sv, (IV)*(long*)vec->data);
                break;
            case IT_FLOAT:
                sv_setnv(sv, (double)*(float*)vec->data);
                break;
            case IT_DOUBLE:
                sv_setnv(sv, (double)*(double*)vec->data);
                break;
        }

        ok = 1;
    }

    return ok;
}


/*
 * Destroy a perl reference value.
 */
static void
ref_destroy(ref)
    SV  *ref;
{
    sv_2mortal(ref);
}


/*
 * Initialize a perl array value from a vector.
 */
static int
av_initvec(av, vec)
    AV          *av;
    Vector      *vec;
{
    av_clear(av);       /* delete all elements in the AV */

    switch (vec->type)
    {
        case IT_CHAR:
        {
            char        *ptr = (char*)vec->data;
            char        *end = ptr + vec->nelt;

            for (; ptr < end; ++ptr)
                av_push(av, newSViv((IV)*ptr));
            break;
        }
        case IT_SHORT:
        {
            short       *ptr = (short*)vec->data;
            short       *end = ptr + vec->nelt;

            for (; ptr < end; ++ptr)
                av_push(av, newSViv((IV)*ptr));
            break;
        }
        case IT_INT:
        {
            int *ptr = (int*)vec->data;
            int *end = ptr + vec->nelt;

            for (; ptr < end; ++ptr)
                av_push(av, newSViv((IV)*ptr));
            break;
        }
        case IT_NCLONG:
        {
            nclong      *ptr = (nclong*)vec->data;
            nclong      *end = ptr + vec->nelt;

            for (; ptr < end; ++ptr)
                av_push(av, newSViv((IV)*ptr));
            break;
        }
        case IT_LONG:
        {
            long        *ptr = (long*)vec->data;
            long        *end = ptr + vec->nelt;

            for (; ptr < end; ++ptr)
                av_push(av, newSViv((IV)*ptr));
            break;
        }
        case IT_FLOAT:
        {
            float       *ptr = (float*)vec->data;
            float       *end = ptr + vec->nelt;

            for (; ptr < end; ++ptr)
                av_push(av, newSVnv((double)*ptr));
            break;
        }
        case IT_DOUBLE:
        {
            double      *ptr = (double*)vec->data;
            double      *end = ptr + vec->nelt;

            for (; ptr < end; ++ptr)
                av_push(av, newSVnv((double)*ptr));
            break;
        }
    }

    return 1;
}


/*
 * Destroy a perl(1) array value.
 */
static void
av_destroy(av)
    AV          *av;
{
    av_undef(av);
}


/*
 * Destroy a perl scalar value.
 */
static void
sv_destroy(sv)
    SV          *sv;
{
    sv_2mortal(sv);
}


/*
 * Initialize a perl(1) reference from a vector structure.  The referenced
 * value shall exist.
 *
 * Returns:
 *      0       Error
 *      1       Success
 */
static int
ref_initvec(ref, vec)
    SV          *ref;                   /* a perl(1) reference (in/out) */
    Vector      *vec;                   /* vector of values (in) */
{
    int         ok = 0;                 /* error */
    SV          *sv;

    sv = SvRV(ref);

    if (SvOK(sv) || SvIOK(sv) || SvNOK(sv) || SvPOK(sv))
    {
        /*
         * The referenced value is scalar.
         */
        if (sv_initvec(sv, vec))
            ok = 1;
    }
    else
    {
        /*
         * The referenced value must be an array.
         */
        AV      *av = (AV*)sv;

        if (av_initvec(av, vec))
            ok = 1;
    }

    return ok;
}


/*
 * Return a new perl(1) reference that has been initialized from a vector
 * structure.
 *
 * Returns:
 *       NULL   Error
 *      !NULL   Success
 */
static SV*
ref_newvec(vec)
    Vector      *vec;                   /* vector of values (in) */
{
    SV          *ref = NULL;

    if (vec->type == IT_CHAR)
    {
        /*
         * Generate a perl string from the vector structure.
         */
        SV      *sv;

        sv = newSVpv((char*)vec->data, (int)vec->nelt);

        if (sv == NULL)
            warn("Couldn't allocate new perl string value");
        else
        {
            ref = newRV(sv);
            if (ref == NULL)
            {
                sv_destroy(sv);
                warn("Couldn't allocate new perl reference to string value");
            }
        }
    }
    else
    {
        /*
         * Generate a perl array value from the vector structure.
         */
        AV      *av = newAV();

        if (av == NULL)
            warn("Couldn't allocate new perl array value");
        else
        {
            int ok = 0;

            if (av_initvec(av, vec))
            {
                ref = newRV((SV*)av);

                if (ref != NULL)
                    ok = 1;                     /* success */
            }

            if (!ok)
                av_destroy(av);
        }                                       /* new AV obtained */
    }

    return ref;
}


/*
 * Initialize a perl(1) array value from a record structure.
 *
 * Returns:
 *      0       Error
 *      1       Success
 */
static int
av_initrec(av, rec)
    AV          *av;
    Record      *rec;
{
    int         ivar;
    int         ok = 0;                         /* error */
    int         nelt = av_len(av) + 1;

    if (nelt && nelt != rec->nvar)
    {
        (void) fprintf(stderr, "av_initrec(): nvar=%d, nref=%d\n", 
                       rec->nvar, nelt);
        warn("Number of record variables doesn't match number of references");
    }
    else if (nelt == 0)
    {
        /*
         * The array is empty.  Create references and add them.
         */
        for (ivar = 0; ivar < rec->nvar; ++ivar)
        {
            SV  *ref = ref_newvec(&rec->vecs[ivar]);

            if (ref == NULL)
                break;

            av_push(av, ref);
        }

        if (ivar >= rec->nvar)
            ok = 1;
        else
        {
            /* ivar is the index of the reference that wasn't initialized. */
            while (ivar--)
                ref_destroy(av_pop(av));
        }
    }
    else
    {
        /*
         * The array contains the correct number of references.  Put the
         * data in the referenced variables.
         */
        for (ivar = 0; ivar < rec->nvar; ++ivar)
        {
            SV  **ref = av_fetch(av, (I32)ivar, (I32)0);

            if (!SvROK(*ref))
            {
                warn("Array value member is not a reference");
                break;
            }
            else
            {
                SV      *sv = SvRV(*ref);

                if (SvIOK(sv) || SvNOK(sv) || SvPOK(sv))
                {
                    /*
                     * The perl reference refers to a scalar value.
                     */
                    if (!sv_initvec(sv, &rec->vecs[ivar]))
                        break;
                }
                else
                {
                    /*
                     * The referenced variable is undefined or the 
                     * reference refers to an array value.
                     */
                    AV  *av = (AV*)sv;

                    if (!av_initvec(av, &rec->vecs[ivar]))
                        break;
                }
            }
        }

        if (ivar >= rec->nvar)
            ok = 1;
    }

    return ok;
}


/*
 * Initialize a perl(1) reference variable from a record structure.
 *
 * Returns:
 *      0       Error
 *      1       Success
 */
static int
ref_initrec(ref, rec)
    SV          **ref;
    Record      *rec;
{
    int         ok = 0;                         /* error */
    AV          *av = newAV();

    if (av == NULL)
        warn("Couldn't allocate new perl array value");
    else
    {
        int     ivar;

        for (ivar = 0; ivar < rec->nvar; ++ivar)
        {
            SV  *eltref = ref_newvec(&rec->vecs[ivar]);

            if (eltref == NULL)
                break;

            av_push(av, eltref);
        }

        if (ivar < rec->nvar)
        {
            /* ivar is the index of the reference that wasn't initialized. */
            while (ivar--)
                ref_destroy(av_pop(av));
        }
        else
        {
            SV  *sv = newRV((SV*)av);

            if (sv == NULL)
                warn("Couldn't allocate new perl reference value");
            else
            {
                *ref = sv;
                ok = 1;
            }
        }
    }

    return ok;
}


/*
 * Return total number of data elements for a perl value.
 *
 * Recursive function.
 */
static long
pv_nelt(pv, type)
    SV          *pv;
    IntType     type;
{
    long        ntotal;

    if (SvROK(pv))
    {
        /*
         * The scalar variable is a perl reference.
         */
        ntotal = pv_nelt(SvRV(pv), type);
    }
    else
    {
        /*
         * The scalar variable is not a perl reference.
         */
        if (SvIOK(pv) || SvNOK(pv))
        {
            /*
             * The scalar variable is a numeric value.
             */
            ntotal = 1;
        }
        else
        if (SvPOK(pv))
        {
            /*
             * The scalar value is a string.
             */
            ntotal = type == IT_CHAR
                        ? SvCUR(pv)
                        : 1;
        }
        else
        {
            /*
             * The `scalar variable' must be an array value.
             */
            AV          *list;
            int         nelt;
            int         i;

            list = (AV*)pv;
            nelt = av_len(list) + 1;
            ntotal = 0;

#           if 0
                (void) fprintf(stderr, "pv_nelt(): nelt=%d\n", nelt);
#           endif

            for (i = 0; i < nelt; ++i)
            {
                SV      **sv;

#               if NP_DIAG_REF_NELT
                    (void) fprintf(stderr, "pv_nelt(): handling element %d\n",
                                   i);
#               endif

                sv = av_fetch(list, (I32)i, (I32)0);

                ntotal += pv_nelt(*sv, type);
            }
        }
    }

    return ntotal;
}


/*
 * Extract the data portion of a perl(1) value into contiguous memory.
 *
 * Recursive function.
 *
 * Can't fail.
 */
static char*
pv_data(pv, type, data)
    SV          *pv;
    IntType     type;
    char        *data;                  /* SHALL have sufficient room */
{
    if (SvROK(pv))
    {
        /*
         * The perl value is a perl reference.
         */
        data = pv_data(SvRV(pv), type, data);
    }
    else
    if (!SvIOK(pv) && !SvNOK(pv) && !SvPOK(pv))
    {
        /*
         * The perl value must be an array value.
         */
        AV      *list;
        int     n;
        int     i;

        list = (AV*)pv;
        n = av_len(list) + 1;

        for (i = 0; i < n; ++i)
        {
            SV  **sv;

#           if NP_DIAG_REF_DATA
                (void) fprintf(stderr, "pv_data(): handling element %d\n", i);
#           endif

            sv = av_fetch(list, (I32)i, (I32)0);

            data = pv_data(*sv, type, data);
        }
    }
    else
    {
        /*
         * The perl value is a scalar value.
         */
        switch (type)
        {
            case IT_CHAR:
            {
                if (SvPOK(pv))
                {
                    (void) memcpy(
                        (char*)data, SvPV_nolen(pv), (size_t)SvCUR(pv));
                    data += SvCUR(pv);
                }
                else
                {
                    *(char*)data = SvIV(pv);
                    data += sizeof(char);
                }
                break;
            }
            case IT_SHORT:
            {
                *(short*)data = SvIV(pv);
                data += sizeof(short);
                break;
            }
            case IT_INT:
            {
                *(int*)data = SvIV(pv);
                data += sizeof(int);
                break;
            }
            case IT_NCLONG:
            {
                *(nclong*)data = SvIV(pv);
                data += sizeof(nclong);
                break;
            }
            case IT_LONG:
            {
                *(long*)data = SvIV(pv);
                data += sizeof(long);
                break;
            }
            case IT_FLOAT:
            {
                *(float*)data = SvNV(pv);
                data += sizeof(float);
                break;
            }
            case IT_DOUBLE:
            {
                *(double*)data = SvNV(pv);
                data += sizeof(double);
                break;
            }
        }
    }

    return data;
}


/*
 * Destroy a vector structure.
 */
static void
vec_destroy(vec)
    Vector      *vec;
{
    if (vec->data != NULL)
    {
        free((char*)vec->data);
        vec->data = NULL;
    }
    vec->type = 0;
    vec->nelt = 0;
    vec->initialized = 0;
}


/*
 * Initialize a vector structure from a perl(1) reference.
 */
static void
vec_initref(vec, type, ref)
    Vector      *vec;
    IntType     type;
    SV          *ref;
{
    size_t      nelt;
    char        *data;

#   if 0
        (void) fprintf(stderr, "vec_initref(): type=%d\n", (int)type);
#   endif

    nelt = pv_nelt(ref, type);
#   if 0
        (void) fprintf(stderr, "vec_initref(): nelt=%lu\n",
                       (unsigned long)nelt);
#   endif
    data = (char*)malloc(nelt * inttype_len(type));

    vec->initialized = 0;
    vec->nelt = 0;
    vec->data = 0;

    if (data == NULL)
    {
        warn("Couldn't allocate memory for vector data");
    }
    else
    {
        (void) pv_data(ref, type, data);

        vec->data = data;
        vec->type = type;
        vec->nelt = nelt;
        vec->initialized = 1;
    }
}


/*
 * Initialize a vector structure from a specification.
 */
static void
vec_initspec(vec, type, nelt)
    Vector      *vec;
    IntType     type;
    long        nelt;
{
    char        *data = malloc((size_t)(nelt * inttype_len(type)));

    if (data == NULL)
        warn("Couldn't allocate memory for vector structure");
    else
    {
            vec->data = data;
            vec->type = type;
            vec->nelt = nelt;
            vec->initialized = 1;
    }
}


/*
 * Initialize a record-variable vector-structure from a perl reference
 * and a netCDF dataset.  The pearl reference must match the netCDF record.
 */
static void
vec_initrecref(vec, ref, ncid, varid)
    Vector      *vec;
    SV          *ref;
    int         ncid;
    int         varid;
{
    nc_type     nctype;
    int         ndim;
    int         dimids[MAX_NC_DIMS];

#   if NP_DIAG_VEC_INITRECREF
        (void) fprintf(stderr, "vec_initrecref(): ncid=%d, varid=%d\n",
                       ncid, varid);
#   endif

    if (ncvarinq(ncid, varid, (char*)0, &nctype, &ndim, dimids, (int*)0)
        != -1)
    {
        vec_initref(vec, nctype_inttype(nctype), ref);

        if (vec->initialized)
        {
            int ok = 0;

            if (vec->nelt == 0)
            {
                /* Empty record variable. */
                ok = 1;
            }
            else
            {
                int     idim;
                long    nelt = 1;

                for (idim = 1; idim < ndim; ++idim)
                {
                    long        length;

                    if (ncdiminq(ncid, dimids[idim], (char*)0, &length) ==
                        -1)
                    {
                        break;
                    }

                    nelt *= length;
                }

#               if 0
                    (void) fprintf(stderr,
                        "vec_initrecref(): vec->nelt=%d, nelt=%d\n",
                        vec->nelt, nelt);
#               endif

                if (idim >= ndim)
                {
                    if (vec->nelt != nelt)
                        warn("perl/netCDF record variable size mismatch");
                    else
                        ok = 1;
                }
            }

            if (!ok)
                vec_destroy(vec);
        }                                       /* vector initialized */
    }                                           /* variable info obtained */
}


/*
 * Initialize a vector structure from a record variable.
 *
 * The values are read into the vector.
 */
static void
vec_initrec(vec, ncid, varid, recid)
    Vector      *vec;
    int         ncid;
    int         varid;
    long        recid;
{
    int         ndim;
    int         dimids[MAX_NC_DIMS];
    nc_type     nctype;

    vec->type = 0;
    vec->nelt = 0;
    vec->data = NULL;
    vec->initialized = 0;

    if (ncvarinq(ncid, varid, (char*)0, &nctype, &ndim, dimids, (int*)0) != -1)
    {
        int     idim;
        long    count[MAX_NC_DIMS];
        long    nelt = 1;

        /* Skip dimension 0, which must be the record dimension. */
        count[0] = 1;
        for (idim = 1; idim < ndim; ++idim)
        {
            if (ncdiminq(ncid, dimids[idim], (char*)NULL, count+idim) == -1)
                break;
            nelt *= count[idim];
        }

        if (idim >= ndim)
        {
            vec_initspec(vec, nctype_inttype(nctype), nelt);
            if (vec->initialized)
            {
                static long     start[MAX_NC_DIMS];

                start[0] = recid;

                if (ncvarget(ncid, varid, start, count, vec->data) == -1)
                    vec_destroy(vec);
            }
        }
    }
}


/*
 * Compute the integer product of the elements of a vector structure.
 */
static long
vec_prod(vec)
    Vector      *vec;
{
    char        *data = vec->data;
    char        *out = vec->data + vec->nelt * inttype_len(vec->type);
    long        prod = 1;

    switch (vec->type)
    {
        case IT_CHAR:
        {
            char        *ptr = (char*)data;
            char        *end = (char*)out;

            while (ptr < end)
                prod *= *ptr++;
            break;
        }
        case IT_SHORT:
        {
            short       *ptr = (short*)data;
            short       *end = (short*)out;

            while (ptr < end)
                prod *= *ptr++;
            break;
        }
        case IT_INT:
        {
            int         *ptr = (int*)data;
            int         *end = (int*)out;

            while (ptr < end)
                prod *= *ptr++;
            break;
        }
        case IT_NCLONG:
        {
            nclong      *ptr = (nclong*)data;
            nclong      *end = (nclong*)out;

            while (ptr < end)
                prod *= *ptr++;
            break;
        }
        case IT_LONG:
        {
            long        *ptr = (long*)data;
            long        *end = (long*)out;

            while (ptr < end)
                prod *= *ptr++;
            break;
        }
        case IT_FLOAT:
        {
            float       *ptr = (float*)data;
            float       *end = (float*)out;

            while (ptr < end)
                prod *= *ptr++;
            break;
        }
        case IT_DOUBLE:
        {
            double      *ptr = (double*)data;
            double      *end = (double*)out;

            while (ptr < end)
                prod *= *ptr++;
            break;
        }
    }

    return prod;
}


/*
 * Print a vector structure.
 */
static void
vec_print(vec, stream, prefix)
    Vector      *vec;
    FILE        *stream;
    char        *prefix;
{
    if (!vec->initialized)
        warn("vec_print(): Vector not initialized");
    else
    {
        (void) fprintf(stream, "%sVector type = %s\n",
                       prefix,
                       vec->type == IT_CHAR
                            ? "IT_CHAR"
                            : vec->type == IT_SHORT
                                ? "IT_SHORT"
                                : vec->type == IT_INT
                                    ? "IT_INT"
                                    : vec->type == IT_NCLONG
                                        ? "IT_NCLONG"
                                        : vec->type == IT_LONG
                                            ? "IT_LONG"
                                            : vec->type == IT_FLOAT
                                                ? "IT_FLOAT"
                                                : vec->type == IT_DOUBLE
                                                    ? "IT_DOUBLE"
                                                    : "UNKNOWN");
        (void) fprintf(stream, "%sVector size = %ld\n", prefix, vec->nelt);
        (void) fprintf(stream, "%sValues = ", prefix);
        switch (vec->type)
        {
            case IT_CHAR:
            {
                char    *ptr = (char*)vec->data;
                char    *out = ptr + vec->nelt;

                for (; ptr < out; ++ptr)
                    (void) fprintf(stream, "%d ", *ptr);
                break;
            }
            case IT_SHORT:
            {
                short   *ptr = (short*)vec->data;
                short   *out = ptr + vec->nelt;

                for (; ptr < out; ++ptr)
                    (void) fprintf(stream, "%d ", *ptr);
                break;
            }
            case IT_INT:
            {
                int     *ptr = (int*)vec->data;
                int     *out = ptr + vec->nelt;

                for (; ptr < out; ++ptr)
                    (void) fprintf(stream, "%d ", *ptr);
                break;
            }
            case IT_NCLONG:
            {
                nclong  *ptr = (nclong*)vec->data;
                nclong  *out = ptr + vec->nelt;

                for (; ptr < out; ++ptr)
                    (void) fprintf(stream, "%ld ", *ptr);
                break;
            }
            case IT_LONG:
            {
                long    *ptr = (long*)vec->data;
                long    *out = ptr + vec->nelt;

                for (; ptr < out; ++ptr)
                    (void) fprintf(stream, "%ld ", *ptr);
                break;
            }
            case IT_FLOAT:
            {
                float   *ptr = (float*)vec->data;
                float   *out = ptr + vec->nelt;

                for (; ptr < out; ++ptr)
                    (void) fprintf(stream, "%g ", *ptr);
                break;
            }
            case IT_DOUBLE:
            {
                double  *ptr = (double*)vec->data;
                double  *out = ptr + vec->nelt;

                for (; ptr < out; ++ptr)
                    (void) fprintf(stream, "%g ", *ptr);
                break;
            }
        }                                       /* type switch */
        (void) putc('\n', stream);
    }                                           /* vector was initialized */
}


/*
 * Initialize a record from a reference and a netCDF dataset.
 */
static void
rec_initref(rec, ref, ncid)
    Record      *rec;
    SV          *ref;
    int         ncid;
{
    AV          *list = (AV*)SvRV(ref);
    int         nvar = av_len(list) + 1;
    int         *varids   = (int*)   malloc((size_t)(nvar*sizeof(int*)));
    long        *varsizes = (long*)  malloc((size_t)(nvar*sizeof(long)));
    void        **data    = (void**) malloc((size_t)(nvar*sizeof(void*)));
    Vector      *vecs     = (Vector*)malloc((size_t)(nvar*sizeof(Vector)));

#   if NP_DIAG_REC_INITREF
        (void) fprintf(stderr, "rec_initref(): ncid=%d\n", ncid);
#   endif

    rec->data = NULL;
    rec->vecs = NULL;
    rec->nvar = 0;
    rec->initialized = 0;

    if (vecs == NULL || data == NULL || varids == NULL || varsizes == NULL)
        warn("Couldn't allocate memory for record variables");
    else
    {
        int     ncnvar;

        if (ncrecinq(ncid, &ncnvar, varids, varsizes) != -1)
        {
            if (ncnvar != nvar)
                warn("perl/netCDF record mismatch");
            else
            {
                int     ivar;

                for (ivar = 0; ivar < nvar; ++ivar)
                {
                    SV  **sv;

#                   if NP_DIAG_REC_INITREF
                        (void) fprintf(stderr, 
                                       "rec_initref(): handling variable %d\n",
                                       ivar);
#                   endif

                    sv = av_fetch(list, (I32)ivar, (I32)0);

                    if (!SvROK(*sv))
                    {
                        warn("Invalid perl record structure");
                        break;
                    }

                    vec_initrecref(&vecs[ivar], *sv, ncid, varids[ivar]);
                    if (!vecs[ivar].initialized)
                        break;

#                   if NP_DIAG_REC_INITREF
                        (void) fputs("Record vector:\n", stderr);
                        vec_print(&vecs[ivar], stderr, "    ");
#                   endif

                    data[ivar] = vecs[ivar].nelt == 0
                                    ? NULL
                                    : (void*)vecs[ivar].data;
                }                               /* variable loop */

                if (ivar < nvar)
                {
                    /*
                     * ivar is the index of the vector that wasn't initialized.
                     */
                    while (ivar--)
                        vec_destroy(&vecs[ivar]);
                }
                else
                {
                    rec->data = data;
                    rec->vecs = vecs;
                    rec->nvar = nvar;
                    rec->initialized = 1;
                }
            }                                   /* same number variables */
        }                                       /* record info obtained */
    }                                           /* memory allocated */

    if (varids != NULL)
        free((char*)varids);
    if (varsizes != NULL)
        free((char*)varsizes);
    if (!rec->initialized)
    {
        if (data != NULL)
            free((char*)data);
        if (vecs != NULL)
            free((char*)vecs);
    }
}


/*
 * Initialize a record structure from a netCDF dataset.
 */
rec_initnc(rec, ncid, recid)
    Record      *rec;
    int         ncid;
    long        recid;
{
    int         nvar;

    rec->data = NULL;
    rec->vecs = NULL;
    rec->nvar = 0;
    rec->initialized = 0;

    if (ncrecinq(ncid, &nvar, (int*)NULL, (long*)NULL) != -1)
    {
        int     *varids   = (int*)   malloc((size_t)(nvar*sizeof(int)));
        long    *varsizes = (long*)  malloc((size_t)(nvar*sizeof(long)));
        void    **data    = (void**) malloc((size_t)(nvar*sizeof(void*)));
        Vector  *vecs     = (Vector*)malloc((size_t)(nvar*sizeof(Vector)));

        if (varids == NULL || data == NULL || 
            varsizes == NULL || vecs == NULL)
        {
            warn("Couldn't allocate memory for record variables");
        }
        else if (ncrecinq(ncid, &nvar, varids, varsizes) != -1)
        {
            int ivar;

            for (ivar = 0; ivar < nvar; ++ivar)
            {
                vec_initrec(&vecs[ivar], ncid, varids[ivar], recid);
                if (!vecs[ivar].initialized)
                    break;

                data[ivar] = (void*)vecs[ivar].data;
            }

            if (ivar < nvar)
            {
                /* ivar is the index of the vector that wasn't initialized. */
                while (ivar--)
                    vec_destroy(&vecs[ivar]);
            }
            else
            {
                rec->data = data;
                rec->vecs = vecs;
                rec->nvar = nvar;
                rec->initialized = 1;
            }
        }

        if (varids != NULL)
            free((char*)varids);
        if (varsizes != NULL)
            free((char*)varsizes);
        if (!rec->initialized)
        {
            if (data != NULL)
                free((char*)data);
            if (vecs != NULL)
                free((char*)vecs);
        }
    }
}


/*
 * Destroy a record.
 */
static void
rec_destroy(rec)
    Record      *rec;
{
    if (rec->data != NULL)
    {
        free((char*)rec->data);
        rec->data = NULL;
    }

    if (rec->vecs != NULL)
    {
        int     ivar;

        for (ivar = 0; ivar < rec->nvar; ++ivar)
            vec_destroy(&rec->vecs[ivar]);

        free((char*)rec->vecs);
        rec->vecs = NULL;
    }

    rec->nvar = 0;
    rec->initialized = 0;
}


/*
 * Print a record.
 */
static void
rec_print(rec, stream, prefix)
    Record      *rec;
    FILE        *stream;
    char        *prefix;
{
    if (!rec->initialized)
    {
        warn("rec_print(): Record not initialized");
    }
    else
    {
        int     ivar;

        (void) fprintf(stream, "%sNumber of variables = %d\n", 
                       prefix, rec->nvar);

        for (ivar = 0; ivar < rec->nvar; ++ivar)
        {
            char        buf[128];

            (void) fprintf(stream, "%sRecord variable %d:\n", prefix, ivar);

            (void) strcat(strcpy(buf, prefix), "    ");

            vec_print(&rec->vecs[ivar], stream, buf);

            (void) fprintf(stream, "%sData pointers: %p ?= %p\n", 
                           buf, rec->data[ivar], rec->vecs[ivar].data);
        }
    }
}


static int
not_here(s)
char *s;
{
    warn("%s not implemented on this architecture", s);
    return -1;
}

static double
constant(name, arg)
char *name;
int arg;
{
#if 0
    (void)printf("constant(): name=\"%s\", arg=%d\n", name, arg);
#endif
    errno = 0;
    switch (*name) {
    case 'A':
        break;
    case 'B':
        if (strEQ(name, "BYTE"))
            return NC_BYTE;
        break;
    case 'C':
        if (strEQ(name, "CHAR"))
            return NC_CHAR;
        if (strEQ(name, "CLOBBER"))
            return NC_CLOBBER;
        break;
    case 'D':
        if (strEQ(name, "DOUBLE"))
            return NC_DOUBLE;
        break;
    case 'E':
        if (strEQ(name, "EBADDIM"))
            return NC_EBADDIM;
        if (strEQ(name, "EBADID"))
            return NC_EBADID;
        if (strEQ(name, "EBADTYPE"))
            return NC_EBADTYPE;
        if (strEQ(name, "EEXIST"))
            return NC_EEXIST;
        if (strEQ(name, "EGLOBAL"))
            return NC_EGLOBAL;
        if (strEQ(name, "EINDEFINE"))
            return NC_EINDEFINE;
        if (strEQ(name, "EINVAL"))
            return NC_EINVAL;
        if (strEQ(name, "EINVALCOORDS"))
            return NC_EINVALCOORDS;
        if (strEQ(name, "EMAXATTS"))
            return NC_EMAXATTS;
        if (strEQ(name, "EMAXDIMS"))
            return NC_EMAXDIMS;
        if (strEQ(name, "EMAXNAME"))
            return NC_EMAXNAME;
        if (strEQ(name, "EMAXVARS"))
            return NC_EMAXVARS;
        if (strEQ(name, "ENAMEINUSE"))
            return NC_ENAMEINUSE;
        if (strEQ(name, "ENFILE"))
            return NC_ENFILE;
        if (strEQ(name, "ENOTATT"))
            return NC_ENOTATT;
        if (strEQ(name, "ENOTINDEFINE"))
            return NC_ENOTINDEFINE;
        if (strEQ(name, "ENOTNC"))
            return NC_ENOTNC;
        if (strEQ(name, "ENOTVAR"))
            return NC_ENOTVAR;
        if (strEQ(name, "ENTOOL"))
            return NC_ENTOOL;
        if (strEQ(name, "EPERM"))
            return NC_EPERM;
        if (strEQ(name, "ESTS"))
            return NC_ESTS;
        if (strEQ(name, "EUNLIMIT"))
            return NC_EUNLIMIT;
        if (strEQ(name, "EUNLIMPOS"))
            return NC_EUNLIMPOS;
        if (strEQ(name, "EXDR"))
            return NC_EXDR;
        break;
    case 'F':
        if (strEQ(name, "FATAL"))
            return NC_FATAL;
        if (strEQ(name, "FILL"))
            return NC_FILL;
        if (strEQ(name, "FILL_BYTE"))
            return FILL_BYTE;
        if (strEQ(name, "FILL_CHAR"))
            return FILL_CHAR;
        if (strEQ(name, "FILL_DOUBLE"))
            return FILL_DOUBLE;
        if (strEQ(name, "FILL_FLOAT"))
            return FILL_FLOAT;
        if (strEQ(name, "FILL_LONG"))
            return FILL_LONG;
        if (strEQ(name, "FILL_SHORT"))
            return FILL_SHORT;
        if (strEQ(name, "FLOAT"))
            return NC_FLOAT;
        break;
    case 'G':
        if (strEQ(name, "GLOBAL"))
            return NC_GLOBAL;
        break;
    case 'H':
        break;
    case 'I':
        break;
    case 'J':
        break;
    case 'K':
        break;
    case 'L':
        if (strEQ(name, "LONG"))
            return NC_LONG;
        break;
    case 'M':
        if (strEQ(name, "MAX_ATTRS"))
            return MAX_NC_ATTRS;
        if (strEQ(name, "MAX_DIMS"))
            return MAX_NC_DIMS;
        if (strEQ(name, "MAX_NAME"))
            return MAX_NC_NAME;
        if (strEQ(name, "MAX_OPEN"))
            return MAX_NC_OPEN;
        if (strEQ(name, "MAX_VARS"))
            return MAX_NC_VARS;
        if (strEQ(name, "MAX_VAR_DIMS"))
            return MAX_VAR_DIMS;
        break;
    case 'N':
        if (strEQ(name, "NOCLOBBER"))
            return NC_NOCLOBBER;
        if (strEQ(name, "NOERR"))
            return NC_NOERR;
        if (strEQ(name, "NOFILL"))
            return NC_NOFILL;
        if (strEQ(name, "NOWRITE"))
            return NC_NOWRITE;
        break;
    case 'O':
        break;
    case 'P':
        break;
    case 'Q':
        break;
    case 'R':
        break;
    case 'S':
        if (strEQ(name, "SHORT"))
            return NC_SHORT;
        if (strEQ(name, "SYSERR"))
            return NC_SYSERR;
        break;
    case 'T':
        break;
    case 'U':
        if (strEQ(name, "UNLIMITED"))
            return NC_UNLIMITED;
        break;
    case 'V':
        if (strEQ(name, "VERBOSE"))
            return NC_VERBOSE;
        break;
    case 'W':
        if (strEQ(name, "WRITE"))
            return NC_WRITE;
        break;
    case 'X':
        if (strEQ(name, "XDR_D_INFINITY"))
#ifdef XDR_D_INFINITY
            return XDR_D_INFINITY;
#else
            goto not_there;
#endif
        if (strEQ(name, "XDR_F_INFINITY"))
#ifdef XDR_F_INFINITY
            return XDR_F_INFINITY;
#else
            goto not_there;
#endif
        break;
    case 'Y':
        break;
    case 'Z':
        break;
    case 'a':
        break;
    case 'b':
        break;
    case 'c':
        break;
    case 'd':
        break;
    case 'e':
        break;
    case 'f':
        break;
    case 'g':
        break;
    case 'h':
        break;
    case 'i':
        break;
    case 'j':
        break;
    case 'k':
        break;
    case 'l':
        break;
    case 'm':
        break;
    case 'n':
        break;
    case 'o':
        break;
    case 'p':
        break;
    case 'q':
        break;
    case 'r':
        break;
    case 's':
        break;
    case 't':
        break;
    case 'u':
        break;
    case 'v':
        break;
    case 'w':
        break;
    case 'x':
        break;
    case 'y':
        break;
    case 'z':
        break;
    case '_':
        break;
    }
    errno = EINVAL;
    return 0;

not_there:
    errno = ENOENT;
    return 0;
}


MODULE = NetCDF         PACKAGE = NetCDF        PREFIX=nc

double
constant(name,arg)
        char *          name
        int             arg


################################################################################
# netCDF control operations:
#

int
nccreate(path, cmode)
    char *      path
    int         cmode


int
ncopen(path, mode)
    char *      path
    int         mode
    CODE:
    {
        /*
        (void) fprintf(stderr, "ncopen(): path=\"%s\", mode=%d\n",
                       path, mode);
        */

        RETVAL = ncopen(path, mode);
    }
    OUTPUT:
        RETVAL


int
ncredef(ncid)
    int         ncid


int
ncendef(ncid)
    int         ncid


int
ncclose(ncid)
    int         ncid


int
ncinquire(ncid, ndims, nvars, natts, recdim)
    int         ncid
    SV *        ndims
    SV *        nvars
    SV *        natts
    SV *        recdim
    CODE:
    {
        int     nd, nv, na, rd;

        RETVAL = -1;                            /* error */

        if (ncinquire(ncid, &nd, &nv, &na, &rd) != -1)
        {
            SV_SET(sv_setiv, ndims, (IV)nd);
            SV_SET(sv_setiv, nvars, (IV)nv);
            SV_SET(sv_setiv, natts, (IV)na);
            SV_SET(sv_setiv, recdim, (IV)rd);

            RETVAL = 0;                         /* success */
        }
    }
    OUTPUT:
        RETVAL


int
ncsync(ncid)
    int         ncid


int
ncabort(ncid)
    int         ncid


int
ncsetfill(ncid, fillmode)
    int         ncid
    int         fillmode


################################################################################
# Dimension control operations:
#

int
ncdimdef(ncid, name, size)
    int         ncid
    char *      name
    long        size


int
ncdimid(ncid, name)
    int         ncid
    char *      name


int
ncdiminq(ncid, dimid, name, length)
    int         ncid
    int         dimid
    SV *        name
    SV *        length
    CODE:
    {
        char    buf[MAX_NC_NAME+1];
        long    len;

        RETVAL = -1;                            /* error */
        if (ncdiminq(ncid, dimid, buf, &len) != -1)
        {
            SV_SET(sv_setpv, name, buf);
            SV_SET(sv_setiv, length, (IV)len);

            RETVAL = 0;                         /* success */
        }
    }
    OUTPUT:
        RETVAL


int
ncdimrename(ncid, dimid, name)
    int         ncid
    int         dimid
    char *      name



################################################################################
# Variable operations:
#

int
ncvardef(ncid, name, type, dimids)
    int         ncid
    char *      name
    int         type
    SV *        dimids
    CODE:
    {
        Vector  dimvec;

        vec_initref(&dimvec, IT_INT, dimids);

        if (!dimvec.initialized)
            RETVAL = -1;
        else
        {
            RETVAL = ncvardef(ncid, name, type, (int)dimvec.nelt,
                              (int*)dimvec.data);
            vec_destroy(&dimvec);
        }
    }
    OUTPUT:
        RETVAL


int
ncvarid(ncid, name)
    int         ncid
    char *      name


int
ncvarinq(ncid, varid, name, datatype, ndims, dimids, natts)
    int         ncid
    int         varid
    SV *        name
    SV *        datatype
    SV *        ndims
    SV *        dimids
    SV *        natts
    CODE:
    {
        Vector  dids;                           /* dimension IDs */

        RETVAL = -1;                            /* error */

        vec_initspec(&dids, IT_INT, (long)MAX_NC_DIMS);
        if (dids.initialized)
        {
            int         nd;
            int         na;
            char        nam[MAX_NC_NAME+1];
            nc_type     type;

            if (ncvarinq(ncid, varid, nam, &type, &nd, (int*)dids.data,
                         &na) != -1)
            {
#if 0
                SV *    ref;

                if (ref_initvec(&ref, dids))
                {
                    SV_SET(sv_setpv, name, nam);
                    SV_SET(sv_setiv, datatype, type);
                    SV_SET(sv_setiv, ndims, nd);
                    SV_SET(sv_setsv, dimids, ref);
                    SV_SET(sv_setiv, natts, na);
                    RETVAL = 0;                 /* success */
                }
#else
                if (av_initvec((AV*)SvRV(dimids), &dids))
                {
                    SV_SET(sv_setpv, name, nam);
                    SV_SET(sv_setiv, datatype, type);
                    SV_SET(sv_setiv, ndims, nd);
                    SV_SET(sv_setiv, natts, na);
                    RETVAL = 0;                 /* success */
                }
#endif
            }
            vec_destroy(&dids);
        }
    }
    OUTPUT:
        RETVAL


int
ncvarput1(ncid, varid, coords, value)
    int         ncid
    int         varid
    SV *        coords
    SV *        value
    CODE:
    {
        Vector  where;

        RETVAL = -1;                            /* error */

        vec_initref(&where, IT_LONG, coords);
        if (where.initialized)
        {
            nc_type     nctype;

            if (ncvarinq(ncid, varid, (char*)NULL, &nctype, (int*)NULL,
                         (int*)NULL, (int*)NULL) != -1)
            {
                Value   val;

                value_initref(&val, nctype_inttype(nctype), value);

                RETVAL = ncvarput1(ncid, varid, (long*)where.data, 
                                   (char*)&val.datum);
            }

            vec_destroy(&where);
        }
    }
    OUTPUT:
        RETVAL


int
ncvarget1(ncid, varid, coords, value)
    int         ncid
    int         varid
    SV *        coords
    SV *        value
    CODE:
    {
        Vector  where;

        RETVAL = -1;                            /* error */

        vec_initref(&where, IT_LONG, coords);

        /*
        (void) fputs("ncvarget1(): co-ordinate vector:\n", stderr);
        vec_print(&where, stderr, "    ");
        */

        if (where.initialized)
        {
            nc_type     nctype;

            if (ncvarinq(ncid, varid, (char*)NULL, &nctype, (int*)NULL,
                         (int*)NULL, (int*)NULL) != -1)
            {
                Value   val;

                value_initspec(&val, nctype_inttype(nctype));

                if (ncvarget1(ncid, varid, (long*)where.data, &val.datum) != -1)
                {
                    /*
                    (void) fputs("ncvarget1(): value obtained:\n", stderr);
                    value_print(&val, stderr, "    ");
                    */
                    sv_initvalue(value, &val);
                    RETVAL = 0;
                }
            }

            vec_destroy(&where);
        }
    }
    OUTPUT:
        RETVAL


int
ncvarput(ncid, varid, start, count, values)
    int         ncid
    int         varid
    SV *        start
    SV *        count
    SV *        values
    CODE:
    {
        nc_type         nctype;

        RETVAL = -1;                            /* error */

        if (ncvarinq(ncid, varid, (char*)0, &nctype, (int*)0, (int*)0, (int*)0)
            != -1)
        {
            Vector      start_vec;

            vec_initref(&start_vec, IT_LONG, start);
            if (start_vec.initialized)
            {
                Vector  count_vec;

                vec_initref(&count_vec, IT_LONG, count);
                if (count_vec.initialized)
                {
                    Vector      value_vec;

                    vec_initref(&value_vec, nctype_inttype(nctype), values);
                    if (value_vec.initialized)
                    {
                        RETVAL = ncvarput(ncid,
                                          varid,
                                          (long*)start_vec.data,
                                          (long*)count_vec.data,
                                          value_vec.data);
                        vec_destroy(&value_vec);
                    }
                    vec_destroy(&count_vec);
                }
                vec_destroy(&start_vec);
            }
        }
    }
    OUTPUT:
        RETVAL


int
ncvarget(ncid, varid, start, count, values)
    int         ncid
    int         varid
    SV *        start
    SV *        count
    SV *        values
    CODE:
    {
        Vector  start_vec;

        RETVAL = -1;                            /* error */

        vec_initref(&start_vec, IT_LONG, start);
        if (start_vec.initialized)
        {
            Vector      count_vec;

            vec_initref(&count_vec, IT_LONG, count);
            if (count_vec.initialized)
            {
                nc_type nctype;

                if (ncvarinq(ncid, varid, (char*)0, &nctype, (int*)0,
                             (int*)0, (int*)0) != -1)
                {
                    Vector      value_vec;

                    vec_initspec(&value_vec,
                                 nctype_inttype(nctype),
                                 vec_prod(&count_vec));
                    if (value_vec.initialized)
                    {
                        if (ncvarget(ncid, varid, (long*)start_vec.data,
                                     (long*)count_vec.data, value_vec.data)
                            != -1)
                        {
                            if (av_initvec((AV*)SvRV(values), &value_vec))
                                RETVAL = 0;     /* success */
                        }
                        vec_destroy(&value_vec);
                    }                           /* value vector initialized */
                }                               /* value type obtained */
                vec_destroy(&count_vec);
            }                                   /* count vector set */
            vec_destroy(&start_vec);
        }                                       /* start vector set */
    }
    OUTPUT:
        RETVAL


int
ncvarrename(ncid, varid, name)
    int         ncid
    int         varid
    char *      name


################################################################################
# Attribute operations:
#

int
ncattput(ncid, varid, name, type, values)
    int         ncid
    int         varid
    char *      name
    int         type
    SV *        values
    CODE:
    {
        /*
        (void) fprintf(stderr, 
                       "ncattput(): ncid=%d, varid=%d, name=\"%s\", type=%d\n",
                       ncid, varid, name, type);
        */

        if (SvROK(values))
        {
            /*
             * Reference value: must be a vector attribute.
             */
            Vector      vec;

            vec_initref(&vec, nctype_inttype(type), values); 

            if (!vec.initialized)
                RETVAL = -1;
            else
            {
                /*
                (void) fprintf(stderr, 
                               "ncattput(): nelt=%d\n", (int)vec.nelt);
                */

                RETVAL = ncattput(ncid, varid, name, type, (int)vec.nelt, 
                                  vec.data);
                vec_destroy(&vec);
            }
        }                                       /* vector attribute */
        else
        {
            /*
             * Non-reference value: must be a scalar attribute.
             */
            union
            {
                char    c;
                short   s;
                nclong  l;
                float   f;
                double  d;
            }   val;
            char        *ptr = (char*)&val;
            int         len = 1;

            switch (type)
            {
                case NC_CHAR:
                    ptr = SvPV_nolen(values);
                    len = strlen(ptr) + 1;
                    break;
                case NC_BYTE:
                    val.c = SvIV(values);
                    break;
                case NC_SHORT:
                    val.s = SvIV(values);
                    break;
                case NC_LONG:
                    val.l = SvIV(values);
                    break;
                case NC_FLOAT:
                    val.f = SvNV(values);
                    break;
                case NC_DOUBLE:
                    val.d = SvNV(values);
                    break;
            }

            RETVAL = ncattput(ncid, varid, name, type, len, ptr);
        }                                       /* scalar attribute */
    }
    OUTPUT:
        RETVAL


int
ncattinq(ncid, varid, name, datatype, length)
    int         ncid
    int         varid
    char *      name
    SV *        datatype
    SV *        length
    CODE:
    {
        int     len;
        nc_type nctype;

        RETVAL = -1;                            /* error */

        if (ncattinq(ncid, varid, name, &nctype, &len) != -1)
        {
            SV_SET(sv_setiv, datatype, (IV)nctype);
            SV_SET(sv_setiv, length, (IV)len);
            RETVAL = 0;                         /* success */
        }
    }
    OUTPUT:
        RETVAL


int
ncattget(ncid, varid, name, value)
    int         ncid
    int         varid
    char *      name
    SV *        value
    CODE:
    {
        int     len;
        nc_type nctype;

        /*
        (void) fprintf(stderr,
                       "ncattget(): ncid=%d, varid=%d, name=\"%s\"\n",
                       ncid, varid, name);
         */

        RETVAL = -1;                            /* error */

        if (ncattinq(ncid, varid, name, &nctype, &len) != -1)
        {
            Vector      vec;

            vec_initspec(&vec, nctype_inttype(nctype), (long)len);
            if (vec.initialized)
            {
                if (ncattget(ncid, varid, name, vec.data) != -1)
                {
                    /*
                    (void) fputs("ncattget(): Returned vector:\n", stderr);
                    vec_print(&vec, stderr, "    ");
                     */

                    if (ref_initvec(value, &vec))
                    {
                        /*
                        (void) fputs("ncattget(): Returned reference:\n",
                                     stderr);
                        vec_print(&vec, stderr, "    ");
                         */
                        RETVAL = 0;             /* success */
                    }
                }

                vec_destroy(&vec);
            }
        }
    }
    OUTPUT:
        RETVAL


int
ncattcopy(incdf, invar, name, outcdf, outvar)
    int         incdf
    int         invar
    char *      name
    int         outcdf
    int         outvar


int
ncattname(ncid, varid, attnum, name)
    int         ncid
    int         varid
    int         attnum
    SV *        name
    CODE:
    {
        char    buf[MAX_NC_NAME+1];

        RETVAL = ncattname(ncid, varid, attnum, buf);
        if (RETVAL != -1)
        {
            buf[MAX_NC_NAME] = 0;
            SV_SET(sv_setpv, name, buf);
        }
    }
    OUTPUT:
        RETVAL


int
ncattrename(ncid, varid, name, newname)
    int         ncid
    int         varid
    char *      name
    char *      newname


int
ncattdel(ncid, varid, name)
    int         ncid
    int         varid
    char *      name


################################################################################
# Record I/O operations:
#

int
ncrecput(ncid, recid, data)
    int         ncid
    long        recid
    SV *        data
    CODE:
    {
        Record  rec;

        /*
        (void) fprintf(stderr, "XS_NetCDF::recput(): ncid=%d, recid=%ld\n",
                       ncid, recid);
        */

        RETVAL = -1;                            /* error */

        rec_initref(&rec, data, ncid);
        if (rec.initialized)
        {
            /*
            (void) fputs("ncrecput() record:\n", stderr);
            rec_print(&rec, stderr, "   ");
            (void) fprintf(stderr, "*(short*)rec.data[0] = %d\n",
                           *(short*)rec.data[0]);
             */

            RETVAL = ncrecput(ncid, recid, rec.data);

            rec_destroy(&rec);
        }
    }
    OUTPUT:
        RETVAL


int
ncrecget(ncid, recid, data)
    int         ncid
    long        recid
    SV *        data
    CODE:
    {
        Record  rec;

        RETVAL = -1;                            /* error */

        rec_initnc(&rec, ncid, recid);

        if (rec.initialized)
        {
            if (av_initrec((AV*)SvRV(data), &rec))
                RETVAL = 0;                     /* success */

            rec_destroy(&rec);
        }
    }
    OUTPUT:
        RETVAL


int
ncrecinq(ncid, nrecvars, recvarids, recsizes)
    int         ncid
    SV *        nrecvars
    SV *        recvarids
    SV *        recsizes
    CODE:
    {
        int     nvar;

        /*
        (void) fprintf(stderr, "ncrecinq(): ncid=%d\n");
        */

        RETVAL = -1;                            /* error */

        if (ncrecinq(ncid, &nvar, (int*)NULL, (long*)NULL) != -1)
        {
            long        count = nvar;
            Vector      varids;

            vec_initspec(&varids, IT_INT, (long)nvar);
            if (varids.initialized)
            {
                Vector  varlens;

                vec_initspec(&varlens, IT_LONG, (long)nvar);
                if (varlens.initialized)
                {
                    if (ncrecinq(ncid, (int*)NULL, (int*)varids.data,
                                 (long*)varlens.data) != -1)
                    {
                        if (av_initvec((AV*)SvRV(recvarids), &varids) &&
                            av_initvec((AV*)SvRV(recsizes), &varlens))
                        {
                            /*
                            (void) fputs("ncrecinq(): Variable IDs:\n", stderr);
                            vec_print(&varids, stderr, "    ");
                            (void) fputs("ncrecinq(): Record sizes:\n", stderr);
                            vec_print(&varlens, stderr, "    ");
                            */

                            SV_SET(sv_setiv, nrecvars, (IV)nvar);
                            RETVAL = 0;         /* success */
                        }
                    }

                    vec_destroy(&varlens);
                }

                vec_destroy(&varids);
            }
        }
    }
    OUTPUT:
        RETVAL


################################################################################
# Miscellaneous operations:
#

int
nctypelen(datatype)
    int         datatype


int
ncopts(mode)
    int         mode
    CODE:
    {
        RETVAL = ncopts;
        ncopts = mode;
    }
    OUTPUT:
        RETVAL


int
ncerr()
    CODE:
        RETVAL = ncerr;
    OUTPUT:
        RETVAL


int
foo(outarg)
    SV *        outarg
    CODE:
    {
        if (!SvROK(outarg))
        {
            (void) fputs("Setting scalar\n", stderr);
            SV_SET(sv_setpv, outarg, "Scalar works!");
        }
        else
        {
#if 1
            AV          *av = newAV();
            SV          *ref = sv_2mortal(newRV((SV*)av));
            /*
             * Making the following 2 variables mortal causes no output
             * values to be printed.
             */
            SV          *sv1 = newSVpv("one", 3);
            SV          *sv2 = newSVpv("two", 3);

            (void) fputs("Setting reference\n", stderr);

            /*
             * av_push() doesn't copy the pointed-to values.
             */
            av_push(av, sv1);
            av_push(av, sv2);

            /*
             * Using either of the following causes $outarg to not be
             * an array.
             *    *outarg = *ref
             *     outarg =  ref;
             */

            /* Using (SV*)av in the following causes a SEGV. */
            SV_SET(sv_setsv, outarg, ref);
#else
            char        *string = "Reference works!";
            SV          *newval = sv_2mortal(newSVpv(string, strlen(string)));
            SV          *ref = sv_2mortal(newRV(newval));

            SV_SET(sv_setsv, outarg, ref);
#endif
        }
        /*
         * It is not necessary to set ST(1) from outarg.
         *
         * SV_SET(sv_setsv, ST(1), outarg);
         */
        RETVAL = 1;                             /* success */
    }
    OUTPUT:
        RETVAL


void
foo2()
    PPCODE:
    {
        AV      *av = newAV();

        av_push(av, newSViv(1));
        av_push(av, newSViv(2));

        EXTEND(sp, 1);
        PUSHs(sv_2mortal(newRV((SV*)av)));
    }


void
foo3()
    PPCODE:
    {
        EXTEND(sp, 2);
        PUSHs(sv_2mortal(newSViv(3)));
        PUSHs(sv_2mortal(newSViv(4)));
    }


int
foo4(ref)
    SV *        ref
    CODE:
    {
        AV      *av = newAV();

        av_push(av, newSViv(5));
        av_push(av, newSViv(6));

        SV_SET(sv_setsv, ref, newRV((SV*)av));

        RETVAL = 1;
    }
    OUTPUT:
        RETVAL

int
foo5(ref)
    SV *        ref
    CODE:
    {
        int     vals[5];
        Vector  vec;

        vals[0] = 0;
        vals[1] = 1;
        vals[2] = 2;
        vals[3] = 3;
        vals[4] = 4;

        vec_initspec(&vec, IT_INT, 4);
        if (vec.initialized)
        {
            (void) memcpy((void*)vec.data, vals, sizeof(int)*4);
            if (av_initvec((AV*)SvRV(ref), &vec))
                RETVAL = 0;
            vec_destroy(&vec);
        }
    }
    OUTPUT:
        RETVAL