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

Return to the Main Unidata NetCDF page.
Generated on Wed Aug 19 2015 17:51:09 for NetCDF-Fortran. NetCDF is a Unidata library.