NetCDF-Fortran  4.4.2
nf_nc4.f90
1 ! netCDF 4 specific FORTRAN functions
2 
3 ! Replacement for fort-nc4.c
4 
5 ! Written by: Richard Weed, Ph.D.
6 ! Center for Advanced Vehicular Systems
7 ! Mississippi State University
8 ! rweed@cavs.msstate.edu
9 
10 
11 ! License (and other Lawyer Language)
12 
13 ! This software is released under the Apache 2.0 Open Source License. The
14 ! full text of the License can be viewed at :
15 !
16 ! http:www.apache.org/licenses/LICENSE-2.0.html
17 !
18 ! The author grants to the University Corporation for Atmospheric Research
19 ! (UCAR), Boulder, CO, USA the right to revise and extend the software
20 ! without restriction. However, the author retains all copyrights and
21 ! intellectual property rights explicitly stated in or implied by the
22 ! Apache license
23 
24 ! Version 1.- June 2006 - Based on netCDF 3.6.2 beta code and 4.0 alpha code
25 ! Version 2.- July 2007 - Based on netCDF 3.6.2 snapshot and 4.0 beta code
26 ! Version 3.- April 2009 - Based on NetCDF 4.0.1 release
27 ! Version 4.- April 2010 - Based on NetCDF 4.1.1 release
28 ! Version 5.- Aug. 2013 - Added nf_rename_grp to align with netCDF-C 4.3.1
29 ! Version 6.- Sep. 2013 - Changed fill routines to support different types
30 ! Version 7.- May 2014 - Ensure return error status checked from C API calls
31 
32 !-------------------------------- nf_create_par -------------------------------
33  Function nf_create_par (path, cmode, comm, info, ncid) RESULT(status)
34 
35 ! create parallel file
36 
37  USE netcdf4_nc_interfaces
38 
39  Implicit NONE
40 
41  Integer, Intent(IN) :: cmode, comm, info
42  Character(LEN=*), Intent(IN) :: path
43  Integer, Intent(OUT) :: ncid
44 
45  Integer :: status
46 
47  Integer(KIND=C_INT) :: ccmode, ccomm, cinfo, cncid, cstatus
48  Character(LEN=(LEN(path)+1)) :: cpath
49  Integer :: ie
50 
51  ccmode = cmode
52  ccomm = comm
53  cinfo = info
54  cncid = 0
55  cpath = addcnullchar(path, ie) ! add a C Null char and strip trailing blanks
56 
57  cstatus = nc_create_par_fortran(cpath(1:ie+1), ccmode, ccomm, cinfo, cncid)
58 
59  If (cstatus == nc_noerr) Then
60  ncid = cncid
61  EndIf
62  status = cstatus
63 
64  End Function nf_create_par
65 !-------------------------------- nf_open_par --------------------------------
66  Function nf_open_par (path, mode, comm, info, ncid) RESULT(status)
67 
68 ! open a parallel file
69 
70  USE netcdf4_nc_interfaces
71 
72  Implicit NONE
73 
74  Integer, Intent(IN) :: mode, comm, info
75  Character(LEN=*), Intent(IN) :: path
76  Integer, Intent(OUT) :: ncid
77 
78  Integer :: status
79 
80  Integer(KIND=C_INT) :: cmode, ccomm, cinfo, cncid, cstatus
81  Character(LEN=(LEN(path)+1)) :: cpath
82  Integer :: ie
83 
84  cmode = mode
85  ccomm = comm
86  cinfo = info
87  cncid = 0
88  cpath = addcnullchar(path, ie)
89 
90  cstatus = nc_open_par_fortran(cpath(1:ie+1), cmode, ccomm, cinfo, cncid)
91 
92  If (cstatus == nc_noerr) Then
93  ncid = cncid
94  EndIf
95  status = cstatus
96 
97  End Function nf_open_par
98 !-------------------------------- nf_var_par_access -------------------------
99  Function nf_var_par_access( ncid, varid, iaccess) RESULT (status)
100 
101 ! set variable access
102 
103  USE netcdf4_nc_interfaces
104 
105  Implicit NONE
106 
107  Integer, Intent(IN) :: ncid, varid, iaccess
108 
109  Integer :: status
110 
111  Integer(KIND=C_INT) :: cncid, cvarid, caccess, cstatus
112 
113  cncid = ncid
114  cvarid = varid - 1
115  caccess = iaccess
116 
117  cstatus = nc_var_par_access(cncid, cvarid, caccess)
118 
119  status = cstatus
120 
121  End Function nf_var_par_access
122 !-------------------------------- nf_inq_ncid ---------------------------------
123  Function nf_inq_ncid(ncid, name, groupid) RESULT (status)
124 
125 ! inquire ncid
126 
127  USE netcdf4_nc_interfaces
128 
129  Implicit NONE
130 
131  Integer, Intent(IN) :: ncid
132  Character(LEN=*), Intent(IN) :: name
133  Integer, Intent(OUT) :: groupid
134 
135  Integer :: status
136 
137  Integer(KIND=C_INT) :: cncid, cgroupid, cstatus
138  Character(LEN=LEN(name)+1) :: cname
139  Integer :: ie
140 
141  cncid = ncid
142  cgroupid = 0
143  cname = repeat(" ",len(cname))
144  cname = addcnullchar(name, ie)
145 
146  cstatus = nc_inq_ncid(cncid, cname(1:ie+1), cgroupid)
147 
148  If (cstatus == nc_noerr) Then
149  groupid = cgroupid
150  EndIf
151  status = cstatus
152 
153  End Function nf_inq_ncid
154 !-------------------------------- nf_inq_grps ---------------------------------
155  Function nf_inq_grps( ncid, numgrps, ncids) RESULT (status)
156 
157 ! inquire number of grps and ncids
158 
159  USE netcdf4_nc_interfaces
160 
161  Implicit NONE
162 
163  Integer, Intent(IN) :: ncid
164  Integer, Intent(INOUT) :: ncids(*)
165  Integer, Intent(OUT) :: numgrps
166  Integer :: status
167 
168  Integer(KIND=C_INT) :: cncid, cnumgrps, cstatus
169  Integer(KIND=C_INT) :: cncids(nc_max_dims)
170 
171  cncid = ncid
172  cnumgrps = 0
173  ncids(1) = 0
174 
175  cstatus = nc_inq_grps(cncid, cnumgrps, cncids)
176 
177  If (cstatus == nc_noerr) Then
178  numgrps = cnumgrps
179  ncids(1:numgrps) = cncids(1:numgrps)
180  EndIf
181  status = cstatus
182 
183  End Function nf_inq_grps
184 !-------------------------------- nf_inq_grpname ------------------------------
185  Function nf_inq_grpname( ncid, name) RESULT (status)
186 
187 ! inquire group name
188 
189  USE netcdf4_nc_interfaces
190 
191  Implicit NONE
192 
193  Integer, Intent(IN) :: ncid
194  Character(LEN=*), Intent(OUT) :: name
195 
196  Integer :: status
197 
198  Integer(KIND=C_INT) :: cncid, cstatus
199  Character(LEN=NC_MAX_NAME) :: cname
200  Integer :: nlen
201 
202  cncid = ncid
203  nlen = len(name)
204  name = repeat(" ",len(name))
205  cname = repeat(" ",len(cname))
206 
207  cstatus = nc_inq_grpname(cncid, cname)
208 
209  If (cstatus == nc_noerr) Then
210  name = stripcnullchar(cname,nlen) ! Strip null char and trailing blanks
211  EndIf
212  status = cstatus
213 
214  End Function nf_inq_grpname
215 !-------------------------------- nf_inq_grpname_full -------------------------
216  Function nf_inq_grpname_full( ncid, nlen, name) RESULT (status)
217 
218 ! inquire full group name and length
219 
220  USE netcdf4_nc_interfaces
221 
222  Implicit NONE
223 
224  Integer, Intent(IN) :: ncid
225  Character(LEN=*), Intent(OUT) :: name
226  Integer, Intent(OUT) :: nlen
227 
228  Integer :: status
229 
230  Integer(KIND=C_INT) :: cncid, cstatus
231  Integer(KIND=C_SIZE_T) :: clen
232  Character(LEN=LEN(name)+1) :: cname
233  Integer :: nl
234 
235  cncid = ncid
236  nl = len(name)
237  name = repeat(" ",len(name))
238  cname = repeat(" ",len(cname))
239 
240  cstatus = nc_inq_grpname_full(cncid, clen, cname)
241 
242  If (cstatus == nc_noerr) Then
243  nlen = clen
244  name = stripcnullchar(cname, nl)
245  EndIf
246  status = cstatus
247 
248  End Function nf_inq_grpname_full
249 !-------------------------------- nf_inq_grpname_len --------------------------
250  Function nf_inq_grpname_len( ncid, nlen) RESULT (status)
251 
252 ! inquire length of full group name
253 
254  USE netcdf4_nc_interfaces
255 
256  Implicit NONE
257 
258  Integer, Intent(IN) :: ncid
259  Integer, Intent(OUT) :: nlen
260 
261  Integer :: status
262 
263  Integer(KIND=C_INT) :: cncid, cstatus
264  Integer(KIND=C_SIZE_T) :: clen
265 
266  cncid = ncid
267 
268  cstatus = nc_inq_grpname_len(cncid, clen)
269 
270  If (cstatus == nc_noerr) Then
271  ! Return name length
272  nlen = clen
273  EndIf
274  status = cstatus
275 
276  End Function nf_inq_grpname_len
277 !-------------------------------- nf_inq_grp_parent ---------------------------
278  Function nf_inq_grp_parent( ncid,parent_ncid) RESULT (status)
279 
280 ! inquire group parent number
281 
282  USE netcdf4_nc_interfaces
283 
284  Implicit NONE
285 
286  Integer, Intent(IN) :: ncid
287  Integer, Intent(INOUT) :: parent_ncid
288 
289  Integer :: status
290 
291  Integer(KIND=C_INT) :: cncid, cparent_ncid, cstatus
292 
293  cncid = ncid
294 
295  cstatus = nc_inq_grp_parent(cncid, cparent_ncid)
296 
297  If (cstatus == nc_noerr) Then
298  parent_ncid = cparent_ncid
299  EndIf
300  status = cstatus
301 
302  End Function nf_inq_grp_parent
303 !-------------------------------- nf_inq_grp_ncid -----------------------------
304  Function nf_inq_grp_ncid( ncid, grp_name, parent_ncid) RESULT (status)
305 
306 ! inquire parent_ncid given group name
307 
308  USE netcdf4_nc_interfaces
309 
310  Implicit NONE
311 
312  Integer, Intent(IN) :: ncid
313  Character(LEN=*), Intent(IN) :: grp_name
314  Integer, Intent(INOUT) :: parent_ncid
315 
316  Integer :: status
317 
318  Integer(KIND=C_INT) :: cncid, cstatus, cparent_ncid
319  Character(LEN=(LEN(grp_name)+1)) :: cgrp_name
320  Integer :: ie
321 
322  cgrp_name = repeat(" ",len(cgrp_name))
323  cgrp_name = addcnullchar(grp_name, ie)
324  cncid = ncid
325 
326  cstatus = nc_inq_grp_ncid(cncid, cgrp_name(1:ie+1), cparent_ncid)
327 
328  If (cstatus == nc_noerr) Then
329  parent_ncid = cparent_ncid
330  EndIf
331  status = cstatus
332 
333  End Function nf_inq_grp_ncid
334 !-------------------------------- nf_inq_grp_full_ncid ------------------------
335  Function nf_inq_grp_full_ncid( ncid, name, grp_ncid) RESULT (status)
336 
337 ! inquire grp ncid given full group name
338 
339  USE netcdf4_nc_interfaces
340 
341  Implicit NONE
342 
343  Integer, Intent(IN) :: ncid
344  Character(LEN=*), Intent(INOUT) :: name
345  Integer, Intent(INOUT) :: grp_ncid
346 
347  Integer :: status
348 
349  Integer(KIND=C_INT) :: cncid, cstatus, cgrp_ncid
350  Character(LEN=(LEN(name)+1)) :: cgrp_name
351  Integer :: ie
352 
353 ! Test for C Null character in path and strip trailing blanks
354 
355  cncid = ncid
356  cgrp_name = repeat(" ",len(cgrp_name))
357  cgrp_name = addcnullchar(name, ie)
358 
359  cstatus = nc_inq_grp_full_ncid(cncid, cgrp_name(1:ie+1), cgrp_ncid)
360 
361  If (cstatus == nc_noerr) Then
362  grp_ncid = cgrp_ncid
363  EndIf
364  status = cstatus
365 
366  End Function nf_inq_grp_full_ncid
367 !-------------------------------- nf_inq_varids -------------------------------
368  Function nf_inq_varids( ncid, nvars, varids) RESULT (status)
369 
370 ! inquire number of vars and varids
371 
372  USE netcdf4_nc_interfaces
373 
374  Implicit NONE
375 
376  Integer, Intent(IN) :: ncid
377  Integer, Intent(OUT) :: nvars
378  Integer, Intent(INOUT) :: varids(*)
379 
380  Integer :: status
381 
382  Integer(KIND=C_INT) :: cncid, cnvars, cstatus
383 
384  cncid = ncid
385  varids(1) = 0
386 
387  cstatus = nc_inq_varids_f(cncid, cnvars, varids)
388 
389  If (cstatus == nc_noerr) Then
390  nvars = cnvars
391  EndIf
392  status = cstatus
393 
394  End Function nf_inq_varids
395 !-------------------------------- nf_inq_dimids -------------------------------
396  Function nf_inq_dimids( ncid, ndims, dimids, parent) RESULT (status)
397 
398 ! inquire number of dimids
399 
400  USE netcdf4_nc_interfaces
401 
402  Implicit NONE
403 
404  Integer, Intent(IN) :: ncid, parent
405  Integer, Intent(OUT) :: ndims
406  Integer, Intent(INOUT) :: dimids(*)
407 
408  Integer :: status
409 
410  Integer(KIND=C_INT) :: cncid, cndims, cparent, cstatus
411 
412  cncid = ncid
413  dimids(1) = 0
414 
415  cstatus = nc_inq_dimids_f(cncid, cndims, dimids, cparent)
416 
417  If (cstatus == nc_noerr) Then
418  ndims = cndims
419  EndIf
420  status = cstatus
421 
422  End Function nf_inq_dimids
423 !-------------------------------- nf_inq_typeids ------------------------------
424  Function nf_inq_typeids( ncid, ntypes, typeids) RESULT (status)
425 
426 ! inquire number of types and typeids
427 
428  USE netcdf4_nc_interfaces
429 
430  Implicit NONE
431 
432  Integer, Intent(IN) :: ncid
433  Integer, Intent(OUT) :: ntypes
434  Integer, Intent(INOUT) :: typeids(*)
435 
436  Integer :: status
437 
438  Integer(KIND=C_INT) :: cncid, cntypes, cstatus
439  Integer(KIND=C_INT) :: ctypeids(nc_max_dims)
440 
441  cncid = ncid
442  ctypeids = 0
443  typeids(1) = 0
444 
445  cstatus = nc_inq_typeids(cncid, cntypes, ctypeids)
446 
447  If (cstatus == nc_noerr) Then
448  ntypes = cntypes
449  typeids(1:ntypes) = ctypeids(1:ntypes)
450  EndIf
451  status = cstatus
452 
453  End Function nf_inq_typeids
454 !-------------------------------- nf_inq_typeid -------------------------------
455  Function nf_inq_typeid(ncid, name, typeid) RESULT (status)
456 
457 ! inquire typeid for name
458 
459  USE netcdf4_nc_interfaces
460 
461  Implicit NONE
462 
463  Integer, Intent(IN) :: ncid
464  Character(LEN=*), Intent(IN) :: name
465  Integer, Intent(OUT) :: typeid
466 
467  Integer :: status
468 
469  Integer(KIND=C_INT) :: cncid, ctypeid, cstatus
470  Character(LEN=LEN(name)+1) :: cname
471  Integer :: ie
472 
473  cncid = ncid
474  ctypeid = 0
475  cname = repeat(" ",len(cname))
476  cname = addcnullchar(name, ie)
477 
478  cstatus = nc_inq_typeid(cncid, cname(1:ie+1), ctypeid)
479 
480  If (cstatus == nc_noerr) Then
481  typeid = ctypeid
482  EndIf
483  status = cstatus
484 
485  End Function nf_inq_typeid
486 !-------------------------------- nf_def_grp ---------------------------------
487  Function nf_def_grp( parent_ncid, name, new_ncid) RESULT (status)
488 
489 ! define new group given name
490 
491  USE netcdf4_nc_interfaces
492 
493  Implicit NONE
494 
495  Integer, Intent(IN) :: parent_ncid
496  Character(LEN=*), Intent(IN) :: name
497  Integer, Intent(OUT) :: new_ncid
498 
499  Integer :: status
500 
501  Integer(KIND=C_INT) :: cncid, cnew_ncid, cstatus
502  Character(LEN=(LEN(name)+1)) :: cname
503  Integer :: ie
504 
505  cncid = parent_ncid
506  cname = repeat(" ",len(cname))
507  cname = addcnullchar(name, ie)
508 
509  cstatus = nc_def_grp(cncid, cname(1:ie+1), cnew_ncid)
510 
511  If (cstatus == nc_noerr) Then
512  new_ncid = cnew_ncid
513  EndIf
514  status = cstatus
515 
516  End Function nf_def_grp
517 !-------------------------------- nf_rename_grp -------------------------------
518  Function nf_rename_grp( grpid, name) RESULT (status)
519 
520 ! rename previously defined group
521 
522  USE netcdf4_nc_interfaces
523 
524  Implicit NONE
525 
526  Integer, Intent(IN) :: grpid
527  Character(LEN=*), Intent(IN) :: name
528 
529  Integer :: status
530 
531  Integer(KIND=C_INT) :: cgrpid, cstatus
532  Character(LEN=(LEN(name)+1)) :: cname
533  Integer :: ie
534 
535  cgrpid = grpid
536  cname = repeat(" ",len(cname))
537  cname = addcnullchar(name, ie)
538 
539  cstatus = nc_rename_grp(cgrpid, cname(1:ie+1))
540 
541  status = cstatus
542 
543  End Function nf_rename_grp
544 !-------------------------------- nf_def_compound -----------------------------
545  Function nf_def_compound( ncid, isize, name, typeid) RESULT (status)
546 
547 ! define new group given name
548 
549  USE netcdf4_nc_interfaces
550 
551  Implicit NONE
552 
553  Integer, Intent(IN) :: ncid, isize
554  Integer, Intent(OUT) :: typeid
555  Character(LEN=*), Intent(IN) :: name
556 
557  Integer :: status
558 
559  Integer(KIND=C_INT) :: cncid, ctypeid, cstatus
560  Integer(KIND=C_SIZE_T) :: csize
561  Character(LEN=(LEN(name)+1)) :: cname
562  Integer :: ie
563 
564  cncid = ncid
565  csize = isize
566  cname = repeat(" ",len(cname))
567  cname = addcnullchar(name, ie)
568 
569  cstatus = nc_def_compound(cncid, csize, cname(1:ie+1), ctypeid)
570 
571  If (cstatus == nc_noerr) Then
572  typeid = ctypeid
573  EndIf
574  status = cstatus
575 
576  End Function nf_def_compound
577 !-------------------------------- nf_insert_compound --------------------------
578  Function nf_insert_compound( ncid, xtype, name, offset, field_typeid) &
579  result(status)
580 
581 ! define new group given name
582 
583  USE netcdf4_nc_interfaces
584 
585  Implicit NONE
586 
587  Integer, Intent(IN) :: ncid, xtype, field_typeid, offset
588  Character(LEN=*), Intent(IN) :: name
589 
590  Integer :: status
591 
592  Integer(KIND=C_INT) :: cncid, cxtype, ctypeid, cstatus
593  Integer(KIND=C_SIZE_T) :: coffset
594  Character(LEN=(LEN(name)+1)) :: cname
595  Integer :: ie
596 
597  cncid = ncid
598  cxtype = xtype
599  ctypeid = field_typeid
600  coffset = offset
601  cname = repeat(" ",len(cname))
602  cname = addcnullchar(name, ie)
603 
604  cstatus = nc_insert_compound(cncid, cxtype, cname(1:ie+1), &
605  coffset, ctypeid)
606 
607  status = cstatus
608 
609  End Function nf_insert_compound
610 !-------------------------------- nf_insert_array_compound --------------------
611  Function nf_insert_array_compound( ncid, xtype, name, offset, field_typeid, &
612  ndims, dim_sizes) result(status)
613 
614 ! define new group given name
615 
616  USE netcdf4_nc_interfaces
617 
618  Implicit NONE
619 
620  Integer, Intent(IN) :: ncid, xtype, field_typeid, offset, ndims
621  Character(LEN=*), Intent(IN) :: name
622  Integer, Intent(INOUT) :: dim_sizes(*)
623 
624  Integer :: status
625 
626  Integer(KIND=C_INT) :: cncid, cxtype, ctypeid, cndims, cstatus
627  Integer(KIND=C_SIZE_T) :: coffset
628  Character(LEN=(LEN(name)+1)) :: cname
629  Integer :: ie
630 
631  cncid = ncid
632  cxtype = xtype
633  ctypeid = field_typeid
634  coffset = offset
635  cndims = ndims
636  cname = repeat(" ",len(cname))
637  cname = addcnullchar(name, ie)
638 
639  cstatus = nc_insert_array_compound_f(cncid, cxtype, cname(1:ie+1), &
640  coffset, ctypeid, cndims, dim_sizes)
641 
642  status = cstatus
643 
644  End Function nf_insert_array_compound
645 !-------------------------------- nf_inq_type ---------------------------------
646  Function nf_inq_type( ncid, xtype, name, isize) RESULT (status)
647 
648 ! define new group given name
649 
650  USE netcdf4_nc_interfaces
651 
652  Implicit NONE
653 
654  Integer, Intent(IN) :: ncid, xtype
655  Character(LEN=*), Intent(IN) :: name
656  Integer, Intent(OUT) :: isize
657 
658  Integer :: status
659 
660  Integer(KIND=C_INT) :: cncid, cxtype, cstatus
661  Integer(KIND=C_SIZE_T) :: csize
662  Character(LEN=(LEN(name)+1)) :: cname
663  Integer :: ie
664 
665  cncid = ncid
666  cxtype = xtype
667  cname = repeat(" ",len(cname))
668  cname = addcnullchar(name, ie)
669 
670  cstatus = nc_inq_type(cncid, cxtype, cname(1:ie+1), csize)
671 
672  If (cstatus == nc_noerr) Then
673  isize = csize
674  EndIf
675  status = cstatus
676 
677  End Function nf_inq_type
678 !-------------------------------- nf_inq_compound -----------------------------
679  Function nf_inq_compound( ncid, xtype, name, isize, nfields) RESULT (status)
680 
681 ! return size and nfield for compound given ncid, xtype, and name
682 
683  USE netcdf4_nc_interfaces
684 
685  Implicit NONE
686 
687  Integer, Intent(IN) :: ncid, xtype
688  Character(LEN=*), Intent(INOUT) :: name
689  Integer, Intent(INOUT) :: isize, nfields
690 
691  Integer :: status
692 
693  Integer(KIND=C_INT) :: cncid, cxtype, cstatus
694  Integer(KIND=C_SIZE_T) :: csize, cnfieldsp
695  Character(LEN=NC_MAX_NAME+1) :: cname
696  Integer :: nlen
697 
698  cncid = ncid
699  cxtype = xtype
700  nlen = len(name)
701  name = repeat(" ", nlen)
702  cname = repeat(" ", len(cname))
703 
704  cstatus = nc_inq_compound(cncid, cxtype, cname, csize, cnfieldsp)
705 
706  If (cstatus == nc_noerr) Then
707  ! Test for C Null character in path and strip trailing blanks
708  name = stripcnullchar(cname, nlen)
709  isize = csize
710  nfields = cnfieldsp
711  EndIf
712  status = cstatus
713 
714  End Function nf_inq_compound
715 !-------------------------------- nf_inq_compound_name ------------------------
716  Function nf_inq_compound_name( ncid, xtype, name) RESULT (status)
717 
718 ! inquire compound name
719 
720  USE netcdf4_nc_interfaces
721 
722  Implicit NONE
723 
724  Integer, Intent(IN) :: ncid, xtype
725  Character(LEN=*), Intent(OUT) :: name
726 
727  Integer :: status
728 
729  Integer(KIND=C_INT) :: cncid, cxtype, cstatus
730  Character(LEN=NC_MAX_NAME+1) :: cname
731  Integer :: nlen
732 
733  cncid = ncid
734  cxtype = xtype
735  nlen = len(name)
736  name = repeat(" ",len(name))
737  cname = repeat(" ",len(cname))
738 
739  cstatus = nc_inq_compound_name(cncid, cxtype, cname)
740 
741  If (cstatus == nc_noerr) Then
742  name = stripcnullchar(cname, nlen)
743  EndIf
744  status = cstatus
745 
746  End Function nf_inq_compound_name
747 !-------------------------------- nf_inq_compound_size -------------------------
748  Function nf_inq_compound_size( ncid, xtype, isize) RESULT (status)
749 
750 ! return size compound given ncid, xtype
751 
752  USE netcdf4_nc_interfaces
753 
754  Implicit NONE
755 
756  Integer, Intent(IN) :: ncid, xtype
757  Integer, Intent(INOUT) :: isize
758 
759  Integer :: status
760 
761  Integer(KIND=C_INT) :: cncid, cxtype, cstatus
762  Integer(KIND=C_SIZE_T) :: csize
763 
764  cncid = ncid
765  cxtype = xtype
766 
767  cstatus = nc_inq_compound_size(cncid, cxtype, csize)
768 
769  If (cstatus == nc_noerr) Then
770  isize = csize
771  EndIf
772  status = cstatus
773 
774  End Function nf_inq_compound_size
775 !-------------------------------- nf_inq_compound_nfields ----------------------
776  Function nf_inq_compound_nfields( ncid, xtype, nfields) RESULT (status)
777 
778 ! return size compound given ncid, xtype
779 
780  USE netcdf4_nc_interfaces
781 
782  Implicit NONE
783 
784  Integer, Intent(IN) :: ncid, xtype
785  Integer, Intent(INOUT) :: nfields
786 
787  Integer :: status
788 
789  Integer(KIND=C_INT) :: cncid, cxtype, cstatus
790  Integer(KIND=C_SIZE_T) :: cnfields
791 
792  cncid = ncid
793  cxtype = xtype
794 
795  cstatus = nc_inq_compound_nfields(cncid, cxtype, cnfields)
796 
797  If (cstatus == nc_noerr) Then
798  nfields = cnfields
799  EndIf
800  status = cstatus
801 
802  End Function nf_inq_compound_nfields
803 !-------------------------------- nf_inq_compound_field -----------------------
804  Function nf_inq_compound_field( ncid, xtype, fieldid, name, offset, &
805  field_typeid, ndims, dim_sizes) result(status)
806 
807 ! inquire compound name
808 
809  USE netcdf4_nc_interfaces
810 
811  Implicit NONE
812 
813  Integer, Intent(IN) :: ncid, xtype, fieldid
814  Character(LEN=*), Intent(OUT) :: name
815  Integer, Intent(OUT) :: offset, field_typeid, ndims
816  Integer, Intent(OUT) :: dim_sizes(*)
817 
818  Integer :: status
819 
820  Integer(KIND=C_INT) :: cncid, cxtype, cfieldid, cfield_typeid, &
821  cndims, cstatus
822  Integer(KIND=C_INT) :: cdim_sizes(nc_max_dims)
823  Integer(KIND=C_SIZE_T) :: coffset
824  Character(LEN=NC_MAX_NAME+1) :: cname
825  Integer :: nlen
826 
827  cncid = ncid
828  cxtype = xtype
829  cfieldid = fieldid-1
830  nlen = len(name)
831  name = repeat(" ",len(name))
832  cname = repeat(" ",len(cname))
833 
834  cstatus = nc_inq_compound_field_f(cncid, cxtype, cfieldid, cname, coffset, &
835  cfield_typeid, cndims, cdim_sizes)
836 
837  If (cstatus == nc_noerr) Then
838  name = stripcnullchar(cname, nlen)
839  offset = coffset
840  field_typeid = cfield_typeid
841  ndims = cndims
842  dim_sizes(1:ndims) = cdim_sizes(1:ndims)
843  EndIf
844  status = cstatus
845 
846  End Function nf_inq_compound_field
847 !-------------------------------- nf_inq_compound_fieldname -------------------
848  Function nf_inq_compound_fieldname(ncid, xtype, fieldid, name) RESULT(status)
849 
850 ! inquire compound field name
851 
852  USE netcdf4_nc_interfaces
853 
854  Implicit NONE
855 
856  Integer, Intent(IN) :: ncid, xtype, fieldid
857  Character(LEN=*), Intent(OUT) :: name
858 
859  Integer :: status
860 
861  Integer(KIND=C_INT) :: cncid, cxtype, cfieldid, cstatus
862  Character(LEN=NC_MAX_NAME+1) :: cname
863  Integer :: nlen
864 
865  cncid = ncid
866  cxtype = xtype
867  cfieldid = fieldid - 1
868  nlen = len(name)
869  name = repeat(" ",len(name))
870  cname = repeat(" ",len(cname))
871 
872  cstatus = nc_inq_compound_fieldname(cncid, cxtype, cfieldid, cname)
873 
874  If (cstatus == nc_noerr) Then
875  name = stripcnullchar(cname, nlen)
876  EndIf
877  status = cstatus
878 
879  End Function nf_inq_compound_fieldname
880 !-------------------------------- nf_inq_compound_fieldindex ------------------
881  Function nf_inq_compound_fieldindex( ncid, xtype, name, fieldid) RESULT (status)
882 
883 ! define new group given name
884 
885  USE netcdf4_nc_interfaces
886 
887  Implicit NONE
888 
889  Integer, Intent(IN) :: ncid, xtype
890  Character(LEN=*), Intent(IN) :: name
891  Integer, Intent(OUT) :: fieldid
892 
893  Integer :: status
894 
895  Integer(KIND=C_INT) :: cncid, cxtype, cfieldid, cstatus
896  Character(LEN=(LEN(name)+1)) :: cname
897  Integer :: ie
898 
899  cncid = ncid
900  cxtype = xtype
901  cname = repeat(" ",len(cname))
902  cname = addcnullchar(name, ie)
903 
904  cstatus = nc_inq_compound_fieldindex(cncid, cxtype, cname(1:ie+1), cfieldid)
905 
906  If (cstatus == nc_noerr) Then
907  fieldid = cfieldid + 1
908  EndIf
909  status = cstatus
910 
911  End Function nf_inq_compound_fieldindex
912 !-------------------------------- nf_inq_compound_fieldoffset ----------------
913  Function nf_inq_compound_fieldoffset( ncid, xtype, fieldid, offset)&
914  result(status)
915 
916 ! inquire compound field offset
917 
918  USE netcdf4_nc_interfaces
919 
920  Implicit NONE
921 
922  Integer, Intent(IN) :: ncid, xtype, fieldid
923  Integer, Intent(OUT) :: offset
924 
925  Integer :: status
926 
927  Integer(KIND=C_INT) :: cncid, cxtype, cfieldid, cstatus
928  Integer(KIND=C_SIZE_T) :: coffset
929 
930  cncid = ncid
931  cxtype = xtype
932  cfieldid = fieldid - 1
933 
934  cstatus = nc_inq_compound_fieldoffset(cncid, cxtype, cfieldid, coffset)
935 
936  If (cstatus == nc_noerr) Then
937  offset = coffset
938  EndIf
939  status = cstatus
940 
941  End Function nf_inq_compound_fieldoffset
942 !-------------------------------- nf_inq_compound_fieldtype -------------------
943  Function nf_inq_compound_fieldtype( ncid, xtype, fieldid, field_typeid) &
944  result(status)
945 
946 ! define new group given name
947 
948  USE netcdf4_nc_interfaces
949 
950  Implicit NONE
951 
952  Integer, Intent(IN) :: ncid, xtype, fieldid
953  Integer, Intent(OUT) :: field_typeid
954 
955  Integer :: status
956 
957  Integer(KIND=C_INT) :: cncid, cxtype, cfieldid, cfield_typeid, cstatus
958 
959  cncid = ncid
960  cxtype = xtype
961  cfieldid = fieldid -1
962 
963  cstatus = nc_inq_compound_fieldtype(cncid, cxtype, cfieldid, cfield_typeid)
964 
965  If (cstatus == nc_noerr) Then
966  field_typeid = cfield_typeid
967  EndIf
968  status = cstatus
969 
970  End Function nf_inq_compound_fieldtype
971 !-------------------------------- nf_inq_compound_fieldndims ------------------
972  Function nf_inq_compound_fieldndims( ncid, xtype, fieldid, ndims) RESULT (status)
973 
974 ! define new group given name
975 
976  USE netcdf4_nc_interfaces
977 
978  Implicit NONE
979 
980  Integer, Intent(IN) :: ncid, xtype, fieldid
981  Integer, Intent(OUT) :: ndims
982 
983  Integer :: status
984 
985  Integer(KIND=C_INT) :: cncid, cxtype, cfieldid, cndims, cstatus
986 
987  cncid = ncid
988  cxtype = xtype
989  cfieldid = fieldid -1
990 
991  cstatus = nc_inq_compound_fieldndims(cncid, cxtype, cfieldid, cndims)
992 
993  If (cstatus == nc_noerr) Then
994  ndims = cndims
995  EndIf
996  status = cstatus
997 
998  End Function nf_inq_compound_fieldndims
999 !-------------------------------- nf_inq_compound_fielddim_sizes --------------
1000  Function nf_inq_compound_fielddim_sizes( ncid, xtype, fieldid, dim_sizes) &
1001  result(status)
1002 
1003 ! inq compound field dimension sizes
1004 
1005  USE netcdf4_nc_interfaces
1006 
1007  Implicit NONE
1008 
1009  Integer, Intent(IN) :: ncid, xtype, fieldid
1010  Integer, Intent(INOUT) :: dim_sizes(*)
1011 
1012  Integer :: status
1013 
1014  Integer(KIND=C_INT) :: cncid, cxtype, cfieldid, cstatus
1015 
1016  cncid = ncid
1017  cxtype = xtype
1018  cfieldid = fieldid - 1
1019 
1020  cstatus = nc_inq_compound_fielddim_sizes(cncid, cxtype, cfieldid, dim_sizes)
1021 
1022  status = cstatus
1023 
1024  End Function nf_inq_compound_fielddim_sizes
1025 !-------------------------------- nf_def_vlen ---------------------------------
1026  Function nf_def_vlen( ncid, name, base_typeid, xtype) RESULT (status)
1027 
1028 ! define variable length data
1029 
1030  USE netcdf4_nc_interfaces
1031 
1032  Implicit NONE
1033 
1034  Integer, Intent(IN) :: ncid, base_typeid
1035  Character(LEN=*), Intent(IN) :: name
1036  Integer, Intent(OUT) :: xtype
1037 
1038  Integer :: status
1039 
1040  Integer(KIND=C_INT) :: cncid, cxtype, cbase_typeid, cstatus
1041  Character(LEN=(LEN(name)+1)) :: cname
1042  Integer :: ie
1043 
1044  cncid = ncid
1045  cxtype = xtype
1046  cbase_typeid = base_typeid
1047  cname = repeat(" ",len(cname))
1048  cname = addcnullchar(name, ie)
1049 
1050  cstatus = nc_def_vlen(cncid, cname(1:ie+1), cbase_typeid, cxtype)
1051 
1052  If (cstatus == nc_noerr) Then
1053  xtype = cxtype
1054  EndIf
1055  status = cstatus
1056 
1057  End Function nf_def_vlen
1058 !-------------------------------- nf_inq_vlen ---------------------------------
1059  Function nf_inq_vlen( ncid, xtype, name, datum_size, base_type) RESULT(status)
1060 
1061 ! inquire variable length array info
1062 
1063  USE netcdf4_nc_interfaces
1064 
1065  Implicit NONE
1066 
1067  Integer, Intent(IN) :: ncid, xtype
1068  Character(LEN=*), Intent(OUT) :: name
1069  Integer, Intent(OUT) :: datum_size, base_type
1070 
1071  Integer :: status
1072 
1073  Integer(KIND=C_INT) :: cncid, cxtype, cbase_type, cstatus
1074  Integer(KIND=C_SIZE_T) :: cdatum_size
1075  Character(LEN=NC_MAX_NAME+1) :: cname
1076  Integer :: nlen
1077 
1078  cncid = ncid
1079  cxtype = xtype
1080  nlen = len(name)
1081  name = repeat(" ",len(name))
1082  cname = repeat(" ",len(cname))
1083 
1084  cstatus = nc_inq_vlen(cncid, cxtype, cname, cdatum_size, cbase_type)
1085 
1086  If (cstatus == nc_noerr) Then
1087  name = stripcnullchar(cname, nlen)
1088  datum_size = cdatum_size
1089  base_type = cbase_type
1090  EndIf
1091  status = cstatus
1092 
1093  End Function nf_inq_vlen
1094 !-------------------------------- nf_inq_user_type ----------------------------
1095  Function nf_inq_user_type( ncid, xtype, name, isize, base_type, nfields, &
1096  iclass) result(status)
1097 
1098 ! return size and nfield, class, and base type for user type given
1099 ! ncid, xtype, and name
1100 
1101  USE netcdf4_nc_interfaces
1102 
1103  Implicit NONE
1104 
1105  Integer, Intent(IN) :: ncid, xtype
1106  Character(LEN=*), Intent(INOUT) :: name
1107  Integer, Intent(OUT) :: isize, nfields, base_type, iclass
1108 
1109  Integer :: status
1110 
1111  Integer(KIND=C_INT) :: cncid, cxtype, cbase_type, cclass, cstatus
1112  Integer(KIND=C_SIZE_T) :: csize, cnfields
1113  Character(LEN=NC_MAX_NAME+1) :: cname
1114  Integer :: nlen
1115 
1116  cncid = ncid
1117  cxtype = xtype
1118  nlen = len(name)
1119  name = repeat(" ",len(name))
1120  cname = repeat(" ",len(cname))
1121 
1122 
1123  cstatus = nc_inq_user_type(cncid, cxtype, cname, csize, cbase_type, cnfields, &
1124  cclass)
1125 
1126  If (cstatus == nc_noerr) Then
1127  ! Test for C Null character in path and strip trailing blanks
1128  name = stripcnullchar(cname, nlen)
1129  isize = csize
1130  nfields = cnfields
1131  iclass = cclass
1132  base_type = cbase_type
1133  EndIf
1134  status = cstatus
1135 
1136  End Function nf_inq_user_type
1137 !-------------------------------- nf_def_enum ---------------------------------
1138  Function nf_def_enum( ncid, base_typeid, name, typeid) RESULT (status)
1139 
1140 ! define new group given name
1141 
1142  USE netcdf4_nc_interfaces
1143 
1144  Implicit NONE
1145 
1146  Integer, Intent(IN) :: ncid, base_typeid
1147  Character(LEN=*), Intent(IN) :: name
1148  Integer, Intent(OUT) :: typeid
1149 
1150  Integer :: status
1151 
1152  Integer(KIND=C_INT) :: cncid, cbase_typeid, ctypeid, cstatus
1153  Character(LEN=(LEN(name)+1)) :: cname
1154  Integer :: ie
1155 
1156  cncid = ncid
1157  cbase_typeid = base_typeid
1158  cname = repeat(" ",len(cname))
1159  cname = addcnullchar(name, ie)
1160 
1161  cstatus = nc_def_enum(cncid, cbase_typeid, cname(1:ie+1), ctypeid)
1162 
1163  If (cstatus == nc_noerr) Then
1164  typeid = ctypeid
1165  EndIf
1166  status = cstatus
1167 
1168  End Function nf_def_enum
1169 !-------------------------------- nf_insert_enum -------------------------------
1170  Function nf_insert_enum( ncid, xtype, name, value) RESULT (status)
1171 
1172 ! define a value for an enum. We used a C_CHAR string to pass the data
1173 ! into nf_insert_enum and a C_PTR type to pass the address of value
1174 ! into nc_insert_enum which is expecting a void pointer. Don't use
1175 ! an explicit interface to nf_insert_enum in the calling program
1176 ! for any data type other than character. Just declare it external
1177 
1178  USE netcdf4_nc_interfaces
1179 
1180  Implicit NONE
1181 
1182  Integer, Intent(IN) :: ncid, xtype
1183  Character(LEN=*), Intent(IN) :: name
1184  Character(KIND=C_CHAR), Intent(IN), TARGET :: value(*)
1185 
1186  Integer :: status
1187 
1188  Integer(KIND=C_INT) :: cncid, cxtype, cstatus
1189  Type(c_ptr) :: cvalueptr
1190  Character(LEN=(LEN(name)+1)) :: cname
1191  Integer :: ie
1192 
1193  cncid = ncid
1194  cxtype = xtype
1195  cname = repeat(" ",len(cname))
1196  cname = addcnullchar(name, ie)
1197 
1198  cvalueptr = c_loc(value)
1199 
1200  cstatus = nc_insert_enum(cncid, cxtype, cname(1:ie+1), cvalueptr)
1201 
1202  status = cstatus
1203 
1204  End Function nf_insert_enum
1205 !-------------------------------- nf_inq_enum ------------------------------
1206  Function nf_inq_enum( ncid, xtype, name, base_nf_type, base_size, &
1207  num_members) result(status)
1208 
1209 ! get information about an enum.
1210 
1211  USE netcdf4_nc_interfaces
1212 
1213  Implicit NONE
1214 
1215  Integer, Intent(IN) :: ncid, xtype
1216  Character(LEN=*), Intent(INOUT) :: name
1217  Integer, Intent(INOUT) :: base_nf_type, base_size, num_members
1218 
1219  Integer :: status
1220 
1221  Integer(KIND=C_INT) :: cncid, cxtype, c_base_nf_type, cstatus
1222  Integer(KIND=C_SIZE_T) :: c_base_size, c_num_members
1223  Character(LEN=NC_MAX_NAME+1) :: cname
1224  Integer :: nlen
1225 
1226  cncid = ncid
1227  cxtype = xtype
1228  nlen = len(name)
1229  name = repeat(" ",len(name))
1230  cname = repeat(" ",len(cname))
1231 
1232  cstatus = nc_inq_enum(cncid, cxtype, cname, c_base_nf_type, c_base_size, &
1233  c_num_members)
1234 
1235  If (cstatus == nc_noerr) Then
1236  ! Test for C Null character in path and strip trailing blanks
1237  name = stripcnullchar(cname, nlen)
1238  base_nf_type = c_base_nf_type
1239  base_size = c_base_size
1240  num_members = c_num_members
1241  EndIf
1242  status = cstatus
1243 
1244  End Function nf_inq_enum
1245 !-------------------------------- nf_inq_enum_member ---------------------------
1246  Function nf_inq_enum_member( ncid, xtype, idx, name, value) RESULT (status)
1247 
1248 ! Get name and value for an enum. We use a C_CHAR string to pass data
1249 ! from nc_inq_enum_member to the calling routine. Value is a void
1250 ! pointer in nc_inq_enum_member. Don't use an explicit interface in
1251 ! the calling program. Declare nf_inq_enum_member external
1252 
1253  USE netcdf4_nc_interfaces
1254 
1255  Implicit NONE
1256 
1257  Integer, Intent(IN) :: ncid, xtype, idx
1258  Character(LEN=*), Intent(OUT) :: name
1259  Character(KIND=C_CHAR), Intent(OUT) :: value(*)
1260 
1261  Integer :: status
1262 
1263  Integer(KIND=C_INT) :: cncid, cxtype, cidx, cstatus
1264  Character(LEN=NC_MAX_NAME+1) :: cname
1265  Integer :: nlen
1266 
1267  cncid = ncid
1268  cxtype = xtype
1269  cidx = idx - 1
1270  nlen = len(name)
1271  name = repeat(" ",len(name))
1272  cname = repeat(" ",len(cname))
1273 
1274  cstatus = nc_inq_enum_member(cncid, cxtype, cidx, cname, value)
1275 
1276  If (cstatus == nc_noerr) Then
1277  ! Test for C Null character in path and strip trailing blanks
1278  name = stripcnullchar(cname, nlen)
1279  EndIf
1280  status = cstatus
1281 
1282  End Function nf_inq_enum_member
1283 !-------------------------------- nf_inq_enum_ident ---------------------------
1284  Function nf_inq_enum_ident( ncid, xtype, value, name) RESULT (status)
1285 
1286 ! get name of enum identifier given value, type.
1287 
1288  USE netcdf4_nc_interfaces
1289 
1290  Implicit NONE
1291 
1292  Integer, Intent(IN) :: ncid, xtype, value
1293  Character(LEN=*), Intent(INOUT) :: name
1294 
1295  Integer :: status
1296 
1297  Integer(KIND=C_INT) :: cncid, cxtype, cstatus
1298  Integer(KIND=C_LONG_LONG) :: cvalue
1299  Character(LEN=NC_MAX_NAME+1) :: cname
1300  Integer :: nlen
1301 
1302  cncid = ncid
1303  cxtype = xtype
1304  cvalue = value
1305  nlen = len(name)
1306  name = repeat(" ",len(name))
1307  cname = repeat(" ",len(cname))
1308 
1309  cstatus = nc_inq_enum_ident(cncid, cxtype, cvalue, cname)
1310 
1311  If (cstatus == nc_noerr) Then
1312  ! Test for C Null character in path and strip trailing blanks
1313  name = stripcnullchar(cname, nlen)
1314  EndIf
1315  status = cstatus
1316 
1317  End Function nf_inq_enum_ident
1318 !-------------------------------- nf_def_opaque -------------------------------
1319  Function nf_def_opaque( ncid, isize, name, xtype) RESULT (status)
1320 
1321 ! define new group given name
1322 
1323  USE netcdf4_nc_interfaces
1324 
1325  Implicit NONE
1326 
1327  Integer, Intent(IN) :: ncid, isize
1328  Character(LEN=*), Intent(IN) :: name
1329  Integer, Intent(OUT) :: xtype
1330 
1331  Integer :: status
1332 
1333  Integer(KIND=C_INT) :: cncid, cxtype, cstatus
1334  Integer(KIND=C_SIZE_T) :: csize
1335  Character(LEN=(LEN(name)+1)) :: cname
1336  Integer :: ie
1337 
1338  cncid = ncid
1339  csize = isize
1340  cxtype = xtype
1341  cname = repeat(" ",len(cname))
1342  cname = addcnullchar(name, ie)
1343 
1344  cstatus = nc_def_opaque(cncid, csize, cname(1:ie+1), cxtype)
1345 
1346  If (cstatus == nc_noerr) Then
1347  xtype = cxtype
1348  EndIf
1349  status = cstatus
1350 
1351  End Function nf_def_opaque
1352 !-------------------------------- nf_inq_opaque -------------------------------
1353  Function nf_inq_opaque( ncid, xtype, name, isize) RESULT (status)
1354 
1355 
1356  USE netcdf4_nc_interfaces
1357 
1358  Implicit NONE
1359 
1360  Integer, Intent(IN) :: ncid, xtype
1361  Character(LEN=*), Intent(INOUT) :: name
1362  Integer, Intent(OUT) :: isize
1363 
1364  Integer :: status
1365 
1366  Integer(KIND=C_INT) :: cncid, cxtype, cstatus
1367  Integer(KIND=C_SIZE_T) :: csize
1368  Character(LEN=NC_MAX_NAME+1) :: cname
1369  Integer :: nlen
1370 
1371  cncid = ncid
1372  cxtype = xtype
1373  nlen = len(name)
1374  name = repeat(" ",len(name))
1375  cname = repeat(" ",len(cname))
1376 
1377  cstatus = nc_inq_opaque(cncid, cxtype, cname, csize)
1378 
1379  If (cstatus == nc_noerr) Then
1380  ! Test for C Null character in path and strip trailing blanks
1381  name = stripcnullchar(cname, nlen)
1382  isize = csize
1383  EndIf
1384  status = cstatus
1385 
1386  End Function nf_inq_opaque
1387 !-------------------------------- nf_def_var_chunking -------------------------
1388  Function nf_def_var_chunking( ncid, varid, contiguous, chunksizes) &
1389  result(status)
1390 
1391 ! define variable chunking
1392 
1393  USE netcdf4_nc_interfaces
1394 
1395  Implicit NONE
1396 
1397  Integer, Intent(IN) :: ncid, varid, contiguous
1398  Integer, Intent(INOUT) :: chunksizes(*)
1399 
1400  Integer :: status
1401 
1402  Integer(KIND=C_INT) :: cncid, cvarid, ccontiguous, cstat1, cstatus, &
1403  cndims
1404  Integer(KIND=C_INT), TARGET :: cchunksizes(nc_max_dims)
1405  Type(c_ptr) :: cchunksizeptr
1406  Integer :: i, ndims
1407 
1408  cncid = ncid
1409  cvarid = varid-1
1410  ccontiguous = contiguous
1411 
1412  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
1413 
1414  ndims = cndims
1415  cchunksizeptr = c_null_ptr
1416 
1417  If (cstat1 == nc_noerr) Then
1418  If (ndims > 0) Then
1419  cchunksizes(1:ndims) = chunksizes(ndims:1:-1)
1420  EndIf
1421  cchunksizeptr = c_loc(cchunksizes)
1422  EndIf
1423 
1424  cstatus = nc_def_var_chunking_ints(cncid, cvarid, ccontiguous, cchunksizeptr)
1425 
1426  status = cstatus
1427 
1428  End Function nf_def_var_chunking
1429 !-------------------------------- nf_inq_var_chunking -------------------------
1430  Function nf_inq_var_chunking( ncid, varid, contiguous, chunksizes) RESULT(status)
1431 
1432 ! inquire variable chunking
1433 
1434  USE netcdf4_nc_interfaces
1435 
1436  Implicit NONE
1437 
1438  Integer, Intent(IN) :: ncid, varid
1439  Integer, Intent(INOUT) :: contiguous
1440  Integer, Intent(INOUT) :: chunksizes(*)
1441 
1442  Integer :: status
1443 
1444  Integer(KIND=C_INT) :: cncid, cvarid, ccontiguous, cstatus, cstat1, cndims
1445  Integer(KIND=C_INT) :: cchunksizes(nc_max_dims)
1446  Integer :: ndims
1447 
1448  cncid = ncid
1449  cvarid = varid-1
1450  chunksizes(1) = 0
1451 
1452  cstatus = nc_inq_var_chunking_ints(cncid, cvarid, ccontiguous, cchunksizes)
1453 
1454  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
1455 
1456  ndims = cndims
1457 
1458  If (cstat1 == nc_noerr) Then
1459  If (ndims > 0) Then
1460  chunksizes(ndims:1:-1) = cchunksizes(1:ndims)
1461  EndIf
1462  EndIf
1463 
1464  contiguous = ccontiguous
1465  status = cstatus
1466 
1467  End Function nf_inq_var_chunking
1468 !-------------------------------- nf_def_var_deflate --------------------------
1469  Function nf_def_var_deflate( ncid, varid, shuffle, deflate, deflate_level) &
1470  result(status)
1471 
1472 ! define variable deflation
1473 
1474  USE netcdf4_nc_interfaces
1475 
1476  Implicit NONE
1477 
1478  Integer, Intent(IN) :: ncid, varid, shuffle, deflate, deflate_level
1479 
1480  Integer :: status
1481 
1482  Integer(KIND=C_INT) :: cncid, cvarid, cshuffle, cdeflate, cdeflate_level, &
1483  cstatus
1484 
1485  cncid = ncid
1486  cvarid = varid-1
1487  cshuffle = shuffle
1488  cdeflate = deflate
1489  cdeflate_level = deflate_level
1490 
1491  cstatus = nc_def_var_deflate(cncid, cvarid, cshuffle, cdeflate, cdeflate_level)
1492 
1493  status = cstatus
1494 
1495  End Function nf_def_var_deflate
1496 !-------------------------------- nf_inq_var_deflate -------------------------
1497  Function nf_inq_var_deflate( ncid, varid, shuffle, deflate, deflate_level) &
1498  result(status)
1499 
1500 ! inquire variable deflation
1501 
1502  USE netcdf4_nc_interfaces
1503 
1504  Implicit NONE
1505 
1506  Integer, Intent(IN) :: ncid, varid
1507  Integer, Intent(OUT) :: shuffle, deflate, deflate_level
1508 
1509  Integer :: status
1510 
1511  Integer(KIND=C_INT) :: cncid, cvarid, cshuffle, cdeflate, cdeflate_level, &
1512  cstatus
1513 
1514  cncid = ncid
1515  cvarid = varid-1
1516 
1517  cstatus = nc_inq_var_deflate(cncid, cvarid, cshuffle, cdeflate, cdeflate_level)
1518 
1519  If (cstatus == nc_noerr) Then
1520  shuffle = cshuffle
1521  deflate = cdeflate
1522  deflate_level = cdeflate_level
1523  EndIf
1524  status = cstatus
1525 
1526  End Function nf_inq_var_deflate
1527 
1528 !-------------------------------- nf_inq_var_szip -----------------------------
1529  Function nf_inq_var_szip(ncid, varid, options_mask, pixels_per_block) RESULT(status)
1530 
1531 ! get szip variables
1532 
1533  USE netcdf4_nc_interfaces
1534 
1535  Implicit NONE
1536 
1537  Integer, Intent(IN) :: ncid, varid
1538  Integer, Intent(INOUT) :: options_mask, pixels_per_block
1539 
1540  Integer :: status
1541 
1542  Integer(C_INT) :: cncid, cvarid, coptions_mask, cpixels_per_block, cstatus
1543 
1544  cncid = ncid
1545  cvarid = varid-1
1546 
1547  cstatus = nc_inq_var_szip(cncid, cvarid, coptions_mask, cpixels_per_block)
1548 
1549  If (cstatus == nc_noerr) Then
1550  options_mask = coptions_mask
1551  pixels_per_block = cpixels_per_block
1552  EndIf
1553  status = cstatus
1554 
1555  End Function nf_inq_var_szip
1556 
1557 !-------------------------------- nf_def_var_fletcher32 -----------------------
1558  Function nf_def_var_fletcher32( ncid, varid, fletcher32) RESULT(status)
1559 
1560 ! define var for fletcher32
1561 
1562  USE netcdf4_nc_interfaces
1563 
1564  Implicit NONE
1565 
1566  Integer, Intent(IN) :: ncid, varid, fletcher32
1567 
1568  Integer :: status
1569 
1570  Integer(KIND=C_INT) :: cncid, cvarid, cfletcher32, cstatus
1571 
1572  cncid = ncid
1573  cvarid = varid-1
1574  cfletcher32 = fletcher32
1575 
1576  cstatus = nc_def_var_fletcher32(cncid, cvarid, cfletcher32)
1577 
1578  status = cstatus
1579 
1580  End Function nf_def_var_fletcher32
1581 !-------------------------------- nf_inq_var_fletcher32 ------------------------
1582  Function nf_inq_var_fletcher32( ncid, varid, fletcher32) RESULT(status)
1583 
1584 ! get var for fletcher 32
1585 
1586  USE netcdf4_nc_interfaces
1587 
1588  Implicit NONE
1589 
1590  Integer, Intent(IN) :: ncid, varid
1591  Integer, Intent(OUT) :: fletcher32
1592 
1593  Integer :: status
1594 
1595  Integer(KIND=C_INT) :: cncid, cvarid, cfletcher32, cstatus
1596 
1597  cncid = ncid
1598  cvarid = varid-1
1599 
1600  cstatus = nc_inq_var_fletcher32(cncid, cvarid, cfletcher32)
1601 
1602  If (cstatus == nc_noerr) Then
1603  fletcher32 = cfletcher32
1604  EndIf
1605 
1606  status = cstatus
1607 
1608  End Function nf_inq_var_fletcher32
1609 !-------------------------------- nf_def_var_fill -----------------------------
1610  Function nf_def_var_fill( ncid, varid, no_fill, fill_value) RESULT(status)
1611 
1612 ! define fill variable
1613 
1614  USE netcdf4_nc_interfaces
1615 
1616  Implicit NONE
1617 
1618  Integer, Intent(IN) :: ncid, varid, no_fill
1619  Character(KIND=C_CHAR), Intent(IN), TARGET :: fill_value(*)
1620 
1621  Integer :: status
1622 
1623  Integer(KIND=C_INT) :: cncid, cvarid, cno_fill, cstatus
1624  Type(c_ptr) :: cfill_value_p
1625 
1626  cncid = ncid
1627  cvarid = varid-1
1628  cno_fill = no_fill
1629 
1630  cfill_value_p = c_loc(fill_value)
1631 
1632  cstatus = nc_def_var_fill(cncid, cvarid, cno_fill, cfill_value_p)
1633 
1634  status = cstatus
1635 
1636  End Function nf_def_var_fill
1637 !-------------------------------- nf_inq_var_fill -----------------------------
1638  Function nf_inq_var_fill( ncid, varid, no_fill, fill_value) RESULT(status)
1639 
1640 ! get fill variable
1641 
1642  USE netcdf4_nc_interfaces
1643 
1644  Implicit NONE
1645 
1646  Integer, Intent(IN) :: ncid, varid
1647  Integer, Intent(OUT) :: no_fill
1648  Character(KIND=C_CHAR), Intent(INOUT) :: fill_value(*)
1649 
1650  Integer :: status
1651 
1652  Integer(KIND=C_INT) :: cncid, cvarid, cno_fill, cstatus
1653 
1654  cncid = ncid
1655  cvarid = varid-1
1656 
1657  cstatus = nc_inq_var_fill(cncid, cvarid, cno_fill, fill_value)
1658 
1659  If (cstatus == nc_noerr) Then
1660  no_fill = cno_fill
1661  EndIf
1662  status = cstatus
1663 
1664  End Function nf_inq_var_fill
1665 !-------------------------------- nf_def_var_endian ---------------------------
1666  Function nf_def_var_endian( ncid, varid, endiann) RESULT(status)
1667 
1668 ! define variable endian
1669 
1670  USE netcdf4_nc_interfaces
1671 
1672  Implicit NONE
1673 
1674  Integer, Intent(IN) :: ncid, varid, endiann
1675 
1676  Integer :: status
1677 
1678  Integer(KIND=C_INT) :: cncid, cvarid, cendiann, cstatus
1679 
1680  cncid = ncid
1681  cvarid = varid-1
1682  cendiann = endiann
1683 
1684  cstatus = nc_def_var_endian(cncid, cvarid, cendiann)
1685 
1686  status = cstatus
1687 
1688  End Function nf_def_var_endian
1689 !-------------------------------- nf_inq_var_endian ---------------------------
1690  Function nf_inq_var_endian( ncid, varid, endiann) RESULT(status)
1691 
1692 ! get variable endian
1693 
1694  USE netcdf4_nc_interfaces
1695 
1696  Implicit NONE
1697 
1698  Integer, Intent(IN) :: ncid, varid
1699  Integer, Intent(OUT) :: endiann
1700 
1701  Integer :: status
1702 
1703  Integer(KIND=C_INT) :: cncid, cvarid, cendiann, cstatus
1704 
1705  cncid = ncid
1706  cvarid = varid-1
1707 
1708  cstatus = nc_inq_var_endian(cncid, cvarid, cendiann)
1709 
1710  If (cstatus == nc_noerr) Then
1711  endiann = cendiann
1712  EndIf
1713  status = cstatus
1714 
1715  End Function nf_inq_var_endian
1716 !--------------------------------- nf_put_att --------------------------------
1717  Function nf_put_att(ncid, varid, name, xtype, nlen, value) RESULT(status)
1718 
1719 ! Write global attribute of any type. We use a C character
1720 ! string as the dummy arguments for the values
1721 
1722  USE netcdf4_nc_interfaces
1723 
1724  Implicit NONE
1725 
1726  Integer, Intent(IN) :: ncid, varid, nlen, xtype
1727  Character(LEN=*), Intent(IN) :: name
1728  Character(KIND=C_CHAR), Intent(IN), TARGET :: value(*)
1729 
1730  Integer :: status
1731 
1732  Integer(KIND=C_INT) :: cncid, cvarid, cstatus, cxtype
1733 
1734  Integer(KIND=C_SIZE_T) :: cnlen
1735  Type(c_ptr) :: cvalueptr
1736  Character(LEN=(LEN(name)+1)) :: cname
1737  Integer :: ie
1738 
1739  cncid = ncid
1740  cvarid = varid -1 ! Subtract 1 to get C varid
1741  cxtype = xtype
1742  cnlen = nlen
1743  cvalueptr = c_loc(value)
1744  cname = repeat(" ",len(cname))
1745  cname = addcnullchar(name, ie)
1746 
1747  cstatus = nc_put_att(cncid, cvarid, cname(1:ie+1), cxtype, cnlen, cvalueptr)
1748 
1749  status = cstatus
1750 
1751  End Function nf_put_att
1752 !--------------------------------- nf_get_att --------------------------------
1753  Function nf_get_att(ncid, varid, name, value) RESULT(status)
1754 
1755 ! Get global attribute of any type. We use a C character
1756 ! string as the dummy arguments for the values. Don't supply calling
1757 ! program with an explicit interface. Just use external
1758 
1759  USE netcdf4_nc_interfaces
1760 
1761  Implicit NONE
1762 
1763  Integer, Intent(IN) :: ncid, varid
1764  Character(LEN=*), Intent(IN) :: name
1765  Character(KIND=C_CHAR), Intent(INOUT) :: value(*)
1766 
1767  Integer :: status
1768 
1769  Integer(KIND=C_INT) :: cncid, cvarid, cstatus
1770  Character(LEN=(LEN(name)+1)) :: cname
1771  Integer :: ie
1772 
1773  cncid = ncid
1774  cvarid = varid -1 ! Subtract 1 to get C varid
1775  cname = repeat(" ",len(cname))
1776  cname = addcnullchar(name, ie)
1777 
1778  cstatus = nc_get_att(cncid, cvarid, cname(1:ie+1), value)
1779 
1780  status = cstatus
1781 
1782  End Function nf_get_att
1783 !--------------------------------- nf_put_vlen_element ------------------------
1784  Function nf_put_vlen_element(ncid, xtype, vlen_element, nlen, value) &
1785  result(status)
1786 
1787 ! Put in a variable length array element element for Netcdf . We use a C
1788 ! character string as the dummy arguments for the values. Don't supply calling
1789 ! program with an explicit interface. Just use external
1790 
1791 ! Note Users manual defines vlen_element to be a character string. We
1792 ! use the same here but pass it as a C_PTR type.
1793 
1794  USE netcdf4_nc_interfaces
1795 
1796  Implicit NONE
1797 
1798  Integer, Intent(IN) :: ncid, xtype, nlen
1799  Character(KIND=C_CHAR), Intent(INOUT) :: vlen_element(*)
1800  Character(KIND=C_CHAR), Intent(IN), TARGET :: value(*)
1801 
1802  Integer :: status
1803 
1804  Integer(KIND=C_INT) :: cncid, cxtype, cstatus
1805  Integer(KIND=C_SIZE_T) :: cnlen
1806  Type(c_ptr) :: cvalueptr
1807 
1808  cncid = ncid
1809  cxtype = xtype
1810  cnlen = nlen
1811  cvalueptr = c_loc(value)
1812 
1813  cstatus = nc_put_vlen_element(cncid, cxtype, vlen_element, cnlen,&
1814  cvalueptr)
1815 
1816  status = cstatus
1817 
1818  End Function nf_put_vlen_element
1819 !--------------------------------- nf_get_vlen_element ------------------------
1820  Function nf_get_vlen_element(ncid, xtype, vlen_element, nlen, value) RESULT(status)
1821 
1822 ! Get a variable length array element element for Netcdf . We use a C
1823 ! character string as the dummy arguments for the values. Don't supply calling
1824 ! program with an explicit interface. Just use external
1825 
1826 ! Note Users manual defines vlen_element to be a character string. We
1827 ! use the same here but pass it as a C_PTR type.
1828 
1829  USE netcdf4_nc_interfaces
1830 
1831  Implicit NONE
1832 
1833  Integer, Intent(IN) :: ncid, xtype
1834  Integer, Intent(INOUT) :: nlen
1835  Character(LEN=*), Intent(INOUT), TARGET :: vlen_element
1836  Character(KIND=C_CHAR), Intent(INOUT) :: value(*)
1837 
1838  Integer :: status
1839 
1840  Integer(KIND=C_INT) :: cncid, cxtype, cstatus
1841  Integer(KIND=C_SIZE_T) :: cnlen
1842 
1843  cncid = ncid
1844  cxtype = xtype
1845 
1846  cstatus = nc_get_vlen_element(cncid, cxtype, vlen_element, cnlen,&
1847  value)
1848 
1849  If (cstatus == nc_noerr) Then
1850  nlen = cnlen
1851  EndIf
1852  status = cstatus
1853 
1854  End Function nf_get_vlen_element
1855 !--------------------------------- nf_free_vlen --------------------------------
1856  Function nf_free_vlen(vl) RESULT(status)
1857 
1858 ! Free memory for vlen array
1859 ! C_CHAR string is used as the dummy arguments for vl. Don't supply calling
1860 ! program with an explicit interface. Just use external
1861 
1862  USE netcdf4_nc_interfaces
1863 
1864  Implicit NONE
1865 
1866  Character(KIND=C_CHAR), Intent(IN), TARGET :: vl(*)
1867 
1868  Integer :: status
1869 
1870  Integer(C_INT) :: cstatus
1871  Type(c_ptr) :: cvl
1872 
1873  cvl = c_loc(vl) !void pointer in C interface
1874 
1875  cstatus = nc_free_vlen(cvl)
1876 
1877  status = cstatus
1878 
1879 End Function nf_free_vlen
1880 !--------------------------------- nf_free_vlens ------------------------------
1881  Function nf_free_vlens(ilen, vl) RESULT(status)
1882 
1883 ! Free memory for vlens array
1884 ! C_CHAR string is used as the dummy arguments for vl. Don't supply calling
1885 ! program with an explicit interface. Just use external
1886 
1887  USE netcdf4_nc_interfaces
1888 
1889  Implicit NONE
1890 
1891  Integer, Intent(IN) :: ilen
1892  Character(KIND=C_CHAR), Intent(IN), TARGET :: vl(*)
1893 
1894  Integer :: status
1895 
1896  Integer(C_SIZE_T) :: clen
1897  Integer(C_INT) :: cstatus
1898  Type(c_ptr) :: cvl
1899 
1900  clen = ilen
1901  cvl = c_loc(vl) !void pointer in C interface
1902 
1903  cstatus = nc_free_vlens(clen, cvl)
1904 
1905  status = cstatus
1906 
1907 End Function nf_free_vlens
1908 !--------------------------------- nf_free_string -----------------------------
1909  Function nf_free_string(ilen, vl) RESULT(status)
1910 
1911 ! Free memory for string array
1912 ! C_CHAR string is used as the dummy arguments for vl. Don't supply calling
1913 ! program with an explicit interface. Just use external
1914 
1915  USE netcdf4_nc_interfaces
1916 
1917  Implicit NONE
1918 
1919  Integer, Intent(IN) :: ilen
1920  Character(KIND=C_CHAR), Intent(IN), TARGET :: vl(*)
1921 
1922  Integer :: status
1923 
1924  Integer(C_SIZE_T) :: clen
1925  Integer(C_INT) :: cstatus
1926  Type(c_ptr) :: cvl
1927 
1928  clen = ilen
1929  cvl = c_loc(vl) !void pointer in C interface
1930 
1931  cstatus = nc_free_string(clen, cvl)
1932 
1933  status = cstatus
1934 
1935 End Function nf_free_string
1936 
1937 !--------------------------------- nf_put_var -------------------------------
1938  Function nf_put_var(ncid, varid, values) RESULT(status)
1939 
1940 ! Write out a variable of any type. We use a C_CHAR character string
1941 ! to hold values. Therefore, an explicit interface to nf_put_var should NOT
1942 ! be used in the calling routine. Use an external instead.
1943 ! Defined in fort-vario.c but only used in 4.0.1 for NETCDF4 builds
1944 
1945  USE netcdf4_nc_interfaces
1946 
1947  Implicit NONE
1948 
1949  Integer, Intent(IN) :: ncid, varid
1950  Character(KIND=C_CHAR), Intent(IN), TARGET :: values(*)
1951 
1952  Integer :: status
1953 
1954  Integer(KIND=C_INT) :: cncid, cvarid, cstatus
1955  Type(c_ptr) :: cvaluesptr
1956 
1957  cncid = ncid
1958  cvarid = varid - 1 ! Subtract 1 to get C varid
1959 
1960  cvaluesptr = c_loc(values)
1961 
1962  cstatus = nc_put_var(cncid, cvarid, cvaluesptr)
1963 
1964  status = cstatus
1965 
1966  End Function nf_put_var
1967 !--------------------------------- nf_get_var ----------------------------
1968  Function nf_get_var(ncid, varid, values) RESULT(status)
1969 
1970 ! Read in a variable of any type. We use a C_CHAR character string
1971 ! to hold values. Therefore, an explicit interface to nf_get_var should NOT
1972 ! be used in the calling routine. Just use external
1973 ! Defined in fort-vario.c but only used in 4.0.1 for NETCDF4 builds
1974 
1975  USE netcdf4_nc_interfaces
1976 
1977  Implicit NONE
1978 
1979  Integer, Intent(IN) :: ncid, varid
1980  Character(KIND=C_CHAR), Intent(INOUT) :: values(*)
1981 
1982  Integer :: status
1983 
1984  Integer(KIND=C_INT) :: cncid, cvarid, cstatus
1985 
1986  cncid = ncid
1987  cvarid = varid - 1 ! Subtract 1 to get C varid
1988 
1989  cstatus = nc_get_var(cncid, cvarid, values)
1990 
1991  status = cstatus
1992 
1993  End Function nf_get_var
1994 !--------------------------------- nf_put_var1_int64 --------------------------
1995  Function nf_put_var1_int64(ncid, varid, ndex, ival) RESULT(status)
1996 
1997 ! Write out a 64 bit integer variable to location vector ndex to dataset
1998 ! Note that the default fort interfaces pass ival as an integer to
1999 ! nc_put_var1_longlong which is expecting a longlong. We chose to
2000 ! pass ival as an integer of type SELECTED_INT_KIND(18) which is
2001 ! consistent with the f90 interfaces that call these routines
2002 
2003  USE netcdf4_nc_interfaces
2004 
2005  Implicit NONE
2006 
2007  Integer, Intent(IN) :: ncid, varid
2008  Integer, Intent(IN) :: ndex(*)
2009  Integer(KIND=IK8), Intent(IN) :: ival
2010 
2011  Integer :: status
2012 
2013  Integer(KIND=C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
2014  Integer(KIND=C_SIZE_T), TARGET :: cndex(nc_max_dims)
2015  Integer(KIND=C_LONG_LONG) :: cival
2016  Type(c_ptr) :: cndexptr
2017  Integer :: ndims
2018 
2019  cncid = ncid
2020  cvarid = varid - 1 ! Subtract one to get C varid
2021  cndex = 0
2022  cival = ival
2023 
2024  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
2025 
2026  cndexptr = c_null_ptr
2027  ndims = cndims
2028 
2029  If (cstat1 == nc_noerr) Then
2030  If (ndims > 0) Then ! reverse array order and subtract 1 to get C index
2031  cndex(1:ndims) = ndex(ndims:1:-1)-1
2032  EndIf
2033  cndexptr = c_loc(cndex)
2034  EndIf
2035 
2036  cstatus = nc_put_var1_longlong(cncid, cvarid, cndexptr, cival)
2037 
2038  status = cstatus
2039 
2040  End Function nf_put_var1_int64
2041 !--------------------------------- nf_put_vara_int64 --------------------------
2042  Function nf_put_vara_int64(ncid, varid, start, counts, ivals) RESULT(status)
2043 
2044 ! Write out 64 bit integer array to dataset for given start and count vectors
2045 
2046  USE netcdf4_nc_interfaces
2047 
2048  Implicit NONE
2049 
2050  Integer, Intent(IN) :: ncid, varid
2051  Integer, Intent(IN) :: start(*), counts(*)
2052  Integer(KIND=IK8), Intent(IN) :: ivals(*)
2053 
2054  Integer :: status
2055 
2056  Integer(KIND=C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
2057  Integer(KIND=C_SIZE_T), TARGET :: cstart(nc_max_dims), ccounts(nc_max_dims)
2058  Type(c_ptr) :: cstartptr, ccountsptr
2059  Integer :: ndims
2060 
2061  cncid = ncid
2062  cvarid = varid - 1 ! Subtract 1 to get C varid
2063  cstart = 0
2064  ccounts = 0
2065 
2066  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
2067 
2068  cstartptr = c_null_ptr
2069  ccountsptr = c_null_ptr
2070  ndims = cndims
2071 
2072  If (cstat1 == nc_noerr) Then
2073  If (ndims > 0) Then ! flip array order for C and subtract 1 from start
2074  cstart(1:ndims) = start(ndims:1:-1)-1
2075  ccounts(1:ndims) = counts(ndims:1:-1)
2076  EndIf
2077  cstartptr = c_loc(cstart)
2078  ccountsptr = c_loc(ccounts)
2079  EndIf
2080 
2081  cstatus = nc_put_vara_longlong(cncid, cvarid, cstartptr, ccountsptr, ivals)
2082 
2083  status = cstatus
2084 
2085  End Function nf_put_vara_int64
2086 !--------------------------------- nf_put_vars_int64 --------------------------
2087  Function nf_put_vars_int64(ncid, varid, start, counts, strides, ivals) &
2088  result(status)
2089 
2090 ! Write out 64 bit integer array given start, count, and stride
2091 
2092  USE netcdf4_nc_interfaces
2093 
2094  Implicit NONE
2095 
2096  Integer, Intent(IN) :: ncid, varid
2097  Integer, Intent(IN) :: start(*), counts(*), strides(*)
2098  Integer(KIND=IK8), Intent(IN) :: ivals(*)
2099 
2100  Integer :: status
2101 
2102  Integer(KIND=C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
2103  Integer(KIND=C_SIZE_T), TARGET :: cstart(nc_max_dims), ccounts(nc_max_dims)
2104  Integer(KIND=C_PTRDIFF_T), TARGET :: cstrides(nc_max_dims)
2105  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr
2106  Integer :: ndims
2107 
2108  cncid = ncid
2109  cvarid = varid - 1 ! Subtract 1 to get C varid
2110  cstart = 0
2111  ccounts = 0
2112  cstrides = 1
2113 
2114  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
2115 
2116  cstartptr = c_null_ptr
2117  ccountsptr = c_null_ptr
2118  cstridesptr = c_null_ptr
2119  ndims = cndims
2120 
2121  If (cstat1 == nc_noerr) Then
2122  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
2123  cstart(1:ndims) = start(ndims:1:-1)-1
2124  ccounts(1:ndims) = counts(ndims:1:-1)
2125  cstrides(1:ndims) = strides(ndims:1:-1)
2126  EndIf
2127  cstartptr = c_loc(cstart)
2128  ccountsptr = c_loc(ccounts)
2129  cstridesptr = c_loc(cstrides)
2130  EndIf
2131 
2132  cstatus = nc_put_vars_longlong(cncid, cvarid, cstartptr, ccountsptr, &
2133  cstridesptr, ivals)
2134 
2135  status = cstatus
2136 
2137  End Function nf_put_vars_int64
2138 
2139 !--------------------------------- nf_put_varm_int64 -------------------------
2140  Function nf_put_varm_int64(ncid, varid, start, counts, strides, maps, &
2141  ivals) result(status)
2142 
2143 ! Write out 64 bit integer array given start, count, stride and map
2144 
2145  USE netcdf4_nc_interfaces
2146 
2147  Implicit NONE
2148 
2149  Integer, Intent(IN) :: ncid, varid
2150  Integer, Intent(IN) :: start(*), counts(*), strides(*), maps(*)
2151  Integer(KIND=IK8), Intent(IN) :: ivals(*)
2152 
2153  Integer :: status
2154 
2155  Integer(KIND=C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
2156  Integer(KIND=C_SIZE_T), TARGET :: cstart(nc_max_dims), ccounts(nc_max_dims)
2157  Integer(KIND=C_PTRDIFF_T), TARGET :: cstrides(nc_max_dims), cmaps(nc_max_dims)
2158  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr, &
2159  cmapsptr
2160  Integer :: ndims
2161 
2162  cncid = ncid
2163  cvarid = varid -1 ! Subtract 1 to get C varid
2164  cstart = 0
2165  ccounts = 0
2166  cstrides = 1
2167  cmaps = 0
2168 
2169  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
2170 
2171  cstartptr = c_null_ptr
2172  ccountsptr = c_null_ptr
2173  cstridesptr = c_null_ptr
2174  cmapsptr = c_null_ptr
2175  ndims = cndims
2176 
2177  If (cstat1 == nc_noerr) Then
2178  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
2179  cstart(1:ndims) = start(ndims:1:-1)-1
2180  ccounts(1:ndims) = counts(ndims:1:-1)
2181  cstrides(1:ndims) = strides(ndims:1:-1)
2182  cmaps(1:ndims) = maps(ndims:1:-1)
2183  EndIf
2184  cstartptr = c_loc(cstart)
2185  ccountsptr = c_loc(ccounts)
2186  cstridesptr = c_loc(cstrides)
2187  cmapsptr = c_loc(cmaps)
2188  EndIf
2189 
2190  cstatus = nc_put_varm_longlong(cncid, cvarid, cstartptr, ccountsptr, &
2191  cstridesptr, cmapsptr, ivals)
2192 
2193  status = cstatus
2194 
2195  End Function nf_put_varm_int64
2196 !--------------------------------- nf_put_var_int64 --------------------------
2197  Function nf_put_var_int64(ncid, varid, ivals) RESULT(status)
2198 
2199 ! Write out 64 bit integer array to dataset
2200 
2201  USE netcdf4_nc_interfaces
2202 
2203  Implicit NONE
2204 
2205  Integer, Intent(IN) :: ncid, varid
2206  Integer(KIND=IK8), Intent(IN) :: ivals(*)
2207 
2208  Integer :: status
2209 
2210  Integer(KIND=C_INT) :: cncid, cvarid, cstatus
2211 
2212  cncid = ncid
2213  cvarid = varid - 1 ! Subtract 1 to get C varid
2214 
2215  cstatus = nc_put_var_longlong(cncid, cvarid, ivals)
2216 
2217  status = cstatus
2218 
2219  End Function nf_put_var_int64
2220 !--------------------------------- nf_get_var1_int64 -------------------------
2221  Function nf_get_var1_int64(ncid, varid, ndex, ival) RESULT(status)
2222 
2223 ! Read in 64 bit integer variable from location vector ndex in dataset
2224 
2225  USE netcdf4_nc_interfaces
2226 
2227  Implicit NONE
2228 
2229  Integer, Intent(IN) :: ncid, varid
2230  Integer, Intent(IN) :: ndex(*)
2231  Integer(KIND=IK8), Intent(OUT) :: ival
2232 
2233  Integer :: status
2234 
2235  Integer(KIND=C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
2236  Integer(KIND=C_SIZE_T), TARGET :: cndex(nc_max_dims)
2237  Integer(KIND=C_LONG_LONG) :: cival
2238  Type(c_ptr) :: cndexptr
2239  Integer :: ndims
2240 
2241  cncid = ncid
2242  cvarid = varid - 1 ! Subtract one to get C varid
2243  cndex = 0
2244 
2245  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
2246 
2247  cndexptr = c_null_ptr
2248  ndims = cndims
2249 
2250  If (cstat1 == nc_noerr) Then
2251  If (ndims > 0) Then ! reverse array order and subtract 1 to get C index
2252  cndex(1:ndims) = ndex(ndims:1:-1)-1
2253  EndIf
2254  cndexptr = c_loc(cndex)
2255  EndIf
2256 
2257  cstatus = nc_get_var1_longlong(cncid, cvarid, cndexptr, cival)
2258 
2259  ival = cival
2260  status = cstatus
2261 
2262  End Function nf_get_var1_int64
2263 !--------------------------------- nf_get_vara_int -------------------------
2264  Function nf_get_vara_int64(ncid, varid, start, counts, ivals) RESULT(status)
2265 
2266 ! Read in 64 bit integer array from dataset for given start and count vectors
2267 
2268  USE netcdf4_nc_interfaces
2269 
2270  Implicit NONE
2271 
2272  Integer, Intent(IN) :: ncid, varid
2273  Integer, Intent(IN) :: start(*), counts(*)
2274  Integer(KIND=IK8), Intent(OUT) :: ivals(*)
2275 
2276  Integer :: status
2277 
2278  Integer(KIND=C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
2279  Integer(KIND=C_SIZE_T), TARGET :: cstart(nc_max_dims), ccounts(nc_max_dims)
2280  Type(c_ptr) :: cstartptr, ccountsptr
2281  Integer :: ndims
2282 
2283  cncid = ncid
2284  cvarid = varid - 1 ! Subtract 1 to get C varid
2285  cstart = 0
2286  ccounts = 0
2287 
2288  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
2289 
2290  cstartptr = c_null_ptr
2291  ccountsptr = c_null_ptr
2292  ndims = cndims
2293 
2294  If (cstat1 == nc_noerr) Then
2295  If (ndims > 0) Then ! flip array order for C and subtract 1 from start
2296  cstart(1:ndims) = start(ndims:1:-1)-1
2297  ccounts(1:ndims) = counts(ndims:1:-1)
2298  EndIf
2299  cstartptr = c_loc(cstart)
2300  ccountsptr = c_loc(ccounts)
2301  EndIf
2302 
2303  cstatus = nc_get_vara_longlong(cncid, cvarid, cstartptr, ccountsptr, ivals)
2304 
2305  status = cstatus
2306 
2307  End Function nf_get_vara_int64
2308 
2309 !--------------------------------- nf_get_vars_int64 --------------------------
2310  Function nf_get_vars_int64(ncid, varid, start, counts, strides, ivals) &
2311  result(status)
2312 
2313 ! Read in 64 bit integer array given start, count, and stride
2314 
2315  USE netcdf4_nc_interfaces
2316 
2317  Implicit NONE
2318 
2319  Integer, Intent(IN) :: ncid, varid
2320  Integer, Intent(IN) :: start(*), counts(*), strides(*)
2321  Integer(KIND=IK8), Intent(OUT) :: ivals(*)
2322 
2323  Integer :: status
2324 
2325  Integer(KIND=C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
2326  Integer(KIND=C_SIZE_T), TARGET :: cstart(nc_max_dims), ccounts(nc_max_dims)
2327  Integer(KIND=C_PTRDIFF_T), TARGET :: cstrides(nc_max_dims)
2328  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr
2329  Integer :: ndims
2330 
2331  cncid = ncid
2332  cvarid = varid - 1 ! Subtract 1 to get C varid
2333  cstart = 0
2334  ccounts = 0
2335  cstrides = 1
2336 
2337  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
2338 
2339  cstartptr = c_null_ptr
2340  ccountsptr = c_null_ptr
2341  cstridesptr = c_null_ptr
2342  ndims = cndims
2343 
2344  If (cstat1 == nc_noerr) Then
2345  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
2346  cstart(1:ndims) = start(ndims:1:-1)-1
2347  ccounts(1:ndims) = counts(ndims:1:-1)
2348  cstrides(1:ndims) = strides(ndims:1:-1)
2349  EndIf
2350  cstartptr = c_loc(cstart)
2351  ccountsptr = c_loc(ccounts)
2352  cstridesptr = c_loc(cstrides)
2353  EndIf
2354 
2355  cstatus = nc_get_vars_longlong(cncid, cvarid, cstartptr, ccountsptr, &
2356  cstridesptr, ivals)
2357  status = cstatus
2358 
2359  End Function nf_get_vars_int64
2360 !--------------------------------- nf_get_varm_int64 -------------------------
2361  Function nf_get_varm_int64(ncid, varid, start, counts, strides, maps, &
2362  ivals) result(status)
2363 
2364 ! Read in 64 bit integer array given start, count, stride and map
2365 
2366  USE netcdf4_nc_interfaces
2367 
2368  Implicit NONE
2369 
2370  Integer, Intent(IN) :: ncid, varid
2371  Integer, Intent(IN) :: start(*), counts(*), strides(*), maps(*)
2372  Integer(KIND=IK8), Intent(OUT) :: ivals(*)
2373 
2374  Integer :: status
2375 
2376  Integer(KIND=C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
2377  Integer(KIND=C_SIZE_T), TARGET :: cstart(nc_max_dims), ccounts(nc_max_dims)
2378  Integer(KIND=C_PTRDIFF_T), TARGET :: cstrides(nc_max_dims), cmaps(nc_max_dims)
2379  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr, &
2380  cmapsptr
2381  Integer :: ndims
2382 
2383  cncid = ncid
2384  cvarid = varid -1 ! Subtract 1 to get C varid
2385  cstart = 0
2386  ccounts = 0
2387  cstrides = 1
2388  cmaps = 0
2389 
2390  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
2391 
2392  cstartptr = c_null_ptr
2393  ccountsptr = c_null_ptr
2394  cstridesptr = c_null_ptr
2395  cmapsptr = c_null_ptr
2396  ndims = cndims
2397 
2398  If (cstat1 == nc_noerr) Then
2399  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
2400  cstart(1:ndims) = start(ndims:1:-1)-1
2401  ccounts(1:ndims) = counts(ndims:1:-1)
2402  cstrides(1:ndims) = strides(ndims:1:-1)
2403  cmaps(1:ndims) = maps(ndims:1:-1)
2404  EndIf
2405  cstartptr = c_loc(cstart)
2406  ccountsptr = c_loc(ccounts)
2407  cstridesptr = c_loc(cstrides)
2408  cmapsptr = c_loc(cmaps)
2409  EndIf
2410 
2411  cstatus = nc_get_varm_longlong(cncid, cvarid, cstartptr, ccountsptr, &
2412  cstridesptr, cmapsptr, ivals)
2413 
2414  status = cstatus
2415 
2416  End Function nf_get_varm_int64
2417 !--------------------------------- nf_get_var_int64 --------------------------
2418  Function nf_get_var_int64(ncid, varid, ivals) RESULT(status)
2419 
2420 ! Read in 64 bit integer array from dataset
2421 
2422  USE netcdf4_nc_interfaces
2423 
2424  Implicit NONE
2425 
2426  Integer, Intent(IN) :: ncid, varid
2427  Integer(KIND=IK8), Intent(OUT) :: ivals(*)
2428 
2429  Integer :: status
2430 
2431  Integer(KIND=C_INT) :: cncid, cvarid, cstatus
2432 
2433  cncid = ncid
2434  cvarid = varid - 1 ! Subtract 1 to get C varid
2435 
2436  cstatus = nc_get_var_longlong(cncid, cvarid, ivals)
2437 
2438  status = cstatus
2439 
2440  End Function nf_get_var_int64
2441 !--------------------------------- nf_set_chunk_cache ------------------------
2442  Function nf_set_chunk_cache(chunk_size, nelems, preemption) RESULT(status)
2443 
2444 ! Set chunk cache size. Note this follows the fort-nc4 version which uses
2445 ! uses nc_set_chunk_cache_ints to avoid size_t issues with fortran. F03
2446 ! does not have these issues so we could call nc_set_chunk_cache
2447 
2448  USE netcdf4_nc_interfaces
2449 
2450  Implicit NONE
2451 
2452  Integer, Intent(IN) :: chunk_size, nelems, preemption
2453 
2454  Integer :: status
2455 
2456  Integer(KIND=C_INT) :: cchunk_size, cnelems, cpreemption, cstatus
2457 
2458  cchunk_size = chunk_size
2459  cnelems = nelems
2460  cpreemption = preemption
2461 
2462  cstatus = nc_set_chunk_cache_ints(cchunk_size, cnelems, cpreemption)
2463 
2464  status = cstatus
2465 
2466  End Function nf_set_chunk_cache
2467 !--------------------------------- nf_get_chunk_cache -------------------------
2468  Function nf_get_chunk_cache(chunk_size, nelems, preemption) RESULT(status)
2469 
2470 ! get chunk cache size. Note this follows the fort-nc4 version which uses
2471 ! uses nc_get_chunk_cache_ints to avoid size_t issues with fortran. F03
2472 ! does not have these issues so we could call nc_set_chunk_cache
2473 
2474  USE netcdf4_nc_interfaces
2475 
2476  Implicit NONE
2477 
2478  Integer, Intent(INOUT) :: chunk_size, nelems, preemption
2479 
2480  Integer :: status
2481 
2482  Integer(KIND=C_INT) :: cchunk_size, cnelems, cpreemption, cstatus
2483 
2484  cstatus = nc_get_chunk_cache_ints(cchunk_size, cnelems, cpreemption)
2485 
2486  If (cstatus == nc_noerr) Then
2487  chunk_size = cchunk_size
2488  nelems = cnelems
2489  preemption = cpreemption
2490  EndIf
2491  status = cstatus
2492 
2493  End Function nf_get_chunk_cache
2494 !--------------------------------- nf_set_var_chunk_cache ---------------------
2495  Function nf_set_var_chunk_cache(ncid, varid, chunk_size, nelems, preemption) RESULT(status)
2496 
2497 ! Set chunk cache size. Note this follows the fort-nc4 version which uses
2498 ! uses nc_set_var_chunk_cache_ints to avoid size_t issues with fortran.
2499 
2500  USE netcdf4_nc_interfaces
2501 
2502  Implicit NONE
2503 
2504  Integer, Intent(IN) :: ncid, varid, chunk_size, nelems, preemption
2505 
2506  Integer :: status
2507 
2508  Integer(KIND=C_INT) :: cncid, cvarid, cchunk_size, cnelems, cpreemption, &
2509  cstatus
2510 
2511  cncid = ncid
2512  cvarid = varid-1
2513  cchunk_size = chunk_size
2514  cnelems = nelems
2515  cpreemption = preemption
2516 
2517  cstatus = nc_set_var_chunk_cache_ints(cncid, cvarid, cchunk_size, cnelems, &
2518  cpreemption)
2519 
2520  status = cstatus
2521 
2522  End Function nf_set_var_chunk_cache
2523 !--------------------------------- nf_get_var_chunk_cache ---------------------
2524  Function nf_get_var_chunk_cache(ncid, varid, chunk_size, nelems, preemption) RESULT(status)
2525 
2526 ! get chunk cache size. Note this follows the fort-nc4 version which uses
2527 ! uses nc_get_var_chunk_cache_ints to avoid size_t issues with fortran.
2528 
2529  USE netcdf4_nc_interfaces
2530 
2531  Implicit NONE
2532 
2533  Integer, Intent(IN) :: ncid, varid
2534  Integer, Intent(INOUT) :: chunk_size, nelems, preemption
2535 
2536  Integer :: status
2537 
2538  Integer(KIND=C_INT) :: cncid, cvarid, cchunk_size, cnelems, cpreemption, &
2539  cstatus
2540 
2541  cncid = ncid
2542  cvarid = varid-1
2543 
2544  cstatus = nc_get_var_chunk_cache_ints(cncid, cvarid, cchunk_size, cnelems, &
2545  cpreemption)
2546 
2547  If (cstatus == nc_noerr) Then
2548  chunk_size = cchunk_size
2549  nelems = cnelems
2550  preemption = cpreemption
2551  EndIf
2552  status = cstatus
2553 
2554  End Function nf_get_var_chunk_cache

Return to the Main Unidata NetCDF page.
Generated on Sun Dec 27 2015 13:19:49 for NetCDF-Fortran. NetCDF is a Unidata library.