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