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

Return to the Main Unidata NetCDF page.
Generated on Sun Dec 27 2015 13:19:49 for NetCDF-Fortran. NetCDF is a Unidata library.