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

Return to the Main Unidata NetCDF page.
Generated on Fri Aug 4 2017 17:20:58 for NetCDF-Fortran. NetCDF is a Unidata library.