← Index
Performance Profile   « block view • line view • sub view »
For /wise/base/deliv/dev/bin/wdate
  Run on Fri Jun 4 15:13:22 2010
Reported on Fri Jun 4 15:14:24 2010

File/wise/base/deliv/dev/bin/wdate
Statements Executed1075924
Total Time3.28914399999458 seconds

Subroutines — ordered by exclusive time
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
15825111.048332.80214main::get_event_info
15827310.454803.17191main::dat_to_secs
1110.208922.02434main::load_events

LineStmts.Exclusive
Time
Avg.Code
116.7e-56.7e-5#! /usr/bin/env perl
2
330.006330.00211use strict;
# spent 14µs making 1 call to strict::import
430.004850.00162use warnings;
# spent 51µs making 1 call to warnings::import
5
613.0e-63.0e-6my (@datimes,@what,@unit,$fmt,@recfmt,$local,$tick,$dbg,$verbose,
7 $do_events,$search_ev,$search_dt,%opts);
8
9use WISE::Env (iam => 'WDate',
# spent 4.85s making 1 call to WISE::Env::import
10 cfglib => '/wise/base/deliv/dev/lib/perl',
11 use_wise=> 1,
12 version => '$Id: wdate 7954 2010-06-04 01:52:13Z tim $',
13 import => [qw/$iam $err $warn $pars %pvals/],
14 params =>
15 [
16 " # Command => \$iam",
17 ' # Express a date in other interesting forms.',
18 ' # A date entered by the user can be expressed in many new forms. ',
19 ' # See the -display param.',
20 ' # Output format is adjustable too. See the -format param.',
21 ' # When printing out all conversions (the default) the different forms are',
22 ' # labeled and occur in a fixed order.',
23 ' # When certain forms are explicitly requested (see -display), ',
24 ' # they are unlabeled and are printed in the order requested.',
25 'date,datime,time,d,t,da: list of str = $unnamed now' => \ @datimes,
26 ' # Date and time. Default to now',
27 ' # A variety of formats are recognized. An easy one: yymmdd-hhmmss.',
28 ' # Others: ',
29 ' # yy-mm-ddThh-mm-s, yyddd, yydddhhmmss, unix time, ',
30 ' # plus variations of these using different separators. There is ',
31 ' # a fair degree of flexiibility, but the order must always be',
32 ' # year, month, day -- or year, day -- with optional hour, minute,',
33 ' # seconds, and optional zulu ("Z") indicator.',
34 ' # Full or modified julian days are also legal.',
35 ' # Single or multiple date/times may be listed on the command line',
36 ' # when *not* using the -date parameter.',
37 'events,evs,ev: switch' => \ $do_events,
38 ' # Include event information in output',
39 'display,disp,dsp,what,w: list of str = all' => \ @what,
40 ' # What to display. One or more values or "all"',
41 ' # Do all by default',
42 ' # unix,u = UNIX time: seconds since 1970-1-1 0Z',
43 ' # et = Ephemeris time',
44 ' # local,l = local date and time',
45 ' # utc,z = UTC date and time',
46 ' # jday,jd = Julian Day',
47 ' # tjday,tjd = Terrestrial Dynamical Julian Day',
48 ' # mjd = Modified Julian Day',
49 ' # plan = plan time stamp',
50 ' # msn_elap,elap = mission elapsed time',
51 ' # msn_day,day = mission day number',
52 ' # Also available if -events and/or a scanID is specified',
53 ' # events,evs = bracketing events',
54 ' # annealutc,anneal= prior anneal time (only those in the event file)',
55 ' # annealdt = prior anneal time (only those in the event file)',
56 ' # scanid,scan = scan ID',
57 ' # scanutc0,scan0 = encompassing scan start time',
58 ' # scanutc1,scan1 = encompassing scan end time',
59 ' # scandur = scan duration',
60 ' # frameid,fid = approximate frame ID',
61 ' # orbit,orb = orbit number',
62 'date_format,format,datefmt,fmt,f: str = full' => \ $fmt,
63 ' # Display date/time strings in a paticular format',
64 ' # Available: full (default), compact, yyddd, yd, ydh',
65 ' # full,f = e.g. Sun_2003/02/09(040)_00:00:00Z',
66 ' # compact,c = e.g. 030214_214243Z',
67 ' # yyddd,yd = e.g. 03040',
68 ' # ydhms,ydh = e.g. 03040123456',
69 'record_format,recfmt,rec: list of 1 names (line,csv,kv,kvline,tbl)'
70 => \@recfmt,
71 ' # For record output, what format to use',
72 ' # - If not specified and -what is "all", use a maximally descriptive, '.
73 'human readable format',
74 ' # - Defaults to "line" (see below) if -what has elements other than "all"',
75 ' # - line = one value per line, unlabelled',
76 ' # - kvline = one value per line in a key=value format',
77 ' # - kv = all on one line in a key=value comma-separated format',
78 ' # - csv = all on one line in an unlabelled CSV format',
79 ' # - tbl = IPAC table format output (all column types = "c")',
80 'local,loc: switch' => \ $local,
81 ' # Assume no TZ indicator means local time',
82 ' # This is so we can make a gloal decision to always use zulu time.',
83 ' # Zulu time is indicated on a case-by-case basis by appending "z"',
84 ' # to the date/time time string.',
85 'unit,u: list of 1 named (plan,et,vtc)' => \ @unit,
86 ' # Time unit string. Usually unnecessary, but some time formats overlap',
87 'search_event,searchev,sevent,sev: str' => \ $search_ev,
88 ' # A 2nd time is read and the named event is searched for between the times',
89 'search_dt,searchdt,sdt,dt: dbl' => \ $search_dt,
90 ' # Search time step',
91 'tick: switch' => \ $tick,
92 ' # Sleep between dt steps and use current time',
93 'mos_dir, mosdir, mosd: str = %ref_dir%/mos',
94 'naif_dir,naifdir,naifd: file = %mos_dir%/naif',
95 'spk_files,spkfiles: list file (glob) = %naif_dir%/[0-9]*/*.bsp',
96 'clk_base,clkbase: str = wise',
97 'sclk_file,sclk,tsc: file = %naif_dir%/%clk_base%.tsc',
98 'event_base,eventbase,evbase: str = events',
99 'event_dir,eventdir,eventd: file = %mos_dir%/events',
100 'event_file,eventf: file =%event_dir%/%event_base%.tbl',
101 'options,opts: map (scid,launcht,sep)'.
102 '= scid=-163,launcht=2009-11-02T00-00-00Z' => \ %opts,
103 'verbose,v: switch' => \ $verbose,
104 'debug,dbg: str = 0' => \ $dbg,
105 '$include_defs basic({only=>[qw/data_root ref_sub_dir ref_dir/]})',
106 ]
10730.003300.00110 );
108
10933.7e-51.2e-5use IO::Handle;
# spent 103µs making 1 call to Exporter::import
110
11130.020530.00684use WISE::Ingest;
# spent 115ms making 1 call to WISE::Ingest::import
112
11316.3e-56.3e-5my %known = map {$_=>1} qw/all
114 unix u local l utc z et
115 jday jd mjd plan
116 msn_elap elap msn_day day
117 scanid scan scanutc0 scan0 scanutc1 scan1 scandur
118 events evs annealdt annealutc anneal frameid fid
119 searchev sev searchutc sutc searchdt sdt searchdur sdur
120 /;
121
12215.0e-65.0e-6die "*** Unknown display codes found.\n"
123 if grep ! $known{$_} && warn("*** Display code '$_' not recognized.\n"), @what;
124
125100my %what;
12611.0e-51.0e-5@what{map {lc $_} @what} = (1) x scalar(@what);
127
12811.0e-61.0e-6my (%fmt);
12911.9e-51.9e-5if( $fmt =~ /^c(ompact)?$/i) { %fmt = (compact=>1, daynum=>0, notime=>0); }
130elsif($fmt =~ /^y?ydd?d?$/i) { %fmt = (compact=>1, daynum=>1, notime=>1); }
131elsif($fmt =~ /^ydh(ms)?$/i) { %fmt = (compact=>1, daynum=>1, notime=>0); }
132elsif($fmt =~ /^f(ull)?$/i) { %fmt = (compact=>0, daynum=>0, notime=>0); }
133else {
134 die "*** Format '$fmt' not recognized.\n";
135}
136
13711.0e-61.0e-6$do_events ||= $search_ev;
13811.0e-61.0e-6$search_dt ||= 11 if $search_ev;
13911.0e-61.0e-6$search_dt ||= 10 if $tick;
14011.0e-61.0e-6$verbose ||= $dbg;
141
14212.0e-62.0e-6my $recfmt = $recfmt[0] // ($what{all} ? 'full' : 'line');
143
14411.0e-61.0e-6my $zulu = ! $local;
145
14613.2e-53.2e-5my $naif = WISE::Ingest::NAIF->new({
# spent 44.9ms making 1 call to WISE::Ingest::NAIF::new
147 verbose => $verbose,
148 scid => $opts{scid},
149 tls => $pvals{lsk_file},
150 tsc => $pvals{sclk_file},
151 bc => 0,
152 bsp => 0,
153 pbsp => 0,
154 pbsp => 0,
155 });
156
15711.4e-51.4e-5my $msn_t0 = WISE::Time::Str_time($opts{launcht},{z=>1}); # Launch time
# spent 172µs making 1 call to WISE::Time::Str_time
15813.0e-63.0e-6(my $launchday = $opts{launcht}) =~ s/T.*/00:00:00Z/;
15911.5e-51.5e-5my $msn_day0 = WISE::Time::Str_time($launchday,{z=>1}); # Launch day start
# spent 72µs making 1 call to WISE::Time::Str_time
160
161
16211.0e-61.0e-6$unit[0] ||= "";
163100my $ticks;
164100my $secs;
16511.0e-61.0e-6my (@cols,@outrecs);
166
167100my $events;
168100my %scanix;
169
17093.2e-53.6e-6if($search_dt) {
171 die "$err: Too many times for search range.\n" if @datimes != 2;
172 my ($start_dat,$end_dat) = @datimes;
173 my $start_secs = dat_to_secs($start_dat,$unit[0]);
# spent 2.07s making 1 call to main::dat_to_secs
174 my $end_secs = dat_to_secs($end_dat,$unit[0],$start_secs);
# spent 270µs making 1 call to main::dat_to_secs
175 print "Found start/end date=$start_dat/$end_dat, secs=$start_secs/$end_secs ...\n"
176 if $verbose;
177 my $t = $start_secs;
178 @datimes = ();
179 while($t <= $end_secs) {
180316500.031601.0e-6 push @datimes,$tick ? 'now' : $t;
181 $t += $search_dt;
182 }
183}
184
18511.0e-61.0e-6print "\n" if $verbose;
186
187100my $lastfound_et;
18812.0e-62.0e-6my $i = 0;
189
19014.0e-64.0e-6for my $dat (@datimes) {
1912533201.325835.2e-6 my $dat0 = $dat;
192 my ($unit,$is_scan);
193
194 ($secs,$dat,$unit,$is_scan) = dat_to_secs($dat,$unit[0]);
# spent 1.10s making 15825 calls to main::dat_to_secs, avg 70µs/call
195
196 my $local = WISE::Time::Time_str($secs,{local=>1,dp=>3,%fmt});
# spent 1.22s making 15825 calls to WISE::Time::Time_str, avg 77µs/call
197 my $utc = WISE::Time::Time_str($secs,{z=>1,dp=>3,%fmt});
# spent 1.05s making 15825 calls to WISE::Time::Time_str, avg 66µs/call
198 #my $yywww = sunday_yywww($secs) || -1;
199 #my $sunday = ($yywww>=0 && Time_str(Str_time($yywww),{z=>1,%fmt})) || "?";
200 my $mjd = WISE::Time::Time_str($secs,{mjd=>1,dp=>8});
# spent 959ms making 15825 calls to WISE::Time::Time_str, avg 61µs/call
201 my $ydt = WISE::Time::Time_str($secs,{form=>4,dp=>3});
# spent 1.26s making 15825 calls to WISE::Time::Time_str, avg 80µs/call
202 my $et = $naif->utc2et($ydt);
# spent 998ms making 15825 calls to WISE::Ingest::NAIF::utc2et, avg 63µs/call
203 my $jday = $naif->et2date($et,{fmt=>'JD'});
# spent 987ms making 15825 calls to WISE::Ingest::NAIF::et2date, avg 62µs/call
204 my $tjday = $naif->et2date($et,{fmt=>'TJD'});
# spent 891ms making 15825 calls to WISE::Ingest::NAIF::et2date, avg 56µs/call
205 my $vtc = $naif->et2vtc($et);
# spent 1.89s making 15825 calls to WISE::Ingest::NAIF::et2vtc, avg 120µs/call
206 my $plansecs = $naif->et2plan($et);
# spent 1.22s making 15825 calls to WISE::Ingest::NAIF::et2plan, avg 77µs/call
207 my $msn_elap = ($secs - $msn_t0)/86400;
208 my $msn_day = int(($secs - $msn_day0)/86400) + 1;
209
210 my $ev = get_event_info($et) if $do_events;
# spent 2.80s making 15825 calls to main::get_event_info, avg 177µs/call
211
212476870.142423.0e-6 if($search_ev) {
213 # Skip times without the names event
214 next if ! $ev;
215 my ($found_ev) = grep {lc($_->{name}) eq lc($search_ev)} @{$ev->{bevs}};
216 next if ! $found_ev;
217 next if $lastfound_et && $lastfound_et == $found_ev->{et};
218 $ev->{foundev} = $found_ev->{name};
219 $ev->{foundutc0}= $found_ev->{ydt};
220 $ev->{foundutc1}= $found_ev->{end_ydt};
221 $ev->{founddur} = sprintf("%.3f",$found_ev->{end_et}-$found_ev->{start_et})
222 if $found_ev->{end_et};
223 $ev->{founddt} = sprintf("%.3f",$et - $found_ev->{et});
224 $lastfound_et = $found_ev->{et};
225 }
226
2274500.000741.6e-6 if($recfmt eq 'full') {
228 printf("As entered: %-30s %s %s\n",
229 $dat0,($zulu && lc($dat0) ne 'now' && $dat0 !~ /z$/i
230 && ! $unit[0]
231 ? "Z" : ""),$unit[0].($unit?"/$unit":""));
232 printf("Local: %-30s\n", $local);
233 printf("UTC: %-30s\n", $utc);
234 printf("YDT: %-30s\n", $ydt);
235 printf("Julian Day: %-30s\n", $jday);
236 printf("Modified Julian Day: %-30s\n", $mjd);
237 printf("TDT Julian Day: %-30s\n", $tjday);
238 printf("VTC: %-30.3f\n", $vtc//"null");
239 printf("Plan seconds: %-30.3f\n", $plansecs);
240 printf("UNIX time: %-30.3f\n", $secs);
241 printf("Ephemeris time: %-30.3f\n", $et);
242 printf("Mission elapsed days: %-30.3f\n", $msn_elap);
243 printf("Mission day: %-30.f\n", $msn_day);
244 if($do_events) {
245 printf("Orbit: %s\n", $ev->{orbit}//'null');
246 printf("Scan ID: %s\n", $ev->{scan}//'null');
247 printf("Frame ID: %s\n", $ev->{fid}//'null');
248 printf("Scan start UTC: %s\n", $ev->{scanutc0}//'null');
249 printf("Scan start ET: %s\n", $ev->{scanet0}//'null');
250 printf("Scan end UTC: %s\n", $ev->{scanutc1}//'null');
251 printf("Scan end ET: %s\n", $ev->{scanet1}//'null');
252 printf("Scan duration: %s\n", $ev->{scandur}//'null');
253 printf("Enclosing events: %s\n", $ev->{evnamestr});
254 printf("Anneal UTC: %s\n", $ev->{annealutc}//'null');
255 printf("Anneal dt: %s\n", $ev->{annealdt}//'null');
256 if($search_ev) {
257 printf("Search event: %s\n", $ev->{foundev}//'null');
258 printf("Search UTC: %s\n", $ev->{foundutc0}//'null');
259 printf("Search UTC: %s\n", $ev->{foundutc1}//'null');
260 printf("Search dur: %s\n", $ev->{founddur}//'null');
261 printf("Search dt: %s\n", $ev->{founddt}//'null');
262 }
263 }
264 } else {
265 my @outvals;
266 my @outnames;
267 if($what{all} || $what{unix} || $what{u} ) { push @outvals,$secs; push @outnames, 'unix'; }
268 if($what{all} || $what{et}) { push @outvals,$et; push @outnames, 'et'; }
269 if($what{all} || $what{local} || $what{l} ) { push @outvals,$local; push @outnames, 'local'; }
270 if($what{all} || $what{utc} || $what{z} ) { push @outvals,$ydt; push @outnames, 'utc'; }
271 if($what{all} || $what{jday} || $what{jd} ) { push @outvals,$jday; push @outnames, 'jday'; }
272 if($what{all} || $what{tjday} || $what{tjd}) { push @outvals,$tjday; push @outnames, 'tjday'; }
273 if($what{all} || $what{mjd} ) { push @outvals,$mjd; push @outnames, 'mjd'; }
274 if($what{all} || $what{plan} ) { push @outvals,$plansecs; push @outnames, 'plan'; }
275 if($what{all} || $what{mission_elap} || $what{elap} ) { push @outvals,$msn_elap; push @outnames, 'msn_elap'; }
276 if($what{all} || $what{mission_day} || $what{day} ) { push @outvals,$msn_day; push @outnames, 'msn_day'; }
2772700.000431.6e-6 if($do_events) {
278 if($what{all} || $what{orbit} || $what{orb} ) { push @outvals,$ev->{orbit}; push @outnames, 'orbit'; }
279 if($what{all} || $what{scan} || $what{scanid} ) { push @outvals,$ev->{scan}; push @outnames, 'scan'; }
280608.0e-51.3e-6 if($what{all} || $what{frameid} || $what{fid} ) { push @outvals,$ev->{fid}; push @outnames, 'frameid'; }
281 if($what{all} || $what{scan0} || $what{scanutc0} ) { push @outvals,$ev->{scanutc0}; push @outnames, 'scanutc0'; }
282 if($what{all} || $what{scan1} || $what{scanutc1} ) { push @outvals,$ev->{scanutc1}; push @outnames, 'scanutc1'; }
283 if($what{all} || $what{scandur} || $what{dur} ) { push @outvals,$ev->{scandur}; push @outnames, 'scandur'; }
284 if($what{all} || $what{events} || $what{evs} ) { push @outvals,$ev->{evnamestr}; push @outnames, 'events'; }
285 if($what{all} || $what{annealutc} || $what{anneal} ) { push @outvals,$ev->{annealutc}; push @outnames, 'annealutc'; }
286 if($what{all} || $what{annealdt} || $what{dtanneal} ) { push @outvals,$ev->{annealdt}; push @outnames, 'annealdt'; }
287 }
2881200.000221.8e-6 if($search_ev) {
289607.1e-51.2e-6 if($what{all} || $what{searchev} || $what{sev} ) { push @outvals,$ev->{foundev}; push @outnames, 'searchev'; }
290605.7e-59.5e-7 if($what{all} || $what{searchutc} || $what{sutc} ) { push @outvals,$ev->{foundutc0}; push @outnames, 'searchutc'; }
291 if($what{all} || $what{searchdt} || $what{sdt} ) { push @outvals,$ev->{founddt}; push @outnames, 'searchdt'; }
292607.1e-51.2e-6 if($what{all} || $what{searchdur} || $what{sdur} ) { push @outvals,$ev->{founddur}; push @outnames, 'searchdur'; }
293 }
294600.000761.3e-5 if($recfmt eq 'line') {
295 print "$_\n" for @outvals;
296 } elsif($recfmt eq 'csv') {
297 print join($opts{sep}//",",map { $_//"null" } @outvals),"\n";
298 } elsif($recfmt eq 'kv') {
299 print join($opts{sep}//",", map { "$outnames[$_]=".($outvals[$_]//"null") } 0..$#outvals),"\n";
300 } elsif($recfmt eq 'kvline') {
301 print join("\n", map { "$outnames[$_]=".($outvals[$_]//'null') } 0..$#outvals),"\n";
302 } else { # table format
303 @cols = @outnames;
304 push @outrecs, { map { ($outnames[$_]=>$outvals[$_]) } 0..$#outvals };
305 }
306 }
307
308 print "\n" if @datimes>1 && $recfmt =~ /^line|full/;
309
310 ++$i;
311
312 sleep $search_dt if $tick;
313
314} # @datimes
315
31614.8e-54.8e-5if(@outrecs) {
# spent 4.62ms making 1 call to WISE::IPACTbl::data # spent 2.53ms making 1 call to WISE::IPACTbl::new
317 # Write the results in an IPAC table format
318 WISE::IPACTbl->new("-","w",{meta=>{names=>\@cols,types=>[("c")x@cols]},
319 data=>\@outrecs})->data(\@outrecs);
320}
321
322# Not used
323
324# From Eclipse web site on historical delta-T values: 1961-1986
325# http://eclipse.gsfc.nasa.gov/SEhelp/deltatpoly2004.html
326#sub ls {
327# my $t = shift; # fractional year
328# $t -= 1975;
329# return 45.45 + 1.067*$t - $t**2/260 - $t**3 / 718;
330#}
331
332
# spent 2.02s (209ms+1.82) within main::load_events which was called # once (209ms+1.82s) by main::dat_to_secs at line 366
sub load_events {
333 # We need event info
33450.009920.00198 my%scanix;
335 my $events = WISE::Ingest::Seq::PEF->new($pvals{event_file},
# spent 1.82s making 1 call to WISE::Ingest::Seq::PEF::new
336 {from_tbl => 1,
337 naif => $naif,
338 verbose => $pvals{verbose},
339 debug => $pvals{debug},
340 })
341 or die "$err: Unable to load event table '$pvals{event_file}'.\n";
342 my $tbl = $events->event_tbl();
# spent 42µs making 1 call to WISE::Ingest::Seq::PEF::event_tbl
343 # Scan event table and build a scan index
344 for (@$tbl) {
345499050.199044.0e-6 next if ! $_->{scan_id} || $_->{name} !~ /^SCAN|ASCE|DESC$/;
346 $scanix{$_->{scan_id}} = $_;
347 }
348 return ($events,%scanix);
349}
350
351
# spent 3.17s (455ms+2.72) within main::dat_to_secs which was called 15827 times, avg 200µs/call: # 15825 times (430ms+670ms) at line 194, avg 70µs/call # once (24.3ms+2.05s) at line 173 # once (59µs+211µs) at line 174
sub dat_to_secs {
3522374050.444431.9e-6 my $dat = shift;
353 my $unit = shift;
354 my $tbase = shift;
355
356 if($tbase && $dat =~ /[-+]/) {
357 $dat =~ s/s$//;
358 $dat *= 60 if $dat =~ s/m$//;
359 $dat *= 3600 if $dat =~ s/h$//;
360 $dat *= 86400 if $dat =~ s/d$//;
361 $dat += $tbase;
362 }
363
364 my $is_scan = $dat =~ /^\d{5}[a-z](?:\d{3})?(?:_(start|mid|end))?([-+]\d+(?:\.\d*)?)?$/;
365 $do_events ||= $is_scan;
366 ($events,%scanix) = load_events() if ! $events && $do_events;
# spent 2.02s making 1 call to main::load_events
367
368 $dat = time() if lc($dat) eq 'now';
369
370 if($unit eq 'plan') {
371 # Convert to UNIX time
372 my $ydt = $naif->plan2utc($dat);
373 $dat = WISE::Time::Str_time($ydt,{z=>1,dp=>8});
374 $unit = '';
375 }
376 if($unit eq 'et') {
377 my $ydt = $naif->et2utc($dat);
378 $dat = WISE::Time::Str_time($ydt,{z=>1,dp=>8});
379 $unit = '';
380 }
381 if($unit eq 'vtc') {
382 my $et = $naif->vtc2et($dat);
383 my $ydt = $naif->et2utc($et);
384 $dat = WISE::Time::Str_time($ydt,{z=>1,dp=>8});
385 $unit = '';
386 }
387
388 $dat .= $unit if $unit;
389
390180.000158.1e-6 if($is_scan) {
391 # Get scan start/stop time. Use the start time and splice in the end time
392 my ($loc,$dt,$fr);
393 ($dat,$loc,$dt) = $dat =~ /^(\d{5}[a-z](?:\d{3})?)(?:_(start|mid|end))?([-+]\d+(?:\.\d*)?)?$/;
394 $dat =~ s/(\d{3}$)// and $fr = $1;
395 $loc ||= 'start';
396 my $evrec = $scanix{$dat}
397 or warn("$warn: No scan record for '$dat'.\n"),next;
398 my $et;
399 if(! $fr) {
400 $et = $loc eq 'start'
401 ? $evrec->{start_et}
402 : $loc eq 'end'
403 ? $evrec->{end_et}
404 : ($evrec->{start_et} + $evrec->{end_et})/2;
405 } else {
406 # frnum = int(($dt-4.4)/10) + 1
407 $et = $evrec->{start_et} + ($fr - 1)*10 + 4.4;
408 $et += $loc eq 'start'
409 ? -4.4
410 : $loc eq 'end'
411 ? +4.853
412 : 0;
413 }
41422.1e-51.1e-5 if($dt) {
415 $et += $dt;
416 } else { # To make sure it is *in* a scan
417 $et += $loc eq 'start' ? .001 : $loc eq 'end' ? -.001 : 0.0;
418 }
419 $dat = $naif->et2utc($et);
# spent 22.2ms making 2 calls to WISE::Ingest::NAIF::et2utc, avg 11.1ms/call
420 }
421
422 $secs = Str_time($dat, {z=>$zulu,dp=>8,debug=>$dbg});
# spent 671ms making 15827 calls to WISE::Time::Str_time, avg 42µs/call
423
424 #warn("*** Date/time $dat (".($secs||"undef").
425 # ") is pre-1970, post 2037, or unrecognized. I can't handle it!\n"),
426 # next
427 # if ! defined($secs) || int($secs) < 0 || $secs > 2**31-1;
428
429 return wantarray ? ($secs,$dat,$unit,$is_scan) : $secs;
430}
431
432
# spent 2.80s (1.05+1.75) within main::get_event_info which was called 15825 times, avg 177µs/call: # 15825 times (1.05s+1.75s) at line 210, avg 177µs/call
sub get_event_info {
433633000.215983.4e-6 my $et = shift;
434 my ($scan,$scanutc0,$scanutc1,$scandur,$annealutc,$annealdt,
435 $bevs,@event_names,@anneal_evs,$evnamestr,$fid,$orbit,
436 $scanet0,$scanet1);
4371740750.433672.5e-6 if($do_events) {
438 $bevs = $events->find_bracketing_events($et)
# spent 1.01s making 15825 calls to WISE::Ingest::Seq::PEF::find_bracketing_events, avg 64µs/call
439 or die "$err: Can't search event table.\n";
440 @event_names = map { $_->{name} } @$bevs;
441 ($evnamestr = "@event_names") =~ s/\s+/_/g;
442 my ($scan_ev) = grep { $_->{name} eq 'SCAN' } @$bevs;
443510000.107582.1e-6 my ($orb_ev ) = grep { $_->{name} =~ /ASCE|DESC/ } @$bevs;
444 my $ev = $scan_ev || $orb_ev;
445949500.195932.1e-6 if($ev) {
446 ($scan,$scanutc0,$scanutc1,$scandur) =
447 @{$ev}{qw/scan_id start_ydt end_ydt duration/};
448 @anneal_evs = sort {$b->{et}<=>$a->{et}} @{$scan_ev->{tracked}{ANNEAL}}
449 if $scan_ev && $scan_ev->{tracked}{ANNEAL};
450 $fid = sprintf("%s%03d",$scan,int(($et-$ev->{start_et}-4.4)/10) + 1);
451 $orbit = $ev->{orbit};
452 $scanet0 = $ev->{start_et};
453 $scanet1 = $ev->{end_et};
454 }
455 # If more than one anneal event is associated with this time
456 # take the one that precedes or is in this frame
457 my $anneal_ev;
458 my $t_off = -4.853; # Subtract to get the end of frame time
459 for my $an (@anneal_evs) {
460430020.039709.2e-7 if($et-$t_off >= $an->{et}) {
461 $anneal_ev = $an;
462 last;
463 }
464 }
465284120.105083.7e-6 if($anneal_ev) {
466 $annealutc = $naif->et2utc($anneal_ev->{et});
# spent 739ms making 14206 calls to WISE::Ingest::NAIF::et2utc, avg 52µs/call
467 $annealdt = $et - $anneal_ev->{et};
468 }
469 }
470 return wantarray ? ($scan,$scanutc0,$scanutc1,$scandur,$annealutc,$annealdt,
471 $bevs,\@event_names,\@anneal_evs,$evnamestr,$fid,$orbit,
472 $scanet0,$scanet1)
473 : {scan=>$scan,scanutc0=>$scanutc0,scanutc1=>$scanutc1,
474 scandur=>$scandur,annealutc=>$annealutc,annealdt=>$annealdt,
475 bevs=>$bevs,evnames=>\@event_names,annealevs=>\@anneal_evs,
476 evnamestr=>$evnamestr,fid=>$fid,orbit=>$orbit,
477 scanet0=>$scanet0,scanet1=>$scanet1};
478}