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 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 2149 2150 2151 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474 2475 2476 2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496 2497 2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710
|
# -*- Perl -*-
use Config;
use Devel::CheckLib qw(check_lib);
our $VERSION = '4.25';
pp_setversion($VERSION);
my $ncversion = {nc_inq_var_deflate => check_lib(
INC => $ENV{INC},
LIBS => $ENV{LIBS},
header => 'netcdf.h', lib => 'netcdf',
function => 'return !nc_inq_var_deflate(0, 0, NULL, NULL, NULL);',
)};
pp_addpm({At => Top}, <<'EOD');
=head1 NAME
PDL::NetCDF - Object-oriented interface between NetCDF files and PDL objects.
Perl extension to allow interface to NetCDF portable
binary gridded files via PDL objects.
=head1 SYNOPSIS
use PDL;
use PDL::NetCDF;
use PDL::Char;
my $ncobj = PDL::NetCDF->new ("test.nc", {REVERSE_DIMS => 1, PDL_BAD => 1}); # New file
my $pdl = pdl [[1, 2, 3], [4, 5, 6]];
# Specify variable name to put PDL in, plus names of the dimensions. Dimension
# lengths are taken from the PDL, in this case, dim1 = 2 and dim2 = 3.
$ncobj->put ('var1', ['dim1', 'dim2'], $pdl);
# or for netcdf4 files
# $ncobj->put ('var1', ['dim1', 'dim2'], $pdl, {DEFLATE => 9, _FillValue => -999});
# get the deflate level (for any fileformat)
my ($deflate, $shuffle) = $ncobj->getDeflateShuffle('var1');
# $pdlout = [[1, 2, 3], [4, 5, 6]]
my $pdlout = $ncobj->get ('var1');
# Store textual NetCDF arrays using perl strings: (This is a bit primitive, but works)
my $str = "Station1 Station2 Station3 ";
$obj->puttext('textvar', ['n_station', 'n_string'], [3,10], $str);
my $outstr = $obj->gettext('textvar');
# $outstr = "Station1 Station2 Station3 "
# Now textual NetCDF arrays can be stored with PDL::Char style PDLs. This is much
# more natural and flexible than the above method.
$str = PDL::Char->new (['Station1', 'Station2', 'Station3']);
$obj->put ('stations', ['dim_station', 'dim_charlen'], $str);
$outstr = $obj->get('stations');
print $outstr;
# Prints: ['Station1', 'Station2', 'Station3']
# For more info on PDL::Char variables see PDL::Char(3), or perldoc PDL::Char
# $dim1size = 2
my $dim1size = $ncobj->dimsize('dim1');
# A slice of the netCDF variable.
# [0,0] is the starting point, [1,2] is the count.
# $slice = [1,2]
my $slice = $ncobj->get ('var1', [0,0], [1,2]);
# Attach a double attribute of size 3 to var1
$ncobj->putatt (double([1,2,3]), 'double_attribute', 'var1');
# $attr1 = [1,2,3]
my $attr1 = $ncobj->getatt ('double_attribute', 'var1');
# $type = PDL::double
my $type = $ncobj->getvariabletype('var1');
# Write a textual, global attribute. 'attr_name' is the attribute name.
$ncobj->putatt ('The text of the global attribute', 'attr_name');
# $attr2 = 'The text of the global attribute'
my $attr2 = $ncobj->getatt ('attr_name');
# Close the netCDF file. The file is also automatically closed in a DESTROY block
# when it passes out of scope. This just makes is explicit.
$ncobj->close;
For (much) more information on NetCDF, see
http://www.unidata.ucar.edu/packages/netcdf/index.html
Also see the test file, test.pl in this distribution for some working examples.
=head1 DESCRIPTION
This is the PDL interface to the Unidata NetCDF library. It uses the
netCDF version 3 library to make a subset of netCDF functionality
available to PDL users in a clean, object-oriented interface.
Another NetCDF perl interface, which allows access to the entire range
of netCDF functionality (but in a non-object-oriented
style which uses perl arrays instead of PDLs) is available through Unidata at
http://www.unidata.ucar.edu/packages/netcdf/index.html).
The NetCDF standard allows N-dimensional binary data to be efficiently
stored, annotated and exchanged between many platforms.
When one creates a new netCDF object, this object is associated with one
netCDF file.
=head1 FUNCTIONS
=head2 isNetcdf4
=for ref
Check if compiled against netcdf4
=for usage
Arguments: none
=for example
if (PDL::NetCDF::isNetcdf4) {
# open netcdf4 file
}
=head2 defaultFormat
=for ref
Get or change the default format when creating a netcdf-file.
This can be overwritten by the NC_FORMAT option for new. Possible
values are: PDL::NetCDF::NC_FORMAT_CLASSIC, PDL::NetCDF::NC_FORMAT_64BIT,
PDL::NetCDF::NC_FORMAT_NETCDF4, PDL::NetCDF::NC_FORMAT_NETCDF4_CLASSIC
=for usage
Arguments:
1) new format (constant)
Return:
old format as one of the NC_FORMAT_* constants
=head2 new
=for ref
Create an object representing a netCDF file.
=for usage
Arguments:
1) The name of the file.
2) optional: A hashref containing options. Currently defined are:
TEMPLATE:
An existing netCDF object for a file with
identical layout. This allows one to read in many similar netCDF
files without incurring the overhead of reading in all variable
and dimension names and IDs each time. Caution: Undefined
weirdness may occur if you pass the netCDF object from a dissimilar
file!
MODE:
use sysopen file-opening arguments, O_RDONLY, O_RDWR, O_CREAT, O_EXCL
when used, this will overwrite the '>file.nc' type of opening
see L<perlopentut> for usage of O_RDONLY...
REVERSE_DIMS:
this will turn the order of the dimension-names of
netcdf-files. Even with this option the 'put' function will write
variables in FORTRAN order (as before) and will reverse the
dimension names so they fit this order. With this option, the
'putslice' function will write variables in the same way as 'put'.
You should use this option if your planning to work with other
netcdf-programs (ncview, NCL) or if you are planning to combine
putslice and slice. You should _not_ use this option, if you need
compatibility to older versions of PDL::NetCDF.
NC_FORMAT:
set the file format for a new netcdf file, see defaultFormat()
SLOW_CHAR_FETCH:
If this option is set, then a 'get' into a PDL::Char will be done
one string at a time instead of all text data at once. This
is necessary if there are NULLs (hex 0) values embedded in the string
arrays. This takes longer, but gives the correct results. If
the fetch of a string array yields only the first element, try setting
this option.
PDL_BAD:
_FillValue's or missing_values are translated to bad-pdls.
Example:
my $nc = PDL::NetCDF->new ("file1.nc", {REVERSE_DIMS => 1, PDL_BAD => 1});
...
foreach my $ncfile (@a_bunch_of_similar_format_netcdf_files) {
$nc = PDL::NetCDF->new("file2.nc", {TEMPLATE => $nc}); # These calls to 'new' are *much* faster
...
}
# opening using MODE
use Fcntl; # define O_CREAT...
# opening a completely new file (deleting if it exists!)
my $newnc = PDL::NetCDF->new ("file2.nc", {MODE => O_CREAT|O_RDWR,
REVERSE_DIMS => 1, NC_FORMAT => PDL::NetCDF::NC_FORMAT_NETCDF4});
# opening existing file for reading and writing
$nc = PDL::NetCDF->new ("file2.nc", {MODE => O_RDWR}
REVERSE_DIMS => 1});
# opening existing file for reading only
$nc = PDL::NetCDF->new ("file2.nc", {MODE => O_RDONLY,
REVERSE_DIMS => 1});
If this file exists and you want to write to it,
prepend the name with the '>' character: ">name.nc"
Returns: The netCDF object. Barfs if there is an error.
=for example
$ncobj = PDL::NetCDF->new ("file.nc",{REVERSE_DIMS => 1});
=head2 getFormat
=for ref
Get the format of a netcdf file
=for usage
Arguments: none
Returns:
@ integer equal to one of the PDL::NetCDF::NC_FORMAT_* constants.
=head2 put
=for ref
Put a PDL matrix to a netCDF variable.
=for usage
Arguments:
1) The name of the variable to create
2) A reference to a list of dimension names for this variable
3) The PDL to put. It must have the same number of dimensions
as specified in the dimension name list.
4) Optional options hashref: {SHUFFLE => 1, DEFLATE => 7, COMPRESS => 0, _FillValue => -32767}
Returns:
None.
=for example
my $pdl = pdl [[1, 2, 3], [4, 5, 6]];
# Specify variable name to put PDL in, plus names of the dimensions. Dimension
# lengths are taken from the PDL, in this case, dim1 = 2 and dim2 = 3.
$ncobj->put ('var1', ['dim1', 'dim2'], $pdl);
# Now textual NetCDF arrays can be stored with PDL::Char style PDLs.
$str = PDL::Char->new (['Station1', 'Station2', 'Station3']);
$obj->put ('stations', ['dim_station', 'dim_charlen'], $str);
$outstr = $obj->get('stations');
print $outstr;
# Prints: ['Station1', 'Station2', 'Station3']
# For more info on PDL::Char variables see PDL::Char(3), or perldoc PDL::Char
=head2 putslice
=for ref
Put a PDL matrix to a slice of a NetCDF variable
=for usage
Arguments:
1) The name of the variable to create
2) A reference to a list of dimension names for this variable
3) A reference to a list of dimensions for this variable
4) A reference to a list which specifies the N dimensional starting point of the slice.
5) A reference to a list which specifies the N dimensional count of the slice.
6) The PDL to put. It must conform to the size specified by the 4th and 5th
arguments. The 2nd and 3rd argument are optional if the variable is already
defined in the netcdf object.
7) Optional options: {DEFLATE => 7, SHUFFLE => 0/1, _FillValue => -32767} will use
gzip compression (level 7)
on that variable and shuffle will not/will use the shuffle filter. These options are
only valid for netcdf4 files. If you are unsure, test with
($nc->getFormat >= PDL::NetCDF::NC_FORMAT::NC_FORMAT_NETCDF4)
In addition, netcdf4 does not allow changing the _FillValue attribute
after the variable has been put/putslice'd. Therefore, the _FillValue
can be set with an option to put/putslice.
Returns:
None.
=for example
my $pdl = pdl [[1, 2, 3], [4, 5, 6]];
# Specify variable name to put PDL in, plus names of the dimensions. Dimension
# lengths are taken from the PDL, in this case, dim1 = 2 and dim2 = 3.
$ncobj->putslice ('var1', ['dim1', 'dim2', 'dim3'], [2,3,3], [0,0,0], [2,3,1], $pdl);
$ncobj->putslice ('var1', [], [], [0,0,2], [2,3,1], $pdl);
my $pdl2 = $ncobj->get('var1');
print $pdl2;
[
[
[ 1 9.96921e+36 1]
[ 2 9.96921e+36 2]
[ 3 9.96921e+36 3]
]
[
[ 4 9.96921e+36 4]
[ 5 9.96921e+36 5]
[ 6 9.96921e+36 6]
]
]
note that the netcdf missing value (not 0) is filled in.
=head2 sync
=for ref
Synchronize the data to the disk. Use this if you want to read
the file from another process without closing the file. This makes only
sense after put, puttext, putslice, putatt operations
=for usage
Returns:
nothing. Barfs on error.
=for example
$ncobj->sync
=head2 get
=for ref
Get a PDL matrix from a netCDF variable.
=for usage
Arguments:
1) The name of the netCDF variable to fetch. If this is the only
argument, then the entire variable will be returned.
To fetch a slice of the netCDF variable, optional 2nd and 3rd arguments
must be specified:
2) A pdl which specifies the N dimensional starting point of the slice.
3) A pdl which specifies the N dimensional count of the slice.
Also, an options hashref may be passed. The option 'NOCOMPRESS'
tells PDL::NetCDF to *not* try to uncompress
an compressed variable. See the COMPRESS option on 'put' and 'putslice'
for more info.
The option 'PDL_BAD' tells PDL::NetCDF to translate _FillValue
or missing_value attributes to bad-values, e.g. NaN's.
Returns:
The PDL representing the netCDF variable. Barfs on error.
=for example
# A slice of the netCDF variable.
# [0,0] is the starting point, [1,2] is the count.
my $slice = $ncobj->get ('var1', [0,0], [1,2], {NOCOMPRESS => 1, PDL_BAD => 1});
# If var1 contains this: [[1, 2, 3], [4, 5, 6]]
# Then $slice contains: [1,2] (Size '1' dimensions are eliminated).
=head2 putatt
=for ref
putatt -- Attach a numerical or textual attribute to a NetCDF variable or the entire file.
=for usage
Arguments:
1) The attribute. Either: A one dimensional PDL (perhaps containing only one number) or
a string.
2) The name to give the attribute in the netCDF file. Many attribute names
have pre-defined meanings. See the netCDF documentation for more details.
3) Optionally, you may specify the name of the pre-defined netCDF variable to associate
this attribute with. If this is left off, the attribute is a global one, pertaining to
the entire netCDF file.
Returns:
Nothing. Barfs on error.
=for example
# Attach a double attribute of size 3 to var1
$ncobj->putatt (double([1,2,3]), 'double_attribute', 'var1');
# Write a textual, global attribute. 'attr_name' is the attribute name.
$ncobj->putatt ('The text of the global attribute', 'attr_name');
=head2 getatt
=for ref
Get an attribute from a netCDF object.
=for usage
Arguments:
1) The name of the attribute (a text string).
2) The name of the variable this attribute is attached to. If this
argument is not specified, this function returns a global attribute of
the input name.
=for example
# Get a global attribute
my $attr2 = $ncobj->getatt ('attr_name');
# Get an attribute associated with the variable 'var1'
my $attr1 = $ncobj->getatt ('double_attribute', 'var1');
=head2 getDeflateShuffle
=for ref
Get the deflate level and the shuffle flag for a variable.
=for usage
Can be called on all files, although only netcdf4 files support shuffle and deflate.
Arguments:
1) The name of the variable.
Returns:
($deflate, $shuffle)
=for example
my ($deflate, $shuffle) = $nc->getDeflateShuffle('varName');
=head2 getvariabletype
=for ref
Get a type of a variable from a netCDF object.
=for usage
Arguments:
1) The name of the variable.
Returns:
PDL::type or undef, when variable not defined
=for example
# Get a type
my $type = $ncobj->getvariabletype ('var1');
=head2 puttext
=for ref
Put a perl text string into a multi-dimensional NetCDF array.
=for usage
Arguments:
1) The name of the variable to be created (a text string).
2) A reference to a perl list of dimension names to use in creating this NetCDF array.
3) A reference to a perl list of dimension lengths.
4) A perl string to put into the netCDF array. If the NetCDF array is 3 x 10, then the string must
have 30 charactars.
5) Optional nc4 options: {DEFLATE => 7, SHUFFLE => 0}
=for example
my $str = "Station1 Station2 Station3 ";
$obj->puttext('textvar', ['n_station', 'n_string'], [3,10], $str);
=head2 gettext
=for ref
Get a multi-dimensional NetCDF array into a perl string.
=for usage
Arguments:
1) The name of the NetCDF variable.
=for example
my $outstr = $obj->gettext('textvar');
=head2 dimsize
=for ref
Get the size of a dimension from a netCDF object.
=for usage
Arguments:
1) The name of the dimension.
Returns:
The size of the dimension.
=for example
my $dim1size = $ncobj->dimsize('dim1');
=head2 close
=for ref
Close a NetCDF object, writing out the file.
=for usage
Arguments:
None
Returns:
Nothing
This closing of the netCDF file can be done explicitly though the
'close' method. Alternatively, a DESTROY block does an automatic
close whenever the netCDF object passes out of scope.
=for example
$ncobj->close();
=head2 getdimensionnames ([$varname])
=for ref
Get all the dimension names from an open NetCDF object.
If a variable name is specified, just return dimension names for
*that* variable.
=for usage
Arguments:
none
Returns:
An array reference of dimension names
=for example
my $varlist = $ncobj->getdimensionnames();
foreach(@$varlist){
print "Found dim $_\n";
}
=head2 getattributenames
=for ref
Get the attribute names for a given variable from an open NetCDF object.
=for usage
Arguments: Optional variable name, with no arguments it will return
the objects global netcdf attributes.
Returns:
An array reference of attribute names
=for example
my $attlist = $ncobj->getattributenames('var1');
=head2 getvariablenames
=for ref
Get all the variable names for an open NetCDF object.
=for usage
Arguments:
none.
Returns:
An array reference of variable names
=for example
my $varlist = $ncobj->getvariablenames();
=head2 setrec
=for ref
Set up a 'record' of several 1D netCDF variables with the
same dimension. Once this is set up, quick reading/writing
of one element from all variables can be put/get from/to a
perl list.
=for usage
Arguments:
1) The names of all the netCDF variables to group into a record
Returns:
A record name to use in future putrec/getrec calls
=for example
my $rec = $ncobj->setrec('var1', 'var2', 'var3');
=head2 getrec
=for ref
Gets a 'record' (one value from each of several 1D netCDF
variables) previously set up using 'setrec'. These values
are returned in a perl list.
=for usage
Arguments:
1) The name of the record set up in 'setrec'.
2) The index to fetch.
Returns:
A perl list of all values. Note that these variables
can be of different types: float, double, integer, string.
=for example
my @rec = $ncobj->getrec($rec, 5);
=head2 putrec
=for ref
Puts a 'record' (one value from each of several 1D netCDF
variables) previously set up using 'setrec'. These values
are supplied as a perl list reference.
=for usage
Arguments:
1) The name of the record set up in 'setrec'.
2) The index to set.
3) A perl list ref containing the values.
Returns:
None.
=for example
$ncobj->putrec($rec, 5, \@values);
=head1 WRITING NetCDF-FILES EFFICIENTLY
Writing several variables to NetCDF-files can take a long time. When a
new variable is attached by C<put> to a file, the attribute header has
to be written. This might force the internal netcdf-library to
restructure the complete file, and thus might take very much
IO-resources. By pre-defining the dimensions, attributes, and
variables, much time can be saved. Essentially the rule of thumb is to
define and write the data in the order it will be laid out in the
file. Talking PDL::NetCDF, this means the following:
=over 4
=item Open the netcdf file
my $nc = new PDL::NetCDF('test.nc', {MODE => O_CREAT|O_RDWR,
REVERSE_DIMS => 1});
=item Write the global attributes
$nc->putatt (double([1,2,3]), 'double_attribute');
=item Define all variables, make use of the NC_UNLIMITED dimension
# here it is possible to choose float/double/short/long
$pdl_init = long ([]);
for (my $i=0; $i<$it; $i++) {
my $out2 = $nc->putslice("VAR$i",
['x','y','z','t'],
[150,100,20,PDL::NetCDF::NC_UNLIMITED()],
[0,0,0,0],[1,0,0,0],$pdl_init);
}
=item Write the variable-attributes
$nc->putatt ("var-attr", 'attribute', 'VAR0');
=item Write data with putslice
$nc->putslice("VAR5",[],[],[0,0,0,0],[$datapdl->dims],$datapdl);
=back
=head1 AUTHOR
Doug Hunt, dhunt\@ucar.edu.
=head2 CONTRIBUTORS
Heiko Klein, heiko.klein\@met.no
Edward Baudrez, Royal Meteorological Institute of Belgium, edward.baudrez\@meteo.be
Ed J (mohawk2), etj@cpan.org
=head1 SEE ALSO
perl(1), PDL(1), netcdf(3).
=cut
EOD
# Necessary includes for .xs file
pp_addhdr('#include <netcdf.h>'."\n");
if (!$ncversion->{nc_inq_var_deflate}) {
# NC_NETCDF4 defined in header though not always in lib
pp_addhdr('#undef NC_NETCDF4'."\n");
}
pp_addhdr(<<'EOH');
#define ushort unsigned short
#define longlong long long
#define PDLchar pdl
#define PDLuchar pdl
#define PDLshort pdl
#define PDLint pdl
#define PDLlong pdl
#define PDLfloat pdl
#define PDLdouble pdl
#define uchar unsigned char
#ifdef NC_NETCDF4
#define PDLushort pdl
#define PDL_longlong pdl
#endif
EOH
pp_bless ("PDL::NetCDF");
# Read in a modified netcdf.h file. Define
# a low-level perl interface to netCDF from these definitions.
sub create_low_level {
# This file must be modified to only include
# netCDF 3 function definitions.
# Also, all C function declarations must be on one line.
my $defn = shift;
my @lines = split (/\n/, $defn);
foreach (@lines) {
next if (/^\#/); # Skip commented out lines
next if (/^\s*$/); # Skip blank lines
my ($return_type, $func_name, $parms) = /^(\w+\**)\s+(\w+)\((.+)\)\;/;
my @parms = split (/,/, $parms);
my @vars = ();
my @types = ();
my %output = ();
foreach $parm (@parms) {
my ($varname) = ($parm =~ /([\w]+)$/);
$parm =~ s/$varname//; # parm now contains the full C type
$output{$varname} = 1 if (($parm =~ /\*/) && ($parm !~ /const/));
$parm =~ s/const //; # get rid of 'const' in C type
$parm =~ s/^\s+//;
$parm =~ s/\s+$//; # pare off the variable type from 'parm'
push (@vars, $varname);
push (@types, $parm);
}
my $xsout = '';
$xsout .= "$return_type\n";
$xsout .= "$func_name (" . join (", ", @vars) . ")\n";
for (my $i=0;$i<@vars;$i++) {
$xsout .= "\t$types[$i]\t$vars[$i]\n";
}
$xsout .= "CODE:\n";
$xsout .= "\tRETVAL = $func_name (";
for (my $i=0;$i<@vars;$i++) {
if ($types[$i] =~ /PDL_?/) {
($type = $types[$i]) =~ s/PDL_?//; # Get rid of PDL type when writine xs CODE section
$xsout .= "($type)$vars[$i]"."->data,";
} else {
$xsout .= "$vars[$i],";
}
}
chop ($xsout); # remove last comma
$xsout .= ");\n";
$xsout .= "OUTPUT:\n";
$xsout .= "\tRETVAL\n";
foreach $var (sort keys %output) {
$xsout .= "\t$var\n";
}
$xsout .= "\n\n";
pp_addxs ('', $xsout);
}
}
#-------------------------------------------------------------------------
# Create low level interface from edited netcdf header file.
#-------------------------------------------------------------------------
create_low_level (<<'EODEF');
int nc_create(const char *path, int cmode, int *ncidp);
int nc_open(const char *path, int mode, int *ncidp);
int nc_set_fill(int ncid, int fillmode, int *old_modep);
int nc_set_default_format(int format, int *old_formatp);
int nc_redef(int ncid);
int nc_enddef(int ncid);
int nc_sync(int ncid);
int nc_abort(int ncid);
int nc_close(int ncid);
int nc_inq(int ncid, int *ndimsp, int *nvarsp, int *nattsp, int *unlimdimidp);
int nc_inq_ndims(int ncid, int *ndimsp);
int nc_inq_nvars(int ncid, int *nvarsp);
int nc_inq_natts(int ncid, int *nattsp);
int nc_inq_unlimdim(int ncid, int *unlimdimidp);
int nc_inq_format(int ncid, int* formatp);
# /* Begin _dim */
int nc_def_dim(int ncid, const char *name, size_t len, int *idp);
int nc_inq_dimid(int ncid, const char *name, int *idp);
int nc_inq_dim(int ncid, int dimid, char *name, size_t *lenp);
int nc_inq_dimname(int ncid, int dimid, char *name);
int nc_inq_dimlen(int ncid, int dimid, size_t *lenp);
int nc_rename_dim(int ncid, int dimid, const char *name);
# /* End _dim */
# /* Begin _att */
int nc_inq_att(int ncid, int varid, const char *name, nc_type *xtypep, size_t *lenp);
int nc_inq_attid(int ncid, int varid, const char *name, int *idp);
int nc_inq_atttype(int ncid, int varid, const char *name, nc_type *xtypep);
int nc_inq_attlen(int ncid, int varid, const char *name, size_t *lenp);
int nc_inq_attname(int ncid, int varid, int attnum, char *name);
int nc_copy_att(int ncid_in, int varid_in, const char *name, int ncid_out, int varid_out);
int nc_rename_att(int ncid, int varid, const char *name, const char *newname);
int nc_del_att(int ncid, int varid, const char *name);
# /* End _att */
# /* Begin {put,get}_att */
int nc_put_att_text(int ncid, int varid, const char *name, size_t len, const char *op);
int nc_get_att_text(int ncid, int varid, const char *name, char *ip);
int nc_put_att_uchar(int ncid, int varid, const char *name, nc_type xtype, size_t len, const PDLuchar *op);
int nc_get_att_uchar(int ncid, int varid, const char *name, PDLuchar *ip);
int nc_put_att_schar(int ncid, int varid, const char *name, nc_type xtype, size_t len, const PDLchar *op);
int nc_get_att_schar(int ncid, int varid, const char *name, PDLchar *ip);
int nc_put_att_short(int ncid, int varid, const char *name, nc_type xtype, size_t len, const PDLshort *op);
int nc_get_att_short(int ncid, int varid, const char *name, PDLshort *ip);
int nc_put_att_int(int ncid, int varid, const char *name, nc_type xtype, size_t len, const PDLint *op);
int nc_get_att_int(int ncid, int varid, const char *name, PDLint *ip);
int nc_put_att_long(int ncid, int varid, const char *name, nc_type xtype, size_t len, const PDLlong *op);
int nc_get_att_long(int ncid, int varid, const char *name, PDLlong *ip);
int nc_put_att_float(int ncid, int varid, const char *name, nc_type xtype, size_t len, const PDLfloat *op);
int nc_get_att_float(int ncid, int varid, const char *name, PDLfloat *ip);
int nc_put_att_double(int ncid, int varid, const char *name, nc_type xtype, size_t len, const PDLdouble *op);
int nc_get_att_double(int ncid, int varid, const char *name, PDLdouble *ip);
# /* End {put,get}_att */
# /* Begin _var */
int nc_def_var(int ncid, const char *name, nc_type xtype, int ndims, PDLint *dimidsp, int *varidp);
int nc_inq_var(int ncid, int varid, char *name, nc_type *xtypep, int *ndimsp, PDLint *dimidsp, int *nattsp);
int nc_inq_varid(int ncid, const char *name, int *varidp);
int nc_inq_varname(int ncid, int varid, char *name);
int nc_inq_vartype(int ncid, int varid, nc_type *xtypep);
int nc_inq_varndims(int ncid, int varid, int *ndimsp);
int nc_inq_vardimid(int ncid, int varid, PDLint *dimidsp);
int nc_inq_varnatts(int ncid, int varid, int *nattsp);
int nc_rename_var(int ncid, int varid, const char *name);
int nc_copy_var(int ncid_in, int varid, int ncid_out);
# /* End _var */
# /* Begin {put,get}_vara */
int nc_put_vara_text(int ncid, int varid, size_t *startp, size_t *countp, const char *op);
int nc_get_vara_text(int ncid, int varid, size_t *startp, size_t *countp, char *ip);
int nc_put_vara_uchar(int ncid, int varid, size_t *startp, size_t *countp, PDLuchar *op);
int nc_get_vara_uchar(int ncid, int varid, size_t *startp, size_t *countp, PDLuchar *ip);
int nc_put_vara_schar(int ncid, int varid, size_t *startp, size_t *countp, PDLchar *op);
int nc_get_vara_schar(int ncid, int varid, size_t *startp, size_t *countp, PDLchar *ip);
int nc_put_vara_short(int ncid, int varid, size_t *startp, size_t *countp, PDLshort *op);
int nc_get_vara_short(int ncid, int varid, size_t *startp, size_t *countp, PDLshort *ip);
int nc_put_vara_int(int ncid, int varid, size_t *startp, size_t *countp, PDLint *op);
int nc_get_vara_int(int ncid, int varid, size_t *startp, size_t *countp, PDLint *ip);
int nc_put_vara_long(int ncid, int varid, size_t *startp, size_t *countp, PDLlong *op);
int nc_get_vara_long(int ncid, int varid, size_t *startp, size_t *countp, PDLlong *ip);
int nc_put_vara_float(int ncid, int varid, size_t *startp, size_t *countp, PDLfloat *op);
int nc_get_vara_float(int ncid, int varid, size_t *startp, size_t *countp, PDLfloat *ip);
int nc_put_vara_double(int ncid, int varid, size_t *startp, size_t *countp, PDLdouble *op);
int nc_get_vara_double(int ncid, int varid, size_t *startp, size_t *countp, PDLdouble *ip);
# /* End {put,get}_vara */
# /* Begin {put,get}_var */
int nc_put_var_text(int ncid, int varid, const char *op);
int nc_get_var_text(int ncid, int varid, char *ip);
int nc_put_var_uchar(int ncid, int varid, const PDLuchar *op);
int nc_get_var_uchar(int ncid, int varid, PDLuchar *ip);
int nc_put_var_schar(int ncid, int varid, const PDLchar *op);
int nc_get_var_schar(int ncid, int varid, PDLchar *ip);
int nc_put_var_short(int ncid, int varid, const PDLshort *op);
int nc_get_var_short(int ncid, int varid, PDLshort *ip);
int nc_put_var_int(int ncid, int varid, const PDLint *op);
int nc_get_var_int(int ncid, int varid, PDLint *ip);
int nc_put_var_long(int ncid, int varid, const PDLlong *op);
int nc_get_var_long(int ncid, int varid, PDLlong *ip);
int nc_put_var_float(int ncid, int varid, const PDLfloat *op);
int nc_get_var_float(int ncid, int varid, PDLfloat *ip);
int nc_put_var_double(int ncid, int varid, const PDLdouble *op);
int nc_get_var_double(int ncid, int varid, PDLdouble *ip);
# /* End {put,get}_var */
EODEF
#-------------------------------------------------------------------------
# new functions only available in netcdf4
#-------------------------------------------------------------------------
pp_addxs('', "#ifdef NC_NETCDF4\n");
create_low_level(<<'EODEF');
int nc_put_var_ushort(int ncid, int varid, const PDLushort *op);
int nc_get_var_ushort(int ncid, int varid, PDLushort *ip);
int nc_put_vara_ushort(int ncid, int varid, size_t *startp, size_t *countp, PDLushort *op);
int nc_get_vara_ushort(int ncid, int varid, size_t *startp, size_t *countp, PDLushort *ip);
int nc_put_att_ushort(int ncid, int varid, const char *name, nc_type xtype, size_t len, const PDLushort *op);
int nc_get_att_ushort(int ncid, int varid, const char *name, PDLushort *ip);
int nc_put_var_longlong(int ncid, int varid, const PDL_longlong *op);
int nc_get_var_longlong(int ncid, int varid, PDL_longlong *ip);
int nc_put_vara_longlong(int ncid, int varid, size_t *startp, size_t *countp, PDL_longlong *op);
int nc_get_vara_longlong(int ncid, int varid, size_t *startp, size_t *countp, PDL_longlong *ip);
int nc_put_att_longlong(int ncid, int varid, const char *name, nc_type xtype, size_t len, const PDL_longlong *op);
int nc_get_att_longlong(int ncid, int varid, const char *name, PDL_longlong *ip);
int nc_def_var_deflate(int ncid, int varid, int shuffle, int deflate, int deflate_level);
int nc_inq_var_deflate(int ncid, int varid, int *shufflep, int *deflatp, int *deflate_levelp);
EODEF
pp_addxs('', "#endif /* NC_NETCDF4 */\n");
pp_addxs('', <<"EOXS");
MODULE = PDL::NetCDF PACKAGE = PDL::NetCDF
int
isNetcdf4 ()
CODE:
{
#ifdef NC_NETCDF4
RETVAL = 1;
#else
RETVAL = 0;
#endif
}
OUTPUT:
RETVAL
EOXS
#-------------------------------------------------------------------------
# Perl portion of the interface (put by PP into the .pm file)
#-------------------------------------------------------------------------
pp_addpm (<<'EOPM');
use Carp;
use Fcntl; # importing constants O_CREAT,O_RDONLY,O_RDWR
use constant DEBUG => 0;
EOPM
my $SIZE = $Config{'sizetype'} eq 'size_t'
? $Config{'sizesize'}
: $Config{'ivsize'};
if ($SIZE == 8) { pp_addpm ('
use constant PACKTYPE => "Q*";
');
} else { pp_addpm ('
use constant PACKTYPE => "L*";
'); }
#-------------------------------------------------------------------------
# netCDF constants
#-------------------------------------------------------------------------
pp_addpm pp_line_numbers(__LINE__, <<'EOPM');
# These defines are taken from netcdf.h I deemed this cleaner than using
# h2xs and the autoload stuff, which mixes awkwardly with PP.
sub NC_FILL_BYTE () { return -127; }
sub NC_FILL_CHAR () { return 0; }
sub NC_FILL_SHORT () { return -32767; }
sub NC_FILL_INT () { return -2147483647; }
sub NC_FILL_FLOAT () { return 9.9692099683868690e+36; } # near 15 * 2^119
sub NC_FILL_DOUBLE () { return 9.9692099683868690e+36; }
sub NC_FILL_UBYTE () { return 255; }
sub NC_FILL_USHORT () { return 65535; }
sub NC_FILL_UINT () { return 4294967295; }
sub NC_FILL_INT64 () { return -9223372036854775806; }
sub NC_FILL_UINT64 () { return 18446744073709551614; }
sub NC_FILL_STRING () { return ""; }
sub NC_FORMAT_CLASSIC () { return 1; }
sub NC_FORMAT_64BIT () { return 2; }
sub NC_FORMAT_NETCDF4 () { return 3; }
sub NC_FORMAT_NETCDF4_CLASSIC () { return 4; }
sub NC_CLOBBER () { return 0; }
sub NC_NOWRITE () { return 0; }
sub NC_WRITE () { return 0x1; } # read & write
sub NC_NOCLOBBER () { return 0x4; } # Don't destroy existing file on create
sub NC_FILL () { return 0; } # argument to ncsetfill to clear NC_NOFILL
sub NC_NOFILL () { return 0x100; } # Don't fill data section an records
sub NC_LOCK () { return 0x0400; } # Use locking if available
sub NC_SHARE () { return 0x0800; } # Share updates, limit cacheing
sub NC_UNLIMITED () { return 0; }
sub NC_GLOBAL () { return -1; }
sub NC_MAX_DIMS () { return 100; } # max dimensions per file
sub NC_MAX_ATTRS () { return 2000; }# max global or per variable attributes
sub NC_MAX_VARS () { return 2000; } # max variables per file
sub NC_MAX_NAME () { return 128; } # max length of a name
sub NC_MAX_VAR_DIMS () { return NC_MAX_DIMS; } # max per variable dimensions
sub NC_NOERR () { return 0; } # No Error
sub NC_EBADID () { return -33; } # Not a netcdf id
sub NC_ENFILE () { return -34; } # Too many netcdfs open
sub NC_EEXIST () { return -35; } # netcdf file exists && NC_NOCLOBBER
sub NC_EINVAL () { return -36; } # Invalid Argument
sub NC_EPERM () { return -37; } # Write to read only
sub NC_ENOTINDEFINE () { return -38; } # Operation not allowed in data mode
sub NC_EINDEFINE () { return -39; } # Operation not allowed in define mode
sub NC_EINVALCOORDS () { return -40; } # Index exceeds dimension bound
sub NC_EMAXDIMS () { return -41; } # NC_MAX_DIMS exceeded
sub NC_ENAMEINUSE () { return -42; }# String match to name in use
sub NC_ENOTATT () { return -43; } # Attribute not found
sub NC_EMAXATTS () { return -44; } # NC_MAX_ATTRS exceeded
sub NC_EBADTYPE () { return -45; } # Not a netcdf data type
sub NC_EBADDIM () { return -46; } # Invalid dimension id or name
sub NC_EUNLIMPOS () { return -47; } # NC_UNLIMITED in the wrong index
sub NC_EMAXVARS () { return -48; } # NC_MAX_VARS exceeded
sub NC_ENOTVAR () { return -49; } # Variable not found
sub NC_EGLOBAL () { return -50; } # Action prohibited on NC_GLOBAL varid
sub NC_ENOTNC () { return -51; } # Not a netcdf file
sub NC_ESTS () { return -52; } # In Fortran, string too short
sub NC_EMAXNAME () { return -53; } # NC_MAX_NAME exceeded
sub NC_EUNLIMIT () { return -54; } # NC_UNLIMITED size already in use
sub NC_ENORECVARS () { return -55; }# nc_rec op when there are no record vars
sub NC_ECHAR () { return -56; } # Attempt to convert between text & numbers
sub NC_EEDGE () { return -57; } # Edge+start exceeds dimension bound
sub NC_ESTRIDE () { return -58; } # Illegal stride
sub NC_EBADNAME () { return -59; } # Attribute or variable name
sub NC_ERANGE () { return -60; } # Math result not representable
sub NC_ENOMEM () { return -61; } # Memory allocation (malloc) failure
sub NC_SYSERR () { return (-31)};
sub NC_FATAL () { return 1}; # quit on netcdf error
sub NC_VERBOSE () { return 2}; # give verbose error messages
sub NC_BYTE () { return 1; } # signed 1 byte integer
sub NC_CHAR () { return 2; } # ISO/ASCII character
sub NC_SHORT () { return 3; } # signed 2 byte integer
sub NC_INT () { return 4; } # signed 4 byte integer
sub NC_FLOAT () { return 5; } # single precision floating point number
sub NC_DOUBLE () { return 6; } # double precision floating point number
sub NC_UBYTE () { return 7; } # unsigned 1 byte int
sub NC_USHORT () { return 8; } # unsigned 2-byte int
sub NC_UINT () { return 9; } # unsigned 4-byte int
sub NC_INT64 () { return 10; } # signed 8-byte int
sub NC_UINT64 () { return 11; } # unsigned 8-byte int
sub NC_STRING () { return 12; } # string
# Used for creating new blank pdls with the input number of dimensions, and
# the correct type.
my %typemap = (
NC_BYTE() => sub { PDL->zeroes (PDL::byte, @_); },
NC_CHAR() => sub { PDL::Char->new(PDL->zeroes (PDL::byte, @_)); },
NC_SHORT() => sub { PDL->zeroes (PDL::short, @_); },
NC_INT() => sub { PDL->zeroes (PDL::long, @_); },
NC_FLOAT() => sub { PDL->zeroes (PDL::float, @_); },
NC_DOUBLE() => sub { PDL->zeroes (PDL::double, @_); },
NC_UBYTE() => sub { PDL->zeroes (PDL::byte, @_); },
NC_USHORT() => sub { PDL->zeroes (PDL::ushort, @_); },
NC_UINT() => sub { PDL->zeroes (PDL::long, @_); },
NC_INT64() => sub { PDL->zeroes (PDL::longlong, @_); },
NC_UINT64() => sub { PDL->zeroes (PDL::longlong, @_); },
);
# Used for creating new pdls with the input data, and
# the correct type.
my %typemap1 = (
NC_BYTE() => sub { PDL::byte (@_); },
NC_CHAR() => sub { PDL::byte (@_); },
NC_SHORT() => sub { PDL::short (@_); },
NC_INT() => sub { PDL::long (@_); },
NC_FLOAT() => sub { PDL::float (@_); },
NC_DOUBLE() => sub { PDL::double(@_); },
NC_UBYTE() => sub { PDL::byte (@_); },
NC_USHORT() => sub { PDL::ushort(@_); },
NC_UINT() => sub { PDL::long(@_); },
NC_INT64() => sub { PDL::longlong(@_); },
NC_UINT64() => sub { PDL::longlong(@_); },
);
# Used for creating new blank pdls with the input number of dimensions, and
# the correct type.
my %typemap2 = (
PDL::byte->[0] => sub { return PDL::NetCDF::nc_put_var_uchar (@_); },
PDL::short->[0] => sub { return PDL::NetCDF::nc_put_var_short (@_); },
PDL::long->[0] => sub { return PDL::NetCDF::nc_put_var_int (@_); },
PDL::float->[0] => sub { return PDL::NetCDF::nc_put_var_float (@_); },
PDL::double->[0] => sub { return PDL::NetCDF::nc_put_var_double (@_); },
PDL::ushort->[0] => sub { return PDL::NetCDF::nc_put_var_ushort (@_); },
PDL::longlong->[0] => sub { return PDL::NetCDF::nc_put_var_longlong (@_); },
);
# Used for mapping a PDL type to a netCDF type
my %typemap3 = (
PDL::byte->[0] => NC_BYTE(),
PDL::short->[0] => NC_SHORT(),
PDL::long->[0] => NC_INT(),
PDL::float->[0] => NC_FLOAT(),
PDL::double->[0] => NC_DOUBLE(),
PDL::ushort->[0] => NC_USHORT(),
PDL::longlong->[0] => NC_INT64(),
);
# Used for getting a netCDF variable for the correct type of a PDL
my %typemap4 = (
PDL::byte->[0] => sub { PDL::NetCDF::nc_get_var_uchar (@_); },
PDL::short->[0] => sub { PDL::NetCDF::nc_get_var_short (@_); },
PDL::long->[0] => sub { PDL::NetCDF::nc_get_var_int (@_); },
PDL::float->[0] => sub { PDL::NetCDF::nc_get_var_float (@_); },
PDL::double->[0] => sub { PDL::NetCDF::nc_get_var_double (@_); },
PDL::ushort->[0] => sub { PDL::NetCDF::nc_get_var_ushort (@_); },
PDL::longlong->[0] => sub { PDL::NetCDF::nc_get_var_longlong (@_); },
);
# Used for putting attributes of correct type for a PDL
my %typemap5 = (
PDL::byte->[0] => sub { return PDL::NetCDF::nc_put_att_uchar (@_); },
PDL::short->[0] => sub { return PDL::NetCDF::nc_put_att_short (@_); },
PDL::long->[0] => sub { return PDL::NetCDF::nc_put_att_int (@_); },
PDL::float->[0] => sub { return PDL::NetCDF::nc_put_att_float (@_); },
PDL::double->[0] => sub { return PDL::NetCDF::nc_put_att_double (@_); },
PDL::ushort->[0] => sub { return PDL::NetCDF::nc_put_att_ushort (@_); },
PDL::longlong->[0] => sub { return PDL::NetCDF::nc_put_att_longlong (@_); },
);
# Used for getting a netCDF attribute for the correct type of a PDL
my %typemap6 = (
PDL::byte->[0] => sub { PDL::NetCDF::nc_get_att_uchar (@_); },
PDL::short->[0] => sub { PDL::NetCDF::nc_get_att_short (@_); },
PDL::long->[0] => sub { PDL::NetCDF::nc_get_att_int (@_); },
PDL::float->[0] => sub { PDL::NetCDF::nc_get_att_float (@_); },
PDL::double->[0] => sub { PDL::NetCDF::nc_get_att_double (@_); },
PDL::ushort->[0] => sub { PDL::NetCDF::nc_get_att_ushort (@_); },
PDL::longlong->[0] => sub { PDL::NetCDF::nc_get_att_longlong (@_); },
);
# Used for getting a slice of a netCDF variable for the correct type of a PDL
my %typemap7 = (
PDL::byte->[0] => sub { PDL::NetCDF::nc_get_vara_uchar (@_); },
PDL::short->[0] => sub { PDL::NetCDF::nc_get_vara_short (@_); },
PDL::long->[0] => sub { PDL::NetCDF::nc_get_vara_int (@_); },
PDL::float->[0] => sub { PDL::NetCDF::nc_get_vara_float (@_); },
PDL::double->[0] => sub { PDL::NetCDF::nc_get_vara_double (@_); },
PDL::ushort->[0] => sub { PDL::NetCDF::nc_get_vara_ushort (@_); },
PDL::longlong->[0] => sub { PDL::NetCDF::nc_get_vara_longlong (@_); },
);
# Used for putting a slice of a netCDF variable for the correct type of a PDL
my %typemap8 = (
PDL::byte->[0] => sub { PDL::NetCDF::nc_put_vara_uchar (@_); },
PDL::short->[0] => sub { PDL::NetCDF::nc_put_vara_short (@_); },
PDL::long->[0] => sub { PDL::NetCDF::nc_put_vara_int (@_); },
PDL::float->[0] => sub { PDL::NetCDF::nc_put_vara_float (@_); },
PDL::double->[0] => sub { PDL::NetCDF::nc_put_vara_double (@_); },
PDL::ushort->[0] => sub { PDL::NetCDF::nc_put_vara_ushort (@_); },
PDL::longlong->[0] => sub { PDL::NetCDF::nc_put_vara_longlong (@_); },
);
my %fillmap = (
NC_BYTE() => NC_FILL_BYTE(),
NC_CHAR() => NC_FILL_CHAR(),
NC_SHORT() => NC_FILL_SHORT(),
NC_INT() => NC_FILL_INT(),
NC_FLOAT() => NC_FILL_FLOAT(),
NC_DOUBLE() => NC_FILL_DOUBLE(),
NC_UBYTE() => NC_FILL_UBYTE(),
NC_USHORT() => NC_FILL_USHORT(),
NC_UINT() => NC_FILL_UINT(),
NC_INT64() => NC_FILL_INT64(),
NC_UINT64() => NC_FILL_UINT64(),
);
# maps original type to compressed type
my %compressionMap = (
PDL::float->[0] => PDL::short->[0],
PDL::double->[0] => PDL::long->[0],
);
# options one can specify in the call to new
my %legalopts = (
REVERSE_DIMS => 1, # index in the C order, not the FORTRAN order
TEMPLATE => 1, # initialize this nc object with contents of a previous object
PERL_SCALAR => 1, # return single element PDLs as perl scalars
PDL_BAD => 1, # return missing values as PDL bad values
NC_FORMAT => 1, # choose the files format for new files, NC_FORMAT_*, see also defaultFormat
SLOW_CHAR_FETCH => 1, # read individual PDL::Char values in a loop instead of at once
DEBUG => 1,
);
# get/set the format of PDL::NetCDF
sub defaultFormat {
my ($format) = @_;
my $oldFormat;
if (defined $format) {
my $rc = PDL::NetCDF::nc_set_default_format($format, $oldFormat=-999);
barf ("Cannot change default format -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
} else {
my $rc = PDL::NetCDF::nc_set_default_format(NC_FORMAT_CLASSIC(), $oldFormat=-999);
barf ("Cannot get default format -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
if ($rc == NC_NOERR) {
my $temp;
$rc = PDL::NetCDF::nc_set_default_format($oldFormat, $temp=-999);
barf ("Cannot get default format -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
}
}
return $oldFormat;
}
# This routine hooks up an object to a NetCDF file.
sub new {
my $type = shift;
my $file = shift;
my $opt = shift || {}; # options hash
my $fast = 0; # fast new does not inquire about all variables and dimensions.
# This is assumed to have been done before. All this info
# is taken from the previous nc object. This is useful
# if one has to process many identical netCDF files.
#
## Handle options
#
my $self = {};
if (exists($$opt{TEMPLATE})) {
$fast = 1;
$self = $$opt{TEMPLATE};
delete $$opt{TEMPLATE};
}
foreach my $optname (keys %$opt) {
if ($legalopts{$optname}) {
$self->{$optname} = $$opt{$optname};
}
}
my $rc;
my $write;
if (exists($$opt{MODE})) { # write-mode
if ($file =~ s/^\s*>//) {
carp "MODE set and $file starts with >: suppressing >";
}
my $create;
if (($$opt{MODE} | O_CREAT | O_RDONLY | O_RDWR | O_EXCL) !=
(O_CREAT | O_RDONLY | O_RDWR | O_EXCL)) {
barf "unknown mode, only defined: O_CREAT,O_RDONLY,O_RDWR,O_EXCL";
} elsif ($$opt{MODE} & O_EXCL) {
barf "opening O_EXCL, but file $file exists"
if (-f $file);
} elsif ($$opt{MODE} & O_CREAT) {
my $create = 1;
if (-f $file) {
unlink $file
or barf "Cannot remove $file: $!";
}
} elsif ( O_RDONLY && ( $$opt{MODE} & O_RDONLY )
|| !O_RDONLY && ( ($$opt{MODE} & (O_CREAT | O_RDWR | O_EXCL)) == O_RDONLY ) ) {
# O_RDONLY may be zero on some platforms
$write = 0;
unless (-f $file) {
barf "Cannot open readonly! No such file: $file";
}
} elsif ($$opt{MODE} & O_RDWR) {
$write = 1;
unless (-f $file) {
unless ($create) {
barf "Cannot open rdwr! No such file: $file";
}
}
}
} elsif (substr($file, 0, 1) eq '>') { # open for writing
$file = substr ($file, 1); # chop off >
$write = 1;
}
if (-e $file or ($file =~ m{^https?://})) {
if ($write) {
$rc = PDL::NetCDF::nc_open ($file, NC_WRITE(), $self->{NCID}=-999);
barf ("new: Cannot open file -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
$self->{WR} = 'w';
} else { # Open read-only
$rc = PDL::NetCDF::nc_open ($file, 0, $self->{NCID}=-999);
barf ("new: Cannot open file -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
$self->{WR} = 'r';
# Specify that this file is out of define mode
$self->{DEFINE} = 0;
}
# Record file name
$self->{FILENM} = $file;
# don't bother to inquire about this file. The info in the nc object
# passed in should suffice.
return $self if ($fast);
# Find out about variables, dimensions and global attributes in this file
my ($ndims, $nvars, $ngatts, $unlimid);
# $rc = PDL::NetCDF::nc_inq_ndims ($self->{NCID}, $ndims=-999);
# barf ("new: Cannot inquire ndims -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
# $rc = PDL::NetCDF::nc_inq_nvars ($self->{NCID}, $nvars=-999);
# barf ("new: Cannot inquire nvars -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
$rc = PDL::NetCDF::nc_inq ($self->{NCID}, $ndims=-999, $nvars=-999, $ngatts=-999, $unlimid=-999);
barf ("new: Cannot inquire -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
$self->{UNLIMID} = $unlimid;
for (my $i=0;$i<$ndims;$i++) {
$rc = PDL::NetCDF::nc_inq_dimname ($self->{NCID}, $i,
my $name='x' x NC_MAX_NAME()); # Preallocate strings
barf ("new: Cannot inquire dim name -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
$self->{DIMIDS}{$name} = $i;
$rc = PDL::NetCDF::nc_inq_dimlen ($self->{NCID}, $i, my $len = -999);
barf ("new: Cannot inquire dim length -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
$self->{DIMLENS}{$name} = $len;
}
for (my $i=0;$i<$nvars;$i++) {
$rc = PDL::NetCDF::nc_inq_varname ($self->{NCID}, $i,
my $name='x' x NC_MAX_NAME()); # Preallocate strings
barf ("new: Cannot inquire var name -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
$self->{VARIDS}{$name} = $i;
$rc = PDL::NetCDF::nc_inq_vartype ($self->{NCID}, $self->{VARIDS}{$name},
$self->{DATATYPES}{$name}=-999);
barf ("new: Cannot inquire var type -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
$rc = PDL::NetCDF::nc_inq_varnatts ($self->{NCID}, $i,
my $natts=-999);
barf ("new: Cannot inquire natts -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
for (my $j=0;$j<$natts; $j++) {
$rc = PDL::NetCDF::nc_inq_attname ($self->{NCID}, $i, $j,
my $attname='x' x NC_MAX_NAME()); # Preallocate strings
barf ("new: Cannot inquire att name -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
# Determine the type and length of this attribute
$rc = PDL::NetCDF::nc_inq_atttype ($self->{NCID}, $i, $attname, my $datatype=-999);
barf ("new: Cannot get attribute type -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
$rc = PDL::NetCDF::nc_inq_attlen ($self->{NCID}, $i, $attname, my $attlen=-999);
barf ("new: Cannot get attribute length -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
$self->{ATTTYPE}{$name}{$attname}=$datatype;
$self->{ATTLEN}{$name}{$attname}=$attlen;
}
}
for (my $i=0;$i<$ngatts; $i++) {
$self->{VARIDS}{GLOBAL}=NC_GLOBAL();
$rc = PDL::NetCDF::nc_inq_attname ($self->{NCID},$self->{VARIDS}{GLOBAL} , $i,
my $attname='x' x NC_MAX_NAME()); # Preallocate strings
barf ("new: Cannot inquire global att name -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
# Determine the type and length of this attribute
$rc = PDL::NetCDF::nc_inq_atttype ($self->{NCID}, $self->{VARIDS}{GLOBAL}, $attname, my $datatype=-999);
barf ("new: Cannot get attribute type -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
$rc = PDL::NetCDF::nc_inq_attlen ($self->{NCID}, $self->{VARIDS}{GLOBAL}, $attname, my $attlen=-999);
barf ("new: Cannot get attribute length -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
$self->{ATTTYPE}{GLOBAL}{$attname}=$datatype;
$self->{ATTLEN}{GLOBAL}{$attname}=$attlen;
}
# Specify that this file is out of define mode
$self->{DEFINE} = 0;
} else { # new file
my $oldFormat;
defaultFormat($opt->{NC_FORMAT}, $oldFormat) if ($opt->{NC_FORMAT});
$rc = PDL::NetCDF::nc_create ($file, NC_CLOBBER(), $self->{NCID}=-999);
defaultFormat($oldFormat, my $tmp) if ($opt->{NC_FORMAT});
barf ("new: Cannot create netCDF file -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
# Specify that this file is now in define mode
$self->{DEFINE} = 1;
# Open for writing
$self->{WR} = 'w';
}
# Record file name
$self->{FILENM} = $file;
bless $self, $type;
return $self;
}
# Get the format of the file
sub getFormat {
my ($self) = @_;
my $format;
my $rc = nc_inq_format($self->{NCID}, $format=-999);
barf("Cannot get format -- " . PDL::NetCDF::nc_strerror($rc)) if $rc;
return $format;
}
# Explicitly close a netCDF file and free the object
sub close {
my $self = shift;
my $retVal = 1;
if ($self->{NCID} != -999) {
$retVal = PDL::NetCDF::nc_close ($self->{NCID});
$self->{NCID} = -999;
}
return $retVal;
}
# Close a netCDF object when it passes out of scope
sub DESTROY {
my $self = shift;
# print "Destroying $self\n";
$self->close;
}
# Get deflate and shuffle level of a variable
sub getDeflateShuffle {
my ($self, $varnm) = @_;
return (0,0) if ($self->getFormat < PDL::NetCDF::NC_FORMAT_NETCDF4);
barf ("getDeflateShuffle: undefined varname $varname") unless exists $self->{VARIDS}{$varnm};
my ($deflate, $isDeflate, $shuffel);
my $rc = nc_inq_var_deflate($self->{NCID}, $self->{VARIDS}{$varnm}, $shuffle=-999, $isDeflate=-999, $deflate=-999);
barf ("getDeflateShuffle: ncerror on $varname -- ".nc_strerror($rc)) if $rc;
return ($deflate, $shuffle);
}
# Get the names and order of dimensions in a variable, otherwise
# get the names of all dimensions
sub getdimensionnames {
my $self = shift;
my $varnm = shift;
my $dimnames = [];
my $dimids = [values %{$self->{DIMIDS}}];
if (defined $varnm) {
my ($ndims, $rc);
# Cannot call nc_inq_varndims unless $self->{VARIDS}{$varnm} is defined
if (!defined($self->{VARIDS}{$varnm})) {
$ndims = 0;
} else { # normal case
$rc = PDL::NetCDF::nc_inq_varndims ($self->{NCID}, $self->{VARIDS}{$varnm}, $ndims=-999);
}
if ($ndims > 0) {
$dimids = zeroes (PDL::long, $ndims);
$rc |= PDL::NetCDF::nc_inq_vardimid ($self->{NCID}, $self->{VARIDS}{$varnm}, $dimids);
barf ("getdimensionnames: Cannot get info on this var id -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
$dimids = [list $dimids];
} else {
$dimids = [];
}
}
foreach my $id (@$dimids) {
foreach(keys %{$self->{DIMIDS}}){
push(@$dimnames,$_) if $self->{DIMIDS}{$_} == $id;
}
}
if ($self->{REVERSE_DIMS}) {
$dimnames = [ reverse @$dimnames ];
}
$dimnames;
}
# Return the names of all variables in the netCDF file. Special care
# is taken to return them in the order defined in the file.
sub getvariablenames {
my $self = shift;
my @varnames = ();
return [()] unless (exists $self->{VARIDS});
for my $varn (keys %{$self->{VARIDS}}){
next if($self->{VARIDS}{$varn} == NC_GLOBAL());
push (@varnames, $varn);
}
@varnames = sort { $self->{VARIDS}{$a} <=> $self->{VARIDS}{$b} } (@varnames);
return \@varnames;
}
# Return the names of all attribute names in the netCDF file.
sub getattributenames {
my $self = shift;
my $varname = shift;
$varname = 'GLOBAL' unless(defined $varname);
my $attnames = [];
foreach(keys %{$self->{ATTTYPE}{$varname}}){
push(@$attnames,$_);
}
$attnames;
}
sub sync {
my $self = shift; # name of object
$rc = PDL::NetCDF::nc_sync($self->{NCID});
barf ("sync: Cannot sync file -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
return;
}
# Put a netCDF variable from a PDL
sub put {
my $self = shift; # name of object
my $varnm = shift; # name of netCDF variable to create or update
my $dims = shift; # set of dimensions, i.e. ['dim1', 'dim2']
my $pdl = shift; # PDL to put
my $opt = shift || {};
my $compress = delete $opt->{COMPRESS} || 0;
my $deflate = delete $opt->{DEFLATE} || 0;
my $shuffle = delete $opt->{SHUFFLE} || 0;
my $fillValue = delete $opt->{_FillValue};
barf ("Unknown options to put: ". join(",", keys %{$opt})) if (keys %{$opt});
if ($self->{REVERSE_DIMS}) {
$dims = [ reverse @$dims ];
}
barf "Cannot write read-only netCDF file $self->{FILENM}" if ($self->{WR} eq 'r');
# Define dimensions if necessary
my @dimlens = reverse $pdl->dims;
my $dimids = (@dimlens > 0) ? zeroes (PDL::long, scalar(@dimlens)) : pdl [];
my $dimlens = scalar (@$dims);
for (my $i=0;$i<@$dims;$i++) {
if (!defined($self->{DIMIDS}{$$dims[$i]})) {
unless ($self->{DEFINE}) {
my $rc = PDL::NetCDF::nc_redef ($self->{NCID});
barf ("Cannot put file into define mode") if $rc;
$self->{DEFINE} = 1;
}
my $rc = PDL::NetCDF::nc_def_dim ($self->{NCID}, $$dims[$i], $dimlens[$i],
$self->{DIMIDS}{$$dims[$i]}=-999);
barf ("put: Cannot define dimension -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
$self->{DIMLENS}{$$dims[$i]} = $dimlens[$i];
}
set ($dimids, $i, $self->{DIMIDS}{$$dims[$i]});
barf ("put: Attempt to redefine length of dimension $$dims[$i]")
if ($self->{DIMLENS}{$$dims[$i]} != $dimlens[$i]);
}
my ($datatype, $pdltype);
# Define variable if necessary
if (!defined($self->{VARIDS}{$varnm})) {
unless ($self->{DEFINE}) {
my $rc = PDL::NetCDF::nc_redef ($self->{NCID});
barf ("put: Cannot put file into define mode -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
$self->{DEFINE} = 1;
}
if (ref($pdl) =~ /Char/) { # a PDL::Char type PDL--write a netcdf char variable
$datatype = NC_CHAR();
} else {
$pdltype = $pdl->get_datatype;
$pdltype = $compressionMap{$pdltype} if ($compress);
$datatype = $typemap3{$pdltype};
}
my $rc = PDL::NetCDF::nc_def_var ($self->{NCID}, $varnm, $datatype,
$dimlens, $dimids, $self->{VARIDS}{$varnm}=-999);
barf ("put: Cannot define variable -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
if ($deflate || $shuffle) {
my $doDeflate = $deflate > 0 ? 1 : 0;
my $rc = PDL::NetCDF::nc_def_var_deflate($self->{NCID}, $self->{VARIDS}{$varnm}, $shuffle, $doDeflate, $deflate);
barf ("put: Cannot shuffle/deflate variable -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
}
$self->{DATATYPES}{$varnm} = $datatype;
}
# set _FillValue before data
if (defined $fillValue) {
$fillValue = PDL->zeroes($pdl->type, 1) + $fillValue
if !ref $fillValue; # make it a pdl
$self->putatt($fillValue, '_FillValue', $varnm);
}
# Make PDL physical
$pdl->make_physical;
# Get out of define mode
if ($self->{DEFINE}) {
my $rc = PDL::NetCDF::nc_enddef ($self->{NCID});
barf ("put: Cannot end define mode -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
$self->{DEFINE} = 0;
}
# Call the correct 'put' routine depending on PDL type
if (ref($pdl) =~ /Char/) { # a PDL::Char type PDL--write a netcdf char variable
$rc = PDL::NetCDF::nc_put_var_text ($self->{NCID}, $self->{VARIDS}{$varnm}, ${$pdl->get_dataref});
} else {
#
## compute a compressed PDL to put if compression is requested
#
if ($compress) {
my $var = $pdl->copy;
my ($min, $max) = $var->minmax;
my $r1 = ($max - $min);
my ($add_offset, $scale_factor, $newfill);
if ($pdltype == PDL::short->[0]) { # original type = float, new type = short
my $r2 = 2**16 - 2; # positive range of unsigned short with one left over for an error value (max short)
$var -= $min;
$var *= ($r2/$r1);
$var -= 2**15; # map values from min(short) to max(short)
$newfill = (2**15)-1; # max(short) = fill value
$var->inplace->setbadtoval($newfill);
$rc = &{$typemap2{$pdltype}}($self->{NCID}, $self->{VARIDS}{$varnm}, $var->short);
$add_offset = float([$min]);
$scale_factor = float([$r1/$r2])
} elsif ($pdltype == PDL::long->[0]) { # original type = double, new type = long
my $r2 = 2**32 - 2; # positive range of unsigned long with one left over for an error value (max short)
$var -= $min;
$var *= ($r2/$r1);
$var -= 2**31; # map values from min(long) to max(long)
$newfill = (2**31)-1; # max(long) = fill value
$var->inplace->setbadtoval($newfill);
$rc = &{$typemap2{$pdltype}}($self->{NCID}, $self->{VARIDS}{$varnm}, $var->long);
$add_offset = double([$min]);
$scale_factor = double([$r1/$r2]);
} else {
barf ("put (compressed): compression of other than float or double variables not supported");
}
barf ("put (compressed): Cannot write file -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
# write compression attributes
$self->putatt($newfill, '_FillValue', $varnm);
$self->putatt($add_offset, 'add_offset', $varnm);
$self->putatt($scale_factor, 'scale_factor', $varnm);
} else { # no compression
$rc = &{$typemap2{$pdl->get_datatype}}($self->{NCID}, $self->{VARIDS}{$varnm}, $pdl);
barf ("put: Cannot write file -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
}
}
return 0;
}
#
# Put a netCDF variable slice (array section) from a PDL
#
sub putslice {
my $self = shift; # name of object
my $varnm = shift; # name of netCDF variable to create or update
my $dims = shift; # set of dimensions, i.e. ['dim1', 'dim2']
my $dimdefs = shift;# Need to state dims explicitly since the PDL is a subset
my $start = shift; # ref to perl array containing start of hyperslab to get
my $count = shift; # ref to perl array containing count along each dimension
my $pdl = shift; # PDL to put
my $opt = shift || {}; # options for deflate/shuffle
my $deflate = delete $opt->{DEFLATE} || 0;
my $shuffle = delete $opt->{SHUFFLE} || 0;
my $fillValue = delete $opt->{_FillValue};
barf ("Unknown options to putslice: ". join(",", keys %{$opt})) if (keys %{$opt});
if ($self->{REVERSE_DIMS}) {
$dims = [ reverse @$dims ];
$dimdefs = [ reverse @$dimdefs ];
$start = [ reverse @$start ];
$count = [ reverse @$count ];
}
barf "Cannot write read-only netCDF file $self->{FILENM}" if ($self->{WR} eq 'r');
if (!defined($self->{VARIDS}{$varnm})) {
# Define dimensions if necessary
my @dimlens = @$dimdefs;
my $dimids = zeroes (PDL::long, scalar(@dimlens));
for (my $i=0;$i<@$dims;$i++) {
if (!defined($self->{DIMIDS}{$$dims[$i]})) {
unless ($self->{DEFINE}) {
my $rc = PDL::NetCDF::nc_redef ($self->{NCID});
barf ("Cannot put file into define mode") if $rc;
$self->{DEFINE} = 1;
}
my $rc = PDL::NetCDF::nc_def_dim ($self->{NCID}, $$dims[$i], $dimlens[$i],
$self->{DIMIDS}{$$dims[$i]}=-999);
barf ("put: Cannot define dimension -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
$self->{UNLIMID} = $self->{DIMIDS}{$$dims[$i]} if ($dimlens[$i] == PDL::NetCDF::NC_UNLIMITED());
$self->{DIMLENS}{$$dims[$i]} = $dimlens[$i];
}
set ($dimids, $i, $self->{DIMIDS}{$$dims[$i]});
barf ("putslice: Attempt to redefine length of dimension $$dims[$i]")
if ($self->{DIMLENS}{$$dims[$i]} != $dimlens[$i]);
}
# Define variable if necessary
unless ($self->{DEFINE}) {
my $rc = PDL::NetCDF::nc_redef ($self->{NCID});
barf ("put: Cannot put file into define mode -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
$self->{DEFINE} = 1;
}
my $datatype;
if (ref($pdl) =~ /Char/) { # a PDL::Char type PDL--write a netcdf char variable
$datatype = NC_CHAR();
} else {
$datatype = $typemap3{$pdl->get_datatype};
}
my $rc = PDL::NetCDF::nc_def_var ($self->{NCID}, $varnm, $datatype,
scalar(@dimlens), $dimids, $self->{VARIDS}{$varnm}=-999);
barf ("put: Cannot define variable -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
if ($deflate || $shuffle) {
my $doDeflate = $deflate > 0 ? 1 : 0;
my $rc = PDL::NetCDF::nc_def_var_deflate($self->{NCID}, $self->{VARIDS}{$varnm}, $shuffle, $doDeflate, $deflate);
barf ("put: Cannot shuffle/deflate variable -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
}
$self->{DATATYPES}{$varnm} = $datatype;
}
if (defined $fillValue) {
$fillValue = PDL->zeroes($pdl->type, 1) + $fillValue
if !ref $fillValue; # make it a pdl
$self->putatt($fillValue, '_FillValue', $varnm);
}
# Make PDL physical
$pdl->make_physical;
# Get out of define mode
if ($self->{DEFINE}) {
my $rc = PDL::NetCDF::nc_enddef ($self->{NCID});
barf ("put: Cannot end define mode -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
$self->{DEFINE} = 0;
}
# Convert start and count from perl lists to scalars
my $st = pack (PACKTYPE, @$start);
my $ct = pack (PACKTYPE, @$count);
# Call the correct 'put' routine depending on PDL type
if(ref($pdl) =~ /Char/) { # a PDL::Char type PDL--write a netcdf char variable
$rc = PDL::NetCDF::nc_put_vara_text ($self->{NCID}, $self->{VARIDS}{$varnm}, $st, $ct, ${$pdl->get_dataref});
} else {
$rc = &{$typemap8{$pdl->get_datatype}}($self->{NCID}, $self->{VARIDS}{$varnm}, $st, $ct, $pdl);
}
barf ("put: Cannot write file -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
return 0;
}
sub _recursiveGetStringSlice {
my ($self, $varnm, $pdl, $start, $count, $curStart, $loopPos) = @_;
if ($loopPos == (@$start - 1)) {
# allocate a string max line-size, determined by last dimension
my $t = ' ' x $count->[$loopPos];
# only last count > 1;
my @slice_count = map { 1 } @$count;
$slice_count[-1] = $count->[$loopPos];
my $st = pack (PACKTYPE, @$curStart);
my $ct = pack (PACKTYPE, @slice_count);
$rc = PDL::NetCDF::nc_get_vara_text ($self->{NCID}, $self->{VARIDS}{$varnm}, $st, $ct, $t);
my @pdlStart;
for (my $i = 0; $i < $loopPos; $i++) {
if ($count->[$i] > 1) { # slices with size 1 are reduced
unshift @pdlStart, $curStart->[$i] - $start->[$i]; # reverse dims here!
}
}
unless (@pdlStart) {
$pdlStart[0] = 0;
}
$pdl->setstr(@pdlStart, $t);
} else {
for (my $i = 0; $i < $count->[$loopPos]; $i++) {
my @thisStart = @$curStart;
$thisStart[$loopPos] = $start->[$loopPos] + $i;
# and now read the slice starting at thisPos
_recursiveGetStringSlice($self, $varnm, $pdl, $start, $count, \@thisStart, $loopPos+1);
}
}
}
# Get the explicit or default _FillValue for a variable
sub _getFillValue {
my ($self, $varnm) = @_;
eval { $self->getatt('_FillValue', $varnm) } // $fillmap{$self->{DATATYPES}{$varnm}};
}
# Get a variable into a pdl
sub get {
my $self = shift;
my $varnm = shift;
# separate options hash (if present) from the rest of the args
my ($opt) = grep { ref($_) =~ /HASH/ } @_;
my @args = grep { ref($_) !~ /HASH/ } @_;
print "In get(): self = $self, varnm = $varnm\n" if ($self->{DEBUG});
my $rc = 0;
# Optional variables
my $start = shift @args; # ref to perl array containing start of hyperslab to get
my $count = shift @args; # ref to perl array containing count along each dimension
if ($self->{REVERSE_DIMS}) {
if (defined $start) {
$start = [ reverse @$start ];
}
if (defined $count) {
$count = [ reverse @$count ];
}
}
barf ("Cannot find variable $varnm") if (!defined($self->{VARIDS}{$varnm}));
my $pdl; # The PDL to return
if (defined ($count)) { # Get a hyperslab of the netCDF matrix
# Get rid of length one dimensions. @cnt used for allocating new blank PDL
# to put data in.
my @cnt = ();
foreach my $elem (@$count) {
push (@cnt, $elem) if ($elem != 1);
}
if (@cnt == 0) { @cnt = (1); } # If count all ones, replace with single one
# Note the 'reverse'! Necessary fiddling to get dimension order to work.
$pdl = &{$typemap{$self->{DATATYPES}{$varnm}}}(reverse @cnt);
my $st = pack (PACKTYPE, @$start);
my $ct = pack (PACKTYPE, @$count);
# Get the data
if (ref($pdl) =~ /Char/) { # a PDL::Char type PDL--write a netcdf char variable
# Determine the type of this variable. We need this info to test if the first
# dimension is unlimited. D. Hunt 8/3/2009
$rc = PDL::NetCDF::nc_inq_varndims ($self->{NCID}, $self->{VARIDS}{$varnm}, my $ndims=-999);
barf ("get: Cannot get number of variables -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
my $dimids = ($ndims > 0) ? zeroes (PDL::long, $ndims) : pdl [];
$rc = PDL::NetCDF::nc_inq_vardimid ($self->{NCID}, $self->{VARIDS}{$varnm}, $dimids);
barf ("get: Cannot get info on this var id -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
# If the first dim is the unlimited dim, this PDL needs to be read in slices. D. Hunt 8/3/2009
if ($self->{SLOW_CHAR_FETCH} || (defined $self->{UNLIMID} && $self->{UNLIMID} == $dimids->at(0))) {
_recursiveGetStringSlice($self, $varnm, $pdl, $start, $count, $start, 0);
} else { # first dim not the unlimited dimension
my $f = ${$pdl->get_dataref};
$rc = PDL::NetCDF::nc_get_vara_text ($self->{NCID}, $self->{VARIDS}{$varnm}, $st, $ct, $f);
${$pdl->get_dataref} = $f;
$pdl->upd_data();
}
} else {
$rc = &{$typemap7{$pdl->get_datatype}}($self->{NCID}, $self->{VARIDS}{$varnm}, $st, $ct, $pdl);
}
barf ("get: Cannot get data -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
} else { # get whole netCDF matrix
# Determine the type of this variable
my ($ndims, $natts, $i);
$rc = PDL::NetCDF::nc_inq_varndims ($self->{NCID}, $self->{VARIDS}{$varnm}, $ndims=-999);
barf ("get: Cannot get number of variables -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
my $dimids = ($ndims > 0) ? zeroes (PDL::long, $ndims) : pdl [];
$rc = PDL::NetCDF::nc_inq_vardimid ($self->{NCID}, $self->{VARIDS}{$varnm}, $dimids);
barf ("get: Cannot get info on this var id -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
print "In get(): ndims = $ndims, natts = $natts, dimids = $dimids\n" if ($self->{DEBUG});
# Find out size of each dimension of this NetCDF matrix
my ($name, $size, @cnt);
for ($i=0;$i<$ndims;$i++) {
my $rc = PDL::NetCDF::nc_inq_dim ($self->{NCID}, $dimids->at($i), $name='x' x NC_MAX_NAME(), $size=-999);
barf ("get: Cannot get info on this dimension -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
barf ("get: Dimension must be positive") if ($size <= 0); # Added to address zero length vars. D. Hunnt 4/29/2005
push (@cnt, $size);
}
# Create empty PDL (of correct type and size) to hold output from NetCDF file
if (defined($opt->{FETCH_AS})) {
my $netcdf_type = $typemap3{$opt->{FETCH_AS}}; # FETCH_AS is the PDL type: PDL::byte->[0] ..PDL::longlong->[0]
$pdl = &{$typemap{$netcdf_type}}(reverse @cnt);
} else {
$pdl = &{$typemap{$self->{DATATYPES}{$varnm}}}(reverse @cnt);
}
print "In get(): pdl = ", $pdl->info, " cnt = @cnt\n" if ($self->{DEBUG});
# Get the data
if (ref($pdl) =~ /Char/) { # a PDL::Char type PDL--write a netcdf char variable
# If the first dim is the unlimited dim, this PDL needs to be read in slices. D. Hunt 1/17/2003
if ($self->{SLOW_CHAR_FETCH} || (defined $self->{UNLIMID} && $self->{UNLIMID} == $dimids->at(0))) {
my @start = map {0} @cnt;
_recursiveGetStringSlice($self, $varnm, $pdl, \@start, \@cnt, \@start, 0);
} else {
my $f = ${$pdl->get_dataref};
$rc = PDL::NetCDF::nc_get_var_text ($self->{NCID}, $self->{VARIDS}{$varnm}, $f);
${$pdl->get_dataref} = $f;
$pdl->upd_data();
}
} else {
if (defined($opt->{FETCH_AS})) {
$rc = &{$typemap4{$opt->{FETCH_AS}}}($self->{NCID}, $self->{VARIDS}{$varnm}, $pdl);
} else {
$rc = &{$typemap4{$pdl->get_datatype}}($self->{NCID}, $self->{VARIDS}{$varnm}, $pdl);
}
print "In get(): rc = $rc, pdl[info, first, last] = ", $pdl->info, " ", $pdl->at(0), " ", $pdl->at($pdl->nelem-1), "\n" if ($self->{DEBUG});
}
barf ("get: Cannot get data -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
}
#
## If this variable is compressed (simple netCDF offset/scale compression) then uncompress it.
#
unless ($opt->{NOCOMPRESS}) {
if (defined (my $type = $self->{ATTTYPE}{$varnm}{'scale_factor'})) {
print "In get(): why am I uncompressing?\n" if ($self->{DEBUG});
my $scale_factor = $self->getatt('scale_factor', $varnm);
my $add_offset = $self->getatt('add_offset', $varnm);
my $fill = $self->_getFillValue($varnm);
$fill = $fill->at(0) if (ref($fill) =~ /PDL/); # convert to perl scalar
my $uncomp;
if ($type == NC_FLOAT()) {
$uncomp = $pdl->float; # create output PDL of float type
$uncomp->inplace->setvaltobad($fill) if (defined($fill));
$uncomp += 2**15; # change signed short vals to unsigned short vals
} elsif ($type == NC_DOUBLE()) {
$uncomp = $pdl->double; # create output PDL of float type
$uncomp->inplace->setvaltobad($fill) if (defined($fill));
$uncomp += 2**31; # change signed long vals to unsigned long vals
}
$uncomp *= $scale_factor;
$uncomp += $add_offset;
$pdl = $uncomp;
}
}
# convert netcdf fill/missing values to PDL badvals if requested and missing value is available
if ($self->{PDL_BAD} || $opt->{PDL_BAD}) {
my $fill = $self->_getFillValue($varnm);
$fill = $fill->sclr if UNIVERSAL::isa($missing, 'PDL');
$pdl->inplace->setvaltobad($fill) if (defined($fill));
print "In get(): _FillValue = $fill, pdl[info] = ", $pdl->info, "\n" if ($self->{DEBUG});
my $missing = eval { $self->getatt('missing_value', $varnm); };
$missing = $missing->sclr if UNIVERSAL::isa($missing, 'PDL');
$pdl->inplace->setvaltobad($missing) if (defined($missing));
print "In get(): missing = $missing, pdl[info, first, last] = ", $pdl->info, " ", $pdl->at(0), " ", $pdl->at($pdl->nelem-1), "\n" if ($self->{DEBUG});
}
# convert single value PDLs to perl scalars if requested
$pdl = (exists($self->{PERL_SCALAR}) and ($pdl->nelem == 1)) ? $pdl->at(0) : $pdl;
return $pdl;
}
# Get the size of a dimension
sub dimsize {
my $self = shift;
my $dimnm = shift;
barf ("dimsize: No such dimension -- $dimnm") unless exists ($self->{DIMIDS}{$dimnm});
my ($dimsz, $name);
my $rc = nc_inq_dimlen ($self->{NCID}, $self->{DIMIDS}{$dimnm}, $dimsz=-999);
barf ("dimsize: Cannot get dimension length -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
return $dimsz;
}
# Put a netCDF attribute from a PDL or string
sub putatt {
my $self = shift; # name of object
my $att = shift; # Attribute to put. Can be a string, a PDL, or a ref to a list of strings
my $attnm = shift; # Name of attribute to put
my $varnm = shift; # name of netCDF variable this attribute is to be associated with
# (defaults to global if not passed).
barf "Cannot write read-only netCDF file $self->{FILENM}" if ($self->{WR} eq 'r');
# If no varnm passed in, fetch a global attribute
if (!defined($varnm)) {
$varnm = 'GLOBAL';
$self->{VARIDS}{$varnm} = NC_GLOBAL();
}
# Put netCDF file into define mode
unless ($self->{DEFINE}) {
my $rc = PDL::NetCDF::nc_redef ($self->{NCID});
barf ("putatt: Cannot put file into define mode -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
$self->{DEFINE} = 1;
}
# Attribute is a PDL one-D variable
if (ref $att eq 'PDL') {
barf ("Attributes can only be 1 dimensional") if ($att->dims != 1);
# Make PDL physical
$att->make_physical;
# Put the attribute
my $rc = &{$typemap5{$att->get_datatype}}($self->{NCID}, $self->{VARIDS}{$varnm},
$attnm, $typemap3{$att->get_datatype},
nelem ($att), $att);
barf ("putatt: Cannot put PDL attribute -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
#
# update self
#
$self->{ATTTYPE}{$varnm}{$attnm} = $typemap3{$att->get_datatype};
$self->{ATTLEN}{$varnm}{$attnm} = $att->nelem;
} elsif (ref $att eq '') { # A scalar variable
# Put the attribute
my $rc = PDL::NetCDF::nc_put_att_text ($self->{NCID}, $self->{VARIDS}{$varnm}, $attnm,
length($att), $att."\0"); # null terminate!
barf ("putatt: Cannot put string attribute -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
#
# update self
#
$self->{ATTTYPE}{$varnm}{$attnm} = NC_CHAR();
$self->{ATTLEN}{$varnm}{$attnm} = length($att);
} elsif (ref $att eq 'ARRAY') { # A ref to a list: Treat as a list of strings for string attributes
# Put the attribute
my $rc = PDL::NetCDF::nc_put_att_string ($self->{NCID}, $self->{VARIDS}{$varnm}, $attnm,
scalar(@$att), $att);
barf ("putatt: Cannot put string attribute -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
#
# update self
#
$self->{ATTTYPE}{$varnm}{$attnm} = NC_STRING();
$self->{ATTLEN}{$varnm}{$attnm} = scalar(@$att);
} else {
barf ("Attributes of this type not supported");
}
# Get out of define mode
if ($self->{DEFINE}) {
my $rc = PDL::NetCDF::nc_enddef ($self->{NCID});
barf ("put: Cannot end define mode -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
$self->{DEFINE} = 0;
}
return 0;
}
# Get an attribute value into a pdl
sub getatt {
my $self = shift;
my $attnm = shift;
my $varnm = shift;
# If no varnm passed in, fetch a global attribute
if (!defined($varnm)) {
$varnm = 'GLOBAL';
$self->{VARIDS}{$varnm} = NC_GLOBAL();
}
# Determine the type and length of this attribute
my($datatype,$attlen);
if(defined $self->{ATTTYPE}{$varnm}{$attnm}){
$datatype = $self->{ATTTYPE}{$varnm}{$attnm};
$attlen = $self->{ATTLEN}{$varnm}{$attnm};
}else{
barf ("getatt: Attribute not found -- $varnm:$attnm");
}
# $rc = PDL::NetCDF::nc_inq_atttype ($self->{NCID}, $self->{VARIDS}{$varnm}, $attnm, my $datatype=-999);
# barf ("getatt: Cannot get attribute type -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
#
# $rc = PDL::NetCDF::nc_inq_attlen ($self->{NCID}, $self->{VARIDS}{$varnm}, $attnm, my $attlen=-999);
# barf ("getatt: Cannot get attribute length -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
# Get text attribute into perl string
if ($datatype == NC_CHAR()) {
$rc = PDL::NetCDF::nc_get_att_text ($self->{NCID}, $self->{VARIDS}{$varnm},
$attnm, my $str=('x' x $attlen)."\0"); # null terminate!
barf ("getatt: Cannot get text attribute -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
return $str;
} elsif ($datatype == NC_STRING()) { # Handle the new string attributes
my $str = PDL::NetCDF::nc_get_att_string ($self->{NCID}, $self->{VARIDS}{$varnm}, $attnm, $attlen);
return $str;
}
# Get PDL attribute
# Create empty PDL (of correct type and size) to hold output from NetCDF file
my $pdl = &{$typemap{$datatype}}($attlen);
# Get the attribute
$rc = &{$typemap6{$pdl->get_datatype}}($self->{NCID}, $self->{VARIDS}{$varnm}, $attnm, $pdl);
barf ("getatt: Cannot get attribute -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
return (exists($self->{PERL_SCALAR}) and ($pdl->nelem == 1)) ? $pdl->at(0) : $pdl;
}
# Get the PDL-type of a variable
sub getvariabletype {
my $self = shift;
my $varnm = shift;
unless (defined $self->{DATATYPES}{$varnm}) {
# carp ("getvariabletype: variable $varnm not found, returning undef");
return undef;
}
return $typemap1{$self->{DATATYPES}{$varnm}}();
}
# Put a perl string into a multi-dimensional netCDF object
#
## ex: $o->puttext ('station_names', ['n_stations', 'n_string'], [3,10], 'Station1 Station2 Station3');
#
sub puttext {
my $self = shift;
my $varnm = shift;
my $dims = shift;
my $dimlens = shift; # Length of dimensions
my $str = shift; # Perl string with data
my $opt = shift || {}; # options for deflate/shuffle
my $deflate = delete $opt->{DEFLATE} || 0;
my $shuffle = delete $opt->{SHUFFLE} || 0;
barf ("Unknown options to puttext: ". join(",", keys %{$opt})) if (keys %{$opt});
my $ndims = scalar(@$dimlens);
barf "Cannot write read-only netCDF file $self->{FILENM}" if ($self->{WR} eq 'r');
# Define dimensions if necessary
my $dimids = zeroes (PDL::long, $ndims);
for (my $i=0;$i<@$dims;$i++) {
if (!defined($self->{DIMIDS}{$$dims[$i]})) {
unless ($self->{DEFINE}) {
my $rc = PDL::NetCDF::nc_redef ($self->{NCID});
barf ("Cannot put file into define mode") if $rc;
$self->{DEFINE} = 1;
}
my $rc = PDL::NetCDF::nc_def_dim ($self->{NCID}, $$dims[$i], $$dimlens[$i],
$self->{DIMIDS}{$$dims[$i]}=-999);
barf ("put: Cannot define dimension -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
$self->{DIMLENS}{$$dims[$i]} = $$dimlens[$i];
}
set ($dimids, $i, $self->{DIMIDS}{$$dims[$i]});
barf ("put: Attempt to redefine length of dimension $$dims[$i]")
if ($self->{DIMLENS}{$$dims[$i]} != $$dimlens[$i]);
}
# Define variable if necessary
if (!defined($self->{VARIDS}{$varnm})) {
unless ($self->{DEFINE}) {
my $rc = PDL::NetCDF::nc_redef ($self->{NCID});
barf ("put: Cannot put file into define mode -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
$self->{DEFINE} = 1;
}
my $datatype = NC_CHAR();
my $rc = PDL::NetCDF::nc_def_var ($self->{NCID}, $varnm, $datatype,
$ndims, $dimids, $self->{VARIDS}{$varnm}=-999);
barf ("put: Cannot define variable -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
if ($deflate || $shuffle) {
my $doDeflate = $deflate > 0 ? 1 : 0;
my $rc = PDL::NetCDF::nc_def_var_deflate($self->{NCID}, $self->{VARIDS}{$varnm}, $shuffle, $doDeflate, $deflate);
barf ("put: Cannot shuffle/deflate variable -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
}
$self->{DATATYPES}{$varnm} = $datatype;
}
# Get out of define mode
if ($self->{DEFINE}) {
my $rc = PDL::NetCDF::nc_enddef ($self->{NCID});
barf ("put: Cannot end define mode -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
$self->{DEFINE} = 0;
}
my $st = pack (PACKTYPE, ((0) x $ndims));
my $ct = pack (PACKTYPE, @$dimlens);
# Call the 'put' routine
$rc = PDL::NetCDF::nc_put_vara_text ($self->{NCID}, $self->{VARIDS}{$varnm}, $st, $ct, $str."\0"); # null terminate!
barf ("put: Cannot write file -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
return 0;
}
# Get an entire text variable into one big string. Multiple dimensions are concatenated.
sub gettext {
my $self = shift;
my $varnm = shift;
# Determine the type of this variable
my ($ndims, $natts, $i, $rc);
return '' unless (defined($self->{VARIDS}{$varnm}));
$rc = PDL::NetCDF::nc_inq_varndims ($self->{NCID}, $self->{VARIDS}{$varnm}, $ndims=-999);
barf ("get: Cannot get number of variables -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
my $dimids = zeroes (PDL::long, $ndims);
$rc = PDL::NetCDF::nc_inq_vardimid ($self->{NCID}, $self->{VARIDS}{$varnm}, $dimids);
barf ("get: Cannot get info on this var id -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
# Find out size of each dimension of this NetCDF matrix
my ($name, $size, $total_size, @dims);
$total_size = 1;
@dims = ();
for ($i=0;$i<$ndims;$i++) {
my $rc = PDL::NetCDF::nc_inq_dim ($self->{NCID}, $dimids->at($i), $name='x' x NC_MAX_NAME(), $size=-999);
barf ("get: Cannot get info on this dimension -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
$total_size *= $size;
push (@dims, $size);
}
my $datatype = $self->{DATATYPES}{$varnm};
# Get text attribute into perl string
barf ("gettext: Data not of string type") if ($datatype != NC_CHAR());
my $st = pack (PACKTYPE, ((0) x $ndims));
my $ct = pack (PACKTYPE, @dims);
$rc = PDL::NetCDF::nc_get_vara_text ($self->{NCID}, $self->{VARIDS}{$varnm}, $st, $ct, my $str=('x' x $total_size)."\0"); # null terminate!
barf ("gettext: Cannot get text variable -- " . PDL::NetCDF::nc_strerror ($rc)) if $rc;
return $str;
}
# Establish a 'record' (a group of 1D variables all having a shared dimension).
sub setrec {
my $self = shift;
my @vars = @_;
my $varlist = $self->getvariablenames();
my %dimhash = ();
my @strdim = ();
foreach my $var (@vars) {
die "Cannot find $var in netCDF file" if (!grep /^$var$/, @$varlist);
my $dimname = $self->getdimensionnames($var);
my $datatype = $self->{DATATYPES}{$var};
if ($datatype == NC_CHAR) {
die "Character variable $var has more than two dimensions" if (@$dimname > 2);
push (@strdim, $self->{DIMLENS}{$$dimname[1]});
} else {
die "$var has more than one dimension" if (@$dimname > 1);
push (@strdim, 0);
}
$dimhash{$$dimname[0]}++;
}
# Insist all variables must have the same dimension name
die "All variables in a record must have the same dimension (which is not true here)"
if (keys %dimhash > 1);
my $recN = (defined($self->{MAXRECNUM}) ? $self->{MAXRECNUM} : 0) + 1;
$self->{MAXRECNUM} = $recN;
my $rec_name = "rec$recN";
$self->{RECS}{$rec_name}{NAMES} = [@vars];
# Store the data types of each variable in the record
$self->{RECS}{$rec_name}{DATATYPES} = [map { $self->{DATATYPES}{$_} } @vars];
# Store the variable IDs of each variable in the record $self->{VARIDS}{$name} = $i;
$self->{RECS}{$rec_name}{VARIDS} = [map { $self->{VARIDS}{$_} } @vars];
# Store the lengths of string dimensions (if any) for all variables
$self->{RECS}{$rec_name}{STRLEN} = [@strdim];
return $rec_name;
}
# Perl outer layer of the 'putrec' subroutine to update many 1D variables quickly
sub putrec {
my $self = shift;
my $rec = shift; # record name
my $idx = shift;
my $values = shift;
c_putrec ($self->{NCID}, $self->{RECS}{$rec}{VARIDS},
$self->{RECS}{$rec}{DATATYPES},
$self->{RECS}{$rec}{STRLEN},
$idx, $values);
}
# Perl outer layer of the 'getrec' subroutine to update many 1D variables quickly
# my @rec = $ncobj->getrec($rec, 5);
sub getrec {
my $self = shift;
my $rec = shift; # record name
my $idx = shift;
return c_getrec ($self->{NCID}, $self->{RECS}{$rec}{VARIDS},
$self->{RECS}{$rec}{DATATYPES},
$self->{RECS}{$rec}{STRLEN}, $idx);
}
EOPM
#-------------------------------------------------------------------------
# Add the error number -> error string translation function interface
# to the .xs file. This function behaves differently than the others
# from netcdf.h, so it is not created in 'create_low_level'
#-------------------------------------------------------------------------
pp_addxs (<<'EOXS');
SV *
nc_strerror (errid)
int errid
CODE:
{
const char * myerrstr;
char errstr[NC_MAX_NAME]; /* use of this second string gets rid of a warning msg */
myerrstr = nc_strerror (errid);
strcpy (errstr, myerrstr);
RETVAL = newSVpv (errstr, strlen(myerrstr));
}
OUTPUT:
RETVAL
EOXS
#-------------------------------------------------------------------------
# Add the ability to fetch 'string' variable attributes (as opposed to 'text')
# using the new routine nc_get_att_string
#-------------------------------------------------------------------------
pp_addxs (<<'EOXS');
SV *
nc_get_att_string(ncid, varid, name, attlen)
int ncid
int varid
char *name
size_t attlen
CODE:
{
int i;
AV *perlarray = newAV();
char **string_attr = (char**)malloc(attlen * sizeof(char*));
memset(string_attr, 0, attlen * sizeof(char*));
int rc = nc_get_att_string(ncid, varid, name, string_attr);
if (rc != NC_NOERR)
croak("Error fetching attribute %s from varid %d\n", name, varid);
for (i=0;i<attlen;i++) {
size_t lenstr = strlen(string_attr[i]);
SV *perlstr = newSVpv (string_attr[i], lenstr);
av_push(perlarray, perlstr);
}
RETVAL = newRV((SV *)perlarray);
rc = nc_free_string(attlen, string_attr);
if (rc != NC_NOERR)
croak("Error in nc_free_string attribute %s from varid %d\n", name, varid);
free(string_attr);
}
OUTPUT:
RETVAL
EOXS
#-------------------------------------------------------------------------
# Add the ability to put 'string' variable attributes (as opposed to 'text')
# using the new routine nc_put_att_string. These strings are multiple, represented
# as a char** in C and a ref to a list of perl strings in perl.
#-------------------------------------------------------------------------
pp_addxs (<<'EOXS');
int
nc_put_att_string(ncid, varid, name, len, perlarr_ref)
int ncid
int varid
char *name
size_t len
SV *perlarr_ref
CODE:
{
int i;
char **string_attr = (char**)malloc(len * sizeof(char*));
memset(string_attr, 0, len * sizeof(char*));
AV *perlarr = (AV *)SvRV(perlarr_ref);
for (i=0;i<len;i++) {
SV** perlstr_p = av_fetch(perlarr, i, 0);
string_attr[i] = SvPVbyte_nolen(*perlstr_p); // Assume string null-terminated!
}
RETVAL = nc_put_att_string(ncid, varid, name, len, (const char **)string_attr);
if (RETVAL != NC_NOERR)
printf("Error in nc_put_att_string for attribute %s from varid %d\n", name, varid);
free(string_attr);
}
OUTPUT:
RETVAL
EOXS
#-------------------------------------------------------------------------
# Put a list of values to a bunch of 1D variables.
#-------------------------------------------------------------------------
pp_addxs (<<'EOXS');
int
c_putrec (ncid, varids, datatypes, strlen, idx, values)
int ncid
SV* varids
SV* datatypes
SV* strlen
int idx
SV* values
PPCODE:
int i;
int dt;
int varid;
char c_elem;
short s_elem;
ushort us_elem;
int i_elem;
unsigned int ui_elem;
longlong ll_elem;
unsigned longlong ull_elem;
float f_elem;
double d_elem;
char *t_elem; // Hard-coded 256 char limit to string sizes!
STRLEN len;
SV **elem;
size_t nc_index[2]; // Index for use in inserting variables
size_t nc_count[2]; // For 'classic' string variables
int rc = NC_NOERR; // 0
int recsize = av_len((AV *)SvRV(varids)) + 1;
nc_index[0] = idx; // index to put
nc_index[1] = 0; // For string variables
nc_count[0] = 1; // For string variables
// loop over input variables
for (i=0; i<recsize; i++) {
elem = av_fetch((AV *)SvRV(datatypes), i, 0); // elem is perl SV for the datatype
dt = (int)SvIV(*elem); // dt is the data type of the current variable (C int)
elem = av_fetch((AV *)SvRV(varids), i, 0);
varid = (int)SvIV(*elem);
elem = av_fetch((AV *)SvRV(values), i, 0); // perl SV for current value
if (dt == NC_BYTE) {
c_elem = (char)SvIV(*elem); // element to put
rc = nc_put_var1_schar (ncid, varid, nc_index, &c_elem);
} else if (dt == NC_SHORT) {
s_elem = (short)SvIV(*elem); // element to put
rc = nc_put_var1_short (ncid, varid, nc_index, &s_elem);
} else if (dt == NC_INT) {
i_elem = (int)SvIV(*elem); // element to put
rc = nc_put_var1_int (ncid, varid, nc_index, &i_elem);
#ifdef NC_NETCDF4
} else if (dt == NC_USHORT) {
us_elem = (ushort)SvIV(*elem); // element to put
rc = nc_put_var1_ushort (ncid, varid, nc_index, &us_elem);
} else if (dt == NC_UINT) {
ui_elem = (unsigned int)SvIV(*elem); // element to put
rc = nc_put_var1_uint (ncid, varid, nc_index, &ui_elem);
} else if (dt == NC_INT64) {
ll_elem = (longlong)SvIV(*elem); // element to put
rc = nc_put_var1_longlong (ncid, varid, nc_index, &ll_elem);
} else if (dt == NC_UINT64) {
ull_elem = (unsigned longlong)SvIV(*elem); // element to put
rc = nc_put_var1_ulonglong (ncid, varid, nc_index, &ll_elem);
#endif
} else if (dt == NC_FLOAT) {
f_elem = (float)SvNV(*elem); // element to put
rc = nc_put_var1_float (ncid, varid, nc_index, &f_elem);
} else if (dt == NC_DOUBLE) {
d_elem = (double)SvNV(*elem); // element to put
rc = nc_put_var1_double (ncid, varid, nc_index, &d_elem);
} else if (dt == NC_CHAR) {
t_elem = (char *)SvPV(*elem, len); // element to put
elem = av_fetch((AV *)SvRV(strlen), i, 0); // elem is perl SV for the length of this string dimension
nc_count[1] = (int)SvIV(*elem); // nc_count[1] is the length of the string dimension for this variable
rc = nc_put_vara_text (ncid, varid, nc_index, nc_count, t_elem);
}
if (rc != NC_NOERR)
croak("Error writing NCID %d: %s\n", varid, nc_strerror(rc));
}
EOXS
#-------------------------------------------------------------------------
# Get a list of values from a bunch of 1D variables.
#-------------------------------------------------------------------------
pp_addxs (<<'EOXS');
int
c_getrec (ncid, varids, datatypes, strlen, idx)
int ncid
SV* varids
SV* datatypes
SV* strlen
int idx
PPCODE:
int i;
int dt;
int varid;
char c_elem;
short s_elem;
ushort us_elem;
int i_elem;
longlong ll_elem;
float f_elem;
double d_elem;
char t_elem[256]; // Hard-coded 256 char limit to string sizes!
SV **elem;
size_t nc_index[2]; // Index for use in inserting variables
size_t nc_count[2]; // For 'classic' string variables
int rc = NC_NOERR; // 0
int recsize = av_len((AV *)SvRV(varids)) + 1;
nc_index[0] = idx; // index to put
nc_index[1] = 0; // For string variables
nc_count[0] = 1; // For string variables
// loop over input variables
for (i=0; i<recsize; i++) {
elem = av_fetch((AV *)SvRV(datatypes), i, 0); // elem is perl SV for the datatype
dt = (int)SvIV(*elem); // dt is the data type of the current variable (C int)
elem = av_fetch((AV *)SvRV(varids), i, 0);
varid = (int)SvIV(*elem);
EXTEND (SP, 1);
if (dt == NC_BYTE) {
rc = nc_get_var1_schar (ncid, varid, nc_index, &c_elem);
PUSHs (sv_2mortal (newSViv ((IV)c_elem)));
} else if (dt == NC_SHORT) {
rc = nc_get_var1_short (ncid, varid, nc_index, &s_elem);
PUSHs (sv_2mortal (newSViv ((IV)s_elem)));
} else if (dt == NC_INT) {
rc = nc_get_var1_int (ncid, varid, nc_index, &i_elem);
PUSHs (sv_2mortal (newSViv ((IV)i_elem)));
#ifdef NC_NETCDF4
} else if (dt == NC_USHORT) {
rc = nc_get_var1_ushort (ncid, varid, nc_index, &us_elem);
PUSHs (sv_2mortal (newSViv ((IV)us_elem)));
} else if (dt == NC_UINT) {
rc = nc_get_var1_uint (ncid, varid, nc_index, &i_elem);
PUSHs (sv_2mortal (newSViv ((IV)i_elem)));
} else if (dt == NC_INT64) {
rc = nc_get_var1_longlong (ncid, varid, nc_index, &ll_elem);
PUSHs (sv_2mortal (newSViv ((IV)ll_elem)));
} else if (dt == NC_UINT64) {
rc = nc_get_var1_ulonglong (ncid, varid, nc_index, &ll_elem);
PUSHs (sv_2mortal (newSViv ((IV)ll_elem)));
#endif
} else if (dt == NC_FLOAT) {
rc = nc_get_var1_float (ncid, varid, nc_index, &f_elem);
PUSHs (sv_2mortal (newSVnv ((double)f_elem)));
} else if (dt == NC_DOUBLE) {
rc = nc_get_var1_double (ncid, varid, nc_index, &d_elem);
PUSHs (sv_2mortal (newSVnv (d_elem)));
} else if (dt == NC_CHAR) {
elem = av_fetch((AV *)SvRV(strlen), i, 0); // elem is perl SV for the length of this string dimension
nc_count[1] = (int)SvIV(*elem); // nc_count[1] is the length of the string dimension for this variable
rc = nc_get_vara_text (ncid, varid, nc_index, nc_count, (char *)&t_elem);
PUSHs (sv_2mortal (newSVpv(t_elem, nc_count[1])));
}
if (rc != NC_NOERR)
croak("Error writing NCID %d: %s\n", varid, nc_strerror(rc));
}
EOXS
pp_done();
|