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

Return to the Main Unidata NetCDF page.
Generated on Tue Jul 17 2018 12:21:03 for NetCDF-Fortran. NetCDF is a Unidata library.