NetCDF-Fortran  4.4.4
nf_varmio.F90
Go to the documentation of this file.
1 #include "nfconfig.inc"
2 
3 !- Array/string put/get routines given start, count, stride, and map vectors -
4 
5 ! Replacement for fort-varmio.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, strides, and
29 ! maps as 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 cstart, ccounts,
34 ! cstrides, and cmaps with allocatable arrays and
35 ! general code cleanup
36 
37 !--------------------------------- nf_put_varm_text ----------------------
38  Function nf_put_varm_text(ncid, varid, start, counts, strides, maps, &
39  text) RESULT(status)
40 
41 ! Write out a character string to dataset given start, count, stride and map
42 
44 
45  Implicit NONE
46 
47  Integer, Intent(IN) :: ncid, varid
48  Integer, Intent(IN) :: start(*), counts(*), strides(*), maps(*)
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, cmapsptr
55  Integer :: ndims
56 
57  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cstart(:), ccounts(:)
58  Integer(C_PTRDIFF_T), ALLOCATABLE, TARGET :: cstrides(:), cmaps(:)
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  cmapsptr = c_null_ptr
69  ndims = cndims
70 
71  If (cstat1 == nc_noerr) Then
72  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
73  ALLOCATE(cstart(1:ndims))
74  ALLOCATE(ccounts(1:ndims))
75  ALLOCATE(cstrides(1:ndims))
76  ALLOCATE(cmaps(1:ndims))
77  cstart(1:ndims) = start(ndims:1:-1) - 1
78  ccounts(1:ndims) = counts(ndims:1:-1)
79  cstrides(1:ndims) = strides(ndims:1:-1)
80  cmaps(1:ndims) = maps(ndims:1:-1)
81  cstartptr = c_loc(cstart)
82  ccountsptr = c_loc(ccounts)
83  cstridesptr = c_loc(cstrides)
84  cmapsptr = c_loc(cmaps)
85  EndIf
86  EndIf
87 
88  cstatus = nc_put_varm_text(cncid, cvarid, cstartptr, ccountsptr, &
89  cstridesptr, cmapsptr, text)
90 
91  status = cstatus
92 
93 ! Make sure we don't leave any dangling pointers or allocated arrays
94 
95  cstartptr = c_null_ptr
96  ccountsptr = c_null_ptr
97  cstridesptr = c_null_ptr
98  cmapsptr = c_null_ptr
99  If (ALLOCATED(cmaps)) DEALLOCATE(cmaps)
100  If (ALLOCATED(cstrides)) DEALLOCATE(cstrides)
101  If (ALLOCATED(ccounts)) DEALLOCATE(ccounts)
102  If (ALLOCATED(cstart)) DEALLOCATE(cstart)
103 
104  End Function nf_put_varm_text
105 !--------------------------------- nf_put_varm_text_a ----------------------
106  Function nf_put_varm_text_a(ncid, varid, start, counts, strides, maps, &
107  text) RESULT(status)
109 ! Write out array of characters to dataset given start, count, stride and map
110 
112 
113  Implicit NONE
114 
115  Integer, Intent(IN) :: ncid, varid
116  Integer, Intent(IN) :: start(*), counts(*), strides(*), maps(*)
117  Character(LEN=1), Intent(IN) :: text(*)
118 
119  Integer :: status
120 
121  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
122  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr, cmapsptr
123  Integer :: ndims
124 
125  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cstart(:), ccounts(:)
126  Integer(C_PTRDIFF_T), ALLOCATABLE, TARGET :: cstrides(:), cmaps(:)
127 
128  cncid = ncid
129  cvarid = varid -1 ! Subtract 1 to get C varid
130 
131  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
132 
133  cstartptr = c_null_ptr
134  ccountsptr = c_null_ptr
135  cstridesptr = c_null_ptr
136  cmapsptr = c_null_ptr
137  ndims = cndims
138 
139  If (cstat1 == nc_noerr) Then
140  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
141  ALLOCATE(cstart(1:ndims))
142  ALLOCATE(ccounts(1:ndims))
143  ALLOCATE(cstrides(1:ndims))
144  ALLOCATE(cmaps(1:ndims))
145  cstart(1:ndims) = start(ndims:1:-1) - 1
146  ccounts(1:ndims) = counts(ndims:1:-1)
147  cstrides(1:ndims) = strides(ndims:1:-1)
148  cmaps(1:ndims) = maps(ndims:1:-1)
149  cstartptr = c_loc(cstart)
150  ccountsptr = c_loc(ccounts)
151  cstridesptr = c_loc(cstrides)
152  cmapsptr = c_loc(cmaps)
153  EndIf
154  EndIf
155 
156  cstatus = nc_put_varm_text(cncid, cvarid, cstartptr, ccountsptr, &
157  cstridesptr, cmapsptr, text)
158 
159  status = cstatus
160 
161 ! Make sure we don't leave any dangling pointers or allocated arrays
162 
163  cstartptr = c_null_ptr
164  ccountsptr = c_null_ptr
165  cstridesptr = c_null_ptr
166  cmapsptr = c_null_ptr
167  If (ALLOCATED(cmaps)) DEALLOCATE(cmaps)
168  If (ALLOCATED(cstrides)) DEALLOCATE(cstrides)
169  If (ALLOCATED(ccounts)) DEALLOCATE(ccounts)
170  If (ALLOCATED(cstart)) DEALLOCATE(cstart)
171 
172  End Function nf_put_varm_text_a
173 !--------------------------------- nf_put_varm_int1 ------------------------
174  Function nf_put_varm_int1(ncid, varid, start, counts, strides, maps, &
175  i1vals) RESULT(status)
177 ! Write out 8 bit integer array given start, count, stride and map
178 
180 
181  Implicit NONE
182 
183  Integer, Intent(IN) :: ncid, varid
184  Integer, Intent(IN) :: start(*), counts(*), strides(*), maps(*)
185  Integer(NFINT1), Intent(IN) :: i1vals(*)
186 
187  Integer :: status
188 
189  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
190  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr, cmapsptr
191  Integer :: ndims
192 
193  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cstart(:), ccounts(:)
194  Integer(C_PTRDIFF_T), ALLOCATABLE, TARGET :: cstrides(:), cmaps(:)
195 
196  If (c_signed_char < 0) Then ! schar not supported by processor
197  status = nc_ebadtype
198  RETURN
199  EndIf
200 
201  cncid = ncid
202  cvarid = varid -1 ! Subtract 1 to get C varid
203 
204  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
205 
206  cstartptr = c_null_ptr
207  ccountsptr = c_null_ptr
208  cstridesptr = c_null_ptr
209  cmapsptr = c_null_ptr
210  ndims = cndims
211 
212  If (cstat1 == nc_noerr) Then
213  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
214  ALLOCATE(cstart(1:ndims))
215  ALLOCATE(ccounts(1:ndims))
216  ALLOCATE(cstrides(1:ndims))
217  ALLOCATE(cmaps(1:ndims))
218  cstart(1:ndims) = start(ndims:1:-1) - 1
219  ccounts(1:ndims) = counts(ndims:1:-1)
220  cstrides(1:ndims) = strides(ndims:1:-1)
221  cmaps(1:ndims) = maps(ndims:1:-1)
222  cstartptr = c_loc(cstart)
223  ccountsptr = c_loc(ccounts)
224  cstridesptr = c_loc(cstrides)
225  cmapsptr = c_loc(cmaps)
226  EndIf
227  EndIf
228 
229 #if NF_INT1_IS_C_SIGNED_CHAR
230  cstatus = nc_put_varm_schar(cncid, cvarid, cstartptr, ccountsptr, &
231  cstridesptr, cmapsptr, i1vals)
232 #elif NF_INT1_IS_C_SHORT
233  cstatus = nc_put_varm_short(cncid, cvarid, cstartptr, ccountsptr, &
234  cstridesptr, cmapsptr, i1vals)
235 #elif NF_INT1_IS_C_INT
236  cstatus = nc_put_varm_int(cncid, cvarid, cstartptr, ccountsptr, &
237  cstridesptr, cmapsptr, i1vals)
238 #elif NF_INT1_IS_C_LONG
239  cstatus = nc_put_varm_long(cncid, cvarid, cstartptr, ccountsptr, &
240  cstridesptr, cmapsptr, i1vals)
241 #endif
242 
243  status = cstatus
244 
245 ! Make sure we don't leave any dangling pointers or allocated arrays
246 
247  cstartptr = c_null_ptr
248  ccountsptr = c_null_ptr
249  cstridesptr = c_null_ptr
250  cmapsptr = c_null_ptr
251  If (ALLOCATED(cmaps)) DEALLOCATE(cmaps)
252  If (ALLOCATED(cstrides)) DEALLOCATE(cstrides)
253  If (ALLOCATED(ccounts)) DEALLOCATE(ccounts)
254  If (ALLOCATED(cstart)) DEALLOCATE(cstart)
255 
256  End Function nf_put_varm_int1
257 !--------------------------------- nf_put_varm_int2 ------------------------
258  Function nf_put_varm_int2(ncid, varid, start, counts, strides, maps, &
259  i2vals) RESULT(status)
261 ! Write out 16 bit integer array given start, count, stride and map
262 
264 
265  Implicit NONE
266 
267  Integer, Intent(IN) :: ncid, varid
268  Integer, Intent(IN) :: start(*), counts(*), strides(*), maps(*)
269  Integer(NFINT2), Intent(IN) :: i2vals(*)
270 
271  Integer :: status
272 
273  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
274  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr, cmapsptr
275  Integer :: ndims
276 
277  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cstart(:), ccounts(:)
278  Integer(C_PTRDIFF_T), ALLOCATABLE, TARGET :: cstrides(:), cmaps(:)
279 
280  If (c_short < 0) Then ! short not supported by processor
281  status = nc_ebadtype
282  RETURN
283  EndIf
284 
285  cncid = ncid
286  cvarid = varid -1 ! Subtract 1 to get C varid
287 
288  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
289 
290  cstartptr = c_null_ptr
291  ccountsptr = c_null_ptr
292  cstridesptr = c_null_ptr
293  cmapsptr = c_null_ptr
294  ndims = cndims
295 
296  If (cstat1 == nc_noerr) Then
297  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
298  ALLOCATE(cstart(1:ndims))
299  ALLOCATE(ccounts(1:ndims))
300  ALLOCATE(cstrides(1:ndims))
301  ALLOCATE(cmaps(1:ndims))
302  cstart(1:ndims) = start(ndims:1:-1) - 1
303  ccounts(1:ndims) = counts(ndims:1:-1)
304  cstrides(1:ndims) = strides(ndims:1:-1)
305  cmaps(1:ndims) = maps(ndims:1:-1)
306  cstartptr = c_loc(cstart)
307  ccountsptr = c_loc(ccounts)
308  cstridesptr = c_loc(cstrides)
309  cmapsptr = c_loc(cmaps)
310  EndIf
311  EndIf
312 
313 #if NF_INT2_IS_C_SHORT
314  cstatus = nc_put_varm_short(cncid, cvarid, cstartptr, ccountsptr, &
315  cstridesptr, cmapsptr, i2vals)
316 #elif NF_INT2_IS_C_INT
317  cstatus = nc_put_varm_int(cncid, cvarid, cstartptr, ccountsptr, &
318  cstridesptr, cmapsptr, i2vals)
319 #elif NF_INT2_IS_C_LONG
320  cstatus = nc_put_varm_long(cncid, cvarid, cstartptr, ccountsptr, &
321  cstridesptr, cmapsptr, i2vals)
322 #endif
323 
324  status = cstatus
325 
326 ! Make sure we don't leave any dangling pointers or allocated arrays
327 
328  cstartptr = c_null_ptr
329  ccountsptr = c_null_ptr
330  cstridesptr = c_null_ptr
331  cmapsptr = c_null_ptr
332  If (ALLOCATED(cmaps)) DEALLOCATE(cmaps)
333  If (ALLOCATED(cstrides)) DEALLOCATE(cstrides)
334  If (ALLOCATED(ccounts)) DEALLOCATE(ccounts)
335  If (ALLOCATED(cstart)) DEALLOCATE(cstart)
336 
337  End Function nf_put_varm_int2
338 !--------------------------------- nf_put_varm_int -------------------------
339  Function nf_put_varm_int(ncid, varid, start, counts, strides, maps, &
340  ivals) RESULT(status)
342 ! Write out default integer array given start, count, stride and map
343 
345 
346  Implicit NONE
347 
348  Integer, Intent(IN) :: ncid, varid
349  Integer, Intent(IN) :: start(*), counts(*), strides(*), maps(*)
350  Integer(NFINT), Intent(IN) :: ivals(*)
351 
352  Integer :: status
353 
354  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
355  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr, cmapsptr
356  Integer :: ndims
357 
358  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cstart(:), ccounts(:)
359  Integer(C_PTRDIFF_T), ALLOCATABLE, TARGET :: cstrides(:), cmaps(:)
360 
361  cncid = ncid
362  cvarid = varid -1 ! Subtract 1 to get C varid
363 
364  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
365 
366  cstartptr = c_null_ptr
367  ccountsptr = c_null_ptr
368  cstridesptr = c_null_ptr
369  cmapsptr = c_null_ptr
370  ndims = cndims
371 
372  If (cstat1 == nc_noerr) Then
373  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
374  ALLOCATE(cstart(1:ndims))
375  ALLOCATE(ccounts(1:ndims))
376  ALLOCATE(cstrides(1:ndims))
377  ALLOCATE(cmaps(1:ndims))
378  cstart(1:ndims) = start(ndims:1:-1) - 1
379  ccounts(1:ndims) = counts(ndims:1:-1)
380  cstrides(1:ndims) = strides(ndims:1:-1)
381  cmaps(1:ndims) = maps(ndims:1:-1)
382  cstartptr = c_loc(cstart)
383  ccountsptr = c_loc(ccounts)
384  cstridesptr = c_loc(cstrides)
385  cmapsptr = c_loc(cmaps)
386  EndIf
387  EndIf
388 
389 #if NF_INT_IS_C_INT
390  cstatus = nc_put_varm_int(cncid, cvarid, cstartptr, ccountsptr, &
391  cstridesptr, cmapsptr, ivals)
392 #elif NF_INT_IS_C_LONG
393  cstatus = nc_put_varm_long(cncid, cvarid, cstartptr, ccountsptr, &
394  cstridesptr, cmapsptr, ivals)
395 #endif
396 
397  status = cstatus
398 
399 ! Make sure we don't leave any dangling pointers or allocated arrays
400 
401  cstartptr = c_null_ptr
402  ccountsptr = c_null_ptr
403  cstridesptr = c_null_ptr
404  cmapsptr = c_null_ptr
405  If (ALLOCATED(cmaps)) DEALLOCATE(cmaps)
406  If (ALLOCATED(cstrides)) DEALLOCATE(cstrides)
407  If (ALLOCATED(ccounts)) DEALLOCATE(ccounts)
408  If (ALLOCATED(cstart)) DEALLOCATE(cstart)
409 
410  End Function nf_put_varm_int
411 !--------------------------------- nf_put_varm_real ------------------------
412  Function nf_put_varm_real(ncid, varid, start, counts, strides, maps, &
413  rvals) RESULT(status)
415 ! Write out 32 bit real array given start, count, stride and map
416 
418 
419  Implicit NONE
420 
421  Integer, Intent(IN) :: ncid, varid
422  Integer, Intent(IN) :: start(*), counts(*), strides(*), maps(*)
423  Real(NFREAL), Intent(IN) :: rvals(*)
424 
425  Integer :: status
426 
427  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
428  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr, cmapsptr
429  Integer :: ndims
430 
431  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cstart(:), ccounts(:)
432  Integer(C_PTRDIFF_T), ALLOCATABLE, TARGET :: cstrides(:), cmaps(:)
433 
434  cncid = ncid
435  cvarid = varid -1 ! Subtract 1 to get C varid
436 
437  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
438 
439  cstartptr = c_null_ptr
440  ccountsptr = c_null_ptr
441  cstridesptr = c_null_ptr
442  cmapsptr = c_null_ptr
443  ndims = cndims
444 
445  If (cstat1 == nc_noerr) Then
446  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
447  ALLOCATE(cstart(1:ndims))
448  ALLOCATE(ccounts(1:ndims))
449  ALLOCATE(cstrides(1:ndims))
450  ALLOCATE(cmaps(1:ndims))
451  cstart(1:ndims) = start(ndims:1:-1) - 1
452  ccounts(1:ndims) = counts(ndims:1:-1)
453  cstrides(1:ndims) = strides(ndims:1:-1)
454  cmaps(1:ndims) = maps(ndims:1:-1)
455  cstartptr = c_loc(cstart)
456  ccountsptr = c_loc(ccounts)
457  cstridesptr = c_loc(cstrides)
458  cmapsptr = c_loc(cmaps)
459  EndIf
460  EndIf
461 
462 #if NF_REAL_IS_C_DOUBLE
463  cstatus = nc_put_varm_double(cncid, cvarid, cstartptr, ccountsptr, &
464  cstridesptr, cmapsptr, rvals)
465 #else
466  cstatus = nc_put_varm_float(cncid, cvarid, cstartptr, ccountsptr, &
467  cstridesptr, cmapsptr, rvals)
468 #endif
469 
470  status = cstatus
471 
472 ! Make sure we don't leave any dangling pointers or allocated arrays
473 
474  cstartptr = c_null_ptr
475  ccountsptr = c_null_ptr
476  cstridesptr = c_null_ptr
477  cmapsptr = c_null_ptr
478  If (ALLOCATED(cmaps)) DEALLOCATE(cmaps)
479  If (ALLOCATED(cstrides)) DEALLOCATE(cstrides)
480  If (ALLOCATED(ccounts)) DEALLOCATE(ccounts)
481  If (ALLOCATED(cstart)) DEALLOCATE(cstart)
482 
483  End Function nf_put_varm_real
484 !--------------------------------- nf_put_varm_double ----------------------
485  Function nf_put_varm_double(ncid, varid, start, counts, strides, maps, &
486  dvals) RESULT(status)
488 ! Write out 64 bit real array given start, count, stride, and map
489 
491 
492  Implicit NONE
493 
494  Integer, Intent(IN) :: ncid, varid
495  Integer, Intent(IN) :: start(*), counts(*), strides(*), maps(*)
496  Real(RK8), Intent(IN) :: dvals(*)
497 
498  Integer :: status
499 
500  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
501  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr, cmapsptr
502  Integer :: ndims
503 
504  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cstart(:), ccounts(:)
505  Integer(C_PTRDIFF_T), ALLOCATABLE, TARGET :: cstrides(:), cmaps(:)
506 
507  cncid = ncid
508  cvarid = varid -1 ! Subtract 1 to get C varid
509 
510  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
511 
512  cstartptr = c_null_ptr
513  ccountsptr = c_null_ptr
514  cstridesptr = c_null_ptr
515  cmapsptr = c_null_ptr
516  ndims = cndims
517 
518  If (cstat1 == nc_noerr) Then
519  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
520  ALLOCATE(cstart(1:ndims))
521  ALLOCATE(ccounts(1:ndims))
522  ALLOCATE(cstrides(1:ndims))
523  ALLOCATE(cmaps(1:ndims))
524  cstart(1:ndims) = start(ndims:1:-1) - 1
525  ccounts(1:ndims) = counts(ndims:1:-1)
526  cstrides(1:ndims) = strides(ndims:1:-1)
527  cmaps(1:ndims) = maps(ndims:1:-1)
528  cstartptr = c_loc(cstart)
529  ccountsptr = c_loc(ccounts)
530  cstridesptr = c_loc(cstrides)
531  cmapsptr = c_loc(cmaps)
532  EndIf
533  EndIf
534 
535  cstatus = nc_put_varm_double(cncid, cvarid, cstartptr, ccountsptr, &
536  cstridesptr, cmapsptr, dvals)
537 
538  status = cstatus
539 
540 ! Make sure we don't leave any dangling pointers or allocated arrays
541 
542  cstartptr = c_null_ptr
543  ccountsptr = c_null_ptr
544  cstridesptr = c_null_ptr
545  cmapsptr = c_null_ptr
546  If (ALLOCATED(cmaps)) DEALLOCATE(cmaps)
547  If (ALLOCATED(cstrides)) DEALLOCATE(cstrides)
548  If (ALLOCATED(ccounts)) DEALLOCATE(ccounts)
549  If (ALLOCATED(cstart)) DEALLOCATE(cstart)
550 
551  End Function nf_put_varm_double
552 !--------------------------------- nf_get_varm_text ----------------------
553  Function nf_get_varm_text(ncid, varid, start, counts, strides, maps, &
554  text) RESULT(status)
556 ! Read in a character string to dataset given start, count, stride, and map
557 
559 
560  Implicit NONE
561 
562  Integer, Intent(IN) :: ncid, varid
563  Integer, Intent(IN) :: start(*), counts(*), strides(*), maps(*)
564  Character(LEN=*), Intent(OUT) :: text
565 
566  Integer :: status
567 
568  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
569  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr, cmapsptr
570  Integer :: ndims
571 
572  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cstart(:), ccounts(:)
573  Integer(C_PTRDIFF_T), ALLOCATABLE, TARGET :: cstrides(:), cmaps(:)
574 
575  cncid = ncid
576  cvarid = varid -1 ! Subtract 1 to get C varid
577  text = repeat(" ",len(text))
578 
579  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
580 
581  cstartptr = c_null_ptr
582  ccountsptr = c_null_ptr
583  cstridesptr = c_null_ptr
584  cmapsptr = c_null_ptr
585  ndims = cndims
586 
587  If (cstat1 == nc_noerr) Then
588  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
589  ALLOCATE(cstart(1:ndims))
590  ALLOCATE(ccounts(1:ndims))
591  ALLOCATE(cstrides(1:ndims))
592  ALLOCATE(cmaps(1:ndims))
593  cstart(1:ndims) = start(ndims:1:-1) - 1
594  ccounts(1:ndims) = counts(ndims:1:-1)
595  cstrides(1:ndims) = strides(ndims:1:-1)
596  cmaps(1:ndims) = maps(ndims:1:-1)
597  cstartptr = c_loc(cstart)
598  ccountsptr = c_loc(ccounts)
599  cstridesptr = c_loc(cstrides)
600  cmapsptr = c_loc(cmaps)
601  EndIf
602  EndIf
603 
604  cstatus = nc_get_varm_text(cncid, cvarid, cstartptr, ccountsptr, &
605  cstridesptr, cmapsptr, text)
606 
607  status = cstatus
608 
609 ! Make sure we don't leave any dangling pointers or allocated arrays
610 
611  cstartptr = c_null_ptr
612  ccountsptr = c_null_ptr
613  cstridesptr = c_null_ptr
614  cmapsptr = c_null_ptr
615  If (ALLOCATED(cmaps)) DEALLOCATE(cmaps)
616  If (ALLOCATED(cstrides)) DEALLOCATE(cstrides)
617  If (ALLOCATED(ccounts)) DEALLOCATE(ccounts)
618  If (ALLOCATED(cstart)) DEALLOCATE(cstart)
619 
620  End Function nf_get_varm_text
621 !--------------------------------- nf_get_varm_text_a ----------------------
622  Function nf_get_varm_text_a(ncid, varid, start, counts, strides, maps, &
623  text) RESULT(status)
625 ! Read in array of characters from dataset given start, count, stride and map
626 
628 
629  Implicit NONE
630 
631  Integer, Intent(IN) :: ncid, varid
632  Integer, Intent(IN) :: start(*), counts(*), strides(*), maps(*)
633  Character(LEN=1), Intent(OUT) :: text(*)
634 
635  Integer :: status
636 
637  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
638  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr, cmapsptr
639  Integer :: ndims
640 
641  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cstart(:), ccounts(:)
642  Integer(C_PTRDIFF_T), ALLOCATABLE, TARGET :: cstrides(:), cmaps(:)
643 
644  cncid = ncid
645  cvarid = varid -1 ! Subtract 1 to get C varid
646 
647  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
648 
649  cstartptr = c_null_ptr
650  ccountsptr = c_null_ptr
651  cstridesptr = c_null_ptr
652  cmapsptr = c_null_ptr
653  ndims = cndims
654 
655  If (cstat1 == nc_noerr) Then
656  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
657  ALLOCATE(cstart(1:ndims))
658  ALLOCATE(ccounts(1:ndims))
659  ALLOCATE(cstrides(1:ndims))
660  ALLOCATE(cmaps(1:ndims))
661  cstart(1:ndims) = start(ndims:1:-1) - 1
662  ccounts(1:ndims) = counts(ndims:1:-1)
663  cstrides(1:ndims) = strides(ndims:1:-1)
664  cmaps(1:ndims) = maps(ndims:1:-1)
665  cstartptr = c_loc(cstart)
666  ccountsptr = c_loc(ccounts)
667  cstridesptr = c_loc(cstrides)
668  cmapsptr = c_loc(cmaps)
669  EndIf
670  EndIf
671 
672  cstatus = nc_get_varm_text(cncid, cvarid, cstartptr, ccountsptr, &
673  cstridesptr, cmapsptr, text)
674 
675  status = cstatus
676 
677 ! Make sure we don't leave any dangling pointers or allocated arrays
678 
679  cstartptr = c_null_ptr
680  ccountsptr = c_null_ptr
681  cstridesptr = c_null_ptr
682  cmapsptr = c_null_ptr
683  If (ALLOCATED(cmaps)) DEALLOCATE(cmaps)
684  If (ALLOCATED(cstrides)) DEALLOCATE(cstrides)
685  If (ALLOCATED(ccounts)) DEALLOCATE(ccounts)
686  If (ALLOCATED(cstart)) DEALLOCATE(cstart)
687 
688  End Function nf_get_varm_text_a
689 !--------------------------------- nf_get_varm_int1 ------------------------
690  Function nf_get_varm_int1(ncid, varid, start, counts, strides, maps, &
691  i1vals) RESULT(status)
693 ! Read in 8 bit integer array given start, count, stride and map
694 
696 
697  Implicit NONE
698 
699  Integer, Intent(IN) :: ncid, varid
700  Integer, Intent(IN) :: start(*), counts(*), strides(*), maps(*)
701  Integer(NFINT1), Intent(OUT) :: i1vals(*)
702 
703  Integer :: status
704 
705  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
706  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr, cmapsptr
707  Integer :: ndims
708 
709  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cstart(:), ccounts(:)
710  Integer(C_PTRDIFF_T), ALLOCATABLE, TARGET :: cstrides(:), cmaps(:)
711 
712  If (c_signed_char < 0) Then ! schar not supported by processor
713  status = nc_ebadtype
714  RETURN
715  EndIf
716 
717  cncid = ncid
718  cvarid = varid -1 ! Subtract 1 to get C varid
719 
720  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
721 
722  cstartptr = c_null_ptr
723  ccountsptr = c_null_ptr
724  cstridesptr = c_null_ptr
725  cmapsptr = c_null_ptr
726  ndims = cndims
727 
728  If (cstat1 == nc_noerr) Then
729  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
730  ALLOCATE(cstart(1:ndims))
731  ALLOCATE(ccounts(1:ndims))
732  ALLOCATE(cstrides(1:ndims))
733  ALLOCATE(cmaps(1:ndims))
734  cstart(1:ndims) = start(ndims:1:-1) - 1
735  ccounts(1:ndims) = counts(ndims:1:-1)
736  cstrides(1:ndims) = strides(ndims:1:-1)
737  cmaps(1:ndims) = maps(ndims:1:-1)
738  cstartptr = c_loc(cstart)
739  ccountsptr = c_loc(ccounts)
740  cstridesptr = c_loc(cstrides)
741  cmapsptr = c_loc(cmaps)
742  EndIf
743  EndIf
744 
745 #if NF_INT1_IS_C_SIGNED_CHAR
746  cstatus = nc_get_varm_schar(cncid, cvarid, cstartptr, ccountsptr, &
747  cstridesptr, cmapsptr, i1vals)
748 #elif NF_INT1_IS_C_SHORT
749  cstatus = nc_get_varm_short(cncid, cvarid, cstartptr, ccountsptr, &
750  cstridesptr, cmapsptr, i1vals)
751 #elif NF_INT1_IS_C_INT
752  cstatus = nc_get_varm_int(cncid, cvarid, cstartptr, ccountsptr, &
753  cstridesptr, cmapsptr, i1vals)
754 #elif NF_INT1_IS_C_LONG
755  cstatus = nc_get_varm_long(cncid, cvarid, cstartptr, ccountsptr, &
756  cstridesptr, cmapsptr, i1vals)
757 #endif
758 
759  status = cstatus
760 
761 ! Make sure we don't leave any dangling pointers or allocated arrays
762 
763  cstartptr = c_null_ptr
764  ccountsptr = c_null_ptr
765  cstridesptr = c_null_ptr
766  cmapsptr = c_null_ptr
767  If (ALLOCATED(cmaps)) DEALLOCATE(cmaps)
768  If (ALLOCATED(cstrides)) DEALLOCATE(cstrides)
769  If (ALLOCATED(ccounts)) DEALLOCATE(ccounts)
770  If (ALLOCATED(cstart)) DEALLOCATE(cstart)
771 
772  End Function nf_get_varm_int1
773 !--------------------------------- nf_get_varm_int2 ------------------------
774  Function nf_get_varm_int2(ncid, varid, start, counts, strides, maps, &
775  i2vals) RESULT(status)
777 ! Read in 16 bit integer array given start, count, stride and map
778 
780 
781  Implicit NONE
782 
783  Integer, Intent(IN) :: ncid, varid
784  Integer, Intent(IN) :: start(*), counts(*), strides(*), maps(*)
785  Integer(NFINT2), Intent(OUT) :: i2vals(*)
786 
787  Integer :: status
788 
789  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
790  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr, cmapsptr
791  Integer :: ndims
792 
793  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cstart(:), ccounts(:)
794  Integer(C_PTRDIFF_T), ALLOCATABLE, TARGET :: cstrides(:), cmaps(:)
795 
796  If (c_short < 0) Then ! short not supported by processor
797  status = nc_ebadtype
798  RETURN
799  EndIf
800 
801  cncid = ncid
802  cvarid = varid -1 ! Subtract 1 to get C varid
803 
804  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
805 
806  cstartptr = c_null_ptr
807  ccountsptr = c_null_ptr
808  cstridesptr = c_null_ptr
809  cmapsptr = c_null_ptr
810  ndims = cndims
811 
812  If (cstat1 == nc_noerr) Then
813  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
814  ALLOCATE(cstart(1:ndims))
815  ALLOCATE(ccounts(1:ndims))
816  ALLOCATE(cstrides(1:ndims))
817  ALLOCATE(cmaps(1:ndims))
818  cstart(1:ndims) = start(ndims:1:-1) - 1
819  ccounts(1:ndims) = counts(ndims:1:-1)
820  cstrides(1:ndims) = strides(ndims:1:-1)
821  cmaps(1:ndims) = maps(ndims:1:-1)
822  cstartptr = c_loc(cstart)
823  ccountsptr = c_loc(ccounts)
824  cstridesptr = c_loc(cstrides)
825  cmapsptr = c_loc(cmaps)
826  EndIf
827  EndIf
828 
829 #if NF_INT2_IS_C_SHORT
830  cstatus = nc_get_varm_short(cncid, cvarid, cstartptr, ccountsptr, &
831  cstridesptr, cmapsptr, i2vals)
832 #elif NF_INT2_IS_C_INT
833  cstatus = nc_get_varm_int(cncid, cvarid, cstartptr, ccountsptr, &
834  cstridesptr, cmapsptr, i2vals)
835 #elif NF_INT2_IS_C_LONG
836  cstatus = nc_get_varm_long(cncid, cvarid, cstartptr, ccountsptr, &
837  cstridesptr, cmapsptr, i2vals)
838 #endif
839 
840  status = cstatus
841 
842 ! Make sure we don't leave any dangling pointers or allocated arrays
843 
844  cstartptr = c_null_ptr
845  ccountsptr = c_null_ptr
846  cstridesptr = c_null_ptr
847  cmapsptr = c_null_ptr
848  If (ALLOCATED(cmaps)) DEALLOCATE(cmaps)
849  If (ALLOCATED(cstrides)) DEALLOCATE(cstrides)
850  If (ALLOCATED(ccounts)) DEALLOCATE(ccounts)
851  If (ALLOCATED(cstart)) DEALLOCATE(cstart)
852 
853  End Function nf_get_varm_int2
854 !--------------------------------- nf_get_varm_int -------------------------
855  Function nf_get_varm_int(ncid, varid, start, counts, strides, maps, &
856  ivals) RESULT(status)
858 ! Read in default integer array given start, count, stride and map
859 
861 
862  Implicit NONE
863 
864  Integer, Intent(IN) :: ncid, varid
865  Integer, Intent(IN) :: start(*), counts(*), strides(*), maps(*)
866  Integer(NFINT), Intent(OUT) :: ivals(*)
867 
868  Integer :: status
869 
870  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
871  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr, cmapsptr
872  Integer :: ndims
873 
874  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cstart(:), ccounts(:)
875  Integer(C_PTRDIFF_T), ALLOCATABLE, TARGET :: cstrides(:), cmaps(:)
876 
877  cncid = ncid
878  cvarid = varid -1 ! Subtract 1 to get C varid
879 
880  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
881 
882  cstartptr = c_null_ptr
883  ccountsptr = c_null_ptr
884  cstridesptr = c_null_ptr
885  cmapsptr = c_null_ptr
886  ndims = cndims
887 
888  If (cstat1 == nc_noerr) Then
889  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
890  ALLOCATE(cstart(1:ndims))
891  ALLOCATE(ccounts(1:ndims))
892  ALLOCATE(cstrides(1:ndims))
893  ALLOCATE(cmaps(1:ndims))
894  cstart(1:ndims) = start(ndims:1:-1) - 1
895  ccounts(1:ndims) = counts(ndims:1:-1)
896  cstrides(1:ndims) = strides(ndims:1:-1)
897  cmaps(1:ndims) = maps(ndims:1:-1)
898  cstartptr = c_loc(cstart)
899  ccountsptr = c_loc(ccounts)
900  cstridesptr = c_loc(cstrides)
901  cmapsptr = c_loc(cmaps)
902  EndIf
903  EndIf
904 
905 #if NF_INT_IS_C_INT
906  cstatus = nc_get_varm_int(cncid, cvarid, cstartptr, ccountsptr, &
907  cstridesptr, cmapsptr, ivals)
908 #elif NF_INT_IS_C_LONG
909  cstatus = nc_get_varm_long(cncid, cvarid, cstartptr, ccountsptr, &
910  cstridesptr, cmapsptr, ivals)
911 #endif
912 
913  status = cstatus
914 
915 ! Make sure we don't leave any dangling pointers or allocated arrays
916 
917  cstartptr = c_null_ptr
918  ccountsptr = c_null_ptr
919  cstridesptr = c_null_ptr
920  cmapsptr = c_null_ptr
921  If (ALLOCATED(cmaps)) DEALLOCATE(cmaps)
922  If (ALLOCATED(cstrides)) DEALLOCATE(cstrides)
923  If (ALLOCATED(ccounts)) DEALLOCATE(ccounts)
924  If (ALLOCATED(cstart)) DEALLOCATE(cstart)
925 
926  End Function nf_get_varm_int
927 !--------------------------------- nf_get_varm_real ------------------------
928  Function nf_get_varm_real(ncid, varid, start, counts, strides, maps, &
929  rvals) RESULT(status)
931 ! Read in 32 bit real array given start, count, stride and map
932 
934 
935  Implicit NONE
936 
937  Integer, Intent(IN) :: ncid, varid
938  Integer, Intent(IN) :: start(*), counts(*), strides(*), maps(*)
939  Real(NFREAL), Intent(OUT) :: rvals(*)
940 
941  Integer :: status
942 
943  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
944  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr, cmapsptr
945  Integer :: ndims
946 
947  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cstart(:), ccounts(:)
948  Integer(C_PTRDIFF_T), ALLOCATABLE, TARGET :: cstrides(:), cmaps(:)
949 
950  cncid = ncid
951  cvarid = varid -1 ! Subtract 1 to get C varid
952 
953  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
954 
955  cstartptr = c_null_ptr
956  ccountsptr = c_null_ptr
957  cstridesptr = c_null_ptr
958  cmapsptr = c_null_ptr
959  ndims = cndims
960 
961  If (cstat1 == nc_noerr) Then
962  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
963  ALLOCATE(cstart(1:ndims))
964  ALLOCATE(ccounts(1:ndims))
965  ALLOCATE(cstrides(1:ndims))
966  ALLOCATE(cmaps(1:ndims))
967  cstart(1:ndims) = start(ndims:1:-1) - 1
968  ccounts(1:ndims) = counts(ndims:1:-1)
969  cstrides(1:ndims) = strides(ndims:1:-1)
970  cmaps(1:ndims) = maps(ndims:1:-1)
971  cstartptr = c_loc(cstart)
972  ccountsptr = c_loc(ccounts)
973  cstridesptr = c_loc(cstrides)
974  cmapsptr = c_loc(cmaps)
975  EndIf
976  EndIf
977 
978 #if NF_REAL_IS_C_DOUBLE
979  cstatus = nc_get_varm_double(cncid, cvarid, cstartptr, ccountsptr, &
980  cstridesptr, cmapsptr, rvals)
981 #else
982  cstatus = nc_get_varm_float(cncid, cvarid, cstartptr, ccountsptr, &
983  cstridesptr, cmapsptr, rvals)
984 #endif
985 
986  status = cstatus
987 
988 ! Make sure we don't leave any dangling pointers or allocated arrays
989 
990  cstartptr = c_null_ptr
991  ccountsptr = c_null_ptr
992  cstridesptr = c_null_ptr
993  cmapsptr = c_null_ptr
994  If (ALLOCATED(cmaps)) DEALLOCATE(cmaps)
995  If (ALLOCATED(cstrides)) DEALLOCATE(cstrides)
996  If (ALLOCATED(ccounts)) DEALLOCATE(ccounts)
997  If (ALLOCATED(cstart)) DEALLOCATE(cstart)
998 
999  End Function nf_get_varm_real
1000 !--------------------------------- nf_get_varm_double ----------------------
1001  Function nf_get_varm_double(ncid, varid, start, counts, strides, maps, &
1002  dvals) RESULT(status)
1004 ! Read in 64 bit real array given start, count, stride and map
1005 
1007 
1008  Implicit NONE
1009 
1010  Integer, Intent(IN) :: ncid, varid
1011  Integer, Intent(IN) :: start(*), counts(*), strides(*), maps(*)
1012  Real(RK8), Intent(OUT) :: dvals(*)
1013 
1014  Integer :: status
1015 
1016  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
1017  Type(c_ptr) :: cstartptr, ccountsptr, cstridesptr, cmapsptr
1018  Integer :: ndims
1019 
1020  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cstart(:), ccounts(:)
1021  Integer(C_PTRDIFF_T), ALLOCATABLE, TARGET :: cstrides(:), cmaps(:)
1022 
1023  cncid = ncid
1024  cvarid = varid -1 ! Subtract 1 to get C varid
1025 
1026  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
1027 
1028  cstartptr = c_null_ptr
1029  ccountsptr = c_null_ptr
1030  cstridesptr = c_null_ptr
1031  cmapsptr = c_null_ptr
1032  ndims = cndims
1033 
1034  If (cstat1 == nc_noerr) Then
1035  If (ndims > 0) Then ! Flip arrays to C order and subtract 1 from start
1036  ALLOCATE(cstart(1:ndims))
1037  ALLOCATE(ccounts(1:ndims))
1038  ALLOCATE(cstrides(1:ndims))
1039  ALLOCATE(cmaps(1:ndims))
1040  cstart(1:ndims) = start(ndims:1:-1) - 1
1041  ccounts(1:ndims) = counts(ndims:1:-1)
1042  cstrides(1:ndims) = strides(ndims:1:-1)
1043  cmaps(1:ndims) = maps(ndims:1:-1)
1044  cstartptr = c_loc(cstart)
1045  ccountsptr = c_loc(ccounts)
1046  cstridesptr = c_loc(cstrides)
1047  cmapsptr = c_loc(cmaps)
1048  EndIf
1049  EndIf
1050 
1051  cstatus = nc_get_varm_double(cncid, cvarid, cstartptr, ccountsptr, &
1052  cstridesptr, cmapsptr, dvals)
1053 
1054  status = cstatus
1055 
1056 ! Make sure we don't leave any dangling pointers or allocated arrays
1057 
1058  cstartptr = c_null_ptr
1059  ccountsptr = c_null_ptr
1060  cstridesptr = c_null_ptr
1061  cmapsptr = c_null_ptr
1062  If (ALLOCATED(cmaps)) DEALLOCATE(cmaps)
1063  If (ALLOCATED(cstrides)) DEALLOCATE(cstrides)
1064  If (ALLOCATED(ccounts)) DEALLOCATE(ccounts)
1065  If (ALLOCATED(cstart)) DEALLOCATE(cstart)
1066 
1067  End Function nf_get_varm_double
integer function nf_put_varm_text(ncid, varid, start, counts, strides, maps, text)
Definition: nf_varmio.F90:40
integer function nf_get_varm_text_a(ncid, varid, start, counts, strides, maps, text)
Definition: nf_varmio.F90:624
integer function nf_put_varm_int2(ncid, varid, start, counts, strides, maps, i2vals)
Definition: nf_varmio.F90:260
integer function nf_put_varm_text_a(ncid, varid, start, counts, strides, maps, text)
Definition: nf_varmio.F90:108
integer function nf_get_varm_int1(ncid, varid, start, counts, strides, maps, i1vals)
Definition: nf_varmio.F90:692
integer function nf_get_varm_text(ncid, varid, start, counts, strides, maps, text)
Definition: nf_varmio.F90:555
integer function nf_get_varm_real(ncid, varid, start, counts, strides, maps, rvals)
Definition: nf_varmio.F90:930
integer function nf_put_varm_int1(ncid, varid, start, counts, strides, maps, i1vals)
Definition: nf_varmio.F90:176
integer(c_int), parameter nc_ebadtype
integer(c_int), parameter nc_noerr
integer function nf_get_varm_int(ncid, varid, start, counts, strides, maps, ivals)
Definition: nf_varmio.F90:857
integer function nf_put_varm_double(ncid, varid, start, counts, strides, maps, dvals)
Definition: nf_varmio.F90:487
integer function nf_get_varm_int2(ncid, varid, start, counts, strides, maps, i2vals)
Definition: nf_varmio.F90:776
integer function nf_put_varm_real(ncid, varid, start, counts, strides, maps, rvals)
Definition: nf_varmio.F90:414
integer function nf_put_varm_int(ncid, varid, start, counts, strides, maps, ivals)
Definition: nf_varmio.F90:341
integer function nf_get_varm_double(ncid, varid, start, counts, strides, maps, dvals)
Definition: nf_varmio.F90:1003

Return to the Main Unidata NetCDF page.
Generated on Fri Oct 27 2017 08:12:17 for NetCDF-Fortran. NetCDF is a Unidata library.