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