1!------------ Array/string put/get routines for a given varid ----------------
2
3! Replacement for fort-vario.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!                          Added preprocessor tests for int and real types
29! Version 5.: Jan.  2016 - Some minor code cleanup
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(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(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(NFINT1), Intent(IN) :: i1vals(*)
90
91 Integer                     :: status
92
93 Integer(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(NFINT2), Intent(IN) :: i2vals(*)
127
128 Integer                     :: status
129
130 Integer(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(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
191 Integer                     :: status
192
193 Integer(C_INT) :: cncid, cvarid,  cstatus
194
195 cncid  = ncid
196 cvarid = varid - 1 ! Subtract 1 to get C varid
197
198#if NF_REAL_IS_C_DOUBLE
199 cstatus = nc_put_var_double(cncid, cvarid, rvals)
200#else
201 cstatus = nc_put_var_float(cncid, cvarid, rvals)
202#endif
203
204 status = cstatus
205
206 End Function nf_put_var_real
207!--------------------------------- nf_put_var_double -----------------------
208 Function nf_put_var_double(ncid, varid, dvals) RESULT(status)
209
210! Write out 64 bit real array to dataset
211
212 USE netcdf_nc_interfaces
213
214 Implicit NONE
215
216 Integer,   Intent(IN) :: ncid, varid
217 Real(RK8), Intent(IN) :: dvals(*)
218
219 Integer               :: status
220
221 Integer(C_INT) :: cncid, cvarid,  cstatus
222
223 cncid  = ncid
224 cvarid = varid - 1 ! Subtract 1 to get C varid
225
226 cstatus = nc_put_var_double(cncid, cvarid, dvals)
227
228 status = cstatus
229
230 End Function nf_put_var_double
231!--------------------------------- nf_put_var_int64 --------------------------
232 Function nf_put_var_int64(ncid, varid, ivals) RESULT(status)
233
234! Write out 64 bit integer array to dataset
235
236 USE netcdf_nc_interfaces
237
238 Implicit NONE
239
240 Integer,      Intent(IN) :: ncid, varid
241 Integer(IK8), Intent(IN) :: ivals(*)
242
243 Integer                       :: status
244
245 Integer(C_INT) :: cncid, cvarid,  cstatus
246
247 cncid  = ncid
248 cvarid = varid - 1 ! Subtract 1 to get C varid
249
250 cstatus = nc_put_var_longlong(cncid, cvarid, ivals)
251
252 status = cstatus
253
254 End Function nf_put_var_int64
255!--------------------------------- nf_get_var_text -----------------------
256 Function nf_get_var_text(ncid, varid, text) RESULT(status)
257
258! Read in a character string from dataset
259
260 USE netcdf_nc_interfaces
261
262 Implicit NONE
263
264 Integer,          Intent(IN)  :: ncid, varid
265 Character(LEN=*), Intent(OUT) :: text
266
267 Integer                       :: status
268
269 Integer(C_INT) :: cncid, cvarid,  cstatus
270
271 cncid  = ncid
272 cvarid = varid - 1 ! Subtract 1 to get C varid
273 text   = REPEAT(" ", LEN(text))
274
275 cstatus = nc_get_var_text(cncid, cvarid, text)
276
277 status = cstatus
278
279 End Function nf_get_var_text
280!--------------------------------- nf_get_var_text_a -----------------------
281 Function nf_get_var_text_a(ncid, varid, text) RESULT(status)
282
283! Read in array of characters from dataset
284
285 USE netcdf_nc_interfaces
286
287 Implicit NONE
288
289 Integer,          Intent(IN)  :: ncid, varid
290 Character(LEN=1), Intent(OUT) :: text(*)
291
292 Integer                       :: status
293
294 Integer(C_INT) :: cncid, cvarid,  cstatus
295
296 cncid  = ncid
297 cvarid = varid - 1 ! Subtract 1 to get C varid
298
299 cstatus = nc_get_var_text(cncid, cvarid, text)
300
301 status = cstatus
302
303 End Function nf_get_var_text_a
304!--------------------------------- nf_get_var_int1 -------------------------
305 Function nf_get_var_int1(ncid, varid, i1vals) RESULT(status)
306
307! Read in 8 bit integer array from dataset
308
309 USE netcdf_nc_interfaces
310
311 Implicit NONE
312
313 Integer,         Intent(IN)  :: ncid, varid
314 Integer(NFINT1), Intent(OUT) :: i1vals(*)
315
316 Integer                      :: status
317
318 Integer(C_INT) :: cncid, cvarid,  cstatus
319
320 If (C_SIGNED_CHAR < 0) Then ! schar not supported by processor
321   status = NC_EBADTYPE
322   RETURN
323 EndIf
324
325 cncid  = ncid
326 cvarid = varid - 1 ! Subtract 1 to get C varid
327
328#if NF_INT1_IS_C_SIGNED_CHAR
329 cstatus = nc_get_var_schar(cncid, cvarid, i1vals)
330#elif NF_INT1_IS_C_SHORT
331 cstatus = nc_get_var_short(cncid, cvarid, i1vals)
332#elif NF_INT1_IS_C_INT
333 cstatus = nc_get_var_int(cncid, cvarid, i1vals)
334#elif NF_INT1_IS_C_LONG
335 cstatus = nc_get_var_long(cncid, cvarid, i1vals)
336#endif
337
338 status = cstatus
339
340 End Function nf_get_var_int1
341!--------------------------------- nf_get_var_int2 -------------------------
342 Function nf_get_var_int2(ncid, varid, i2vals) RESULT(status)
343
344! Read in 16 bit integer array from dataset
345
346 USE netcdf_nc_interfaces
347
348 Implicit NONE
349
350 Integer,         Intent(IN)  :: ncid, varid
351 Integer(NFINT2), Intent(OUT) :: i2vals(*)
352
353 Integer                      :: status
354
355 Integer(C_INT) :: cncid, cvarid,  cstatus
356
357 If (C_SHORT < 0) Then ! short not supported by processor
358   status = NC_EBADTYPE
359   RETURN
360 EndIf
361
362 cncid  = ncid
363 cvarid = varid - 1 ! Subtract 1 to get C varid
364
365#if NF_INT2_IS_C_SHORT
366 cstatus = nc_get_var_short(cncid, cvarid, i2vals)
367#elif NF_INT2_IS_C_INT
368 cstatus = nc_get_var_int(cncid, cvarid, i2vals)
369#elif NF_INT2_IS_C_LONG
370 cstatus = nc_get_var_long(cncid, cvarid, i2vals)
371#endif
372
373 status = cstatus
374
375 End Function nf_get_var_int2
376!--------------------------------- nf_get_var_int --------------------------
377 Function nf_get_var_int(ncid, varid, ivals) RESULT(status)
378
379! Read in default integer array from dataset
380
381 USE netcdf_nc_interfaces
382
383 Implicit NONE
384
385 Integer,        Intent(IN)  :: ncid, varid
386 Integer(NFINT), Intent(OUT) :: ivals(*)
387
388 Integer                     :: status
389
390 Integer(C_INT) :: cncid, cvarid,  cstatus
391
392 cncid  = ncid
393 cvarid = varid - 1 ! Subtract 1 to get C varid
394
395#if NF_INT_IS_C_INT
396 cstatus = nc_get_var_int(cncid, cvarid, ivals)
397#elif NF_INT_IS_C_LONG
398 cstatus = nc_get_var_long(cncid, cvarid, ivals)
399#endif
400
401 status = cstatus
402
403 End Function nf_get_var_int
404!--------------------------------- nf_get_var_real -------------------------
405 Function nf_get_var_real(ncid, varid, rvals) RESULT(status)
406
407! Read in 32 bit real array from dataset
408
409 USE netcdf_nc_interfaces
410
411 Implicit NONE
412
413 Integer,      Intent(IN)  :: ncid, varid
414 Real(NFREAL), Intent(OUT) :: rvals(*)
415
416 Integer                   :: status
417
418 Integer(C_INT) :: cncid, cvarid,  cstatus
419
420 cncid  = ncid
421 cvarid = varid - 1 ! Subtract 1 to get C varid
422
423#if NF_REAL_IS_C_DOUBLE
424 cstatus = nc_get_var_double(cncid, cvarid, rvals)
425#else
426 cstatus = nc_get_var_float(cncid, cvarid, rvals)
427#endif
428
429 status = cstatus
430
431 End Function nf_get_var_real
432!--------------------------------- nf_get_var_double -----------------------
433 Function nf_get_var_double(ncid, varid, dvals) RESULT(status)
434
435! Read in 64 bit real array from dataset
436
437 USE netcdf_nc_interfaces
438
439 Implicit NONE
440
441 Integer,   Intent(IN)  :: ncid, varid
442 Real(RK8), Intent(OUT) :: dvals(*)
443
444 Integer                :: status
445
446 Integer(C_INT) :: cncid, cvarid, cstatus
447
448 cncid  = ncid
449 cvarid = varid - 1 ! Subtract 1 to get C varid
450
451 cstatus = nc_get_var_double(cncid, cvarid, dvals)
452
453 status = cstatus
454
455 End Function nf_get_var_double
456!--------------------------------- nf_get_var_int64 --------------------------
457 Function nf_get_var_int64(ncid, varid, ivals) RESULT(status)
458
459! Read in 64 bit integer array from dataset
460
461 USE netcdf_nc_interfaces
462
463 Implicit NONE
464
465 Integer,      Intent(IN)  :: ncid, varid
466 Integer(IK8), Intent(OUT) :: ivals(*)
467
468 Integer                   :: status
469
470 Integer(C_INT) :: cncid, cvarid,  cstatus
471
472 cncid  = ncid
473 cvarid = varid - 1 ! Subtract 1 to get C varid
474
475 cstatus = nc_get_var_longlong(cncid, cvarid, ivals)
476
477 status = cstatus
478
479 End Function nf_get_var_int64
480