"Fossies" - the Fresh Open Source Software Archive

Member "netcdf-fortran-4.4.5/fortran/nf_v2compat.c" (31 Jan 2019, 42233 Bytes) of package /linux/misc/netcdf-fortran-4.4.5.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) C and C++ source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "nf_v2compat.c" see the Fossies "Dox" file reference documentation.

    1 /*
    2  *  Copyright 1996, University Corporation for Atmospheric Research
    3  *      See netcdf/COPYRIGHT file for copying and redistribution conditions.
    4  */
    5 
    6 /* $Id: fort-v2compat.c,v 1.33 2009/01/27 19:48:34 ed Exp $ */
    7 
    8 /*
    9  *  Source for netCDF2 FORTRAN jacket library.
   10  */
   11 
   12 /* Modified version of fort-v2compat.c used to provide required
   13  * C functions used in v2 compatability interface. This clone
   14  * was created to keep existing C code fort-v2compat.c pristine
   15  * and to make compiling easier. Note all cfortran.h stuff has  
   16  * been removed to make compiling easier and the functions
   17  * have been made external instead of static so that FORTRAN can
   18  * see them
   19  */
   20 
   21 /* April, 2009
   22  * Modified by:  Richard Weed, Ph.D
   23  *               Center for Advanced Vehicular Systems
   24  *               Mississippi State University
   25  *               rweed@cavs.msstate.edu
   26  *
   27  *  C routines required for Fortran V2 compatability 
   28  */
   29 
   30 /*
   31  * OVERVIEW
   32  *
   33  * This file contains jacket routines written in C for interfacing
   34  * Fortran netCDF-2 function calls to the actual C-binding netCDF
   35  * function call -- using either the netCDF-2 or netCDF-3 C API.
   36  * In general, these functions handle character-string parameter
   37  * conventions, convert between column-major-order arrays and
   38  * row-major-order arrays, and map between array indices beginning
   39  * at one and array indices beginning at zero.  They also adapt the
   40  * differing error handling mechanisms between version 2 and version 3.
   41  */
   42 
   43 #include <config.h>
   44 
   45 #ifndef NO_NETCDF_2
   46 
   47 /* LINTLIBRARY */
   48 
   49 #include    <ctype.h>
   50 #include        <string.h>
   51 #include    <stdlib.h>
   52 #include    <stdio.h>
   53 #include    "netcdf.h"
   54 #include    "nfconfig.inc"
   55 
   56 #ifndef USE_NETCDF4
   57 #define NC_CLASSIC_MODEL 0
   58 #else
   59 /* There is a dependency error here;
   60 NC_CLASSIC_MODEL will not be defined
   61 if ../libsrc4/netcdf.h does not exist yet
   62 (which it won't after a maintainer-clean).
   63 So, define it here if not already defined.
   64 */
   65 #ifndef NC_CLASSIC_MODEL
   66 #define NC_CLASSIC_MODEL 0x0100
   67 #endif
   68 #endif
   69 
   70 
   71 /*
   72  New function added by RW to support FORTRAN 2003 interfaces.
   73  Function to return C data type sizes to FORTRAN 2003 code for
   74  v2 imap conversion. Duplicates some code in f2c_vimap below
   75 */
   76 extern size_t
   77 v2data_size(nc_type datatype)
   78 {
   79  size_t size;
   80 
   81  size = 0;
   82  switch (datatype)
   83   {
   84 
   85     case NC_CHAR:
   86       size = sizeof(char);
   87     break;
   88     case NC_BYTE:
   89 #if NF_INT1_IS_C_SIGNED_CHAR
   90       size = sizeof(signed char);
   91 #elif NF_INT1_IS_C_SHORT
   92       size = sizeof(short);
   93 #elif NF_INT1_IS_C_INT
   94       size = sizeof(int);
   95 #elif NF_INT1_IS_C_LONG
   96       size = sizeof(long);
   97 #endif
   98     break;
   99     case NC_SHORT:
  100 #if NF_INT2_IS_C_SHORT
  101       size = sizeof(short);
  102 #elif NF_INT2_IS_C_INT
  103       size = sizeof(int);
  104 #elif NF_INT2_IS_C_LONG
  105       size = sizeof(long);
  106 #endif
  107     break;
  108     case NC_INT:
  109 #if NF_INT_IS_C_INT
  110       size = sizeof(int);
  111 #elif NF_INT_IS_C_LONG
  112       size = sizeof(long);
  113 #endif
  114     break;
  115     case NC_FLOAT:
  116 #if NF_REAL_IS_C_FLOAT
  117       size = sizeof(float);
  118 #elif NF_REAL_IS_C_DOUBLE
  119       size = sizeof(double);
  120 #endif
  121     break;
  122     case NC_DOUBLE:
  123 #if NF_DOUBLEPRECISION_IS_C_FLOAT
  124       size = sizeof(float);
  125 #elif NF_DOUBLEPRECISION_IS_C_DOUBLE
  126       size = sizeof(double);
  127 #endif
  128     break;
  129     default:
  130       size = -1;
  131   }
  132  return size;
  133 }
  134 
  135 /**
  136  * Convert a Version 2 Fortran IMAP vector into a Version 3 C imap vector.
  137  */
  138 extern ptrdiff_t*
  139 f2c_v2imap(int ncid, int varid, const int* fimap, ptrdiff_t* cimap)
  140 {
  141     int     rank;
  142     nc_type datatype;
  143 
  144     if (nc_inq_vartype(ncid, varid, &datatype) ||
  145     nc_inq_varndims(ncid, varid, &rank) || rank <= 0)
  146     {
  147     return NULL;
  148     }
  149 
  150     /* else */
  151     if (fimap[0] == 0)
  152     {
  153     /*
  154      * Special Fortran version 2 semantics: use external netCDF variable 
  155      * structure.
  156      */
  157     int     dimids[NC_MAX_VAR_DIMS];
  158     int     idim;
  159     size_t  total;
  160 
  161     if (nc_inq_vardimid(ncid, varid, dimids) != NC_NOERR)
  162         return NULL;
  163 
  164     for (total = 1, idim = rank - 1; idim >= 0; --idim)
  165     {
  166         size_t  length;
  167 
  168         cimap[idim] = total;
  169 
  170         if (nc_inq_dimlen(ncid, dimids[idim], &length) != NC_NOERR)
  171         return NULL;
  172 
  173         total *= length;
  174     }
  175     }
  176     else
  177     {
  178     /*
  179      * Regular Fortran version 2 semantics: convert byte counts to
  180      * element counts.
  181      */
  182     int idim;
  183     size_t  size;
  184 
  185     switch (datatype)
  186     {
  187 
  188         case NC_CHAR:
  189         size = sizeof(char);
  190         break;
  191         case NC_BYTE:
  192 #       if NF_INT1_IS_C_SIGNED_CHAR
  193             size = sizeof(signed char);
  194 #       elif NF_INT1_IS_C_SHORT
  195             size = sizeof(short);
  196 #       elif NF_INT1_IS_C_INT
  197             size = sizeof(int);
  198 #       elif NF_INT1_IS_C_LONG
  199             size = sizeof(long);
  200 #       endif
  201         break;
  202         case NC_SHORT:
  203 #       if NF_INT2_IS_C_SHORT
  204             size = sizeof(short);
  205 #       elif NF_INT2_IS_C_INT
  206             size = sizeof(int);
  207 #       elif NF_INT2_IS_C_LONG
  208             size = sizeof(long);
  209 #       endif
  210         break;
  211         case NC_INT:
  212 #       if NF_INT_IS_C_INT
  213             size = sizeof(int);
  214 #       elif NF_INT_IS_C_LONG
  215             size = sizeof(long);
  216 #       endif
  217         break;
  218         case NC_FLOAT:
  219 #       if NF_REAL_IS_C_FLOAT
  220             size = sizeof(float);
  221 #       elif NF_REAL_IS_C_DOUBLE
  222             size = sizeof(double);
  223 #       endif
  224         break;
  225         case NC_DOUBLE:
  226 #       if NF_DOUBLEPRECISION_IS_C_FLOAT
  227             size = sizeof(float);
  228 #       elif NF_DOUBLEPRECISION_IS_C_DOUBLE
  229             size = sizeof(double);
  230 #       endif
  231         break;
  232         default:
  233         return NULL;
  234     }
  235 
  236     for (idim = 0; idim < rank; ++idim)
  237         cimap[idim] = fimap[rank - 1 - idim] / size;
  238     }
  239 
  240     return cimap;
  241 }
  242 
  243 
  244 /*
  245  * Compute the product of dimensional counts.
  246  */
  247 static size_t
  248 dimprod(const size_t* count, int rank)
  249 {
  250     int     i;
  251     size_t  prod = 1;
  252 
  253     for (i = 0; i < rank; ++i)
  254     prod *= count[i];
  255 
  256     return prod;
  257 }
  258 
  259 
  260 /*
  261  * Set the C global variable ncopts.
  262  */
  263 extern void
  264 c_ncpopt(
  265     int val     /* NC_FATAL, NC_VERBOSE, or NC_FATAL|NC_VERBOSE */
  266 )
  267 {
  268     ncopts = val;
  269 }
  270 
  271 /*
  272  * Get the C global variable ncopts from FORTRAN.
  273  */
  274 extern void
  275 c_ncgopt(
  276     int *val    /* NC_FATAL, NC_VERBOSE, or NC_FATAL|NC_VERBOSE */
  277 )
  278 {
  279     *val = ncopts;
  280 }
  281 
  282 
  283 
  284 /*
  285  * Create a new netCDF file, returning a netCDF ID.  New netCDF
  286  * file is placed in define mode.
  287  */
  288 extern int
  289 c_nccre(
  290     const char *pathname,   /* file name of new netCDF file */
  291     int clobmode,   /* either NCCLOB or NCNOCLOB */
  292     int *rcode      /* returned error code */
  293 )
  294 {
  295     int ncid = -1;
  296 
  297     if (pathname == NULL)
  298        *rcode = NC_EINVAL;
  299     else
  300     {
  301        *rcode = ((ncid = nccreate (pathname, clobmode)) == -1)
  302       ? ncerr
  303       : 0;
  304     }
  305     
  306     if (*rcode != 0)
  307     {
  308        nc_advise("NCCRE", *rcode, "");
  309        *rcode = ncerr;
  310     }
  311 
  312     return ncid;
  313 }
  314 
  315 
  316 
  317 /*
  318  * Open an existing netCDF file for access.
  319  */
  320 extern int
  321 c_ncopn(
  322     const char *pathname,   /* file name for netCDF to be opened */
  323     int rwmode,         /* either NCWRITE or NCNOWRIT */
  324     int *rcode          /* returned error code */
  325 )
  326 {
  327     int ncid = -1;
  328 
  329     /* Include NC_LOCK in check, in case NC_LOCK is ever implemented */
  330     if (rwmode < 0 ||
  331     rwmode > NC_WRITE + NC_SHARE + NC_CLASSIC_MODEL + NC_LOCK)
  332     {
  333         *rcode = NC_EINVAL;
  334         nc_advise("NCOPN", *rcode,
  335         "bad flag, did you forget to include netcdf.inc?");
  336     }
  337     else
  338     {
  339     if (pathname == NULL) {
  340         *rcode = NC_EINVAL;
  341     }
  342     else
  343     {
  344         *rcode = ((ncid = ncopen (pathname, rwmode)) == -1)
  345             ? ncerr
  346             : 0;
  347     }
  348 
  349     if (*rcode != 0)
  350     {
  351         nc_advise("NCOPN", *rcode, "");
  352         *rcode = ncerr;
  353     }
  354     }
  355 
  356     return ncid;
  357 }
  358 
  359 
  360 /*
  361  * Add a new dimension to an open netCDF file in define mode.
  362  */
  363 extern int
  364 c_ncddef (
  365     int ncid,       /* netCDF ID */
  366     const char *dimname,/* dimension name */
  367     int dimlen,     /* size of dimension */
  368     int *rcode      /* returned error code */
  369 )
  370 {
  371     int dimid;
  372 
  373     if ((dimid = ncdimdef (ncid, dimname, (long)dimlen)) == -1)
  374     *rcode = ncerr;
  375     else
  376     {
  377     dimid++;
  378     *rcode = 0;
  379     }
  380 
  381     return dimid;
  382 }
  383 
  384 
  385 /*
  386  * Return the ID of a netCDF dimension, given the name of the dimension.
  387  */
  388 extern int
  389 c_ncdid (
  390     int ncid,       /* netCDF ID */
  391     const char *dimname,/* dimension name */
  392     int *rcode      /* returned error code */
  393 )
  394 {
  395     int dimid;
  396 
  397     if ((dimid = ncdimid (ncid, dimname)) == -1)
  398     *rcode = ncerr;
  399     else
  400     {
  401     dimid++;
  402     *rcode = 0;
  403     }
  404 
  405     return dimid;
  406 }
  407 
  408 /*
  409  * Add a new variable to an open netCDF file in define mode.
  410  */
  411 extern int
  412 c_ncvdef (
  413     int ncid,           /* netCDF ID */
  414     const char *varname,/* name of variable */
  415     nc_type datatype,   /* netCDF datatype of variable */
  416     int ndims,          /* number of dimensions of variable */
  417     int *dimids,        /* array of ndims dimensions IDs */
  418     int *rcode          /* returned error code */
  419 )
  420 {
  421     int varid, status;
  422 
  423     if ((status = nc_def_var(ncid, varname, datatype, ndims, dimids, &varid)))
  424     {
  425         nc_advise("NCVDEF", status, "");
  426         *rcode = ncerr;
  427         varid = -1;
  428     }
  429     else
  430     {
  431         varid++;
  432         *rcode = 0;
  433     }
  434 
  435     return varid;
  436 }
  437 
  438 
  439 
  440 /*
  441  * Return the ID of a netCDF variable given its name.
  442  */
  443 extern int
  444 c_ncvid (
  445     int ncid,       /* netCDF ID */
  446     const char *varname,/* variable name */
  447     int *rcode      /* returned error code */
  448 )
  449 {
  450     int varid;
  451 
  452     if ((varid = ncvarid (ncid, varname)) == -1)
  453     *rcode = ncerr;
  454     else
  455     {
  456     varid++;
  457     *rcode = 0;
  458     }
  459 
  460     return varid;
  461 }
  462 
  463 
  464 /*
  465  * Return number of bytes per netCDF data type.
  466  */
  467 extern int
  468 c_nctlen (
  469     nc_type datatype,   /* netCDF datatype */
  470     int* rcode      /* returned error code */
  471 )
  472 {
  473     int itype;
  474 
  475     *rcode = ((itype = (int) nctypelen (datatype)) == -1)
  476         ?  ncerr
  477         : 0;
  478 
  479     return itype;
  480 }
  481 
  482 /*
  483  * Close an open netCDF file.
  484  */
  485 extern void
  486 c_ncclos (
  487     int ncid,       /* netCDF ID */
  488     int* rcode      /* returned error code */
  489 )
  490 {
  491     *rcode = ncclose(ncid) == -1
  492         ? ncerr
  493         : 0;
  494 }
  495 
  496 /*
  497  * Put an open netCDF into define mode.
  498  */
  499 extern void
  500 c_ncredf (
  501     int ncid,       /* netCDF ID */
  502     int *rcode      /* returned error code */
  503 )
  504 {
  505     *rcode = ncredef(ncid) == -1
  506         ? ncerr
  507         : 0;
  508 }
  509 
  510 /*
  511  * Take an open netCDF out of define mode.
  512  */
  513 extern void
  514 c_ncendf (
  515     int ncid,       /* netCDF ID */
  516     int *rcode      /* returned error code */
  517 )
  518 {
  519     *rcode = ncendef (ncid) == -1
  520         ? ncerr
  521         : 0;
  522 }
  523 
  524 /*
  525  * Return information about an open netCDF file given its netCDF ID.
  526  */
  527 extern void
  528 c_ncinq (
  529     int ncid,       /* netCDF ID */
  530     int* indims,    /* returned number of dimensions */
  531     int* invars,    /* returned number of variables */
  532     int* inatts,    /* returned number of attributes */
  533     int* irecdim,   /* returned ID of the unlimited dimension */
  534     int* rcode      /* returned error code */
  535 )
  536 {
  537     *rcode = ncinquire(ncid, indims, invars, inatts, irecdim) == -1
  538         ? ncerr
  539         : 0;
  540 }
  541 
  542 /*
  543  * Make sure that the disk copy of a netCDF file open for writing
  544  * is current.
  545  */
  546 extern void
  547 c_ncsnc(
  548     int ncid,       /* netCDF ID */
  549     int* rcode      /* returned error code */
  550 )
  551 {
  552     *rcode = ncsync (ncid) == -1
  553         ? ncerr
  554         : 0;
  555 }
  556 
  557 /*
  558  * Restore the netCDF to a known consistent state in case anything
  559  * goes wrong during the definition of new dimensions, variables
  560  * or attributes.
  561  */
  562 extern void
  563 c_ncabor (
  564     int ncid,       /* netCDF ID */
  565     int* rcode      /* returned error code */
  566 )
  567 {
  568     *rcode = ncabort(ncid) == -1
  569         ? ncerr
  570         : 0;
  571 }
  572 
  573 
  574 /*
  575  * Return the name and size of a dimension, given its ID.
  576  */
  577 extern void
  578 c_ncdinq (
  579     int ncid,           /* netCDF ID */
  580     int dimid,          /* dimension ID */
  581     char* dimname,      /* returned dimension name */
  582     int* size,          /* returned dimension size */
  583     int* rcode          /* returned error code */
  584 )
  585 {
  586     long siz;
  587 
  588     if (ncdiminq (ncid, dimid, dimname, &siz) == -1)
  589     *rcode = ncerr;
  590     else
  591     {
  592     *size = siz;
  593     *rcode = 0;
  594     }
  595 }
  596 
  597 /*
  598  * Rename an existing dimension in a netCDF open for writing.
  599  */
  600 extern void
  601 c_ncdren (
  602     int ncid,           /* netCDF ID */
  603     int dimid,          /* dimension ID */
  604     const char* dimname,    /* new name of dimension */
  605     int* rcode          /* returned error code */
  606 )
  607 {
  608     *rcode = ncdimrename(ncid, dimid, dimname) == -1
  609         ? ncerr
  610         : 0;
  611 }
  612 
  613 
  614 /*
  615  * Return information about a netCDF variable, given its ID.
  616  */
  617 extern void
  618 c_ncvinq (
  619     int ncid,       /* netCDF ID */
  620     int varid,      /* variable ID */
  621     char* varname,  /* returned variable name */
  622     nc_type* datatype,  /* returned variable type */
  623     int* indims,    /* returned number of dimensions */
  624     int* dimarray,  /* returned array of ndims dimension IDs */
  625     int* inatts,    /* returned number of attributes */
  626     int* rcode      /* returned error code */
  627 )
  628 {
  629     *rcode = ncvarinq(ncid, varid, varname, datatype, indims,
  630               dimarray, inatts) == -1
  631         ? ncerr
  632         : 0;
  633 }
  634 
  635 /*
  636  * Put a single numeric data value into a variable of an open netCDF.
  637  */
  638 extern void
  639 c_ncvpt1 (
  640     int         ncid,   /* netCDF ID */
  641     int         varid,  /* variable ID */
  642     const size_t*   indices,/* multidim index of data to be written */
  643     const void*     value,  /* pointer to data value to be written */
  644     int*        rcode   /* returned error code */
  645 )
  646 {
  647     int     status;
  648     nc_type datatype;
  649 
  650     if ((status = nc_inq_vartype(ncid, varid, &datatype)) == 0)
  651     {
  652     switch (datatype)
  653     {
  654     case NC_CHAR:
  655         status = NC_ECHAR;
  656         break;
  657     case NC_BYTE:
  658 #       if NF_INT1_IS_C_SIGNED_CHAR
  659         status = nc_put_var1_schar(ncid, varid, indices,
  660                        (const signed char*)value);
  661 #       elif NF_INT1_IS_C_SHORT
  662         status = nc_put_var1_short(ncid, varid, indices,
  663                        (const short*)value);
  664 #       elif NF_INT1_IS_C_INT
  665         status = nc_put_var1_int(ncid, varid, indices,
  666                        (const int*)value);
  667 #       elif NF_INT1_IS_C_LONG
  668         status = nc_put_var1_long(ncid, varid, indices,
  669                        (const long*)value);
  670 #       endif
  671         break;
  672     case NC_SHORT:
  673 #       if NF_INT2_IS_C_SHORT
  674         status = nc_put_var1_short(ncid, varid, indices,
  675                        (const short*)value);
  676 #       elif NF_INT2_IS_C_INT
  677         status = nc_put_var1_int(ncid, varid, indices,
  678                        (const int*)value);
  679 #       elif NF_INT2_IS_C_LONG
  680         status = nc_put_var1_long(ncid, varid, indices,
  681                        (const long*)value);
  682 #       endif
  683         break;
  684     case NC_INT:
  685 #       if NF_INT_IS_C_INT
  686         status = nc_put_var1_int(ncid, varid, indices,
  687                        (const int*)value);
  688 #       elif NF_INT_IS_C_LONG
  689         status = nc_put_var1_long(ncid, varid, indices,
  690                        (const long*)value);
  691 #       endif
  692         break;
  693     case NC_FLOAT:
  694 #       if NF_REAL_IS_C_FLOAT
  695         status = nc_put_var1_float(ncid, varid, indices,
  696                        (const float*)value);
  697 #       elif NF_REAL_IS_C_DOUBLE
  698         status = nc_put_var1_double(ncid, varid, indices,
  699                        (const double*)value);
  700 #       endif
  701         break;
  702     case NC_DOUBLE:
  703 #       if NF_DOUBLEPRECISION_IS_C_FLOAT
  704         status = nc_put_var1_float(ncid, varid, indices,
  705                        (const float*)value);
  706 #       elif NF_DOUBLEPRECISION_IS_C_DOUBLE
  707         status = nc_put_var1_double(ncid, varid, indices,
  708                        (const double*)value);
  709 #       endif
  710         break;
  711     }
  712     }
  713 
  714     if (status == 0)
  715     *rcode = 0;
  716     else
  717     {
  718     nc_advise("NCVPT1", status, "");
  719     *rcode = ncerr;
  720     }
  721 }
  722 
  723 /* 
  724  * Put a single character into an open netCDF file.
  725  */
  726 extern void
  727 c_ncvp1c(
  728     int         ncid,   /* netCDF ID */
  729     int         varid,  /* variable ID */
  730     const size_t*   indices,/* multidim index of data to be written */
  731     const char*     value,  /* pointer to data value to be written */
  732     int*        rcode   /* returned error code */
  733 )
  734 {
  735     int     status;
  736     nc_type datatype;
  737 
  738     if ((status = nc_inq_vartype(ncid, varid, &datatype)) == 0)
  739     {
  740     status = datatype != NC_CHAR
  741             ? NC_ECHAR
  742             : nc_put_var1_text(ncid, varid, indices, value);
  743     }
  744 
  745     if (status == 0)
  746     *rcode = 0;
  747     else
  748     {
  749     nc_advise("NCVP1C", status, "");
  750     *rcode = ncerr;
  751     }
  752 }
  753 
  754 /*
  755  * Write a hypercube of numeric values into a netCDF variable of an open
  756  * netCDF file.
  757  */
  758 extern void
  759 c_ncvpt (
  760     int         ncid,   /* netCDF ID */
  761     int         varid,  /* variable ID */
  762     const size_t*   start,  /* multidimensional index of hypercube corner */
  763     const size_t*   count,  /* multidimensional hypercube edge lengths */
  764     const void*     value,  /* block of data values to be written */
  765     int*        rcode   /* returned error code */
  766 )
  767 {
  768     int     status;
  769     nc_type datatype;
  770 
  771     if ((status = nc_inq_vartype(ncid, varid, &datatype)) == 0)
  772     {
  773     switch (datatype)
  774     {
  775     case NC_CHAR:
  776         status = NC_ECHAR;
  777         break;
  778     case NC_BYTE:
  779 #       if NF_INT1_IS_C_SIGNED_CHAR
  780         status = nc_put_vara_schar(ncid, varid, start, count,
  781                        (const signed char*)value);
  782 #       elif NF_INT1_IS_C_SHORT
  783         status = nc_put_vara_short(ncid, varid, start, count,
  784                        (const short*)value);
  785 #       elif NF_INT1_IS_C_INT
  786         status = nc_put_vara_int(ncid, varid, start, count,
  787                        (const int*)value);
  788 #       elif NF_INT1_IS_C_LONG
  789         status = nc_put_vara_long(ncid, varid, start, count,
  790                        (const long*)value);
  791 #       endif
  792         break;
  793     case NC_SHORT:
  794 #       if NF_INT2_IS_C_SHORT
  795         status = nc_put_vara_short(ncid, varid, start, count,
  796                        (const short*)value);
  797 #       elif NF_INT2_IS_C_INT
  798         status = nc_put_vara_int(ncid, varid, start, count,
  799                        (const int*)value);
  800 #       elif NF_INT2_IS_C_LONG
  801         status = nc_put_vara_long(ncid, varid, start, count,
  802                        (const long*)value);
  803 #       endif
  804         break;
  805     case NC_INT:
  806 #       if NF_INT_IS_C_INT
  807         status = nc_put_vara_int(ncid, varid, start, count,
  808                        (const int*)value);
  809 #       elif NF_INT_IS_C_LONG
  810         status = nc_put_vara_long(ncid, varid, start, count,
  811                        (const long*)value);
  812 #       endif
  813         break;
  814     case NC_FLOAT:
  815 #       if NF_REAL_IS_C_FLOAT
  816         status = nc_put_vara_float(ncid, varid, start, count,
  817                        (const float*)value);
  818 #       elif NF_REAL_IS_C_DOUBLE
  819         status = nc_put_vara_double(ncid, varid, start, count,
  820                        (const double*)value);
  821 #       endif
  822         break;
  823     case NC_DOUBLE:
  824 #       if NF_DOUBLEPRECISION_IS_C_FLOAT
  825         status = nc_put_vara_float(ncid, varid, start, count,
  826                        (const float*)value);
  827 #       elif NF_DOUBLEPRECISION_IS_C_DOUBLE
  828         status = nc_put_vara_double(ncid, varid, start, count,
  829                        (const double*)value);
  830 #       endif
  831         break;
  832     }
  833     }
  834 
  835     if (status == 0)
  836     *rcode = 0;
  837     else
  838     {
  839     nc_advise("NCVPT", status, "");
  840     *rcode = ncerr;
  841     }
  842 }
  843 
  844 
  845 /*
  846  * Write a hypercube of character values into an open netCDF file.
  847  */
  848 extern void
  849 c_ncvptc(
  850     int         ncid,   /* netCDF ID */
  851     int         varid,  /* variable ID */
  852     const size_t*   start,  /* multidimensional index of hypercube corner */
  853     const size_t*   count,  /* multidimensional hypercube edge lengths */
  854     const char*     value,  /* block of data values to be written */
  855     int         lenstr, /* declared length of the data argument */
  856     int*        rcode   /* returned error code */
  857 )
  858 {
  859     int     status;
  860     nc_type datatype;
  861 
  862     if ((status = nc_inq_vartype(ncid, varid, &datatype)) == 0)
  863     {
  864     if (datatype != NC_CHAR)
  865         status = NC_ECHAR;
  866     else
  867     {
  868         int rank;
  869 
  870         status = nc_inq_varndims(ncid, varid, &rank);
  871         if (status == 0)
  872         {
  873         if (dimprod(count, rank) > (size_t)lenstr)
  874             status = NC_ESTS;
  875         else
  876             status = nc_put_vara_text(ncid, varid, start, count, value);
  877         }
  878     }
  879     }
  880 
  881     if (status == 0)
  882     *rcode = 0;
  883     else
  884     {
  885     nc_advise("NCVPTC", status, "");
  886     *rcode = ncerr;
  887     }
  888 }
  889 
  890 
  891 /*
  892  * Write a generalized hypercube of numeric values into a netCDF variable of 
  893  * an open netCDF file.
  894  */
  895 extern void
  896 c_ncvptg (
  897     int         ncid,   /* netCDF ID */
  898     int         varid,  /* variable ID */
  899     const size_t*   start,  /* multidimensional index of hypercube corner */
  900     const size_t*   count,  /* multidimensional hypercube edge lengths */
  901     const ptrdiff_t*    strides,/* netCDF variable access strides */
  902     const ptrdiff_t*    imap,   /* memory values access mapping vector */
  903     const void*     value,  /* block of data values to be written */
  904     int*        rcode   /* returned error code */
  905 )
  906 {
  907     int     status;
  908     int     rank;
  909     nc_type datatype;
  910 
  911     if ((status = nc_inq_vartype(ncid, varid, &datatype)) == 0 &&
  912     (status = nc_inq_varndims(ncid, varid, &rank)) == 0)
  913     {
  914     switch (datatype)
  915     {
  916     case NC_CHAR:
  917         status = NC_ECHAR;
  918         break;
  919     case NC_BYTE:
  920 #       if NF_INT1_IS_C_SIGNED_CHAR
  921         status = nc_put_varm_schar(ncid, varid, start, count,
  922                        strides, imap,
  923                        (const signed char*)value);
  924 #       elif NF_INT1_IS_C_SHORT
  925         status = nc_put_varm_short(ncid, varid, start, count,
  926                        strides, imap,
  927                        (const short*)value);
  928 #       elif NF_INT1_IS_C_INT
  929         status = nc_put_varm_int(ncid, varid, start, count,
  930                        strides, imap,
  931                        (const int*)value);
  932 #       elif NF_INT1_IS_C_LONG
  933         status = nc_put_varm_long(ncid, varid, start, count,
  934                        strides, imap,
  935                        (const long*)value);
  936 #       endif
  937         break;
  938     case NC_SHORT:
  939 #       if NF_INT2_IS_C_SHORT
  940         status = nc_put_varm_short(ncid, varid, start, count,
  941                        strides, imap,
  942                        (const short*)value);
  943 #       elif NF_INT2_IS_C_INT
  944         status = nc_put_varm_int(ncid, varid, start, count,
  945                        strides, imap,
  946                        (const int*)value);
  947 #       elif NF_INT2_IS_C_LONG
  948         status = nc_put_varm_long(ncid, varid, start, count,
  949                        strides, imap,
  950                        (const long*)value);
  951 #       endif
  952         break;
  953     case NC_INT:
  954 #       if NF_INT_IS_C_INT
  955         status = nc_put_varm_int(ncid, varid, start, count,
  956                        strides, imap,
  957                        (const int*)value);
  958 #       elif NF_INT_IS_C_LONG
  959         status = nc_put_varm_long(ncid, varid, start, count,
  960                        strides, imap,
  961                        (const long*)value);
  962 #       endif
  963         break;
  964     case NC_FLOAT:
  965 #       if NF_REAL_IS_C_FLOAT
  966         status = nc_put_varm_float(ncid, varid, start, count,
  967                        strides, imap,
  968                        (const float*)value);
  969 #       elif NF_REAL_IS_C_DOUBLE
  970         status = nc_put_varm_double(ncid, varid, start, count,
  971                        strides, imap,
  972                        (const double*)value);
  973 #       endif
  974         break;
  975     case NC_DOUBLE:
  976 #       if NF_DOUBLEPRECISION_IS_C_FLOAT
  977         status = nc_put_varm_float(ncid, varid, start, count,
  978                        strides, imap,
  979                        (const float*)value);
  980 #       elif NF_DOUBLEPRECISION_IS_C_DOUBLE
  981         status = nc_put_varm_double(ncid, varid, start, count,
  982                        strides, imap,
  983                        (const double*)value);
  984 #       endif
  985         break;
  986     }
  987     }
  988 
  989     if (status == 0)
  990     *rcode = 0;
  991     else
  992     {
  993     nc_advise("NCVPTG", status, "");
  994     *rcode = ncerr;
  995     }
  996 }
  997 
  998 
  999 /*
 1000  * Write a generalized hypercube of character values into a netCDF variable of 
 1001  * an open netCDF file.
 1002  */
 1003 extern void
 1004 c_ncvpgc(
 1005     int         ncid,   /* netCDF ID */
 1006     int         varid,  /* variable ID */
 1007     const size_t*   start,  /* multidimensional index of hypercube corner */
 1008     const size_t*   count,  /* multidimensional hypercube edge lengths */
 1009     const ptrdiff_t*    strides,/* netCDF variable access strides */
 1010     const ptrdiff_t*    imap,   /* memory values access mapping vector */
 1011     const char*     value,  /* block of data values to be written */
 1012     int*        rcode   /* returned error code */
 1013 )
 1014 {
 1015     int     status;
 1016     int     rank;
 1017     nc_type datatype;
 1018 
 1019     if ((status = nc_inq_vartype(ncid, varid, &datatype)) == 0 &&
 1020     (status = nc_inq_varndims(ncid, varid, &rank)) == 0)
 1021     {
 1022     switch (datatype)
 1023     {
 1024     case NC_CHAR:
 1025         status = nc_put_varm_text(ncid, varid, start, count,
 1026                        strides, imap,
 1027                        value);
 1028         break;
 1029     default:
 1030         status = NC_ECHAR;
 1031         break;
 1032     }
 1033     }
 1034 
 1035     if (status == 0)
 1036     *rcode = 0;
 1037     else
 1038     {
 1039     nc_advise("NCVPGC", status, "");
 1040     *rcode = ncerr;
 1041     }
 1042 }
 1043 
 1044 
 1045 /*
 1046  * Get a single numeric value from a variable of an open netCDF file.
 1047  */
 1048 extern void
 1049 c_ncvgt1 (
 1050     int         ncid,   /* netCDF ID */
 1051     int         varid,  /* variable ID */
 1052     const size_t*   indices,/* multidim index of data to be read */
 1053     void*       value,  /* pointer to data value to be read */
 1054     int*        rcode   /* returned error code */
 1055 )
 1056 {
 1057     int     status;
 1058     nc_type datatype;
 1059 
 1060     if ((status = nc_inq_vartype(ncid, varid, &datatype)) == 0)
 1061     {
 1062     switch (datatype)
 1063     {
 1064     case NC_CHAR:
 1065         status = NC_ECHAR;
 1066         break;
 1067     case NC_BYTE:
 1068 #       if NF_INT1_IS_C_SIGNED_CHAR
 1069         status = nc_get_var1_schar(ncid, varid, indices,
 1070                        (signed char*)value);
 1071 #       elif NF_INT1_IS_C_SHORT
 1072         status = nc_get_var1_short(ncid, varid, indices,
 1073                        (short*)value);
 1074 #       elif NF_INT1_IS_C_INT
 1075         status = nc_get_var1_int(ncid, varid, indices,
 1076                        (int*)value);
 1077 #       elif NF_INT1_IS_C_LONG
 1078         status = nc_get_var1_long(ncid, varid, indices,
 1079                        (long*)value);
 1080 #       endif
 1081         break;
 1082     case NC_SHORT:
 1083 #       if NF_INT2_IS_C_SHORT
 1084         status = nc_get_var1_short(ncid, varid, indices,
 1085                        (short*)value);
 1086 #       elif NF_INT2_IS_C_INT
 1087         status = nc_get_var1_int(ncid, varid, indices,
 1088                        (int*)value);
 1089 #       elif NF_INT2_IS_C_LONG
 1090         status = nc_get_var1_long(ncid, varid, indices,
 1091                        (long*)value);
 1092 #       endif
 1093         break;
 1094     case NC_INT:
 1095 #       if NF_INT_IS_C_INT
 1096         status = nc_get_var1_int(ncid, varid, indices,
 1097                        (int*)value);
 1098 #       elif NF_INT_IS_C_LONG
 1099         status = nc_get_var1_long(ncid, varid, indices,
 1100                        (long*)value);
 1101 #       endif
 1102         break;
 1103     case NC_FLOAT:
 1104 #       if NF_REAL_IS_C_FLOAT
 1105         status = nc_get_var1_float(ncid, varid, indices,
 1106                        (float*)value);
 1107 #       elif NF_REAL_IS_C_DOUBLE
 1108         status = nc_get_var1_double(ncid, varid, indices,
 1109                        (double*)value);
 1110 #       endif
 1111         break;
 1112     case NC_DOUBLE:
 1113 #       if NF_DOUBLEPRECISION_IS_C_FLOAT
 1114         status = nc_get_var1_float(ncid, varid, indices,
 1115                        (float*)value);
 1116 #       elif NF_DOUBLEPRECISION_IS_C_DOUBLE
 1117         status = nc_get_var1_double(ncid, varid, indices,
 1118                        (double*)value);
 1119 #       endif
 1120         break;
 1121     }
 1122     }
 1123 
 1124     if (status == 0)
 1125     *rcode = 0;
 1126     else
 1127     {
 1128     nc_advise("NCVGT1", status, "");
 1129     *rcode = ncerr;
 1130     }
 1131 }
 1132 
 1133 
 1134 /*
 1135  * Get a single character data value from a variable of an open
 1136  * netCDF file.
 1137  */
 1138 extern void
 1139 c_ncvg1c(
 1140     int         ncid,   /* netCDF ID */
 1141     int         varid,  /* variable ID */
 1142     const size_t*   indices,/* multidim index of data to be read */
 1143     char*       value,  /* pointer to data value to be read */
 1144     int*        rcode   /* returned error code */
 1145 )
 1146 {
 1147     int     status;
 1148     nc_type datatype;
 1149 
 1150     if ((status = nc_inq_vartype(ncid, varid, &datatype)) == 0)
 1151     {
 1152     switch (datatype)
 1153     {
 1154     case NC_CHAR:
 1155         status = nc_get_var1_text(ncid, varid, indices, value);
 1156         break;
 1157     default:
 1158         status = NC_ECHAR;
 1159         break;
 1160     }
 1161     }
 1162 
 1163     if (status == 0)
 1164     *rcode = 0;
 1165     else
 1166     {
 1167     nc_advise("NCVG1C", status, "");
 1168     *rcode = ncerr;
 1169     }
 1170 }
 1171 
 1172 
 1173 /*
 1174  * Read a hypercube of numeric values from a netCDF variable of an open
 1175  * netCDF file.
 1176  */
 1177 extern void
 1178 c_ncvgt(
 1179     int         ncid,   /* netCDF ID */
 1180     int         varid,  /* variable ID */
 1181     const size_t*   start,  /* multidimensional index of hypercube corner */
 1182     const size_t*   count,  /* multidimensional hypercube edge lengths */
 1183     void*       value,  /* block of data values to be read */
 1184     int*        rcode   /* returned error code */
 1185 )
 1186 {
 1187     int     status;
 1188     nc_type datatype;
 1189 
 1190     if ((status = nc_inq_vartype(ncid, varid, &datatype)) == 0)
 1191     {
 1192     switch (datatype)
 1193     {
 1194     case NC_CHAR:
 1195         status = NC_ECHAR;
 1196         break;
 1197     case NC_BYTE:
 1198 #       if NF_INT1_IS_C_SIGNED_CHAR
 1199         status = nc_get_vara_schar(ncid, varid, start, count,
 1200                        (signed char*)value);
 1201 #       elif NF_INT1_IS_C_SHORT
 1202         status = nc_get_vara_short(ncid, varid, start, count,
 1203                        (short*)value);
 1204 #       elif NF_INT1_IS_C_INT
 1205         status = nc_get_vara_int(ncid, varid, start, count,
 1206                        (int*)value);
 1207 #       elif NF_INT1_IS_C_LONG
 1208         status = nc_get_vara_long(ncid, varid, start, count,
 1209                        (long*)value);
 1210 #       endif
 1211         break;
 1212     case NC_SHORT:
 1213 #       if NF_INT2_IS_C_SHORT
 1214         status = nc_get_vara_short(ncid, varid, start, count,
 1215                        (short*)value);
 1216 #       elif NF_INT2_IS_C_INT
 1217         status = nc_get_vara_int(ncid, varid, start, count,
 1218                        (int*)value);
 1219 #       elif NF_INT2_IS_C_LONG
 1220         status = nc_get_vara_long(ncid, varid, start, count,
 1221                        (long*)value);
 1222 #       endif
 1223         break;
 1224     case NC_INT:
 1225 #       if NF_INT_IS_C_INT
 1226         status = nc_get_vara_int(ncid, varid, start, count,
 1227                        (int*)value);
 1228 #       elif NF_INT_IS_C_LONG
 1229         status = nc_get_vara_long(ncid, varid, start, count,
 1230                        (long*)value);
 1231 #       endif
 1232         break;
 1233     case NC_FLOAT:
 1234 #       if NF_REAL_IS_C_FLOAT
 1235         status = nc_get_vara_float(ncid, varid, start, count,
 1236                        (float*)value);
 1237 #       elif NF_REAL_IS_C_DOUBLE
 1238         status = nc_get_vara_double(ncid, varid, start, count,
 1239                        (double*)value);
 1240 #       endif
 1241         break;
 1242     case NC_DOUBLE:
 1243 #       if NF_DOUBLEPRECISION_IS_C_FLOAT
 1244         status = nc_get_vara_float(ncid, varid, start, count,
 1245                        (float*)value);
 1246 #       elif NF_DOUBLEPRECISION_IS_C_DOUBLE
 1247         status = nc_get_vara_double(ncid, varid, start, count,
 1248                        (double*)value);
 1249 #       endif
 1250         break;
 1251     }
 1252     }
 1253 
 1254     if (status == 0)
 1255     *rcode = 0;
 1256     else
 1257     {
 1258     nc_advise("NCVGT", status, "");
 1259     *rcode = ncerr;
 1260     }
 1261 }
 1262 
 1263 
 1264 /*
 1265  * Read a hypercube of character values from a netCDF variable.
 1266  */
 1267 extern void
 1268 c_ncvgtc(
 1269     int         ncid,   /* netCDF ID */
 1270     int         varid,  /* variable ID */
 1271     const size_t*   start,  /* multidimensional index of hypercube corner */
 1272     const size_t*   count,  /* multidimensional hypercube edge lengths */
 1273     char*       value,  /* block of data values to be read */
 1274     int         lenstr, /* declared length of the data argument */
 1275     int*        rcode   /* returned error code */
 1276 )
 1277 {
 1278     int     status;
 1279     nc_type datatype;
 1280 
 1281     if ((status = nc_inq_vartype(ncid, varid, &datatype)) == 0)
 1282     {
 1283     if (datatype != NC_CHAR)
 1284         status = NC_ECHAR;
 1285     else if ((status = nc_get_vara_text(ncid, varid, start, count, value))
 1286          == 0)
 1287     {
 1288         int rank;
 1289 
 1290         if ((status = nc_inq_varndims(ncid, varid, &rank)) == 0)
 1291         {
 1292         size_t  total = dimprod(count, rank);
 1293 
 1294         (void) memset(value+total, ' ', lenstr - total);
 1295         }
 1296     }
 1297     }
 1298 
 1299     if (status == 0)
 1300     *rcode = 0;
 1301     else
 1302     {
 1303     nc_advise("NCVGTC", status, "");
 1304     *rcode = ncerr;
 1305     }
 1306 }
 1307 
 1308 /*
 1309  * Read a generalized hypercube of numeric values from a netCDF variable of an 
 1310  * open netCDF file.
 1311  */
 1312 extern void
 1313 c_ncvgtg (
 1314     int         ncid,   /* netCDF ID */
 1315     int         varid,  /* variable ID */
 1316     const size_t*   start,  /* multidimensional index of hypercube corner */
 1317     const size_t*   count,  /* multidimensional hypercube edge lengths */
 1318     const ptrdiff_t*    strides,/* netCDF variable access strides */
 1319     const ptrdiff_t*    imap,   /* memory values access basis vector */
 1320     void*       value,  /* block of data values to be read */
 1321     int*        rcode   /* returned error code */
 1322 )
 1323 {
 1324     int     status;
 1325     int     rank;
 1326     nc_type datatype;
 1327 
 1328     if ((status = nc_inq_vartype(ncid, varid, &datatype)) == 0 &&
 1329     (status = nc_inq_varndims(ncid, varid, &rank)) == 0)
 1330     {
 1331     switch (datatype)
 1332     {
 1333     case NC_CHAR:
 1334         status = NC_ECHAR;
 1335         break;
 1336     case NC_BYTE:
 1337 #       if NF_INT1_IS_C_SIGNED_CHAR
 1338         status = nc_get_varm_schar(ncid, varid, start, count,
 1339                        strides, imap,
 1340                        (signed char*)value);
 1341 #       elif NF_INT1_IS_C_SHORT
 1342         status = nc_get_varm_short(ncid, varid, start, count,
 1343                        strides, imap,
 1344                        (short*)value);
 1345 #       elif NF_INT1_IS_C_INT
 1346         status = nc_get_varm_int(ncid, varid, start, count,
 1347                        strides, imap,
 1348                        (int*)value);
 1349 #       elif NF_INT1_IS_C_LONG
 1350         status = nc_get_varm_long(ncid, varid, start, count,
 1351                        strides, imap,
 1352                        (long*)value);
 1353 #       endif
 1354         break;
 1355     case NC_SHORT:
 1356 #       if NF_INT2_IS_C_SHORT
 1357         status = nc_get_varm_short(ncid, varid, start, count,
 1358                        strides, imap,
 1359                        (short*)value);
 1360 #       elif NF_INT2_IS_C_INT
 1361         status = nc_get_varm_int(ncid, varid, start, count,
 1362                        strides, imap,
 1363                        (int*)value);
 1364 #       elif NF_INT2_IS_C_LONG
 1365         status = nc_get_varm_long(ncid, varid, start, count,
 1366                        strides, imap,
 1367                        (long*)value);
 1368 #       endif
 1369         break;
 1370     case NC_INT:
 1371 #       if NF_INT_IS_C_INT
 1372         status = nc_get_varm_int(ncid, varid, start, count,
 1373                        strides, imap,
 1374                        (int*)value);
 1375 #       elif NF_INT_IS_C_LONG
 1376         status = nc_get_varm_long(ncid, varid, start, count,
 1377                        strides, imap,
 1378                        (long*)value);
 1379 #       endif
 1380         break;
 1381     case NC_FLOAT:
 1382 #       if NF_REAL_IS_C_FLOAT
 1383         status = nc_get_varm_float(ncid, varid, start, count,
 1384                        strides, imap,
 1385                        (float*)value);
 1386 #       elif NF_REAL_IS_C_DOUBLE
 1387         status = nc_get_varm_double(ncid, varid, start, count,
 1388                        strides, imap,
 1389                        (double*)value);
 1390 #       endif
 1391         break;
 1392     case NC_DOUBLE:
 1393 #       if NF_DOUBLEPRECISION_IS_C_FLOAT
 1394         status = nc_get_varm_float(ncid, varid, start, count,
 1395                        strides, imap,
 1396                        (float*)value);
 1397 #       elif NF_DOUBLEPRECISION_IS_C_DOUBLE
 1398         status = nc_get_varm_double(ncid, varid, start, count,
 1399                        strides, imap,
 1400                        (double*)value);
 1401 #       endif
 1402         break;
 1403     }
 1404     }
 1405 
 1406     if (status == 0)
 1407     *rcode = 0;
 1408     else
 1409     {
 1410     nc_advise("NCVGTG", status, "");
 1411     *rcode = ncerr;
 1412     }
 1413 }
 1414 
 1415 /*
 1416  * Read a generalized hypercube of character values from a netCDF variable 
 1417  * of an open netCDF file.
 1418  */
 1419 extern void
 1420 c_ncvggc(
 1421     int         ncid,   /* netCDF ID */
 1422     int         varid,  /* variable ID */
 1423     const size_t*   start,  /* multidimensional index of hypercube corner */
 1424     const size_t*   count,  /* multidimensional hypercube edge lengths */
 1425     const ptrdiff_t*    strides,/* netCDF variable access strides */
 1426     const ptrdiff_t*    imap,   /* memory values access basis vector */
 1427     char*       value,  /* block of data values to be written */
 1428     int*        rcode   /* returned error code */
 1429 )
 1430 {
 1431     int     status;
 1432     int     rank;
 1433     nc_type datatype;
 1434 
 1435     if ((status = nc_inq_vartype(ncid, varid, &datatype)) == 0 &&
 1436     (status = nc_inq_varndims(ncid, varid, &rank)) == 0)
 1437     {
 1438     switch (datatype)
 1439     {
 1440     case NC_CHAR:
 1441         status = nc_get_varm_text(ncid, varid, start, count,
 1442                        strides, imap,
 1443                        value);
 1444         break;
 1445     default:
 1446         status = NC_ECHAR;
 1447         break;
 1448     }
 1449     }
 1450 
 1451     if (status == 0)
 1452     *rcode = 0;
 1453     else
 1454     {
 1455     nc_advise("NCVGGC", status, "");
 1456     *rcode = ncerr;
 1457     }
 1458 }
 1459 
 1460 /*
 1461  * Change the name of a netCDF variable in an open netCDF file.
 1462  */
 1463 extern void
 1464 c_ncvren (
 1465     int ncid,       /* netCDF ID */
 1466     int varid,      /* variable ID */
 1467     const char* varname,/* new name for variable */
 1468     int* rcode      /* returned error code */
 1469 )
 1470 {
 1471     *rcode = ncvarrename (ncid, varid, varname) == -1
 1472         ? ncerr
 1473         : 0;
 1474 }
 1475 
 1476 /*
 1477  * Add or changes a numeric variable or global attribute of an open
 1478  * netCDF file.
 1479  */
 1480 extern void
 1481 c_ncapt (
 1482     int     ncid,       /* netCDF ID */
 1483     int     varid,      /* variable ID */
 1484     const char* attname,    /* attribute name */
 1485     nc_type datatype,   /* attribute datatype */
 1486     size_t  attlen,     /* attribute length */
 1487     const void* value,      /* pointer to data values */
 1488     int*    rcode       /* returned error code */
 1489 )
 1490 {
 1491     int     status;
 1492 
 1493     switch (datatype)
 1494     {
 1495     case NC_CHAR:
 1496     status = NC_ECHAR;
 1497     break;
 1498     case NC_BYTE:
 1499 #   if NF_INT1_IS_C_SIGNED_CHAR
 1500         status = nc_put_att_schar(ncid, varid, attname, datatype,
 1501                        attlen, (const signed char*)value);
 1502 #   elif NF_INT1_IS_C_SHORT
 1503         status = nc_put_att_short(ncid, varid, attname, datatype,
 1504                        attlen, (const short*)value);
 1505 #   elif NF_INT1_IS_C_INT
 1506         status = nc_put_att_int(ncid, varid, attname, datatype,
 1507                        attlen, (const int*)value);
 1508 #   elif NF_INT1_IS_C_LONG
 1509         status = nc_put_att_long(ncid, varid, attname, datatype,
 1510                        attlen, (const long*)value);
 1511 #   endif
 1512     break;
 1513     case NC_SHORT:
 1514 #   if NF_INT2_IS_C_SHORT
 1515         status = nc_put_att_short(ncid, varid, attname, datatype,
 1516                        attlen, (const short*)value);
 1517 #   elif NF_INT2_IS_C_INT
 1518         status = nc_put_att_int(ncid, varid, attname, datatype,
 1519                        attlen, (const int*)value);
 1520 #   elif NF_INT2_IS_C_LONG
 1521         status = nc_put_att_long(ncid, varid, attname, datatype,
 1522                        attlen, (const long*)value);
 1523 #   endif
 1524     break;
 1525     case NC_INT:
 1526 #   if NF_INT_IS_C_INT
 1527         status = nc_put_att_int(ncid, varid, attname, datatype,
 1528                        attlen, (const int*)value);
 1529 #   elif NF_INT_IS_C_LONG
 1530         status = nc_put_att_long(ncid, varid, attname, datatype,
 1531                        attlen, (const long*)value);
 1532 #   endif
 1533     break;
 1534     case NC_FLOAT:
 1535 #   if NF_REAL_IS_C_FLOAT
 1536         status = nc_put_att_float(ncid, varid, attname, datatype,
 1537                        attlen, (const float*)value);
 1538 #   elif NF_REAL_IS_C_DOUBLE
 1539         status = nc_put_att_double(ncid, varid, attname, datatype,
 1540                        attlen, (const double*)value);
 1541 #   endif
 1542     break;
 1543     case NC_DOUBLE:
 1544 #   if NF_DOUBLEPRECISION_IS_C_FLOAT
 1545         status = nc_put_att_float(ncid, varid, attname, datatype,
 1546                        attlen, (const float*)value);
 1547 #   elif NF_DOUBLEPRECISION_IS_C_DOUBLE
 1548         status = nc_put_att_double(ncid, varid, attname, datatype,
 1549                        attlen, (const double*)value);
 1550 #   endif
 1551     break;
 1552     }
 1553 
 1554     if (status == 0)
 1555     *rcode = 0;
 1556     else
 1557     {
 1558     nc_advise("NCAPT", status, "");
 1559     *rcode = ncerr;
 1560     }
 1561 }
 1562 
 1563 /*
 1564  * Add or change a character attribute of an open netCDF file.
 1565  */
 1566 extern void
 1567 c_ncaptc(
 1568     int     ncid,       /* netCDF ID */
 1569     int     varid,      /* variable ID */
 1570     const char* attname,    /* attribute name */
 1571     nc_type datatype,   /* attribute datatype */
 1572     size_t  attlen,     /* attribute length */
 1573     const char* value,      /* pointer to data values */
 1574     int*    rcode       /* returned error code */
 1575 )
 1576 {
 1577     int     status;
 1578 
 1579     if (datatype != NC_CHAR)
 1580     status = NC_ECHAR;
 1581     else
 1582     status = nc_put_att_text(ncid, varid, attname, attlen, value);
 1583 
 1584     if (status == 0)
 1585     *rcode = 0;
 1586     else
 1587     {
 1588     nc_advise("NCAPTC", status, "");
 1589     *rcode = ncerr;
 1590     }
 1591 }
 1592 
 1593 /*
 1594  * Return information about a netCDF attribute given its variable
 1595  * ID and name.
 1596  */
 1597 extern void
 1598 c_ncainq (
 1599     int ncid,           /* netCDF ID */
 1600     int varid,          /* variable ID */
 1601     const char* attname,    /* attribute name */
 1602     nc_type* datatype,      /* returned attribute datatype */
 1603     int* attlen,        /* returned attribute length */
 1604     int* rcode          /* returned error code */
 1605 )
 1606 {
 1607     *rcode = ncattinq(ncid, varid, attname, datatype, attlen)
 1608          == -1
 1609         ? ncerr
 1610         : 0;
 1611 }
 1612 
 1613 /*
 1614  * Get the value of a netCDF attribute given its variable ID and name.
 1615  */
 1616 extern void
 1617 c_ncagt(
 1618     int     ncid,       /* netCDF ID */
 1619     int     varid,      /* variable ID */
 1620     const char* attname,    /* attribute name */
 1621     void*   value,      /* pointer to data values */
 1622     int*    rcode       /* returned error code */
 1623 )
 1624 {
 1625     int     status;
 1626     nc_type datatype;
 1627 
 1628     if ((status = nc_inq_atttype(ncid, varid, attname, &datatype)) == 0)
 1629     {
 1630     switch (datatype)
 1631     {
 1632     case NC_CHAR:
 1633         status = NC_ECHAR;
 1634         break;
 1635     case NC_BYTE:
 1636 #       if NF_INT1_IS_C_SIGNED_CHAR
 1637         status = nc_get_att_schar(ncid, varid, attname, 
 1638                        (signed char*)value);
 1639 #       elif NF_INT1_IS_C_SHORT
 1640         status = nc_get_att_short(ncid, varid, attname, 
 1641                        (short*)value);
 1642 #       elif NF_INT1_IS_C_INT
 1643         status = nc_get_att_int(ncid, varid, attname, 
 1644                        (int*)value);
 1645 #       elif NF_INT1_IS_C_LONG
 1646         status = nc_get_att_long(ncid, varid, attname, 
 1647                        (long*)value);
 1648 #       endif
 1649         break;
 1650     case NC_SHORT:
 1651 #       if NF_INT2_IS_C_SHORT
 1652         status = nc_get_att_short(ncid, varid, attname, 
 1653                        (short*)value);
 1654 #       elif NF_INT2_IS_C_INT
 1655         status = nc_get_att_int(ncid, varid, attname, 
 1656                        (int*)value);
 1657 #       elif NF_INT2_IS_C_LONG
 1658         status = nc_get_att_long(ncid, varid, attname, 
 1659                        (long*)value);
 1660 #       endif
 1661         break;
 1662     case NC_INT:
 1663 #       if NF_INT_IS_C_INT
 1664         status = nc_get_att_int(ncid, varid, attname, 
 1665                        (int*)value);
 1666 #       elif NF_INT_IS_C_LONG
 1667         status = nc_get_att_long(ncid, varid, attname, 
 1668                        (long*)value);
 1669 #       endif
 1670         break;
 1671     case NC_FLOAT:
 1672 #       if NF_REAL_IS_C_FLOAT
 1673         status = nc_get_att_float(ncid, varid, attname, 
 1674                        (float*)value);
 1675 #       elif NF_REAL_IS_C_DOUBLE
 1676         status = nc_get_att_double(ncid, varid, attname, 
 1677                        (double*)value);
 1678 #       endif
 1679         break;
 1680     case NC_DOUBLE:
 1681 #       if NF_DOUBLEPRECISION_IS_C_FLOAT
 1682         status = nc_get_att_float(ncid, varid, attname, 
 1683                        (float*)value);
 1684 #       elif NF_DOUBLEPRECISION_IS_C_DOUBLE
 1685         status = nc_get_att_double(ncid, varid, attname, 
 1686                        (double*)value);
 1687 #       endif
 1688         break;
 1689     }
 1690     }
 1691 
 1692     if (status == 0)
 1693     *rcode = 0;
 1694     else
 1695     {
 1696     nc_advise("NCAGT", status, "");
 1697     *rcode = ncerr;
 1698     }
 1699 }
 1700 
 1701 /*
 1702  * Get the value of a netCDF character attribute given its variable
 1703  * ID and name.
 1704  */
 1705 extern void
 1706 c_ncagtc(
 1707     int     ncid,       /* netCDF ID */
 1708     int     varid,      /* variable ID */
 1709     const char* attname,    /* attribute name */
 1710     char*   value,      /* pointer to data values */
 1711     int     attlen,     /* length of string argument */
 1712     int*    rcode       /* returned error code */
 1713 )
 1714 {
 1715     int     status;
 1716     nc_type datatype;
 1717 
 1718     if ((status = nc_inq_atttype(ncid, varid, attname, &datatype)) == 0)
 1719     {
 1720     if (datatype != NC_CHAR)
 1721         status = NC_ECHAR;
 1722     else
 1723     {
 1724         size_t  len;
 1725 
 1726         status = nc_inq_attlen(ncid, varid, attname, &len);
 1727         if (status == 0)
 1728         {
 1729         if (attlen < len)
 1730             status = NC_ESTS;
 1731         else
 1732         {
 1733             status = nc_get_att_text(ncid, varid, attname, 
 1734                            value);
 1735             if (status == 0)
 1736             (void) memset(value+len, ' ', attlen - len);
 1737         }
 1738         }
 1739     }
 1740     }
 1741 
 1742     if (status == 0)
 1743     *rcode = 0;
 1744     else
 1745     {
 1746     nc_advise("NCAGTC", status, "");
 1747     *rcode = ncerr;
 1748     }
 1749 }
 1750 
 1751 /*
 1752  * Copy an attribute from one open netCDF file to another.
 1753  */
 1754 extern void
 1755 c_ncacpy (
 1756     int inncid,     /* input netCDF ID */
 1757     int invarid,    /* variable ID of input netCDF or NC_GLOBAL */
 1758     const char* attname,/* name of attribute in input netCDF to be copied */
 1759     int outncid,    /* ID of output netCDF file for attribute */
 1760     int outvarid,   /* ID of associated netCDF variable or NC_GLOBAL */
 1761     int* rcode      /* returned error code */
 1762 )
 1763 {
 1764     *rcode = ncattcopy(inncid, invarid, attname, outncid, outvarid)
 1765          == -1
 1766         ? ncerr
 1767         : 0;
 1768 }
 1769 
 1770 /*
 1771  * Get the name of an attribute given its variable ID and number
 1772  * as an attribute of that variable.
 1773  */
 1774 extern void
 1775 c_ncanam (
 1776     int ncid,       /* netCDF ID */
 1777     int varid,      /* variable ID */
 1778     int attnum,     /* attribute number */
 1779     char* attname,  /* returned attribute name */
 1780     int* rcode      /* returned error code */
 1781 )
 1782 {
 1783     *rcode = ncattname(ncid, varid, attnum, attname) == -1
 1784         ? ncerr
 1785         : 0;
 1786 }
 1787 
 1788 /*
 1789  * Rename an attribute in an open netCDF file.
 1790  */
 1791 extern void
 1792 c_ncaren (
 1793     int ncid,       /* netCDF ID */
 1794     int varid,      /* variable ID */
 1795     const char* attname,/* attribute name */
 1796     const char* newname,/* new name */
 1797     int* rcode      /* returned error code */
 1798 )
 1799 {
 1800     *rcode = ncattrename(ncid, varid, attname, newname) == -1
 1801         ? ncerr
 1802         : 0;
 1803 }
 1804 
 1805 /*
 1806  * Delete an attribute from an open netCDF file given the attribute name.
 1807  */
 1808 extern void
 1809 c_ncadel (
 1810     int ncid,       /* netCDF ID */
 1811     int varid,      /* variable ID */
 1812     const char* attname,/* attribute name */
 1813     int* rcode      /* returned error code */
 1814 )
 1815 {
 1816     *rcode = ncattdel(ncid, varid, attname) == -1
 1817         ? ncerr
 1818         : 0;
 1819 }
 1820 
 1821 /*
 1822  * Set the fill mode of a netCDF file open for writing.
 1823  */
 1824 extern int
 1825 c_ncsfil (
 1826     int ncid,       /* netCDF ID */
 1827     int fillmode,   /* fill mode, NCNOFILL or NCFILL */
 1828     int* rcode      /* returned error code */
 1829 )
 1830 {
 1831     int retval;
 1832 
 1833     *rcode = ((retval = ncsetfill(ncid, fillmode)) == -1)
 1834         ? ncerr
 1835         : 0;
 1836 
 1837     return retval;
 1838 }
 1839 
 1840 #endif /*!NO_NETCDF_2*/