1! ------------ Routines to create/open/close/redefine netcdf files ------------ 2 3! Replacement for fort-control.c 4 5! Written by: Richard Weed, Ph.D. 6! Center for Advanced Vehicular Systems 7! Mississippi State University 8! rweed@cavs.msstate.edu 9 10 11! License (and other Lawyer Language) 12 13! This software is released under the Apache 2.0 Open Source License. The 14! full text of the License can be viewed at : 15! 16! http:www.apache.org/licenses/LICENSE-2.0.html 17! 18! The author grants to the University Corporation for Atmospheric Research 19! (UCAR), Boulder, CO, USA the right to revise and extend the software 20! without restriction. However, the author retains all copyrights and 21! intellectual property rights explicitly stated in or implied by the 22! Apache license 23 24! Version 1.: Sept. 2005 - Initial Cray X1 version 25! Version 2.: May, 2006 - Updated to support g95 26! Version 3.: April, 2009 - Updated for netcdf 4.0.1 27! Version 4.: April, 2010 - Updated for netcdf 4.1.1 28! Version 5.: Feb. 2013 - Added nf_inq_path support for fortran 4.4 29! Vertion 6.: Nov. 2013 - Added nf_set_log_level support 30! Version 7.: May, 2014 - Ensure return error status checked from C API calls 31! Version 8.: Jan., 2016 - General code cleanup. Changed name processing to 32! reflect change in addCNullChar function. Added 33! support for nc_open_mem 34 35!-------------------------------- nf_create -------------------------------- 36 Function nf_create(path, cmode, ncid) RESULT (status) 37 38! Creates a new NetCDF file given a file name and a creation mode and returns 39! the file id and a status flag 40 41 USE netcdf_nc_interfaces 42 43 Implicit NONE 44 45 Character(LEN=*), Intent(IN) :: path 46 Integer, Intent(IN) :: cmode 47 Integer, Intent(OUT) :: ncid 48 49 Integer :: status 50 51 Integer(C_INT) :: ccmode, cncid, cstatus 52 Character(LEN=(LEN(path)+1)) :: cpath 53 Integer :: ie 54 55 ccmode = cmode 56 cncid = 0 57 58! Check for C null character on path and add one if not present. 59 60 cpath = addCNullChar(path, ie) 61 62! Call nc_create to create file 63 64 cstatus = nc_create(cpath(1:ie), ccmode, cncid) 65 66 If (cstatus == NC_NOERR) Then 67 ncid = cncid 68 EndIf 69 status = cstatus 70 71 End Function nf_create 72!-------------------------------- nf__create ------------------------------- 73 Function nf__create(path, cmode, initialsz, chunksizehintp, ncid) & 74 RESULT(status) 75 76! Creates a new NetCDF file and returns the file id and a status flag 77! This is an alternate form of nf_create that allows user to input 78! two additional tuning parameters 79 80 USE netcdf_nc_interfaces 81 82 Implicit NONE 83 84 Character(LEN=*), Intent(IN) :: path 85 Integer, Intent(IN) :: cmode, initialsz, chunksizehintp 86 Integer, Intent(OUT) :: ncid 87 88 Integer :: status 89 90 Integer(C_INT) :: ccmode, cncid, cstatus 91 Integer(C_SIZE_T) :: cinit, cchunk 92 Character(LEN=(LEN(path)+1)) :: cpath 93 Integer :: ie 94 95 ccmode = cmode 96 cchunk = chunksizehintp 97 cinit = initialsz 98 cncid = 0 99 100! Check for C null character on path and add one if not present. 101 102 cpath = addCNullChar(path, ie) 103 104! Call nc_create to create file 105 106 cstatus = nc__create(cpath(1:ie), ccmode, cinit, cchunk, cncid) 107 108 If (cstatus == NC_NOERR) Then 109 ncid = cncid 110 EndIf 111 status = cstatus 112 113 End Function nf__create 114!-------------------------------- nf__create_mp ------------------------------ 115 Function nf__create_mp(path, cmode, initialsz, basepe, chunksizehintp, ncid) & 116 RESULT(status) 117 118! Creates a new NetCDF file and returns the file id and a status flag 119! This is an alternate form of nf__create for shared memory MPP systems 120! plus two additional tuning parameters 121 122 USE netcdf_nc_interfaces 123 124 Implicit NONE 125 126 Character(LEN=*), Intent(IN) :: path 127 Integer, Intent(IN) :: cmode, initialsz, chunksizehintp, basepe 128 Integer, Intent(OUT) :: ncid 129 130 Integer :: status 131 132 Integer(C_INT) :: ccmode, cncid, cstatus 133 Integer(C_INT), TARGET :: cbasepe 134 Integer(C_SIZE_T) :: cinit, cchunk 135 Type(C_PTR) :: cbasepeptr 136 Character(LEN=(LEN(path)+1)) :: cpath 137 Integer :: ie 138 139 ccmode = cmode 140 cchunk = chunksizehintp 141 cinit = initialsz 142 cncid = 0 143 cbasepe = basepe 144 cbasepeptr = C_LOC(cbasepe) 145 146! Check for C null character on path and add one if not present. 147 148 cpath = addCNullChar(path, ie) 149 150! Call nc_create_mp to create file for base pe 151 152 cstatus = nc__create_mp(cpath(1:ie), ccmode, cinit, cbasepeptr, & 153 cchunk, cncid) 154 155 If (cstatus == NC_NOERR) Then 156 ncid = cncid 157 EndIf 158 status = cstatus 159 160 End Function nf__create_mp 161!-------------------------------- nf_open ---------------------------------- 162 Function nf_open(path, mode, ncid) RESULT (status) 163 164! Open an existing NetCDF file and return file id and a status flag 165 166 USE netcdf_nc_interfaces 167 168 Implicit NONE 169 170 Character(LEN=*), Intent(IN) :: path 171 Integer, Intent(IN) :: mode 172 Integer, Intent(INOUT) :: ncid 173 174 Integer :: status 175 176 Integer(C_INT) :: cmode, cncid, cstatus 177 Character(LEN=(LEN(path)+1)) :: cpath 178 Integer :: ie 179 180 cmode = mode 181 cncid = 0 182 183! Check for C null character on path and add one if not present. 184 185 cpath = addCNullChar(path, ie) 186 187! Call nc_create to create file 188 189 cstatus = nc_open(cpath(1:ie), cmode, cncid) 190 191 If (cstatus == NC_NOERR) Then 192 ncid = cncid 193 EndIf 194 status = cstatus 195 196 End Function nf_open 197!-------------------------------- nf__open --------------------------------- 198 Function nf__open(path, mode, chunksizehintp, ncid) RESULT (status) 199 200! Open an existing NetCDF file and return file id and a status flag 201! Alternate form of nf_open with extra tuning parameter 202 203 USE netcdf_nc_interfaces 204 205 Implicit NONE 206 207 Character(LEN=*), Intent(IN) :: path 208 Integer, Intent(IN) :: mode, chunksizehintp 209 Integer, Intent(INOUT) :: ncid 210 211 Integer :: status 212 213 Integer(C_INT) :: cmode, cncid, cstatus 214 Integer(C_SIZE_T) :: cchunk 215 Character(LEN=(LEN(path)+1)) :: cpath 216 Integer :: ie 217 218 cmode = mode 219 cchunk = chunksizehintp 220 cncid = 0 221 222! Check for C null character on path and add one if not present. 223 224 cpath = addCNullChar(path,ie) 225 226! Call nc_create to create file 227 228 cstatus = nc__open(cpath(1:ie), cmode, cchunk, cncid) 229 230 If (cstatus == NC_NOERR) Then 231 ncid = cncid 232 EndIf 233 status = cstatus 234 235 End Function nf__open 236!-------------------------------- nf__open_mp -------------------------------- 237 Function nf__open_mp(path, mode, basepe, chunksizehintp, ncid) RESULT (status) 238 239! Open an existing NetCDF file and return file id and a status flag 240! Alternate form of nf__open with parameter to designate basepe on 241! shared memory MPP systems. 242 243 USE netcdf_nc_interfaces 244 245 Implicit NONE 246 247 Character(LEN=*), Intent(IN) :: path 248 Integer, Intent(IN) :: mode, chunksizehintp, basepe 249 Integer, Intent(INOUT) :: ncid 250 251 Integer :: status 252 253 Integer(C_INT) :: cmode, cncid, cstatus 254 Integer(C_INT), TARGET :: cbasepe 255 Integer(C_SIZE_T) :: cchunk 256 Type(C_PTR) :: cbasepeptr 257 Character(LEN=(LEN(path)+1)) :: cpath 258 Integer :: ie 259 260 cmode = mode 261 cchunk = chunksizehintp 262 cncid = 0 263 cbasepe = basepe 264 cbasepeptr = C_LOC(cbasepe) 265 266! Check for C null character on path and add one if not present. 267 268 cpath = addCNullChar(path, ie) 269 270! Call nc_create to create file 271 272 cstatus = nc__open_mp(cpath(1:ie), cmode, cbasepeptr, cchunk, & 273 cncid) 274 275 If (cstatus == NC_NOERR) Then 276 ncid = cncid 277 EndIf 278 status = cstatus 279 280 End Function nf__open_mp 281!-------------------------------- nf_open_mem -------------------------------- 282 Function nf_open_mem(path, mode, size, memory, ncid) RESULT(status) 283 284! Open a block of memory passed as an array of C_CHAR bytes as a 285! netcdf file. Note the file can only be opened as read-only 286 287 USE netcdf_nc_interfaces 288 289 Implicit NONE 290 291 Character(LEN=*), Intent(IN) :: path 292 Integer, Intent(IN) :: mode 293 Integer, Intent(IN) :: size 294 Character(KIND=C_CHAR), Intent(IN), TARGET :: memory(*) 295 Integer, Intent(INOUT) :: ncid 296 297 Integer :: status 298 299 Integer(C_INT) :: cstatus, cmode, cncid 300 Character(LEN=LEN(path)+1) :: cpath 301 Integer(C_SIZE_T) :: csize 302 Type(C_PTR) :: cmemoryptr 303 304 Integer :: ie 305 306 cpath = addCNullChar(path, ie) 307 cmode = mode 308 csize = size 309 310 cmemoryptr = C_LOC(memory) 311 312 cstatus = nc_open_mem(cpath(1:ie), cmode, csize, cmemoryptr, cncid) 313 314 ncid = cncid 315 316 status = cstatus 317 318 End Function nf_open_mem 319!-------------------------------- nf_inq_path ------------------------------ 320 Function nf_inq_path(ncid, pathlen, path) RESULT(status) 321 322! Inquire about file pathname and name length 323 324 USE netcdf_nc_interfaces 325 326 Implicit NONE 327 328 Integer, Intent(IN) :: ncid 329 Integer, Intent(INOUT) :: pathlen 330 Character(LEN=*), Intent(INOUT) :: path 331 332 Integer :: status 333 334 Integer(C_INT) :: cncid, cstatus 335 Integer(C_SIZE_T) :: cpathlen 336 Character(LEN=LEN(path)+1) :: tmppath 337 338 cncid = ncid 339 path = REPEAT(" ", LEN(path)) 340 tmppath = REPEAT(" ", LEN(tmppath)) 341 342 cstatus = nc_inq_path(cncid, cpathlen, tmppath) 343 344 If (cstatus == NC_NOERR) Then 345 pathlen = int(cpathlen) 346 If (pathlen > LEN(path)) pathlen = LEN(path) 347 path = stripCNullchar(tmppath, pathlen) 348 EndIf 349 status = cstatus 350 351 End Function nf_inq_path 352!-------------------------------- nf_set_fill ------------------------------ 353 Function nf_set_fill(ncid, fillmode, old_mode) RESULT(status) 354 355! Sets fill mode for given netcdf file returns old mode if present 356 357 USE netcdf_nc_interfaces 358 359 Implicit NONE 360 361 Integer, Intent(IN) :: ncid, fillmode 362 Integer, Intent(OUT) :: old_mode 363 364 Integer :: status 365 366 Integer(C_INT) :: cncid, cfill, coldmode, cstatus 367 368 cncid = ncid 369 cfill = fillmode 370 coldmode = 0 371 372 cstatus = nc_set_fill(cncid, cfill, coldmode) 373 374 If (cstatus == NC_NOERR) Then 375 old_mode = coldmode 376 EndIf 377 status = cstatus 378 379 End Function nf_set_fill 380!-------------------------------- nf_set_default_format -------------------- 381 Function nf_set_default_format(newform, old_format) RESULT(status) 382 383! Sets new default data format. Used to toggle between 64 bit offset and 384! classic mode 385 386 USE netcdf_nc_interfaces 387 388 Implicit NONE 389 390 Integer, Intent(IN) :: newform 391 Integer, Intent(OUT) :: old_format 392 393 Integer :: status 394 395 Integer(C_INT) :: cnew, cold, cstatus 396 397 cnew = newform 398 399 cstatus = nc_set_default_format(cnew,cold) 400 401 If (cstatus == NC_NOERR) Then 402 old_format = cold 403 EndIf 404 status = cstatus 405 406 End Function nf_set_default_format 407!-------------------------------- nf_redef --------------------------------- 408 Function nf_redef(ncid) RESULT(status) 409 410! Reenter definition mode for NetCDF file id ncid 411 412 USE netcdf_nc_interfaces 413 414 Implicit NONE 415 416 Integer, Intent(IN) :: ncid 417 418 Integer :: status 419 420 Integer(C_INT) :: cncid, cstatus 421 422 cncid = ncid 423 424 cstatus = nc_redef(cncid) 425 426 status = cstatus 427 428 End Function nf_redef 429!-------------------------------- nf_enddef -------------------------------- 430 Function nf_enddef(ncid) RESULT(status) 431 432! Exit definition mode for NetCDF file id ncid 433 434 USE netcdf_nc_interfaces 435 436 Implicit NONE 437 438 Integer, Intent(IN) :: ncid 439 440 Integer :: status 441 442 Integer(C_INT) :: cncid, cstatus 443 444 cncid = ncid 445 446 cstatus = nc_enddef(cncid) 447 448 status = cstatus 449 450 End Function nf_enddef 451!-------------------------------- nf__enddef ------------------------------- 452 Function nf__enddef(ncid, h_minfree, v_align, v_minfree, r_align) & 453 RESULT(status) 454 455! Exit definition mode for NetCDF file id ncid. Alternate version 456! with additional tuning parameters 457 458 USE netcdf_nc_interfaces 459 460 Implicit NONE 461 462 Integer, Intent(IN) :: ncid, h_minfree, v_align, v_minfree, r_align 463 464 Integer :: status 465 466 Integer(C_INT) :: cncid, cstatus 467 Integer(C_SIZE_T) :: chminfree, cvalign, cvminfree, cralign 468 469 cncid = ncid 470 chminfree = h_minfree 471 cvalign = v_align 472 cvminfree = v_minfree 473 cralign = r_align 474 475 cstatus = nc__enddef(cncid, chminfree, cvalign, cvminfree, cralign) 476 477 status = cstatus 478 479 End Function nf__enddef 480!-------------------------------- nf_sync ---------------------------------- 481 Function nf_sync(ncid) RESULT(status) 482 483! synch up all open NetCDF files 484 485 USE netcdf_nc_interfaces 486 487 Implicit NONE 488 489 Integer, Intent(IN) :: ncid 490 491 Integer :: status 492 493 Integer(C_INT) :: cncid, cstatus 494 495 cncid = ncid 496 497 cstatus = nc_sync(cncid) 498 499 status = cstatus 500 501 End Function nf_sync 502!-------------------------------- nf_abort --------------------------------- 503 Function nf_abort(ncid) RESULT(status) 504 505! Abort netCDF file creation and exit 506 507 USE netcdf_nc_interfaces 508 509 Implicit NONE 510 511 Integer, Intent(IN) :: ncid 512 513 Integer :: status 514 515 Integer(C_INT) :: cncid, cstatus 516 517 cncid = ncid 518 519 cstatus = nc_abort(cncid) 520 521 status = cstatus 522 523 End Function nf_abort 524!-------------------------------- nf_close --------------------------------- 525 Function nf_close(ncid) RESULT(status) 526 527! Close netCDF file id ncid 528 529 USE netcdf_nc_interfaces 530 531 Implicit NONE 532 533 Integer, Intent(IN) :: ncid 534 535 Integer :: status 536 537 Integer(C_INT) :: cncid, cstatus 538 539 cncid = ncid 540 541 cstatus = nc_close(cncid) 542 543 status = cstatus 544 545 End Function nf_close 546!-------------------------------- nf_delete -------------------------------- 547 Function nf_delete(path) RESULT(status) 548 549! Delete netCDF file id ncid 550 551 USE netcdf_nc_interfaces 552 553 Implicit NONE 554 555 Character(LEN=*), Intent(IN) :: path 556 557 Integer :: status 558 559 Integer(C_INT) :: cstatus 560 Character(LEN=(LEN(path)+1)) :: cpath 561 Integer :: ie 562 563! Check for C null character on path and add one if not present. 564 565 cpath = addCNullChar(path,ie) 566 567 cstatus = nc_delete(cpath(1:ie)) 568 569 status = cstatus 570 571 End Function nf_delete 572!-------------------------------- nf_delete_mp ------------------------------- 573 Function nf_delete_mp(path, pe) RESULT(status) 574 575! Delete netCDF file id ncid. Alternate form of nf_delete for shared memory 576! MPP systems. 577 578 USE netcdf_nc_interfaces 579 580 Implicit NONE 581 582 Character(LEN=*), Intent(IN) :: path 583 Integer, Intent(IN) :: pe 584 585 Integer :: status 586 587 Integer(C_INT) :: cstatus, cpe 588 Character(LEN=(LEN(path)+1)) :: cpath 589 Integer :: ie 590 591 cpe = pe 592 593! Check for C null character on path and add one if not present. 594 595 cpath = addCNullChar(path,ie) 596 597 cstatus = nc_delete_mp(cpath(1:ie), cpe) 598 599 status = cstatus 600 601 End Function nf_delete_mp 602!-------------------------------- nf_set_base_pe ------------------------------ 603 Function nf_set_base_pe(ncid, pe) RESULT(status) 604 605! Sets base pe number on shared memory MPP systems 606 607 Use netcdf_nc_interfaces 608 609 Implicit NONE 610 611 Integer, Intent(IN) :: ncid, pe 612 613 Integer :: status 614 615 Integer(C_INT) :: cncid, cpe, cstatus 616 617 cncid = ncid 618 cpe = pe 619 620 cstatus = nc_set_base_pe(cncid, cpe) 621 622 status = cstatus 623 624 End Function nf_set_base_pe 625!-------------------------------- nf_inq_base_pe ------------------------------ 626 Function nf_inq_base_pe(ncid, pe) RESULT(status) 627 628! Gets previously set base pe number on shared memory MPP systems 629 630 Use netcdf_nc_interfaces 631 632 Implicit NONE 633 634 Integer, Intent(IN) :: ncid 635 Integer, Intent(OUT) :: pe 636 637 Integer :: status 638 639 Integer(C_INT) :: cncid, cpe, cstatus 640 641 cncid = ncid 642 643 cstatus = nc_inq_base_pe(cncid, cpe) 644 645 If (cstatus == NC_NOERR) Then 646 pe = cpe 647 EndIf 648 status = cstatus 649 650End Function nf_inq_base_pe 651