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

Return to the Main Unidata NetCDF page.
Generated on Sun Mar 27 2016 13:46:12 for NetCDF-Fortran. NetCDF is a Unidata library.