NetCDF-Fortran  4.4.2
nf_control.F90
1 ! ------------ Routines to create/open/close/redefine netcdf files ------------
2 
3 ! Replacement for fort-control.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.: Sept. 2005 - Initial Cray X1 version
25 ! Version 2.: May, 2006 - Updated to support g95
26 ! Version 3.: April, 2009 - Updated for netcdf 4.0.1
27 ! Version 4.: April, 2010 - Updated for netcdf 4.1.1
28 ! Version 5.: Feb. 2013 - Added nf_inq_path support for fortran 4.4
29 ! Vertion 6.: Nov. 2013 - Added nf_set_log_level support
30 ! Version 7.: May, 2014 - Ensure return error status checked from C API calls
31 !
32 !-------------------------------- nf_create --------------------------------
33  Function nf_create(path, cmode, ncid) RESULT (status)
34 
35 ! Creates a new NetCDF file given a file name and a creation mode and returns
36 ! the file id and a status flag
37 
38  USE netcdf_nc_interfaces
39 
40  Implicit NONE
41 
42  Character(LEN=*), Intent(IN) :: path
43  Integer, Intent(IN) :: cmode
44  Integer, Intent(OUT) :: ncid
45 
46  Integer :: status
47 
48  Integer(KIND=C_INT) :: ccmode, cncid, cstatus
49  Character(LEN=(LEN(path)+1)) :: cpath
50  Integer :: ie
51 
52  ccmode = cmode
53  cncid = 0
54 
55 ! Check for C null character on path. We will always add a null
56 ! char so we don't need a second one
57 
58  cpath = addcnullchar(path, ie)
59 
60 ! Call nc_create to create file
61 
62  cstatus = nc_create(cpath(1:ie+1), ccmode, cncid)
63 
64  If (cstatus == nc_noerr) Then
65  ncid = cncid
66  EndIf
67  status = cstatus
68 
69  End Function nf_create
70 !-------------------------------- nf__create -------------------------------
71  Function nf__create(path, cmode, initialsz, chunksizehintp, ncid) &
72  result(status)
73 
74 ! Creates a new NetCDF file and returns the file id and a status flag
75 ! This is an alternate form of nf_create that allows user to input
76 ! two additional tuning parameters
77 
78  USE netcdf_nc_interfaces
79 
80  Implicit NONE
81 
82  Character(LEN=*), Intent(IN) :: path
83  Integer, Intent(IN) :: cmode, initialsz, chunksizehintp
84  Integer, Intent(OUT) :: ncid
85 
86  Integer :: status
87 
88  Integer(KIND=C_INT) :: ccmode, cncid, cstatus
89  Integer(KIND=C_SIZE_T) :: cinit, cchunk
90  Character(LEN=(LEN(path)+1)) :: cpath
91  Integer :: ie
92 
93  ccmode = cmode
94  cchunk = chunksizehintp
95  cinit = initialsz
96  cncid = 0
97 
98 ! Check for C null character on path. We will always add a null
99 ! char so we don't need a second one
100 
101  cpath = addcnullchar(path, ie)
102 
103 ! Call nc_create to create file
104 
105  cstatus = nc__create(cpath(1:ie+1), ccmode, cinit, cchunk, cncid)
106 
107  If (cstatus == nc_noerr) Then
108  ncid = cncid
109  EndIf
110  status = cstatus
111 
112  End Function nf__create
113 !-------------------------------- nf__create_mp ------------------------------
114  Function nf__create_mp(path, cmode, initialsz, basepe, chunksizehintp, ncid) &
115  result(status)
116 
117 ! Creates a new NetCDF file and returns the file id and a status flag
118 ! This is an alternate form of nf__create for shared memory MPP systems
119 ! two additional tuning parameters
120 
121  USE netcdf_nc_interfaces
122 
123  Implicit NONE
124 
125  Character(LEN=*), Intent(IN) :: path
126  Integer, Intent(IN) :: cmode, initialsz, chunksizehintp, basepe
127  Integer, Intent(OUT) :: ncid
128 
129  Integer :: status
130 
131  Integer(KIND=C_INT) :: ccmode, cncid, cstatus
132  Integer(KIND=C_INT), TARGET :: cbasepe
133  Integer(KIND=C_SIZE_T) :: cinit, cchunk
134  Type(c_ptr) :: cbasepeptr
135  Character(LEN=(LEN(path)+1)) :: cpath
136  Integer :: ie
137 
138  ccmode = cmode
139  cchunk = chunksizehintp
140  cinit = initialsz
141  cncid = 0
142  cbasepe = basepe
143  cbasepeptr = c_loc(cbasepe)
144 
145 ! Check for C null character on path. We will always add a null
146 ! char so we don't need a second one
147 
148  cpath = addcnullchar(path, ie)
149 
150 ! Call nc_create_mp to create file for base pe
151 
152  cstatus = nc__create_mp(cpath(1:ie+1), ccmode, cinit, cbasepeptr, &
153  cchunk, cncid)
154 
155  If (cstatus == nc_noerr) Then
156  ncid = cncid
157  EndIf
158  status = cstatus
159 
160  End Function nf__create_mp
161 !-------------------------------- nf_open ----------------------------------
162  Function nf_open(path, mode, ncid) RESULT (status)
163 
164 ! Open an existing NetCDF file and return file id and a status flag
165 
166  USE netcdf_nc_interfaces
167 
168  Implicit NONE
169 
170  Character(LEN=*), Intent(IN) :: path
171  Integer, Intent(IN) :: mode
172  Integer, Intent(INOUT) :: ncid
173 
174  Integer :: status
175 
176  Integer(KIND=C_INT) :: cmode, cncid, cstatus
177  Character(LEN=(LEN(path)+1)) :: cpath
178  Integer :: ie
179 
180  cmode = mode
181  cncid = 0
182 
183 ! Check for C null character on path. We will always add a null
184 ! char so we don't need a second one
185 
186  cpath = addcnullchar(path, ie)
187 
188 ! Call nc_create to create file
189 
190  cstatus = nc_open(cpath(1:ie+1), cmode, cncid)
191 
192  If (cstatus == nc_noerr) Then
193  ncid = cncid
194  EndIf
195  status = cstatus
196 
197  End Function nf_open
198 !-------------------------------- nf__open ---------------------------------
199  Function nf__open(path, mode, chunksizehintp, ncid) RESULT (status)
200 
201 ! Open an existing NetCDF file and return file id and a status flag
202 ! Alternate form of nf_open with extra tuning parameter
203 
204  USE netcdf_nc_interfaces
205 
206  Implicit NONE
207 
208  Character(LEN=*), Intent(IN) :: path
209  Integer, Intent(IN) :: mode, chunksizehintp
210  Integer, Intent(INOUT) :: ncid
211 
212  Integer :: status
213 
214  Integer(KIND=C_INT) :: cmode, cncid, cstatus
215  Integer(KIND=C_SIZE_T) :: cchunk
216  Character(LEN=(LEN(path)+1)) :: cpath
217  Integer :: inull, ie
218 
219  cmode = mode
220  cchunk = chunksizehintp
221  cncid = 0
222 
223 ! Check for C null character in path. A null character is always added
224 ! before we pass path to C we don't need a second one
225 
226  cpath = addcnullchar(path,ie)
227 
228 ! Call nc_create to create file
229 
230  cstatus = nc__open(cpath(1:ie+1), cmode, cchunk, cncid)
231 
232  If (cstatus == nc_noerr) Then
233  ncid = cncid
234  EndIf
235  status = cstatus
236 
237  End Function nf__open
238 !-------------------------------- nf__open_mp --------------------------------
239  Function nf__open_mp(path, mode, basepe, chunksizehintp, ncid) RESULT (status)
240 
241 ! Open an existing NetCDF file and return file id and a status flag
242 ! Alternate form of nf__open with parameter to designate basepe on
243 ! shared memory MPP systems.
244 
245  USE netcdf_nc_interfaces
246 
247  Implicit NONE
248 
249  Character(LEN=*), Intent(IN) :: path
250  Integer, Intent(IN) :: mode, chunksizehintp, basepe
251  Integer, Intent(INOUT) :: ncid
252 
253  Integer :: status
254 
255  Integer(KIND=C_INT) :: cmode, cncid, cstatus
256  Integer(KIND=C_INT), TARGET :: cbasepe
257  Integer(KIND=C_SIZE_T) :: cchunk
258  Type(c_ptr) :: cbasepeptr
259  Character(LEN=(LEN(path)+1)) :: cpath
260  Integer :: ie
261 
262  cmode = mode
263  cchunk = chunksizehintp
264  cncid = 0
265  cbasepe = basepe
266  cbasepeptr = c_loc(cbasepe)
267 
268 ! Check for C null character in path. A null character is always added
269 ! before we pass path to C we don't need a second one
270 
271  cpath = addcnullchar(path, ie)
272 
273 ! Call nc_create to create file
274 
275  cstatus = nc__open_mp(cpath(1:ie+1), cmode, cbasepeptr, cchunk, &
276  cncid)
277 
278  If (cstatus == nc_noerr) Then
279  ncid = cncid
280  EndIf
281  status = cstatus
282 
283  End Function nf__open_mp
284 !-------------------------------- nf_inq_path ------------------------------
285  Function nf_inq_path(ncid, pathlen, path) RESULT(status)
286 
287 ! Inquire about file pathname and name length
288 
289  USE netcdf_nc_interfaces
290 
291  Implicit NONE
292 
293  Integer, Intent(IN) :: ncid
294  Integer, Intent(INOUT) :: pathlen
295  Character(LEN=*), Intent(INOUT) :: path
296 
297  Integer :: status
298 
299  Integer(C_INT) :: cncid, cstatus
300  Integer(C_SIZE_T) :: cpathlen
301  Character(LEN=LEN(path)+1) :: tmppath
302 
303  cncid = ncid
304  path = repeat(" ", len(path))
305  tmppath = repeat(" ", len(tmppath))
306 
307  cstatus = nc_inq_path(cncid, cpathlen, tmppath)
308 
309  If (cstatus == nc_noerr) Then
310  pathlen = cpathlen
311  If (pathlen > len(path)) pathlen = len(path)
312  path = stripcnullchar(tmppath, pathlen)
313  EndIf
314  status = cstatus
315 
316  End Function nf_inq_path
317 !-------------------------------- nf_set_fill ------------------------------
318  Function nf_set_fill(ncid, fillmode, old_mode) RESULT(status)
319 
320 ! Sets fill mode for given netcdf file returns old mode if present
321 
322  USE netcdf_nc_interfaces
323 
324  Implicit NONE
325 
326  Integer, Intent(IN) :: ncid, fillmode
327  Integer, Intent(OUT) :: old_mode
328 
329  Integer :: status
330 
331  Integer(KIND=C_INT) :: cncid, cfill, coldmode, cstatus
332 
333  cncid = ncid
334  cfill = fillmode
335  coldmode = 0
336 
337  cstatus = nc_set_fill(cncid, cfill, coldmode)
338 
339  If (cstatus == nc_noerr) Then
340  old_mode = coldmode
341  EndIf
342  status = cstatus
343 
344  End Function nf_set_fill
345 !-------------------------------- nf_set_default_format --------------------
346  Function nf_set_default_format(newform, old_format) RESULT(status)
347 
348 ! Sets new default data format. Used to toggle between 64 bit offset and
349 ! classic mode
350 
351  USE netcdf_nc_interfaces
352 
353  Implicit NONE
354 
355  Integer, Intent(IN) :: newform
356  Integer, Intent(OUT) :: old_format
357 
358  Integer :: status
359 
360  Integer(KIND=C_INT) :: cnew, cold, cstatus
361 
362  cnew = newform
363 
364  cstatus = nc_set_default_format(cnew,cold)
365 
366  If (cstatus == nc_noerr) Then
367  old_format = cold
368  EndIf
369  status = cstatus
370 
371  End Function nf_set_default_format
372 !-------------------------------- nf_redef ---------------------------------
373  Function nf_redef(ncid) RESULT(status)
374 
375 ! Re-Enter definition mode for NetCDF file id ncid
376 
377  USE netcdf_nc_interfaces
378 
379  Implicit NONE
380 
381  Integer, Intent(IN) :: ncid
382 
383  Integer :: status
384 
385  Integer(KIND=C_INT) :: cncid, cstatus
386 
387  cncid = ncid
388 
389  cstatus = nc_redef(cncid)
390 
391  status = cstatus
392 
393  End Function nf_redef
394 !-------------------------------- nf_enddef --------------------------------
395  Function nf_enddef(ncid) RESULT(status)
396 
397 ! Exit definition mode for NetCDF file id ncid
398 
399  USE netcdf_nc_interfaces
400 
401  Implicit NONE
402 
403  Integer, Intent(IN) :: ncid
404 
405  Integer :: status
406 
407  Integer(KIND=C_INT) :: cncid, cstatus
408 
409  cncid = ncid
410 
411  cstatus = nc_enddef(cncid)
412 
413  status = cstatus
414 
415  End Function nf_enddef
416 !-------------------------------- nf__enddef -------------------------------
417  Function nf__enddef(ncid, h_minfree, v_align, v_minfree, r_align) &
418  result(status)
419 
420 ! Exit definition mode for NetCDF file id ncid. Alternate version
421 ! with additional tuning parameters
422 
423  USE netcdf_nc_interfaces
424 
425  Implicit NONE
426 
427  Integer, Intent(IN) :: ncid, h_minfree, v_align, v_minfree, r_align
428 
429  Integer :: status
430 
431  Integer(KIND=C_INT) :: cncid, cstatus
432  Integer(KIND=C_SIZE_T) :: chminfree, cvalign, cvminfree, cralign
433 
434  cncid = ncid
435  chminfree = h_minfree
436  cvalign = v_align
437  cvminfree = v_minfree
438  cralign = r_align
439 
440  cstatus = nc__enddef(cncid, chminfree, cvalign, cvminfree, cralign)
441 
442  status = cstatus
443 
444  End Function nf__enddef
445 !-------------------------------- nf_sync ----------------------------------
446  Function nf_sync(ncid) RESULT(status)
447 
448 ! synch up all open NetCDF files
449 
450  USE netcdf_nc_interfaces
451 
452  Implicit NONE
453 
454  Integer, Intent(IN) :: ncid
455 
456  Integer :: status
457 
458  Integer(KIND=C_INT) :: cncid, cstatus
459 
460  cncid = ncid
461 
462  cstatus = nc_sync(cncid)
463 
464  status = cstatus
465 
466  End Function nf_sync
467 !-------------------------------- nf_abort ---------------------------------
468  Function nf_abort(ncid) RESULT(status)
469 
470 ! Abort netCDF file creation and exit
471 
472  USE netcdf_nc_interfaces
473 
474  Implicit NONE
475 
476  Integer, Intent(IN) :: ncid
477 
478  Integer :: status
479 
480  Integer(KIND=C_INT) :: cncid, cstatus
481 
482  cncid = ncid
483 
484  cstatus = nc_abort(cncid)
485 
486  status = cstatus
487 
488  End Function nf_abort
489 !-------------------------------- nf_close ---------------------------------
490  Function nf_close(ncid) RESULT(status)
491 
492 ! Close netCDF file id ncid
493 
494  USE netcdf_nc_interfaces
495 
496  Implicit NONE
497 
498  Integer, Intent(IN) :: ncid
499 
500  Integer :: status
501 
502  Integer(KIND=C_INT) :: cncid, cstatus
503 
504  cncid = ncid
505 
506  cstatus = nc_close(cncid)
507 
508  status = cstatus
509 
510  End Function nf_close
511 !-------------------------------- nf_delete --------------------------------
512  Function nf_delete(path) RESULT(status)
513 
514 ! Delete netCDF file id ncid
515 
516  USE netcdf_nc_interfaces
517 
518  Implicit NONE
519 
520  Character(LEN=*), Intent(IN) :: path
521 
522  Integer :: status
523 
524  Integer(KIND=C_INT) :: cstatus
525  Character(LEN=(LEN(path)+1)) :: cpath
526  Integer :: ie
527 
528  cpath = addcnullchar(path,ie)
529 
530  cstatus = nc_delete(cpath(1:ie+1))
531 
532  status = cstatus
533 
534  End Function nf_delete
535 !-------------------------------- nf_delete_mp -------------------------------
536  Function nf_delete_mp(path, pe) RESULT(status)
537 
538 ! Delete netCDF file id ncid. Alternate form of nf_delete for shared memory
539 ! MPP systems.
540 
541  USE netcdf_nc_interfaces
542 
543  Implicit NONE
544 
545  Character(LEN=*), Intent(IN) :: path
546  Integer, Intent(IN) :: pe
547 
548  Integer :: status
549 
550  Integer(KIND=C_INT) :: cstatus, cpe
551  Character(LEN=(LEN(path)+1)) :: cpath
552  Integer :: ie
553 
554  cpe = pe
555 
556  cpath = addcnullchar(path,ie)
557 
558  cstatus = nc_delete_mp(cpath(1:ie+1), cpe)
559 
560  status = cstatus
561 
562  End Function nf_delete_mp
563 !-------------------------------- nf_set_base_pe ------------------------------
564  Function nf_set_base_pe(ncid, pe) RESULT(status)
565 
566 ! Sets base pe number on shared memory MPP systems
567 
568  Use netcdf_nc_interfaces
569 
570  Implicit NONE
571 
572  Integer, Intent(IN) :: ncid, pe
573 
574  Integer :: status
575 
576  Integer(KIND=C_INT) :: cncid, cpe, cstatus
577 
578  cncid = ncid
579  cpe = pe
580 
581  cstatus = nc_set_base_pe(cncid, cpe)
582 
583  status = cstatus
584 
585  End Function nf_set_base_pe
586 !-------------------------------- nf_inq_base_pe ------------------------------
587  Function nf_inq_base_pe(ncid, pe) RESULT(status)
588 
589 ! Gets previously set base pe number on shared memory MPP systems
590 
591  Use netcdf_nc_interfaces
592 
593  Implicit NONE
594 
595  Integer, Intent(IN) :: ncid
596  Integer, Intent(OUT) :: pe
597 
598  Integer :: status
599 
600  Integer(KIND=C_INT) :: cncid, cpe, cstatus
601 
602  cncid = ncid
603 
604  cstatus = nc_inq_base_pe(cncid, cpe)
605 
606  If (cstatus == nc_noerr) Then
607  pe = cpe
608  EndIf
609  status = cstatus
610 End Function nf_inq_base_pe
module procedure interfaces for utility routines

Return to the Main Unidata NetCDF page.
Generated on Fri Sep 25 2015 01:52:27 for NetCDF-Fortran. NetCDF is a Unidata library.