author | A.M. Thurnherr <athurnherr@yahoo.com> |
Tue, 02 Feb 2016 14:55:24 +0000 | |
changeset 34 | e550db661c17 |
parent 33 | 866c881b3a4a |
child 35 | 54b8bb450e5f |
permissions | -rwxr-xr-x |
29 | 1 |
#!/usr/bin/perl |
2 |
#====================================================================== |
|
3 |
# L A D C P _ W S P E C |
|
4 |
# doc: Thu Jun 11 12:02:49 2015 |
|
34 | 5 |
# dlm: Mon Jan 25 09:33:54 2016 |
29 | 6 |
# (c) 2012 A.M. Thurnherr |
34 | 7 |
# uE-Info: 39 0 NIL 0 0 72 10 2 4 NIL ofnI |
29 | 8 |
#====================================================================== |
9 |
||
10 |
$antsSummary = 'calculate VKE window spectra from LADCP profiles'; |
|
11 |
||
12 |
# HISTORY: |
|
13 |
# Jun 11, 2015: - adapted from [binpgrams] |
|
14 |
# Jun 12, 2015: - renamed %PARAM prefixes |
|
15 |
# Jun 15, 2015: - BUG: de-meaning did not respect _gap variables |
|
16 |
# - added %output_depth_resolution |
|
17 |
# - reversed semantics of -d/-u |
|
18 |
# Jun 16, 2015: - reversed semantics of -t |
|
19 |
# - re-added pwrdens.0 to make output consistent with [binpgrams] |
|
32
6041a20feb39
V1.0 release candidate
A.M. Thurnherr <athurnherr@yahoo.com>
parents:
29
diff
changeset
|
20 |
# Oct 12, 2015: - require ANTSlibs V6.2 for release |
33 | 21 |
# Oct 13, 2015: - adapted to [version.pl] |
34 | 22 |
# Jan 25, 2016: - added software version %PARAM |
29 | 23 |
|
24 |
($ANTSBIN) = (`which list` =~ m{^(.*)/[^/]*$}); |
|
25 |
($ANTSLIB) = (`which ANTSlib` =~ m{^(.*)/[^/]*$}); |
|
33 | 26 |
($WCALC) = ($0 =~ m{^(.*)/[^/]*$}); |
27 |
$WCALC = '.' if ($WCALC eq ''); |
|
29 | 28 |
|
33 | 29 |
require "$WCALC/version.pl"; |
29 | 30 |
require "$ANTSLIB/ants.pl"; |
31 |
require "$ANTSLIB/antsfilters.pl"; |
|
32 |
require "$ANTSLIB/libstats.pl"; |
|
33 |
require "$ANTSLIB/fft.pl"; |
|
34 |
require "$ANTSLIB/lfit.pl"; |
|
35 |
require "$ANTSLIB/nrutil.pl"; |
|
36 |
require "$ANTSBIN/.lsfit.poly"; |
|
37 |
require "$ANTSBIN/.nminterp.linear"; |
|
34 | 38 |
&antsAddParams('LADCP_wspec',"Version $VERSION"); |
29 | 39 |
|
40 |
#---------------------------------------------------------------------- |
|
41 |
# Usage |
|
42 |
#---------------------------------------------------------------------- |
|
43 |
||
44 |
&antsUsage('bc:dg:o:s:tuw:',0, |
|
45 |
'[poly-o)rder <n[0]> to de-mean data; -1 to disable>] [suppress cosine-t)aper]', |
|
46 |
'[-d)own/-u)pcast-only] [exclude -b)ottom window]', |
|
47 |
'[shortwave -c)utoff <kz or lambda>]', |
|
48 |
'[-s)urface <layer depth to exclude[150m]>', |
|
49 |
'[-g)ap <max depth layer to fill with interpolation[40m]>]', |
|
50 |
'[-w)indow <power-of-two input-records[32]>]', |
|
51 |
'[LADCP-profile(s)]'); |
|
52 |
||
53 |
&antsIntOpt(\$opt_o,0); # polynomial order to remove |
|
54 |
if ($opt_o >= 0) { # init model |
|
55 |
&modelUsage(); |
|
56 |
matrix(\@covar,1,$modelNFit,1,$modelNFit); |
|
57 |
vector(\@afunc,1,$modelNFit); |
|
58 |
&antsAddParams('wspec::demean_poly_order',$opt_o); |
|
59 |
} |
|
60 |
||
61 |
croak("$0: cannot ignore both down- and upcast\n") |
|
62 |
unless ($opt_d+$opt_u < 2); |
|
63 |
if ($opt_d) { |
|
64 |
&antsAddParams('wspec::input_data','dc'); |
|
65 |
} elsif ($opt_u) { |
|
66 |
&antsAddParams('wspec::input_data','uc'); |
|
67 |
} else { |
|
68 |
&antsAddParams('wspec::input_data','dc/uc'); |
|
69 |
} |
|
70 |
&antsAddParams('wspec::cos_taper_applied',$opt_t ? 'no' : 'yes'); |
|
71 |
&antsAddParams('wspec::btm_window_included',$opt_b ? 'no' : 'yes'); |
|
72 |
||
73 |
if (defined($opt_c)) { # shortwave cutoff |
|
74 |
$kzlim = ($opt_c < 1) ? $opt_c : 2*$PI/$opt_c; |
|
75 |
&antsAddParams('wspec::shortwave_cutoff',$kzlim); |
|
76 |
} else { |
|
77 |
$kzlim = 9e99; |
|
78 |
} |
|
79 |
||
80 |
&antsCardOpt($opt_w); # window size |
|
81 |
||
82 |
&antsCardOpt(\$opt_g,40); # gap length [m] |
|
83 |
&antsAddParams('wspec::min_gap_thickness',$opt_g); |
|
84 |
||
85 |
&antsCardOpt(\$opt_s,150); # surface layer |
|
86 |
&antsAddParams('wspec::surface_layer',$opt_s); |
|
87 |
||
88 |
&ISUsage; # interpolation model |
|
89 |
||
90 |
#---------------------------------------------------------------------- |
|
91 |
# Read Data & Define Layout |
|
92 |
#---------------------------------------------------------------------- |
|
93 |
||
94 |
croak("LADCP_VKE: spectral-input mode must be selected manually (-f)\n") |
|
95 |
if defined(fnrNoErr('pwrdens.0')) && !defined(fnrNoErr('dc_w')); |
|
96 |
||
97 |
$zfnr = fnr('depth'); # required fields |
|
98 |
unless (defined(fnrNoErr('dc_w'))) { # |
|
99 |
} |
|
100 |
$dcwfnr = fnr('dc_w'); |
|
101 |
$ucwfnr = fnr('uc_w'); |
|
102 |
$habfnr = fnrNoErr('hab'); # optional fields |
|
103 |
||
104 |
&antsInstallBufFull(0); # read entire file |
|
105 |
&antsIn(); |
|
106 |
||
107 |
while ($ants_[0][$zfnr] < $opt_s) { # remove surface layer |
|
108 |
shift(@ants_); |
|
109 |
} |
|
110 |
||
111 |
for ($trimmed=0; !numberp($ants_[$#ants_][$dcwfnr]) && !numberp($ants_[$#ants_][$ucwfnr]); $trimmed++) { |
|
112 |
pop(@ants_); |
|
113 |
} |
|
114 |
&antsInfo("$trimmed trailing non-numeric records trimmed") |
|
115 |
if ($trimmed); |
|
116 |
||
117 |
$dz = &antsXCheck($zfnr,0,$#ants_,1.01); # calc dT; 1% jitter |
|
118 |
&antsAddParams("wspec::input_depth_resolution",$dz); |
|
119 |
||
120 |
$opt_g = int(($opt_g - 1) / $dz); # [m] -> [records] |
|
121 |
||
122 |
unless (defined($opt_w)) { # window size |
|
123 |
for ($opt_w=32; $opt_w*$dz>600; $opt_w/=2) {} |
|
124 |
&antsInfo("%d-m windows ($opt_w records)",$opt_w*$dz); |
|
125 |
} |
|
126 |
&antsAddParams('wspec::window_size',$opt_w,'wspec::output_depth_resolution',$dz*$opt_w); |
|
127 |
||
128 |
croak(sprintf("$0: insufficient data (%d records found, %d required)\n",scalar(@ants_),$opt_w)) |
|
129 |
unless (@ants_ >= $opt_w); |
|
130 |
||
131 |
$zrange = $opt_w * $dz; # NB: not equal to max-min!!! |
|
132 |
$resolution_bandwidth = 1 / $zrange; |
|
133 |
$resolution_bandwidth *= 2*$PI; |
|
134 |
&antsAddParams('wspec::resolution_bandwidth',$resolution_bandwidth); |
|
135 |
||
136 |
push(@antsNewLayout,'widx','depth','depth.min','depth.max','hab','nsamp'); |
|
137 |
for (my($i)=0; $i<$opt_w/2+1; $i++) { |
|
138 |
my($kz) = 2*$PI*$i/$zrange; |
|
139 |
last if ($kz > $kzlim); |
|
140 |
&antsAddParams(sprintf('wspec::k.%d',$i),$kz); |
|
141 |
&antsAddParams(sprintf('wspec::lambda.%d',$i),$i ? $zrange/$i : inf); |
|
142 |
push(@antsNewLayout,sprintf('pwrdens.%d',$i)); |
|
143 |
} |
|
144 |
push(@antsNewLayout,'pwr.tot'); |
|
145 |
||
146 |
&antsActivateOut(); |
|
147 |
||
148 |
#---------------------------------------------------------------------- |
|
149 |
# interpolate short gaps |
|
150 |
#---------------------------------------------------------------------- |
|
151 |
||
152 |
&ISInit($dcwfnr,$zfnr); |
|
153 |
&ISInit($ucwfnr,$zfnr); |
|
154 |
||
155 |
my($dcLastValid,$ucLastValid,$interp); |
|
156 |
for (my($r)=0; $r<=$#ants_; $r++) { |
|
157 |
if (numberp($ants_[$r][$dcwfnr])) { # number => no interp. |
|
158 |
$dcLastValid = $r; |
|
159 |
} elsif (defined($dcLastValid)) { |
|
160 |
$ants_[$r][$dcwfnr] = &interpolate($zfnr,$opt_g,$dcwfnr,$dcLastValid,$r); |
|
161 |
$interp++ if numberp($ants_[$r][$dcwfnr]); |
|
162 |
} |
|
163 |
if (numberp($ants_[$r][$ucwfnr])) { # number => no interp. |
|
164 |
$ucLastValid = $r; |
|
165 |
} elsif (defined($ucLastValid)) { |
|
166 |
$ants_[$r][$ucwfnr] = &interpolate($zfnr,$opt_g,$ucwfnr,$ucLastValid,$r); |
|
167 |
$interp++ if numberp($ants_[$r][$ucwfnr]); |
|
168 |
} |
|
169 |
} |
|
170 |
||
171 |
&antsInfo("$interp non-numeric values interpolated") |
|
172 |
if ($interp); |
|
173 |
||
174 |
#---------------------------------------------------------------------- |
|
175 |
# loop over windows |
|
176 |
#---------------------------------------------------------------------- |
|
177 |
||
178 |
sub avgF($$) # average field over window |
|
179 |
{ |
|
180 |
my($f,$r) = @_; |
|
181 |
my(@vals); |
|
182 |
||
183 |
push(@vals,$ants_[$r++][$f]) |
|
184 |
while (@vals < $opt_w); |
|
185 |
return avg(@vals); |
|
186 |
} |
|
187 |
||
188 |
unless ($opt_t) { # compile taper function only if needed |
|
189 |
sub cosTaperWeight($) |
|
190 |
{ |
|
191 |
my($z) = $_[0] - $ants_[$fromR][$zfnr]; # elapsed time |
|
192 |
return ($z<0.1*$zrange || $z>0.9*$zrange) ? |
|
193 |
0.5*(1+cos(10*$PI*$z/$zrange-$PI)) : 1; |
|
194 |
} |
|
195 |
} |
|
196 |
||
197 |
WINDOW: for (my($widx)=1; 1; $widx++) { |
|
198 |
undef(@out); |
|
199 |
$out[0] = $widx; |
|
200 |
local($fromR) = round(($widx-1)*($opt_w/2)); # local, cuz it's used in cosTaperWeight |
|
201 |
||
202 |
#---------------------- |
|
203 |
# partial bottom window |
|
204 |
#---------------------- |
|
205 |
||
206 |
if ($fromR+$opt_w-1 > $#ants_) { |
|
207 |
last if ($opt_b); |
|
208 |
$out[0] = -1; |
|
209 |
$fromR = @ants_ - $opt_w; |
|
210 |
$opt_b = 1; |
|
211 |
} |
|
212 |
||
213 |
#----------------------------------- |
|
214 |
# output nan on non-numeric y values |
|
215 |
#----------------------------------- |
|
216 |
||
217 |
my($dc_gap) = $opt_u; # exclude dc with -d, uc with -u |
|
218 |
my($uc_gap) = $opt_d; |
|
219 |
for (my($r)=$fromR; $r<$fromR+$opt_w; $r++) { |
|
220 |
$dc_gap |= !numberp($ants_[$r][$dcwfnr]); |
|
221 |
$uc_gap |= !numberp($ants_[$r][$ucwfnr]); |
|
222 |
} |
|
223 |
||
224 |
if ($dc_gap && $uc_gap) { |
|
225 |
push(@out,$ants_[$fromR+$opt_w/2][$zfnr]); |
|
226 |
if ($ants_[0][$zfnr] > $ants_[1][$zfnr]) { |
|
227 |
push(@out,$ants_[$fromR+$opt_w-1][$zfnr]); |
|
228 |
push(@out,$ants_[$fromR][$zfnr]); |
|
229 |
} else { |
|
230 |
push(@out,$ants_[$fromR][$zfnr]); |
|
231 |
push(@out,$ants_[$fromR+$opt_w-1][$zfnr]); |
|
232 |
} |
|
233 |
push(@out,defined($habfnr) ? |
|
234 |
avgF($habfnr,$fromR) : nan); |
|
235 |
push(@out,nan); |
|
236 |
for ($i=0; $i<=$opt_w/2; $i++) { |
|
237 |
push(@out,nan); |
|
238 |
} |
|
239 |
&antsOut(@out); # output nan record and go to next window |
|
240 |
next WINDOW; |
|
241 |
} |
|
242 |
||
243 |
#-------------------- |
|
244 |
# save current values |
|
245 |
#-------------------- |
|
246 |
||
247 |
for (my($i)=0; $i<$opt_w; $i++) { |
|
248 |
$dcwbuf[$i] = $ants_[$fromR+$i][$dcwfnr]; |
|
249 |
$ucwbuf[$i] = $ants_[$fromR+$i][$ucwfnr]; |
|
250 |
} |
|
251 |
||
252 |
#------------------------ |
|
253 |
# polynomial de-"mean"ing |
|
254 |
#------------------------ |
|
255 |
||
256 |
if ($opt_o >= 0) { |
|
257 |
my($calc); |
|
258 |
unless ($dc_gap) { |
|
259 |
&modelInit(); # dc |
|
260 |
for (my($a)=1; $a<=$modelNFit; $a++) { $iA[$a] = 1; } |
|
261 |
&lfit($zfnr,$dcwfnr,-1,\@A,\@iA,\@covar,\&modelEvaluate,$fromR,$fromR+$opt_w-1); |
|
262 |
&modelCleanup(); |
|
263 |
for (my($i)=0; $i<$opt_w; $i++) { |
|
264 |
modelEvaluate($i,$zfnr,\@afunc); |
|
265 |
for ($calc=0,my($p)=1; $p<=$modelNFit; $p++) { |
|
266 |
$calc += $A[$p] * $afunc[$p]; |
|
267 |
} |
|
268 |
$ants_[$fromR+$i][$dcwfnr] -= $calc; |
|
269 |
} |
|
270 |
} |
|
271 |
unless ($uc_gap) { |
|
272 |
&modelInit(); # uc |
|
273 |
for (my($a)=1; $a<=$modelNFit; $a++) { $iA[$a] = 1; } |
|
274 |
&lfit($zfnr,$ucwfnr,-1,\@A,\@iA,\@covar,\&modelEvaluate,$fromR,$fromR+$opt_w-1); |
|
275 |
&modelCleanup(); |
|
276 |
for (my($i)=0; $i<$opt_w; $i++) { |
|
277 |
modelEvaluate($i,$zfnr,\@afunc); |
|
278 |
for ($calc=0,my($p)=1; $p<=$modelNFit; $p++) { |
|
279 |
$calc += $A[$p] * $afunc[$p]; |
|
280 |
} |
|
281 |
$ants_[$fromR+$i][$ucwfnr] -= $calc; |
|
282 |
} |
|
283 |
} |
|
284 |
} |
|
285 |
||
286 |
#----------- |
|
287 |
# taper data |
|
288 |
#----------- |
|
289 |
||
290 |
unless ($opt_t) { |
|
291 |
for (my($i)=0; $i<$opt_w; $i++) { |
|
292 |
$ants_[$fromR+$i][$dcwfnr] *= &cosTaperWeight($ants_[$fromR+$i][$zfnr]); |
|
293 |
$ants_[$fromR+$i][$ucwfnr] *= &cosTaperWeight($ants_[$fromR+$i][$zfnr]); |
|
294 |
} |
|
295 |
$taper_correction = 1/0.875; |
|
296 |
} else { |
|
297 |
$taper_correction = 1; |
|
298 |
} |
|
299 |
||
300 |
#------------- |
|
301 |
# PSD Estimate |
|
302 |
#------------- |
|
303 |
||
304 |
# for (my($r)=0; $r<$opt_w; $r++) { |
|
305 |
# print(STDERR "$ants_[$fromR+$r][$dcwfnr], $ants_[$fromR+$r][$ucwfnr]\n"); |
|
306 |
# } |
|
307 |
||
308 |
@dc_coeff = &cFFT($dcwfnr,nan,$opt_w,$fromR) # FFT |
|
309 |
unless ($dc_gap); |
|
310 |
@uc_coeff = &cFFT($ucwfnr,nan,$opt_w,$fromR) |
|
311 |
unless ($uc_gap); |
|
312 |
croak("$0: -n $opt_w not a power-of-two\n") |
|
313 |
unless (@dc_coeff/2==$opt_w || @uc_coeff/2==$opt_w); |
|
314 |
||
315 |
@dc_pwr = &pgram_onesided($opt_w,@dc_coeff) # total power |
|
316 |
unless ($dc_gap); |
|
317 |
@uc_pwr = &pgram_onesided($opt_w,@uc_coeff) |
|
318 |
unless ($uc_gap); |
|
319 |
||
320 |
push(@out,$ants_[$fromR+$opt_w/2][$zfnr]); # middle z |
|
321 |
if ($ants_[0][$zfnr] > $ants_[1][$zfnr]) { # input descending |
|
322 |
push(@out,$ants_[$fromR+$opt_w-1][$zfnr]); # z.min |
|
323 |
push(@out,$ants_[$fromR][$zfnr]); # z.max |
|
324 |
} else { # input ascending |
|
325 |
push(@out,$ants_[$fromR][$zfnr]); # z.min |
|
326 |
push(@out,$ants_[$fromR+$opt_w-1][$zfnr]); # z.max |
|
327 |
} |
|
328 |
push(@out,defined($habfnr) ? # hab |
|
329 |
avgF($habfnr,$fromR) : nan); |
|
330 |
my($nsamp) = !$dc_gap + !$uc_gap; # nsamp |
|
331 |
push(@out,$nsamp); |
|
332 |
||
333 |
my($totP) = 0; # power |
|
334 |
my($i); |
|
335 |
for ($i=0; $i<$opt_w/2+1; $i++) { |
|
336 |
my($sumP) = 0; |
|
337 |
$sumP += $dc_pwr[$i] * $taper_correction unless ($dc_gap); |
|
338 |
$sumP += $uc_pwr[$i] * $taper_correction unless ($uc_gap); |
|
339 |
push(@out,$sumP/$nsamp/$resolution_bandwidth) |
|
340 |
unless (antsParam("k.$i") > $kzlim); |
|
341 |
$totP += $sumP; |
|
342 |
} |
|
343 |
push(@out,$totP); # total power |
|
344 |
||
345 |
&antsOut(@out); |
|
346 |
||
347 |
#-------------------------------- |
|
348 |
# undo tapering and/or de-meaning |
|
349 |
#-------------------------------- |
|
350 |
||
351 |
for ($i=0; $i<$opt_w; $i++) { |
|
352 |
$ants_[$fromR+$i][$dcwfnr] = $dcwbuf[$i]; |
|
353 |
$ants_[$fromR+$i][$ucwfnr] = $ucwbuf[$i]; |
|
354 |
} |
|
355 |
} |
|
356 |
||
357 |
&antsInfo("$skipped windows with non-numeric values skipped") |
|
358 |
if ($skipped); |
|
359 |
||
360 |
antsExit(); |