!-- Routines for processing error messages, obtaining version numbers, etc. --

! Replacement for fort-misc.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.: Jan   2016 - General code cleanup

!-------------------------------- nf_inq_libvers ---------------------------
Function nf_inq_libvers() RESULT(vermsg)

  ! Return string with current version of NetCDF library

  USE netcdf_nc_interfaces

  Implicit NONE

  Character(LEN=80) :: vermsg

  Character(LEN=81), Pointer :: fstrptr
  TYPE(C_PTR)                :: cstrptr
  Integer                    :: inull, ilen

  vermsg = REPEAT(" ", LEN(vermsg)) !initialize vermsg to blanks

  ! Get C character pointer returned by nc_inq_vers and associate it
  ! Fortran character pointer (fstrptr). Have to do this when the C
  ! routine allocates space for the pointer and/or knows where it lives
  ! not Fortran. This is also how you can pass character data back to
  ! FORTRAN from C using a C function that returns a character pointer
  ! instead using a void jacket function and passing the string as a hidden
  ! argument. At least this is how cfortran.h appears to do it.


  NULLIFY(fstrptr) ! Nullify fstrptr

  cstrptr = nc_inq_libvers()         ! Get C pointer to version string and

  Call C_F_POINTER(cstrptr, fstrptr) ! associate it with FORTRAN pointer

  ! Locate first C null character and then set it and remaining characters
  ! in string to blanks

  ilen  = LEN_TRIM(fstrptr)
  inull = SCAN(fstrptr,C_NULL_CHAR)
  If (inull /= 0) ilen = inull-1
  ilen = MAX(1, MIN(ilen,80)) ! Limit ilen to >=1 and <=80

  ! Load return value with trimmed fstrptr string

  vermsg(1:ilen) = fstrptr(1:ilen)

End Function nf_inq_libvers
!-------------------------------- nf_stderror ------------------------------
Function nf_strerror(ncerr) RESULT(errmsg)

  ! Returns an error message string given static error code ncerr

  USE netcdf_nc_interfaces

  Implicit NONE

  Integer(KIND=C_INT), Intent(IN) :: ncerr

  Character(LEN=80)               :: errmsg

  Character(LEN=81), Pointer :: fstrptr
  TYPE(C_PTR)                :: cstrptr
  Integer                    :: inull, ilen
  Integer(KIND=C_INT)        :: cncerr

  errmsg = REPEAT(" ", LEN(errmsg)) !initialize errmsg to blanks

  ! Get C character pointer returned by nc_stderror and associate it
  ! Fortran character pointer (fstrptr). Have to do this when the C
  ! routine allocates space for the pointer and/or knows where it lives
  ! not Fortran. This is also how you can pass character data back to
  ! FORTRAN from C using a C function that returns a character pointer
  ! instead using a void jacket function and passing the string as a hidden
  ! argument. At least this is how cfortran.h appears to do it.

  NULLIFY(fstrptr) ! Nullify fstrptr

  cncerr  = ncerr

  cstrptr = nc_strerror(cncerr)      ! Return C character pointer and
  Call C_F_POINTER(cstrptr, fstrptr) ! associate C ptr with FORTRAN pointer

  ! Locate first C null character and then set it and remaining characters
  ! in string to blanks

  ilen  = LEN_TRIM(fstrptr)
  inull = SCAN(fstrptr,C_NULL_CHAR)
  If (inull /= 0) ilen = inull-1
  ilen  = MAX(1, MIN(ilen,80)) ! Limit ilen to >=1 and <=80

  ! Load return value with trimmed fstrptr string

  errmsg(1:ilen) = fstrptr(1:ilen)

End Function nf_strerror
!-------------------------------- nf_issyserr ------------------------------
Function nf_issyserr(nerr) RESULT(status)

  ! Check to see if nerr is > 0

  Integer, Intent(IN) :: nerr

  Logical             :: status

  status = (nerr > 0)

End Function nf_issyserr
