/*
* Copyright 1990, University Corporation for Atmospheric Research
* See netcdf/README file for copying and redistribution conditions.
*/
/* $Header: /afs/ncsa/projects/hdf/cvs/hdf4/mfhdf/fortran/msoft/jackets.c,v 1.1 1993/04/21 21:49:17 chouck Exp $ */
/*
* OVERVIEW
*
* This file contains jacket routines written in C for interfacing Fortran
* netCDF function calls to the actual C binding for the NetCDF. This code
* is written explicitly for MICROSOFT. In general, these functions handle
* character-string parameter conventions, convert between
* column-major-order arrays and row-major-order arrays, and map between
* array indices beginning at one and array indices beginning at zero.
*
*/
/* LINTLIBRARY */
#include "netcdf.h"
#include <ctype.h>
#include <string.h>
#include <stdio.h>
extern long fslen(int); /* returns declared fortran string length of nth arg */
extern char *
malloc ();
/*
* global integer used for suppressing error messages and determining
* the fatality of errors.
*/
extern int ncopts; /* default is (NC_FATAL | NC_VERBOSE) */
/* global integer that contains a netCDF-specific error code */
extern int ncerr;
/* blank fill C string to make FORTRAN string */
static void
fcdcpy (fstring, fslen, sstring)
char *fstring; /* output string to be blank-filled */
int fslen; /* length of output string */
char *sstring; /* input string, null-terminated */
{
int i, len = strlen(sstring);
for (i = 0; i < len; i++)
*(fstring + i) = *(sstring + i);
for (i = len; i < fslen; i++)
*(fstring + i) = ' ';
}
static void
reverse (array, length)
int array[]; /* array to be reversed */
int length; /* length of array */
{
int temp, i, j;
for (i = 0, j = length - 1; i < j; i++, j--) {
temp = array[i];
array[i] = array[j];
array[j] = temp;
}
}
static void
revlongs (array, length)
long array[]; /* array to be reversed */
int length; /* length of array */
{
int i, j;
long temp;
for (i = 0, j = length - 1; i < j; i++, j--) {
temp = array[i];
array[i] = array[j];
array[j] = temp;
}
}
/* error handling function */
static void
handle_err (pname, rcode)
char *pname; /* procedure name */
int rcode; /* error return */
{
extern void NCadvise();
extern char *cdf_routine_name; /* routine name in error messages */
cdf_routine_name = pname;
(void) NCadvise(rcode, "string won't fit in CHARACTER variable provided");
}
/* copy function used to copy strings with embedded blanks */
static void
fstrncpy (target, source, maxlen)
char *target; /* space to be copied into */
char *source; /* string to be copied */
int maxlen; /* maximum length of *source */
{
while (maxlen-- && *source != '\0')
*target++ = *source++;
*target = '\0';
}
/* copy function used to copy strings terminated with blanks */
static void
nstrncpy (target, source, maxlen)
char *target; /* space to be copied into */
char *source; /* string to be copied */
int maxlen; /* maximum length of *source */
{
while (maxlen-- && *source != ' ')
*target++ = *source++;
*target = '\0';
}
/*
* Compute product of dimensions.
*/
static long
dimprod (dims, ndims)
long *dims; /* list of dimensions */
int ndims; /* number of dimensions in list */
{
long *ip;
long prod = 1;
for (ip = dims; ip < &dims[ndims]; ip++)
prod *= *ip;
return prod;
}
#ifdef FORTRAN_HAS_NO_BYTE
/*
* Convert multi-dimensional array of bytes stored in ints to packed array of
* bytes, in malloc'ed space. Returns pointer to bytes or NULL if malloc
* failed.
*/
static char *
itob(ints, dims, ndims)
int *ints; /* multi-dimensional array of integers */
long *dims; /* list of dimensions */
int ndims; /* number of dimensions in list */
{
long iocount = dimprod (dims, ndims); /* product of dimensions */
char *bytes = (char *) malloc (iocount * sizeof (char));
int *ip;
char *bp = bytes;
if (bytes != NULL)
for (ip = ints; iocount > 0; iocount--)
*bp++ = (char) *ip++;
return bytes;
}
#endif /* FORTRAN_HAS_NO_BYTE */
#ifdef FORTRAN_HAS_NO_SHORT
/*
* Convert multi-dimensional array of shorts stored in ints to packed array of
* shorts, in malloc'ed space. Returns pointer to shorts or NULL if malloc
* failed.
*/
static short *
itos(ints, dims, ndims)
int *ints; /* multi-dimensional array of ints */
long *dims; /* list of dimensions */
int ndims; /* number of dimensions in list */
{
long iocount = dimprod (dims, ndims); /* product of dimensions */
short *shorts = (short *) malloc (iocount * sizeof (short));
int *ip;
short *sp = shorts;
if (shorts != NULL)
for (ip = ints; iocount > 0; iocount--)
*sp++ = (short) *ip++;
return shorts;
}
#endif /* FORTRAN_HAS_NO_SHORT */
/* ------------ MICROSOFT FORTRAN jackets for netCDF Functions ------------ */
/* used to set the C global variable ncopts from Fortran */
int
ncpopt(val)
int *val;
{
ncopts = *val;
}
/* used to get the C global variable ncopts from Fortran */
int
ncgopt(val)
int *val;
{
*val = ncopts;
}
/*
* creates a new netCDF file, returning a netCDF ID. New netCDF
* file is placed in define mode.
*/
int
nccre(pathname, clobmode, rcode)
char *pathname;
int *clobmode;
int *rcode;
{
int pathnamelen = fslen(1);
char name[MAX_NC_NAME + 1];
int cdfid;
(void) nstrncpy (name, pathname, pathnamelen);
if ((cdfid = nccreate (name, *clobmode)) != -1) {
*rcode = 0;
return (cdfid);
}
*rcode = ncerr;
return (-1);
}
/* opens an existing netCDF file for access */
int
ncopn(pathname, rwmode, rcode)
char *pathname;
int *rwmode;
int *rcode;
{
int pathnamelen = fslen(1);
char name[MAX_NC_NAME + 1];
int cdfid;
(void) nstrncpy (name, pathname, pathnamelen);
if ((cdfid = ncopen (name, *rwmode)) != -1) {
*rcode = 0;
return (cdfid);
}
*rcode = ncerr;
return (-1);
}
/* adds a new dimension to an open netCDF file in define mode */
int
ncddef(cdfid, dimname, dimlen, rcode)
int *cdfid;
char *dimname;
long *dimlen;
int *rcode;
{
int dimnamelen = fslen(1);
char name[MAX_NC_NAME + 1];
int dimid;
(void) nstrncpy (name, dimname, dimnamelen);
if ((dimid = ncdimdef (*cdfid, name, *dimlen)) != -1) {
*rcode = 0;
return (dimid + 1);
}
*rcode = ncerr;
return (-1);
}
/*
* returns the ID of a netCDF dimension, given the name of the
* dimension
*/
int
ncdid(cdfid, dimname, rcode)
int *cdfid;
char *dimname;
int *rcode;
{
int dimnamelen = fslen(1);
char name[MAX_NC_NAME + 1];
int dimid;
(void) nstrncpy (name, dimname, dimnamelen);
if ((dimid = ncdimid (*cdfid, name)) != -1) {
*rcode = 0;
return (dimid + 1);
}
*rcode = ncerr;
return (-1);
}
/* adds a new variable to an open netCDF file in define mode */
int
ncvdef(cdfid, varname, datatype, ndims, dimarray, rcode)
int *cdfid;
char *varname;
int *datatype;
int *ndims;
int *dimarray;
int *rcode;
{
int varnamelen = fslen(1);
int varid, i, dimid[MAX_VAR_DIMS];
char name[MAX_NC_NAME + 1];
(void) nstrncpy (name, varname, varnamelen);
for (i = 0; i < *ndims; i++)
dimid[i] = dimarray[i] - 1;
reverse (dimid, *ndims);
if ((varid = ncvardef (*cdfid, name, (nc_type) *datatype, *ndims,
dimid)) != -1) {
*rcode = 0;
return (varid + 1);
}
*rcode = ncerr;
return (-1);
}
/* returns the ID of a netCDF variable given its name */
int
ncvid(cdfid, varname, rcode)
int *cdfid;
char *varname;
int *rcode;
{
int varnamelen = fslen(1);
int varid;
char name[MAX_NC_NAME + 1];
(void) nstrncpy (name, varname, varnamelen);
if ((varid = ncvarid (*cdfid, name)) != -1) {
*rcode = 0;
return (varid + 1);
}
*rcode = ncerr;
return (-1);
}
/* returns number of bytes per netCDF data type */
int
nctlen(datatype, rcode)
int *datatype;
int *rcode;
{
int itype;
if ((itype = nctypelen ((nc_type) *datatype)) != -1) {
*rcode = 0;
return (itype);
}
*rcode = ncerr;
return (-1);
}
/* closes an open netCDF file */
void
ncclos(cdfid, rcode)
int *cdfid;
int *rcode;
{
*rcode = 0;
if (ncclose (*cdfid) == -1)
*rcode = ncerr;
}
/* puts an open netCDF into define mode */
void
ncredf(cdfid, rcode)
int *cdfid;
int *rcode;
{
*rcode = 0;
if (ncredef (*cdfid) == -1)
*rcode = ncerr;
}
/* takes an open netCDF out of define mode */
void
ncendf(cdfid, rcode)
int *cdfid;
int *rcode;
{
*rcode = 0;
if (ncendef (*cdfid) == -1)
*rcode = ncerr;
}
/* returns information about an open netCDF file given its netCDF ID */
void
ncinq(cdfid, ndims, nvars, natts, recdim, rcode)
int *cdfid;
int *ndims;
int *nvars;
int *natts;
int *recdim;
int *rcode;
{
*rcode = 0;
if (ncinquire (*cdfid, ndims, nvars, natts, recdim) == -1) {
*rcode = ncerr;
return;
}
if (*recdim != -1)
(*recdim)++;
}
/*
* makes sure that the disk copy of a netCDF file open for writing
* is current
*/
void
ncsnc(cdfid, rcode)
int *cdfid;
int *rcode;
{
*rcode = 0;
if (ncsync (*cdfid) == -1)
*rcode = ncerr;
}
/*
* restores the netCDF to a known consistent state in case anything
* goes wrong during the definition of new dimensions, variables
* or attributes
*/
void
ncabor(cdfid, rcode)
int *cdfid;
int *rcode;
{
*rcode = 0;
if (ncabort (*cdfid) == -1)
*rcode = ncerr;
}
/* returns the name and size of a dimension, given its ID */
void
ncdinq(cdfid, dimid, dimname, size, rcode)
int *cdfid;
int *dimid;
char *dimname;
long *size;
int *rcode;
{
int dimnamelen = fslen(1);
char name[MAX_NC_NAME + 1];
*rcode = 0;
if (ncdiminq (*cdfid, *dimid - 1, name, size) == -1) {
*rcode = ncerr;
return;
}
if (strlen (name) > dimnamelen) {
*rcode = NC_ESTS;
handle_err ("NCDINQ", *rcode);
return;
}
/* blank fill the input character string */
fcdcpy (dimname, dimnamelen, name);
}
/* renames an existing dimension in a netCDF open for writing */
void
ncdren(cdfid, dimid, dimname, rcode)
int *cdfid;
int *dimid;
char *dimname;
int *rcode;
{
int dimnamelen = fslen(1);
char name[MAX_NC_NAME + 1];
(void) nstrncpy (name, dimname, dimnamelen);
*rcode = 0;
if (ncdimrename (*cdfid, *dimid - 1, name) == -1)
*rcode = ncerr;
}
/* returns information about a netCDF variable, given its ID */
void
ncvinq(cdfid, varid, varname, datatype, ndims, dimarray, natts, rcode)
int *cdfid;
int *varid;
char *varname;
int *datatype;
int *ndims;
int *dimarray;
int *natts;
int *rcode;
{
int varnamelen = fslen(1);
char name[MAX_NC_NAME + 1];
int dimid[MAX_VAR_DIMS], i;
*rcode = 0;
if (ncvarinq (*cdfid, *varid - 1, name, (nc_type *) datatype, ndims, dimid,
natts) == -1) {
*rcode = ncerr;
return;
}
for (i = 0; i < *ndims; i++)
dimarray[i] = dimid[i] + 1;
reverse (dimarray, *ndims);
if (strlen (name) > varnamelen) {
*rcode = NC_ESTS;
handle_err ("NCVINQ", *rcode);
return;
}
fcdcpy (varname, varnamelen, name);
}
/* puts a single numeric data value into a variable of an open netCDF */
void
ncvpt1(cdfid, varid, indices, value, rcode)
int *cdfid;
int *varid;
long *indices;
void *value;
int *rcode;
{
int datatype, ndims, natts, i;
long nindices[MAX_VAR_DIMS];
int dimid[MAX_VAR_DIMS];
if (ncvarinq (*cdfid, *varid - 1, (char *) 0,
(nc_type *) & datatype, &ndims, dimid, &natts) == -1) {
*rcode = ncerr;
return;
}
for (i = 0; i < ndims; i++)
nindices[i] = indices[i] - 1;
revlongs (nindices, ndims);
*rcode = 0;
#ifdef FORTRAN_HAS_NO_BYTE
if ((nc_type) datatype == NC_BYTE) { /* pack ints into bytes */
char bytes = *(int *) value;
if (ncvarput1(*cdfid, *varid - 1, nindices,
(ncvoid *) &bytes) == -1) {
*rcode = ncerr;
}
return;
} /* else */
#endif /* FORTRAN_HAS_NO_BYTE */
#ifdef FORTRAN_HAS_NO_SHORT
if ((nc_type) datatype == NC_SHORT) { /* pack ints into shorts */
short shorts = *(int *)value;
if (ncvarput1(*cdfid, *varid - 1, nindices, (ncvoid *) &shorts) == -1) {
*rcode = ncerr;
}
return;
} /* else */
#endif /* FORTRAN_HAS_NO_SHORT */
if (ncvarput1 (*cdfid, *varid - 1, nindices, value) == -1) {
*rcode = ncerr;
}
}
/* puts a single character into an open netCDF file */
void
ncvp1c(cdfid, varid, indices, chval, rcode)
int *cdfid;
int *varid;
long *indices;
char *chval;
int *rcode;
{
int chvallen = fslen(1);
int datatype, ndims, natts, i;
long nindices[MAX_VAR_DIMS];
int dimid[MAX_VAR_DIMS];
if (ncvarinq (*cdfid, *varid - 1, (char *) 0,
(nc_type *) & datatype, &ndims, dimid, &natts) == -1) {
*rcode = ncerr;
return;
}
for (i = 0; i < ndims; i++)
nindices[i] = indices[i] - 1;
revlongs (nindices, ndims);
*rcode = 0;
if (ncvarput1 (*cdfid, *varid - 1, nindices, (ncvoid *) chval) == -1) {
*rcode = ncerr;
}
}
/*
* writes a hypercube of numeric values into a netCDF variable of an open
* netCDF file
*/
void
ncvpt(cdfid, varid, start, count, value, rcode)
int *cdfid;
int *varid;
long *start;
long *count;
void *value;
int *rcode;
{
long ncount[MAX_VAR_DIMS], nstart[MAX_VAR_DIMS], i;
int ndims, datatype, dimarray[MAX_VAR_DIMS], natts;
if (ncvarinq (*cdfid, *varid - 1, (char *) 0, (nc_type *) & datatype,
&ndims, dimarray, &natts) == -1) {
*rcode = ncerr;
return;
}
for (i = 0; i < ndims; i++) {
ncount[i] = count[i];
nstart[i] = start[i] - 1;
}
revlongs (ncount, ndims);
revlongs (nstart, ndims);
*rcode = 0;
#ifdef FORTRAN_HAS_NO_BYTE
if ((nc_type) datatype == NC_BYTE) { /* pack ints into bytes */
char *bytes = itob (value, count, ndims);
if (bytes == NULL) {
*rcode = NC_SYSERR;
return;
}
if (ncvarput (*cdfid, *varid - 1, nstart, ncount,
(ncvoid *) bytes) == -1) {
*rcode = ncerr;
}
free (bytes);
return;
} /* else */
#endif /* FORTRAN_HAS_NO_BYTE */
#ifdef FORTRAN_HAS_NO_SHORT
if ((nc_type) datatype == NC_SHORT) { /* pack ints into shorts */
short *shorts = itos (value, count, ndims);
if (shorts == NULL) {
*rcode = NC_SYSERR;
return;
}
if (ncvarput (*cdfid, *varid - 1, nstart, ncount, (ncvoid *) shorts) == -1) {
*rcode = ncerr;
}
free (shorts);
return;
} /* else */
#endif /* FORTRAN_HAS_NO_SHORT */
if (ncvarput (*cdfid, *varid - 1, nstart, ncount, value) == -1) {
*rcode = ncerr;
}
}
/* writes a hypercube of character values into an open netCDF file */
void
ncvptc(cdfid, varid, start, count, string, lenstr, rcode)
int *cdfid;
int *varid;
long *start;
long *count;
char *string;
int *lenstr;
int *rcode;
{
int stringlen = fslen(1);
long ncount[MAX_VAR_DIMS], nstart[MAX_VAR_DIMS], i;
int ndims, datatype, dimarray[MAX_VAR_DIMS], natts;
if (ncvarinq (*cdfid, *varid - 1, (char *) 0,
(nc_type *) & datatype, &ndims, dimarray, &natts) == -1) {
*rcode = ncerr;
return;
}
if (dimprod(count,ndims) > *lenstr) {
*rcode = NC_ESTS;
handle_err ("NCVPTC", *rcode);
return;
}
for (i = 0; i < ndims; i++) {
ncount[i] = count[i];
nstart[i] = start[i] - 1;
}
revlongs (ncount, ndims);
revlongs (nstart, ndims);
*rcode = 0;
if (ncvarput (*cdfid, *varid - 1, nstart, ncount, (ncvoid *) string) == -1) {
*rcode = ncerr;
}
}
/* gets a single numeric value from a variable of an open netCDF file */
void
ncvgt1(cdfid, varid, indices, value, rcode)
int *cdfid;
int *varid;
long *indices;
void *value;
int *rcode;
{
long nindices[MAX_VAR_DIMS], i;
int datatype, ndims, dimarray[MAX_VAR_DIMS], natts;
if (ncvarinq (*cdfid, *varid - 1, (char *) 0, (nc_type *) & datatype,
&ndims, dimarray, &natts) == -1) {
*rcode = ncerr;
return;
}
for (i = 0; i < ndims; i++) {
nindices[i] = indices[i] - 1;
}
revlongs (nindices, ndims);
*rcode = 0;
#ifdef FORTRAN_HAS_NO_BYTE
if ((nc_type) datatype == NC_BYTE) {
char bytes;
int *ip = (int *) value;
char *bp = &bytes;
if (ncvarget1(*cdfid, *varid - 1, nindices, (ncvoid *) &bytes) == -1) {
*rcode = ncerr;
return;
}
*ip = *bp;
return;
} /* else */
#endif /* FORTRAN_HAS_NO_BYTE */
#ifdef FORTRAN_HAS_NO_SHORT
if ((nc_type) datatype == NC_SHORT) {
short shorts;
int *ip = (int *) value;
short *sp = &shorts;
if (ncvarget1(*cdfid, *varid - 1, nindices, (ncvoid *) &shorts) == -1) {
*rcode = ncerr;
return;
}
*ip = *sp;
return;
} /* else */
#endif /* FORTRAN_HAS_NO_SHORT */
if (ncvarget1 (*cdfid, *varid - 1, nindices, value) == -1) {
*rcode = ncerr;
}
}
/*
* gets a single character data value from a variable of an open
* netCDF file
*/
void
ncvg1c(cdfid, varid, indices, chval, rcode)
int *cdfid;
int *varid;
long *indices;
char *chval;
int *rcode;
{
int chvallen = fslen(1);
long nindices[MAX_VAR_DIMS];
int i, datatype, ndims, dimarray[MAX_VAR_DIMS], natts;
if (ncvarinq (*cdfid, *varid - 1, (char *) 0,
(nc_type *) & datatype, &ndims, dimarray, &natts) == -1) {
*rcode = ncerr;
return;
}
for (i = 0; i < ndims; i++) {
nindices[i] = indices[i] - 1;
}
revlongs (nindices, ndims);
*rcode = 0;
if (ncvarget1 (*cdfid, *varid - 1, nindices, (ncvoid *) chval) == -1) {
*rcode = ncerr;
}
}
/*
* reads a hypercube of numeric values from a netCDF variable of an open
* netCDF file
*/
void
ncvgt(cdfid, varid, start, count, value, rcode)
int *cdfid;
int *varid;
long *start;
long *count;
void *value;
int *rcode;
{
long ncount[MAX_VAR_DIMS], nstart[MAX_VAR_DIMS];
int i, ndims, datatype, dimarray[MAX_VAR_DIMS], natts;
if (ncvarinq (*cdfid, *varid - 1, (char *) 0, (nc_type *) & datatype,
&ndims, dimarray, &natts) == -1) {
*rcode = ncerr;
return;
}
for (i = 0; i < ndims; i++) {
ncount[i] = count[i];
nstart[i] = start[i] - 1;
}
revlongs (ncount, ndims);
revlongs (nstart, ndims);
*rcode = 0;
#ifdef FORTRAN_HAS_NO_BYTE
if ((nc_type) datatype == NC_BYTE) {
long iocount = dimprod (count, ndims); /* product of dimensions */
char *bytes = (char *) malloc (iocount * sizeof (char));
int *ip;
char *bp = bytes;
if (bytes == NULL) {
*rcode = NC_SYSERR;
return;
}
if (ncvarget (*cdfid, *varid - 1, nstart, ncount, (ncvoid *) bytes) == -1) {
*rcode = ncerr;
free (bytes);
return;
}
for (ip = (int *) value; iocount > 0; iocount--)
*ip++ = *bp++;
free (bytes);
return;
} /* else */
#endif /* FORTRAN_HAS_NO_BYTE */
#ifdef FORTRAN_HAS_NO_SHORT
if ((nc_type) datatype == NC_SHORT) {
long iocount = dimprod (count, ndims); /* product of dimensions */
short *shorts = (short *) malloc (iocount * sizeof (short));
int *ip;
short *sp = shorts;
if (shorts == NULL) {
*rcode = NC_SYSERR;
return;
}
if (ncvarget (*cdfid, *varid - 1, nstart, ncount, (ncvoid *) shorts) == -1) {
*rcode = ncerr;
free (shorts);
return;
}
for (ip = (int *) value; iocount > 0; iocount--)
*ip++ = *sp++;
free (shorts);
return;
} /* else */
#endif /* FORTRAN_HAS_NO_SHORT */
if (ncvarget (*cdfid, *varid - 1, nstart, ncount, value) == -1) {
*rcode = ncerr;
}
}
/* reads a hypercube of character values from a netCDF variable */
void
ncvgtc(cdfid, varid, start, count, string, lenstr, rcode)
int *cdfid;
int *varid;
long *start;
long *count;
char *string;
int *lenstr;
int *rcode;
{
int stringlen = fslen(1);
long ncount[MAX_VAR_DIMS], nstart[MAX_VAR_DIMS];
int i, ndims, datatype, dimarray[MAX_VAR_DIMS], natts;
int prod = 1;
if (ncvarinq (*cdfid, *varid - 1, (char *) 0,
(nc_type *) & datatype, &ndims, dimarray, &natts) == -1) {
*rcode = ncerr;
return;
}
for (i = 0; i < ndims; i++) {
ncount[i] = count[i];
nstart[i] = start[i] - 1;
prod *= count[i];
}
if (prod > *lenstr) {
*rcode = NC_ESTS;
handle_err ("NCVGTC", *rcode);
return;
}
revlongs (ncount, ndims);
revlongs (nstart, ndims);
*rcode = 0;
if (ncvarget (*cdfid, *varid - 1, nstart, ncount, (ncvoid *) string) == -1) {
*rcode = ncerr;
return;
}
for (i = prod; i < *lenstr; i++)
string[i] = ' ';
}
/* changes the name of a netCDF variable in an open netCDF file */
void
ncvren(cdfid, varid, varname, rcode)
int *cdfid;
int *varid;
char *varname;
int *rcode;
{
int varnamelen = fslen(1);
char name[MAX_NC_NAME + 1];
(void) nstrncpy (name, varname, varnamelen);
*rcode = 0;
if (ncvarrename (*cdfid, *varid - 1, name) == -1) {
*rcode = ncerr;
}
}
/*
* adds or changes a numeric variable or global attribute of an open
* netCDF file
*/
void
ncapt(cdfid, varid, attname, datatype, attlen, value, rcode)
int *cdfid;
int *varid;
char *attname;
int *datatype;
int *attlen;
void *value;
int *rcode;
{
int attnamelen = fslen(1);
char name[MAX_NC_NAME + 1];
(void) nstrncpy (name, attname, attnamelen);
*rcode = 0;
#ifdef FORTRAN_HAS_NO_BYTE
if ((nc_type) *datatype == NC_BYTE) { /* pack ints into bytes */
char *bytes = itob (value, attlen, 1);
if (bytes == NULL) {
*rcode = NC_SYSERR;
return;
}
if (ncattput (*cdfid, *varid - 1, name, (nc_type) *datatype, *attlen,
(ncvoid *) bytes) == -1) {
*rcode = ncerr;
}
free (bytes);
return;
} /* else */
#endif /* FORTRAN_HAS_NO_BYTE */
#ifdef FORTRAN_HAS_NO_SHORT
if ((nc_type) *datatype == NC_SHORT) { /* pack ints into shorts */
short *shorts = itos (value, attlen, 1);
if (shorts == NULL) {
*rcode = NC_SYSERR;
return;
}
if (ncattput (*cdfid, *varid - 1, name, (nc_type) *datatype, *attlen,
(ncvoid *) shorts) == -1) {
*rcode = ncerr;
}
free (shorts);
return;
} /* else */
#endif /* FORTRAN_HAS_NO_SHORT */
if (ncattput (*cdfid, *varid - 1, name, (nc_type) *datatype, *attlen,
value) == -1) {
*rcode = ncerr;
}
}
/*
* adds or changes a character variable or global attribute
* of an open netCDF file
*/
void
ncaptc(cdfid, varid, attname, datatype, lenstr, string, rcode)
int *cdfid;
int *varid;
char *attname;
int *datatype;
int *lenstr;
char *string;
int *rcode;
{
int attnamelen = fslen(1);
int stringlen = fslen(2);
char name[MAX_NC_NAME + 1];
char *value;
(void) nstrncpy (name, attname, attnamelen);
if (((value = malloc ((unsigned) *lenstr + 1)) == NULL) || (*lenstr == 0)) {
*rcode = NC_ESTS;
handle_err ("NCAPTC", *rcode);
return;
}
(void) fstrncpy (value, string, *lenstr);
*rcode = 0;
if (ncattput (*cdfid, *varid - 1, name, (nc_type) *datatype, *lenstr,
(ncvoid *) value) == -1) {
*rcode = ncerr;
}
free (value);
}
/*
* returns information about a netCDF attribute given its variable
* ID and name
*/
void
ncainq(cdfid, varid, attname, datatype, attlen, rcode)
int *cdfid;
int *varid;
char *attname;
int *datatype;
int *attlen;
int *rcode;
{
int attnamelen = fslen(1);
char name[MAX_NC_NAME + 1];
(void) nstrncpy (name, attname, attnamelen);
*rcode = 0;
if (ncattinq (*cdfid, *varid - 1, name, (nc_type *) datatype, attlen) == -1) {
*rcode = ncerr;
}
}
/*
* gets the value of a netCDF attribute given its variable ID
* and name
*/
void
ncagt(cdfid, varid, attname, value, rcode)
int *cdfid;
int *varid;
char *attname;
void *value;
int *rcode;
{
int attnamelen = fslen(1);
char name[MAX_NC_NAME + 1];
#if defined(FORTRAN_HAS_NO_BYTE) || defined(FORTRAN_HAS_NO_SHORT)
int datatype;
int attlen;
#endif
(void) nstrncpy (name, attname, attnamelen);
*rcode = 0;
#if defined(FORTRAN_HAS_NO_BYTE) || defined(FORTRAN_HAS_NO_SHORT)
if (ncattinq (*cdfid, *varid - 1, name, (nc_type *) &datatype, &attlen) == -1) {
*rcode = ncerr;
return;
}
#endif
#ifdef FORTRAN_HAS_NO_BYTE
if ((nc_type) datatype == NC_BYTE) {
char *bytes = (char *) malloc (attlen);
int *ip;
char *bp = bytes;
if (bytes == NULL) {
*rcode = NC_SYSERR;
return;
}
if (ncattget (*cdfid, *varid - 1, name, (ncvoid *) bytes) == -1) {
*rcode = ncerr;
free (bytes);
return;
}
for (ip = (int *) value; attlen > 0; attlen--)
*ip++ = *bp++;
free (bytes);
return;
} /* else */
#endif /* FORTRAN_HAS_NO_BYTE */
#ifdef FORTRAN_HAS_NO_SHORT
if ((nc_type) datatype == NC_SHORT) {
short *shorts = (short *) malloc (attlen * sizeof (short));
int *ip;
short *sp = shorts;
if (shorts == NULL) {
*rcode = NC_SYSERR;
return;
}
if (ncattget (*cdfid, *varid - 1, name, (ncvoid *) shorts) == -1) {
*rcode = ncerr;
free (shorts);
return;
}
for (ip = (int *) value; attlen > 0; attlen--)
*ip++ = *sp++;
free (shorts);
return;
} /* else */
#endif /* FORTRAN_HAS_NO_SHORT */
if (ncattget (*cdfid, *varid - 1, name, value) == -1) {
*rcode = ncerr;
}
}
/*
* gets the value of a netCDF character attribute given its variable
* ID and name
*/
void
ncagtc(cdfid, varid, attname, string, lenstr, rcode)
int *cdfid;
int *varid;
char *attname;
char *string;
int *lenstr;
int *rcode;
{
int attnamelen = fslen(1);
int stringlen = fslen(2);
char name[MAX_NC_NAME + 1];
int datatype;
int attlen;
int i;
(void) nstrncpy (name, attname, attnamelen);
*rcode = 0;
if (ncattinq (*cdfid, *varid - 1, name, (nc_type *) &datatype, &attlen) == -1) {
*rcode = ncerr;
return;
}
if (attlen > *lenstr) {
*rcode = NC_ESTS;
handle_err ("NCAGTC", *rcode);
return;
}
if (ncattget (*cdfid, *varid - 1, name, (ncvoid *) string) == -1) {
*rcode = ncerr;
return;
}
for (i = attlen; i < *lenstr; i++)
string[i] = ' ';
}
/* copies an attribute from one open netCDF file to another */
void
ncacpy(incdfid, invarid, attname, outcdfid, outvarid, rcode)
int *incdfid;
int *invarid;
char *attname;
int *outcdfid;
int *outvarid;
int *rcode;
{
int attnamelen = fslen(1);
char name[MAX_NC_NAME + 1];
(void) nstrncpy (name, attname, attnamelen);
*rcode = 0;
if (ncattcopy (*incdfid, *invarid - 1, name,
*outcdfid, *outvarid - 1) == -1) {
*rcode = ncerr;
}
}
/*
* gets the name of an attribute given its variable ID and number
* as an attribute of that variable
*/
void
ncanam(cdfid, varid, attnum, attname, rcode)
int *cdfid;
int *varid;
int *attnum;
char *attname;
int *rcode;
{
int attnamelen = fslen(1);
char name[MAX_NC_NAME + 1];
*rcode = 0;
if (ncattname (*cdfid, *varid - 1, *attnum - 1, name) == -1) {
*rcode = ncerr;
return;
}
if (strlen (name) > attnamelen) {
*rcode = NC_ESTS;
handle_err ("NCANAM", *rcode);
return;
}
fcdcpy (attname, attnamelen, name);
}
/* renames an attribute in an open netCDF file */
void
ncaren(cdfid, varid, attname, newname, rcode)
int *cdfid;
int *varid;
char *attname;
char *newname;
int *rcode;
{
int attnamelen = fslen(1);
int newnamelen = fslen(2);
char name[MAX_NC_NAME + 1], nname[MAX_NC_NAME + 1];
(void) nstrncpy (name, attname, attnamelen);
(void) nstrncpy (nname, newname, newnamelen);
*rcode = 0;
if (ncattrename (*cdfid, *varid - 1, name, nname) == -1) {
*rcode = ncerr;
}
}
/*
* deletes an attribute from an open netCDF file given the attribute
* name
*/
void
ncadel(cdfid, varid, attname, rcode)
int *cdfid;
int *varid;
char *attname;
int *rcode;
{
int attnamelen = fslen(1);
char name[MAX_NC_NAME + 1];
(void) nstrncpy (name, attname, attnamelen);
*rcode = 0;
if (ncattdel (*cdfid, *varid - 1, name) == -1) {
*rcode = ncerr;
}
}
/*
* sets the fill mode of a netCDF file open for writing
*/
int
ncsfil(cdfid, fillmode, rcode)
int *cdfid;
int *fillmode;
int *rcode;
{
int retval;
if ((retval = ncsetfill (*cdfid, *fillmode)) != -1) {
*rcode = 0;
return retval;
}
*rcode = ncerr;
return (-1);
}
syntax highlighted by Code2HTML, v. 0.9.1