NetCDF-Fortran  4.4.4
nf_vario.F90
Go to the documentation of this file.
1 #include "nfconfig.inc"
2 !------------ Array/string put/get routines for a given varid ----------------
3 
4 ! Replacement for fort-vario.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 Corporation 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 for netCDF 4.0.1
28 ! Version 4.: April 2010 - Updated for netCDF 4.1.1
29 ! Added preprocessor tests for int and real types
30 ! Version 5.: Jan. 2016 - Some minor code cleanup
31 
32 !--------------------------------- nf_put_var_text -----------------------
33  Function nf_put_var_text(ncid, varid, text) RESULT(status)
34 
35 ! Write out a character string to dataset
36 
38 
39  Implicit NONE
40 
41  Integer, Intent(IN) :: ncid, varid
42  Character(LEN=*), Intent(IN) :: text
43 
44  Integer :: status
45 
46  Integer(C_INT) :: cncid, cvarid, cstatus
47 
48  cncid = ncid
49  cvarid = varid - 1 ! Subtract 1 to get C varid
50 
51  cstatus = nc_put_var_text(cncid, cvarid, text)
52 
53  status = cstatus
54 
55  End Function nf_put_var_text
56 !--------------------------------- nf_put_var_text_a -----------------------
57  Function nf_put_var_text_a(ncid, varid, text) RESULT(status)
58 
59 ! Write out array of characters to dataset
60 
62 
63  Implicit NONE
64 
65  Integer, Intent(IN) :: ncid, varid
66  Character(LEN=1), Intent(IN) :: text(*)
67 
68  Integer :: status
69 
70  Integer(C_INT) :: cncid, cvarid, cstatus
71 
72  cncid = ncid
73  cvarid = varid - 1 ! Subtract 1 to get C varid
74 
75  cstatus = nc_put_var_text(cncid, cvarid, text)
76 
77  status = cstatus
78 
79  End Function nf_put_var_text_a
80 !--------------------------------- nf_put_var_int1 -------------------------
81  Function nf_put_var_int1(ncid, varid, i1vals) RESULT(status)
82 
83 ! Write out 8 bit integer array to dataset
84 
86 
87  Implicit NONE
88 
89  Integer, Intent(IN) :: ncid, varid
90  Integer(NFINT1), Intent(IN) :: i1vals(*)
91 
92  Integer :: status
93 
94  Integer(C_INT) :: cncid, cvarid, cstatus
95 
96  If (c_signed_char < 0) Then ! schar not supported by processor
97  status = nc_ebadtype
98  RETURN
99  EndIf
100 
101  cncid = ncid
102  cvarid = varid - 1 ! Subtract 1 to get C varid
103 
104 #if NF_INT1_IS_C_SIGNED_CHAR
105  cstatus = nc_put_var_schar(cncid, cvarid, i1vals)
106 #elif NF_INT1_IS_C_SHORT
107  cstatus = nc_put_var_short(cncid, cvarid, i1vals)
108 #elif NF_INT1_IS_C_INT
109  cstatus = nc_put_var_int(cncid, cvarid, i1vals)
110 #elif NF_INT1_IS_C_LONG
111  cstatus = nc_put_var_long(cncid, cvarid, i1vals)
112 #endif
113 
114  status = cstatus
115 
116  End Function nf_put_var_int1
117 !--------------------------------- nf_put_var_int2 -------------------------
118  Function nf_put_var_int2(ncid, varid, i2vals) RESULT(status)
120 ! Write out 16 bit integer array to dataset
121 
123 
124  Implicit NONE
125 
126  Integer, Intent(IN) :: ncid, varid
127  Integer(NFINT2), Intent(IN) :: i2vals(*)
128 
129  Integer :: status
130 
131  Integer(C_INT) :: cncid, cvarid, cstatus
132 
133  If (c_short < 0) Then ! short not supported by processor
134  status = nc_ebadtype
135  RETURN
136  EndIf
137 
138  cncid = ncid
139  cvarid = varid - 1 ! Subtract 1 to get C varid
140 
141 #if NF_INT2_IS_C_SHORT
142  cstatus = nc_put_var_short(cncid, cvarid, i2vals)
143 #elif NF_INT2_IS_C_INT
144  cstatus = nc_put_var_int(cncid, cvarid, i2vals)
145 #elif NF_INT2_IS_C_LONG
146  cstatus = nc_put_var_long(cncid, cvarid, i2vals)
147 #endif
148 
149  status = cstatus
150 
151  End Function nf_put_var_int2
152 !--------------------------------- nf_put_var_int --------------------------
153  Function nf_put_var_int(ncid, varid, ivals) RESULT(status)
155 ! Write out 32 bit integer array to dataset
156 
158 
159  Implicit NONE
160 
161  Integer, Intent(IN) :: ncid, varid
162  Integer(NFINT), Intent(IN) :: ivals(*)
163 
164  Integer :: status
165 
166  Integer(C_INT) :: cncid, cvarid, cstatus
167 
168  cncid = ncid
169  cvarid = varid - 1 ! Subtract 1 to get C varid
170 
171 #if NF_INT_IS_C_INT
172  cstatus = nc_put_var_int(cncid, cvarid, ivals)
173 #elif NF_INT_IS_C_LONG
174  cstatus = nc_put_var_long(cncid, cvarid, ivals)
175 #endif
176 
177  status = cstatus
178 
179  End Function nf_put_var_int
180 !--------------------------------- nf_put_var_real -------------------------
181  Function nf_put_var_real(ncid, varid, rvals) RESULT(status)
183 ! Write out 32 bit real array to dataset
184 
186 
187  Implicit NONE
188 
189  Integer, Intent(IN) :: ncid, varid
190  Real(NFREAL), Intent(IN) :: rvals(*)
191 
192  Integer :: status
193 
194  Integer(C_INT) :: cncid, cvarid, cstatus
195 
196  cncid = ncid
197  cvarid = varid - 1 ! Subtract 1 to get C varid
198 
199 #if NF_REAL_IS_C_DOUBLE
200  cstatus = nc_put_var_double(cncid, cvarid, rvals)
201 #else
202  cstatus = nc_put_var_float(cncid, cvarid, rvals)
203 #endif
204 
205  status = cstatus
206 
207  End Function nf_put_var_real
208 !--------------------------------- nf_put_var_double -----------------------
209  Function nf_put_var_double(ncid, varid, dvals) RESULT(status)
211 ! Write out 64 bit real array to dataset
212 
214 
215  Implicit NONE
216 
217  Integer, Intent(IN) :: ncid, varid
218  Real(RK8), Intent(IN) :: dvals(*)
219 
220  Integer :: status
221 
222  Integer(C_INT) :: cncid, cvarid, cstatus
223 
224  cncid = ncid
225  cvarid = varid - 1 ! Subtract 1 to get C varid
226 
227  cstatus = nc_put_var_double(cncid, cvarid, dvals)
228 
229  status = cstatus
230 
231  End Function nf_put_var_double
232 !--------------------------------- nf_get_var_text -----------------------
233  Function nf_get_var_text(ncid, varid, text) RESULT(status)
235 ! Read in a character string from dataset
236 
238 
239  Implicit NONE
240 
241  Integer, Intent(IN) :: ncid, varid
242  Character(LEN=*), Intent(OUT) :: text
243 
244  Integer :: status
245 
246  Integer(C_INT) :: cncid, cvarid, cstatus
247 
248  cncid = ncid
249  cvarid = varid - 1 ! Subtract 1 to get C varid
250  text = repeat(" ", len(text))
251 
252  cstatus = nc_get_var_text(cncid, cvarid, text)
253 
254  status = cstatus
255 
256  End Function nf_get_var_text
257 !--------------------------------- nf_get_var_text_a -----------------------
258  Function nf_get_var_text_a(ncid, varid, text) RESULT(status)
260 ! Read in array of characters from dataset
261 
263 
264  Implicit NONE
265 
266  Integer, Intent(IN) :: ncid, varid
267  Character(LEN=1), Intent(OUT) :: text(*)
268 
269  Integer :: status
270 
271  Integer(C_INT) :: cncid, cvarid, cstatus
272 
273  cncid = ncid
274  cvarid = varid - 1 ! Subtract 1 to get C varid
275 
276  cstatus = nc_get_var_text(cncid, cvarid, text)
277 
278  status = cstatus
279 
280  End Function nf_get_var_text_a
281 !--------------------------------- nf_get_var_int1 -------------------------
282  Function nf_get_var_int1(ncid, varid, i1vals) RESULT(status)
284 ! Read in 8 bit integer array from dataset
285 
287 
288  Implicit NONE
289 
290  Integer, Intent(IN) :: ncid, varid
291  Integer(NFINT1), Intent(OUT) :: i1vals(*)
292 
293  Integer :: status
294 
295  Integer(C_INT) :: cncid, cvarid, cstatus
296 
297  If (c_signed_char < 0) Then ! schar not supported by processor
298  status = nc_ebadtype
299  RETURN
300  EndIf
301 
302  cncid = ncid
303  cvarid = varid - 1 ! Subtract 1 to get C varid
304 
305 #if NF_INT1_IS_C_SIGNED_CHAR
306  cstatus = nc_get_var_schar(cncid, cvarid, i1vals)
307 #elif NF_INT1_IS_C_SHORT
308  cstatus = nc_get_var_short(cncid, cvarid, i1vals)
309 #elif NF_INT1_IS_C_INT
310  cstatus = nc_get_var_int(cncid, cvarid, i1vals)
311 #elif NF_INT1_IS_C_LONG
312  cstatus = nc_get_var_long(cncid, cvarid, i1vals)
313 #endif
314 
315  status = cstatus
316 
317  End Function nf_get_var_int1
318 !--------------------------------- nf_get_var_int2 -------------------------
319  Function nf_get_var_int2(ncid, varid, i2vals) RESULT(status)
321 ! Read in 16 bit integer array from dataset
322 
324 
325  Implicit NONE
326 
327  Integer, Intent(IN) :: ncid, varid
328  Integer(NFINT2), Intent(OUT) :: i2vals(*)
329 
330  Integer :: status
331 
332  Integer(C_INT) :: cncid, cvarid, cstatus
333 
334  If (c_short < 0) Then ! short not supported by processor
335  status = nc_ebadtype
336  RETURN
337  EndIf
338 
339  cncid = ncid
340  cvarid = varid - 1 ! Subtract 1 to get C varid
341 
342 #if NF_INT2_IS_C_SHORT
343  cstatus = nc_get_var_short(cncid, cvarid, i2vals)
344 #elif NF_INT2_IS_C_INT
345  cstatus = nc_get_var_int(cncid, cvarid, i2vals)
346 #elif NF_INT2_IS_C_LONG
347  cstatus = nc_get_var_long(cncid, cvarid, i2vals)
348 #endif
349 
350  status = cstatus
351 
352  End Function nf_get_var_int2
353 !--------------------------------- nf_get_var_int --------------------------
354  Function nf_get_var_int(ncid, varid, ivals) RESULT(status)
356 ! Read in default integer array from dataset
357 
359 
360  Implicit NONE
361 
362  Integer, Intent(IN) :: ncid, varid
363  Integer(NFINT), Intent(OUT) :: ivals(*)
364 
365  Integer :: status
366 
367  Integer(C_INT) :: cncid, cvarid, cstatus
368 
369  cncid = ncid
370  cvarid = varid - 1 ! Subtract 1 to get C varid
371 
372 #if NF_INT_IS_C_INT
373  cstatus = nc_get_var_int(cncid, cvarid, ivals)
374 #elif NF_INT_IS_C_LONG
375  cstatus = nc_get_var_long(cncid, cvarid, ivals)
376 #endif
377 
378  status = cstatus
379 
380  End Function nf_get_var_int
381 !--------------------------------- nf_get_var_real -------------------------
382  Function nf_get_var_real(ncid, varid, rvals) RESULT(status)
384 ! Read in 32 bit real array from dataset
385 
387 
388  Implicit NONE
389 
390  Integer, Intent(IN) :: ncid, varid
391  Real(NFREAL), Intent(OUT) :: rvals(*)
392 
393  Integer :: status
394 
395  Integer(C_INT) :: cncid, cvarid, cstatus
396 
397  cncid = ncid
398  cvarid = varid - 1 ! Subtract 1 to get C varid
399 
400 #if NF_REAL_IS_C_DOUBLE
401  cstatus = nc_get_var_double(cncid, cvarid, rvals)
402 #else
403  cstatus = nc_get_var_float(cncid, cvarid, rvals)
404 #endif
405 
406  status = cstatus
407 
408  End Function nf_get_var_real
409 !--------------------------------- nf_get_var_double -----------------------
410  Function nf_get_var_double(ncid, varid, dvals) RESULT(status)
412 ! Read in 64 bit real array from dataset
413 
415 
416  Implicit NONE
417 
418  Integer, Intent(IN) :: ncid, varid
419  Real(RK8), Intent(OUT) :: dvals(*)
420 
421  Integer :: status
422 
423  Integer(C_INT) :: cncid, cvarid, cstatus
424 
425  cncid = ncid
426  cvarid = varid - 1 ! Subtract 1 to get C varid
427 
428  cstatus = nc_get_var_double(cncid, cvarid, dvals)
429 
430  status = cstatus
431 
432  End Function nf_get_var_double
integer function nf_put_var_int2(ncid, varid, i2vals)
Definition: nf_vario.F90:119
integer function nf_put_var_real(ncid, varid, rvals)
Definition: nf_vario.F90:182
integer function nf_put_var_text(ncid, varid, text)
Definition: nf_vario.F90:34
integer function nf_put_var_int1(ncid, varid, i1vals)
Definition: nf_vario.F90:82
integer function nf_put_var_int(ncid, varid, ivals)
Definition: nf_vario.F90:154
integer function nf_get_var_int2(ncid, varid, i2vals)
Definition: nf_vario.F90:320
integer function nf_get_var_text_a(ncid, varid, text)
Definition: nf_vario.F90:259
integer function nf_get_var_real(ncid, varid, rvals)
Definition: nf_vario.F90:383
integer function nf_get_var_double(ncid, varid, dvals)
Definition: nf_vario.F90:411
integer function nf_get_var_int(ncid, varid, ivals)
Definition: nf_vario.F90:355
integer function nf_get_var_text(ncid, varid, text)
Definition: nf_vario.F90:234
integer(c_int), parameter nc_ebadtype
integer function nf_get_var_int1(ncid, varid, i1vals)
Definition: nf_vario.F90:283
integer function nf_put_var_text_a(ncid, varid, text)
Definition: nf_vario.F90:58
integer function nf_put_var_double(ncid, varid, dvals)
Definition: nf_vario.F90:210

Return to the Main Unidata NetCDF page.
Generated on Thu Nov 9 2017 06:56:52 for NetCDF-Fortran. NetCDF is a Unidata library.