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

Return to the Main Unidata NetCDF page.
Generated on Mon Dec 19 2016 16:43:42 for NetCDF-Fortran. NetCDF is a Unidata library.