NetCDF-Fortran  4.4.3
nf_varsio.F90
1 #include "nfconfig.inc"
2 !-------- Array/string put/get routines given start, count, and stride -------
3 
4 ! Replacement for fort-varsio.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 ! Updated to pass start, counts, and strides as
28 ! C_PTR variables
29 ! Version 3.: April 2009 - Updated for netCDF 4.0.1
30 ! Version 4.: April 2010 - Updated for netCDF 4.1.1
31 ! Added preprocessor tests for int and real types
32 
33 !--------------------------------- nf_put_vars_text ----------------------
34  Function nf_put_vars_text(ncid, varid, start, counts, strides, text) &
35  result(status)
36 
37 ! Write out a character string given start, count, and stride
38 
39  USE netcdf_nc_interfaces
40 
41  Implicit NONE
42 
43  Integer, Intent(IN) :: ncid, varid
44  Integer, Intent(IN) :: start(*), counts(*), strides(*)
45  Character(LEN=*), Intent(IN) :: text
46 
47  Integer :: status
48 
49  Integer(KIND=C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
50  Integer(KIND=C_SIZE_T), TARGET :: cstart(nc_max_dims), ccounts(nc_max_dims)
51  Integer(KIND=C_PTRDIFF_T), TARGET :: cstrides(nc_max_dims)
52  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr
53  Integer :: ndims
54 
55  cncid = ncid
56  cvarid = varid - 1 ! Subtract 1 to get C varid
57  cstart = 0
58  ccounts = 0
59  cstrides = 1
60 
61  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
62 
63  cstartptr = c_null_ptr
64  ccountsptr = c_null_ptr
65  cstridesptr = c_null_ptr
66  ndims = cndims
67 
68  If (cstat1 == nc_noerr) Then
69  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
70  cstart(1:ndims) = start(ndims:1:-1)-1
71  ccounts(1:ndims) = counts(ndims:1:-1)
72  cstrides(1:ndims) = strides(ndims:1:-1)
73  EndIf
74  cstartptr = c_loc(cstart)
75  ccountsptr = c_loc(ccounts)
76  cstridesptr = c_loc(cstrides)
77  EndIf
78 
79  cstatus = nc_put_vars_text(cncid, cvarid, cstartptr, ccountsptr, &
80  cstridesptr, text)
81 
82  status = cstatus
83 
84  End Function nf_put_vars_text
85 !--------------------------------- nf_put_vars_text_a ----------------------
86  Function nf_put_vars_text_a(ncid, varid, start, counts, strides, text) &
87  result(status)
88 
89 ! Write out array of characters given start, count, and stride
90 ! Special version for case where string is an array of characters
91 
92  USE netcdf_nc_interfaces
93 
94  Implicit NONE
95 
96  Integer, Intent(IN) :: ncid, varid
97  Integer, Intent(IN) :: start(*), counts(*), strides(*)
98  Character(LEN=1), Intent(IN) :: text(*)
99 
100  Integer :: status
101 
102  Integer(KIND=C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
103  Integer(KIND=C_SIZE_T), TARGET :: cstart(nc_max_dims), ccounts(nc_max_dims)
104  Integer(KIND=C_PTRDIFF_T), TARGET :: cstrides(nc_max_dims)
105  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr
106  Integer :: ndims
107 
108  cncid = ncid
109  cvarid = varid - 1 ! Subtract 1 to get C varid
110  cstart = 0
111  ccounts = 0
112  cstrides = 1
113 
114  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
115 
116  cstartptr = c_null_ptr
117  ccountsptr = c_null_ptr
118  cstridesptr = c_null_ptr
119  ndims = cndims
120 
121  If (cstat1 == nc_noerr) Then
122  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
123  cstart(1:ndims) = start(ndims:1:-1)-1
124  ccounts(1:ndims) = counts(ndims:1:-1)
125  cstrides(1:ndims) = strides(ndims:1:-1)
126  EndIf
127  cstartptr = c_loc(cstart)
128  ccountsptr = c_loc(ccounts)
129  cstridesptr = c_loc(cstrides)
130  EndIf
131 
132  cstatus = nc_put_vars_text(cncid, cvarid, cstartptr, ccountsptr, &
133  cstridesptr, text)
134  status = cstatus
135 
136  End Function nf_put_vars_text_a
137 !--------------------------------- nf_put_vars_int1 ------------------------
138  Function nf_put_vars_int1(ncid, varid, start, counts, strides, i1vals) &
139  result(status)
140 
141 ! Write out 8 bit integer array given start, count, and stride
142 
143  USE netcdf_nc_interfaces
144 
145  Implicit NONE
146 
147  Integer, Intent(IN) :: ncid, varid
148  Integer, Intent(IN) :: start(*), counts(*), strides(*)
149  Integer(KIND=NFINT1), Intent(IN) :: i1vals(*)
150 
151  Integer :: status
152 
153  Integer(KIND=C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
154  Integer(KIND=C_SIZE_T), TARGET :: cstart(nc_max_dims), ccounts(nc_max_dims)
155  Integer(KIND=C_PTRDIFF_T), TARGET :: cstrides(nc_max_dims)
156  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr
157  Integer :: ndims
158 
159  If (c_signed_char < 0) Then ! schar not supported by processor
160  status = nc_ebadtype
161  RETURN
162  EndIf
163 
164  cncid = ncid
165  cvarid = varid - 1 ! Subtract 1 to get C varid
166  cstart = 0
167  ccounts = 0
168  cstrides = 1
169 
170  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
171 
172  cstartptr = c_null_ptr
173  ccountsptr = c_null_ptr
174  cstridesptr = c_null_ptr
175  ndims = cndims
176 
177  If (cstat1 == nc_noerr) Then
178  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
179  cstart(1:ndims) = start(ndims:1:-1)-1
180  ccounts(1:ndims) = counts(ndims:1:-1)
181  cstrides(1:ndims) = strides(ndims:1:-1)
182  EndIf
183  cstartptr = c_loc(cstart)
184  ccountsptr = c_loc(ccounts)
185  cstridesptr = c_loc(cstrides)
186  EndIf
187 
188 #if NF_INT1_IS_C_SIGNED_CHAR
189  cstatus = nc_put_vars_schar(cncid, cvarid, cstartptr, ccountsptr, &
190  cstridesptr, i1vals)
191 #elif NF_INT1_IS_C_SHORT
192  cstatus = nc_put_vars_short(cncid, cvarid, cstartptr, ccountsptr, &
193  cstridesptr, i1vals)
194 #elif NF_INT1_IS_C_INT
195  cstatus = nc_put_vars_int(cncid, cvarid, cstartptr, ccountsptr, &
196  cstridesptr, i1vals)
197 #elif NF_INT1_IS_C_LONG
198  cstatus = nc_put_vars_long(cncid, cvarid, cstartptr, ccountsptr, &
199  cstridesptr, i1vals)
200 #endif
201 
202  status = cstatus
203 
204  End Function nf_put_vars_int1
205 !--------------------------------- nf_put_vars_int2 ------------------------
206  Function nf_put_vars_int2(ncid, varid, start, counts, strides, i2vals) &
207  result(status)
208 
209 ! Write out 16 bit integer array given start, count, and stride
210 
211  USE netcdf_nc_interfaces
212 
213  Implicit NONE
214 
215  Integer, Intent(IN) :: ncid, varid
216  Integer, Intent(IN) :: start(*), counts(*), strides(*)
217  Integer(KIND=NFINT2), Intent(IN) :: i2vals(*)
218 
219  Integer :: status
220 
221  Integer(KIND=C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
222  Integer(KIND=C_SIZE_T), TARGET :: cstart(nc_max_dims), ccounts(nc_max_dims)
223  Integer(KIND=C_PTRDIFF_T), TARGET :: cstrides(nc_max_dims)
224  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr
225  Integer :: ndims
226 
227  If (c_short < 0) Then ! short not supported by processor
228  status = nc_ebadtype
229  RETURN
230  EndIf
231 
232  cncid = ncid
233  cvarid = varid - 1 ! Subtract 1 to get C varid
234  cstart = 0
235  ccounts = 0
236  cstrides = 1
237 
238  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
239 
240  cstartptr = c_null_ptr
241  ccountsptr = c_null_ptr
242  cstridesptr = c_null_ptr
243  ndims = cndims
244 
245  If (cstat1 == nc_noerr) Then
246  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
247  cstart(1:ndims) = start(ndims:1:-1)-1
248  ccounts(1:ndims) = counts(ndims:1:-1)
249  cstrides(1:ndims) = strides(ndims:1:-1)
250  EndIf
251  cstartptr = c_loc(cstart)
252  ccountsptr = c_loc(ccounts)
253  cstridesptr = c_loc(cstrides)
254  EndIf
255 
256 #if NF_INT2_IS_C_SHORT
257  cstatus = nc_put_vars_short(cncid, cvarid, cstartptr, ccountsptr, &
258  cstridesptr, i2vals)
259 #elif NF_INT2_IS_C_INT
260  cstatus = nc_put_vars_int(cncid, cvarid, cstartptr, ccountsptr, &
261  cstridesptr, i2vals)
262 #elif NF_INT2_IS_C_LONG
263  cstatus = nc_put_vars_long(cncid, cvarid, cstartptr, ccountsptr, &
264  cstridesptr, i2vals)
265 #endif
266 
267  status = cstatus
268 
269  End Function nf_put_vars_int2
270 !--------------------------------- nf_put_vars_int -------------------------
271  Function nf_put_vars_int(ncid, varid, start, counts, strides, ivals) &
272  result(status)
273 
274 ! Write out default integer array given start, count, and stride
275 
276  USE netcdf_nc_interfaces
277 
278  Implicit NONE
279 
280  Integer, Intent(IN) :: ncid, varid
281  Integer, Intent(IN) :: start(*), counts(*), strides(*)
282  Integer(NFINT), Intent(IN) :: ivals(*)
283 
284  Integer :: status
285 
286  Integer(KIND=C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
287  Integer(KIND=C_SIZE_T), TARGET :: cstart(nc_max_dims), ccounts(nc_max_dims)
288  Integer(KIND=C_PTRDIFF_T), TARGET :: cstrides(nc_max_dims)
289  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr
290  Integer :: ndims
291 
292  cncid = ncid
293  cvarid = varid - 1 ! Subtract 1 to get C varid
294  cstart = 0
295  ccounts = 0
296  cstrides = 1
297 
298  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
299 
300  cstartptr = c_null_ptr
301  ccountsptr = c_null_ptr
302  cstridesptr = c_null_ptr
303  ndims = cndims
304 
305  If (cstat1 == nc_noerr) Then
306  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
307  cstart(1:ndims) = start(ndims:1:-1)-1
308  ccounts(1:ndims) = counts(ndims:1:-1)
309  cstrides(1:ndims) = strides(ndims:1:-1)
310  EndIf
311  cstartptr = c_loc(cstart)
312  ccountsptr = c_loc(ccounts)
313  cstridesptr = c_loc(cstrides)
314  EndIf
315 
316 #if NF_INT_IS_C_INT
317  cstatus = nc_put_vars_int(cncid, cvarid, cstartptr, ccountsptr, &
318  cstridesptr, ivals)
319 #elif NF_INT_IS_C_LONG
320  cstatus = nc_put_vars_long(cncid, cvarid, cstartptr, ccountsptr, &
321  cstridesptr, ivals)
322 #endif
323 
324  status = cstatus
325 
326  End Function nf_put_vars_int
327 !--------------------------------- nf_put_vars_real ------------------------
328  Function nf_put_vars_real(ncid, varid, start, counts, strides, rvals) &
329  result(status)
330 
331 ! Write out 32 bit real array given start, count, and stride
332 
333  USE netcdf_nc_interfaces
334 
335  Implicit NONE
336 
337  Integer, Intent(IN) :: ncid, varid
338  Integer, Intent(IN) :: start(*), counts(*), strides(*)
339  Real(NFREAL), Intent(IN) :: rvals(*)
340 
341  Integer :: status
342 
343  Integer(KIND=C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
344  Integer(KIND=C_SIZE_T), TARGET :: cstart(nc_max_dims), ccounts(nc_max_dims)
345  Integer(KIND=C_PTRDIFF_T), TARGET :: cstrides(nc_max_dims)
346  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr
347  Integer :: ndims
348 
349  cncid = ncid
350  cvarid = varid - 1 ! Subtract 1 to get C varid
351  cstart = 0
352  ccounts = 0
353  cstrides = 1
354 
355  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
356 
357  cstartptr = c_null_ptr
358  ccountsptr = c_null_ptr
359  cstridesptr = c_null_ptr
360  ndims = cndims
361 
362  If (cstat1 == nc_noerr) Then
363  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
364  cstart(1:ndims) = start(ndims:1:-1)-1
365  ccounts(1:ndims) = counts(ndims:1:-1)
366  cstrides(1:ndims) = strides(ndims:1:-1)
367  EndIf
368  cstartptr = c_loc(cstart)
369  ccountsptr = c_loc(ccounts)
370  cstridesptr = c_loc(cstrides)
371  EndIf
372 
373 #if NF_REAL_IS_C_DOUBLE
374  cstatus = nc_put_vars_double(cncid, cvarid, cstartptr, ccountsptr, &
375  cstridesptr, rvals)
376 #else
377  cstatus = nc_put_vars_float(cncid, cvarid, cstartptr, ccountsptr, &
378  cstridesptr, rvals)
379 #endif
380 
381  status = cstatus
382 
383  End Function nf_put_vars_real
384 !--------------------------------- nf_put_vars_double ----------------------
385  Function nf_put_vars_double(ncid, varid, start, counts, strides, dvals) &
386  result(status)
387 
388 ! Write out 64 bit real array given start, count, and stride
389 
390  USE netcdf_nc_interfaces
391 
392  Implicit NONE
393 
394  Integer, Intent(IN) :: ncid, varid
395  Integer, Intent(IN) :: start(*), counts(*), strides(*)
396  Real(RK8), Intent(IN) :: dvals(*)
397 
398  Integer :: status
399 
400  Integer(KIND=C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
401  Integer(KIND=C_SIZE_T), TARGET :: cstart(nc_max_dims), ccounts(nc_max_dims)
402  Integer(KIND=C_PTRDIFF_T), TARGET :: cstrides(nc_max_dims)
403  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr
404  Integer :: ndims
405 
406  cncid = ncid
407  cvarid = varid - 1 ! Subtract 1 to get C varid
408  cstart = 0
409  ccounts = 0
410  cstrides = 1
411 
412  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
413 
414  cstartptr = c_null_ptr
415  ccountsptr = c_null_ptr
416  cstridesptr = c_null_ptr
417  ndims = cndims
418 
419  If (cstat1 == nc_noerr) Then
420  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
421  cstart(1:ndims) = start(ndims:1:-1)-1
422  ccounts(1:ndims) = counts(ndims:1:-1)
423  cstrides(1:ndims) = strides(ndims:1:-1)
424  EndIf
425  cstartptr = c_loc(cstart)
426  ccountsptr = c_loc(ccounts)
427  cstridesptr = c_loc(cstrides)
428  EndIf
429 
430  cstatus = nc_put_vars_double(cncid, cvarid, cstartptr, ccountsptr, &
431  cstridesptr, dvals)
432 
433  status = cstatus
434 
435  End Function nf_put_vars_double
436 !--------------------------------- nf_put_vars -----------------------------
437  Function nf_put_vars(ncid, varid, start, counts, strides, values) &
438  result(status)
439 
440 ! Write out a variable of any type. We use a C interop character string to
441 ! hold the values. Therefore, an explicit interface to nf_put_vars should NOT
442 ! be used in the calling program. Just use external
443 
444  USE netcdf_nc_interfaces
445 
446  Implicit NONE
447 
448  Integer, Intent(IN) :: ncid, varid
449  Integer, Intent(IN) :: start(*), counts(*), strides(*)
450  Character(KIND=C_CHAR), Intent(IN), TARGET :: values(*)
451 ! Type(C_PTR), VALUE :: values
452  Integer :: status
453 
454  Integer(KIND=C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
455  Integer(KIND=C_SIZE_T), TARGET :: cstart(nc_max_dims), ccounts(nc_max_dims)
456  Integer(KIND=C_PTRDIFF_T), TARGET :: cstrides(nc_max_dims)
457  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr, &
458  cvaluesptr
459 ! Type(C_PTR) :: cstartptr, ccountsptr, cstridesptr
460  Integer :: ndims
461 
462  cncid = ncid
463  cvarid = varid - 1 ! Subtract 1 to get C varid
464  cstart = 0
465  ccounts = 0
466  cstrides = 1
467 
468  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
469 
470  cstartptr = c_null_ptr
471  ccountsptr = c_null_ptr
472  cstridesptr = c_null_ptr
473  ndims = cndims
474 
475  If (cstat1 == nc_noerr) Then
476  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
477  cstart(1:ndims) = start(ndims:1:-1)-1
478  ccounts(1:ndims) = counts(ndims:1:-1)
479  cstrides(1:ndims) = strides(ndims:1:-1)
480  EndIf
481  cstartptr = c_loc(cstart)
482  ccountsptr = c_loc(ccounts)
483  cstridesptr = c_loc(cstrides)
484  EndIf
485 
486  cvaluesptr = c_loc(values)
487 
488  cstatus = nc_put_vars(cncid, cvarid, cstartptr, ccountsptr, &
489  cstridesptr, cvaluesptr)
490 ! cstatus = nc_put_vars(cncid, cvarid, cstartptr, ccountsptr, &
491 ! cstridesptr, values)
492 
493  status = cstatus
494 
495  End Function nf_put_vars
496 !--------------------------------- nf_get_vars_text ----------------------
497  Function nf_get_vars_text(ncid, varid, start, counts, strides, text) &
498  result(status)
499 
500 ! Read in a character string from dataset
501 
502  USE netcdf_nc_interfaces
503 
504  Implicit NONE
505 
506  Integer, Intent(IN) :: ncid, varid
507  Integer, Intent(IN) :: start(*), counts(*), strides(*)
508  Character(LEN=*), Intent(OUT) :: text
509 
510  Integer :: status
511 
512  Integer(KIND=C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
513  Integer(KIND=C_SIZE_T), TARGET :: cstart(nc_max_dims), ccounts(nc_max_dims)
514  Integer(KIND=C_PTRDIFF_T), TARGET :: cstrides(nc_max_dims)
515  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr
516  Integer :: ndims
517 
518  cncid = ncid
519  cvarid = varid - 1 ! Subtract 1 to get C varid
520  cstart = 0
521  ccounts = 0
522  cstrides = 1
523  text = repeat(" ", len(text))
524 
525  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
526 
527  cstartptr = c_null_ptr
528  ccountsptr = c_null_ptr
529  cstridesptr = c_null_ptr
530  ndims = cndims
531 
532  If (cstat1 == nc_noerr) Then
533  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
534  cstart(1:ndims) = start(ndims:1:-1)-1
535  ccounts(1:ndims) = counts(ndims:1:-1)
536  cstrides(1:ndims) = strides(ndims:1:-1)
537  EndIf
538  cstartptr = c_loc(cstart)
539  ccountsptr = c_loc(ccounts)
540  cstridesptr = c_loc(cstrides)
541  EndIf
542 
543  cstatus = nc_get_vars_text(cncid, cvarid, cstartptr, ccountsptr, &
544  cstridesptr, text)
545 
546  status = cstatus
547 
548  End Function nf_get_vars_text
549 !--------------------------------- nf_get_vars_text_a ----------------------
550  Function nf_get_vars_text_a(ncid, varid, start, counts, strides, text) &
551  result(status)
552 
553 ! Read in an array of characters given start, count, and stride
554 
555  USE netcdf_nc_interfaces
556 
557  Implicit NONE
558 
559  Integer, Intent(IN) :: ncid, varid
560  Integer, Intent(IN) :: start(*), counts(*), strides(*)
561  Character(LEN=1), Intent(OUT) :: text(*)
562 
563  Integer :: status
564 
565  Integer(KIND=C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
566  Integer(KIND=C_SIZE_T), TARGET :: cstart(nc_max_dims), ccounts(nc_max_dims)
567  Integer(KIND=C_PTRDIFF_T), TARGET :: cstrides(nc_max_dims)
568  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr
569  Integer :: ndims
570 
571  cncid = ncid
572  cvarid = varid - 1 ! Subtract 1 to get C varid
573  cstart = 0
574  ccounts = 0
575  cstrides = 1
576 
577  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
578 
579  cstartptr = c_null_ptr
580  ccountsptr = c_null_ptr
581  cstridesptr = c_null_ptr
582  ndims = cndims
583 
584  If (cstat1 == nc_noerr) Then
585  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
586  cstart(1:ndims) = start(ndims:1:-1)-1
587  ccounts(1:ndims) = counts(ndims:1:-1)
588  cstrides(1:ndims) = strides(ndims:1:-1)
589  EndIf
590 
591  cstartptr = c_loc(cstart)
592  ccountsptr = c_loc(ccounts)
593  cstridesptr = c_loc(cstrides)
594  EndIf
595 
596  cstatus = nc_get_vars_text(cncid, cvarid, cstartptr, ccountsptr, &
597  cstridesptr, text)
598 
599  status = cstatus
600 
601  End Function nf_get_vars_text_a
602 !--------------------------------- nf_get_vars_int1 ------------------------
603  Function nf_get_vars_int1(ncid, varid, start, counts, strides, i1vals) &
604  result(status)
605 
606 ! Read in 8 bit integer array given start, count, and stride
607 
608  USE netcdf_nc_interfaces
609 
610  Implicit NONE
611 
612  Integer, Intent(IN) :: ncid, varid
613  Integer, Intent(IN) :: start(*), counts(*), strides(*)
614  Integer(KIND=NFINT1), Intent(OUT) :: i1vals(*)
615 
616  Integer :: status
617 
618  Integer(KIND=C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
619  Integer(KIND=C_SIZE_T), TARGET :: cstart(nc_max_dims), ccounts(nc_max_dims)
620  Integer(KIND=C_PTRDIFF_T), TARGET :: cstrides(nc_max_dims)
621  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr
622  Integer :: ndims
623 
624  If (c_signed_char < 0) Then ! schar not supported by processor
625  status = nc_ebadtype
626  RETURN
627  EndIf
628 
629  cncid = ncid
630  cvarid = varid - 1 ! Subtract 1 to get C varid
631  cstart = 0
632  ccounts = 0
633  cstrides = 1
634 
635  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
636 
637  cstartptr = c_null_ptr
638  ccountsptr = c_null_ptr
639  cstridesptr = c_null_ptr
640  ndims = cndims
641 
642  If (cstat1 == nc_noerr) Then
643  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
644  cstart(1:ndims) = start(ndims:1:-1)-1
645  ccounts(1:ndims) = counts(ndims:1:-1)
646  cstrides(1:ndims) = strides(ndims:1:-1)
647  EndIf
648  cstartptr = c_loc(cstart)
649  ccountsptr = c_loc(ccounts)
650  cstridesptr = c_loc(cstrides)
651  EndIf
652 
653 #if NF_INT1_IS_C_SIGNED_CHAR
654  cstatus = nc_get_vars_schar(cncid, cvarid, cstartptr, ccountsptr, &
655  cstridesptr, i1vals)
656 #elif NF_INT1_IS_C_SHORT
657  cstatus = nc_get_vars_short(cncid, cvarid, cstartptr, ccountsptr, &
658  cstridesptr, i1vals)
659 #elif NF_INT1_IS_C_INT
660  cstatus = nc_get_vars_int(cncid, cvarid, cstartptr, ccountsptr, &
661  cstridesptr, i1vals)
662 #elif NF_INT1_IS_C_LONG
663  cstatus = nc_get_vars_long(cncid, cvarid, cstartptr, ccountsptr, &
664  cstridesptr, i1vals)
665 #endif
666 
667  status = cstatus
668 
669  End Function nf_get_vars_int1
670 !--------------------------------- nf_get_vars_int2 ------------------------
671  Function nf_get_vars_int2(ncid, varid, start, counts, strides, i2vals) &
672  result(status)
673 
674 ! Read in 16 bit integer array given start, count, and stride
675 
676  USE netcdf_nc_interfaces
677 
678  Implicit NONE
679 
680  Integer, Intent(IN) :: ncid, varid
681  Integer, Intent(IN) :: start(*), counts(*), strides(*)
682  Integer(KIND=NFINT2), Intent(OUT) :: i2vals(*)
683 
684  Integer :: status
685 
686  Integer(KIND=C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
687  Integer(KIND=C_SIZE_T), TARGET :: cstart(nc_max_dims), ccounts(nc_max_dims)
688  Integer(KIND=C_PTRDIFF_T), TARGET :: cstrides(nc_max_dims)
689  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr
690  Integer :: ndims
691 
692  If (c_short < 0) Then ! short not supported by processor
693  status = nc_ebadtype
694  RETURN
695  EndIf
696 
697  cncid = ncid
698  cvarid = varid - 1 ! Subtract 1 to get C varid
699  cstart = 0
700  ccounts = 0
701  cstrides = 1
702 
703  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
704 
705  cstartptr = c_null_ptr
706  ccountsptr = c_null_ptr
707  cstridesptr = c_null_ptr
708  ndims = cndims
709 
710  If (cstat1 == nc_noerr) Then
711  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
712  cstart(1:ndims) = start(ndims:1:-1)-1
713  ccounts(1:ndims) = counts(ndims:1:-1)
714  cstrides(1:ndims) = strides(ndims:1:-1)
715  EndIf
716  cstartptr = c_loc(cstart)
717  ccountsptr = c_loc(ccounts)
718  cstridesptr = c_loc(cstrides)
719  EndIf
720 
721 #if NF_INT2_IS_C_SHORT
722  cstatus = nc_get_vars_short(cncid, cvarid, cstartptr, ccountsptr, &
723  cstridesptr, i2vals)
724 #elif NF_INT2_IS_C_INT
725  cstatus = nc_get_vars_int(cncid, cvarid, cstartptr, ccountsptr, &
726  cstridesptr, i2vals)
727 #elif NF_INT2_IS_C_LONG
728  cstatus = nc_get_vars_long(cncid, cvarid, cstartptr, ccountsptr, &
729  cstridesptr, i2vals)
730 #endif
731 
732  status = cstatus
733 
734  End Function nf_get_vars_int2
735 !--------------------------------- nf_get_vars_int -------------------------
736  Function nf_get_vars_int(ncid, varid, start, counts, strides, ivals) &
737  result(status)
738 
739 ! Read in default integer array given start, count, and stride
740 
741  USE netcdf_nc_interfaces
742 
743  Implicit NONE
744 
745  Integer, Intent(IN) :: ncid, varid
746  Integer, Intent(IN) :: start(*), counts(*), strides(*)
747  Integer(NFINT), Intent(OUT) :: ivals(*)
748 
749  Integer :: status
750 
751  Integer(KIND=C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
752  Integer(KIND=C_SIZE_T), TARGET :: cstart(nc_max_dims), ccounts(nc_max_dims)
753  Integer(KIND=C_PTRDIFF_T), TARGET :: cstrides(nc_max_dims)
754  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr
755  Integer :: ndims
756 
757  cncid = ncid
758  cvarid = varid - 1 ! Subtract 1 to get C varid
759  cstart = 0
760  ccounts = 0
761  cstrides = 1
762 
763  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
764 
765  cstartptr = c_null_ptr
766  ccountsptr = c_null_ptr
767  cstridesptr = c_null_ptr
768  ndims = cndims
769 
770  If (cstat1 == nc_noerr) Then
771  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
772  cstart(1:ndims) = start(ndims:1:-1)-1
773  ccounts(1:ndims) = counts(ndims:1:-1)
774  cstrides(1:ndims) = strides(ndims:1:-1)
775  EndIf
776  cstartptr = c_loc(cstart)
777  ccountsptr = c_loc(ccounts)
778  cstridesptr = c_loc(cstrides)
779  EndIf
780 
781 #if NF_INT_IS_C_INT
782  cstatus = nc_get_vars_int(cncid, cvarid, cstartptr, ccountsptr, &
783  cstridesptr, ivals)
784 #elif NF_INT_IS_C_LONG
785  cstatus = nc_get_vars_long(cncid, cvarid, cstartptr, ccountsptr, &
786  cstridesptr, ivals)
787 #endif
788 
789  status = cstatus
790 
791  End Function nf_get_vars_int
792 !--------------------------------- nf_get_vars_real ------------------------
793  Function nf_get_vars_real(ncid, varid, start, counts, strides, rvals) &
794  result(status)
795 
796 ! Read in 32 bit real array given start, count, and stride
797 
798  USE netcdf_nc_interfaces
799 
800  Implicit NONE
801 
802  Integer, Intent(IN) :: ncid, varid
803  Integer, Intent(IN) :: start(*), counts(*), strides(*)
804  Real(NFREAL), Intent(OUT) :: rvals(*)
805 
806  Integer :: status
807 
808  Integer(KIND=C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
809  Integer(KIND=C_SIZE_T), TARGET :: cstart(nc_max_dims), ccounts(nc_max_dims)
810  Integer(KIND=C_PTRDIFF_T), TARGET :: cstrides(nc_max_dims)
811  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr
812  Integer :: ndims
813 
814  cncid = ncid
815  cvarid = varid - 1 ! Subtract 1 to get C varid
816  cstart = 0
817  ccounts = 0
818  cstrides = 1
819 
820  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
821 
822  cstartptr = c_null_ptr
823  ccountsptr = c_null_ptr
824  cstridesptr = c_null_ptr
825  ndims = cndims
826 
827  If (cstat1 == nc_noerr) Then
828  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
829  cstart(1:ndims) = start(ndims:1:-1)-1
830  ccounts(1:ndims) = counts(ndims:1:-1)
831  cstrides(1:ndims) = strides(ndims:1:-1)
832  EndIf
833  cstartptr = c_loc(cstart)
834  ccountsptr = c_loc(ccounts)
835  cstridesptr = c_loc(cstrides)
836  EndIf
837 
838 #if NF_REAL_IS_C_DOUBLE
839  cstatus = nc_get_vars_double(cncid, cvarid, cstartptr, ccountsptr, &
840  cstridesptr, rvals)
841 #else
842  cstatus = nc_get_vars_float(cncid, cvarid, cstartptr, ccountsptr, &
843  cstridesptr, rvals)
844 #endif
845 
846  status = cstatus
847 
848  End Function nf_get_vars_real
849 !--------------------------------- nf_get_vars_double ----------------------
850  Function nf_get_vars_double(ncid, varid, start, counts, strides, dvals) &
851  result(status)
852 
853 ! Read in 64 bit real array given start, count, and stride
854 
855  USE netcdf_nc_interfaces
856 
857  Implicit NONE
858 
859  Integer, Intent(IN) :: ncid, varid
860  Integer, Intent(IN) :: start(*), counts(*), strides(*)
861  Real(RK8), Intent(OUT) :: dvals(*)
862 
863  Integer :: status
864 
865  Integer(KIND=C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
866  Integer(KIND=C_SIZE_T), TARGET :: cstart(nc_max_dims), ccounts(nc_max_dims)
867  Integer(KIND=C_PTRDIFF_T), TARGET :: cstrides(nc_max_dims)
868  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr
869  Integer :: ndims
870 
871  cncid = ncid
872  cvarid = varid - 1 ! Subtract 1 to get C varid
873  cstart = 0
874  ccounts = 0
875  cstrides = 1
876 
877  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
878 
879  cstartptr = c_null_ptr
880  ccountsptr = c_null_ptr
881  cstridesptr = c_null_ptr
882  ndims = cndims
883 
884  If (cstat1 == nc_noerr) Then
885  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
886  cstart(1:ndims) = start(ndims:1:-1)-1
887  ccounts(1:ndims) = counts(ndims:1:-1)
888  cstrides(1:ndims) = strides(ndims:1:-1)
889  EndIf
890  cstartptr = c_loc(cstart)
891  ccountsptr = c_loc(ccounts)
892  cstridesptr = c_loc(cstrides)
893  EndIf
894 
895  cstatus = nc_get_vars_double(cncid, cvarid, cstartptr, ccountsptr, &
896  cstridesptr, dvals)
897 
898  status = cstatus
899 
900  End Function nf_get_vars_double
901 !--------------------------------- nf_get_vars ----------------------------
902  Function nf_get_vars(ncid, varid, start, counts, strides, values) &
903  result(status)
904 
905 ! Read in a variable of any type. We use a C interop character string to
906 ! hold the values. Therefore, an explicit interface to nf_put_vars should NOT
907 ! be used in the calling program. Just use external
908 
909  USE netcdf_nc_interfaces
910 
911  Implicit NONE
912 
913  Integer, Intent(IN) :: ncid, varid
914  Integer, Intent(IN) :: start(*), counts(*), strides(*)
915  Character(KIND=C_CHAR), Intent(INOUT) :: values
916 ! Type(C_PTR) VALUE :: values
917 
918  Integer :: status
919 
920  Integer(KIND=C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
921  Integer(KIND=C_SIZE_T), TARGET :: cstart(nc_max_dims), ccounts(nc_max_dims)
922  Integer(KIND=C_PTRDIFF_T), TARGET :: cstrides(nc_max_dims)
923  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr
924  Integer :: ndims
925 
926  cncid = ncid
927  cvarid = varid - 1 ! Subtract 1 to get C varid
928  cstart = 0
929  ccounts = 0
930  cstrides = 1
931 
932  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
933 
934  cstartptr = c_null_ptr
935  ccountsptr = c_null_ptr
936  cstridesptr = c_null_ptr
937  ndims = cndims
938 
939  If (cstat1 == nc_noerr) Then
940  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
941  cstart(1:ndims) = start(ndims:1:-1)-1
942  ccounts(1:ndims) = counts(ndims:1:-1)
943  cstrides(1:ndims) = strides(ndims:1:-1)
944  EndIf
945  cstartptr = c_loc(cstart)
946  ccountsptr = c_loc(ccounts)
947  cstridesptr = c_loc(cstrides)
948  EndIf
949 
950  cstatus = nc_get_vars(cncid, cvarid, cstartptr, ccountsptr, &
951  cstridesptr, values)
952 
953  status = cstatus
954 
955  End Function nf_get_vars

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