NetCDF-Fortran  4.4.4
nf_attio.F90
Go to the documentation of this file.
1 #include "nfconfig.inc"
2 !---------- Routines to put/get attribute data of various data types ----------
3 
4 ! Replacement for fort-attio.c
5 
6 ! Written by: Richard Weed, Ph.D.
7 ! Center for Advanced Vehicular Systems
8 ! Mississippi State University
9 ! rweed@cavs.msstate.edu
10 
11 
12 ! License (and other Lawyer Language)
13 
14 ! This software is released under the Apache 2.0 Open Source License. The
15 ! full text of the License can be viewed at :
16 !
17 ! http:www.apache.org/licenses/LICENSE-2.0.html
18 !
19 ! The author grants to the University Center for Atmospheric Research
20 ! (UCAR), Boulder, CO, USA the right to revise and extend the software
21 ! without restriction. However, the author retains all copyrights and
22 ! intellectual property rights explicitly stated in or implied by the
23 ! Apache license
24 
25 ! Version 1.: Sept. 2005 - Initial Cray X1 version
26 ! Version 2.: May 2006 - Updated to support g95
27 ! Version 3.: April 2009 - Updated to Netcdf 4.0.1
28 ! Version 4.: April 2010 - Updated to Netcdf 4.1.1
29 ! Version 5.: Feb. 2013 - bug fixes for fortran 4.4
30 ! Version 6: Jan. 2016 - General code cleanup. Changed processing of
31 ! name strings to reflect change to addCNullChar
32 
33 !--------------------------------- nf_put_att_text ---------------------------
34  Function nf_put_att_text(ncid, varid, name, nlen, text) RESULT(status)
35 
36 ! Write variable or global attribute text string to dataset ncid
37 
39 
40  Implicit NONE
41 
42  Integer, Intent(IN) :: ncid, varid, nlen
43  Character(LEN=*), Intent(IN) :: name, text
44 
45  Integer :: status
46 
47  Integer(C_INT) :: cncid, cvarid, cstatus
48  Integer(C_SIZE_T) :: cnlen
49  Character(LEN=(LEN(name)+1)) :: cname
50  Integer :: ie
51 
52  cncid = ncid
53  cvarid = varid -1 ! Subtract 1 to get C varid
54  cnlen = nlen
55 
56  cname = addcnullchar(name, ie)
57 
58  cstatus = nc_put_att_text(cncid, cvarid, cname(1:ie), cnlen, &
59  text)
60 
61  status = cstatus
62 
63  End Function nf_put_att_text
64 !--------------------------------- nf_put_att_text_a ------------------------
65  Function nf_put_att_text_a(ncid, varid, name, nlen, text) RESULT(status)
66 
67 ! New routine to support passing an array of single characters
68 ! Write variable or global attribute array of characters to dataset ncid
69 
71 
72  Implicit NONE
73 
74  Integer, Intent(IN) :: ncid, varid, nlen
75  Character(LEN=*), Intent(IN) :: name
76  Character(LEN=1), Intent(IN) :: text(*)
77 
78  Integer :: status
79 
80  Integer(C_INT) :: cncid, cvarid, cstatus
81  Integer(C_SIZE_T) :: cnlen
82  Character(LEN=(LEN(name)+1)) :: cname
83  Integer :: ie
84 
85  cncid = ncid
86  cvarid = varid -1 ! Subtract 1 to get C varid
87  cnlen = nlen
88 
89  cname = addcnullchar(name, ie)
90 
91  cstatus = nc_put_att_text(cncid, cvarid, cname(1:ie), cnlen, &
92  text)
93 
94  status = cstatus
95 
96  End Function nf_put_att_text_a
97 !--------------------------------- nf_put_att_int1 -------------------------
98  Function nf_put_att_int1(ncid, varid, name, xtype, nlen, i1vals) &
99  result(status)
101 ! Write variable or global attribute byte data to dataset ncid
102 
104 
105  Implicit NONE
106 
107  Integer, Intent(IN) :: ncid, varid, nlen, xtype
108  Character(LEN=*), Intent(IN) :: name
109  Integer(NFINT1), Intent(IN) :: i1vals(*)
110 
111  Integer :: status
112 
113  Integer(C_INT) :: cncid, cvarid, cstatus, cxtype
114  Integer(C_SIZE_T) :: cnlen
115  Character(LEN=(LEN(name)+1)) :: cname
116  Integer :: ie
117 
118  If (c_signed_char < 0) Then ! schar not supported by processor
119  status = nc_ebadtype
120  RETURN
121  EndIf
122 
123  cncid = ncid
124  cvarid = varid -1 ! Subtract 1 to get C varid
125  cnlen = nlen
126  cxtype = xtype
127 
128 ! Check for C null char on name and add one
129 
130  cname = addcnullchar(name, ie)
131 
132 #if NF_INT1_IS_C_SIGNED_CHAR
133  cstatus = nc_put_att_schar(cncid, cvarid, cname(1:ie), &
134  cxtype, cnlen, i1vals)
135 #elif NF_INT1_IS_C_SHORT
136  cstatus = nc_put_att_short(cncid, cvarid, cname(1:ie), &
137  cxtype, cnlen, i1vals)
138 #elif NF_INT1_IS_C_INT
139  cstatus = nc_put_att_int(cncid, cvarid, cname(1:ie), &
140  cxtype, cnlen, i1vals)
141 #elif NF_INT1_IS_C_LONG
142  cstatus = nc_put_att_long(cncid, cvarid, cname(1:ie), &
143  cxtype, cnlen, i1vals)
144 #endif
145  status = cstatus
146 
147  End Function nf_put_att_int1
148 !--------------------------------- nf_put_att_int2 -------------------------
149  Function nf_put_att_int2(ncid, varid, name, xtype, nlen, i2vals) &
150  result(status)
152 ! Write variable or global attribute 16 bit integer data to dataset ncid
153 
155 
156  Implicit NONE
157 
158  Integer, Intent(IN) :: ncid, varid, nlen, xtype
159  Character(LEN=*), Intent(IN) :: name
160  Integer(NFINT2), Intent(IN) :: i2vals(*)
161 
162  Integer :: status
163 
164  Integer(C_INT) :: cncid, cvarid, cstatus, cxtype
165  Integer(C_SIZE_T) :: cnlen
166  Character(LEN=(LEN(name)+1)) :: cname
167  Integer :: ie
168 
169  If (c_short < 0) Then ! short not supported by processor
170  status = nc_ebadtype
171  Return
172  EndIf
173 
174  cncid = ncid
175  cvarid = varid -1 ! Subtract 1 to get C varid
176  cnlen = nlen
177  cxtype = xtype
178 
179  cname = addcnullchar(name, ie)
180 
181 #if NF_INT2_IS_C_SHORT
182  cstatus = nc_put_att_short(cncid, cvarid, cname(1:ie), &
183  cxtype, cnlen, i2vals)
184 #elif NF_INT2_IS_C_INT
185  cstatus = nc_put_att_int(cncid, cvarid, cname(1:ie), &
186  cxtype, cnlen, i2vals)
187 #elif NF_INT2_IS_C_LONG
188  cstatus = nc_put_att_long(cncid, cvarid, cname(1:ie), &
189  cxtype, cnlen, i2vals)
190 #endif
191  status = cstatus
192 
193  End Function nf_put_att_int2
194 !--------------------------------- nf_put_att_int --------------------------
195  Function nf_put_att_int(ncid, varid, name, xtype, nlen, ivals) &
196  result(status)
198 ! Write variable or global attribute default integer data to dataset ncid
199 
201 
202  Implicit NONE
203 
204  Integer, Intent(IN) :: ncid, varid, nlen, xtype
205  Character(LEN=*), Intent(IN) :: name
206  Integer(NFINT), Intent(IN) :: ivals(*)
207 
208  Integer :: status
209 
210  Integer(C_INT) :: cncid, cvarid, cstatus, cxtype
211  Integer(C_SIZE_T) :: cnlen
212  Character(LEN=(LEN(name)+1)) :: cname
213  Integer :: ie
214 
215  cncid = ncid
216  cvarid = varid -1 ! Subtract 1 to get C varid
217  cnlen = nlen
218  cxtype = xtype
219 
220 ! Check for C null char and add one if missing
221 
222  cname = addcnullchar(name, ie)
223 
224 #if NF_INT_IS_C_INT
225  cstatus = nc_put_att_int(cncid, cvarid, cname(1:ie), &
226  cxtype, cnlen, ivals)
227 #elif NF_INT_IS_C_LONG
228  cstatus = nc_put_att_long(cncid, cvarid, cname(1:ie), &
229  cxtype, cnlen, ivals)
230 #endif
231  status = cstatus
232 
233  End Function nf_put_att_int
234 !--------------------------------- nf_put_att_real -------------------------
235  Function nf_put_att_real(ncid, varid, name, xtype, nlen, rvals) &
236  result(status)
238 ! Write variable or global attribute Real(RK4) data to dataset ncid
239 
241 
242  Implicit NONE
243 
244  Integer, Intent(IN) :: ncid, varid, nlen, xtype
245  Character(LEN=*), Intent(IN) :: name
246  Real(NFREAL), Intent(IN) :: rvals(*)
247 
248  Integer :: status
249 
250  Integer(C_INT) :: cncid, cvarid, cstatus, cxtype
251  Integer(C_SIZE_T) :: cnlen
252  Character(LEN=(LEN(name)+1)) :: cname
253  Integer :: ie
254 
255  cncid = ncid
256  cvarid = varid -1 ! Subtract 1 to get C varid
257  cnlen = nlen
258  cxtype = xtype
259 
260 ! Check for C null char and add one if missing
261 
262  cname = addcnullchar(name, ie)
263 
264 #if NF_REAL_IS_C_DOUBLE
265  cstatus = nc_put_att_double(cncid, cvarid, cname(1:ie), &
266  cxtype, cnlen, rvals)
267 #else
268  cstatus = nc_put_att_float(cncid, cvarid, cname(1:ie), &
269  cxtype, cnlen, rvals)
270 #endif
271  status = cstatus
272 
273  End Function nf_put_att_real
274 !--------------------------------- nf_put_att_double -----------------------
275  Function nf_put_att_double(ncid, varid, name, xtype, nlen, dvals) &
276  result(status)
278 ! Write variable or global attribute Real(RK8) to dataset ncid
279 
281 
282  Implicit NONE
283 
284  Integer, Intent(IN) :: ncid, varid, nlen, xtype
285  Character(LEN=*), Intent(IN) :: name
286  Real(RK8), Intent(IN) :: dvals(*)
287 
288  Integer :: status
289 
290  Integer(C_INT) :: cncid, cvarid, cstatus, cxtype
291  Integer(C_SIZE_T) :: cnlen
292  Character(LEN=(LEN(name)+1)) :: cname
293  Integer :: ie
294 
295  cncid = ncid
296  cvarid = varid -1 ! Subtract 1 to get C varid
297  cnlen = nlen
298  cxtype = xtype
299 
300 ! Check for C null char and add one if missing
301 
302  cname = addcnullchar(name, ie)
303 
304  cstatus = nc_put_att_double(cncid, cvarid, cname(1:ie), &
305  cxtype, cnlen, dvals)
306 
307  status = cstatus
308 
309  End Function nf_put_att_double
310 !--------------------------------- nf_get_att_text -----------------------
311  Function nf_get_att_text(ncid, varid, name, text) RESULT(status)
313 ! Read variable or global attribute character string from dataset ncid
314 
316 
317  Implicit NONE
318 
319  Integer, Intent(IN) :: ncid, varid
320  Character(LEN=*), Intent(IN) :: name
321  Character(LEN=*), Intent(OUT) :: text
322 
323  Integer :: status
324 
325  Integer(C_INT) :: cncid, cvarid, cstatus
326  Character(LEN=(LEN(name)+1)) :: cname
327  Integer :: ie
328 
329  cncid = ncid
330  cvarid = varid -1 ! Subtract 1 to get C varid
331  text = repeat(" ", len(text))
332 
333 ! Check for C null char and add one if missing
334 
335  cname = addcnullchar(name, ie)
336 
337  cstatus = nc_get_att_text(cncid, cvarid, cname(1:ie), text)
338 
339  status = cstatus
340 
341  End Function nf_get_att_text
342 !--------------------------------- nf_get_att_text_a -----------------------
343  Function nf_get_att_text_a(ncid, varid, name, text) RESULT(status)
345 ! New routine to support passing an array of single characters
346 ! Read variable or global attribute array of characters from dataset ncid
347 
349 
350  Implicit NONE
351 
352  Integer, Intent(IN) :: ncid, varid
353  Character(LEN=*), Intent(IN) :: name
354  Character(LEN=1), Intent(OUT) :: text(*)
355 
356  Integer :: status
357 
358  Integer(C_INT) :: cncid, cvarid, cstatus
359  Character(LEN=(LEN(name)+1)) :: cname
360  Integer :: ie
361 
362  cncid = ncid
363  cvarid = varid -1 ! Subtract 1 to get C varid
364 
365 ! Check for C null char and add one if missing
366 
367  cname = addcnullchar(name, ie)
368 
369  cstatus = nc_get_att_text(cncid, cvarid, cname(1:ie), text)
370 
371  status = cstatus
372 
373  End Function nf_get_att_text_a
374 !--------------------------------- nf_get_att_int1 -------------------------
375  Function nf_get_att_int1(ncid, varid, name, i1vals) RESULT(status)
377 ! Read variable or global attribute BYTE integer data from dataset ncid
378 
380 
381  Implicit NONE
382 
383  Integer, Intent(IN) :: ncid, varid
384  Character(LEN=*), Intent(IN) :: name
385  Integer(NFINT1), Intent(OUT) :: i1vals(*)
386 
387  Integer :: status
388 
389  Integer(C_INT) :: cncid, cvarid, cstatus
390  Character(LEN=(LEN(name)+1)) :: cname
391  Integer :: ie
392 
393  If (c_signed_char < 0) Then ! schar not supported by processor
394  status = nc_ebadtype
395  RETURN
396  EndIf
397 
398  cncid = ncid
399  cvarid = varid -1 ! Subtract 1 to get C varid
400 
401 ! Check for C null char and add one if missing
402 
403  cname = addcnullchar(name, ie)
404 
405 #if NF_INT1_IS_C_SIGNED_CHAR
406  cstatus = nc_get_att_schar(cncid, cvarid, cname(1:ie), i1vals)
407 #elif NF_INT1_IS_C_SHORT
408  cstatus = nc_get_att_short(cncid, cvarid, cname(1:ie), i1vals)
409 #elif NF_INT1_IS_C_INT
410  cstatus = nc_get_att_int(cncid, cvarid, cname(1:ie), i1vals)
411 #elif NF_INT1_IS_C_LONG
412  cstatus = nc_get_att_long(cncid, cvarid, cname(1:ie), i1vals)
413 #endif
414  status = cstatus
415 
416  End Function nf_get_att_int1
417 !--------------------------------- nf_get_att_int2 --------------------------
418  Function nf_get_att_int2(ncid, varid, name, i2vals) RESULT(status)
420 ! Read variable or global attribute 16 bit integer data from dataset ncid
421 
423 
424  Implicit NONE
425 
426  Integer, Intent(IN) :: ncid, varid
427  Character(LEN=*), Intent(IN) :: name
428  Integer(NFINT2), Intent(OUT) :: i2vals(*)
429 
430  Integer :: status
431 
432  Integer(C_INT) :: cncid, cvarid, cstatus
433  Character(LEN=(LEN(name)+1)) :: cname
434  Integer :: ie
435 
436  If (c_short < 0) Then ! short not supported by processor
437  status = nc_ebadtype
438  RETURN
439  EndIf
440 
441  cncid = ncid
442  cvarid = varid -1 ! Subtract 1 to get C varid
443 
444 ! Check for C null char and add one if missing
445 
446  cname = addcnullchar(name, ie)
447 
448 #if NF_INT2_IS_C_SHORT
449  cstatus = nc_get_att_short(cncid, cvarid, cname(1:ie), i2vals)
450 #elif NF_INT2_IS_C_INT
451  cstatus = nc_get_att_int(cncid, cvarid, cname(1:ie), i2vals)
452 #elif NF_INT2_IS_C_LONG
453  cstatus = nc_get_att_long(cncid, cvarid, cname(1:ie), i2vals)
454 #endif
455  status = cstatus
456 
457  End Function nf_get_att_int2
458 !--------------------------------- nf_get_att_int ---------------------------
459  Function nf_get_att_int(ncid, varid, name, ivals) RESULT(status)
461 ! Read variable or global attribute default Integer data from dataset ncid
462 
464 
465  Implicit NONE
466 
467  Integer, Intent(IN) :: ncid, varid
468  Character(LEN=*), Intent(IN) :: name
469  Integer(NFINT), Intent(OUT) :: ivals(*)
470 
471  Integer :: status
472 
473  Integer(C_INT) :: cncid, cvarid, cstatus
474  Character(LEN=(LEN(name)+1)) :: cname
475  Integer :: ie
476 
477  cncid = ncid
478  cvarid = varid -1 ! Subtract 1 to get C varid
479 
480 ! Check for C null char and add one if missing
481 
482  cname = addcnullchar(name, ie)
483 
484 #if NF_INT_IS_C_INT
485  cstatus = nc_get_att_int(cncid, cvarid, cname(1:ie), ivals)
486 #elif NF_INT_IS_C_LONG
487  cstatus = nc_get_att_long(cncid, cvarid, cname(1:ie), ivals)
488 #endif
489  status = cstatus
490 
491  End Function nf_get_att_int
492 !--------------------------------- nf_get_att_real -------------------------
493  Function nf_get_att_real(ncid, varid, name, rvals) RESULT(status)
495 ! Read variable or global attribute Real(RK4) data from dataset ncid
496 
498 
499  Implicit NONE
500 
501  Integer, Intent(IN) :: ncid, varid
502  Character(LEN=*), Intent(IN) :: name
503  Real(NFREAL), Intent(OUT) :: rvals(*)
504 
505  Integer :: status
506 
507  Integer(C_INT) :: cncid, cvarid, cstatus
508  Character(LEN=(LEN(name)+1)) :: cname
509  Integer :: ie
510 
511  cncid = ncid
512  cvarid = varid -1 ! Subtract 1 to get C varid
513 
514 ! Check for C null char and add one if missing
515 
516  cname = addcnullchar(name, ie)
517 
518 #if NF_REAL_IS_C_DOUBLE
519  cstatus = nc_get_att_double(cncid, cvarid, cname(1:ie), rvals)
520 #else
521  cstatus = nc_get_att_float(cncid, cvarid, cname(1:ie), rvals)
522 #endif
523  status = cstatus
524 
525  End Function nf_get_att_real
526 !--------------------------------- nf_get_att_double -----------------------
527  Function nf_get_att_double(ncid, varid, name, dvals) RESULT(status)
529 ! Read variable or global attribute Real(RK8) data from dataset ncid
530 
532 
533  Implicit NONE
534 
535  Integer, Intent(IN) :: ncid, varid
536  Character(LEN=*), Intent(IN) :: name
537  Real(RK8), Intent(OUT) :: dvals(*)
538 
539  Integer :: status
540 
541  Integer(C_INT) :: cncid, cvarid, cstatus
542  Character(LEN=(LEN(name)+1)) :: cname
543  Integer :: ie
544 
545  cncid = ncid
546  cvarid = varid -1 ! Subtract 1 to get C varid
547 
548 ! Check for C null char and add one if missing
549 
550  cname = addcnullchar(name, ie)
551 
552  cstatus = nc_get_att_double(cncid, cvarid, cname(1:ie), dvals)
553 
554  status = cstatus
555 
556  End Function nf_get_att_double
function nf_put_att_double(ncid, varid, name, xtype, nlen, dvals)
Definition: nf_attio.F90:277
function nf_put_att_real(ncid, varid, name, xtype, nlen, rvals)
Definition: nf_attio.F90:237
integer function nf_get_att_real(ncid, varid, name, rvals)
Definition: nf_attio.F90:494
integer function nf_get_att_double(ncid, varid, name, dvals)
Definition: nf_attio.F90:528
integer function nf_get_att_int(ncid, varid, name, ivals)
Definition: nf_attio.F90:460
integer function nf_get_att_text(ncid, varid, name, text)
Definition: nf_attio.F90:312
integer function nf_get_att_int1(ncid, varid, name, i1vals)
Definition: nf_attio.F90:376
function nf_put_att_int2(ncid, varid, name, xtype, nlen, i2vals)
Definition: nf_attio.F90:151
integer function nf_get_att_text_a(ncid, varid, name, text)
Definition: nf_attio.F90:344
module procedure interfaces for utility routines
integer function nf_get_att_int2(ncid, varid, name, i2vals)
Definition: nf_attio.F90:419
integer function nf_put_att_text_a(ncid, varid, name, nlen, text)
Definition: nf_attio.F90:66
function nf_put_att_int(ncid, varid, name, xtype, nlen, ivals)
Definition: nf_attio.F90:197
function nf_put_att_int1(ncid, varid, name, xtype, nlen, i1vals)
Definition: nf_attio.F90:100
integer function nf_put_att_text(ncid, varid, name, nlen, text)
Definition: nf_attio.F90:35

Return to the Main Unidata NetCDF page.
Generated on Sun May 15 2016 13:27:33 for NetCDF-Fortran. NetCDF is a Unidata library.