! ------------ Routines to create/open/close/redefine netcdf files ------------ ! Replacement for fort-control.c ! Written by: Richard Weed, Ph.D. ! Center for Advanced Vehicular Systems ! Mississippi State University ! rweed@cavs.msstate.edu ! License (and other Lawyer Language) ! This software is released under the Apache 2.0 Open Source License. The ! full text of the License can be viewed at : ! ! http:www.apache.org/licenses/LICENSE-2.0.html ! ! The author grants to the University Corporation for Atmospheric Research ! (UCAR), Boulder, CO, USA the right to revise and extend the software ! without restriction. However, the author retains all copyrights and ! intellectual property rights explicitly stated in or implied by the ! Apache license ! Version 1.: Sept. 2005 - Initial Cray X1 version ! Version 2.: May, 2006 - Updated to support g95 ! Version 3.: April, 2009 - Updated for netcdf 4.0.1 ! Version 4.: April, 2010 - Updated for netcdf 4.1.1 ! Version 5.: Feb. 2013 - Added nf_inq_path support for fortran 4.4 ! Vertion 6.: Nov. 2013 - Added nf_set_log_level support ! Version 7.: May, 2014 - Ensure return error status checked from C API calls ! Version 8.: Jan., 2016 - General code cleanup. Changed name processing to ! reflect change in addCNullChar function. Added ! support for nc_open_mem !-------------------------------- nf_create -------------------------------- Function nf_create(path, cmode, ncid) RESULT (status) ! Creates a new NetCDF file given a file name and a creation mode and returns ! the file id and a status flag USE netcdf_nc_interfaces Implicit NONE Character(LEN=*), Intent(IN) :: path Integer, Intent(IN) :: cmode Integer, Intent(OUT) :: ncid Integer :: status Integer(C_INT) :: ccmode, cncid, cstatus Character(LEN=(LEN(path)+1)) :: cpath Integer :: ie ccmode = cmode cncid = 0 ! Check for C null character on path and add one if not present. cpath = addCNullChar(path, ie) ! Call nc_create to create file cstatus = nc_create(cpath(1:ie), ccmode, cncid) If (cstatus == NC_NOERR) Then ncid = cncid EndIf status = cstatus End Function nf_create !-------------------------------- nf__create ------------------------------- Function nf__create(path, cmode, initialsz, chunksizehintp, ncid) & RESULT(status) ! Creates a new NetCDF file and returns the file id and a status flag ! This is an alternate form of nf_create that allows user to input ! two additional tuning parameters USE netcdf_nc_interfaces Implicit NONE Character(LEN=*), Intent(IN) :: path Integer, Intent(IN) :: cmode, initialsz, chunksizehintp Integer, Intent(OUT) :: ncid Integer :: status Integer(C_INT) :: ccmode, cncid, cstatus Integer(C_SIZE_T) :: cinit, cchunk Character(LEN=(LEN(path)+1)) :: cpath Integer :: ie ccmode = cmode cchunk = chunksizehintp cinit = initialsz cncid = 0 ! Check for C null character on path and add one if not present. cpath = addCNullChar(path, ie) ! Call nc_create to create file cstatus = nc__create(cpath(1:ie), ccmode, cinit, cchunk, cncid) If (cstatus == NC_NOERR) Then ncid = cncid EndIf status = cstatus End Function nf__create !-------------------------------- nf__create_mp ------------------------------ Function nf__create_mp(path, cmode, initialsz, basepe, chunksizehintp, ncid) & RESULT(status) ! Creates a new NetCDF file and returns the file id and a status flag ! This is an alternate form of nf__create for shared memory MPP systems ! plus two additional tuning parameters USE netcdf_nc_interfaces Implicit NONE Character(LEN=*), Intent(IN) :: path Integer, Intent(IN) :: cmode, initialsz, chunksizehintp, basepe Integer, Intent(OUT) :: ncid Integer :: status Integer(C_INT) :: ccmode, cncid, cstatus Integer(C_INT), TARGET :: cbasepe Integer(C_SIZE_T) :: cinit, cchunk Type(C_PTR) :: cbasepeptr Character(LEN=(LEN(path)+1)) :: cpath Integer :: ie ccmode = cmode cchunk = chunksizehintp cinit = initialsz cncid = 0 cbasepe = basepe cbasepeptr = C_LOC(cbasepe) ! Check for C null character on path and add one if not present. cpath = addCNullChar(path, ie) ! Call nc_create_mp to create file for base pe cstatus = nc__create_mp(cpath(1:ie), ccmode, cinit, cbasepeptr, & cchunk, cncid) If (cstatus == NC_NOERR) Then ncid = cncid EndIf status = cstatus End Function nf__create_mp !-------------------------------- nf_open ---------------------------------- Function nf_open(path, mode, ncid) RESULT (status) ! Open an existing NetCDF file and return file id and a status flag USE netcdf_nc_interfaces Implicit NONE Character(LEN=*), Intent(IN) :: path Integer, Intent(IN) :: mode Integer, Intent(INOUT) :: ncid Integer :: status Integer(C_INT) :: cmode, cncid, cstatus Character(LEN=(LEN(path)+1)) :: cpath Integer :: ie cmode = mode cncid = 0 ! Check for C null character on path and add one if not present. cpath = addCNullChar(path, ie) ! Call nc_create to create file cstatus = nc_open(cpath(1:ie), cmode, cncid) If (cstatus == NC_NOERR) Then ncid = cncid EndIf status = cstatus End Function nf_open !-------------------------------- nf__open --------------------------------- Function nf__open(path, mode, chunksizehintp, ncid) RESULT (status) ! Open an existing NetCDF file and return file id and a status flag ! Alternate form of nf_open with extra tuning parameter USE netcdf_nc_interfaces Implicit NONE Character(LEN=*), Intent(IN) :: path Integer, Intent(IN) :: mode, chunksizehintp Integer, Intent(INOUT) :: ncid Integer :: status Integer(C_INT) :: cmode, cncid, cstatus Integer(C_SIZE_T) :: cchunk Character(LEN=(LEN(path)+1)) :: cpath Integer :: inull, ie cmode = mode cchunk = chunksizehintp cncid = 0 ! Check for C null character on path and add one if not present. cpath = addCNullChar(path,ie) ! Call nc_create to create file cstatus = nc__open(cpath(1:ie), cmode, cchunk, cncid) If (cstatus == NC_NOERR) Then ncid = cncid EndIf status = cstatus End Function nf__open !-------------------------------- nf__open_mp -------------------------------- Function nf__open_mp(path, mode, basepe, chunksizehintp, ncid) RESULT (status) ! Open an existing NetCDF file and return file id and a status flag ! Alternate form of nf__open with parameter to designate basepe on ! shared memory MPP systems. USE netcdf_nc_interfaces Implicit NONE Character(LEN=*), Intent(IN) :: path Integer, Intent(IN) :: mode, chunksizehintp, basepe Integer, Intent(INOUT) :: ncid Integer :: status Integer(C_INT) :: cmode, cncid, cstatus Integer(C_INT), TARGET :: cbasepe Integer(C_SIZE_T) :: cchunk Type(C_PTR) :: cbasepeptr Character(LEN=(LEN(path)+1)) :: cpath Integer :: ie cmode = mode cchunk = chunksizehintp cncid = 0 cbasepe = basepe cbasepeptr = C_LOC(cbasepe) ! Check for C null character on path and add one if not present. cpath = addCNullChar(path, ie) ! Call nc_create to create file cstatus = nc__open_mp(cpath(1:ie), cmode, cbasepeptr, cchunk, & cncid) If (cstatus == NC_NOERR) Then ncid = cncid EndIf status = cstatus End Function nf__open_mp !-------------------------------- nf_open_mem -------------------------------- ! Function nf_open_mem(path, mode, size, memory, ncid) RESULT(status) ! !! Open a block of memory passed as an array of C_CHAR bytes as a !! netcdf file. Note the file can only be opened as read-only ! ! USE netcdf_nc_interfaces ! ! Implicit NONE ! ! Character(LEN=*), Intent(IN) :: path ! Integer, Intent(IN) :: mode ! Integer, Intent(IN) :: size ! Character(KIND=C_CHAR), Intent(IN), TARGET :: memory(*) ! Integer, Intent(INOUT) :: ncid ! ! Integer :: status ! ! Integer(C_INT) :: cstatus, cmode, cncid ! Character(LEN=LEN(path)+1) :: cpath ! Integer(C_SIZE_T) :: csize ! Type(C_PTR) :: cmemoryptr ! ! Integer :: ie ! ! cpath = addCNullChar(path, ie) ! cmode = mode ! csize = size ! ! cmemoryptr = C_LOC(memory) ! ! cstatus = nc_open_mem(cpath(1:ie), cmode, csize, cmemoryptr, cncid) ! ! ncid = cncid ! ! status = cstatus ! ! End Function nf_open_mem !-------------------------------- nf_inq_path ------------------------------ Function nf_inq_path(ncid, pathlen, path) RESULT(status) ! Inquire about file pathname and name length USE netcdf_nc_interfaces Implicit NONE Integer, Intent(IN) :: ncid Integer, Intent(INOUT) :: pathlen Character(LEN=*), Intent(INOUT) :: path Integer :: status Integer(C_INT) :: cncid, cstatus Integer(C_SIZE_T) :: cpathlen Character(LEN=LEN(path)+1) :: tmppath cncid = ncid path = REPEAT(" ", LEN(path)) tmppath = REPEAT(" ", LEN(tmppath)) cstatus = nc_inq_path(cncid, cpathlen, tmppath) If (cstatus == NC_NOERR) Then pathlen = cpathlen If (pathlen > LEN(path)) pathlen = LEN(path) path = stripCNullchar(tmppath, pathlen) EndIf status = cstatus End Function nf_inq_path !-------------------------------- nf_set_fill ------------------------------ Function nf_set_fill(ncid, fillmode, old_mode) RESULT(status) ! Sets fill mode for given netcdf file returns old mode if present USE netcdf_nc_interfaces Implicit NONE Integer, Intent(IN) :: ncid, fillmode Integer, Intent(OUT) :: old_mode Integer :: status Integer(C_INT) :: cncid, cfill, coldmode, cstatus cncid = ncid cfill = fillmode coldmode = 0 cstatus = nc_set_fill(cncid, cfill, coldmode) If (cstatus == NC_NOERR) Then old_mode = coldmode EndIf status = cstatus End Function nf_set_fill !-------------------------------- nf_set_default_format -------------------- Function nf_set_default_format(newform, old_format) RESULT(status) ! Sets new default data format. Used to toggle between 64 bit offset and ! classic mode USE netcdf_nc_interfaces Implicit NONE Integer, Intent(IN) :: newform Integer, Intent(OUT) :: old_format Integer :: status Integer(C_INT) :: cnew, cold, cstatus cnew = newform cstatus = nc_set_default_format(cnew,cold) If (cstatus == NC_NOERR) Then old_format = cold EndIf status = cstatus End Function nf_set_default_format !-------------------------------- nf_redef --------------------------------- Function nf_redef(ncid) RESULT(status) ! Reenter definition mode for NetCDF file id ncid USE netcdf_nc_interfaces Implicit NONE Integer, Intent(IN) :: ncid Integer :: status Integer(C_INT) :: cncid, cstatus cncid = ncid cstatus = nc_redef(cncid) status = cstatus End Function nf_redef !-------------------------------- nf_enddef -------------------------------- Function nf_enddef(ncid) RESULT(status) ! Exit definition mode for NetCDF file id ncid USE netcdf_nc_interfaces Implicit NONE Integer, Intent(IN) :: ncid Integer :: status Integer(C_INT) :: cncid, cstatus cncid = ncid cstatus = nc_enddef(cncid) status = cstatus End Function nf_enddef !-------------------------------- nf__enddef ------------------------------- Function nf__enddef(ncid, h_minfree, v_align, v_minfree, r_align) & RESULT(status) ! Exit definition mode for NetCDF file id ncid. Alternate version ! with additional tuning parameters USE netcdf_nc_interfaces Implicit NONE Integer, Intent(IN) :: ncid, h_minfree, v_align, v_minfree, r_align Integer :: status Integer(C_INT) :: cncid, cstatus Integer(C_SIZE_T) :: chminfree, cvalign, cvminfree, cralign cncid = ncid chminfree = h_minfree cvalign = v_align cvminfree = v_minfree cralign = r_align cstatus = nc__enddef(cncid, chminfree, cvalign, cvminfree, cralign) status = cstatus End Function nf__enddef !-------------------------------- nf_sync ---------------------------------- Function nf_sync(ncid) RESULT(status) ! synch up all open NetCDF files USE netcdf_nc_interfaces Implicit NONE Integer, Intent(IN) :: ncid Integer :: status Integer(C_INT) :: cncid, cstatus cncid = ncid cstatus = nc_sync(cncid) status = cstatus End Function nf_sync !-------------------------------- nf_abort --------------------------------- Function nf_abort(ncid) RESULT(status) ! Abort netCDF file creation and exit USE netcdf_nc_interfaces Implicit NONE Integer, Intent(IN) :: ncid Integer :: status Integer(C_INT) :: cncid, cstatus cncid = ncid cstatus = nc_abort(cncid) status = cstatus End Function nf_abort !-------------------------------- nf_close --------------------------------- Function nf_close(ncid) RESULT(status) ! Close netCDF file id ncid USE netcdf_nc_interfaces Implicit NONE Integer, Intent(IN) :: ncid Integer :: status Integer(C_INT) :: cncid, cstatus cncid = ncid cstatus = nc_close(cncid) status = cstatus End Function nf_close !-------------------------------- nf_delete -------------------------------- Function nf_delete(path) RESULT(status) ! Delete netCDF file id ncid USE netcdf_nc_interfaces Implicit NONE Character(LEN=*), Intent(IN) :: path Integer :: status Integer(C_INT) :: cstatus Character(LEN=(LEN(path)+1)) :: cpath Integer :: ie ! Check for C null character on path and add one if not present. cpath = addCNullChar(path,ie) cstatus = nc_delete(cpath(1:ie)) status = cstatus End Function nf_delete !-------------------------------- nf_delete_mp ------------------------------- Function nf_delete_mp(path, pe) RESULT(status) ! Delete netCDF file id ncid. Alternate form of nf_delete for shared memory ! MPP systems. USE netcdf_nc_interfaces Implicit NONE Character(LEN=*), Intent(IN) :: path Integer, Intent(IN) :: pe Integer :: status Integer(C_INT) :: cstatus, cpe Character(LEN=(LEN(path)+1)) :: cpath Integer :: ie cpe = pe ! Check for C null character on path and add one if not present. cpath = addCNullChar(path,ie) cstatus = nc_delete_mp(cpath(1:ie), cpe) status = cstatus End Function nf_delete_mp !-------------------------------- nf_set_base_pe ------------------------------ Function nf_set_base_pe(ncid, pe) RESULT(status) ! Sets base pe number on shared memory MPP systems Use netcdf_nc_interfaces Implicit NONE Integer, Intent(IN) :: ncid, pe Integer :: status Integer(C_INT) :: cncid, cpe, cstatus cncid = ncid cpe = pe cstatus = nc_set_base_pe(cncid, cpe) status = cstatus End Function nf_set_base_pe !-------------------------------- nf_inq_base_pe ------------------------------ Function nf_inq_base_pe(ncid, pe) RESULT(status) ! Gets previously set base pe number on shared memory MPP systems Use netcdf_nc_interfaces Implicit NONE Integer, Intent(IN) :: ncid Integer, Intent(OUT) :: pe Integer :: status Integer(C_INT) :: cncid, cpe, cstatus cncid = ncid cstatus = nc_inq_base_pe(cncid, cpe) If (cstatus == NC_NOERR) Then pe = cpe EndIf status = cstatus End Function nf_inq_base_pe