1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
|
!-- 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
|
