|
1 #====================================================================== |
|
2 # A N T S N C . P L |
|
3 # doc: Mon Jul 17 11:59:37 2006 |
|
4 # dlm: Fri Jan 15 10:17:51 2016 |
|
5 # (c) 2006 A.M. Thurnherr |
|
6 # uE-Info: 25 56 NIL 0 0 72 2 2 4 NIL ofnI |
|
7 #====================================================================== |
|
8 |
|
9 # ANTS netcdf library |
|
10 |
|
11 # HISTORY: |
|
12 # Jul 17, 2006: - created |
|
13 # Jul 21, 2006: - documented |
|
14 # - added NC-encoding routines |
|
15 # Jul 22: 2006: - BUG: pseudo %PARAMs were written as well |
|
16 # - BUG: var ATTRs were not enconded correctly |
|
17 # - added type support |
|
18 # Jul 23, 2006: - improved type magic |
|
19 # Sep 1, 2006: - BUG: removing trainling 0s had not worked |
|
20 # Sep 23, 2006: - fiddled |
|
21 # Jul 11, 2008: - adapted to new pseudo %PARAMs |
|
22 # Jul 16, 2008: - remove \0s from strings in NC_stringify |
|
23 # Mar 20, 2008: - added progress output to NC_stringify |
|
24 # Jul 21, 2009: - allowed for suppression of %PARAMs |
|
25 # Jan 15, 2016: - BUG: %DEPS pseudo-%PARAM was encoded |
|
26 |
|
27 # NOTES: |
|
28 # - multi-valued attribs are not loaded by getInfo() |
|
29 # - spaces in NC strings are replaced by underscores |
|
30 # - data filling is disabled, because of a bug in the NetCDF library |
|
31 |
|
32 # NetCDF Library Bug: |
|
33 # The library appears to have incorrect default _FillValue types for |
|
34 # integer data types. The error appears if the "setfill" line is commented |
|
35 # out and the following command is run: |
|
36 # listNC -ct dbk100.nc | NCode -o TEMP.nc time |
|
37 # NB: The error occurs when the 1st variable value is written, NOT when |
|
38 # the first Q_time value is written. However, when all the Q_ fields |
|
39 # are ommitted, the error disappears. |
|
40 |
|
41 use NetCDF; |
|
42 |
|
43 #---------------------------------- |
|
44 # string representation of NC types |
|
45 #---------------------------------- |
|
46 |
|
47 sub NC_typeName($) |
|
48 { |
|
49 my($tp) = @_; |
|
50 |
|
51 return 'byte' if ($tp == NetCDF::BYTE); |
|
52 return 'char' if ($tp == NetCDF::CHAR); |
|
53 return 'short' if ($tp == NetCDF::SHORT); |
|
54 return 'long' if ($tp == NetCDF::LONG); |
|
55 return 'float' if ($tp == NetCDF::FLOAT); |
|
56 return 'double' if ($tp == NetCDF::DOUBLE); |
|
57 croak("$0: unknown NetCDF type #$tp\n"); |
|
58 } |
|
59 |
|
60 sub NC_type($) |
|
61 { |
|
62 my($tn) = lc($_[0]); |
|
63 |
|
64 return NetCDF::BYTE if ($tn eq 'byte'); |
|
65 return NetCDF::CHAR if ($tn eq 'char'); |
|
66 return NetCDF::SHORT if ($tn eq 'short'); |
|
67 return NetCDF::LONG if ($tn eq 'long'); |
|
68 return NetCDF::FLOAT if ($tn eq 'float'); |
|
69 return NetCDF::DOUBLE if ($tn eq 'double'); |
|
70 croak("$0: unknown NetCDF type <$tn>\n"); |
|
71 } |
|
72 |
|
73 #-------------------------------------- |
|
74 # test whether given NC type is numeric |
|
75 #-------------------------------------- |
|
76 |
|
77 sub NC_isNumeric($) |
|
78 { |
|
79 my($tp) = @_; |
|
80 |
|
81 return 1 if ($tp == NetCDF::BYTE); |
|
82 return 1 if ($tp == NetCDF::SHORT); |
|
83 return 1 if ($tp == NetCDF::LONG); |
|
84 return 1 if ($tp == NetCDF::FLOAT); |
|
85 return 1 if ($tp == NetCDF::DOUBLE); |
|
86 return 0; |
|
87 } |
|
88 |
|
89 #---------------------------------------- |
|
90 # test whether given NC type is character |
|
91 #---------------------------------------- |
|
92 |
|
93 sub NC_isChar($) |
|
94 { |
|
95 return $_[0] == NetCDF::CHAR; |
|
96 } |
|
97 |
|
98 #----------------------------------- |
|
99 # convert character- to string array |
|
100 #----------------------------------- |
|
101 |
|
102 sub NC_stringify($@) |
|
103 { |
|
104 my($len,@chars) = @_; |
|
105 my(@strings); |
|
106 my($nStrings) = @chars/$len; |
|
107 |
|
108 print(STDERR "$0: extracting $nStrings strings") |
|
109 if ($nStrings > 1000); |
|
110 |
|
111 while (@chars) { |
|
112 print(STDERR ".") if ($nStrings>1000 && $n++%1000 == 0); |
|
113 push(@strings,pack("c$len",@chars)); |
|
114 $strings[$#strings] =~ s/ /_/g; |
|
115 $strings[$#strings] =~ s/\0//g; |
|
116 splice(@chars,0,$len); |
|
117 } |
|
118 print(STDERR "\n") if ($nStrings > 1000); |
|
119 return @strings; |
|
120 } |
|
121 |
|
122 #---------------------------------------------------------------------- |
|
123 # open netcdf file and read (most) metadata into hash |
|
124 # |
|
125 # INPUT: |
|
126 # <filename> |
|
127 # |
|
128 # OUTPUT: |
|
129 # $NC{id} netcdf id |
|
130 # |
|
131 # @NC{attrName}[] names of global attrs |
|
132 # %NC{AttrType}{$aName} types of global attrs |
|
133 # %NC{AttrLen}{$aName} # of elts in global attrs |
|
134 # %NC{Attr}{$aName} vals of scalar global attrs |
|
135 # |
|
136 # $NC{unlim_dimId} dim id of unlimited dim |
|
137 # @NC{dimName}[$dimId] dim names |
|
138 # %NC{dimID}{$dName} dim ids |
|
139 # %NC{dimLen}{$dName} # elts in dim |
|
140 # |
|
141 # @NC{varName}[$varId] var names |
|
142 # %NC{varType}{$vName} var types |
|
143 # %NC{varId}{$vName} var ids |
|
144 # @%NC{varDimIDs}{$vName}[] dims of vars, e.g. u(lon,lat) |
|
145 # @%NC{varAttrName}{$vName}[] names of var attrs |
|
146 # %%NC{varAttrType}{$vName}{$aName} types of var attrs |
|
147 # %%NC{varAttrLen}{$vName}{$aName} # of elts in var attrs |
|
148 # %%NC{varAttr}{$vName}{$aName} vals of scalar var attrs |
|
149 # |
|
150 #---------------------------------------------------------------------- |
|
151 |
|
152 sub NC_readMData($) |
|
153 { |
|
154 my($fn) = @_; |
|
155 my(%NC); |
|
156 |
|
157 $NC{id} = NetCDF::open($ARGV[0],NetCDF::NOWRITE); # open |
|
158 |
|
159 my($nd,$nv,$nga,$udi); # get nelts |
|
160 NetCDF::inquire($NC{id},$nd,$nv,$nga,$udi); |
|
161 $NC{unlim_dimId} = $udi; |
|
162 |
|
163 for (my($d)=0; $d<$nd; $d++) { # dimensions |
|
164 my($dnm,$ln); |
|
165 NetCDF::diminq($NC{id},$d,$dnm,$ln); |
|
166 $NC{dimName}[$d] = $dnm; |
|
167 $NC{dimId}{$dnm} = $d; |
|
168 $NC{dimLen}{$dnm} = $ln; |
|
169 } |
|
170 |
|
171 for (my($v)=0; $v<$nv; $v++) { # vars & var-attribs |
|
172 my($vnm,$vtp,$nvd,$nva); |
|
173 my(@dids) = (); |
|
174 NetCDF::varinq($NC{id},$v,$vnm,$vtp,$nvd,\@dids,$nva); |
|
175 $NC{varName}[$v] = $vnm; |
|
176 $NC{varId}{$vnm} = $v; |
|
177 $NC{varType}{$vnm} = $vtp; |
|
178 @{$NC{varDimIds}{$vnm}} = @dids[0..$nvd-1]; |
|
179 |
|
180 for (my($a)=0; $a<$nva; $a++) { # var-attribs |
|
181 my($anm,$atp,$aln); |
|
182 NetCDF::attname($NC{id},$v,$a,$anm); |
|
183 $NC{varAttrName}{$vnm}[$a] = $anm; |
|
184 NetCDF::attinq($NC{id},$v,$anm,$atp,$aln); |
|
185 $NC{varAttrType}{$vnm}{$anm} = $atp; |
|
186 $NC{varAttrLen}{$vnm}{$anm} = $aln; |
|
187 if ($atp == NetCDF::BYTE || $atp == NetCDF::CHAR || $aln == 1) { |
|
188 my($val) = ""; |
|
189 NetCDF::attget($NC{id},$v,$anm,\$val); |
|
190 $val =~ s{\0+$}{} if ($atp == NetCDF::CHAR); # trailing \0 |
|
191 $NC{varAttr}{$vnm}{$anm} = $val; |
|
192 } |
|
193 } |
|
194 } |
|
195 |
|
196 for (my($a)=0; $a<$nga; $a++) { # global attribs |
|
197 my($anm,$atp,$aln); |
|
198 NetCDF::attname($NC{id},NetCDF::GLOBAL,$a,$anm); |
|
199 $NC{attrName}[$a] = $anm; |
|
200 NetCDF::attinq($NC{id},NetCDF::GLOBAL,$anm,$atp,$aln); |
|
201 $NC{attrType}{$anm} = $atp; |
|
202 $NC{attrLen}{$anm} = $aln; |
|
203 if ($atp == NetCDF::BYTE || $atp == NetCDF::CHAR || $aln == 1) { |
|
204 my($val) = ""; |
|
205 NetCDF::attget($NC{id},NetCDF::GLOBAL,$anm,\$val); |
|
206 $val =~ s{\0+$}{} if ($atp == NetCDF::CHAR); |
|
207 $NC{attr}{$anm} = $val; |
|
208 } |
|
209 } |
|
210 |
|
211 return %NC; |
|
212 } |
|
213 |
|
214 #---------------------------------------------------------------------- |
|
215 # create new nc file and write metadata |
|
216 # |
|
217 # INPUT: |
|
218 # <filename> |
|
219 # <abscissa> name of unlimited dimension |
|
220 # <suppress-params> if true, don't write %PARAMs |
|
221 # |
|
222 # OUTPUT: |
|
223 # <netcdf id> |
|
224 # |
|
225 # NOTES: |
|
226 # - netcdf types can be set with %<var>:NC_type to |
|
227 # byte, long, short, double |
|
228 # - string types are as in old PASCAL convention (e.g. string80) |
|
229 # - default type is NetCDF::DOUBLE |
|
230 # - %<var>:NC_type are not added to ATTRIBs |
|
231 #---------------------------------------------------------------------- |
|
232 |
|
233 sub NC_writeMData($$$) |
|
234 { |
|
235 my($fn,$abscissa,$suppress_params) = @_; |
|
236 my(%attrDone,@slDim,@NCtype); |
|
237 |
|
238 my($ncId) = NetCDF::create($fn,NetCDF::CLOBBER); |
|
239 NetCDF::setfill($ncId,NetCDF::NOFILL); # NetCDF library bug |
|
240 |
|
241 # DIMENSIONS |
|
242 my($aid) = NetCDF::dimdef($ncId,$abscissa,NetCDF::UNLIMITED); |
|
243 |
|
244 for (my($f)=0; $f<=$#antsLayout; $f++) { # types |
|
245 my($tpa) = $antsLayout[$f] . ':NC_type'; |
|
246 my($sl) = ($P{$tpa} =~ m{^string(\d+)$}); |
|
247 if ($sl > 0) { # string |
|
248 $slDim[$f] = NetCDF::dimdef($ncId,"$antsLayout[$f]:strlen",$sl); |
|
249 $NCtype[$f] = NetCDF::CHAR; |
|
250 } elsif (defined($P{$tpa})) { # custom |
|
251 $NCtype[$f] = NC_type($P{$tpa}); |
|
252 } else { # default |
|
253 $NCtype[$f] = NetCDF::DOUBLE; |
|
254 } |
|
255 # printf(STDERR "type %s set to %s\n",$antsLayout[$f],NC_typeName($NCtype[$f])); |
|
256 undef($P{$tpa}); # do not add to ATTRIBs |
|
257 } |
|
258 |
|
259 for (my($f)=0; $f<=$#antsLayout; $f++) { # VARIABLES |
|
260 my($vid); |
|
261 if (defined($slDim[$f])) { |
|
262 $vid = NetCDF::vardef($ncId,$antsLayout[$f],$NCtype[$f],[$aid,$slDim[$f]]); |
|
263 } else { |
|
264 $vid = NetCDF::vardef($ncId,$antsLayout[$f],$NCtype[$f],[$aid]); |
|
265 } |
|
266 croak("$0: varid != fnr (implementation restriction)") |
|
267 unless ($vid == $f); |
|
268 foreach my $anm (keys(%P)) { # variable attributes |
|
269 next unless defined($P{$anm}); |
|
270 my($var,$attr) = ($anm =~ m{([^:]+):(.*)}); |
|
271 next unless ($var eq $antsLayout[$f]); |
|
272 $attrDone{$anm} = 1; # mark |
|
273 if (numberp($P{$anm}) || lc($P{$anm}) eq nan) { |
|
274 NetCDF::attput($ncId,$f,$attr,NetCDF::DOUBLE,$P{$anm}); |
|
275 } else { |
|
276 NetCDF::attput($ncId,$f,$attr,NetCDF::CHAR,$P{$anm}); |
|
277 } |
|
278 } |
|
279 } |
|
280 |
|
281 unless ($suppress_params) { |
|
282 foreach my $anm (keys(%P)) { # GLOBAL ATTRIBUTES |
|
283 next unless defined($P{$anm}); |
|
284 next if ($anm eq 'FILENAME' || $anm eq 'DIRNAME' || # skip pseudo |
|
285 $anm eq 'BASENAME' || $anm eq 'EXTN' || |
|
286 $anm eq 'PATHNAME' || $anm eq 'DEPS' || |
|
287 $anm eq 'RECNO' || $anm eq 'LINENO'); |
|
288 next if $attrDone{$anm}; |
|
289 if (numberp($P{$anm}) || lc($P{$anm}) eq nan) { |
|
290 NetCDF::attput($ncId,NetCDF::GLOBAL,$anm,NetCDF::DOUBLE,$P{$anm}); |
|
291 } else { |
|
292 NetCDF::attput($ncId,NetCDF::GLOBAL,$anm,NetCDF::CHAR,$P{$anm}); |
|
293 } |
|
294 } |
|
295 } |
|
296 |
|
297 NetCDF::endef($ncId); |
|
298 |
|
299 return $ncId; |
|
300 } |
|
301 |
|
302 1; |