This archive contains answers to questions sent to Unidata support through mid-2025. Note that the archive is no longer being updated. We provide the archive for reference; many of the answers presented here remain technically correct, even if somewhat outdated. For the most up-to-date information on the use of NSF Unidata software and data services, please consult the Software Documentation first.
> Subject: 970421: Compiling and linking under MSDOS > >To: NetCDF Support <address@hidden> > >From: Mike Lucas <"address@hidden"@erols.com> > >Subject: Compiling and linking under MSDOS > >Organization: Wyle Laboratories > >Keywords: 199704211541.JAA00258 Mike: Here is another cut at msoft32/jackets.c. By the way, be sure to tell your compiler to look in the libsrc directory for include files when attempting to compile this module. Also, as you peruse your documentation, be on the lookout for how to use the "msoft.int" interface description file. -glenn /* * Copyright 1990, University Corporation for Atmospheric Research * See netcdf/COPYRIGHT file for copying and redistribution conditions. */ /* $Id: jackets.src,v 1.38 1996/02/27 23:01:47 steve 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 MICROSOFT32. 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 <ctype.h> #include <string.h> #include <stdlib.h> #include <stdio.h> #include "netcdf.h" #include "ncconfig.h" #include "error.h" /* nc_advise() ... */ /* * 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; /* error handling function */ static void handle_err ( const char *const pname, /* procedure name */ const int rcode) /* error return */ { nc_advise(pname, rcode, "string won't fit in CHARACTER variable provided"); } /* blank fill C string to make FORTRAN string */ static int fcdcpy ( const char *const pname, /* procedure name to use for error report */ char *fstring, /* output string to be blank-filled */ const size_t fslen, /* length of output string */ const char *sstring) /* input string, null-terminated */ { const char *const end = &fstring[fslen]; while(fstring < end) { if(sstring == NULL) { *fstring++ = ' '; continue; } /* else */ if(*sstring == 0) { sstring = NULL; *fstring++ = ' '; continue; } /* else */ *fstring++ = *sstring++; } if(sstring != NULL && *sstring != 0) { /* the C string was bigger than the fortran string */ handle_err (pname, NC_ESTS); return NC_ESTS; } /* else */ return NC_NOERR; } static void reverse ( int array[], /* array to be reversed */ size_t length) /* length of array */ { size_t i, j; int temp; for (i = 0, j = length - 1; i < j; i++, j--) { temp = array[i]; array[i] = array[j]; array[j] = temp; } } static void revlong ( long array[], /* array to be reversed */ size_t length) /* length of array */ { size_t i, j; long temp; for (i = 0, j = length - 1; i < j; i++, j--) { temp = array[i]; array[i] = array[j]; array[j] = temp; } } /* copy function used to copy strings with embedded blanks */ static void fstrncpy ( char *target, /* space to be copied into */ const char *source, /* string to be copied */ size_t maxlen) /* maximum length of *source */ { while (maxlen-- != 0 && *source != '\0') *target++ = *source++; *target = '\0'; } /* copy function used to copy strings terminated with blanks */ static void nstrncpy ( char *target, /* space to be copied into */ const char *source, /* string to be copied */ size_t maxlen) /* maximum length of *source */ { while (maxlen-- != 0 && *source != ' ') *target++ = *source++; *target = '\0'; } /* copy function used to copy strings terminated with blanks */ static char * nstrndup ( const char *source, /* string to be copied */ int maxlen) /* maximum length of *source */ { char *target; /* space to be copied into */ size_t slen = 0; { const char *const end = &source[maxlen]; const char *cp = source; while(cp < end) { if(*cp == ' ') break; cp++; } slen = cp - source; } target = malloc(slen +1); if(target == NULL) return NULL; (void) memcpy(target, source, slen); target[slen] = 0; return target; } /* * Compute product of dimensions. */ static long dimprod ( long *dims, /* list of dimensions */ size_t 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; } /* * Convert a generalized 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 * itobg(ints, dims, basis, ndims) int *ints; /* multi-dimensional array of integers */ long *dims; /* list of dimensions */ long *basis; /* memory access basis vector */ int ndims; /* number of dimensions in list */ { long iocount = dimprod (dims, ndims); /* product of dimensions */ char *bytes = (char *) malloc (iocount * sizeof (char)); if (bytes != NULL && iocount > 0) { int idim; char *bp = bytes; char *ip = (char*)ints; long length[MAX_NC_DIMS]; long coords[MAX_NC_DIMS]; for (idim = 0; idim < ndims; ++idim) { length[idim] = dims[idim]*basis[idim]; coords[idim] = 0; } for (;;) { *bp++ = (char)*(int*)ip; idim = ndims - 1; carry: ip += basis[idim]; if (++coords[idim] >= dims[idim]) { coords[idim] = 0; ip -= length[idim]; if (--idim < 0) break; goto carry; } } } return bytes; } /* * Convert a packed array of bytes into a generalized multi-dimensional array * of ints. */ static void btoig(bytes, ints, dims, basis, ndims) char *bytes; /* packed array of bytes */ int *ints; /* multi-dimensional array of integers */ long *dims; /* list of dimensions */ long *basis; /* memory access basis vector */ int ndims; /* number of dimensions in list */ { if (dimprod (dims, ndims) > 0) { int idim; char *bp = bytes; char *ip = (char*)ints; long length[MAX_NC_DIMS]; long coords[MAX_NC_DIMS]; for (idim = 0; idim < ndims; ++idim) { length[idim] = dims[idim]*basis[idim]; coords[idim] = 0; } for (;;) { *(int*)ip = *bp++; idim = ndims - 1; carry: ip += basis[idim]; if (++coords[idim] >= dims[idim]) { coords[idim] = 0; ip -= length[idim]; if (--idim < 0) break; goto carry; } } } } #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; } /* * Convert a generalized 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 * itosg(ints, dims, basis, ndims) int *ints; /* multi-dimensional array of integers */ long *dims; /* list of dimensions */ long *basis; /* memory access basis vector */ int ndims; /* number of dimensions in list */ { long iocount = dimprod (dims, ndims); /* product of dimensions */ short *shorts = (short *) malloc (iocount * sizeof (short)); if (shorts != NULL && iocount > 0) { int idim; char *ip = (char*)ints; short *sp = shorts; long length[MAX_NC_DIMS]; long coords[MAX_NC_DIMS]; for (idim = 0; idim < ndims; ++idim) { length[idim] = dims[idim]*basis[idim]; coords[idim] = 0; } for (;;) { *sp++ = (short)*(int*)ip; idim = ndims - 1; carry: ip += basis[idim]; if (++coords[idim] >= dims[idim]) { coords[idim] = 0; ip -= length[idim]; if (--idim < 0) break; goto carry; } } } return shorts; } /* * Convert a packed array of shorts into a generalized multi-dimensional array * of ints. */ static void stoig(shorts, ints, dims, basis, ndims) short *shorts; /* packed array of shorts */ int *ints; /* multi-dimensional array of integers */ long *dims; /* list of dimensions */ long *basis; /* memory access basis vector */ int ndims; /* number of dimensions in list */ { if (dimprod (dims, ndims) > 0) { int idim; short *sp = shorts; char *ip = (char*)ints; long length[MAX_NC_DIMS]; long coords[MAX_NC_DIMS]; for (idim = 0; idim < ndims; ++idim) { length[idim] = dims[idim]*basis[idim]; coords[idim] = 0; } for (;;) { *(int*)ip = *sp++; idim = ndims - 1; carry: ip += basis[idim]; if (++coords[idim] >= dims[idim]) { coords[idim] = 0; ip -= length[idim]; if (--idim < 0) break; goto carry; } } } } #endif /* FORTRAN_HAS_NO_SHORT */ #if SIZEOF_INT == 4 && SIZEOF_INT < SIZEOF_NCINT /* * Convert multi-dimensional array of NCINTs stored in ints to packed * array of longs, in malloc'ed space. Returns pointer to longs or NULL * if malloc failed. */ static long * itol(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); long *longs = (long *) malloc (iocount * sizeof (long)); int *ip; long *lp = longs; if (longs != NULL) for (ip = ints; iocount > 0; iocount--) *lp++ = (long) *ip++; return longs; } /* * Convert a generalized multi-dimensional array of longs stored in ints to * packed array of longs, in malloc'ed space. Returns pointer to longs or * NULL if malloc failed. */ static long * itolg(ints, dims, imap, ndims) int *ints; /* multi-dimensional array of integers */ long *dims; /* list of dimensions */ long *imap; /* memory access index mapping vector */ int ndims; /* number of dimensions in list */ { long iocount = dimprod (dims, ndims); long *longs = (long *) malloc (iocount * sizeof (long)); if (longs != NULL && iocount > 0) { int idim; char *ip = (char*)ints; long *lp = longs; long length[MAX_NC_DIMS]; long coords[MAX_NC_DIMS]; for (idim = 0; idim < ndims; ++idim) { length[idim] = dims[idim]*imap[idim]; coords[idim] = 0; } for (;;) { *lp++ = (long)*(int*)ip; idim = ndims - 1; carry: ip += imap[idim]; if (++coords[idim] >= dims[idim]) { coords[idim] = 0; ip -= length[idim]; if (--idim < 0) break; goto carry; } } } return longs; } /* * Convert a packed array of longs into a generalized multi-dimensional array * of ints. */ static void ltoig(longs, ints, dims, imap, ndims) long *longs; /* packed array of longs */ int *ints; /* multi-dimensional array of integers */ long *dims; /* list of dimensions */ long *imap; /* memory access index mapping vector */ int ndims; /* number of dimensions in list */ { if (dimprod (dims, ndims) > 0) { int idim; long *lp = longs; char *ip = (char*)ints; long length[MAX_NC_DIMS]; long coords[MAX_NC_DIMS]; for (idim = 0; idim < ndims; ++idim) { length[idim] = dims[idim]*imap[idim]; coords[idim] = 0; } for (;;) { *(int*)ip = *lp++; idim = ndims - 1; carry: ip += imap[idim]; if (++coords[idim] >= dims[idim]) { coords[idim] = 0; ip -= length[idim]; if (--idim < 0) break; goto carry; } } } } #endif /* sizeof(int) < sizeof(nclong) above */ #ifdef FORTRAN_HAS_NO_FLOAT /* * Convert multi-dimensional array of floats stored in doubles to packed array * of floats, in malloc'ed space. Returns pointer to floats or NULL if malloc * failed. */ static float * dtof(doubles, dims, ndims) double *doubles; /* multi-dimensional array of doubles */ long *dims; /* list of dimensions */ int ndims; /* number of dimensions in list */ { long iocount = dimprod (dims, ndims); /* product of dimensions */ float *floats = (float *) malloc (iocount * sizeof (float)); double *dp; float *fp = floats; if (floats != NULL) for (dp = doubles; iocount > 0; iocount--) *fp++ = (float) *dp++; return floats; } /* * Convert a generalized multi-dimensional array of floats stored in doubles to * packed array of floats, in malloc'ed space. Returns pointer to floats or * NULL if malloc failed. */ static float * dtofg(doubles, dims, basis, ndims) double *doubles; /* multi-dimensional array of doubles */ long *dims; /* list of dimensions */ long *basis; /* memory access basis vector */ int ndims; /* number of dimensions in list */ { long iocount = dimprod (dims, ndims); /* product of dimensions */ float *floats = (float *) malloc (iocount * sizeof (float)); if (floats != NULL && iocount > 0) { int idim; char *dp = (char*)doubles; float *fp = floats; long length[MAX_NC_DIMS]; long coords[MAX_NC_DIMS]; for (idim = 0; idim < ndims; ++idim) { length[idim] = dims[idim]*basis[idim]; coords[idim] = 0; } for (;;) { *fp++ = (float)*(double*)dp; idim = ndims - 1; carry: dp += basis[idim]; if (++coords[idim] >= dims[idim]) { coords[idim] = 0; dp -= length[idim]; if (--idim < 0) break; goto carry; } } } return floats; } /* * Convert a packed array of floats into a generalized multi-dimensional array * of doubles. */ static void ftodg(floats, doubles, dims, basis, ndims) float *floats; /* packed array of floats */ double *doubles; /* multi-dimensional array of doubles */ long *dims; /* list of dimensions */ long *basis; /* memory access basis vector */ int ndims; /* number of dimensions in list */ { if (dimprod (dims, ndims) > 0) { int idim; float *fp = floats; char *dp = (char*)doubles; long length[MAX_NC_DIMS]; long coords[MAX_NC_DIMS]; for (idim = 0; idim < ndims; ++idim) { length[idim] = dims[idim]*basis[idim]; coords[idim] = 0; } for (;;) { *(double*)dp = *fp++; idim = ndims - 1; carry: dp += basis[idim]; if (++coords[idim] >= dims[idim]) { coords[idim] = 0; dp -= length[idim]; if (--idim < 0) break; goto carry; } } } } #endif /* FORTRAN_HAS_NO_FLOAT */ /* ------------ MICROSOFT32 FORTRAN jackets for netCDF Functions ------------ */ /* used to set the C global variable ncopts from Fortran */ void ncpopt(val) long *val; { ncopts = *val; } /* used to get the C global variable ncopts from Fortran */ void ncgopt(val) long *val; { *val = ncopts; } /* * creates a new netCDF file, returning a netCDF ID. New netCDF * file is placed in define mode. */ int nccre(pathname, pathnamelen, clobmode, rcode) char *pathname; unsigned int pathnamelen; long *clobmode; long *rcode; { char *name; int ncid; cdf_routine_name = "NCCRE"; if (*clobmode != NC_CLOBBER && *clobmode != NC_NOCLOBBER) { *rcode = NC_EINVAL; nc_advise(cdf_routine_name, *rcode, "bad flag, did you forget to include netcdf.inc?"); return (-1); } name = nstrndup(pathname, pathnamelen); if(name == NULL) { *rcode = NC_SYSERR; /* Out of memory */ return (-1); } if ((ncid = nccreate (name, *clobmode)) == -1) { free(name); *rcode = ncerr; return (-1); } free(name); *rcode = 0; return (ncid); } /* opens an existing netCDF file for access */ int ncopn(pathname, pathnamelen, rwmode, rcode) char *pathname; unsigned int pathnamelen; long *rwmode; long *rcode; { char *name; int ncid; cdf_routine_name = "NCOPN"; if (*rwmode != NC_NOWRITE && *rwmode != NC_WRITE) { *rcode = NC_EINVAL; nc_advise(cdf_routine_name, *rcode, "bad flag, did you forget to include netcdf.inc?"); return (-1); } name = nstrndup(pathname, pathnamelen); if(name == NULL) { *rcode = NC_SYSERR; /* Out of memory */ return (-1); } if ((ncid = ncopen (name, *rwmode)) == -1) { free(name); *rcode = ncerr; return (-1); } free(name); *rcode = 0; return (ncid); } /* adds a new dimension to an open netCDF file in define mode */ int ncddef(ncid, dimname, dimnamelen, dimlen, rcode) long *ncid; char *dimname; unsigned int dimnamelen; long *dimlen; long *rcode; { char name[MAX_NC_NAME + 1]; int dimid; nstrncpy (name, dimname, dimnamelen); if ((dimid = ncdimdef (*ncid, name, (long)*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(ncid, dimname, dimnamelen, rcode) long *ncid; char *dimname; unsigned int dimnamelen; long *rcode; { char name[MAX_NC_NAME + 1]; int dimid; nstrncpy (name, dimname, dimnamelen); if ((dimid = ncdimid (*ncid, 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(ncid, varname, varnamelen, datatype, ndims, dimarray, rcode) long *ncid; char *varname; unsigned int varnamelen; long *datatype; long *ndims; long *dimarray; long *rcode; { int varid, i, dimid[MAX_VAR_DIMS]; char name[MAX_NC_NAME + 1]; nstrncpy (name, varname, varnamelen); for (i = 0; i < *ndims; i++) dimid[i] = dimarray[i] - 1; reverse (dimid, *ndims); if ((varid = ncvardef (*ncid, 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(ncid, varname, varnamelen, rcode) long *ncid; char *varname; unsigned int varnamelen; long *rcode; { int varid; char name[MAX_NC_NAME + 1]; nstrncpy (name, varname, varnamelen); if ((varid = ncvarid (*ncid, name)) != -1) { *rcode = 0; return (varid + 1); } *rcode = ncerr; return (-1); } /* returns number of bytes per netCDF data type */ int nctlen(datatype, rcode) long *datatype; long *rcode; { int itype; if ((itype = (int) nctypelen ((nc_type) *datatype)) != -1) { *rcode = 0; return (itype); } *rcode = ncerr; return (-1); } /* closes an open netCDF file */ void ncclos(ncid, rcode) long *ncid; long *rcode; { *rcode = 0; if (ncclose (*ncid) == -1) *rcode = ncerr; } /* puts an open netCDF into define mode */ void ncredf(ncid, rcode) long *ncid; long *rcode; { *rcode = 0; if (ncredef (*ncid) == -1) *rcode = ncerr; } /* takes an open netCDF out of define mode */ void ncendf(ncid, rcode) long *ncid; long *rcode; { *rcode = 0; if (ncendef (*ncid) == -1) *rcode = ncerr; } /* returns information about an open netCDF file given its netCDF ID */ void ncinq(ncid, indims, invars, inatts, irecdim, rcode) long *ncid; long *indims; long *invars; long *inatts; long *irecdim; long *rcode; { int ndims; int nvars; int natts; *rcode = 0; if (ncinquire (*ncid, &ndims, &nvars, &natts, irecdim) == -1) { *rcode = ncerr; return; } *indims = ndims; *invars = nvars; *inatts = natts; if (*irecdim != -1) (*irecdim)++; } /* * makes sure that the disk copy of a netCDF file open for writing * is current */ void ncsnc(ncid, rcode) long *ncid; long *rcode; { *rcode = 0; if (ncsync (*ncid) == -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(ncid, rcode) long *ncid; long *rcode; { *rcode = 0; if (ncabort (*ncid) == -1) *rcode = ncerr; } /* returns the name and size of a dimension, given its ID */ void ncdinq(ncid, dimid, dimname, dimnamelen, size, rcode) long *ncid; long *dimid; char *dimname; unsigned int dimnamelen; long *size; long *rcode; { long siz; char name[MAX_NC_NAME + 1]; *rcode = 0; if (ncdiminq (*ncid, *dimid - 1, name, &siz) == -1) { *rcode = ncerr; return; } *size = siz; /* blank fill the input character string */ *rcode = fcdcpy ("NCDINQ", dimname, dimnamelen, name); } /* renames an existing dimension in a netCDF open for writing */ void ncdren(ncid, dimid, dimname, dimnamelen, rcode) long *ncid; long *dimid; char *dimname; unsigned int dimnamelen; long *rcode; { char name[MAX_NC_NAME + 1]; nstrncpy (name, dimname, dimnamelen); *rcode = 0; if (ncdimrename (*ncid, *dimid - 1, name) == -1) *rcode = ncerr; } /* returns information about a netCDF variable, given its ID */ void ncvinq(ncid, varid, varname, varnamelen, datatype, indims, dimarray, inatts, rcode) long *ncid; long *varid; char *varname; unsigned int varnamelen; long *datatype; long *indims; long *dimarray; long *inatts; long *rcode; { char name[MAX_NC_NAME + 1]; int dimid[MAX_VAR_DIMS], i; int ndims; int natts; *rcode = 0; if (ncvarinq (*ncid, *varid - 1, name, (nc_type *) datatype, &ndims, dimid, &natts) == -1) { *rcode = ncerr; return; } *indims = ndims; *inatts = natts; for (i = 0; i < ndims; i++) dimarray[i] = dimid[i] + 1; reverse (dimarray, (int)ndims); *rcode = fcdcpy ("NCVINQ", varname, varnamelen, name); } /* puts a single numeric data value into a variable of an open netCDF */ void ncvpt1(ncid, varid, indices, value, rcode) long *ncid; long *varid; long *indices; void *value; long *rcode; { int i; int ndims; nc_type datatype; long nindices[MAX_VAR_DIMS]; int dimid[MAX_VAR_DIMS]; if (ncvarinq (*ncid, *varid - 1, (char *) 0, & datatype, &ndims, dimid, NULL) == -1) { *rcode = ncerr; return; } for (i = 0; i < ndims; i++) nindices[i] = indices[i] - 1; revlong (nindices, ndims); *rcode = 0; #ifdef FORTRAN_HAS_NO_BYTE if (datatype == NC_BYTE) { /* pack ints into bytes */ char bytes = *(int *) value; if (ncvarput1(*ncid, *varid - 1, nindices, (void *) &bytes) == -1) { *rcode = ncerr; } return; } /* else */ #endif /* FORTRAN_HAS_NO_BYTE */ #ifdef FORTRAN_HAS_NO_SHORT if (datatype == NC_SHORT) { /* pack ints into shorts */ short shorts = *(int *)value; if (ncvarput1(*ncid, *varid - 1, nindices, (void *) &shorts) == -1) { *rcode = ncerr; } return; } /* else */ #endif /* FORTRAN_HAS_NO_SHORT */ #if SIZEOF_INT == 4 && SIZEOF_INT < SIZEOF_NCINT if (datatype == NC_INT) { ncint ncint = *(int *)value; if (ncvarput1(*ncid, *varid - 1, nindices, (void *) &ncint) == -1) { *rcode = ncerr; } return; } /* else */ #endif #ifdef FORTRAN_HAS_NO_FLOAT if (datatype == NC_FLOAT) { /* pack doubles into floats */ float floats = *(double *)value; if (ncvarput1(*ncid, *varid - 1, nindices, (ncvoid *) &floats) == -1) { *rcode = ncerr; } return; } /* else */ #endif /* FORTRAN_HAS_NO_FLOAT */ if (ncvarput1 (*ncid, *varid - 1, nindices, value) == -1) { *rcode = ncerr; } } /* puts a single character into an open netCDF file */ void ncvp1c(ncid, varid, indices, chval, chvallen, rcode) long *ncid; long *varid; long *indices; char *chval; unsigned int chvallen; long *rcode; { int i; int ndims; nc_type datatype; long nindices[MAX_VAR_DIMS]; int dimid[MAX_VAR_DIMS]; if (ncvarinq (*ncid, *varid - 1, (char *) 0, & datatype, &ndims, dimid, NULL) == -1) { *rcode = ncerr; return; } for (i = 0; i < ndims; i++) nindices[i] = indices[i] - 1; revlong (nindices, ndims); *rcode = 0; if (ncvarput1 (*ncid, *varid - 1, nindices, (void *) chval) == -1) { *rcode = ncerr; } } /* * writes a hypercube of numeric values into a netCDF variable of an open * netCDF file */ void ncvpt(ncid, varid, start, count, value, rcode) long *ncid; long *varid; long *start; long *count; void *value; long *rcode; { int i; long ncount[MAX_VAR_DIMS], nstart[MAX_VAR_DIMS]; int ndims; nc_type datatype; if (ncvarinq (*ncid, *varid - 1, (char *) 0, & datatype, &ndims, NULL, NULL) == -1) { *rcode = ncerr; return; } for (i = 0; i < ndims; i++) { ncount[i] = count[i]; nstart[i] = start[i] - 1; } revlong (ncount, ndims); revlong (nstart, ndims); *rcode = 0; #ifdef FORTRAN_HAS_NO_BYTE if (datatype == NC_BYTE) { /* pack ints into bytes */ char *bytes = itob (value, ncount, ndims); if (bytes == NULL) { *rcode = NC_SYSERR; return; } if (ncvarput (*ncid, *varid - 1, nstart, ncount, (void *) bytes) == -1) { *rcode = ncerr; } free (bytes); return; } /* else */ #endif /* FORTRAN_HAS_NO_BYTE */ #ifdef FORTRAN_HAS_NO_SHORT if (datatype == NC_SHORT) { /* pack ints into shorts */ short *shorts = itos (value, ncount, ndims); if (shorts == NULL) { *rcode = NC_SYSERR; return; } if (ncvarput (*ncid, *varid - 1, nstart, ncount, (void *) shorts) == -1) { *rcode = ncerr; } free (shorts); return; } /* else */ #endif /* FORTRAN_HAS_NO_SHORT */ #if SIZEOF_INT == 4 && SIZEOF_INT < SIZEOF_NCINT if (datatype == NC_INT) { ncint *ncints = itol (value, ncount, ndims); if (ncints == NULL) { *rcode = NC_SYSERR; return; } if (ncvarput (*ncid, *varid - 1, nstart, ncount, (void *) ncints) == -1) { *rcode = ncerr; } free (ncints); return; } /* else */ #endif #ifdef FORTRAN_HAS_NO_FLOAT if (datatype == NC_FLOAT) { /* pack doubles into floats */ float *floats = dtof (value, ncount, ndims); if (floats == NULL) { *rcode = NC_SYSERR; return; } if (ncvarput (*ncid, *varid - 1, nstart, ncount, (ncvoid *) floats) == -1) { *rcode = ncerr; } free (floats); return; } /* else */ #endif /* FORTRAN_HAS_NO_FLOAT */ if (ncvarput (*ncid, *varid - 1, nstart, ncount, value) == -1) { *rcode = ncerr; } } /* writes a hypercube of character values into an open netCDF file */ void ncvptc(ncid, varid, start, count, string, stringlen, lenstr, rcode) long *ncid; long *varid; long *start; long *count; char *string; unsigned int stringlen; long *lenstr; long *rcode; { int i; long ncount[MAX_VAR_DIMS], nstart[MAX_VAR_DIMS]; int ndims; nc_type datatype; if (ncvarinq (*ncid, *varid - 1, (char *) 0, & datatype, &ndims, NULL, NULL) == -1) { *rcode = ncerr; return; } for (i = 0; i < ndims; i++) { ncount[i] = count[i]; nstart[i] = start[i] - 1; } revlong (ncount, ndims); revlong (nstart, ndims); if (dimprod(ncount,ndims) > *lenstr) { *rcode = NC_ESTS; handle_err ("NCVPTC", *rcode); return; } *rcode = 0; if (ncvarput (*ncid, *varid - 1, nstart, ncount, (void *) string) == -1) { *rcode = ncerr; } } /* * writes a generalized hypercube of numeric values into a netCDF variable of * an open netCDF file */ void ncvptg(ncid, varid, start, count, stride, basis, value, rcode) long *ncid; long *varid; long *start; long *count; long *stride; long *basis; void *value; long *rcode; { int i; long ncount[MAX_VAR_DIMS], nstart[MAX_VAR_DIMS]; long nstride[MAX_VAR_DIMS], nbasis[MAX_VAR_DIMS]; long tmpbasis; int ndims; nc_type datatype; if (ncvarinq (*ncid, *varid - 1, (char *) 0, & datatype, &ndims, NULL, NULL) == -1) { *rcode = ncerr; return; } #ifdef FORTRAN_HAS_NO_BYTE if (datatype == NC_CHAR || datatype == NC_BYTE) tmpbasis = (ptrdiff_t) nctypelen(NC_INT); else #endif #ifdef FORTRAN_HAS_NO_SHORT if (datatype == NC_SHORT) tmpbasis = (ptrdiff_t) nctypelen(NC_INT); else #endif #if SIZEOF_INT == 4 && SIZEOF_INT < SIZEOF_NCINT if (datatype == NC_INT) tmpbasis = (ptrdiff_t) sizeof(int); else #endif #ifdef FORTRAN_HAS_NO_FLOAT if (datatype == NC_FLOAT) tmpbasis = (ptrdiff_t) nctypelen(NC_DOUBLE); else #endif tmpbasis = (ptrdiff_t) nctypelen(datatype); for (i = 0; i < ndims; i++) { ncount[i] = count[i]; nstart[i] = start[i] - 1; nstride[i] = stride[0] == 0 ? 1 : stride[i]; nbasis[i] = basis[0] == 0 ? tmpbasis : basis[i]; tmpbasis *= count[i]; } revlong (ncount, ndims); revlong (nstart, ndims); revlong (nstride, ndims); revlong (nbasis, ndims); *rcode = 0; #ifdef FORTRAN_HAS_NO_BYTE if (datatype == NC_BYTE) { /* pack ints into bytes */ /* * Release 2.3.1 had a bug in the following line: it used count * rather than ncount. */ char *bytes = itobg (value, ncount, nbasis, ndims); if (bytes == NULL) { *rcode = NC_SYSERR; return; } if (ncvarputg (*ncid, *varid - 1, nstart, ncount, nstride, (long*)NULL, (void *) bytes) == -1) { *rcode = ncerr; } free (bytes); return; } /* else */ #endif /* FORTRAN_HAS_NO_BYTE */ #ifdef FORTRAN_HAS_NO_SHORT if (datatype == NC_SHORT) { /* pack ints into shorts */ /* * Release 2.3.1 had a bug in the following line: it used count * rather than ncount. */ short *shorts = itosg (value, ncount, nbasis, ndims); if (shorts == NULL) { *rcode = NC_SYSERR; return; } if (ncvarputg (*ncid, *varid - 1, nstart, ncount, nstride, (long*)NULL, (void *) shorts) == -1) { *rcode = ncerr; } free (shorts); return; } /* else */ #endif /* FORTRAN_HAS_NO_SHORT */ #if SIZEOF_INT == 4 && SIZEOF_INT < SIZEOF_NCINT if (datatype == NC_INT) { ncint *ncints = itolg (value, ncount, nbasis, ndims); if (ncints == NULL) { *rcode = NC_SYSERR; return; } if (ncvarputg (*ncid, *varid - 1, nstart, ncount, nstride, (long*)NULL, (void *) ncints) == -1) { *rcode = ncerr; } free (ncints); return; } /* else */ #endif #ifdef FORTRAN_HAS_NO_FLOAT if (datatype == NC_FLOAT) { /* pack doubles into floats */ float *floats = dtofg (value, ncount, nbasis, ndims); if (floats == NULL) { *rcode = NC_SYSERR; return; } if (ncvarputg (*ncid, *varid - 1, nstart, ncount, nstride, (long*)NULL, (ncvoid *) floats) == -1) { *rcode = ncerr; } free (floats); return; } /* else */ #endif /* FORTRAN_HAS_NO_FLOAT */ if (ncvarputg (*ncid, *varid - 1, nstart, ncount, nstride, nbasis, value) == -1) { *rcode = ncerr; } } /* * writes a generalized hypercube of character values into a netCDF variable of * an open netCDF file */ void ncvpgc(ncid, varid, start, count, stride, basis, string, stringlen, rcode) long *ncid; long *varid; long *start; long *count; long *stride; long *basis; char *string; unsigned int stringlen; long *rcode; { int i; long ncount[MAX_VAR_DIMS], nstart[MAX_VAR_DIMS]; long nstride[MAX_VAR_DIMS], nbasis[MAX_VAR_DIMS]; long tmpbasis; int ndims; nc_type datatype; if (ncvarinq (*ncid, *varid - 1, (char *) 0, & datatype, &ndims, NULL, NULL) == -1) { *rcode = ncerr; return; } tmpbasis = (ptrdiff_t) nctypelen(datatype); for (i = 0; i < ndims; i++) { ncount[i] = count[i]; nstart[i] = start[i] - 1; nstride[i] = stride[0] == 0 ? 1 : stride[i]; nbasis[i] = basis[0] == 0 ? tmpbasis : basis[i]; tmpbasis *= count[i]; } revlong (ncount, ndims); revlong (nstart, ndims); revlong (nstride, ndims); revlong (nbasis, ndims); *rcode = 0; if (ncvarputg (*ncid, *varid - 1, nstart, ncount, nstride, nbasis, (void*)string) == -1) { *rcode = ncerr; } } /* gets a single numeric value from a variable of an open netCDF file */ void ncvgt1(ncid, varid, indices, value, rcode) long *ncid; long *varid; long *indices; void *value; long *rcode; { int i; long nindices[MAX_VAR_DIMS]; int ndims; nc_type datatype; if (ncvarinq (*ncid, *varid - 1, (char *) 0, & datatype, &ndims, NULL, NULL) == -1) { *rcode = ncerr; return; } for (i = 0; i < ndims; i++) { nindices[i] = indices[i] - 1; } revlong (nindices, ndims); *rcode = 0; #ifdef FORTRAN_HAS_NO_BYTE if (datatype == NC_BYTE) { char bytes; int *ip = (int *) value; char *bp = &bytes; if (ncvarget1(*ncid, *varid - 1, nindices, (void *) &bytes) == -1) { *rcode = ncerr; return; } *ip = *bp; return; } /* else */ #endif /* FORTRAN_HAS_NO_BYTE */ #ifdef FORTRAN_HAS_NO_SHORT if (datatype == NC_SHORT) { short shorts; int *ip = (int *) value; short *sp = &shorts; if (ncvarget1(*ncid, *varid - 1, nindices, (void *) &shorts) == -1) { *rcode = ncerr; return; } *ip = *sp; return; } /* else */ #endif /* FORTRAN_HAS_NO_SHORT */ #if SIZEOF_INT == 4 && SIZEOF_INT < SIZEOF_NCINT if (datatype == NC_INT) { ncint ncints; int *ip = (int *) value; if (ncvarget1(*ncid, *varid - 1, nindices, (void *) &ncints) == -1) { *rcode = ncerr; return; } *ip = ncints; return; } /* else */ #endif #ifdef FORTRAN_HAS_NO_FLOAT if (datatype == NC_FLOAT) { float floats; double *dp = (double *) value; float *fp = &floats; if (ncvarget1(*ncid, *varid - 1, nindices, (ncvoid *) &floats) == -1) { *rcode = ncerr; return; } *dp = *fp; return; } /* else */ #endif /* FORTRAN_HAS_NO_FLOAT */ if (ncvarget1 (*ncid, *varid - 1, nindices, value) == -1) { *rcode = ncerr; } } /* * gets a single character data value from a variable of an open * netCDF file */ void ncvg1c(ncid, varid, indices, chval, chvallen, rcode) long *ncid; long *varid; long *indices; char *chval; unsigned int chvallen; long *rcode; { int i; long nindices[MAX_VAR_DIMS]; int ndims; nc_type datatype; if (ncvarinq (*ncid, *varid - 1, (char *) 0, & datatype, &ndims, NULL, NULL) == -1) { *rcode = ncerr; return; } for (i = 0; i < ndims; i++) { nindices[i] = indices[i] - 1; } revlong (nindices, ndims); *rcode = 0; if (ncvarget1 (*ncid, *varid - 1, nindices, (void *) chval) == -1) { *rcode = ncerr; } } /* * reads a hypercube of numeric values from a netCDF variable of an open * netCDF file */ void ncvgt(ncid, varid, start, count, value, rcode) long *ncid; long *varid; long *start; long *count; void *value; long *rcode; { int i; long ncount[MAX_VAR_DIMS], nstart[MAX_VAR_DIMS]; int ndims; nc_type datatype; if (ncvarinq (*ncid, *varid - 1, (char *) 0, & datatype, &ndims, NULL, NULL) == -1) { *rcode = ncerr; return; } for (i = 0; i < ndims; i++) { ncount[i] = count[i]; nstart[i] = start[i] - 1; } revlong (ncount, ndims); revlong (nstart, ndims); *rcode = 0; #ifdef FORTRAN_HAS_NO_BYTE if (datatype == NC_BYTE) { size_t iocount = dimprod (ncount, 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 (*ncid, *varid - 1, nstart, ncount, (void *) 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 (datatype == NC_SHORT) { long iocount = dimprod (ncount, 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 (*ncid, *varid - 1, nstart, ncount, (void *) 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 SIZEOF_INT == 4 && SIZEOF_INT < SIZEOF_NCINT if (datatype == NC_INT) { long iocount = dimprod (ncount, ndims); /* product of dimensions */ ncint *ncints = (ncint *) malloc (iocount * sizeof (ncint)); int *ip; ncint *lp = ncints; if (ncints == NULL) { *rcode = NC_SYSERR; return; } if (ncvarget (*ncid, *varid - 1, nstart, ncount, (void *) ncints) == -1) { *rcode = ncerr; free (ncints); return; } for (ip = (int *) value; iocount > 0; iocount--) *ip++ = *lp++; free (ncints); return; } /* else */ #endif #ifdef FORTRAN_HAS_NO_FLOAT if (datatype == NC_FLOAT) { long iocount = dimprod (ncount, ndims); /* product of dimensions */ float *floats = (float *) malloc (iocount * sizeof (float)); double *dp; float *fp = floats; if (floats == NULL) { *rcode = NC_SYSERR; return; } if (ncvarget (*ncid, *varid - 1, nstart, ncount, (ncvoid *) floats) == -1) { *rcode = ncerr; free (floats); return; } for (dp = (double *) value; iocount > 0; iocount--) *dp++ = *fp++; free (floats); return; } /* else */ #endif /* FORTRAN_HAS_NO_FLOAT */ if (ncvarget (*ncid, *varid - 1, nstart, ncount, value) == -1) { *rcode = ncerr; } } /* reads a hypercube of character values from a netCDF variable */ void ncvgtc(ncid, varid, start, count, string, stringlen, lenstr, rcode) long *ncid; long *varid; long *start; long *count; char *string; unsigned int stringlen; long *lenstr; long *rcode; { int i; long ncount[MAX_VAR_DIMS], nstart[MAX_VAR_DIMS]; int ndims; nc_type datatype; int prod = 1; if (ncvarinq (*ncid, *varid - 1, (char *) 0, & datatype, &ndims, NULL, NULL) == -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; } revlong (ncount, ndims); revlong (nstart, ndims); *rcode = 0; if (ncvarget (*ncid, *varid - 1, nstart, ncount, (void *) string) == -1) { *rcode = ncerr; return; } for (i = prod; i < *lenstr; i++) string[i] = ' '; } /* * reads a generalized hypercube of numeric values from a netCDF variable of an * open netCDF file */ void ncvgtg(ncid, varid, start, count, stride, basis, value, rcode) long *ncid; long *varid; long *start; long *count; long *stride; long *basis; void *value; long *rcode; { int i; long ncount[MAX_VAR_DIMS], nstart[MAX_VAR_DIMS]; long nstride[MAX_VAR_DIMS], nbasis[MAX_VAR_DIMS]; long tmpbasis; int ndims; nc_type datatype; if (ncvarinq (*ncid, *varid - 1, (char *) 0, & datatype, &ndims, NULL, NULL) == -1) { *rcode = ncerr; return; } #ifdef FORTRAN_HAS_NO_BYTE if (datatype == NC_CHAR || datatype == NC_BYTE) tmpbasis = (ptrdiff_t) nctypelen(NC_INT); else #endif #ifdef FORTRAN_HAS_NO_SHORT if (datatype == NC_SHORT) tmpbasis = (ptrdiff_t) nctypelen(NC_INT); else #endif #if SIZEOF_INT == 4 && SIZEOF_INT < SIZEOF_NCINT if (datatype == NC_INT) tmpbasis = sizeof(int); else #endif #ifdef FORTRAN_HAS_NO_FLOAT if (datatype == NC_FLOAT) tmpbasis = (ptrdiff_t) nctypelen(NC_DOUBLE); else #endif tmpbasis = (ptrdiff_t) nctypelen(datatype); for (i = 0; i < ndims; i++) { ncount[i] = count[i]; nstart[i] = start[i] - 1; nstride[i] = stride[0] == 0 ? 1 : stride[i]; nbasis[i] = basis[0] == 0 ? tmpbasis : basis[i]; tmpbasis *= count[i]; } revlong (ncount, ndims); revlong (nstart, ndims); revlong (nstride, ndims); revlong (nbasis, ndims); *rcode = 0; #ifdef FORTRAN_HAS_NO_BYTE if (datatype == NC_BYTE) { long iocount = dimprod (ncount, ndims); /* product of dimensions */ char *bytes = (char *) malloc (iocount * sizeof (char)); int *ip; char *bp = bytes; if (bytes == NULL) { *rcode = NC_SYSERR; return; } if (ncvargetg (*ncid, *varid - 1, nstart, ncount, nstride, (long*)NULL, (void *) bytes) == -1) { *rcode = ncerr; free (bytes); return; } /* * Release 2.3.1 had a bug in the following line: it used basis * rather than nbasis. */ btoig(bytes, (int*)value, ncount, nbasis, ndims); free (bytes); return; } /* else */ #endif /* FORTRAN_HAS_NO_BYTE */ #ifdef FORTRAN_HAS_NO_SHORT if (datatype == NC_SHORT) { long iocount = dimprod (ncount, ndims); /* product of dimensions */ short *shorts = (short *) malloc (iocount * sizeof (short)); int *ip; short *sp = shorts; if (shorts == NULL) { *rcode = NC_SYSERR; return; } if (ncvargetg (*ncid, *varid - 1, nstart, ncount, nstride, (long*)NULL, (void *) shorts) == -1) { *rcode = ncerr; free (shorts); return; } /* * Release 2.3.1 had a bug in the following line: it used basis * rather than nbasis. */ stoig(shorts, (int*)value, ncount, nbasis, ndims); free (shorts); return; } /* else */ #endif /* FORTRAN_HAS_NO_SHORT */ #if SIZEOF_INT == 4 && SIZEOF_INT < SIZEOF_NCINT if (datatype == NC_INT) { long iocount = dimprod (ncount, ndims); /* product of dimensions */ ncint *ncints = (ncint *) malloc (iocount * sizeof (ncint)); if (ncints == NULL) { *rcode = NC_SYSERR; return; } if (ncvargetg (*ncid, *varid - 1, nstart, ncount, nstride, (long*)NULL, (void *) ncints) == -1) { *rcode = ncerr; free (ncints); return; } ltoig(ncints, (int*)value, ncount, nbasis, ndims); free (ncints); return; } /* else */ #endif #ifdef FORTRAN_HAS_NO_FLOAT if (datatype == NC_FLOAT) { long iocount = dimprod (ncount, ndims); /* product of dimensions */ float *floats = (float *) malloc (iocount * sizeof (float)); if (floats == NULL) { *rcode = NC_SYSERR; return; } if (ncvargetg (*ncid, *varid - 1, nstart, ncount, nstride, (long*)NULL, (ncvoid *) floats) == -1) { *rcode = ncerr; free (floats); return; } ftodg(floats, (double*)value, ncount, nbasis, ndims); free (floats); return; } /* else */ #endif /* FORTRAN_HAS_NO_FLOAT */ if (ncvargetg (*ncid, *varid - 1, nstart, ncount, nstride, nbasis, value) == -1) { *rcode = ncerr; } } /* * reads a generalized hypercube of character values from a netCDF variable * of an open netCDF file */ void ncvggc(ncid, varid, start, count, stride, basis, string, stringlen, rcode) long *ncid; long *varid; long *start; long *count; long *stride; long *basis; char *string; unsigned int stringlen; long *rcode; { int i; long ncount[MAX_VAR_DIMS], nstart[MAX_VAR_DIMS]; long nstride[MAX_VAR_DIMS], nbasis[MAX_VAR_DIMS]; long tmpbasis; int ndims; nc_type datatype; if (ncvarinq (*ncid, *varid - 1, (char *) 0, & datatype, &ndims, NULL, NULL) == -1) { *rcode = ncerr; return; } tmpbasis = (ptrdiff_t) nctypelen(datatype); for (i = 0; i < ndims; i++) { ncount[i] = count[i]; nstart[i] = start[i] - 1; nstride[i] = stride[0] == 0 ? 1 : stride[i]; nbasis[i] = basis[0] == 0 ? tmpbasis : basis[i]; tmpbasis *= count[i]; } revlong (ncount, ndims); revlong (nstart, ndims); revlong (nstride, ndims); revlong (nbasis, ndims); *rcode = 0; if (ncvargetg (*ncid, *varid - 1, nstart, ncount, nstride, nbasis, (void*)string) == -1) { *rcode = ncerr; } } /* changes the name of a netCDF variable in an open netCDF file */ void ncvren(ncid, varid, varname, varnamelen, rcode) long *ncid; long *varid; char *varname; unsigned int varnamelen; long *rcode; { char name[MAX_NC_NAME + 1]; nstrncpy (name, varname, varnamelen); *rcode = 0; if (ncvarrename (*ncid, *varid - 1, name) == -1) { *rcode = ncerr; } } /* * adds or changes a numeric variable or global attribute of an open * netCDF file */ void ncapt(ncid, varid, attname, attnamelen, datatype, attlen, value, rcode) long *ncid; long *varid; char *attname; unsigned int attnamelen; long *datatype; long *attlen; void *value; long *rcode; { char name[MAX_NC_NAME + 1]; nstrncpy (name, attname, attnamelen); *rcode = 0; #ifdef FORTRAN_HAS_NO_BYTE if ((nc_type) *datatype == NC_BYTE) { /* pack ints into bytes */ long ncount = *attlen; char *bytes = itob (value, &ncount, 1); if (bytes == NULL) { *rcode = NC_SYSERR; return; } if (ncattput (*ncid, *varid - 1, name, (nc_type) *datatype, *attlen, (void *) 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 */ long ncount = *attlen; short *shorts = itos (value, &ncount, 1); if (shorts == NULL) { *rcode = NC_SYSERR; return; } if (ncattput (*ncid, *varid - 1, name, (nc_type) *datatype, *attlen, (void *) shorts) == -1) { *rcode = ncerr; } free (shorts); return; } /* else */ #endif /* FORTRAN_HAS_NO_SHORT */ #if SIZEOF_INT == 4 && SIZEOF_INT < SIZEOF_NCINT if ((nc_type) *datatype == NC_INT) { long ncount = *attlen; ncint *ncints = itol (value, &ncount, 1); if (ncints == NULL) { *rcode = NC_SYSERR; return; } if (ncattput (*ncid, *varid - 1, name, (nc_type) *datatype, *attlen, (void *) ncints) == -1) { *rcode = ncerr; } free (ncints); return; } /* else */ #endif #ifdef FORTRAN_HAS_NO_FLOAT if ((nc_type) *datatype == NC_FLOAT) { /* pack ints into floats */ long ncount = *attlen; float *floats = dtof (value, &ncount, 1); if (floats == NULL) { *rcode = NC_SYSERR; return; } if (ncattput (*ncid, *varid - 1, name, (nc_type) *datatype, *attlen, (ncvoid *) floats) == -1) { *rcode = ncerr; } free (floats); return; } /* else */ #endif /* FORTRAN_HAS_NO_FLOAT */ if (ncattput (*ncid, *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(ncid, varid, attname, attnamelen, datatype, lenstr, string, stringlen, rcode) long *ncid; long *varid; char *attname; unsigned int attnamelen; long *datatype; long *lenstr; char *string; unsigned int stringlen; long *rcode; { char name[MAX_NC_NAME + 1]; char *value; nstrncpy (name, attname, attnamelen); if (((value = (char *)malloc ((unsigned) *lenstr + 1)) == NULL) || (*lenstr == 0)) { *rcode = NC_ESTS; handle_err ("NCAPTC", *rcode); return; } (void) fstrncpy (value, string, *lenstr); *rcode = 0; if (ncattput (*ncid, *varid - 1, name, (nc_type) *datatype, *lenstr, (void *) value) == -1) { *rcode = ncerr; } free (value); } /* * returns information about a netCDF attribute given its variable * ID and name */ void ncainq(ncid, varid, attname, attnamelen, datatype, iattlen, rcode) long *ncid; long *varid; char *attname; unsigned int attnamelen; long *datatype; long *iattlen; long *rcode; { char name[MAX_NC_NAME + 1]; int attlen; nstrncpy (name, attname, attnamelen); *rcode = 0; if (ncattinq (*ncid, *varid - 1, name, (nc_type *) datatype, &attlen) == -1) { *rcode = ncerr; } *iattlen = attlen; } /* * gets the value of a netCDF attribute given its variable ID * and name */ void ncagt(ncid, varid, attname, attnamelen, value, rcode) long *ncid; long *varid; char *attname; unsigned int attnamelen; void *value; long *rcode; { char name[MAX_NC_NAME + 1]; nc_type datatype; int attlen; nstrncpy (name, attname, attnamelen); *rcode = 0; if (ncattinq (*ncid, *varid - 1, name, &datatype, &attlen) == -1) { *rcode = ncerr; return; } #ifdef FORTRAN_HAS_NO_BYTE if (datatype == NC_BYTE) { char *bytes = (char *) malloc (attlen); int *ip; char *bp = bytes; if (bytes == NULL) { *rcode = NC_SYSERR; return; } if (ncattget (*ncid, *varid - 1, name, (void *) 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 (datatype == NC_SHORT) { short *shorts = (short *) malloc (attlen * sizeof (short)); int *ip; short *sp = shorts; if (shorts == NULL) { *rcode = NC_SYSERR; return; } if (ncattget (*ncid, *varid - 1, name, (void *) 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 SIZEOF_INT == 4 && SIZEOF_INT < SIZEOF_NCINT if (datatype == NC_INT) { ncint *ncints = (ncint *) malloc (attlen * sizeof (ncint)); int *ip; ncint *lp = ncints; if (ncints == NULL) { *rcode = NC_SYSERR; return; } if (ncattget (*ncid, *varid - 1, name, (void *) ncints) == -1) { *rcode = ncerr; free (ncints); return; } for (ip = (int *) value; attlen > 0; attlen--) *ip++ = *lp++; free (ncints); return; } /* else */ #endif #ifdef FORTRAN_HAS_NO_FLOAT if (datatype == NC_FLOAT) { float *floats = (float *) malloc (attlen * sizeof (float)); double *dp; float *fp = floats; if (floats == NULL) { *rcode = NC_SYSERR; return; } if (ncattget (*ncid, *varid - 1, name, (ncvoid *) floats) == -1) { *rcode = ncerr; free (floats); return; } for (dp = (double *) value; attlen > 0; attlen--) *dp++ = *fp++; free (floats); return; } /* else */ #endif /* FORTRAN_HAS_NO_FLOAT */ if (ncattget (*ncid, *varid - 1, name, value) == -1) { *rcode = ncerr; } } /* * gets the value of a netCDF character attribute given its variable * ID and name */ void ncagtc(ncid, varid, attname, attnamelen, string, stringlen, lenstr, rcode) long *ncid; long *varid; char *attname; unsigned int attnamelen; char *string; unsigned int stringlen; long *lenstr; long *rcode; { char name[MAX_NC_NAME + 1]; nc_type datatype; int attlen; int i; nstrncpy (name, attname, attnamelen); *rcode = 0; if (ncattinq (*ncid, *varid - 1, name, &datatype, &attlen) == -1) { *rcode = ncerr; return; } if (attlen > *lenstr) { *rcode = NC_ESTS; handle_err ("NCAGTC", *rcode); return; } if (ncattget (*ncid, *varid - 1, name, (void *) string) == -1) { *rcode = ncerr; return; } for (i = (int) attlen; i < *lenstr; i++) string[i] = ' '; } /* copies an attribute from one open netCDF file to another */ void ncacpy(inncid, invarid, attname, attnamelen, outncid, outvarid, rcode) long *inncid; long *invarid; char *attname; unsigned int attnamelen; long *outncid; long *outvarid; long *rcode; { char name[MAX_NC_NAME + 1]; nstrncpy (name, attname, attnamelen); *rcode = 0; if (ncattcopy (*inncid, *invarid - 1, name, *outncid, *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(ncid, varid, attnum, attname, attnamelen, rcode) long *ncid; long *varid; long *attnum; char *attname; unsigned int attnamelen; long *rcode; { char name[MAX_NC_NAME + 1]; *rcode = 0; if (ncattname (*ncid, *varid - 1, *attnum - 1, name) == -1) { *rcode = ncerr; return; } *rcode = fcdcpy ("NCANAM", attname, attnamelen, name); } /* renames an attribute in an open netCDF file */ void ncaren(ncid, varid, attname, attnamelen, newname, newnamelen, rcode) long *ncid; long *varid; char *attname; unsigned int attnamelen; char *newname; unsigned int newnamelen; long *rcode; { char name[MAX_NC_NAME + 1], nname[MAX_NC_NAME + 1]; nstrncpy (name, attname, attnamelen); nstrncpy (nname, newname, newnamelen); *rcode = 0; if (ncattrename (*ncid, *varid - 1, name, nname) == -1) { *rcode = ncerr; } } /* * deletes an attribute from an open netCDF file given the attribute * name */ void ncadel(ncid, varid, attname, attnamelen, rcode) long *ncid; long *varid; char *attname; unsigned int attnamelen; long *rcode; { char name[MAX_NC_NAME + 1]; nstrncpy (name, attname, attnamelen); *rcode = 0; if (ncattdel (*ncid, *varid - 1, name) == -1) { *rcode = ncerr; } } /* * sets the fill mode of a netCDF file open for writing */ int ncsfil(ncid, fillmode, rcode) long *ncid; long *fillmode; long *rcode; { int retval; if ((retval = ncsetfill (*ncid, *fillmode)) != -1) { *rcode = 0; return retval; } *rcode = ncerr; return (-1); }