NetCDF-Fortran  4.4.4
nf_varsio.F90
Go to the documentation of this file.
1 #include "nfconfig.inc"
2 
3 !-------- Array/string put/get routines given start, count, and stride -------
4 
5 ! Replacement for fort-varsio.c
6 
7 ! Written by: Richard Weed, Ph.D.
8 ! Center for Advanced Vehicular Systems
9 ! Mississippi State University
10 ! rweed@cavs.msstate.edu
11 
12 
13 ! License (and other Lawyer Language)
14 
15 ! This software is released under the Apache 2.0 Open Source License. The
16 ! full text of the License can be viewed at :
17 !
18 ! http:www.apache.org/licenses/LICENSE-2.0.html
19 !
20 ! The author grants to the University Corporation for Atmospheric Research
21 ! (UCAR), Boulder, CO, USA the right to revise and extend the software
22 ! without restriction. However, the author retains all copyrights and
23 ! intellectual property rights explicitly stated in or implied by the
24 ! Apache license
25 
26 ! Version 1.: Sept 2005 - Initial Cray X1 version
27 ! Version 2.: May 2006 - Updated to support g95
28 ! Updated to pass start, counts, and strides as
29 ! C_PTR variables
30 ! Version 3.: April 2009 - Updated for netCDF 4.0.1
31 ! Version 4.: April 2010 - Updated for netCDF 4.1.1
32 ! Added preprocessor tests for int and real types
33 ! Version 5.: Jan. 2016 - Replaced automatic arrays for starts, counts,
34 ! and strides with allocatable arrays and general
35 ! text cleanup
36 
37 !--------------------------------- nf_put_vars_text ----------------------
38  Function nf_put_vars_text(ncid, varid, start, counts, strides, text) &
39  result(status)
40 
41 ! Write out a character string given start, count, and stride
42 
44 
45  Implicit NONE
46 
47  Integer, Intent(IN) :: ncid, varid
48  Integer, Intent(IN) :: start(*), counts(*), strides(*)
49  Character(LEN=*), Intent(IN) :: text
50 
51  Integer :: status
52 
53  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
54  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr
55  Integer :: ndims
56 
57  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cstart(:), ccounts(:)
58  Integer(C_PTRDIFF_T), ALLOCATABLE, TARGET :: cstrides(:)
59 
60  cncid = ncid
61  cvarid = varid - 1 ! Subtract 1 to get C varid
62 
63  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
64 
65  cstartptr = c_null_ptr
66  ccountsptr = c_null_ptr
67  cstridesptr = c_null_ptr
68  ndims = cndims
69 
70  If (cstat1 == nc_noerr) Then
71  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
72  ALLOCATE(cstart(ndims))
73  ALLOCATE(ccounts(ndims))
74  ALLOCATE(cstrides(ndims))
75  cstart(1:ndims) = start(ndims:1:-1) - 1
76  ccounts(1:ndims) = counts(ndims:1:-1)
77  cstrides(1:ndims) = strides(ndims:1:-1)
78  cstartptr = c_loc(cstart)
79  ccountsptr = c_loc(ccounts)
80  cstridesptr = c_loc(cstrides)
81  EndIf
82  EndIf
83 
84  cstatus = nc_put_vars_text(cncid, cvarid, cstartptr, ccountsptr, &
85  cstridesptr, text)
86 
87  status = cstatus
88 
89  End Function nf_put_vars_text
90 !--------------------------------- nf_put_vars_text_a ----------------------
91  Function nf_put_vars_text_a(ncid, varid, start, counts, strides, text) &
92  result(status)
93 
94 ! Write out array of characters given start, count, and stride
95 ! Special version for case where string is an array of characters
96 
98 
99  Implicit NONE
100 
101  Integer, Intent(IN) :: ncid, varid
102  Integer, Intent(IN) :: start(*), counts(*), strides(*)
103  Character(LEN=1), Intent(IN) :: text(*)
104 
105  Integer :: status
106 
107  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
108  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr
109  Integer :: ndims
110 
111  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cstart(:), ccounts(:)
112  Integer(C_PTRDIFF_T), ALLOCATABLE, TARGET :: cstrides(:)
113 
114  cncid = ncid
115  cvarid = varid - 1 ! Subtract 1 to get C varid
116 
117  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
118 
119  cstartptr = c_null_ptr
120  ccountsptr = c_null_ptr
121  cstridesptr = c_null_ptr
122  ndims = cndims
123 
124  If (cstat1 == nc_noerr) Then
125  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
126  ALLOCATE(cstart(ndims))
127  ALLOCATE(ccounts(ndims))
128  ALLOCATE(cstrides(ndims))
129  cstart(1:ndims) = start(ndims:1:-1) - 1
130  ccounts(1:ndims) = counts(ndims:1:-1)
131  cstrides(1:ndims) = strides(ndims:1:-1)
132  cstartptr = c_loc(cstart)
133  ccountsptr = c_loc(ccounts)
134  cstridesptr = c_loc(cstrides)
135  EndIf
136  EndIf
137 
138  cstatus = nc_put_vars_text(cncid, cvarid, cstartptr, ccountsptr, &
139  cstridesptr, text)
140  status = cstatus
141 
142  End Function nf_put_vars_text_a
143 !--------------------------------- nf_put_vars_int1 ------------------------
144  Function nf_put_vars_int1(ncid, varid, start, counts, strides, i1vals) &
145  result(status)
146 
147 ! Write out 8 bit integer array given start, count, and stride
148 
151  Implicit NONE
152 
153  Integer, Intent(IN) :: ncid, varid
154  Integer, Intent(IN) :: start(*), counts(*), strides(*)
155  Integer(NFINT1), Intent(IN) :: i1vals(*)
156 
157  Integer :: status
158 
159  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
160  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr
161  Integer :: ndims
162 
163  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cstart(:), ccounts(:)
164  Integer(C_PTRDIFF_T), ALLOCATABLE, TARGET :: cstrides(:)
165 
166  If (c_signed_char < 0) Then ! schar not supported by processor
167  status = nc_ebadtype
168  RETURN
169  EndIf
170 
171  cncid = ncid
172  cvarid = varid - 1 ! Subtract 1 to get C varid
173 
174  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
175 
176  cstartptr = c_null_ptr
177  ccountsptr = c_null_ptr
178  cstridesptr = c_null_ptr
179  ndims = cndims
180 
181  If (cstat1 == nc_noerr) Then
182  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
183  ALLOCATE(cstart(ndims))
184  ALLOCATE(ccounts(ndims))
185  ALLOCATE(cstrides(ndims))
186  cstart(1:ndims) = start(ndims:1:-1) - 1
187  ccounts(1:ndims) = counts(ndims:1:-1)
188  cstrides(1:ndims) = strides(ndims:1:-1)
189  cstartptr = c_loc(cstart)
190  ccountsptr = c_loc(ccounts)
191  cstridesptr = c_loc(cstrides)
192  EndIf
193  EndIf
194 
195 #if NF_INT1_IS_C_SIGNED_CHAR
196  cstatus = nc_put_vars_schar(cncid, cvarid, cstartptr, ccountsptr, &
197  cstridesptr, i1vals)
198 #elif NF_INT1_IS_C_SHORT
199  cstatus = nc_put_vars_short(cncid, cvarid, cstartptr, ccountsptr, &
200  cstridesptr, i1vals)
201 #elif NF_INT1_IS_C_INT
202  cstatus = nc_put_vars_int(cncid, cvarid, cstartptr, ccountsptr, &
203  cstridesptr, i1vals)
204 #elif NF_INT1_IS_C_LONG
205  cstatus = nc_put_vars_long(cncid, cvarid, cstartptr, ccountsptr, &
206  cstridesptr, i1vals)
207 #endif
208 
209  status = cstatus
210 
211 ! Make sure we have no dangling pointers and unallocated arrays
212 
213  cstartptr = c_null_ptr
214  ccountsptr = c_null_ptr
215  cstridesptr = c_null_ptr
216  If (ALLOCATED(cstrides)) DEALLOCATE(cstrides)
217  If (ALLOCATED(ccounts)) DEALLOCATE(ccounts)
218  If (ALLOCATED(cstart)) DEALLOCATE(cstart)
219 
220  End Function nf_put_vars_int1
221 !--------------------------------- nf_put_vars_int2 ------------------------
222  Function nf_put_vars_int2(ncid, varid, start, counts, strides, i2vals) &
223  result(status)
224 
225 ! Write out 16 bit integer array given start, count, and stride
226 
229  Implicit NONE
230 
231  Integer, Intent(IN) :: ncid, varid
232  Integer, Intent(IN) :: start(*), counts(*), strides(*)
233  Integer(NFINT2), Intent(IN) :: i2vals(*)
234 
235  Integer :: status
236 
237  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
238  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr
239  Integer :: ndims
240 
241  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cstart(:), ccounts(:)
242  Integer(C_PTRDIFF_T), ALLOCATABLE, TARGET :: cstrides(:)
243 
244  If (c_short < 0) Then ! short not supported by processor
245  status = nc_ebadtype
246  RETURN
247  EndIf
248 
249  cncid = ncid
250  cvarid = varid - 1 ! Subtract 1 to get C varid
251 
252  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
253 
254  cstartptr = c_null_ptr
255  ccountsptr = c_null_ptr
256  cstridesptr = c_null_ptr
257  ndims = cndims
258 
259  If (cstat1 == nc_noerr) Then
260  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
261  ALLOCATE(cstart(ndims))
262  ALLOCATE(ccounts(ndims))
263  ALLOCATE(cstrides(ndims))
264  cstart(1:ndims) = start(ndims:1:-1) - 1
265  ccounts(1:ndims) = counts(ndims:1:-1)
266  cstrides(1:ndims) = strides(ndims:1:-1)
267  cstartptr = c_loc(cstart)
268  ccountsptr = c_loc(ccounts)
269  cstridesptr = c_loc(cstrides)
270  EndIf
271  EndIf
272 
273 #if NF_INT2_IS_C_SHORT
274  cstatus = nc_put_vars_short(cncid, cvarid, cstartptr, ccountsptr, &
275  cstridesptr, i2vals)
276 #elif NF_INT2_IS_C_INT
277  cstatus = nc_put_vars_int(cncid, cvarid, cstartptr, ccountsptr, &
278  cstridesptr, i2vals)
279 #elif NF_INT2_IS_C_LONG
280  cstatus = nc_put_vars_long(cncid, cvarid, cstartptr, ccountsptr, &
281  cstridesptr, i2vals)
282 #endif
283 
284  status = cstatus
285 
286 ! Make sure we have no dangling pointers and unallocated arrays
287 
288  cstartptr = c_null_ptr
289  ccountsptr = c_null_ptr
290  cstridesptr = c_null_ptr
291  If (ALLOCATED(cstrides)) DEALLOCATE(cstrides)
292  If (ALLOCATED(ccounts)) DEALLOCATE(ccounts)
293  If (ALLOCATED(cstart)) DEALLOCATE(cstart)
294 
295  End Function nf_put_vars_int2
296 !--------------------------------- nf_put_vars_int -------------------------
297  Function nf_put_vars_int(ncid, varid, start, counts, strides, ivals) &
298  result(status)
299 
300 ! Write out default integer array given start, count, and stride
301 
304  Implicit NONE
305 
306  Integer, Intent(IN) :: ncid, varid
307  Integer, Intent(IN) :: start(*), counts(*), strides(*)
308  Integer(NFINT), Intent(IN) :: ivals(*)
309 
310  Integer :: status
311 
312  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
313  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr
314  Integer :: ndims
315 
316  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cstart(:), ccounts(:)
317  Integer(C_PTRDIFF_T), ALLOCATABLE, TARGET :: cstrides(:)
318 
319  cncid = ncid
320  cvarid = varid - 1 ! Subtract 1 to get C varid
321 
322  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
323 
324  cstartptr = c_null_ptr
325  ccountsptr = c_null_ptr
326  cstridesptr = c_null_ptr
327  ndims = cndims
328 
329  If (cstat1 == nc_noerr) Then
330  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
331  ALLOCATE(cstart(ndims))
332  ALLOCATE(ccounts(ndims))
333  ALLOCATE(cstrides(ndims))
334  cstart(1:ndims) = start(ndims:1:-1) - 1
335  ccounts(1:ndims) = counts(ndims:1:-1)
336  cstrides(1:ndims) = strides(ndims:1:-1)
337  cstartptr = c_loc(cstart)
338  ccountsptr = c_loc(ccounts)
339  cstridesptr = c_loc(cstrides)
340  EndIf
341  EndIf
342 
343 #if NF_INT_IS_C_INT
344  cstatus = nc_put_vars_int(cncid, cvarid, cstartptr, ccountsptr, &
345  cstridesptr, ivals)
346 #elif NF_INT_IS_C_LONG
347  cstatus = nc_put_vars_long(cncid, cvarid, cstartptr, ccountsptr, &
348  cstridesptr, ivals)
349 #endif
350 
351  status = cstatus
352 
353 ! Make sure we have no dangling pointers and unallocated arrays
354 
355  cstartptr = c_null_ptr
356  ccountsptr = c_null_ptr
357  cstridesptr = c_null_ptr
358  If (ALLOCATED(cstrides)) DEALLOCATE(cstrides)
359  If (ALLOCATED(ccounts)) DEALLOCATE(ccounts)
360  If (ALLOCATED(cstart)) DEALLOCATE(cstart)
361 
362  End Function nf_put_vars_int
363 !--------------------------------- nf_put_vars_real ------------------------
364  Function nf_put_vars_real(ncid, varid, start, counts, strides, rvals) &
365  result(status)
366 
367 ! Write out 32 bit real array given start, count, and stride
368 
371  Implicit NONE
372 
373  Integer, Intent(IN) :: ncid, varid
374  Integer, Intent(IN) :: start(*), counts(*), strides(*)
375  Real(NFREAL), Intent(IN) :: rvals(*)
376 
377  Integer :: status
378 
379  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
380  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr
381  Integer :: ndims
382 
383  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cstart(:), ccounts(:)
384  Integer(C_PTRDIFF_T), ALLOCATABLE, TARGET :: cstrides(:)
385 
386  cncid = ncid
387  cvarid = varid - 1 ! Subtract 1 to get C varid
388 
389  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
390 
391  cstartptr = c_null_ptr
392  ccountsptr = c_null_ptr
393  cstridesptr = c_null_ptr
394  ndims = cndims
395 
396  If (cstat1 == nc_noerr) Then
397  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
398  ALLOCATE(cstart(ndims))
399  ALLOCATE(ccounts(ndims))
400  ALLOCATE(cstrides(ndims))
401  cstart(1:ndims) = start(ndims:1:-1) - 1
402  ccounts(1:ndims) = counts(ndims:1:-1)
403  cstrides(1:ndims) = strides(ndims:1:-1)
404  cstartptr = c_loc(cstart)
405  ccountsptr = c_loc(ccounts)
406  cstridesptr = c_loc(cstrides)
407  EndIf
408  EndIf
409 
410 #if NF_REAL_IS_C_DOUBLE
411  cstatus = nc_put_vars_double(cncid, cvarid, cstartptr, ccountsptr, &
412  cstridesptr, rvals)
413 #else
414  cstatus = nc_put_vars_float(cncid, cvarid, cstartptr, ccountsptr, &
415  cstridesptr, rvals)
416 #endif
417 
418  status = cstatus
419 
420 ! Make sure we have no dangling pointers and unallocated arrays
421 
422  cstartptr = c_null_ptr
423  ccountsptr = c_null_ptr
424  cstridesptr = c_null_ptr
425  If (ALLOCATED(cstrides)) DEALLOCATE(cstrides)
426  If (ALLOCATED(ccounts)) DEALLOCATE(ccounts)
427  If (ALLOCATED(cstart)) DEALLOCATE(cstart)
428 
429  End Function nf_put_vars_real
430 !--------------------------------- nf_put_vars_double ----------------------
431  Function nf_put_vars_double(ncid, varid, start, counts, strides, dvals) &
432  result(status)
433 
434 ! Write out 64 bit real array given start, count, and stride
435 
438  Implicit NONE
439 
440  Integer, Intent(IN) :: ncid, varid
441  Integer, Intent(IN) :: start(*), counts(*), strides(*)
442  Real(RK8), Intent(IN) :: dvals(*)
443 
444  Integer :: status
445 
446  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
447  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr
448  Integer :: ndims
449 
450  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cstart(:), ccounts(:)
451  Integer(C_PTRDIFF_T), ALLOCATABLE, TARGET :: cstrides(:)
452 
453  cncid = ncid
454  cvarid = varid - 1 ! Subtract 1 to get C varid
455 
456  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
457 
458  cstartptr = c_null_ptr
459  ccountsptr = c_null_ptr
460  cstridesptr = c_null_ptr
461  ndims = cndims
462 
463  If (cstat1 == nc_noerr) Then
464  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
465  ALLOCATE(cstart(ndims))
466  ALLOCATE(ccounts(ndims))
467  ALLOCATE(cstrides(ndims))
468  cstart(1:ndims) = start(ndims:1:-1) - 1
469  ccounts(1:ndims) = counts(ndims:1:-1)
470  cstrides(1:ndims) = strides(ndims:1:-1)
471  cstartptr = c_loc(cstart)
472  ccountsptr = c_loc(ccounts)
473  cstridesptr = c_loc(cstrides)
474  EndIf
475  EndIf
476 
477  cstatus = nc_put_vars_double(cncid, cvarid, cstartptr, ccountsptr, &
478  cstridesptr, dvals)
479 
480  status = cstatus
481 
482 ! Make sure we have no dangling pointers and unallocated arrays
483 
484  cstartptr = c_null_ptr
485  ccountsptr = c_null_ptr
486  cstridesptr = c_null_ptr
487  If (ALLOCATED(cstrides)) DEALLOCATE(cstrides)
488  If (ALLOCATED(ccounts)) DEALLOCATE(ccounts)
489  If (ALLOCATED(cstart)) DEALLOCATE(cstart)
490 
491  End Function nf_put_vars_double
492 !--------------------------------- nf_put_vars -----------------------------
493  Function nf_put_vars(ncid, varid, start, counts, strides, values) &
494  result(status)
495 
496 ! Write out a variable of any type. We use a C interop character string to
497 ! hold the values. Therefore, an explicit interface to nf_put_vars should NOT
498 ! be used in the calling program. Just use external
499 
502  Implicit NONE
503 
504  Integer, Intent(IN) :: ncid, varid
505  Integer, Intent(IN) :: start(*), counts(*), strides(*)
506  Character(KIND=C_CHAR), Intent(IN), TARGET :: values(*)
507  Integer :: status
508 
509  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
510  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr, cvaluesptr
511  Integer :: ndims
512 
513  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cstart(:), ccounts(:)
514  Integer(C_PTRDIFF_T), ALLOCATABLE, TARGET :: cstrides(:)
515 
516  cncid = ncid
517  cvarid = varid - 1 ! Subtract 1 to get C varid
518 
519  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
520 
521  cstartptr = c_null_ptr
522  ccountsptr = c_null_ptr
523  cstridesptr = c_null_ptr
524  ndims = cndims
525 
526  If (cstat1 == nc_noerr) Then
527  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
528  ALLOCATE(cstart(ndims))
529  ALLOCATE(ccounts(ndims))
530  ALLOCATE(cstrides(ndims))
531  cstart(1:ndims) = start(ndims:1:-1) - 1
532  ccounts(1:ndims) = counts(ndims:1:-1)
533  cstrides(1:ndims) = strides(ndims:1:-1)
534  cstartptr = c_loc(cstart)
535  ccountsptr = c_loc(ccounts)
536  cstridesptr = c_loc(cstrides)
537  EndIf
538  EndIf
539 
540  cvaluesptr = c_loc(values)
541 
542  cstatus = nc_put_vars(cncid, cvarid, cstartptr, ccountsptr, &
543  cstridesptr, cvaluesptr)
544 
545  status = cstatus
546 
547 ! Make sure we have no dangling pointers and unallocated arrays
548 
549  cstartptr = c_null_ptr
550  ccountsptr = c_null_ptr
551  cstridesptr = c_null_ptr
552  If (ALLOCATED(cstrides)) DEALLOCATE(cstrides)
553  If (ALLOCATED(ccounts)) DEALLOCATE(ccounts)
554  If (ALLOCATED(cstart)) DEALLOCATE(cstart)
555 
556  End Function nf_put_vars
557 !--------------------------------- nf_get_vars_text ----------------------
558  Function nf_get_vars_text(ncid, varid, start, counts, strides, text) &
559  result(status)
560 
561 ! Read in a character string from dataset
562 
565  Implicit NONE
566 
567  Integer, Intent(IN) :: ncid, varid
568  Integer, Intent(IN) :: start(*), counts(*), strides(*)
569  Character(LEN=*), Intent(OUT) :: text
570 
571  Integer :: status
572 
573  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
574  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr
575  Integer :: ndims
576 
577  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cstart(:), ccounts(:)
578  Integer(C_PTRDIFF_T), ALLOCATABLE, TARGET :: cstrides(:)
579 
580  cncid = ncid
581  cvarid = varid - 1 ! Subtract 1 to get C varid
582  text = repeat(" ", len(text))
583 
584  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
585 
586  cstartptr = c_null_ptr
587  ccountsptr = c_null_ptr
588  cstridesptr = c_null_ptr
589  ndims = cndims
590 
591  If (cstat1 == nc_noerr) Then
592  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
593  ALLOCATE(cstart(ndims))
594  ALLOCATE(ccounts(ndims))
595  ALLOCATE(cstrides(ndims))
596  cstart(1:ndims) = start(ndims:1:-1) - 1
597  ccounts(1:ndims) = counts(ndims:1:-1)
598  cstrides(1:ndims) = strides(ndims:1:-1)
599  cstartptr = c_loc(cstart)
600  ccountsptr = c_loc(ccounts)
601  cstridesptr = c_loc(cstrides)
602  EndIf
603  EndIf
604 
605  cstatus = nc_get_vars_text(cncid, cvarid, cstartptr, ccountsptr, &
606  cstridesptr, text)
607 
608  status = cstatus
609 
610 ! Make sure we have no dangling pointers and unallocated arrays
611 
612  cstartptr = c_null_ptr
613  ccountsptr = c_null_ptr
614  cstridesptr = c_null_ptr
615  If (ALLOCATED(cstrides)) DEALLOCATE(cstrides)
616  If (ALLOCATED(ccounts)) DEALLOCATE(ccounts)
617  If (ALLOCATED(cstart)) DEALLOCATE(cstart)
618 
619  End Function nf_get_vars_text
620 !--------------------------------- nf_get_vars_text_a ----------------------
621  Function nf_get_vars_text_a(ncid, varid, start, counts, strides, text) &
622  result(status)
623 
624 ! Read in an array of characters given start, count, and stride
625 
628  Implicit NONE
629 
630  Integer, Intent(IN) :: ncid, varid
631  Integer, Intent(IN) :: start(*), counts(*), strides(*)
632  Character(LEN=1), Intent(OUT) :: text(*)
633 
634  Integer :: status
635 
636  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
637  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr
638  Integer :: ndims
639 
640  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cstart(:), ccounts(:)
641  Integer(C_PTRDIFF_T), ALLOCATABLE, TARGET :: cstrides(:)
642 
643  cncid = ncid
644  cvarid = varid - 1 ! Subtract 1 to get C varid
645 
646  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
647 
648  cstartptr = c_null_ptr
649  ccountsptr = c_null_ptr
650  cstridesptr = c_null_ptr
651  ndims = cndims
652 
653  If (cstat1 == nc_noerr) Then
654  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
655  ALLOCATE(cstart(ndims))
656  ALLOCATE(ccounts(ndims))
657  ALLOCATE(cstrides(ndims))
658  cstart(1:ndims) = start(ndims:1:-1) - 1
659  ccounts(1:ndims) = counts(ndims:1:-1)
660  cstrides(1:ndims) = strides(ndims:1:-1)
661  cstartptr = c_loc(cstart)
662  ccountsptr = c_loc(ccounts)
663  cstridesptr = c_loc(cstrides)
664  EndIf
665  EndIf
666 
667  cstatus = nc_get_vars_text(cncid, cvarid, cstartptr, ccountsptr, &
668  cstridesptr, text)
669 
670  status = cstatus
671 
672 ! Make sure we have no dangling pointers and unallocated arrays
673 
674  cstartptr = c_null_ptr
675  ccountsptr = c_null_ptr
676  cstridesptr = c_null_ptr
677  If (ALLOCATED(cstrides)) DEALLOCATE(cstrides)
678  If (ALLOCATED(ccounts)) DEALLOCATE(ccounts)
679  If (ALLOCATED(cstart)) DEALLOCATE(cstart)
680 
681  End Function nf_get_vars_text_a
682 !--------------------------------- nf_get_vars_int1 ------------------------
683  Function nf_get_vars_int1(ncid, varid, start, counts, strides, i1vals) &
684  result(status)
685 
686 ! Read in 8 bit integer array given start, count, and stride
687 
690  Implicit NONE
691 
692  Integer, Intent(IN) :: ncid, varid
693  Integer, Intent(IN) :: start(*), counts(*), strides(*)
694  Integer(NFINT1), Intent(OUT) :: i1vals(*)
695 
696  Integer :: status
697 
698  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
699  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr
700  Integer :: ndims
701 
702  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cstart(:), ccounts(:)
703  Integer(C_PTRDIFF_T), ALLOCATABLE, TARGET :: cstrides(:)
704 
705  If (c_signed_char < 0) Then ! schar not supported by processor
706  status = nc_ebadtype
707  RETURN
708  EndIf
709 
710  cncid = ncid
711  cvarid = varid - 1 ! Subtract 1 to get C varid
712 
713  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
714 
715  cstartptr = c_null_ptr
716  ccountsptr = c_null_ptr
717  cstridesptr = c_null_ptr
718  ndims = cndims
719 
720  If (cstat1 == nc_noerr) Then
721  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
722  ALLOCATE(cstart(ndims))
723  ALLOCATE(ccounts(ndims))
724  ALLOCATE(cstrides(ndims))
725  cstart(1:ndims) = start(ndims:1:-1) - 1
726  ccounts(1:ndims) = counts(ndims:1:-1)
727  cstrides(1:ndims) = strides(ndims:1:-1)
728  cstartptr = c_loc(cstart)
729  ccountsptr = c_loc(ccounts)
730  cstridesptr = c_loc(cstrides)
731  EndIf
732  EndIf
733 
734 #if NF_INT1_IS_C_SIGNED_CHAR
735  cstatus = nc_get_vars_schar(cncid, cvarid, cstartptr, ccountsptr, &
736  cstridesptr, i1vals)
737 #elif NF_INT1_IS_C_SHORT
738  cstatus = nc_get_vars_short(cncid, cvarid, cstartptr, ccountsptr, &
739  cstridesptr, i1vals)
740 #elif NF_INT1_IS_C_INT
741  cstatus = nc_get_vars_int(cncid, cvarid, cstartptr, ccountsptr, &
742  cstridesptr, i1vals)
743 #elif NF_INT1_IS_C_LONG
744  cstatus = nc_get_vars_long(cncid, cvarid, cstartptr, ccountsptr, &
745  cstridesptr, i1vals)
746 #endif
747 
748  status = cstatus
749 
750 ! Make sure we have no dangling pointers and unallocated arrays
751 
752  cstartptr = c_null_ptr
753  ccountsptr = c_null_ptr
754  cstridesptr = c_null_ptr
755  If (ALLOCATED(cstrides)) DEALLOCATE(cstrides)
756  If (ALLOCATED(ccounts)) DEALLOCATE(ccounts)
757  If (ALLOCATED(cstart)) DEALLOCATE(cstart)
758 
759  End Function nf_get_vars_int1
760 !--------------------------------- nf_get_vars_int2 ------------------------
761  Function nf_get_vars_int2(ncid, varid, start, counts, strides, i2vals) &
762  result(status)
763 
764 ! Read in 16 bit integer array given start, count, and stride
765 
768  Implicit NONE
769 
770  Integer, Intent(IN) :: ncid, varid
771  Integer, Intent(IN) :: start(*), counts(*), strides(*)
772  Integer(NFINT2), Intent(OUT) :: i2vals(*)
773 
774  Integer :: status
775 
776  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
777  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr
778  Integer :: ndims
779 
780  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cstart(:), ccounts(:)
781  Integer(C_PTRDIFF_T), ALLOCATABLE, TARGET :: cstrides(:)
782 
783  If (c_short < 0) Then ! short not supported by processor
784  status = nc_ebadtype
785  RETURN
786  EndIf
787 
788  cncid = ncid
789  cvarid = varid - 1 ! Subtract 1 to get C varid
790 
791  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
792 
793  cstartptr = c_null_ptr
794  ccountsptr = c_null_ptr
795  cstridesptr = c_null_ptr
796  ndims = cndims
797 
798  If (cstat1 == nc_noerr) Then
799  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
800  ALLOCATE(cstart(ndims))
801  ALLOCATE(ccounts(ndims))
802  ALLOCATE(cstrides(ndims))
803  cstart(1:ndims) = start(ndims:1:-1) - 1
804  ccounts(1:ndims) = counts(ndims:1:-1)
805  cstrides(1:ndims) = strides(ndims:1:-1)
806  cstartptr = c_loc(cstart)
807  ccountsptr = c_loc(ccounts)
808  cstridesptr = c_loc(cstrides)
809  EndIf
810  EndIf
811 
812 #if NF_INT2_IS_C_SHORT
813  cstatus = nc_get_vars_short(cncid, cvarid, cstartptr, ccountsptr, &
814  cstridesptr, i2vals)
815 #elif NF_INT2_IS_C_INT
816  cstatus = nc_get_vars_int(cncid, cvarid, cstartptr, ccountsptr, &
817  cstridesptr, i2vals)
818 #elif NF_INT2_IS_C_LONG
819  cstatus = nc_get_vars_long(cncid, cvarid, cstartptr, ccountsptr, &
820  cstridesptr, i2vals)
821 #endif
822 
823  status = cstatus
824 
825 ! Make sure we have no dangling pointers and unallocated arrays
826 
827  cstartptr = c_null_ptr
828  ccountsptr = c_null_ptr
829  cstridesptr = c_null_ptr
830  If (ALLOCATED(cstrides)) DEALLOCATE(cstrides)
831  If (ALLOCATED(ccounts)) DEALLOCATE(ccounts)
832  If (ALLOCATED(cstart)) DEALLOCATE(cstart)
833 
834  End Function nf_get_vars_int2
835 !--------------------------------- nf_get_vars_int -------------------------
836  Function nf_get_vars_int(ncid, varid, start, counts, strides, ivals) &
837  result(status)
838 
839 ! Read in default integer array given start, count, and stride
840 
843  Implicit NONE
844 
845  Integer, Intent(IN) :: ncid, varid
846  Integer, Intent(IN) :: start(*), counts(*), strides(*)
847  Integer(NFINT), Intent(OUT) :: ivals(*)
848 
849  Integer :: status
850 
851  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
852  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr
853  Integer :: ndims
854 
855  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cstart(:), ccounts(:)
856  Integer(C_PTRDIFF_T), ALLOCATABLE, TARGET :: cstrides(:)
857 
858  cncid = ncid
859  cvarid = varid - 1 ! Subtract 1 to get C varid
860 
861  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
862 
863  cstartptr = c_null_ptr
864  ccountsptr = c_null_ptr
865  cstridesptr = c_null_ptr
866  ndims = cndims
867 
868  If (cstat1 == nc_noerr) Then
869  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
870  ALLOCATE(cstart(ndims))
871  ALLOCATE(ccounts(ndims))
872  ALLOCATE(cstrides(ndims))
873  cstart(1:ndims) = start(ndims:1:-1) - 1
874  ccounts(1:ndims) = counts(ndims:1:-1)
875  cstrides(1:ndims) = strides(ndims:1:-1)
876  cstartptr = c_loc(cstart)
877  ccountsptr = c_loc(ccounts)
878  cstridesptr = c_loc(cstrides)
879  EndIf
880  EndIf
881 
882 #if NF_INT_IS_C_INT
883  cstatus = nc_get_vars_int(cncid, cvarid, cstartptr, ccountsptr, &
884  cstridesptr, ivals)
885 #elif NF_INT_IS_C_LONG
886  cstatus = nc_get_vars_long(cncid, cvarid, cstartptr, ccountsptr, &
887  cstridesptr, ivals)
888 #endif
889 
890  status = cstatus
891 
892 ! Make sure we have no dangling pointers and unallocated arrays
893 
894  cstartptr = c_null_ptr
895  ccountsptr = c_null_ptr
896  cstridesptr = c_null_ptr
897  If (ALLOCATED(cstrides)) DEALLOCATE(cstrides)
898  If (ALLOCATED(ccounts)) DEALLOCATE(ccounts)
899  If (ALLOCATED(cstart)) DEALLOCATE(cstart)
900 
901  End Function nf_get_vars_int
902 !--------------------------------- nf_get_vars_real ------------------------
903  Function nf_get_vars_real(ncid, varid, start, counts, strides, rvals) &
904  result(status)
905 
906 ! Read in 32 bit real array given start, count, and stride
907 
910  Implicit NONE
911 
912  Integer, Intent(IN) :: ncid, varid
913  Integer, Intent(IN) :: start(*), counts(*), strides(*)
914  Real(NFREAL), Intent(OUT) :: rvals(*)
915 
916  Integer :: status
917 
918  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
919  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr
920  Integer :: ndims
921 
922  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cstart(:), ccounts(:)
923  Integer(C_PTRDIFF_T), ALLOCATABLE, TARGET :: cstrides(:)
924 
925  cncid = ncid
926  cvarid = varid - 1 ! Subtract 1 to get C varid
927 
928  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
929 
930  cstartptr = c_null_ptr
931  ccountsptr = c_null_ptr
932  cstridesptr = c_null_ptr
933  ndims = cndims
934 
935  If (cstat1 == nc_noerr) Then
936  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
937  ALLOCATE(cstart(ndims))
938  ALLOCATE(ccounts(ndims))
939  ALLOCATE(cstrides(ndims))
940  cstart(1:ndims) = start(ndims:1:-1) - 1
941  ccounts(1:ndims) = counts(ndims:1:-1)
942  cstrides(1:ndims) = strides(ndims:1:-1)
943  cstartptr = c_loc(cstart)
944  ccountsptr = c_loc(ccounts)
945  cstridesptr = c_loc(cstrides)
946  EndIf
947  EndIf
948 
949 #if NF_REAL_IS_C_DOUBLE
950  cstatus = nc_get_vars_double(cncid, cvarid, cstartptr, ccountsptr, &
951  cstridesptr, rvals)
952 #else
953  cstatus = nc_get_vars_float(cncid, cvarid, cstartptr, ccountsptr, &
954  cstridesptr, rvals)
955 #endif
956 
957  status = cstatus
958 
959 ! Make sure we have no dangling pointers and unallocated arrays
960 
961  cstartptr = c_null_ptr
962  ccountsptr = c_null_ptr
963  cstridesptr = c_null_ptr
964  If (ALLOCATED(cstrides)) DEALLOCATE(cstrides)
965  If (ALLOCATED(ccounts)) DEALLOCATE(ccounts)
966  If (ALLOCATED(cstart)) DEALLOCATE(cstart)
967 
968  End Function nf_get_vars_real
969 !--------------------------------- nf_get_vars_double ----------------------
970  Function nf_get_vars_double(ncid, varid, start, counts, strides, dvals) &
971  result(status)
972 
973 ! Read in 64 bit real array given start, count, and stride
974 
977  Implicit NONE
978 
979  Integer, Intent(IN) :: ncid, varid
980  Integer, Intent(IN) :: start(*), counts(*), strides(*)
981  Real(RK8), Intent(OUT) :: dvals(*)
982 
983  Integer :: status
984 
985  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
986  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr
987  Integer :: ndims
988 
989  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cstart(:), ccounts(:)
990  Integer(C_PTRDIFF_T), ALLOCATABLE, TARGET :: cstrides(:)
991 
992  cncid = ncid
993  cvarid = varid - 1 ! Subtract 1 to get C varid
994 
995  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
996 
997  cstartptr = c_null_ptr
998  ccountsptr = c_null_ptr
999  cstridesptr = c_null_ptr
1000  ndims = cndims
1001 
1002  If (cstat1 == nc_noerr) Then
1003  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
1004  ALLOCATE(cstart(ndims))
1005  ALLOCATE(ccounts(ndims))
1006  ALLOCATE(cstrides(ndims))
1007  cstart(1:ndims) = start(ndims:1:-1) - 1
1008  ccounts(1:ndims) = counts(ndims:1:-1)
1009  cstrides(1:ndims) = strides(ndims:1:-1)
1010  cstartptr = c_loc(cstart)
1011  ccountsptr = c_loc(ccounts)
1012  cstridesptr = c_loc(cstrides)
1013  EndIf
1014  EndIf
1015 
1016  cstatus = nc_get_vars_double(cncid, cvarid, cstartptr, ccountsptr, &
1017  cstridesptr, dvals)
1018 
1019  status = cstatus
1020 
1021 ! Make sure we have no dangling pointers and unallocated arrays
1022 
1023  cstartptr = c_null_ptr
1024  ccountsptr = c_null_ptr
1025  cstridesptr = c_null_ptr
1026  If (ALLOCATED(cstrides)) DEALLOCATE(cstrides)
1027  If (ALLOCATED(ccounts)) DEALLOCATE(ccounts)
1028  If (ALLOCATED(cstart)) DEALLOCATE(cstart)
1029 
1030  End Function nf_get_vars_double
1031 !--------------------------------- nf_get_vars ----------------------------
1032  Function nf_get_vars(ncid, varid, start, counts, strides, values) &
1033  result(status)
1034 
1035 ! Read in a variable of any type. We use a C interop character string to
1036 ! hold the values. Therefore, an explicit interface to nf_put_vars should NOT
1037 ! be used in the calling program. Just use external
1038 
1041  Implicit NONE
1042 
1043  Integer, Intent(IN) :: ncid, varid
1044  Integer, Intent(IN) :: start(*), counts(*), strides(*)
1045  Character(KIND=C_CHAR), Intent(INOUT) :: values
1046 
1047  Integer :: status
1048 
1049  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
1050  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr
1051  Integer :: ndims
1052 
1053  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cstart(:), ccounts(:)
1054  Integer(C_PTRDIFF_T), ALLOCATABLE, TARGET :: cstrides(:)
1055 
1056  cncid = ncid
1057  cvarid = varid - 1 ! Subtract 1 to get C varid
1058 
1059  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
1060 
1061  cstartptr = c_null_ptr
1062  ccountsptr = c_null_ptr
1063  cstridesptr = c_null_ptr
1064  ndims = cndims
1065 
1066  If (cstat1 == nc_noerr) Then
1067  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
1068  ALLOCATE(cstart(ndims))
1069  ALLOCATE(ccounts(ndims))
1070  ALLOCATE(cstrides(ndims))
1071  cstart(1:ndims) = start(ndims:1:-1) - 1
1072  ccounts(1:ndims) = counts(ndims:1:-1)
1073  cstrides(1:ndims) = strides(ndims:1:-1)
1074  cstartptr = c_loc(cstart)
1075  ccountsptr = c_loc(ccounts)
1076  cstridesptr = c_loc(cstrides)
1077  EndIf
1078  EndIf
1079 
1080  cstatus = nc_get_vars(cncid, cvarid, cstartptr, ccountsptr, &
1081  cstridesptr, values)
1082 
1083  status = cstatus
1084 
1085 ! Make sure we have no dangling pointers and unallocated arrays
1086 
1087  cstartptr = c_null_ptr
1088  ccountsptr = c_null_ptr
1089  cstridesptr = c_null_ptr
1090  If (ALLOCATED(cstrides)) DEALLOCATE(cstrides)
1091  If (ALLOCATED(ccounts)) DEALLOCATE(ccounts)
1092  If (ALLOCATED(cstart)) DEALLOCATE(cstart)
1093 
1094  End Function nf_get_vars
function nf_put_vars_double(ncid, varid, start, counts, strides, dvals)
Definition: nf_varsio.F90:437
function nf_put_vars_text(ncid, varid, start, counts, strides, text)
Definition: nf_varsio.F90:44
function nf_get_vars_int1(ncid, varid, start, counts, strides, i1vals)
Definition: nf_varsio.F90:689
function nf_get_vars_real(ncid, varid, start, counts, strides, rvals)
Definition: nf_varsio.F90:909
function nf_put_vars_int(ncid, varid, start, counts, strides, ivals)
Definition: nf_varsio.F90:303
function nf_put_vars_real(ncid, varid, start, counts, strides, rvals)
Definition: nf_varsio.F90:370
function nf_get_vars_text(ncid, varid, start, counts, strides, text)
Definition: nf_varsio.F90:564
function nf_get_vars_double(ncid, varid, start, counts, strides, dvals)
Definition: nf_varsio.F90:976
function nf_put_vars_int2(ncid, varid, start, counts, strides, i2vals)
Definition: nf_varsio.F90:228
function nf_get_vars(ncid, varid, start, counts, strides, values)
Definition: nf_varsio.F90:1040
function nf_put_vars_text_a(ncid, varid, start, counts, strides, text)
Definition: nf_varsio.F90:98
function nf_get_vars_text_a(ncid, varid, start, counts, strides, text)
Definition: nf_varsio.F90:627
integer(c_int), parameter nc_ebadtype
integer(c_int), parameter nc_noerr
function nf_put_vars(ncid, varid, start, counts, strides, values)
Definition: nf_varsio.F90:501
function nf_get_vars_int(ncid, varid, start, counts, strides, ivals)
Definition: nf_varsio.F90:842
function nf_get_vars_int2(ncid, varid, start, counts, strides, i2vals)
Definition: nf_varsio.F90:767
function nf_put_vars_int1(ncid, varid, start, counts, strides, i1vals)
Definition: nf_varsio.F90:150

Return to the Main Unidata NetCDF page.
Generated on Fri Aug 4 2017 17:20:58 for NetCDF-Fortran. NetCDF is a Unidata library.