NetCDF-Fortran  4.4.2
nf_genatt.f90
1 !---------- Routines for defining and obtaining info about attributes --------
2 
3 ! Replacement for fort-genatt.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 ! License (and other Lawyer Language)
11 
12 ! This software is released under the Apache 2.0 Open Source License. The
13 ! full text of the License can be viewed at :
14 !
15 ! http:www.apache.org/licenses/LICENSE-2.0.html
16 !
17 ! The author grants to the University Corporation for Atmospheric Research
18 ! (UCAR), Boulder, CO, USA the right to revise and extend the software
19 ! without restriction. However, the author retains all copyrights and
20 ! intellectual property rights explicitly stated in or implied by the
21 ! Apache license
22 
23 ! Version 1.: Sept. 2005 - Initial Cray X1 version
24 ! Version 2.: May 2006 - Updated to support g95
25 ! Version 3.: April 2009 - Updated for netCDF 4.0.1
26 ! Version 4.: April 2010 - Updated for netCDF 4.1.1
27 ! Version 5.: May 2014 - Ensure return error status checked from C API calls
28 
29 !-------------------------------- nf_inq_att ---------------------------------
30  Function nf_inq_att(ncid, varid, name, xtype, nlen) RESULT(status)
31 
32 ! Get attribute data type and length for a given varid and name
33 
34  USE netcdf_nc_interfaces
35 
36  Implicit NONE
37 
38  Integer, Intent(IN) :: ncid, varid
39  Character(LEN=*), Intent(IN) :: name
40  Integer, Intent(OUT) :: nlen, xtype
41 
42  Integer :: status
43 
44  Integer(KIND=C_INT) :: cncid, cstatus, cvarid
45  Integer(KIND=C_SIZE_T) :: cnlen
46  Integer(KIND=C_INT) :: cxtype
47  Character(LEN=(LEN(name)+1)) :: cname
48  Integer :: ie
49 
50  cncid = ncid
51  cvarid = varid - 1 ! Subtract 1 to get C varid
52 
53 ! Check to see if a C null character was added to name in calling program
54 
55  cname = addcnullchar(name, ie)
56 
57  cstatus = nc_inq_att(cncid, cvarid, cname(1:ie+1), cxtype, cnlen)
58 
59  If (cstatus == nc_noerr) Then
60  xtype = cxtype
61  nlen = cnlen
62  EndIf
63  status = cstatus
64 
65  End Function nf_inq_att
66 !-------------------------------- nf_inq_atttype ---------------------------
67  Function nf_inq_atttype(ncid, varid, name, xtype) RESULT(status)
68 
69 ! Get attribute type for a given varid and name
70 
71  USE netcdf_nc_interfaces
72 
73  Implicit NONE
74 
75  Integer, Intent(IN) :: ncid, varid
76  Character(LEN=*), Intent(IN) :: name
77  Integer, Intent(OUT) :: xtype
78 
79  Integer :: status
80 
81  Integer(KIND=C_INT) :: cncid, cstatus, cvarid
82  Integer(KIND=C_INT) :: cxtype
83  Character(LEN=(LEN(name)+1)) :: cname
84  Integer :: ie
85 
86  cncid = ncid
87  cvarid = varid - 1 ! Subtract 1 to get C varid
88 
89 ! Check to see if a C null character was added to name in calling program
90 
91  cname = addcnullchar(name, ie)
92 
93  cstatus = nc_inq_atttype(cncid, cvarid, cname(1:ie+1), cxtype)
94 
95  If (cstatus == nc_noerr) Then
96  xtype = cxtype
97  EndIf
98  status = cstatus
99 
100  End Function nf_inq_atttype
101 !-------------------------------- nf_inq_attlen ----------------------------
102  Function nf_inq_attlen(ncid, varid, name, nlen) RESULT(status)
103 
104 ! Get attribute length for a given varid and name
105 
106  USE netcdf_nc_interfaces
107 
108  Implicit NONE
109 
110  Integer, Intent(IN) :: ncid, varid
111  Character(LEN=*), Intent(IN) :: name
112  Integer, Intent(OUT) :: nlen
113 
114  Integer :: status
115 
116  Integer(KIND=C_INT) :: cncid, cstatus, cvarid
117  Integer(KIND=C_SIZE_T) :: cnlen
118  Character(LEN=(LEN(name)+1)) :: cname
119  Integer :: ie
120 
121  cncid = ncid
122  cvarid = varid - 1 ! Subtract 1 to get C varid
123 
124 ! Check to see if a C null character was added to name in calling program
125 
126  cname = addcnullchar(name, ie)
127 
128  cstatus = nc_inq_attlen(cncid, cvarid, cname(1:ie+1), cnlen)
129 
130  If (cstatus == nc_noerr) Then
131  nlen = cnlen
132  EndIf
133  status = cstatus
134 
135  End Function nf_inq_attlen
136 !-------------------------------- nf_inq_attid -----------------------------
137  Function nf_inq_attid(ncid, varid, name, attnum) RESULT(status)
138 
139 ! Get attribute id for a given varid and name
140 
141  USE netcdf_nc_interfaces
142 
143  Implicit NONE
144 
145  Integer, Intent(IN) :: ncid, varid
146  Character(LEN=*), Intent(IN) :: name
147  Integer, Intent(OUT) :: attnum
148 
149  Integer :: status
150 
151  Integer(KIND=C_INT) :: cncid, cstatus, cattnum, cvarid
152  Character(LEN=(LEN(name)+1)) :: cname
153  Integer :: ie
154 
155  cncid = ncid
156  cvarid = varid - 1 ! Subtract 1 to get C varid
157 
158 ! Check to see if a C null character was added to name in calling program
159 
160  cname = addcnullchar(name, ie)
161 
162  cstatus = nc_inq_attid(cncid, cvarid, cname(1:ie+1), cattnum)
163 
164  If (cstatus == nc_noerr) Then
165  attnum = cattnum + 1 ! add 1 to get FORTRAN att id
166  EndIf
167  status = cstatus
168 
169  End Function nf_inq_attid
170 !-------------------------------- nf_inq_attname ---------------------------
171  Function nf_inq_attname(ncid, varid, attnum, name) RESULT(status)
172 
173 ! Get attribute name for a given varid and attribute number
174 
175  USE netcdf_nc_interfaces
176 
177  Implicit NONE
178 
179  Integer, Intent(IN) :: ncid, varid, attnum
180  Character(LEN=*), Intent(OUT) :: name
181 
182  Integer :: status
183 
184  Integer(KIND=C_INT) :: cncid, cstatus, cattnum, cvarid
185  Character(LEN=(LEN(name)+1)) :: tmpname
186  Integer :: nlen
187 
188  cncid = ncid
189  cvarid = varid - 1 ! Subtract 1 to get C varid and att num
190  cattnum = attnum - 1
191  nlen = len(name)
192  name = repeat(" ",nlen)
193  tmpname = repeat(" ",len(tmpname)) ! init to blanks
194 
195  cstatus = nc_inq_attname(cncid, cvarid, cattnum, tmpname)
196 
197  If (cstatus == nc_noerr) Then
198  ! Strip of any C null characters and load only the part
199  ! of tmpname that will fit in name
200 
201  name = stripcnullchar(tmpname, nlen)
202  EndIf
203  status = cstatus
204 
205  End Function nf_inq_attname
206 !-------------------------------- nf_copy_att ------------------------------
207  Function nf_copy_att(ncid_in, varid_in, name, ncid_out, varid_out) &
208  result(status)
209 
210 ! Copy attribute name with varid_in from one netcdf file to another
211 ! with new varid_out
212 
213  USE netcdf_nc_interfaces
214 
215  Implicit NONE
216 
217  Integer, Intent(IN) :: ncid_in, varid_in, ncid_out, varid_out
218  Character(LEN=*), Intent(IN) :: name
219 
220  Integer :: status
221 
222  Integer(KIND=C_INT) :: cncidin, cncidout,cvaridin, cvaridout, cstatus
223  Character(LEN=(LEN(name)+1)) :: cname
224  Integer :: ie
225 
226  cncidin = ncid_in
227  cvaridin = varid_in - 1
228  cncidout = ncid_out
229  cvaridout = varid_out - 1
230 
231 ! Check to see if a C null character was added to name in calling program
232 
233  cname = addcnullchar(name, ie)
234 
235  cstatus = nc_copy_att(cncidin, cvaridin, cname(1:ie+1), &
236  cncidout, cvaridout)
237 
238  status = cstatus
239 
240  End Function nf_copy_att
241 !-------------------------------- nf_rename_att ----------------------------
242  Function nf_rename_att(ncid, varid, name, newname) RESULT(status)
243 
244 ! Rename an attribute to newname givin varid
245 
246  USE netcdf_nc_interfaces
247 
248  Implicit NONE
249 
250  Integer, Intent(IN) :: ncid, varid
251  Character(LEN=*), Intent(IN) :: name, newname
252 
253  Integer :: status
254 
255  Integer(KIND=C_INT) :: cncid, cvarid, cstatus
256  Character(LEN=(LEN(name)+1)) :: cname
257  Character(LEN=(LEN(newname)+1)) :: cnewname
258  Integer :: ie1, ie2, inull
259 
260  cncid = ncid
261  cvarid = varid - 1 ! Subtract 1 to get C varid
262 
263 ! Check to see if a C null character was added to name and newname
264 ! in calling program
265 
266  cname = addcnullchar(name, ie1)
267 
268  cnewname = addcnullchar(newname, ie2)
269 
270  cstatus = nc_rename_att(cncid, cvarid, cname(1:ie1+1), cnewname(1:ie2+1))
271 
272  status = cstatus
273 
274  End Function nf_rename_att
275 !-------------------------------- nf_del_att -------------------------------
276  Function nf_del_att(ncid, varid, name) RESULT(status)
277 
278 ! Delete an attribute givne varid and name
279 
280  USE netcdf_nc_interfaces
281 
282  Implicit NONE
283 
284  Integer, Intent(IN) :: ncid, varid
285  Character(LEN=*), Intent(IN) :: name
286 
287  Integer :: status
288 
289  Integer(KIND=C_INT) :: cncid, cvarid, cstatus
290  Character(LEN=(LEN(name)+1)) :: cname
291  Integer :: ie
292 
293  cncid = ncid
294  cvarid = varid - 1 ! Subtract 1 to get C varid
295 
296 ! Check to see if a C null character was added to name in calling program
297 
298  cname = addcnullchar(name, ie)
299 
300  cstatus = nc_del_att(cncid, cvarid, cname(1:ie+1))
301 
302  status = cstatus
303 
304  End Function nf_del_att
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.