NetCDF-Fortran  4.4.4
 All Classes Files Functions Variables Typedefs Macros Pages
nf_var1io.F90
Go to the documentation of this file.
1 #include "nfconfig.inc"
2 !----- Routines to put/get single data items of a variety of data types ------
3 
4 ! Replacement for fort-var1io.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 ndex as C_PTR variable
28 ! Version 3.: April 2009 - Updated for netCDF 4.0.1
29 ! Version 4.: April 2010 - Updated for netCDF 4.1.1
30 ! Added preprocessor test for int and real types
31 ! Version 5.: Jan. 2016 - Replace automatic array for cndex with allocatable
32 ! array and general code cleanup
33 
34 !--------------------------------- nf_put_var1_text ------------------------
35  Function nf_put_var1_text(ncid, varid, ndex, chval) RESULT(status)
36 
37 ! Write out a single character variable to location vector ndex in dataset
38 
40 
41  Implicit NONE
42 
43  Integer, Intent(IN) :: ncid, varid
44  Integer, Intent(IN) :: ndex(*)
45  Character(LEN=1), Intent(IN) :: chval
46 
47  Integer :: status
48 
49  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
50  Type(c_ptr) :: cndexptr
51  Integer :: ndims
52 
53  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cndex(:)
54 
55  cncid = ncid
56  cvarid = varid - 1 ! Subtract one to get C varid
57 
58  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
59 
60  cndexptr = c_null_ptr
61  ndims = cndims
62 
63  If (cstat1 == nc_noerr) Then
64  If (ndims > 0) Then ! reverse array order and subtract 1 to get C index
65  ALLOCATE(cndex(ndims))
66  cndex(1:ndims) = ndex(ndims:1:-1) - 1
67  cndexptr = c_loc(cndex)
68  EndIf
69  EndIf
70 
71  cstatus = nc_put_var1_text(cncid, cvarid, cndexptr, chval)
72 
73  status = cstatus
74 
75 ! Make sure there are no dangling pointers or allocated arrays
76 
77  cndexptr = c_null_ptr
78  If (ALLOCATED(cndex)) DEALLOCATE(cndex)
79 
80  End Function nf_put_var1_text
81 !--------------------------------- nf_put_var1_int1 ------------------------
82  Function nf_put_var1_int1(ncid, varid, ndex, ival) RESULT(status)
83 
84 ! Write out a 8 bit integer variable to location vector ndex in dataset
85 
87 
88  Implicit NONE
89 
90  Integer, Intent(IN) :: ncid, varid
91  Integer, Intent(IN) :: ndex(*)
92  Integer(NFINT1), Intent(IN) :: ival
93 
94  Integer :: status
95 
96  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
97  Type(c_ptr) :: cndexptr
98  Integer(CINT1) :: cival
99  Integer :: ndims
100 
101  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cndex(:)
102 
103  If (c_signed_char < 0) Then ! schar not supported by processor exit
104  status = nc_ebadtype
105  RETURN
106  EndIf
107 
108  cncid = ncid
109  cvarid = varid - 1 ! Subtract one to get C varid
110  cival = ival
111 
112  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
113 
114  cndexptr = c_null_ptr
115  ndims = cndims
116 
117  If (cstat1 == nc_noerr) Then
118  If (ndims > 0) Then ! reverse array order and subtract 1 to get C index
119  ALLOCATE(cndex(ndims))
120  cndex(1:ndims) = ndex(ndims:1:-1) - 1
121  cndexptr = c_loc(cndex)
122  EndIf
123  EndIf
124 
125 #if NF_INT1_IS_C_SIGNED_CHAR
126  cstatus = nc_put_var1_schar(cncid, cvarid, cndexptr, cival)
127 #elif NF_INT1_IS_C_SHORT
128  cstatus = nc_put_var1_short(cncid, cvarid, cndexptr, cival)
129 #elif NF_INT1_IS_C_INT
130  cstatus = nc_put_var1_int(cncid, cvarid, cndexptr, cival)
131 #elif NF_INT1_IS_C_LONG
132  cstatus = nc_put_var1_long(cncid, cvarid, cndexptr, cival)
133 #endif
134 
135  status = cstatus
136 
137 ! Make sure there are no dangling pointers or allocated arrays
138 
139  cndexptr = c_null_ptr
140  If (ALLOCATED(cndex)) DEALLOCATE(cndex)
141 
142  End Function nf_put_var1_int1
143 !--------------------------------- nf_put_var1_int2 ------------------------
144  Function nf_put_var1_int2(ncid, varid, ndex, ival) RESULT(status)
145 
146 ! Write out a 16 bit integer variable to location vector ndex in dataset
147 
149 
150  Implicit NONE
151 
152  Integer, Intent(IN) :: ncid, varid
153  Integer, Intent(IN) :: ndex(*)
154  Integer(NFINT2), Intent(IN) :: ival
155 
156  Integer :: status
157 
158  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
159  Type(c_ptr) :: cndexptr
160  Integer(CINT2) :: cival
161  Integer :: ndims
162 
163  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cndex(:)
164 
165  If (c_short < 0) Then ! short not supported by processor
166  status = nc_ebadtype
167  RETURN
168  EndIf
169 
170  cncid = ncid
171  cvarid = varid - 1 ! Subtract one to get C varid
172  cival = ival
173 
174  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
175 
176  cndexptr = c_null_ptr
177  ndims = cndims
178 
179  If (cstat1 == nc_noerr) Then
180  If (ndims > 0) Then ! reverse array order and subtract 1 to get C index
181  ALLOCATE(cndex(ndims))
182  cndex(1:ndims) = ndex(ndims:1:-1) - 1
183  cndexptr = c_loc(cndex)
184  EndIf
185  EndIf
186 
187 #if NF_INT2_IS_C_SHORT
188  cstatus = nc_put_var1_short(cncid, cvarid, cndexptr, cival)
189 #elif NF_INT2_IS_C_INT
190  cstatus = nc_put_var1_int(cncid, cvarid, cndexptr, cival)
191 #elif NF_INT2_IS_C_LONG
192  cstatus = nc_put_var1_long(cncid, cvarid, cndexptr, cival)
193 #endif
194 
195  status = cstatus
196 
197 ! Make sure there are no dangling pointers or allocated arrays
198 
199  cndexptr = c_null_ptr
200  If (ALLOCATED(cndex)) DEALLOCATE(cndex)
201 
202  End Function nf_put_var1_int2
203 !--------------------------------- nf_put_var1_int -------------------------
204  Function nf_put_var1_int(ncid, varid, ndex, ival) RESULT(status)
205 
206 ! Write out a default integer variable to location vector ndex to dataset
207 
209 
210  Implicit NONE
211 
212  Integer, Intent(IN) :: ncid, varid
213  Integer, Intent(IN) :: ndex(*)
214  Integer(NFINT), Intent(IN) :: ival
215 
216  Integer :: status
217 
218  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
219  Type(c_ptr) :: cndexptr
220  Integer(CINT) :: cival
221  Integer :: ndims
222 
223  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cndex(:)
224 
225  cncid = ncid
226  cvarid = varid - 1 ! Subtract one to get C varid
227  cival = ival
228 
229  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
230 
231  cndexptr = c_null_ptr
232  ndims = cndims
233 
234  If (cstat1 == nc_noerr) Then
235  If (ndims > 0) Then ! reverse array order and subtract 1 to get C index
236  ALLOCATE(cndex(ndims))
237  cndex(1:ndims) = ndex(ndims:1:-1) - 1
238  cndexptr = c_loc(cndex)
239  EndIf
240  EndIf
241 
242 #if NF_INT_IS_C_INT
243  cstatus = nc_put_var1_int(cncid, cvarid, cndexptr, cival)
244 #elif NF_INT_IS_C_LONG
245  cstatus = nc_put_var1_long(cncid, cvarid, cndexptr, cival)
246 #endif
247 
248  status = cstatus
249 
250 ! Make sure there are no dangling pointers or allocated arrays
251 
252  cndexptr = c_null_ptr
253  If (ALLOCATED(cndex)) DEALLOCATE(cndex)
254 
255  End Function nf_put_var1_int
256 !--------------------------------- nf_put_var1_real ------------------------
257  Function nf_put_var1_real(ncid, varid, ndex, rval) RESULT(status)
258 
259 ! Write out a 32 bit real variable to location vector ndex in dataset
260 
262 
263  Implicit NONE
264 
265  Integer, Intent(IN) :: ncid, varid
266  Integer, Intent(IN) :: ndex(*)
267  Real(NFREAL), Intent(IN) :: rval
268 
269  Integer :: status
270 
271  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
272  Type(c_ptr) :: cndexptr
273  Integer :: ndims
274 
275  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cndex(:)
276 
277  cncid = ncid
278  cvarid = varid - 1 ! Subtract one to get C varid
279 
280  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
281 
282  cndexptr = c_null_ptr
283  ndims = cndims
284 
285  If (cstat1 == nc_noerr) Then
286  If (ndims > 0) Then ! reverse array order and subtract 1 to get C index
287  ALLOCATE(cndex(ndims))
288  cndex(1:ndims) = ndex(ndims:1:-1) - 1
289  cndexptr = c_loc(cndex)
290  EndIf
291  EndIf
292 
293 #if NF_REAL_IS_C_DOUBLE
294  cstatus = nc_put_var1_double(cncid, cvarid, cndexptr, rval)
295 #else
296  cstatus = nc_put_var1_float(cncid, cvarid, cndexptr, rval)
297 #endif
298 
299  status = cstatus
300 
301 ! Make sure there are no dangling pointers or allocated arrays
302 
303  cndexptr = c_null_ptr
304  If (ALLOCATED(cndex)) DEALLOCATE(cndex)
305 
306  End Function nf_put_var1_real
307 !--------------------------------- nf_put_var1_double ----------------------
308  Function nf_put_var1_double(ncid, varid, ndex, dval) RESULT(status)
309 
310 ! Write out a 64 bit real variable to location vector ndex in dataset
311 
313 
314  Implicit NONE
315 
316  Integer, Intent(IN) :: ncid, varid
317  Integer, Intent(IN) :: ndex(*)
318  Real(RK8), Intent(IN) :: dval
319 
320  Integer :: status
321 
322  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
323  Type(c_ptr) :: cndexptr
324  Integer :: ndims
325 
326  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cndex(:)
327 
328  cncid = ncid
329  cvarid = varid - 1 ! Subtract one to get C varid
330 
331  cstat1 = nc_inq_varndims(cncid, cvarid, cndims) ! get varid dimension
332 
333  cndexptr = c_null_ptr
334  ndims = cndims
335 
336  If (cstat1 == nc_noerr) Then
337  If (ndims > 0) Then
338  ALLOCATE(cndex(ndims))
339  cndex(1:ndims) = ndex(ndims:1:-1) - 1
340  cndexptr = c_loc(cndex)
341  EndIf
342  EndIf
343 
344  cstatus = nc_put_var1_double(cncid, cvarid, cndexptr, dval)
345 
346  status = cstatus
347 
348 ! Make sure there are no dangling pointers or allocated arrays
349 
350  cndexptr = c_null_ptr
351  If (ALLOCATED(cndex)) DEALLOCATE(cndex)
352 
353  End Function nf_put_var1_double
354 !--------------------------------- nf_put_var1 ------------------------
355  Function nf_put_var1(ncid, varid, ndex, values) RESULT(status)
356 
357 ! Write out values of any type. We use a C interop character string to
358 ! hold values. Therefore, an explicit interface to nf_put_var1 should
359 ! not be defined in the calling program to avoid rigid TKR conflict
360 ! Just declare it external
361 
363 
364  Implicit NONE
365 
366  Integer, Intent(IN) :: ncid, varid
367  Integer, Intent(IN) :: ndex(*)
368  Character(KIND=C_CHAR), Intent(IN), TARGET :: values(*)
369 
370  Integer :: status
371 
372  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
373  Type(c_ptr) :: cndexptr, cvaluesptr
374  Integer :: ndims
375 
376  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cndex(:)
377 
378  cncid = ncid
379  cvarid = varid - 1 ! Subtract one to get C varid
380 
381  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
382 
383  cndexptr = c_null_ptr
384  ndims = cndims
385 
386  If (cstat1 == nc_noerr) Then
387  If (ndims > 0) Then ! reverse array order and subtract 1 to get C index
388  ALLOCATE(cndex(ndims))
389  cndex(1:ndims) = ndex(ndims:1:-1) - 1
390  cndexptr = c_loc(cndex)
391  Else
392  ALLOCATE(cndex(1))
393  cndex(1:ndims) = ndex(ndims:1:-1) - 1
394  cndexptr = c_loc(cndex)
395  EndIf
396  EndIf
397 
398  cvaluesptr = c_loc(values)
399 
400  cstatus = nc_put_var1(cncid, cvarid, cndexptr, cvaluesptr)
401 
402  status = cstatus
403 
404 ! Make sure there are no dangling pointers or allocated arrays
405 
406  cndexptr = c_null_ptr
407  If (ALLOCATED(cndex)) DEALLOCATE(cndex)
408 
409  End Function nf_put_var1
410 !--------------------------------- nf_get_var1_text ------------------------
411  Function nf_get_var1_text(ncid, varid, ndex, chval) RESULT(status)
412 
413 ! Read in a single character variable from location vector ndex in dataset
414 
416 
417  Implicit NONE
418 
419  Integer, Intent(IN) :: ncid, varid
420  Integer, Intent(IN) :: ndex(*)
421  Character(LEN=1), Intent(OUT) :: chval
422 
423  Integer :: status
424 
425  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
426  Type(c_ptr) :: cndexptr
427  Integer :: ndims
428 
429  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cndex(:)
430 
431  cncid = ncid
432  cvarid = varid - 1 ! Subtract one to get C varid
433  chval = ' '
434 
435  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
436 
437  cndexptr = c_null_ptr
438  ndims = cndims
439 
440  If (cstat1 == nc_noerr) Then
441  If (ndims > 0) Then ! reverse array order and subtract 1 to get C index
442  ALLOCATE(cndex(ndims))
443  cndex(1:ndims) = ndex(ndims:1:-1) -1
444  cndexptr = c_loc(cndex)
445  EndIf
446  EndIf
447 
448  cstatus = nc_get_var1_text(cncid, cvarid, cndexptr, chval)
449 
450  status = cstatus
451 
452 ! Make sure there are no dangling pointers or allocated arrays
453 
454  cndexptr = c_null_ptr
455  If (ALLOCATED(cndex)) DEALLOCATE(cndex)
456 
457  End Function nf_get_var1_text
458 !--------------------------------- nf_get_var1_int1 ------------------------
459  Function nf_get_var1_int1(ncid, varid, ndex, ival) RESULT(status)
460 
461 ! Read in a 8 bit integer variable from location vector ndex in dataset
462 
464 
465  Implicit NONE
466 
467  Integer, Intent(IN) :: ncid, varid
468  Integer, Intent(IN) :: ndex(*)
469  Integer(NFINT1), Intent(OUT) :: ival
470 
471  Integer :: status
472 
473  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
474  Type(c_ptr) :: cndexptr
475  Integer(CINT1) :: cival
476  Integer :: ndims
477 
478  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cndex(:)
479 
480  If (c_signed_char < 0) Then ! schar not supported by processor exit
481  status = nc_ebadtype
482  RETURN
483  EndIf
484 
485  cncid = ncid
486  cvarid = varid - 1 ! Subtract one to get C varid
487 
488  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
489 
490  cndexptr = c_null_ptr
491  ndims = cndims
492 
493  If (cstat1 == nc_noerr) Then
494  If (ndims > 0) Then ! reverse array order and subtract 1 to get C index
495  ALLOCATE(cndex(ndims))
496  cndex(1:ndims) = ndex(ndims:1:-1) - 1
497  cndexptr = c_loc(cndex)
498  EndIf
499  EndIf
500 
501 #if NF_INT1_IS_C_SIGNED_CHAR
502  cstatus = nc_get_var1_schar(cncid, cvarid, cndexptr, cival)
503 #elif NF_INT1_IS_C_SHORT
504  cstatus = nc_get_var1_short(cncid, cvarid, cndexptr, cival)
505 #elif NF_INT1_IS_C_INT
506  cstatus = nc_get_var1_int(cncid, cvarid, cndexptr, cival)
507 #elif NF_INT1_IS_C_LONG
508  cstatus = nc_get_var1_long(cncid, cvarid, cndexptr, cival)
509 #endif
510 
511  ival = cival
512  status = cstatus
513 
514 ! Make sure there are no dangling pointers or allocated arrays
515 
516  cndexptr = c_null_ptr
517  If (ALLOCATED(cndex)) DEALLOCATE(cndex)
518 
519  End Function nf_get_var1_int1
520 !--------------------------------- nf_get_var1_int2 ------------------------
521  Function nf_get_var1_int2(ncid, varid, ndex, ival) RESULT(status)
522 
523 ! Read in a 16 bit integer variable from location vector ndex in dataset
524 
526 
527  Implicit NONE
528 
529  Integer, Intent(IN) :: ncid, varid
530  Integer, Intent(IN) :: ndex(*)
531  Integer(NFINT2), Intent(OUT) :: ival
532 
533  Integer :: status
534 
535  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
536  Type(c_ptr) :: cndexptr
537  Integer(CINT2) :: cival
538  Integer :: ndims
539 
540  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cndex(:)
541 
542  If (c_short < 0) Then ! short not supported by processor
543  status = nc_ebadtype
544  RETURN
545  EndIf
546 
547  cncid = ncid
548  cvarid = varid - 1 ! Subtract one to get C varid
549 
550  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
551 
552  cndexptr = c_null_ptr
553  ndims = cndims
554 
555  If (cstat1 == nc_noerr) Then
556  If (ndims > 0) Then ! reverse array order and subtract 1 to get C index
557  ALLOCATE(cndex(ndims))
558  cndex(1:ndims) = ndex(ndims:1:-1) - 1
559  cndexptr = c_loc(cndex)
560  EndIf
561  EndIf
562 
563 #if NF_INT2_IS_C_SHORT
564  cstatus = nc_get_var1_short(cncid, cvarid, cndexptr, cival)
565 #elif NF_INT2_IS_C_INT
566  cstatus = nc_get_var1_int(cncid, cvarid, cndexptr, cival)
567 #elif NF_INT2_IS_C_LONG
568  cstatus = nc_get_var1_long(cncid, cvarid, cndexptr, cival)
569 #endif
570 
571  ival = cival
572  status = cstatus
573 
574 ! Make sure there are no dangling pointers or allocated arrays
575 
576  cndexptr = c_null_ptr
577  If (ALLOCATED(cndex)) DEALLOCATE(cndex)
578 
579  End Function nf_get_var1_int2
580 !--------------------------------- nf_get_var1_int -------------------------
581  Function nf_get_var1_int(ncid, varid, ndex, ival) RESULT(status)
582 
583 ! Read in 32 bit integer variable from location vector ndex in dataset
584 
586 
587  Implicit NONE
588 
589  Integer, Intent(IN) :: ncid, varid
590  Integer, Intent(IN) :: ndex(*)
591  Integer, Intent(OUT) :: ival
592 
593  Integer :: status
594 
595  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
596  Type(c_ptr) :: cndexptr
597  Integer(CINT) :: cival
598  Integer :: ndims
599 
600  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cndex(:)
601 
602  cncid = ncid
603  cvarid = varid - 1 ! Subtract one to get C varid
604 
605  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
606 
607  cndexptr = c_null_ptr
608  ndims = cndims
609 
610  If (cstat1 == nc_noerr) Then
611  If (ndims > 0) Then ! reverse array order and subtract 1 to get C index
612  ALLOCATE(cndex(ndims))
613  cndex(1:ndims) = ndex(ndims:1:-1) - 1
614  cndexptr = c_loc(cndex)
615  EndIf
616  EndIf
617 
618 #if NF_INT_IS_C_INT
619  cstatus = nc_get_var1_int(cncid, cvarid, cndexptr, cival)
620 #elif NF_INT_IS_C_LONG
621  cstatus = nc_get_var1_long(cncid, cvarid, cndexptr, cival)
622 #endif
623 
624  ival = cival
625  status = cstatus
626 
627 ! Make sure there are no dangling pointers or allocated arrays
628 
629  cndexptr = c_null_ptr
630  If (ALLOCATED(cndex)) DEALLOCATE(cndex)
631 
632  End Function nf_get_var1_int
633 !--------------------------------- nf_get_var1_real ------------------------
634  Function nf_get_var1_real(ncid, varid, ndex, rval) RESULT(status)
635 
636 ! Read in a 32 bit real variable to location vector ndex in dataset
637 
639 
640  Implicit NONE
641 
642  Integer, Intent(IN) :: ncid, varid
643  Integer, Intent(IN) :: ndex(*)
644  Real(NFREAL), Intent(OUT) :: rval
645 
646  Integer :: status
647 
648  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
649  Type(c_ptr) :: cndexptr
650  Integer :: ndims
651 
652  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cndex(:)
653 
654  cncid = ncid
655  cvarid = varid - 1 ! Subtract one to get C varid
656 
657  cstat1 = nc_inq_varndims(cncid, cvarid, cndims)
658 
659  cndexptr = c_null_ptr
660  ndims = cndims
661 
662  If (cstat1 == nc_noerr) Then
663  If (ndims > 0) Then ! reverse array order and subtract 1 to get C index
664  ALLOCATE(cndex(ndims))
665  cndex(1:ndims) = ndex(ndims:1:-1) - 1
666  cndexptr = c_loc(cndex)
667  EndIf
668  EndIf
669 
670 #if NF_REAL_IS_C_DOUBLE
671  cstatus = nc_get_var1_double(cncid, cvarid, cndexptr, rval)
672 #else
673  cstatus = nc_get_var1_float(cncid, cvarid, cndexptr, rval)
674 #endif
675 
676  status = cstatus
677 
678 ! Make sure there are no dangling pointers or allocated arrays
679 
680  cndexptr = c_null_ptr
681  If (ALLOCATED(cndex)) DEALLOCATE(cndex)
682 
683  End Function nf_get_var1_real
684 !--------------------------------- nf_get_var1_double ----------------------
685  Function nf_get_var1_double(ncid, varid, ndex, dval) RESULT(status)
686 
687 ! Read in a 64 bit real variable to location vector ndex in dataset
688 
690 
691  Implicit NONE
692 
693  Integer, Intent(IN) :: ncid, varid
694  Integer, Intent(IN) :: ndex(*)
695  Real(RK8), Intent(OUT) :: dval
696 
697  Integer :: status
698 
699  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
700  Type(c_ptr) :: cndexptr
701  Integer :: ndims
702 
703  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cndex(:)
704 
705  cncid = ncid
706  cvarid = varid - 1 ! Subtract one to get C varid
707 
708  cstat1 = nc_inq_varndims(cncid, cvarid, cndims) ! get varid dimension
709 
710  cndexptr = c_null_ptr
711  ndims = cndims
712 
713  If (cstat1 == nc_noerr) Then
714  If (ndims > 0) Then ! reverse array order and subtract 1 to get C index
715  ALLOCATE(cndex(ndims))
716  cndex(1:ndims) = ndex(ndims:1:-1) - 1
717  cndexptr = c_loc(cndex)
718  EndIf
719  EndIf
720 
721  cstatus = nc_get_var1_double(cncid, cvarid, cndexptr, dval)
722 
723  status = cstatus
724 
725 ! Make sure there are no dangling pointers or allocated arrays
726 
727  cndexptr = c_null_ptr
728  If (ALLOCATED(cndex)) DEALLOCATE(cndex)
729 
730  End Function nf_get_var1_double
731 !--------------------------------- nf_get_var1 -------------------------------
732  Function nf_get_var1(ncid, varid, ndex, values) RESULT(status)
733 
734 ! Read in values of any type. We use a C interop character string to
735 ! hold values. Therefore, an explicit interface to nf_get_var1 should
736 ! not be defined in the calling program to avoid rigid TKR conflict
737 ! Just declare it external
738 
740 
741  Implicit NONE
742 
743  Integer, Intent(IN) :: ncid, varid
744  Integer, Intent(IN) :: ndex(*)
745  Character(KIND=C_CHAR), Intent(OUT), TARGET :: values(*)
746 
747  Integer :: status
748 
749  Integer(C_INT) :: cncid, cvarid, cndims, cstat1, cstatus
750  Type(c_ptr) :: cndexptr, cvaluesptr
751  Integer :: ndims
752 
753  Integer(C_SIZE_T), ALLOCATABLE, TARGET :: cndex(:)
754 
755  cncid = ncid
756  cvarid = varid - 1 ! Subtract one to get C varid
757 
758  cstat1 = nc_inq_varndims(cncid, cvarid, cndims) ! get varid dimension
759 
760  cndexptr = c_null_ptr
761  ndims = cndims
762 
763  If (cstat1 == nc_noerr) Then
764  If (ndims > 0) Then ! reverse array order and subtract 1 to get C index
765  ALLOCATE(cndex(ndims))
766  cndex(1:ndims) = ndex(ndims:1:-1) - 1
767  cndexptr = c_loc(cndex)
768  EndIf
769  EndIf
770 
771  cstatus = nc_get_var1(cncid, cvarid, cndexptr, values)
772 
773  status = cstatus
774 
775 ! Make sure there are no dangling pointers or allocated arrays
776 
777  cndexptr = c_null_ptr
778  If (ALLOCATED(cndex)) DEALLOCATE(cndex)
779 
780  End Function nf_get_var1
integer function nf_get_var1_double(ncid, varid, ndex, dval)
Definition: nf_var1io.F90:685
integer function nf_put_var1_int2(ncid, varid, ndex, ival)
Definition: nf_var1io.F90:144
integer function nf_put_var1_double(ncid, varid, ndex, dval)
Definition: nf_var1io.F90:308
integer function nf_put_var1_int1(ncid, varid, ndex, ival)
Definition: nf_var1io.F90:82
integer function nf_get_var1_text(ncid, varid, ndex, chval)
Definition: nf_var1io.F90:411
integer function nf_get_var1_int(ncid, varid, ndex, ival)
Definition: nf_var1io.F90:581
integer function nf_put_var1_int(ncid, varid, ndex, ival)
Definition: nf_var1io.F90:204
integer function nf_put_var1_real(ncid, varid, ndex, rval)
Definition: nf_var1io.F90:257
integer function nf_get_var1_int2(ncid, varid, ndex, ival)
Definition: nf_var1io.F90:521
integer function nf_get_var1(ncid, varid, ndex, values)
Definition: nf_var1io.F90:732
integer function nf_get_var1_int1(ncid, varid, ndex, ival)
Definition: nf_var1io.F90:459
integer function nf_get_var1_real(ncid, varid, ndex, rval)
Definition: nf_var1io.F90:634
integer function nf_put_var1(ncid, varid, ndex, values)
Definition: nf_var1io.F90:355
integer function nf_put_var1_text(ncid, varid, ndex, chval)
Definition: nf_var1io.F90:35

Return to the Main Unidata NetCDF page.
Generated on Mon Dec 19 2016 16:43:43 for NetCDF-Fortran. NetCDF is a Unidata library.