-
Notifications
You must be signed in to change notification settings - Fork 0
/
netcdf.pd
2580 lines (1983 loc) · 86.2 KB
/
netcdf.pd
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
# -*- Perl -*-
use Config;
# Read in options determined by Makefile.PL and written to the OPTIONS! file
my $ncversion = do 'OPTIONS!';
pp_addpm({At => Top}, <<'EOD');
package PDL::NetCDF; # to fool CPAN indexer
=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}); # 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});
# 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 varibles 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.
Example:
my $nc = PDL::NetCDF->new ("file1.nc", {REVERSE_DIMS => 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}
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} 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)
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
Syncronize 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 argments
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 only option currently
is 'NOCOMPRESS' which tells PDL::NetCDF to *not* try to uncompress
an compressed variable. See the COMPRESS option on 'put' and 'putslice'
for more info.
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});
# 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 contining 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 varibale '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
=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 (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
#-------------------------------------------------------------------------