NetCDF-Fortran  4.4.3
module_netcdf_fortv2_c_interfaces.f90
1 Module netcdf_fortv2_c_interfaces
2 
3 ! Fortran 20003 interfaces to C routines in fort_v2compat.c called by
4 ! the V2 Fortran interfaces. Interface routine names are the same
5 ! as the C routine names.
6 
7 ! Written by : Richard Weed, Ph.D.
8 ! Center for Advanced Vehicular Systems
9 ! Mississipi State University
10 ! rweed@cavs.msstate.edu
11 
12 
13 ! License (and other Lawyer Language)
14 
15 ! This software is released under the Apache 2.0 Open Source License. The
16 ! full text of the License can be viewed at :
17 !
18 ! http:www.apache.org/licenses/LICENSE-2.0.html
19 !
20 ! The author grants to the University Corporation for Atmospheric Research
21 ! (UCAR), Boulder, CO, USA the right to revise and extend the software
22 ! without restriction. However, the author retains all copyrights and
23 ! intellectual property rights explicitly stated in or implied by the
24 ! Apache license
25 
26 ! Version 1.: May, 2006 - Initial version 2 interfaces
27 ! Version 2.; April, 2009 - Redone to reflect passing void data types
28 ! in C with C_PTR and C_CHAR strings and
29 ! NetCDF 4.0.1
30 ! Version 3.; April, 2010 - Updated to NetCDF 4.1.1
31 
32 ! USE ISO_C_BINDING
33 
34 ! USE NETCDF_NC_DATA, ONLY: C_PTRDIFF_T
35 ! USE NETCDF_NC_INTERFACES, ONLY: addCNullChar, stripCNullChar
36  USE netcdf_nc_interfaces
37 
38  Implicit NONE
39 
40 ! The following interfaces are for the netCDF V2 functions. Note that
41 ! the actual C routines return a void pointer for arrays etc. This
42 ! forced me to adopt a commonly used kludge for interfacing old Fortran
43 ! 77 with C, namely, passing the void pointer to an array of C_CHARs.
44 
45 ! Also note that each interface has an explicit USE ISO_C_BINDING. A better
46 ! solution is to use the F2003 IMPORT statement (I originally had it this way)
47 ! However its best to leave the interfaces as is for now because there might
48 ! be a few compilers out there that support most of the C-interop facility but
49 ! for some reason haven't implemented IMPORT yet.
50 
51 ! Begin fortv2 C interface definitions
52 
53 !-------------------------------- c_ncpopt ------------------------------------
54 Interface
55  Subroutine c_ncpopt(val) BIND(C)
56 
57  USE iso_c_binding, ONLY: c_int
58 
59  Integer(KIND=C_INT), VALUE :: val
60 
61  End Subroutine c_ncpopt
62 End Interface
63 !-------------------------------- c_ncgopt ------------------------------------
64 Interface
65  Subroutine c_ncgopt(val) BIND(C)
66 
67  USE iso_c_binding, ONLY: c_int
68 
69  Integer(KIND=C_INT), Intent(OUT) :: val
70 
71  End Subroutine c_ncgopt
72 End Interface
73 !-------------------------------- c_nccre -------------------------------------
74 Interface
75  Function c_nccre(pathname, clobmode, rcode) BIND(C)
76 
77  USE iso_c_binding, ONLY: c_int, c_char
78 
79  Character(KIND=C_CHAR), Intent(IN) :: pathname(*)
80  Integer(KIND=C_INT), VALUE :: clobmode
81  Integer(KIND=C_INT), Intent(OUT) :: rcode
82 
83  Integer(KIND=C_INT) :: c_nccre
84 
85  End Function c_nccre
86 End Interface
87 !-------------------------------- c_ncopn -------------------------------------
88 Interface
89  Function c_ncopn(pathname, rwmode, rcode) BIND(C)
90 
91  USE iso_c_binding, ONLY: c_int, c_char
92 
93  Character(KIND=C_CHAR), Intent(IN) :: pathname(*)
94  Integer(KIND=C_INT), VALUE :: rwmode
95  Integer(KIND=C_INT), Intent(OUT) :: rcode
96 
97  Integer(KIND=C_INT) :: c_ncopn
98 
99  End Function c_ncopn
100 End Interface
101 !-------------------------------- c_ncddef ------------------------------------
102 Interface
103  Function c_ncddef(ncid, dimname, dimlen, rcode) BIND(C)
104 
105  USE iso_c_binding, ONLY: c_int, c_char
106 
107  Integer(KIND=C_INT), VALUE :: ncid, dimlen
108  Character(KIND=C_CHAR), Intent(IN) :: dimname(*)
109  Integer(KIND=C_INT), Intent(OUT) :: rcode
110 
111  Integer(KIND=C_INT) :: c_ncddef
112 
113  End Function c_ncddef
114 End Interface
115 !-------------------------------- c_ncdid -------------------------------------
116 Interface
117  Function c_ncdid(ncid, dimname, rcode) BIND(C)
118 
119  USE iso_c_binding, ONLY: c_int, c_char
120 
121  Integer(KIND=C_INT), VALUE :: ncid
122  Character(KIND=C_CHAR), Intent(IN) :: dimname(*)
123  Integer(KIND=C_INT), Intent(OUT) :: rcode
124 
125  Integer(KIND=C_INT) :: c_ncdid
126 
127  End Function c_ncdid
128 End Interface
129 !-------------------------------- c_ncvdef ------------------------------------
130 Interface
131  Function c_ncvdef(ncid, varname, datatype, ndims, dimids, rcode) BIND(C)
132 
133  USE iso_c_binding, ONLY: c_int, c_char
134 
135  Integer(KIND=C_INT), VALUE :: ncid
136  Character(KIND=C_CHAR), Intent(IN) :: varname(*)
137  Integer(KIND=C_INT), VALUE :: datatype ! nc_type variable in C
138  Integer(KIND=C_INT), VALUE :: ndims
139  Integer(KIND=C_INT), Intent(IN) :: dimids(*)
140  Integer(KIND=C_INT), Intent(OUT) :: rcode
141 
142  Integer(KIND=C_INT) :: c_ncvdef
143 
144  End Function c_ncvdef
145 End Interface
146 !-------------------------------- c_ncvid -------------------------------------
147 Interface
148  Function c_ncvid(ncid, varname, rcode) BIND(C)
149 
150  USE iso_c_binding, ONLY: c_int, c_char
151 
152  Integer(KIND=C_INT), VALUE :: ncid
153  Character(KIND=C_CHAR), Intent(IN) :: varname(*)
154  Integer(KIND=C_INT), Intent(OUT) :: rcode
155 
156  Integer(KIND=C_INT) :: c_ncvid
157 
158  End Function c_ncvid
159 End Interface
160 !-------------------------------- c_nctlen ------------------------------------
161 Interface
162  Function c_nctlen(datatype, rcode) BIND(C)
163 
164  USE iso_c_binding, ONLY: c_int
165 
166  Integer(KIND=C_INT), VALUE :: datatype ! nc_type var in C
167  Integer(KIND=C_INT), Intent(OUT) :: rcode
168 
169  Integer(KIND=C_INT) :: c_nctlen
170 
171  End Function c_nctlen
172 End Interface
173 !-------------------------------- c_ncclos ------------------------------------
174 Interface
175  Subroutine c_ncclos(ncid, rcode) BIND(C)
176 
177  USE iso_c_binding, ONLY: c_int
178 
179  Integer(KIND=C_INT), VALUE :: ncid
180  Integer(KIND=C_INT), Intent(OUT) :: rcode
181 
182  End Subroutine c_ncclos
183 End Interface
184 !-------------------------------- c_ncredf ------------------------------------
185 Interface
186  Subroutine c_ncredf(ncid, rcode) BIND(C)
187 
188  USE iso_c_binding, ONLY: c_int
189 
190  Integer(KIND=C_INT), VALUE :: ncid
191  Integer(KIND=C_INT), Intent(OUT) :: rcode
192 
193  End Subroutine c_ncredf
194 End Interface
195 !-------------------------------- c_ncendf ------------------------------------
196 Interface
197  Subroutine c_ncendf(ncid, rcode) BIND(C)
198 
199  USE iso_c_binding, ONLY: c_int
200 
201  Integer(KIND=C_INT), VALUE :: ncid
202  Integer(KIND=C_INT), Intent(OUT) :: rcode
203 
204  End Subroutine c_ncendf
205 End Interface
206 !-------------------------------- c_ncinq -------------------------------------
207 Interface
208  Subroutine c_ncinq(ncid, indims, invars, inatts, irecdim, rcode) BIND(C)
209 
210  USE iso_c_binding, ONLY: c_int
211 
212  Integer(KIND=C_INT), VALUE :: ncid
213  Integer(KIND=C_INT), Intent(OUT) :: indims, invars, inatts, irecdim, rcode
214 
215  End Subroutine c_ncinq
216 End Interface
217 !-------------------------------- c_ncsnc -------------------------------------
218 Interface
219  Subroutine c_ncsnc(ncid, rcode) BIND(C)
220 
221  USE iso_c_binding, ONLY: c_int
222 
223  Integer(KIND=C_INT), VALUE :: ncid
224  Integer(KIND=C_INT), Intent(OUT) :: rcode
225 
226  End Subroutine c_ncsnc
227 End Interface
228 !-------------------------------- c_ncabor ------------------------------------
229 Interface
230  Subroutine c_ncabor(ncid, rcode) BIND(C)
231 
232  USE iso_c_binding, ONLY: c_int
233 
234  Integer(KIND=C_INT), VALUE :: ncid
235  Integer(KIND=C_INT), Intent(OUT) :: rcode
236 
237  End Subroutine c_ncabor
238 End Interface
239 !-------------------------------- c_ncdinq -----------------------------------
240 Interface
241  Subroutine c_ncdinq(ncid, dimid, dimname, size, rcode) BIND(C)
242 
243  USE iso_c_binding, ONLY: c_int, c_char
244 
245  Integer(KIND=C_INT), VALUE :: ncid , dimid
246  Character(KIND=C_CHAR), Intent(OUT) :: dimname(*)
247  Integer(KIND=C_INT), Intent(OUT) :: size, rcode
248 
249  End Subroutine c_ncdinq
250 End Interface
251 !-------------------------------- c_ncdren ------------------------------------
252 Interface
253  Subroutine c_ncdren(ncid, dimid, dimname, rcode) BIND(C)
254 
255  USE iso_c_binding, ONLY: c_int, c_char
256 
257  Integer(KIND=C_INT), VALUE :: ncid , dimid
258  Character(KIND=C_CHAR), Intent(IN) :: dimname(*)
259  Integer(KIND=C_INT), Intent(OUT) :: rcode
260 
261  End Subroutine c_ncdren
262 End Interface
263 !-------------------------------- c_ncviq -------------------------------------
264 Interface
265  Subroutine c_ncvinq(ncid, varid, varname, datatype, indims, dimarray, &
266  inatts, rcode) bind(c)
267 
268  USE iso_c_binding, ONLY: c_int, c_char
269 
270  Integer(KIND=C_INT), VALUE :: ncid , varid
271  Character(KIND=C_CHAR), Intent(INOUT) :: varname(*)
272  Integer(KIND=C_INT), Intent(OUT) :: datatype ! nc_type var in C
273  Integer(KIND=C_INT), Intent(OUT) :: dimarray(*)
274  Integer(KIND=C_INT), Intent(OUT) :: indims, inatts, rcode
275 
276  End Subroutine c_ncvinq
277 End Interface
278 !-------------------------------- c_ncvpt1 ------------------------------------
279 Interface
280  Subroutine c_ncvpt1(ncid, varid, indices, value, rcode) BIND(C)
281 
282  USE iso_c_binding, ONLY: c_int, c_ptr
283 
284  Integer(KIND=C_INT), VALUE :: ncid , varid
285  TYPE(c_ptr), VALUE :: indices
286  Type(c_ptr), VALUE :: value
287  Integer(KIND=C_INT), Intent(OUT) :: rcode
288 
289  End Subroutine c_ncvpt1
290 End Interface
291 !-------------------------------- c_ncvp1c ------------------------------------
292 Interface
293  Subroutine c_ncvp1c(ncid, varid, indices, value, rcode) BIND(C)
294 
295  USE iso_c_binding, ONLY: c_int, c_ptr, c_char
296 
297  Integer(KIND=C_INT), VALUE :: ncid , varid
298  TYPE(c_ptr), VALUE :: indices
299  Character(KIND=C_CHAR), Intent(IN) :: value(*) ! void in C
300  Integer(KIND=C_INT), Intent(OUT) :: rcode
301 
302  End Subroutine c_ncvp1c
303 End Interface
304 !-------------------------------- c_ncvpt -------------------------------------
305 Interface
306  Subroutine c_ncvpt(ncid, varid, start, count, value, rcode) BIND(C)
307 
308  USE iso_c_binding, ONLY: c_int, c_ptr
309 
310  Integer(KIND=C_INT), VALUE :: ncid , varid
311  Type(c_ptr), VALUE :: start, count
312  Type(c_ptr), VALUE :: value
313  Integer(KIND=C_INT), Intent(OUT) :: rcode
314 
315  End Subroutine c_ncvpt
316 End Interface
317 !-------------------------------- c_ncvptc ------------------------------------
318 Interface
319  Subroutine c_ncvptc(ncid, varid, start, count, value, lenstr, rcode) BIND(C)
320 
321  USE iso_c_binding, ONLY: c_int, c_ptr, c_char
322 
323  Integer(KIND=C_INT), VALUE :: ncid , varid, lenstr
324  Type(c_ptr), VALUE :: start, count
325  Character(KIND=C_CHAR), Intent(IN) :: value(*) ! char in C
326  Integer(KIND=C_INT), Intent(OUT) :: rcode
327 
328  End Subroutine c_ncvptc
329 End Interface
330 !-------------------------------- c_ncvptg ------------------------------------
331 Interface
332  Subroutine c_ncvptg(ncid, varid, start, count, strides, imap, value, &
333  rcode) bind(c)
334 
335  USE iso_c_binding, ONLY: c_int, c_ptr
336 
337  Integer(KIND=C_INT), VALUE :: ncid , varid
338  Type(c_ptr), VALUE :: start, count, strides, imap
339  Type(c_ptr), VALUE :: value
340  Integer(KIND=C_INT), Intent(OUT) :: rcode
341 
342  End Subroutine c_ncvptg
343 End Interface
344 !-------------------------------- c_ncvpgc ------------------------------------
345 Interface
346  Subroutine c_ncvpgc(ncid, varid, start, count, strides, imap, value, &
347  rcode) bind(c)
348 
349  USE iso_c_binding, ONLY: c_int, c_ptr, c_char
350 
351  Integer(KIND=C_INT), VALUE :: ncid , varid
352  Type(c_ptr), VALUE :: start, count, strides, imap
353  Character(KIND=C_CHAR), Intent(IN) :: value(*) ! char in C
354  Integer(KIND=C_INT), Intent(OUT) :: rcode
355 
356  End Subroutine c_ncvpgc
357 End Interface
358 !-------------------------------- c_ncvgt1 ------------------------------------
359 Interface
360  Subroutine c_ncvgt1(ncid, varid, indices, value, rcode) BIND(C)
361 
362  USE iso_c_binding, ONLY: c_int, c_ptr, c_char
363 
364  Integer(KIND=C_INT), VALUE :: ncid , varid
365  Type(c_ptr), VALUE :: indices
366  Character(KIND=C_CHAR), Intent(OUT) :: value(*) ! void in C
367  Integer(KIND=C_INT), Intent(OUT) :: rcode
368 
369  End Subroutine c_ncvgt1
370 End Interface
371 !-------------------------------- c_ncvg1c ------------------------------------
372 Interface
373  Subroutine c_ncvg1c(ncid, varid, indices, value, rcode) BIND(C)
374 
375  USE iso_c_binding, ONLY: c_int, c_ptr, c_char
376 
377  Integer(KIND=C_INT), VALUE :: ncid , varid
378  Type(c_ptr), VALUE :: indices
379  Character(KIND=C_CHAR), Intent(INOUT) :: value(*) ! char in C
380  Integer(KIND=C_INT), Intent(OUT) :: rcode
381 
382  End Subroutine c_ncvg1c
383 End Interface
384 !-------------------------------- c_ncvgt -------------------------------------
385 Interface
386  Subroutine c_ncvgt(ncid, varid, start, count, value, rcode) BIND(C)
387 
388  USE iso_c_binding, ONLY: c_int, c_ptr, c_char
389 
390  Integer(KIND=C_INT), VALUE :: ncid , varid
391  Type(c_ptr), VALUE :: start, count
392  Character(KIND=C_CHAR), Intent(OUT) :: value(*) ! void in C
393  Integer(KIND=C_INT), Intent(OUT) :: rcode
394 
395  End Subroutine c_ncvgt
396 End Interface
397 !-------------------------------- c_ncvgtc ------------------------------------
398 Interface
399  Subroutine c_ncvgtc(ncid, varid, start, count, value, lenstr, rcode) BIND(C)
400 
401  USE iso_c_binding, ONLY: c_int, c_ptr, c_char
402 
403  Integer(KIND=C_INT), VALUE :: ncid , varid, lenstr
404  Type(c_ptr), VALUE :: start, count
405  Character(KIND=C_CHAR), Intent(INOUT) :: value(*) ! char in C
406  Integer(KIND=C_INT), Intent(OUT) :: rcode
407 
408  End Subroutine c_ncvgtc
409 End Interface
410 !-------------------------------- c_ncvgtg ------------------------------------
411 Interface
412  Subroutine c_ncvgtg(ncid, varid, start, count, strides, imap, value, &
413  rcode) bind(c)
414 
415  USE iso_c_binding, ONLY: c_int, c_ptr, c_char
416 
417  Integer(KIND=C_INT), VALUE :: ncid , varid
418  Type(c_ptr), VALUE :: start, count, strides, imap
419  Character(KIND=C_CHAR), Intent(OUT) :: value(*) ! void in C
420  Integer(KIND=C_INT), Intent(OUT) :: rcode
421 
422  End Subroutine c_ncvgtg
423 End Interface
424 !-------------------------------- c_ncvggc ------------------------------------
425 Interface
426  Subroutine c_ncvggc(ncid, varid, start, count, strides, imap, value, &
427  rcode) bind(c)
428 
429  USE iso_c_binding, ONLY: c_int, c_ptr, c_char
430 
431  Integer(KIND=C_INT), VALUE :: ncid , varid
432  Type(c_ptr), VALUE :: start, count, strides, imap
433  Character(KIND=C_CHAR), Intent(OUT) :: value(*) ! char in C
434  Integer(KIND=C_INT), Intent(OUT) :: rcode
435 
436  End Subroutine c_ncvggc
437 End Interface
438 !-------------------------------- c_ncvren ------------------------------------
439 Interface
440  Subroutine c_ncvren(ncid, varid, varname, rcode) BIND(C)
441 
442  USE iso_c_binding, ONLY: c_int, c_char
443 
444  Integer(KIND=C_INT), VALUE :: ncid , varid
445  Character(KIND=C_CHAR), Intent(IN) :: varname(*)
446  Integer(KIND=C_INT), Intent(OUT) :: rcode
447 
448  End Subroutine c_ncvren
449 End Interface
450 !-------------------------------- c_ncapt -------------------------------------
451 Interface
452  Subroutine c_ncapt(ncid, varid, attname, datatype, attlen, value, &
453  rcode) bind(c)
454 
455  USE iso_c_binding, ONLY: c_int, c_size_t, c_char, c_ptr
456 
457  Integer(KIND=C_INT), VALUE :: ncid , varid
458  Character(KIND=C_CHAR), Intent(IN) :: attname(*)
459  Integer(KIND=C_INT), VALUE :: datatype ! nc_type var in C
460  Integer(KIND=C_SIZE_T), VALUE :: attlen
461  Type(c_ptr), VALUE :: value ! void in C
462  Integer(KIND=C_INT), Intent(OUT) :: rcode
463 
464  End Subroutine c_ncapt
465 End Interface
466 !-------------------------------- c_ncaptc ------------------------------------
467 Interface
468  Subroutine c_ncaptc(ncid, varid, attname, datatype, attlen, string, &
469  rcode) bind(c)
470 
471  USE iso_c_binding, ONLY: c_int, c_size_t, c_char
472 
473  Integer(KIND=C_INT), VALUE :: ncid , varid
474  Character(KIND=C_CHAR), Intent(IN) :: attname(*)
475  Integer(KIND=C_INT), VALUE :: datatype ! nc_type var in C
476  Integer(KIND=C_SIZE_T), VALUE :: attlen
477  Character(KIND=C_CHAR), Intent(IN) :: string(*) ! char in C
478  Integer(KIND=C_INT), Intent(OUT) :: rcode
479 
480  End Subroutine c_ncaptc
481 End Interface
482 !-------------------------------- c_ncainq ------------------------------------
483 Interface
484  Subroutine c_ncainq(ncid, varid, attname, datatype, attlen, rcode) BIND(C)
485 
486  USE iso_c_binding, ONLY: c_int, c_char
487 
488  Integer(KIND=C_INT), VALUE :: ncid , varid
489  Character(KIND=C_CHAR), Intent(IN) :: attname(*)
490  Integer(KIND=C_INT), Intent(OUT) :: datatype ! nc_type var in C
491  Integer(KIND=C_INT), Intent(OUT) :: attlen
492  Integer(KIND=C_INT), Intent(OUT) :: rcode
493 
494  End Subroutine c_ncainq
495 End Interface
496 !-------------------------------- c_ncagt -------------------------------------
497 Interface
498  Subroutine c_ncagt(ncid, varid, attname, value, rcode) BIND(C)
499 
500  USE iso_c_binding, ONLY: c_int, c_char
501 
502  Integer(KIND=C_INT), VALUE :: ncid , varid
503  Character(KIND=C_CHAR), Intent(IN) :: attname(*)
504  Character(KIND=C_CHAR), Intent(OUT) :: value(*) ! void in C
505  Integer(KIND=C_INT), Intent(OUT) :: rcode
506 
507  End Subroutine c_ncagt
508 End Interface
509 !-------------------------------- c_ncagtc ------------------------------------
510 Interface
511  Subroutine c_ncagtc(ncid, varid, attname, value, attlen, rcode) BIND(C)
512 
513  USE iso_c_binding, ONLY: c_int, c_char
514 
515  Integer(KIND=C_INT), VALUE :: ncid , varid, attlen
516  Character(KIND=C_CHAR), Intent(IN) :: attname(*)
517  Character(KIND=C_CHAR), Intent(OUT) :: value(*) ! char in C
518  Integer(KIND=C_INT), Intent(OUT) :: rcode
519 
520  End Subroutine c_ncagtc
521 End Interface
522 !-------------------------------- c_ncacpy ------------------------------------
523 Interface
524  Subroutine c_ncacpy(inncid, invarid, attname, outncid, outvarid, &
525  rcode) bind(c)
526 
527  USE iso_c_binding, ONLY: c_int, c_char
528 
529  Integer(KIND=C_INT), VALUE :: inncid , invarid, outncid, outvarid
530  Character(KIND=C_CHAR), Intent(IN) :: attname(*)
531  Integer(KIND=C_INT), Intent(OUT) :: rcode
532 
533  End Subroutine c_ncacpy
534 End Interface
535 !-------------------------------- c_ncanam ------------------------------------
536 Interface
537  Subroutine c_ncanam(ncid, varid, attnum, newname, rcode) BIND(C)
538 
539  USE iso_c_binding, ONLY: c_int, c_char
540 
541  Integer(KIND=C_INT), VALUE :: ncid , varid, attnum
542  Character(KIND=C_CHAR), Intent(INOUT) :: newname(*)
543  Integer(KIND=C_INT), Intent(OUT) :: rcode
544 
545  End Subroutine c_ncanam
546 End Interface
547 !-------------------------------- c_ncaren ------------------------------------
548 Interface
549  Subroutine c_ncaren(ncid, varid, attnam, newname, rcode) BIND(C)
550 
551  USE iso_c_binding, ONLY: c_int, c_char
552 
553  Integer(KIND=C_INT), VALUE :: ncid , varid
554  Character(KIND=C_CHAR), Intent(IN) :: attnam(*), newname(*)
555  Integer(KIND=C_INT), Intent(OUT) :: rcode
556 
557  End Subroutine c_ncaren
558 End Interface
559 !-------------------------------- c_ncadel ------------------------------------
560 Interface
561  Subroutine c_ncadel(ncid, varid, attname, rcode) BIND(C)
562 
563  USE iso_c_binding, ONLY: c_int, c_char
564 
565  Integer(KIND=C_INT), VALUE :: ncid , varid
566  Character(KIND=C_CHAR), Intent(IN) :: attname(*)
567  Integer(KIND=C_INT), Intent(OUT) :: rcode
568 
569  End Subroutine c_ncadel
570 End Interface
571 !-------------------------------- c_ncsfil ------------------------------------
572 Interface
573  Function c_ncsfil(ncid, fillmode, rcode) BIND(C)
574 
575  USE iso_c_binding, ONLY: c_int
576 
577  Integer(KIND=C_INT), VALUE :: ncid , fillmode
578  Integer(KIND=C_INT), Intent(OUT) :: rcode
579 
580  Integer(KIND=C_INT) :: c_ncsfil
581 
582  End Function c_ncsfil
583 End Interface
584 !---------------------------------v2data_size ---------------------------------
585 Interface
586  Function v2data_size(datatype) BIND(C)
587 !
588 ! New function added to fort-v2compat.c
589 !
590  USE iso_c_binding, ONLY: c_int, c_size_t
591 
592  Integer(KIND=C_INT), VALUE :: datatype
593  Integer(KIND=C_SIZE_T) :: v2data_size
594 
595  End Function v2data_size
596 End Interface
597 
598 CONTAINS
599 
600 Subroutine convert_v2_imap(cncid, cvarid, fmap, cmap, inullp)
601 
602 ! Replacement for f2c_v2imap C function. Uses v2data_size to return
603 ! data size defined for C code. A futher test will be made using
604 ! C interop value.s for FORTRAN side
605 !
606 ! USE ISO_C_BINDING, ONLY: C_INT, C_SIZE_T
607 ! USE NETCDF_NC_DATA, ONLY: C_PTRDIFF_T
608 ! USE netcdf_nc_interfaces, ONLY: NC_CHAR, NC_SHORT, NC_INT, NC_FLOAT, &
609 ! NC_BYTE, NC_DOUBLE, NC_MAX_VAR_DIMS, &
610 
611 ! USE netcdf_nc_interfaces, ONLY: nc_inq_vartype, nc_inq_varndims, &
612 ! nc_inq_vardimid, nc_inq_dimlen, &
613 ! NC_NOERR , NC_MAX_VAR_DIMS
614 
615  Implicit NONE
616 
617  Integer(KIND=C_INT), Intent(IN) :: cncid, cvarid
618  Integer(KIND=C_INT), Intent(IN) :: fmap(*)
619  Integer(KIND=C_PTRDIFF_T), Intent(INOUT) :: cmap(*)
620  Integer, Intent(OUT) :: inullp
621 
622  Integer(KIND=C_INT) :: rank, datatype, cstat1, cstat2, cstat3, cstat4
623  Integer(KIND=C_SIZE_T) :: total, length, csize
624  Integer(KIND=C_INT) :: dimids(nc_max_var_dims)
625  Integer :: ii, idim
626 
627 !
628  inullp=0
629 
630  cstat1 = nc_inq_vartype(cncid, cvarid, datatype)
631  cstat2 = nc_inq_varndims(cncid, cvarid, rank)
632 
633 ! Return if nc_inq_vartype or nc_inq_varndims returns an error
634 ! code. Set inullp to trigger use of NULL pointer in calling
635 ! routine
636 
637  If (cstat1/=nc_noerr) Then
638  inullp=1
639  Return
640  EndIf
641  If (cstat2/=nc_noerr) Then
642  inullp=1
643  Return
644  EndIf
645  If (rank <= 0) Then
646  inullp=1
647  Return
648  EndIf
649 
650  If (fmap(1)==0) Then ! Special Fortran version 2 sematics
651  cstat3 = nc_inq_vardimid(cncid, cvarid, dimids)
652  If (cstat3 /= nc_noerr) Then
653  inullp=1
654  Return
655  EndIf
656 !
657  total = 1
658  loop1: Do ii=1, rank
659  idim = rank-ii+1
660  cmap(idim) = total
661  cstat4 = nc_inq_dimlen(cncid, dimids(idim), length)
662  If (cstat4 /= nc_noerr) Then
663  inullp=1
664  Exit loop1
665  EndIf
666  total = total*length
667  EndDo loop1
668  If (inullp==1) Return
669 
670  Else ! Standard version 2 format - Use KIND parameters to set size
671 
672 ! Get C data type size using v2data_size. Unfortunately, the F03
673 ! standard didn't specify a C_SIZEOF function. This will be
674 ! remedied in the next upgrade to FORTRAN (2008) but for now
675 ! we will rely on a C function to provide the value
676 
677  csize = v2data_size(datatype)
678  If (csize <= 0) Then
679  inullp=1
680  Return
681  EndIf
682 
683  cmap(1:rank) = fmap(rank:1:-1) / csize
684 
685  EndIf
686 
687 End Subroutine convert_v2_imap
688 
689 !-------------------- End module_netcdf_fortv2_c_interfaces -------------------
690 End Module netcdf_fortv2_c_interfaces

Return to the Main Unidata NetCDF page.
Generated on Tue Mar 1 2016 12:16:22 for NetCDF-Fortran. NetCDF is a Unidata library.