NetCDF-Fortran  4.4.3
nf_genvar.f90
1 !------ Routines for defining and obtaining info about dataset variables ------
2 
3 ! Replacement for fort-genvar.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 
11 ! License (and other Lawyer Language)
12 
13 ! This software is released under the Apache 2.0 Open Source License. The
14 ! full text of the License can be viewed at :
15 !
16 ! http:www.apache.org/licenses/LICENSE-2.0.html
17 !
18 ! The author grants to the University Corporation for Atmospheric Research
19 ! (UCAR), Boulder, CO, USA the right to revise and extend the software
20 ! without restriction. However, the author retains all copyrights and
21 ! intellectual property rights explicitly stated in or implied by the
22 ! Apache license
23 
24 ! Version 1.: Sept. 2005 - Initial Cray X1 version
25 ! Version 2.: May 2006 - Updated to support g95
26 ! Version 3.: April 2009 - Updated for netCDF 4.0.1
27 ! Version 4.: April 2010 - Updated for netCDF 4.1.1
28 ! Version 5.: May 2014 - Ensure return error status checked from C API calls
29 
30 !-------------------------------- nf_def_var -------------------------------
31  Function nf_def_var(ncid, name, xtype, nvdims, vdims, varid) RESULT (status)
32 
33 ! Define name, datatype, number of dimensions, and dimension ids for a
34 ! dataset variable. Returns variable id
35 
36  USE netcdf_nc_interfaces
37 
38  Implicit NONE
39 
40  Integer, Intent(IN) :: ncid, xtype, nvdims
41  Integer, Intent(IN) :: vdims(*)
42  Integer, Intent(OUT) :: varid
43  Character(LEN=*), Intent(IN) :: name
44 
45  Integer :: status
46 
47  Integer(KIND=C_INT) :: cncid, cnvdims, cvarid, cstatus, cxtype
48  Integer(KIND=C_INT) :: cvdims(nc_max_dims)
49  Character(LEN=(LEN(name)+1)) :: cname
50  Integer :: ie
51 
52  cncid = ncid
53  cnvdims = nvdims
54  cxtype = xtype
55 
56 ! Check if a C NULL character was appended to name in calling routine
57 
58  cname = addcnullchar(name, ie)
59 
60 ! Flip dimids to C order and subtract -1 to yield C ids prior
61 ! to calling nc_def_var. Replaces C utility f2c_dimids
62 
63  cvdims = 0
64  If (nvdims /= 0) Then
65  cvdims(1:nvdims) = vdims(nvdims:1:-1)-1
66  EndIf
67 
68  cstatus = nc_def_var(cncid, cname(1:ie+1), cxtype, &
69  cnvdims, cvdims, cvarid)
70 
71  If (cstatus == nc_noerr) Then
72  ! Add one to returned C varid to yield FORTRAN id
73  varid = cvarid + 1
74  EndIf
75  status = cstatus
76 
77  End Function nf_def_var
78 !-------------------------------- nf_inq_varndims --------------------------
79  Function nf_inq_varndims(ncid, varid, vndims) RESULT (status)
80 
81 ! Get variable dimension for a given varid from NetCDF dataset ncid
82 
83  USE netcdf_nc_interfaces
84 
85  Implicit NONE
86 
87  Integer, Intent(IN) :: ncid, varid
88  Integer, Intent(OUT) :: vndims
89 
90  Integer :: status
91 
92  Integer(KIND=C_INT) :: cncid, cvarid, cvndims, cstatus
93 
94  cncid = ncid
95  cvarid = varid - 1
96 
97  cstatus = nc_inq_varndims(cncid, cvarid, cvndims)
98 
99  If (cstatus == nc_noerr) Then
100  vndims = cvndims
101  EndIf
102  status = cstatus
103 
104  End Function nf_inq_varndims
105 !-------------------------------- nf_inq_var ----------------------------
106  Function nf_inq_var(ncid, varid, name, xtype, ndims, dimids, natts) &
107  result(status)
108 
109 ! Get variable name, data type, dimension length, dimension ids, and
110 ! number of attributes for a given varid
111 
112  USE netcdf_nc_interfaces
113 
114  Implicit NONE
115 
116  Integer, Intent(IN) :: ncid, varid
117  Character(LEN=*), Intent(OUT) :: name
118  Integer, Intent(OUT) :: dimids(*)
119  Integer, Intent(OUT) :: ndims, xtype, natts
120 
121  Integer :: status
122 
123  Integer(KIND=C_INT) :: cncid, cstatus, cndims, cvarid, cnatts
124  Integer(KIND=C_INT) :: cdimids(nc_max_dims)
125  Integer(KIND=C_INT) :: cxtype
126  Character(LEN=NC_MAX_NAME+1) :: tmpname
127  Integer :: nlen
128 
129  cncid = ncid
130  cvarid = varid - 1 ! subtract -1 to yield cvarid
131 
132  nlen = len(name)
133  tmpname = repeat(" ", len(tmpname))
134  name = repeat(" ", nlen)
135 
136  cndims = 0
137  dimids(1) = 0
138  xtype = 0
139  natts = 0
140  ndims = 0
141 
142  cstatus = nc_inq_var(cncid, cvarid, tmpname, cxtype, cndims, cdimids, cnatts)
143 
144  If (cstatus == nc_noerr) Then
145  xtype = cxtype
146  natts = cnatts
147  ndims = cndims
148 
149  ! Check tmpname for a C null character and strip it and trailing blanks
150 
151  name = stripcnullchar(tmpname, nlen)
152 
153  ! Reverse order of cdimids and add one to yield FORTRAN id numbers
154  ! Replaces c2f_dimids C utility
155 
156  If (ndims > 0) Then
157  dimids(1:ndims) = cdimids(ndims:1:-1)+1
158  EndIf
159  EndIf
160 
161  status = cstatus
162 
163  End Function nf_inq_var
164 !-------------------------------- nf_inq_vardimid -----------------------
165  Function nf_inq_vardimid(ncid, varid, dimids) RESULT (status)
166 
167 ! Get variable dimension id for a dimension name
168 
169  USE netcdf_nc_interfaces
170 
171  Implicit NONE
172 
173  Integer, Intent(IN) :: ncid, varid
174  Integer, Intent(OUT) :: dimids(*)
175 
176  Integer :: status
177 
178  Integer(KIND=C_INT) :: cncid, cstatus, cstat2, cndims, cvarid
179  Integer(KIND=C_INT) :: cvdimids(nc_max_dims)
180  Integer :: ndims
181 
182  cncid = ncid
183  cvarid = varid - 1 ! subtract -1 to get C id number
184  dimids(1) = 0
185  cvdimids = 0
186  cndims = 0
187  ndims = 0
188 
189  cstat2 = nc_inq_varndims(cncid, cvarid, cndims)
190  cstatus = nc_inq_vardimid(cncid, cvarid, cvdimids)
191 
192 ! Reverse order of cdimids and add 1 to yield FORTRAN id numbers
193 ! Replaces c2f_dimids C utility
194 
195  If (cstat2 == nc_noerr .AND. cstatus == nc_noerr) Then
196  ndims = cndims
197  If (ndims > 0) Then
198  dimids(1:ndims) = cvdimids(ndims:1:-1)+1
199  EndIf
200  Else
201  ndims = 0
202  EndIf
203 
204  status = cstatus
205 
206  End Function nf_inq_vardimid
207 !-------------------------------- nf_inq_varid --------------------------
208  Function nf_inq_varid(ncid, name, varid) RESULT (status)
209 
210 ! Get variable id for a variable name from NetCDF dataset ncid
211 
212  USE netcdf_nc_interfaces
213 
214  Implicit NONE
215 
216  Integer, Intent(IN) :: ncid
217  Character(LEN=*), Intent(IN) :: name
218  Integer, Intent(OUT) :: varid
219 
220  Integer :: status
221 
222  Integer(KIND=C_INT) :: cncid, cvarid, cstatus
223  Character(LEN=(LEN(name)+1)) :: cname
224  Integer :: ie
225 
226  cncid = ncid
227 
228 ! Check name for a C NULL character added in calling routine
229 
230  cname = addcnullchar(name, ie)
231 
232  cstatus = nc_inq_varid(cncid, cname(1:ie+1), cvarid)
233 
234  If (cstatus == nc_noerr) Then
235  varid = cvarid + 1 ! add one to get Fortran id number
236  EndIf
237  status = cstatus
238 
239  End Function nf_inq_varid
240 !-------------------------------- nf_inq_varname ------------------------
241  Function nf_inq_varname (ncid, varid, name) RESULT (status)
242 
243 ! Get variable name for a given varid from NetCDF dataset ncid
244 
245  USE netcdf_nc_interfaces
246 
247  Implicit NONE
248 
249  Integer, Intent(IN) :: ncid, varid
250  Character(LEN=*), Intent(OUT) :: name
251 
252  Integer :: status
253 
254  Integer(KIND=C_INT) :: cncid, cvarid, cstatus
255  Character(LEN=NC_MAX_NAME+1) :: tmpname
256  Integer :: nlen
257 
258  cncid = ncid
259  cvarid = varid - 1 ! subtract one to get C id number
260 
261  nlen = len(name)
262  tmpname = repeat(" ", len(tmpname))
263  name = repeat(" ", nlen)
264 
265 ! Get tmpname from C interface
266 
267  cstatus = nc_inq_varname(cncid, cvarid, tmpname)
268 
269  If (cstatus == nc_noerr) Then
270  ! Find first C null character in tmpname if present and set end of string
271  name = stripcnullchar(tmpname, nlen)
272  EndIf
273  status = cstatus
274 
275  End Function nf_inq_varname
276 !-------------------------------- nf_inq_vartype -------------------------
277  Function nf_inq_vartype(ncid, varid, xtype) RESULT(status)
278 
279 ! Inquire about numeric type of variable attributes for NetCDF file id ncid
280 
281  USE netcdf_nc_interfaces
282 
283  Implicit NONE
284 
285  Integer, Intent(IN) :: ncid, varid
286  Integer, Intent(OUT) :: xtype
287 
288  Integer :: status
289 
290  Integer(KIND=C_INT) :: cncid, cvarid, cstatus
291  Integer(KIND=C_INT) :: cxtype
292 
293  cncid = ncid
294  cvarid = varid - 1 ! Subtract one to get C id number
295 
296  cstatus = nc_inq_vartype(cncid, cvarid, cxtype)
297 
298  If (cstatus == nc_noerr) Then
299  xtype = cxtype
300  EndIf
301  status = cstatus
302 
303  End Function nf_inq_vartype
304 !-------------------------------- nf_inq_varnatts -----------------------
305  Function nf_inq_varnatts(ncid, varid, nvatts) RESULT(status)
306 
307 ! Inquire about number of variable attributes for NetCDF file id ncid
308 
309  USE netcdf_nc_interfaces
310 
311  Implicit NONE
312 
313  Integer, Intent(IN) :: ncid, varid
314  Integer, Intent(OUT) :: nvatts
315 
316  Integer :: status
317 
318  Integer(KIND=C_INT) :: cncid, cvarid, cnvatts, cstatus
319 
320  cncid = ncid
321  cvarid = varid - 1 ! subtract one to get C id number
322 
323  cstatus = nc_inq_varnatts(cncid, cvarid, cnvatts)
324 
325  If (cstatus == nc_noerr) Then
326  nvatts = cnvatts
327  EndIf
328 
329  status = cstatus
330 
331  End Function nf_inq_varnatts
332 !-------------------------------- nf_rename_var -------------------------
333  Function nf_rename_var(ncid, varid, name) RESULT (status)
334 
335 ! Rename dimension name for a given dimension id
336 
337  USE netcdf_nc_interfaces
338 
339  Implicit NONE
340 
341  Integer, Intent(IN) :: ncid, varid
342  Character(LEN=*), Intent(IN) :: name
343 
344  Integer :: status
345 
346  Integer(KIND=C_INT) :: cncid, cvarid, cstatus
347  Character(LEN=(LEN(name)+1)) :: cname
348  Integer :: ie
349 
350  cncid = ncid
351  cvarid = varid - 1 ! Subtract one to get C id number
352 
353 ! Check name for a C NULL character added in calling routine
354 
355  cname = addcnullchar(name, ie)
356 
357  cstatus = nc_rename_var(cncid, cvarid, cname(1:ie+1))
358 
359  status = cstatus
360 
361  End Function nf_rename_var
362 !-------------------------------- nf_copy_var ---------------------------
363  Function nf_copy_var(ncid_in, varid, ncid_out) RESULT(status)
364 
365 ! Copies a given variable from dataset ncid_in to dataset ncid_out
366 
367  USE netcdf_nc_interfaces
368 
369  Implicit NONE
370 
371  Integer, Intent(IN) :: ncid_in, varid, ncid_out
372  Integer :: status
373 
374  Integer(KIND=C_INT) :: cncidin, cvarid, cncidout, cstatus
375 
376  cncidin = ncid_in
377  cncidout = ncid_out
378  cvarid = varid - 1 ! Subtract one to get C id number
379 
380  cstatus = nc_copy_var(cncidin, cvarid, cncidout)
381 
382  status = cstatus
383 
384  End Function nf_copy_var
module procedure interfaces for utility routines

Return to the Main Unidata NetCDF page.
Generated on Sun Mar 27 2016 13:46:12 for NetCDF-Fortran. NetCDF is a Unidata library.