← Index
Performance Profile   « block view • line view • sub view »
For /wise/base/deliv/dev/bin/getfix
  Run on Thu May 20 15:30:03 2010
Reported on Thu May 20 16:25:29 2010

File/wise/base/deliv/dev/bin/getfix
Statements Executed10400778
Total Time43.4773460031836 seconds

Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
124701120.03423146.71735main::overlap
2212.9e-52.9e-5main::norm_times
00000main::__ANON__[:272]
00000main::tscale

LineStmts.Exclusive
Time
Avg.Code
1#! /usr/bin/env perl
2
330.001460.00049use strict;
# spent 11µs making 1 call to strict::import
430.002040.00068use warnings;
# spent 31µs making 1 call to warnings::import
5
660.001320.00022use 5.010;
# spent 39µs making 1 call to feature::import
7
819.0e-69.0e-6my %typex = (real => 'r', integer => 'i', text => 'c');
918.0e-68.0e-6my %scancols = (scans_qa_score => integer =>
10 scans_qa_reviewer => text =>
11 scans_qa_status => text =>
12 scans_qa_notes => text =>
13 scans_qa_factors => text =>
14 scans_pipe_status => integer =>
15 scans_pipe_dir => text =>
16 );
1713.8e-53.8e-5my %auxtypes = (ra => 'real', dec => 'real', pa => 'real', datime => 'text',
18 elon => 'real', elat => 'real', glon => 'real', glat => 'real',
19 pstat => 'integer', mchs=>'text', bands => 'integer',
20 stat1 => 'real', stat2 => 'real', stat3 => 'real',
21 pipedatime => 'integer',
22 start_utcs => 'text', end_utcs => 'text',
23 start_datime => 'text', end_datime => 'text',
24 start_frame => 'integer', end_frame => 'integer',
25 start_elat => 'real', end_elat => 'real',
26 start_elon => 'real', end_elon => 'real',
27 n_frames => 'integer', scan_dur => 'real',
28 med_elon => 'real', scan_dir => 'text',
29 moon_sep => 'real', moon_pa => 'real',
30 id => 'text',
31 %scancols,
32 );
33
3411.7e-51.7e-5my @skipscans = qw( 00738a 00788a 00789a 00790a 00791a 00792a 00793a
35 00794a 00795a 00796a 00797a 00798a 00799a 00800a
36 00801a 00802a 00803a 00816a 00830b 00831a 00831b
37 00831c 00831d 00831e 00831f 00831g 00831h 00831i
38 00842a 00844a 00860b 00860c 00860d 00860e 00860f
39 00860g 00860h 00860i 00860j 00860k 00860l 00860x
40 00861a 00861b 00861c 00861d 00861e 00861f 00861g
41 00861h 00861i 00861j 00861k
42 );
4317.7e-57.7e-5my %skipscans = map { ($_=>1) } @skipscans;
44
45use WISE::Env
46 (cfglib => '/wise/base/deliv/dev/lib/perl' ,
# spent 433ms making 1 call to WISE::Env::import
47 iam => 'GetFix',
48 use_wise => 1,
49 banner => 0,
50 version => '$Id: getfix 7902 2010-05-19 18:51:25Z tim $ ',
51 import => [qw/$iam $version $err $warn $pars %pvals/],
52 params =>
53 [
54 " # Command => \$iam",
55 " # Query the Frame Index database.",
56 " # Writes out an IPAC table of entries matching specified criteria.",
57 " # Query types:",
58 " # . Radial or frame footprint position search based on",
59 " # . command line positions",
60 " # . positions from a table file",
61 " # . overlap with square region footprint",
62 " # . time range",
63 " # . scan ID and/or frame number matching",
64 " # . pipeline run status",
65 " # ",
66 " # Examples: ",
67 " # Match frames where an RA,Dec is within 1' of frame edge:",
68 " # getfix -pos 15,-20",
69 " # or",
70 " # getfix -pos 01h00m00s,-20d00m00s",
71 " # Match any of three positions inside 1' of frame edge:",
72 " # getfix -pos 15,-20,323,-75,12h33m14s,-63d38m19s -r -60",
73 " # Match an ecliptic position with a large radius (arc-secs):",
74 " # getfix -pos 15,-20 -cs ecl -r 20000",
75 " # Match to within 5' of frame edges:",
76 " # getfix -pos 15,-20 -cs ecl -r +300",
77 " # Match inside 5' from frame edge:",
78 " # getfix -pos 15,-20 -cs ecl -r -300",
79 " # Match of any position in the ra,dec columns of a table ".
80 "within 5' of frame edges:",
81 " # getfix -mchtbl matchthese.tbl -r +300",
82 " # Match frame time within +/- 4.4 seconds of a date:",
83 " # getfix -frt 10-03-13T11:33:12",
84 " # Match frame time within 1000 seconds forward from a date:",
85 " # getfix -frt 10-03-13T11:33:12,+1000",
86 " # Same but backwards 1000 secs:",
87 " # getfix -frt 100313T113312,-1000",
88 " # Same but backwards 10 days, using yyddd date formt:",
89 " # getfix -frt 10072,-10d",
90 " # Match between 10 days ago and 5 days ago:",
91 " # getfix -frt now-10d,now-5d",
92 " # Match scans start with 51 or 52 and ending in 5a:",
93 " # getfix -f scanre='^5[12].*5a'",
94 " # Match based on pipeline success:",
95 " # getfix -f pstat=0",
96 " # Match based on pipeline failure:",
97 " # getfix -f pstat=1",
98 " # Match a set of scans and frames:",
99 " # getfix -f scan=01451a,01451b,01452a,frame=21,34,35,36,40",
100 " # Match a set of scans and range of frames:",
101 " # getfix -f scan=01451a,01451b,01452a,frame=21..40",
102 " # Match a set of frame IDs:",
103 " # getfix -f fid=01451a001,01451b013,01452a040",
104 " # Write results to a named table instead of stdout:",
105 " # getfix -outf my-cool-fix-subset.tbl",
106 " # Combine a bunch of the above:",
107 " # getfix -outf xxx.tbl -frt now-10d,now-5d,pstat=0,frame=21..40 ".
108 "-pos 0,-90 -cs ecl -r +300",
109 " # Request only bandframes matching band 2:",
110 " # getfix -band 2 ...",
111 " # Request that the whole frameset be matched:",
112 " # getfix -band 0 ...",
113 " # (Not specifying the band says return any one frame to represent ".
114 "the frameset.)",
115 " # Match calibrator table and keep the successfully processed frames ".
116 "whose from scans matching a pattern whose centers match best",
117 " # getfix -v -mchtbl %ref_dir%/photom/%ref_base%-pcalref.tbl ".
118 "-f pstat=0,scanre='014[12]' -nearest",
119 " # Find successful frames from scan 01301b that intersect a 1.5deg ".
120 "region at elon,elat=0,30:",
121 " # getfix -v -width 5400 -pos 0,30 -cs ecl -f scan=01301b,pstat=0 ".
122 "-r -60",
123 " # ",
124
125 "\$include_defs basic({ignore=>'band'})",
126
127 " # ",
128 "out_file,outf,of,o: file = \$unnamed -",
129 " # Output file; '-' means stdout, '0' suppresses",
130 "positions,pos,radec: list of str",
131 " # List if (RA,Dec) positions to match",
132 "match_tbl,mchtbl,mtbl: file",
133 " # Table supplying positions to match against",
134 "match_radius,mchrad,radius,rad,r: char = +60",
135 " # Match radius (arc-seconds) to match from frame center",
136 " # Leading +/- or '0' means distance from frame edge,".
137 " # otherwise it's a radius from frame center.",
138 "region_width,regwidth,regw,width: real",
139 " # If non-zero, -pos marks a (single) region center ".
140 "for which this is the width in arc-secs",
141 "region_pa,regpa,pa: real",
142 " # Region position angle, defaults to 0",
143 "frame_time,frtime,frt: list of 1 to 2 str",
144 " # Frame time, or range of times, to match",
145 " # Formats: 'datetime,datetime', 'datetime,+/-delta'",
146 " # 'datetime' can be many ymdhms formats, and 'now+/-delta'.",
147 " # Delta is seconds unless there's a trailing unit.",
148 " # Units: 'y' (365.25 days), 'w' (week), 'd' (day), 'h' (hour), ".
149 "'m' (minute).",
150 "run_time,runtime,runt: list of 2 str",
151 " # Frame pipeline run time, or range of times, to match",
152 " # Formats: 'datetime,datetime', 'datetime,+/-delta'",
153 " # 'datetime' can be many ymdhms formats, and 'now+/-delta'.",
154 " # Delta is seconds unless there's a trailing unit.",
155 " # Units: 'y' (365.25 days), 'w' (week), 'd' (day), 'h' (hour), ".
156 "'m' (minute).",
157 "search_fields,search,srch,flds,fld,f: map ".
158 "(scan,scanre,scanlike,frame,fid,score,anneal,saa,pstat,moon)",
159 " # FIX fields to match; supply values for those you wish to restrict",
160 " # scan: Exact scanID or comma separated scanIDs",
161 " # scanlike: ScanID pattern (regex) or comma separated scanID regexs",
162 " # scanre: ScanID pattern (regex) or comma separated scanID regexs ".
163 "(not a query item)",
164 " # frame: Frame number or comma separated frames, or range (x..y)",
165 " # fid: FrameID (scanID+frame number) or comma-separated list of fids",
166 " # pstat: Pipeline run status: ".
167 "0 or 'ok', 1 or 'err', -1 or 'run', -2 or 'notrun'",
168 " # score: qa_score lower threshold",
169 " # anneal: anneal_dt (seconds), time since last anneal",
170 " # saa: Degrees outside (>0) or inside (<0) SAA boundary",
171 " # moon: Delta in degrees from moon to boresite (not a query item)",
172 "tbl_pos_cols,tblposcols,tblpos,tpos,tp: list of 2 str = ra,dec",
173 " # Lon,lat columns from the match table to use for matching",
174 "coord_sys,coordsys,coord,cs: name (equ,ecl,gal) = equ",
175 " # Coordinate system of input positions",
176 "nearest,near: switch",
177 " # Only take the frames which best match an input position",
178 "band,bnd,b: int (0..4)",
179 " # Band to match; 0 means all, absence means any ONE",
180 "sort_cols,sort: list of str = scan,frame,band",
181 " # Columns on which to sort o/p table rows",
182 "scans,scan: switch",
183 " # Just return scan summary info",
184 "no_hdr,nohdr,noh: switch",
185 " # Write a header-less table",
186 "no_keys,nokeys,nok: switch",
187 " # Don't write out table key=value header; i.e. just write the table",
188 "fix_pos_cols,fixposcols,fixpos,fpos,fp: list of 3 str = ".
189 "ra_raw,dec_raw,pa_raw",
190 " # Lon,lat columns from the FIX to use for matching",
191 " # Should be 'ra_raw,dec_raw,pa_raw', or 'ra_ref,dec_ref,pa_ref'.",
192 " # If you use the latter, you should probably restrict '-f pstat=0'.",
193 "fix_cols,fixcols,cols: names = \@std",
194 " # FIX columns to include in table output",
195 " # Plain ra,dec,pa without a '_raw' or '_ref' suffix means to use",
196 " # '_ref' if available, otherwise use '_raw', on a row-by-row basis.",
197 " # 'datime' is the 'utcs' column converted to a date/time.",
198 " # g/elon/lat are derived from ra,dec.",
199 " # pstat is an alias for pipe_status",
200 " # mchs is a list of matching source position indicies",
201 "meta_aps,aps: list of string",
202 " # Meta-files to read from each frame directory to supplement FIX columns",
203 " # Slows things down quite a bit when results from preliminary ".
204 "query are large.",
205 "meta_vals,metavalls: list of string",
206 " # Values from meta-table values to add to output",
207 "meta_keys,metakeys: list of string",
208 " # Values from meta-table header key values to add to output",
209 "col_macros: map private quiet = ".
210 "\@all=scan,frame,id,ra,dec,pa,elon,elat,glon,glat,band,pstat,".
211 "datime,pipedatime,stat1,stat2,stat3,delivery,utcs,pipe_dir,".
212 "ra_ref,dec_ref,pa_ref,ra_raw,dec_raw,pa_raw,bands,mchs,".
213 "start_utcs,end_utcs,start_frame,end_frame,scan_start,scan_end,".
214 "start_datime,end_datime,delivery_utcs,l0_file,".
215 "start_elon,end_elon,med_elon,start_elat,end_elat,scan_dir,".
216 "qa_score,qa_factors,qa_notes,qa_reviewer,qa_status,".
217 "scans_qa_score,scans_qa_reviewer,scans_qa_status,scans_qa_score,".
218 "scans_qa_notes,scans_qa_factors,scans_pipe_status,scans_pipe_dir,".
219 "anneal_time,anneal_dt,saa_status,scan_rate,sciobs_status,".
220 "archive_status,archive_dir,archive_run_time,orbit_number,".
221 "moon_sep,moon_pa,".
222 "\@std=\@top,\@opt,\@cs,\@bot,".
223 "\@small=\@top,\@opt,pstat,qa_score,datime,".
224 "\@big=\@top,\@opt,\@cs,\@l0,\@bot,".
225 "\@raw=ra_raw,dec_raw,pa_raw,".
226 "\@ref=ra_ref,dec_ref,pa_ref,".
227 "\@opt=ra,dec,pa,".
228 "\@top=scan,frame,bands,".
229 "\@cs=elon,elat,glon,glat,".
230 "\@bot=pstat,qa_score,datime,anneal_dt,pipe_dir,pipedatime,".
231 "\@l0=delivery,stat1,stat2,stat3,".
232 "\@scans=scan,start_frame,end_frame,n_frames,".
233 "start_datime,end_datime,scan_dur,".
234 "start_elon,end_elon,med_elon,start_elat,end_elat,scan_dir,".
235 "\@fastscans=scan,n_frames,start_frame,end_frame,".
236 "start_datime,end_datime,scan_dur,scan_dir,".
237 "",
238 'mos_dir, mosdir, mosd: str = %ref_dir%/mos',
239 'naif_dir,naifdir,naifd: file = %mos_dir%/naif',
240 'ck_dir,ckdir: file = %naif_dir%/%deliv_grp%',
241 'ck_files,ckfiles: str = %naif_dir%/[0-9]*/*.bc',
242 'spk_files,spkfiles: str = %naif_dir%/[0-9]*/*.bsp',
243 'clk_base,clkbase: str = wise',
244 'sclk_file,sclk,tsc: file = %naif_dir%/%clk_base%.tsc',
245 'lsk_file,lsk,tls: file = %naif_dir%/%clk_base%.tls',
246 "options,opts: map (\@defaults) = ".
247 "dfr=4.4,index=1,frwidth=2794,pixscl=2.75,rawrowlimit=250000,sort=1,".
248 "npix=1016,append=0,nonscans=0,wholescans=1,allscans=0,fastscans=1,".
249 "scid=-163,ck_scid=-163000,darkscans=0,firstscan=00467x,orderby=0,".
250 "survscans=1",
251 " # wholescans=1 => w/ -scans, match whole scan for any matching frame",
252 " # allscans=1 => w/ -scans, demand all frames in scan match",
253 " # fastscans=1 => w/ -scans, do a reduced query to get basic scan info",
254 ],
255 param_opts => {
256 defaults => {
257 out_file => '-',
258 },
259 help => {
260 },
261 }
26230.002570.00086 );
263
26433.6e-51.2e-5use WISE::CoUtils qw/$R2D/;
# spent 198µs making 1 call to Exporter::import
26530.001380.00046use WISE::DB::FrameIndex;
# spent 4µs making 1 call to import
266#print "@INC\n";
267#print "$INC{'WISE/DB/FrameIndex.pm'}\n";
26833.3e-51.1e-5use File::Basename;
# spent 71µs making 1 call to Exporter::import
26933.8e-51.3e-5use Time::HiRes;
# spent 127µs making 1 call to Time::HiRes::import
27030.013770.00459use Carp qw/confess/;
# spent 39µs making 1 call to Exporter::import
271
27213.0e-63.0e-6$SIG{__DIE__} = sub { confess; } if $pvals{debug};
273
27412.0e-62.0e-6my $debug = $pvals{debug};
27513.0e-63.0e-6my $verbose = $pvals{verbose} || $debug;
276
27724.4e-52.2e-5if($verbose) {
27811.2e-51.2e-5 WISE::Utils::banner($iam,$version,{defs=>$pars})
# spent 8.45ms making 1 call to WISE::UtilsLight::banner
279}
280
28111.0e-61.0e-6$ENV{DBIC_TRACE} = 1 if $debug;
282
283# We can optimize the scan search under certain conditions, if the user
284# can put up with limited column output
285my $fastscans = $pvals{scans} && $pvals{options}{fastscans} &&
28614.0e-64.0e-6 (! $pvals{positions} || ! @{$pvals{positions}}) &&
287 ! $pvals{match_tbl};
288
28912.0e-62.0e-6if($pvals{scans}) {
290 $pars->set(sort => 'scan')
291 if ! $pars->given('sort');
292 $pars->set(cols =>($pvals{options}{fastscans} ? '@fastscans' : '@scans'))
293 if ! $pars->given('cols');
294}
295
29612.0e-62.0e-6my @aps = @{$pvals{meta_aps} || []};
29712.0e-62.0e-6my @apsubdirs = map { my $sd="."; s|^(.*)/+|| and $sd=$1; $sd; } @aps;
29812.0e-62.0e-6my @metavals =@{$pvals{meta_vals} || []};
29911.0e-61.0e-6my @metakeys =@{$pvals{meta_keys} || []};
30011.1e-51.1e-5my %metavals = map { (lc($_)=>1) } @metavals;
30111.0e-61.0e-6my %metakeys = map { (lc($_)=>1) } @metakeys;
30211.0e-61.0e-6my $dometa = @aps && (@metavals || @metakeys);
303
304
30513.2e-53.2e-5my @fixcols = WISE::Params::steps_resolve($pars->get('fix_cols'),
# spent 707µs making 1 call to WISE::Params::steps_resolve # spent 96µs making 2 calls to WISE::Pars::get, avg 48µs/call
306 $pars->get('col_macros'));
30712.0e-62.0e-6my %fixcols = @fixcols;
30812.7e-52.7e-5@fixcols = map {$fixcols[$_]} grep {! ($_%2)} 0..$#fixcols; # Straight col list
30932.1e-57.0e-6{ my %seen; @fixcols = grep {! $seen{$_}++} @fixcols; }
310#print "FIX output columns: @fixcols\n" if $verbose;
31111.0e-61.0e-6my @realfixcols;
31232.5e-58.3e-6{ my %seen;
313 @realfixcols = (grep {! $seen{$_}++}
314 grep {! $auxtypes{$_}}
315 (@fixcols,
316 qw/scan frame band
317 ra_raw dec_raw pa_raw ra_ref dec_ref pa_ref
318 pipe_status utcs frameset_run_time pipe_dir
319 pixel_stat1 pixel_stat2 pixel_stat3/));
320}
32113.0e-63.0e-6my @scansfixcols = grep { $scancols{$_} } @fixcols;
322
32312.0e-62.0e-6my $band = $pvals{band};
32411.0e-61.0e-6my $set = defined $band && $band == 0;
32511.0e-61.0e-6$band = undef if ! $band;
32611.0e-61.0e-6my $coord = $pvals{coord_sys}[0];
32711.0e-61.0e-6my $sort = $pvals{sort_cols};
32812.0e-62.0e-6my $nearest = $pvals{nearest} // 0;
32925.0e-62.5e-6my $r = eval { $pvals{match_radius} + 0 };
330100die "$err: Specified match radius is not a number; '$pvals{match_radius}'.\n"
331 if ! defined $r;
33211.4e-51.4e-5my $border = $pars->origval('match_radius')=~/^\s*[-+0]/ ? $r : undef;
# spent 56µs making 1 call to WISE::Pars::origval
33316.0e-66.0e-6$r = $border+$pvals{options}{frwidth}*sqrt(2)/2 if defined $border;
33419.0e-69.0e-6my ($frisod, $frdat, ) = norm_times($pvals{frame_time});
# spent 13µs making 1 call to main::norm_times
33518.0e-68.0e-6my ($runisod, $rundat, $runt) = norm_times($pvals{run_time});
# spent 16µs making 1 call to main::norm_times
33615.0e-65.0e-6my %fields = %{ $pvals{search_fields} || {} };
337my @scans = ($fields{scan}
338 ? (ref($fields{scan})
33911.0e-61.0e-6 ? @{$fields{scan}}
340 : $fields{scan})
341 : ());
34212.0e-62.0e-6my $notscans = @scans && $scans[0] =~ s/^-// ? "not_" : "";
34311.0e-61.0e-6my $scanrng = 0;
34412.0e-62.0e-6if(@scans == 1 && $scans[0]=~/(.*)[-.]+(.*)/) {
345 @scans = ($1,$2);
346 $scanrng = 1;
347}
348my @scanre = ($fields{scanre}
349 ? (ref($fields{scanre})
35011.0e-61.0e-6 ? @{$fields{scanre}}
351 : $fields{scanre})
352 : ());
35311.0e-61.0e-6my $scanre = @scanre ? "(".join(")|(",@scanre).")" : undef;
35411.0e-61.0e-6$scanre = qr/$scanre/ if $scanre;
35512.0e-62.0e-6my $scanlike= $fields{scanlike};
35611.0e-61.0e-6my $notscanlike = $scanlike && $scanlike =~ s/^-// ? "not_" : "";
35711.0e-61.0e-6if(! @scans && $scanlike && $scanlike =~ /^([^*%]+[%*]+)/) {
358 # Optimize a like expression a bit
359 my $pfx = $1;
360 $pfx =~ s/[*%]+$//;
361 $scanrng = 1;
362 $scans[0] = $pfx;
363 $pfx++;
364 $scans[1] = $pfx;
365 $notscans = $notscanlike;
366 print "Adding scan range '$notscans@scans' to optimize glob matching.\n"
367 if $pvals{debug};
368}
369my @frames = ($fields{frame}
370 ? (ref($fields{frame})
37111.0e-61.0e-6 ? @{$fields{frame}}
372 : $fields{frame})
373 : ());
37411.1e-51.1e-5@frames = WISE::Utils::expandlist(join(",",@frames));
# spent 68µs making 1 call to WISE::Utils::expandlist
375my @fids = ($fields{fid}
376 ? (ref($fields{fid})
37711.0e-61.0e-6 ? @{$fields{fid}}
378 : $fields{fid})
379 : ());
380
38111.0e-61.0e-6my $notfid = "";
38211.0e-61.0e-6$notfid = "not " if $fids[0] && $fids[0] =~ s/^\s*(-|\!|not)\s*//;
38311.0e-61.0e-6@fids = split " ",$fids[0] if @fids == 1 && $fids[0] =~ /\s/;
38411.0e-61.0e-6if(@fids == 1 && $fids[0] =~ s/^\s*@\s*//) {
385 open(my $fidfh,"<",$fids[0])
386 or die "$err: Can't open FID input file '$fids[0]'; $!.\n";
387 chomp(@fids = map {s/\s+//g; $_;} grep {! /^\s*[;#\\]/} <$fidfh>);
388}
38911.0e-61.0e-6$fields{pstat} = lc $fields{pstat} if $fields{pstat};
39013.0e-63.0e-6my $status = (defined $fields{pstat}
391 ? ($fields{pstat} eq 'ok' || $fields{pstat} eq '0'
392 ? 0
393 : $fields{pstat} eq 'err' || $fields{pstat} eq '1'
394 ? 1
395 : $fields{pstat} eq 'run' || $fields{pstat} eq '-1'
396 ? -1
397 : $fields{pstat} eq 'notrun' || $fields{pstat} eq '-2'
398 ? -2
399 : die "$err: Unrecognized pstat limit '$fields{pstat}'.\n"
400 )
401 : undef);
40212.0e-62.0e-6my $score = int($fields{score}) if defined $fields{score};
403100my $anneal = $fields{anneal};
40411.0e-61.0e-6my $saa = $fields{saa};
40511.0e-61.0e-6my $moond = $fields{moon};
40611.0e-61.0e-6my $fix = $pvals{frame_index};
40711.0e-61.0e-6my $mchfile = $pvals{match_tbl};
408
409100my $naif;
41010.006760.00676my @ck = sort grep {-e} glob($pvals{ck_files});
# spent 152ms making 1 call to File::Glob::csh_glob
41110.000780.00078my @spk = sort grep {-e} glob($pvals{spk_files});
# spent 29.4ms making 1 call to File::Glob::csh_glob
412
41391.5e-51.7e-6my $moon = defined $fields{moon} || grep { /moon_/ } @fixcols;
414
41511.0e-61.0e-6if($moon) {
416 eval "use WISE::Ingest;";
417 die $@ if $@;
418 print "Loading NAIF kernels ...\n" if $verbose;
419 $naif= WISE::Ingest::NAIF->new({
420 verbose => $pvals{debug},
421 scid => $pvals{options}{scid},
422 ck_scid => $pvals{options}{ck_scid},
423 tls => $pvals{lsk_file},
424 tsc => $pvals{sclk_file},
425 bc => [],
426 bsp => \@spk,
427 });
428}
429
43011.0e-51.0e-5my @fixposcols = map {lc} @{ $pvals{fix_pos_cols} };
431
43213.1e-53.1e-5print "\nSearching Frame Index '$fix' ...\n\n" if $verbose;
433
43411.0e-61.0e-6my %pos;
43511.0e-61.0e-6my ($wcsreg,$regwidth,$regpa,$regra,$regdec);
436100my $npos = 0;
43711.0e-61.0e-6if($mchfile) {
438 my @tblposcols = map {lc} @{ $pvals{tbl_pos_cols} };
439 print "Reading match table file '$mchfile' columns @tblposcols ...\n"
440 if $verbose;
441 my $mchtbl = eval { WISE::IPACTbl->new($mchfile,{cols=>[@tblposcols]}); };
442 die "$err: Failed to open '$mchfile': $@" if ! $mchtbl;
443 my $mchpos = $mchtbl->data();
444 $npos = $mchtbl->nrows();
445 die "$err: No sources read from '$mchfile'." if $npos == 0;
446 $pos{ra} = $mchpos->{lc $tblposcols[0]};
447 $pos{dec} = $mchpos->{lc $tblposcols[1]};
448 print "... retrieved $npos positions.\n" if $verbose;
449}
45061.0e-51.7e-6if($pvals{region_width}) {
451 die "$err: Region_ width $pvals{region_width} is too small. ".
452 "Did you give degrees instead of arc-seconds?\n"
453 if $pvals{region_width} < 90;
454 die "$err: Multi-position match file not allowed when a region is defined.\n"
455 if $mchfile && $npos > 1;
456 die "$err: One manual position must be specified when a region ".
457 "is defined.\n"
458 if ! $mchfile &&
459 ! $pvals{positions} || ! @{$pvals{positions}} ||
460 @{$pvals{positions}} > 2;
461 die "$err: -nearest not allowed when region defined.\n"
462 if $nearest;
463 die "$err: -r must defined a border offset when a region is defined ".
464 "(use '+' or '-' or '0').\n"
465 if ! defined $border;
466}
46766.7e-51.1e-5if($pvals{positions} && @{$pvals{positions}}) {
468 die "$err: Unpaired match positions provided." if @{$pvals{positions}}%2;
469 $pos{ra} = [@{$pos{ra}||[]},
470 map {$pvals{positions}[$_]}
471 grep {! ($_%2)}
472 0..$#{$pvals{positions}}];
473 $pos{dec} = [@{$pos{dec}||[]},
474 map {$pvals{positions}[$_]}
475 grep { $_%2 }
476 0..$#{$pvals{positions}}];
477 $npos = @{$pvals{positions}}/2;
478
479 print "Read $npos positions from parameters.\n" if $verbose;
480}
48142.0e-55.0e-6if($npos > 0) {
482 # Convert coord. string to equ. decimal degrees
483 print "Normalizing coordinates...\n" if $verbose;
484 for (0..$npos-1) {
48532.1e-57.0e-6 my ($ra,$dec) = WISE::CoUtils::cconv($coord,$pos{ra}[$_],$pos{dec}[$_],
# spent 290µs making 1 call to WISE::CoUtils::cconv
486 "equ")
487 or die;
488 print "--- $_: $pos{ra}[$_],$pos{dec}[$_]($coord) -> $ra,$dec\n"
489 if $debug;
490 ($pos{ra}[$_],$pos{dec}[$_]) = ($ra,$dec);
491 }
49280.001230.00015 if($pvals{region_width}) {
493 require WISE::FITSIO::Utils;
494 $regwidth = $pvals{region_width};
495 $regpa = $pvals{region_pa}//0;
496 $regra = $pos{ra}[0];
497 $regdec = $pos{dec}[0];
498 $r = $border+($pvals{options}{frwidth}+$regwidth)*sqrt(2)/2;
499 print "Define region with ...\n".
500 ". Center RA,Dec = $pos{ra}[0],$pos{dec}[0]\n".
501 ". Width = $regwidth\"\n".
502 ". PA = $regpa\n"
503 if $verbose;
504 $wcsreg = WISE::WCS->new({npix =>int($regwidth+0.5),
# spent 201µs making 1 call to WISE::WCS::new
505 cdelt =>1/3600,
506 crval1=>$regra,
507 crval2=>$regdec,
508 pa =>$regpa,
509 })
510 or die;
511 }
512}
513
514# Coarse matching
515
51612.3e-52.3e-5my $t0 = [Time::HiRes::gettimeofday()];
# spent 21µs making 1 call to Time::HiRes::gettimeofday
517
51811.8e-51.8e-5my $db = WISE::DB::FrameIndex->connect($fix);
# spent 55.1ms making 1 call to DBIx::Class::Schema::connect
519
52011.0e-61.0e-6my %colinfo;
521{
52230.000124.1e-5 my $rs = $db->resultset('Frame');
# spent 954µs making 1 call to DBIx::Class::Schema::resultset
523470.000429.0e-6 %colinfo = map { ($_ => $rs->result_source->column_info($_)) }
# spent 4.83ms making 48 calls to DBIx::Class::ResultSet::result_source, avg 101µs/call # spent 2.25ms making 47 calls to DBIx::Class::ResultSource::column_info, avg 48µs/call # spent 20µs making 1 call to DBIx::Class::ResultSource::columns
524 $rs->result_source->columns();
525}
526
52713.0e-63.0e-6my $scans = $pvals{scans};
52811.0e-61.0e-6my $all = $scans && $pvals{options}{allscans};
52911.0e-61.0e-6my $whole = $scans && ($pvals{options}{wholescans} || $all);
530
531209.3e-54.6e-6if($verbose) {
532 print "\nSearch terms:\n";
533 print ". Band = $band.\n" if $band;
534 print ". FramesetIDs = $notfid@fids.\n" if @fids;
535 print ". Scans = $notscans@scans.\n" if @scans && ! $scanrng;
536 print ". ScanRange = $notscans$scans[0]-$scans[1].\n"
537 if @scans && $scanrng;
538 print ". ScanRE = $scanre.\n" if $scanre;
539 print ". ScanLike = $notscanlike$scanlike.\n" if $scanlike;
540 print ". Frames = @frames.\n" if @frames;
541 print ". Status = $status.\n" if defined $status;
542 print ". QA Score = $score.\n" if defined $score;
543 print ". Anneal dt = $anneal.\n" if defined $anneal;
544 print ". SAA GCD = $saa.\n" if defined $saa;
545 print ". Frame Times = @$frdat (@$frisod)\n" if @$frisod;
546 print ". Run Times = @$rundat (@$runisod)\n" if @$runisod;
547 print ". Radius = $r\"".
548 (defined $border
549 ? ", border = $border"
550 : "").".\n" if $npos > 0;
551 print ". Matching to $npos positions.\n" if $npos > 0;
552 print ". Taking only nearest match.\n" if $nearest;
553 print ". Matching $regwidth\"x$regwidth\" region at ".
554 "RA,Dec=$regra,$regdec, PA=$regpa\n"
555 if $regwidth;
556 print "\nSearching ".($fastscans?"(fastscans)":"")." ...\n";
557}
558
55912.0e-62.0e-6my %scanquery = ((@scans
560 ? (! $scanrng
561 ? ("-${notscans}in"=>[@scans])
562 : ("-${notscans}between"=>[@scans])
563 #: (($notscans?'<':'>=')=>$scans[0],
564 # ($notscans?'>':'<=')=>$scans[1])
565 )
566 : ()),
567 ($scanlike
568 ? ("-${notscanlike}like"=>$scanlike)
569 : ())
570 );
571
572100my %fidquery;
57311.0e-61.0e-6if(@fids) {
574 my @bad = grep(length($_)!=9,@fids);
575 die "$err: Illegal frame ID(s) provided; @bad.\n"
576 if @bad;
577 if(! $notfid) {
578 %fidquery = (-or => [map { { 'me.scan' => substr($_,0,6),
579 frame => substr($_,6) } }
580 @fids ]);
581 } else {
582 %fidquery = (-and=> [map { { -or => ['me.scan' => {'!=' => substr($_,0,6)},
583 frame => {'!=' => substr($_,6) } ]
584 } }
585 @fids ]);
586 }
587}
588
58918.0e-68.0e-6my %limit = ($pvals{options}{rawrowlimit}>0
590 ? (rows => $pvals{options}{rawrowlimit})
591 : ());
592
59311.0e-61.0e-6my %group;
594100if($fastscans) {
595 %group = (
596 group_by => ['me.scan'],
597 order_by => [qw/me.scan frame band/],
598 select => [
599 { count => { distinct => ['scan','frame'] } },
600 { min => 'utcs' },
601 { max => 'utcs' },
602 { min => 'frame' },
603 { max => 'frame' },
604 @realfixcols
605 ],
606 as => [qw/nfr_scan
607 min_utcs
608 max_utcs
609 min_frame
610 max_frame/,
611 @realfixcols],
612 );
613}
614
61511.0e-61.0e-6my %scantbl;
61611.0e-61.0e-6if(@scansfixcols) {
617 my @scansreccols = map { (my$x=$_)=~s/^scans_/scanrec./; $x; } @scansfixcols;
618 %scantbl = (
619 join => 'scanrec',
620 '+select' => \@scansreccols,
621 '+as' => \@scansfixcols,
622 );
623}
624
62511.4e-51.4e-5my $query = {
626 ($npos>0
627 ? (ra=>$pos{ra}, dec=>$pos{dec}, radius=>$r/3600) : () ),
628 ($band ? (band =>$band) : () ),
629 (@frames ? (frame=>{ '-in'=>[@frames] }) : () ),
630 (@$frisod ? (utcs =>{ '>='=>$frisod->[0],
631 '<='=>$frisod->[1] }) : () ),
632 (@$runt ? (frameset_run_time =>{ '>='=>$runt->[0],
633 '<='=>$runt->[1] }) : () ),
634 (defined $status
635 ? ($status == 0
636 ? (pipe_status => 0)
637 : $status == 1
638 ? (pipe_status => { '!='=>0 })
639 : $status == -1
640 ? (pipe_status => { '!='=>undef }) # not null
641 : (pipe_status => { '=='=>undef })) # null
642 : ()),
643 (defined $score
644 ? ($score >= 0
645 ? (qa_score=>{'>='=>$score}) # At or above thresh
646 : $score >= -90
647 ? (qa_score=>{'<='=>abs($score)}) # At or below thresh
648 : (qa_score=>{'=='=>undef} ) # Is null
649 )
650 : ()),
651 (defined $anneal
652 ? ($anneal >= 0
653 ? (anneal_dt=>{'>='=>$anneal}) # At or above thresh
654 : $anneal >= -99000
655 ? (anneal_dt=>{'<='=>abs($anneal)}) # At or below thresh
656 : (anneal_dt=>{'=='=>undef} ) # Is null
657 )
658 : ()),
659 (defined $saa
660 ? ($saa >= 0
661 ? (saa_status=>{'>='=>$saa}) # At or above thresh
662 : $anneal >= -990
663 ? (saa_status=>{'<='=>abs($saa)}) # At or below thresh
664 : (saa_status=>{'=='=>undef} ) # Is null
665 )
666 : ()),
667 (%scanquery || %fidquery
668 ? (-and => [
669 (%scanquery ? ('me.scan' => \%scanquery) : ()),
670 (%fidquery ? (%fidquery) : ()),
671 ])
672 : () ),
673 };
674
67512.0e-62.0e-6print "Query = ", Dumper $query if $pvals{debug} =~ /query/;
676
67713.1e-53.1e-5my $rs = $db->search($query,
# spent 284ms making 1 call to WISE::DB::FrameIndex::search
678 { # Attributes
679 (! $scans ? (columns => [@realfixcols]) : ()),
680 ($pvals{options}{orderby}
681 ? (order_by => [qw/scan frame band/]) : ()),
682 %limit,
683 %group,
684 %scantbl,
685 },
686 );
687
68814.4e-54.4e-5print "Coarse query found ".$rs->count." candidate bandframes.\n"
# spent 182s making 1 call to DBIx::Class::ResultSet::count
689 if $verbose;
690
69111.0e-61.0e-6my (%nfr, %minutcs, %maxutcs, %minfr, %maxfr);
69211.0e-61.0e-6if($whole) {
693 # Do simpler query just to match the selected scans
694 @scans = ();
695 while(my $row = $rs->next) {
696 my $scan = $row->scan;
697 if($fastscans) {
698 push @scans, $scan;
699 $nfr{$scan} = $row->get_column('nfr_scan');
700 $minutcs{$scan} = $row->get_column('min_utcs');
701 $maxutcs{$scan} = $row->get_column('max_utcs');
702 $minfr{$scan} = $row->get_column('min_frame');
703 $maxfr{$scan} = $row->get_column('max_frame');
704 } else {
705 ++$nfr{$scan};
706 my($utcs,$frame) = ($row->utcs,$row->frame);
707 push @scans, $scan if $nfr{$scan} == 1;
708 $minutcs{$scan} = ! $minutcs{$scan} || $minutcs{$scan} lt $utcs
709 ? $utcs : $minutcs{$scan};
710 $maxutcs{$scan} = ! $maxutcs{$scan} || $maxutcs{$scan} gt $utcs
711 ? $utcs : $maxutcs{$scan};
712 $minfr{$scan} = ! $minfr{$scan} || $minfr{$scan} < $frame
713 ? $frame : $minfr{$scan};
714 $maxfr{$scan} = ! $maxfr{$scan} || $maxfr{$scan} > $frame
715 ? $frame : $maxfr{$scan};
716 }
717 }
718 my $rs_whole = $db->search({scan => {-in=>[@scans]}},
719 {
720 (! $scans
721 ? (columns => [@realfixcols]) : ()),
722 order_by => [qw/scan frame band/],
723 %limit,
724 %group,
725 },
726 );
727
728 print "Whole-scan query found ".$rs_whole->count." candidate bandframes ".
729 "matching scans @scans.\n"
730 if $verbose;
731
732 print Dumper $query if $pvals{debug} =~ /query/;
733
734 if($all) {
735 my @new;
736 while(my $row = $rs_whole->next) {
737 my $scan = $row->scan;
738 my $n = $row->get_column('nfr_scan');
739 if($n == $nfr{$scan}) {
740 push @new, $scan;
741 }
742 }
743 if(@new != @scans) {
744 @scans = @new;
745 $rs_whole = $db->search({scan => {-in=>[@scans]}},
746 {
747 (! $scans
748 ? (columns => [@realfixcols]) : ()),
749 order_by => [qw/scan frame band/],
750 %limit,
751 %group,
752 },
753 );
754 print "All-scan query found ".$rs_whole->count.
755 " candidate bandframes.\n"
756 if $verbose;
757 }
758 }
759
760 $rs = $rs_whole;
761}
762
76312.0e-62.0e-6print Dumper $rs if $debug =~ /frobj/;
764
76513.2e-53.2e-5warn "$err: Results may have been limited at ".
# spent 200s making 1 call to DBIx::Class::ResultSet::count
766 $pvals{options}{rawrowlimit}." rows.\n"
767 if $pvals{options}{rawrowlimit} > 0 &&
768 $rs->count == $pvals{options}{rawrowlimit};
769
770# Reduce to desired matches
771
772100my $nrows = 0;
77311.0e-61.0e-6my %rows;
774100my %bands;
77511.0e-61.0e-6my %seen;
77611.2e-51.2e-5my @outpos = (grep($_ eq 'ra', @fixcols) ? qw(ra dec pa) :
777 grep($_ eq 'ra_ref', @fixcols) ? qw(ra_ref dec_ref pa_ref) :
778 qw(ra_raw dec_raw pa_raw));
779
7807350523.709815.0e-6while(my $fr = $rs->next) {
# spent 204s making 55476 calls to DBIx::Class::ResultSet::next, avg 3.67ms/call
78110.388230.38823 my ($scan,$frame,$band) = map { $fr->$_; } (qw/scan frame band/);
782 my $id = sprintf("$scan%03d",$frame);
783 $bands{$id} //= [];
784 push @{$bands{$id}}, $band;
785 print "--- $id\n" if $debug=~ /coarse/;
786 next if ! $set && $seen{$id}++; # Filter to one bandframe per set
787 next if $pvals{options}{survscans} && $skipscans{$scan};
788 next if ! $pvals{options}{nonscans} && $scan =~ /x$/;
789 next if ! $pvals{options}{darkscans} && $scan lt $pvals{options}{firstscan};
790 next if $scanre && $scan !~ /$scanre/;
791 my $ra = defined $fr->ra_ref ? $fr->ra_ref : $fr->ra_raw;
792 my $dec = defined $fr->dec_ref ? $fr->dec_ref : $fr->dec_raw;
793 my $pa = defined $fr->pa_ref ? $fr->pa_ref : $fr->pa_raw;
794 $rows{$_}[$nrows] = $fr->$_ for @realfixcols;
79511.403381.40338 $rows{ra}[$nrows] = $ra;
796 $rows{dec}[$nrows] = $dec;
797 next if ! defined $rows{$outpos[0]}[$nrows] || # Watch out for crappy
798 ! defined $rows{$outpos[1]}[$nrows] || # DB entries
799 $rows{$outpos[0]}[$nrows] !~ /\d/ ||
800 $rows{$outpos[1]}[$nrows] !~ /\d/;
801 $rows{id}[$nrows] = $id;
802 $rows{pa}[$nrows] = $pa;
803 $rows{pstat}[$nrows] = $fr->pipe_status;
804277380.127844.6e-6 if($rows{pipe_dir}[$nrows]) {
805 $rows{pipe_dir}[$nrows] =~ s|^/+wise-ops/+\d\d/+wise/+|/wise/|;
806 # /wise/fops/scans/0a/00460a/fr/122
807 ($rows{scan_dir}[$nrows]) =
808 $rows{pipe_dir}[$nrows] =~ m!( .* /+
809 (?:scans|ql) /+
810 [^/]+ /+
811 [^/]+ ) /+
812 !x;
813 }
814416070.397729.6e-6 if(defined $fr->pixel_stat1) {
815 $rows{stat1}[$nrows] = sprintf "%.2f",$fr->pixel_stat1;
816 $rows{stat2}[$nrows] = sprintf "%.2f",$fr->pixel_stat2;
817 $rows{stat3}[$nrows] = sprintf "%.2f",$fr->pixel_stat3;
818 }
819 $rows{datime}[$nrows] = defined $fr->utcs
# spent 2.09s making 13869 calls to WISE::Time::Str_time, avg 151µs/call # spent 1.19s making 13869 calls to WISE::Time::Time_str, avg 86µs/call # spent 366ms making 27738 calls to Class::Accessor::Grouped::__ANON__[(eval 0)[/wise/base/static/lib/perl5/site_perl/5.10.0/Class/Accessor/Grouped.pm:156]:8], avg 13µs/call
820 ? WISE::Time::Time_str(
821 WISE::Time::Str_time($fr->utcs,{z=>1}),
822 {form=>1,dp=>3}
823 )
824 : undef;
825 $rows{pipedatime}[$nrows]=defined $fr->frameset_run_time
# spent 897ms making 13869 calls to WISE::Time::Time_str, avg 65µs/call # spent 408ms making 27738 calls to Class::Accessor::Grouped::__ANON__[(eval 0)[/wise/base/static/lib/perl5/site_perl/5.10.0/Class/Accessor/Grouped.pm:156]:8], avg 15µs/call
826 ? WISE::Time::Time_str($fr->frameset_run_time,
827 {form=>1})
828 : undef;
829 my %qafact = $fr->qa_factors();
# spent 2.26s making 13869 calls to WISE::DB::FrameIndex::Frame::qa_factors, avg 163µs/call
830 $rows{qa_factors}[$nrows] = %qafact ? join(",",map {"$_=$qafact{$_}"}
831 sort keys %qafact)
832 : undef;
833 ($rows{elon}[$nrows],$rows{elat}[$nrows]) =
# spent 1.09s making 13869 calls to WISE::CoUtils::cconv, avg 79µs/call
834 WISE::CoUtils::cconv('equ',
835 $rows{$outpos[0]}[$nrows],
836 $rows{$outpos[1]}[$nrows],
837 'ecl');
838 ($rows{glon}[$nrows],$rows{glat}[$nrows]) =
# spent 3.25s making 13869 calls to WISE::CoUtils::cconv, avg 234µs/call
839 WISE::CoUtils::cconv('equ',
840 $rows{$outpos[0]}[$nrows],
841 $rows{$outpos[1]}[$nrows],
842 'gal');
843 if($scans) {
844 $rows{n_frames}[$nrows] = $nfr{$scan};
845 $rows{min_utcs}[$nrows] = $minutcs{$scan};
846 $rows{max_utcs}[$nrows] = $maxutcs{$scan};
847 $rows{min_frame}[$nrows] = $minfr{$scan};
848 $rows{max_frame}[$nrows] = $maxfr{$scan};
849 }
850 for (grep {$rows{$_}} qw/ra dec pa ra_ref dec_ref pa_ref
851 ra_raw dec_raw pa_raw elon elat glon glat/) {
8521802971.455108.1e-6 $rows{$_}[$nrows] = sprintf("%10.6f",
853 (($rows{$_}[$nrows]//'') =~ /\d/
854 ? $rows{$_}[$nrows]
855 : -999)
856 );
857 }
858 #print "--- $nrows: $rows{pipe_dir}[$nrows] && @aps && @metavals \n";
859 if(@scansfixcols) {
860 $rows{$_}[$nrows] = $fr->get_column($_) for @scansfixcols;
861 }
862 if($moon) {
863 my $et = $naif->utc2et($fr->utcs);
864 my $obj = $naif->et2relpos($et,'MOON','WISE') or die;
865 my $sep = WISE::CoUtils::rd2radvec($obj->{lon},$obj->{lat},$ra,$dec);
866 my $pa = WISE::CoUtils::gcposang($obj->{lon},$obj->{lat},$ra,$dec);
867 if(defined $moond) {
868 if($moond >= 0) {
869 next if $sep < $moond;
870 } else {
871 next if $sep > abs($moond);
872 }
873 }
874 $rows{moon_sep}[$nrows] = $sep;
875 $rows{moon_pa}[$nrows] = $pa;
876 }
877 if($dometa && $rows{pipe_dir}[$nrows]) {
878 my $dir = $rows{pipe_dir}[$nrows];
879 my @files;
880 if(@aps == 1) {
881 # Optimization
882 # Avoid use of scanframe_from_path since it uses fast_abs_path()
883 # and I want to avoid unecessary disk hits.
884 my($scan,$frame) =
885 $dir =~ m%/+\d[\da-z]/+(\d{5}[a-z])/+fr/+(\d\d\d)(?:/+)?$%;
886 $files[0] = WISE::Utils::pathcomp({dir=>"$dir/$apsubdirs[0]",
887 base=>"$scan$frame",
888 type=>'meta',
889 vsn=>$aps[0],
890 form=>'tbl'});
891 } else {
892 # SLOW!!!
893 my $glob = "$dir/{.,qa,cal}/*-meta-{".join(",",@aps)."}.tbl";
894 @files = grep {-e} glob($glob);
895 }
896 #print "------ $glob @files\n";
897 my %metasum;
898 for my $metafile (@files) {
899 my $metatbl = eval { WISE::IPACTbl->new($metafile,{fast=>1}); };
900 next if ! $metatbl;
901 my $metadata = $metatbl->data({hashrow=>1});
902 if(@metavals) {
903 for my $row (@$metadata) {
904 $row->{name} =~ s/.*://;
905 $row->{name} = lc $row->{name};
906 my $b = $row->{band} // 0;
907 #print "--------- $metafile: $row->{name} $b $row->{value}\n";
908 next if ! $metavals{$row->{name}};
909 $row->{name} = "w$b$row->{name}" if $b;
910 $metasum{$row->{name}} = $row->{value};
911 $colinfo{$row->{name}}{data_type} ||= $row->{type};
912 }
913 }
914 if(@metakeys) {
915 my $keys = $metatbl->keys();
916 for my $key (@metakeys) {
917 $metasum{lc $key} = $keys->{lc $key};
918 $colinfo{lc $key}{data_type} ||= 'text';
919 }
920 }
921 }
922 $rows{$_}[$nrows] = $metasum{$_} for( @metavals,@metakeys);
923 }
924 ++$nrows;
925}
926
927# Assign bands value back to rows
92817.0e-67.0e-6for my $i (0..$nrows-1) {
929138690.068114.9e-6 $rows{bands}[$i] = join "", sort {$a<=>$b} @{$bands{$rows{id}[$i]}};
930}
931
932140.078990.00564if($npos > 0 && $nrows > 0) { POS: {
933 print "Matched $nrows ".($set?"frameset":"bandframes").
934 "; reducing to radial matches ...\n"
935 if $verbose;
936 my $res = WISE::CoUtils::posmatch(\%pos,\%rows,$r,
# spent 461s making 1 call to WISE::CoUtils::posmatch
937 {
938 index => $pvals{options}{index},
939 loncol => 'ra',
940 latcol => 'dec',
941 nearest=> $nearest && ! defined $border,
942 verbose=> $debug,
943 debug => scalar($debug=~/mch/),
944 }
945 );
946
947 my @mchpos = @{ $res->{matched} || [] }; # Matched position indices
948 my %got;
949 for my $j (@mchpos) { # For each matched position ...
950 # Frames matched to position $j
95120.013560.00678 my @mchfrs = @{ $res->{matches}{$j} || [] };
952 for my $mch (@mchfrs) { # Step through matches
953498800.081621.6e-6 my ($i,$mchr) = @{$mch}{'ix','r'}; # Index to matched frame (row) and match distance
954 print "--- frm #$i, pos #$j; r=$mchr\n"
955 if $debug =~ /mch/;
956 push @{$rows{mchs}[$i]}, $j;
957 ++$got{$i};
958 }
959 }
960 my @ok = sort {$a<=>$b} keys %got;
961 if($whole) {
962 # Expand accepted frames to the whole encompassing scan
963 my %scans_ok;
964 for my $i (@ok) {
965 ++$scans_ok{$rows{scan}[$i]};
966 }
967 my @new_ok;
968 for my $i (0..$nrows-1) {
969 push @new_ok, $i if $scans_ok{$rows{scan}[$i]};
970 }
971 @ok = @new_ok;
972 }
973 $rows{$_} = [ @{$rows{$_}}[@ok] ] for keys %rows;
97410.540380.54038 $nrows = @ok;
975 last POS if $nrows == 0;
976
977140.006890.00049 if(defined $border) {
978 require WISE::FITSIO::Utils;
979 # Subset by whether each source is on the matched frame (using
980 # simplified frame geomtery; no distortion, approx. pixel
981 # scales) or by whether it overlaps a square region (e.g. a
982 # coadd's geometry)
983 print "Matched $nrows bandframes; reducing to footprint matches ".
984 "...\n"
985 if $verbose;
986 my $pixscl= $pvals{options}{pixscl};
987 my $cdelt = $pixscl/3600;
988 my $npix = $pvals{options}{npix};
989 my $cen = $npix/2 + 0.5;
990 my @ok;
991 my %nearest;
992 for my $i (0..$nrows-1) {
993374100.256106.8e-6 my $wcs = WISE::WCS->new({npix =>$npix,
# spent 752ms making 12470 calls to WISE::WCS::new, avg 60µs/call
994 cdelt =>$cdelt,
995 crval1=>$rows{ra}[$i],
996 crval2=>$rows{dec}[$i],
997 pa =>$rows{pa}[$i],
998 })
999 or die;
1000 if($wcsreg) {
# spent 147s making 12470 calls to main::overlap, avg 11.8ms/call
1001 # Region overlap check
1002 push @ok, $i if overlap($wcs, $wcsreg);
1003 } else {
1004 # Position on frame check
1005 my $n = 0;
1006 my @posmchs;
1007 for my $j (@{$rows{mchs}[$i]}) {
1008 my ($x,$y) = $wcs->wcs2pix($pos{ra}[$j],$pos{dec}[$j]);
1009 my $xin= $x<$cen ? $x - 0.5 : $npix - $x + 0.5;
1010 my $yin= $y<$cen ? $y - 0.5 : $npix - $y + 0.5;
1011 my $edgedist= $xin<$yin ? -$xin*$pixscl : -$yin*$pixscl;
1012 print "--- frm #$i, pos #$j, #mch=$n; $edgedist, $border\n"
1013 if $debug =~ /mch/;
1014 next if $edgedist > $border;
1015 ++$n;
1016 push @posmchs, $j;
1017 if($nearest) {
1018 $nearest{$j} = [$i,$edgedist]
1019 if ! $nearest{$j} || $edgedist<$nearest{$j}[1];
1020 }
1021 }
1022 if($n) {
1023 # Sources on frame; accept
1024 push @ok, $i;
1025 $rows{mchs}[$i] = \@posmchs; # Update matching positions
1026 }
1027 } # nmchs
102810.047800.04780 if($nearest) {
1029 # Keep only the winning frames
1030 my %winner = map { ($_->[0]=>1) } values %nearest;
1031 @ok = grep { $winner{$_} } @ok;
1032 # Update matching positions (again)
1033 my %posmchs;
1034 push @{$posmchs{$nearest{$_}[0]}},$_ for keys %nearest;
1035 $rows{mchs}[$_] = [@{$posmchs{$_}}] for @ok;
1036 }
1037 }
1038 if($whole) {
1039 # Expand accepted frames to the whole encompassing scan
1040 my %scans_ok;
1041 for my $i (@ok) {
1042 ++$scans_ok{$rows{scan}[$i]};
1043 }
1044 my @new_ok;
1045 for my $i (0..$nrows-1) {
1046 push @new_ok, $i if $scans_ok{$rows{scan}[$i]};
1047 }
1048 @ok = @new_ok;
1049 }
1050 $rows{$_} = [ @{$rows{$_}}[@ok] ] for keys %rows;
105110.386660.38666 $nrows = @ok;
1052 last POS if $nrows == 0;
1053 } # border
1054} } # npos
1055
105610.000110.00011print "\nMatched $nrows bandframes ",
# spent 76µs making 1 call to Time::HiRes::tv_interval
1057 "(elapsed time = ",Time::HiRes::tv_interval($t0),"s).\n"
1058 if $verbose;
1059
106013.3e-53.3e-5if($fixcols{mchs}) {
1061 # Construct a column of matching positions
1062 $rows{mchs}[$_] = join(",",@{$rows{mchs}[$_]||[]}) for 0..$nrows-1;
1063}
1064
1065100my $meta;
106614.0e-64.0e-6my $outfile = $pvals{out_file};
106714.0e-64.0e-6my $append = $outfile && $pvals{options}{append} && -e $outfile;
1068
1069100if($append) {
1070 # Meta from extant file
1071 $meta = WISE::IPACTbl->new($outfile,{hdronly=>1});
1072 if(! $meta) {
1073 warn "$warn: Unable to get meta-info from '$outfile'.\n";
1074 $append = 0;
1075 }
1076}
107715.0e-55.0e-5if(! $meta) {
1078 # Meta from scratch
1079 $meta = {
1080 names => [ @fixcols,@metavals,@metakeys ],
1081 types => [ map {$typex{$colinfo{$_}{data_type} ||
1082 $auxtypes{$_} || ''} || 'r'}
1083 (@fixcols,@metavals,@metakeys) ],
1084 blanks=> [ ('null') x (@fixcols+@metavals+@metakeys) ],
1085 };
1086}
1087
108814.0e-64.0e-6if($pvals{options}{sort} &&
1089 $pvals{options}{sort} eq '1' && $pvals{options}{orderby}) {
1090 $pvals{options}{sort} = 0;
1091}
1092
109359.1e-51.8e-5if($pvals{options}{sort} && $nrows > 1) {
1094 my @sortcols;
1095 if($pvals{options}{sort} eq '1') {
1096 @sortcols = grep {$rows{$_}} qw/scan frame band/;
1097 } else {
1098 @sortcols= (ref $pvals{options}{sort}
1099 ? @{$pvals{options}{sort}}
1100 : $pvals{options}{sort});
1101 }
1102 my %types = (map { (lc($meta->{names}[$_]) => $meta->{types}[$_]) }
1103 0..$#{$meta->{names}});
1104 WISE::IOUtils::sort_cols(\%rows,[map {lc($_)} @sortcols],\%types)
# spent 867ms making 1 call to WISE::IOUtils::sort_cols
1105 if grep($rows{$_},@sortcols) == @sortcols;
1106}
1107
110812.0e-62.0e-6if($scans) {
1109 # Reduce info to just frame info
1110 my %byscan;
1111 # Accumulate scan-wide derived column data
1112 for my $i (0..$nrows-1) {
1113 my $s = $rows{scan}[$i];
1114 if(! $fastscans) {
1115 $byscan{$s}{start_utcs} =
1116 ! $byscan{$s}{start_utcs} ||
1117 $rows{utcs}[$i] lt $byscan{$s}{start_utcs}
1118 ? $rows{utcs}[$i] : $byscan{$s}{start_utcs};
1119 $byscan{$s}{start_datime} =
1120 ! $byscan{$s}{start_datime} ||
1121 $rows{datime}[$i] lt $byscan{$s}{start_datime}
1122 ? $rows{datime}[$i] : $byscan{$s}{start_datime};
1123 $byscan{$s}{start_frame } =
1124 ! $byscan{$s}{start_frame} ||
1125 $rows{frame}[$i] < $byscan{$s}{start_frame}
1126 ? $rows{frame}[$i] : $byscan{$s}{start_frame};
1127 $byscan{$s}{end_utcs} =
1128 ! $byscan{$s}{end_utcs} ||
1129 $rows{utcs}[$i] gt $byscan{$s}{end_utcs}
1130 ? $rows{utcs}[$i] : $byscan{$s}{end_utcs};
1131 $byscan{$s}{end_datime} =
1132 ! $byscan{$s}{end_datime} ||
1133 $rows{datime}[$i] gt $byscan{$s}{end_datime}
1134 ? $rows{datime}[$i] : $byscan{$s}{end_datime};
1135 $byscan{$s}{end_frame } =
1136 ! $byscan{end_frame} ||
1137 $rows{frame}[$i] > $byscan{$s}{end_frame}
1138 ? $rows{frame}[$i] : $byscan{$s}{end_frame};
1139 push @{$byscan{$s}{elons_ary}},$rows{elon}[$i];
1140 $byscan{$s}{elats}{$rows{frame}[$i]} = $rows{elat}[$i];
1141 $byscan{$s}{elons}{$rows{frame}[$i]} = $rows{elon}[$i];
1142 ++$byscan{$s}{n_frames};
1143 } else {
1144 $byscan{$s}{start_utcs} = $rows{min_utcs}[$i];
1145 $byscan{$s}{end_utcs} = $rows{max_utcs}[$i];
1146 my $t0 = WISE::Time::Str_time($byscan{$s}{start_utcs},{z=>1});
1147 my $t1 = WISE::Time::Str_time($byscan{$s}{end_utcs},{z=>1});
1148 $byscan{$s}{scan_dur} = sprintf("%0.3f",$t1 - $t0);
1149 $byscan{$s}{start_datime}= WISE::Time::Time_str($t0,
1150 {form=>1,dp=>3});
1151 $byscan{$s}{end_datime} = WISE::Time::Time_str($t1,
1152 {form=>1,dp=>3});
1153 $byscan{$s}{start_frame} = $rows{min_frame}[$i];
1154 $byscan{$s}{end_frame} = $rows{max_frame}[$i];
1155 }
1156 }
1157 if(! $fastscans) {
1158 for my $s (keys %byscan) {
1159 $byscan{$s}{med_elon} = (sort {$a<=>$b} @{$byscan{$s}{elons_ary}})
1160 [@{$byscan{$s}{elons_ary}}/2];
1161 $byscan{$s}{start_elat} =
1162 $byscan{$s}{elats}{$byscan{$s}{start_frame}};
1163 $byscan{$s}{end_elat} =
1164 $byscan{$s}{elats}{$byscan{$s}{end_frame}};
1165 $byscan{$s}{start_elon} =
1166 $byscan{$s}{elons}{$byscan{$s}{start_frame}};
1167 $byscan{$s}{end_elon} =
1168 $byscan{$s}{elons}{$byscan{$s}{end_frame}};
1169 my $t0 = WISE::Time::Str_time($byscan{$s}{start_datime},{z=>1});
1170 my $t1 = WISE::Time::Str_time($byscan{$s}{end_datime},{z=>1});
1171 $byscan{$s}{scan_dur} = $t1 - $t0;
1172 }
1173 delete @{$byscan{$_}}{qw/elons elats/} for keys %byscan;
1174 }
1175 my %scancnt;
1176 my %new;
1177 my $newnrows = 0;
1178 for my $i (0..$nrows-1) {
1179 my $s = $rows{scan}[$i];
1180 next if $scancnt{$s}++;
1181 push @{$new{$_}}, $rows{$_}[$i] for keys %rows;
1182 push @{$new{$_}}, $byscan{$s}{$_} for keys %{$byscan{$s}};
1183 ++$newnrows;
1184 }
1185 $nrows = $newnrows;
1186 %rows = %new;
1187}
1188
1189# Truncate output arrays to final list length
119023.3e-51.7e-5$#{$rows{$_}} = $nrows-1 for keys %rows;
1191
119250.001960.00039if($outfile) {
1193
1194 print "Writing $nrows records to table file '$outfile' ...\n\n"
1195 if $verbose;
1196
1197 my $pscans = @scans > 10 ? "@scans[0..9] ..." : "@scans";
1198
1199 my $out = WISE::IPACTbl->new(
# spent 208ms making 1 call to WISE::IPACTbl::new
1200 $outfile, "w",
1201 {meta=>$meta,
1202 data=>$append?undef:\%rows,
1203 fast=>1,
1204 nohdr=>$pvals{no_hdr},
1205 append=>$append,
1206 (! $pvals{no_keys} && ! $pvals{no_hdr}
1207 ? (keys=>[
1208 {name=>nrecs => value=>$nrows},
1209 {name=>fix => value=>$fix},
1210 {name=>npos => value=>$npos},
1211 {name=>radius => value=>$r},
1212 {name=>border => value=>$border//'n/a'},
1213 {name=>regwidth=> value=>$regwidth//'n/a'},
1214 {name=>regra => value=>$regra//'n/a'},
1215 {name=>regdec => value=>$regdec//'n/a'},
1216 {name=>regpa => value=>$regpa//'n/a'},
1217 {name=>nearest => value=>$nearest//0},
1218 {name=>scans => value=>$pscans||'n/a'},
1219 {name=>asrange => value=>$scanrng//'0'},
1220 {name=>scanre => value=>$scanre||'n/a'},
1221 {name=>scanlike=> value=>$notscanlike.($scanlike||'n/a')},
1222 {name=>frames => value=>"@frames"||'n/a'},
1223 {name=>frdat => value=>"@$frdat"||'n/a'},
1224 {name=>frisod => value=>"@$frisod"||'n/a'},
1225 {name=>runisod => value=>"@$runisod"||'n/a'},
1226 {name=>rundat => value=>"@$rundat"||'n/a'},
1227 {name=>mchfile => value=>$mchfile//'none'},
1228 {name=>status => value=>$status//'n/a'},
1229 {name=>qa_score=> value=>$score//'n/a'},
1230 {name=>anneal_dt=>value=>$anneal//'n/a'},
1231 {name=>saa_gcd => value=>$saa//'n/a'},
1232 {name=>band => value=>$band//'n/a'},
1233 {name=>'*BLANK*' => value=>1},
1234 ])
1235 : ()),
1236 })
1237 or die "$err: Unable to open '$outfile'.\n";
1238
123911.2e-51.2e-5 if($nrows > 0) {
1240 $out->data(\%rows)
# spent 61.9ms making 1 call to WISE::IPACTbl::data
1241 or die "$err: Unable to write to '$outfile'.\n";
1242 }
1243}
1244
124512.9e-52.9e-5print "\nDone.\n\n" if $verbose;
1246
124710.199880.19988exit 0;
1248
1249# =======
1250# Subs
1251# =======
1252
1253# Scale a time interval by the trailing unit: ywdhms
1254sub tscale {
1255 my $t = shift;
1256 $t =~ s/(?<=\d)y\s*$// and $t *= 365.25*86400;
1257 $t =~ s/(?<=\d)w\s*$// and $t *= 7*86400;
1258 $t =~ s/(?<=\d)d\s*$// and $t *= 86400;
1259 $t =~ s/(?<=\d)h\s*$// and $t *= 3600;
1260 $t =~ s/(?<=\d)m\s*$// and $t *= 60;
1261 $t =~ s/(?<=\d)s\s*$//;
1262 return $t;
1263}
1264
1265# Check if two square projected (WCS) regions intesect
1266
# spent 147s (20.0+127) within main::overlap which was called 12470 times, avg 11.8ms/call: # 12470 times (20.0s+127s) at line 1000, avg 11.8ms/call
sub overlap {
12671820040.304271.7e-6 my $wcs = shift; # Frame WCS object
1268 my $wcs0 = shift; # Region WCS object
1269 my $cdelt = $wcs->yscale();
# spent 118ms making 12470 calls to WISE::WCS::yscale, avg 9µs/call
1270 my $cdelt0 = $wcs0->yscale();
# spent 108ms making 12470 calls to WISE::WCS::yscale, avg 9µs/call
1271 my $npix = $wcs->nxpix();
# spent 111ms making 12470 calls to WISE::WCS::nxpix, avg 9µs/call
1272 my $npix0 = $wcs0->nxpix();
# spent 105ms making 12470 calls to WISE::WCS::nxpix, avg 8µs/call
1273 my $width = $cdelt*$npix;
1274 my $width0 = $cdelt0*$npix0;
1275 my $npts; # Edge subdivision of frame
1276 my @pts;
1277 my $npts0; # Edge subdivision of region
1278 my @pts0;
1279 # Subdivide so the edge of the larger area is broken into
1280 # 1+(big/small) pieces (always odd)
1281249400.021178.5e-7 if($width0 > $width) {
1282 $npts0 = int($width0/$width + 0.5) + 1;
1283 $npts = 2;
1284 } else {
1285 $npts = int($width/$width0 + 0.5) + 1;
1286 $npts0 = 2;
1287 }
1288 # Test points on frame
1289 for my $ix (0..$npts) {
1290403620.050591.3e-6 my $x = $npix/$npts*$ix + 0.5;
1291 for my $iy (0..$npts) {
12921310370.528814.0e-6 my $y = $npix/$npts*$iy + 0.5;
1293 my ($x0,$y0) = $wcs0->wcs2pix($wcs->pix2wcs($x,$y));
# spent 997ms making 43679 calls to WISE::WCS::pix2wcs, avg 23µs/call # spent 965ms making 43679 calls to WISE::WCS::wcs2pix, avg 22µs/call
1294 # Indicate overlap if any point is in the region
1295 return 1 if $x0>=0.5 && $x0<=$npix0+0.5 &&
1296 $y0>=0.5 && $y0<=$npix0+0.5;
1297 }
1298 }
1299 # Test points in region
1300 for my $ix (0..$npts0) {
13012078240.337291.6e-6 my $x0 = $npix0/$npts0*$ix + 0.5;
1302 for my $iy (0..$npts0) {
1303872844633.037903.8e-6 my $y0 = $npix0/$npts0*$iy + 0.5;
1304 my ($x,$y) = $wcs0->wcs2pix($wcs->pix2wcs($x0,$y0));
# spent 62.7s making 2909482 calls to WISE::WCS::wcs2pix, avg 22µs/call # spent 61.6s making 2909482 calls to WISE::WCS::pix2wcs, avg 21µs/call
1305 # Indicate overlap if any point is on the frame
1306 return 1 if $x>=0.5 && $x<=$npix+0.5 &&
1307 $y>=0.5 && $y<=$npix+0.5;
1308 }
1309 }
1310 # No overlap
1311 return 0;
1312}
1313
1314
# spent 29µs within main::norm_times which was called 2 times, avg 15µs/call: # once (16µs+0) at line 335 # once (13µs+0) at line 334
sub norm_times {
131581.9e-52.4e-6 my $in = shift || [];
1316 my $opts = shift || {};
1317 my $d = $opts->{dt} || $pvals{options}{dfr};
1318 return ([], [], []) if ! @$in;
1319 # Convert arbitrary input fmt to UNIX time
1320 my @t = (map { (/^\s*([-+])/
1321 ? $1.abs(tscale($_))
1322 : /^\s*now([-+]\d+[ywdhms]?)?\s*$/
1323 ? time()+tscale($1||0)
1324 : WISE::Time::Str_time($_,{z=>1})||die); }
1325 @$in);
1326 if(@t == 2) {
1327 # Handle interval arithmetic
1328 @t = ($t[1]=~/^\s*-/
1329 ? ($t[0]+$t[1], $t[0])
1330 : $t[1]=~/^\s*\+/
1331 ? ($t[0], $t[0]+$t[1])
1332 : ($t[0], $t[1]));
1333 } elsif(@t == 1) {
1334 # User gave only one time, so apply default range
1335 @t = ($t[0]-$d, $t[0]+$d);
1336 }
1337 # Sort in case user entered times backwards
1338 @t = sort {$a<=>$b} @t;
1339 my @isod = map { WISE::Time::Time_str($_,{form=>4}) } @t;
1340 my @dat = map {WISE::Time::Time_str($_,{form=>1,z=>1})} @t;
1341 return (\@isod, \@dat, \@t);
1342}