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
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
|
!---------- Routines for defining and obtaining info about attributes --------
! Replacement for fort-genatt.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.: May 2014 - Ensure return error status checked from C API calls
! Version 6.: Jan. 2016 - General code cleanup. Changed name processing to
! reflect change in addCNullChar
!-------------------------------- nf_inq_att ---------------------------------
Function nf_inq_att(ncid, varid, name, xtype, nlen) RESULT(status)
! Get attribute data type and length for a given varid and name
USE netcdf_nc_interfaces
Implicit NONE
Integer, Intent(IN) :: ncid, varid
Character(LEN=*), Intent(IN) :: name
Integer, Intent(OUT) :: nlen, xtype
Integer :: status
Integer(C_INT) :: cncid, cstatus, cvarid
Integer(C_SIZE_T) :: cnlen
Integer(C_INT) :: cxtype
Character(LEN=(LEN(name)+1)) :: cname
Integer :: ie
cncid = ncid
cvarid = varid - 1 ! Subtract 1 to get C varid
! Check to see if a C null character was added to name in calling program
cname = addCNullChar(name, ie)
cstatus = nc_inq_att(cncid, cvarid, cname(1:ie), cxtype, cnlen)
If (cstatus == NC_NOERR) Then
xtype = cxtype
nlen = cnlen
EndIf
status = cstatus
End Function nf_inq_att
!-------------------------------- nf_inq_atttype ---------------------------
Function nf_inq_atttype(ncid, varid, name, xtype) RESULT(status)
! Get attribute type for a given varid and name
USE netcdf_nc_interfaces
Implicit NONE
Integer, Intent(IN) :: ncid, varid
Character(LEN=*), Intent(IN) :: name
Integer, Intent(OUT) :: xtype
Integer :: status
Integer(C_INT) :: cncid, cstatus, cvarid
Integer(C_INT) :: cxtype
Character(LEN=(LEN(name)+1)) :: cname
Integer :: ie
cncid = ncid
cvarid = varid - 1 ! Subtract 1 to get C varid
! Check to see if a C null character was added to name in calling program
cname = addCNullChar(name, ie)
cstatus = nc_inq_atttype(cncid, cvarid, cname(1:ie), cxtype)
If (cstatus == NC_NOERR) Then
xtype = cxtype
EndIf
status = cstatus
End Function nf_inq_atttype
!-------------------------------- nf_inq_attlen ----------------------------
Function nf_inq_attlen(ncid, varid, name, nlen) RESULT(status)
! Get attribute length for a given varid and name
USE netcdf_nc_interfaces
Implicit NONE
Integer, Intent(IN) :: ncid, varid
Character(LEN=*), Intent(IN) :: name
Integer, Intent(OUT) :: nlen
Integer :: status
Integer(C_INT) :: cncid, cstatus, cvarid
Integer(C_SIZE_T) :: cnlen
Character(LEN=(LEN(name)+1)) :: cname
Integer :: ie
cncid = ncid
cvarid = varid - 1 ! Subtract 1 to get C varid
! Check to see if a C null character was added to name in calling program
cname = addCNullChar(name, ie)
cstatus = nc_inq_attlen(cncid, cvarid, cname(1:ie), cnlen)
If (cstatus == NC_NOERR) Then
nlen = cnlen
EndIf
status = cstatus
End Function nf_inq_attlen
!-------------------------------- nf_inq_attid -----------------------------
Function nf_inq_attid(ncid, varid, name, attnum) RESULT(status)
! Get attribute id for a given varid and name
USE netcdf_nc_interfaces
Implicit NONE
Integer, Intent(IN) :: ncid, varid
Character(LEN=*), Intent(IN) :: name
Integer, Intent(OUT) :: attnum
Integer :: status
Integer(C_INT) :: cncid, cstatus, cattnum, cvarid
Character(LEN=(LEN(name)+1)) :: cname
Integer :: ie
cncid = ncid
cvarid = varid - 1 ! Subtract 1 to get C varid
! Check to see if a C null character was added to name in calling program
cname = addCNullChar(name, ie)
cstatus = nc_inq_attid(cncid, cvarid, cname(1:ie), cattnum)
If (cstatus == NC_NOERR) Then
attnum = cattnum + 1 ! add 1 to get FORTRAN att id
EndIf
status = cstatus
End Function nf_inq_attid
!-------------------------------- nf_inq_attname ---------------------------
Function nf_inq_attname(ncid, varid, attnum, name) RESULT(status)
! Get attribute name for a given varid and attribute number
USE netcdf_nc_interfaces
Implicit NONE
Integer, Intent(IN) :: ncid, varid, attnum
Character(LEN=*), Intent(OUT) :: name
Integer :: status
Integer(C_INT) :: cncid, cstatus, cattnum, cvarid
Character(LEN=(LEN(name)+1)) :: tmpname
Integer :: nlen
cncid = ncid
cvarid = varid - 1 ! Subtract 1 to get C varid and att num
cattnum = attnum - 1
nlen = LEN(name)
name = REPEAT(" ",nlen)
tmpname = REPEAT(" ",LEN(tmpname)) ! init to blanks
cstatus = nc_inq_attname(cncid, cvarid, cattnum, tmpname)
If (cstatus == NC_NOERR) Then
! Strip of any C null characters and load only the part
! of tmpname that will fit in name
name = stripCNullChar(tmpname, nlen)
EndIf
status = cstatus
End Function nf_inq_attname
!-------------------------------- nf_copy_att ------------------------------
Function nf_copy_att(ncid_in, varid_in, name, ncid_out, varid_out) &
RESULT(status)
! Copy attribute name with varid_in from one netcdf file to another
! with new varid_out
USE netcdf_nc_interfaces
Implicit NONE
Integer, Intent(IN) :: ncid_in, varid_in, ncid_out, varid_out
Character(LEN=*), Intent(IN) :: name
Integer :: status
Integer(C_INT) :: cncidin, cncidout,cvaridin, cvaridout, cstatus
Character(LEN=(LEN(name)+1)) :: cname
Integer :: ie
cncidin = ncid_in
cvaridin = varid_in - 1
cncidout = ncid_out
cvaridout = varid_out - 1
! Check to see if a C null character was added to name in calling program
cname = addCNullChar(name, ie)
cstatus = nc_copy_att(cncidin, cvaridin, cname(1:ie), &
cncidout, cvaridout)
status = cstatus
End Function nf_copy_att
!-------------------------------- nf_rename_att ----------------------------
Function nf_rename_att(ncid, varid, name, newname) RESULT(status)
! Rename an attribute to newname givin varid
USE netcdf_nc_interfaces
Implicit NONE
Integer, Intent(IN) :: ncid, varid
Character(LEN=*), Intent(IN) :: name, newname
Integer :: status
Integer(C_INT) :: cncid, cvarid, cstatus
Character(LEN=(LEN(name)+1)) :: cname
Character(LEN=(LEN(newname)+1)) :: cnewname
Integer :: ie1, ie2, inull
cncid = ncid
cvarid = varid - 1 ! Subtract 1 to get C varid
! Check to see if a C null character was added to name and newname
! in calling program
cname = addCNullChar(name, ie1)
cnewname = addCNullChar(newname, ie2)
cstatus = nc_rename_att(cncid, cvarid, cname(1:ie1), cnewname(1:ie2))
status = cstatus
End Function nf_rename_att
!-------------------------------- nf_del_att -------------------------------
Function nf_del_att(ncid, varid, name) RESULT(status)
! Delete an attribute givne varid and name
USE netcdf_nc_interfaces
Implicit NONE
Integer, Intent(IN) :: ncid, varid
Character(LEN=*), Intent(IN) :: name
Integer :: status
Integer(C_INT) :: cncid, cvarid, cstatus
Character(LEN=(LEN(name)+1)) :: cname
Integer :: ie
cncid = ncid
cvarid = varid - 1 ! Subtract 1 to get C varid
! Check to see if a C null character was added to name in calling program
cname = addCNullChar(name, ie)
cstatus = nc_del_att(cncid, cvarid, cname(1:ie))
status = cstatus
End Function nf_del_att
|
