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

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