← 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:21 2010

File/wise/base/deliv/dev/lib/perl/WISE/Ingest/NAIF.pm
Statements Executed1517352
Total Time6.51530099999041 seconds

Subroutines — ordered by exclusive time
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
124985810.818641.01762WISE::Ingest::NAIF::_isopt
47475320.722732.77003WISE::Ingest::NAIF::et2date
15825110.379201.89115WISE::Ingest::NAIF::et2vtc
15825110.285520.45006WISE::Ingest::NAIF::etordate2et
15825110.258030.99793WISE::Ingest::NAIF::utc2et
15825110.255061.08896WISE::Ingest::NAIF::sce2c
14208210.237400.76172WISE::Ingest::NAIF::et2utc
15825110.197201.22345WISE::Ingest::NAIF::et2plan
15825110.134690.13469WISE::Ingest::NAIF::tjd2plan
1110.000420.04475WISE::Ingest::NAIF::_init
1110.000100.04489WISE::Ingest::NAIF::new
1111.9e-51.9e-5WISE::Ingest::NAIF::_ticks_per_sec
00000WISE::Ingest::NAIF::BEGIN
00000WISE::Ingest::NAIF::DESTROY
00000WISE::Ingest::NAIF::body_name
00000WISE::Ingest::NAIF::ckcov_et
00000WISE::Ingest::NAIF::ckgpav
00000WISE::Ingest::NAIF::cm2llt
00000WISE::Ingest::NAIF::et2radectwist
00000WISE::Ingest::NAIF::et2radectwist_euler313
00000WISE::Ingest::NAIF::et2relpos
00000WISE::Ingest::NAIF::llt2cm
00000WISE::Ingest::NAIF::ls_may24_1968
00000WISE::Ingest::NAIF::m2q
00000WISE::Ingest::NAIF::mtxv
00000WISE::Ingest::NAIF::mxv
00000WISE::Ingest::NAIF::plan2et
00000WISE::Ingest::NAIF::plan2tjd
00000WISE::Ingest::NAIF::plan2utc
00000WISE::Ingest::NAIF::plan_epoch_jd
00000WISE::Ingest::NAIF::q2llt
00000WISE::Ingest::NAIF::q2m
00000WISE::Ingest::NAIF::recrad
00000WISE::Ingest::NAIF::sce2c_secs
00000WISE::Ingest::NAIF::sce2t
00000WISE::Ingest::NAIF::scfmt
00000WISE::Ingest::NAIF::scpart_et
00000WISE::Ingest::NAIF::sct2e
00000WISE::Ingest::NAIF::spkcov_et
00000WISE::Ingest::NAIF::str2et
00000WISE::Ingest::NAIF::tps
00000WISE::Ingest::NAIF::utc2deltat
00000WISE::Ingest::NAIF::utc2plan
00000WISE::Ingest::NAIF::vtc2et

LineStmts.Exclusive
Time		Avg.Code
1#! /usr/bin/env perl
2
339.8e-53.3e-5use strict;
# spent 21µs making 1 call to strict::import
438.1e-52.7e-5use warnings;
# spent 34µs making 1 call to warnings::import
5
6package WISE::Ingest::NAIF;
7
8use WISE::Env (
9 mod => 'WISE::Ingest::NAIF',
# spent 883µs making 1 call to WISE::Env::import
10 cfglib => '<:LIB:>',
11 version => '$Id: NAIF.pm 7763 2010-04-08 19:42:44Z tim $ ',
1239.2e-53.1e-5 );
13
1436.2e-52.1e-5use Exporter::Lite;
# spent 71µs making 1 call to Exporter::Lite::import
1536.7e-52.2e-5use vars qw(@ISA @EXPORT_OK);
# spent 70µs making 1 call to vars::import
1611.0e-61.0e-6@EXPORT_OK = ();
17
18# !!! Add spkssb_c and spkapo_c
19
20package WISE::Ingest::NAIF;
21
2232.8e-59.3e-6use WISE;
# spent 739µs making 1 call to WISE::import
2330.001150.00038use WISE::Ingest::NAIFXS;
# spent 46µs making 1 call to Exporter::import
24
2530.003890.00130use Carp qw/cluck/;
# spent 106µs making 1 call to Exporter::import
26
2711.3e-51.3e-5my ($err, $warn) = WISE::Env->err_prefix();
# spent 25µs making 1 call to WISE::Env::err_prefix
28
29
# spent 44.9ms (102µs+44.8) within WISE::Ingest::NAIF::new which was called # once (102µs+44.8ms) at line 146 of /wise/base/deliv/dev/bin/wdate
sub new {
30309.8e-53.3e-6 my $class = shift;
31 my $opts = @_ && _isopt($_[-1]) ? pop : {};
# spent 22µs making 1 call to WISE::Ingest::NAIF::_isopt
32 my $dir = shift || '/wise/fops/ref/mos/naif';
33 my $base = $opts->{base} // 'wise';
34 my $tls = $opts->{tls} // "$base.tls"; # Leap sec kernel file name
35 my $tsc = $opts->{tsc} // "$base.tsc"; # SCLK kernel file name
36 my $pbsp = $opts->{pbsp} // "$base-planets.bsp"; # Planet SPK file
37 #my $predbc = $opts->{predbc} // "$base-pred.bc"; # Predict C kernel file
38 my $bc = $opts->{bc } // "$dir/[0-9]*/*.bc"; # C kernel file names
39 my $bsp = $opts->{bsp} // "$dir/[0-9]*/*.bsp"; # S/C SPK file names
40 my $scid = $opts->{scid} || -163; # NAIF S/C ID (was -199999)
41 my $ck_scid = $opts->{ck_scid}|| $scid*1000; # C-kernel ID
42 my $ref = $opts->{ref} || "j2000"; # Frame of reference
43 my $tol = $opts->{tol} // 1280; # Clock ticks (1/256s)
44
45 $class = ref($class) || $class;
46
47 # Attach leading dir
48 $_ and ! ref($_) and ! m|^.?/| and $_ = "$dir/$_"
49 for ($tls,$tsc,$bc,$pbsp,$bsp);
5016.0e-66.0e-6 my $this = {};
51 $this->{verbose} = $opts->{verbose} || (!!$opts->{debug});
52 $this->{debug} = $opts->{debug};
53 $this->{dir} = $dir;
54 $this->{tls} = $tls;
55 $this->{tsc} = $tsc;
56 $this->{scid} = $scid;
57 $this->{ck_scid} = $ck_scid;
58 $this->{ref} = $ref;
59 $this->{tol} = $tol;
60 #$this->{predbc} = $predbc;
6133.0e-61.0e-6 if(! $opts->{tonly}) {
62 $this->{bc } = $bc;
63 $this->{pbsp} = $pbsp;
64 $this->{bsp} = $bsp;
65 }
66
67 _init($this,$opts);
# spent 44.8ms making 1 call to WISE::Ingest::NAIF::_init
68
69 $this->{tps} = _ticks_per_sec($this);
# spent 19µs making 1 call to WISE::Ingest::NAIF::_ticks_per_sec
70
71 return bless $this, $class;
72}
73
74
# spent 44.8ms (422µs+44.3) within WISE::Ingest::NAIF::_init which was called # once (422µs+44.3ms) by WISE::Ingest::NAIF::new at line 67
sub _init {
75120.000171.4e-5 my $this = shift;
76 my $opts = @_ && _isopt($_[-1]) ? pop : {};
# spent 13µs making 1 call to WISE::Ingest::NAIF::_isopt
77 my $tls = $this->{tls};
78 my $tsc = $this->{tsc};
79 my $ck = $this->{bc };
80 my $pspk = $this->{pbsp};
81 my $spk = $this->{bsp};
82 #my $predck = $this->{predbc};
83 my $report = $opts->{err_report} || "REPORT";
84
85 $this->{init} = 1;
86
87 WISE::Ingest::NAIFXS::erract_set($report);
# spent 135µs making 1 call to WISE::Ingest::NAIFXS::erract_set
88
89 for my $file ($tls,$tsc,$ck,$pspk,$spk) {
90132.9e-52.2e-6 next if ! $file;
91 next if lc($file) eq 'none';
92 if(! ref $file && $file =~ /[\[\]*?{}]/) {
93 # Glob specified
94 $file = [grep {-e} glob($file)];
95 }
96 $file = [$file] if ! ref $file;
97 for (@$file) {
98140.044540.00318 my $real = eval { Cwd::abs_path($_) } // '?';
# spent 1.44ms making 2 calls to Cwd::abs_path, avg 719µs/call
99 die "$err: NAIF file '$_' ($real) not found, not readable, or empty; ".
100 join(",",map {$_||0} (-e _ , -r _ , ! -z _))."\n"
101 if ! -e $_ || ! -r _ || -z _;
102 my $target = readlink($_) if -l $_;
103 print "Loading NAIF kernel '$_' ".($target?"(->$target) ":"").
104 "...\n" if $this->{verbose};
105 WISE::Ingest::NAIFXS::furnsh_c($_);
# spent 42.7ms making 2 calls to WISE::Ingest::NAIFXS::furnsh_c, avg 21.4ms/call
106 die "$err: NAIF file '$_' could not be loaded.\n"
# spent 18µs making 2 calls to WISE::Ingest::NAIFXS::failed_c, avg 9µs/call
107 if WISE::Ingest::NAIFXS::failed_c();
108 }
109 }
110
111 return 1;
112}
113
114sub str2et {
115 my $this = shift;
116 my $opts = @_ && _isopt($_[-1]) ? pop : {};
117 my $utc = shift;
118 cluck("$err: No time provided.\n"), return if ! defined $utc;
119 if($utc =~ /^\d+$/) {
120 # UNIX time (secs since 1970)
121 $utc = WISE::Time::Time_str($utc,{ansi=>1,gmt=>1,noz=>1});
122 }
123 my $et = WISE::Ingest::NAIFXS::str2et_c($utc);
124 return if WISE::Ingest::NAIFXS::failed_c();
125 return $et;
126}
127
128
# spent 998ms (258+740) within WISE::Ingest::NAIF::utc2et which was called 15825 times, avg 63µs/call: # 15825 times (258ms+740ms) at line 202 of /wise/base/deliv/dev/bin/wdate, avg 63µs/call
sub utc2et {
1291266000.891657.0e-6 my $this = shift;
130 my $opts = @_ && _isopt($_[-1]) ? pop : {};
# spent 91.1ms making 15825 calls to WISE::Ingest::NAIF::_isopt, avg 6µs/call
131 my $utc = shift;
132 cluck("$err: No time provided.\n"), return if ! defined $utc;
133 if($utc =~ /^\d+$/) {
134 # UNIX time (secs since 1970)
135 $utc = WISE::Time::Time_str($utc,{form=>4});
136 }
137 my $et = WISE::Ingest::NAIFXS::utc2et_c($utc);
# spent 591ms making 15825 calls to WISE::Ingest::NAIFXS::utc2et_c, avg 37µs/call
138 return if WISE::Ingest::NAIFXS::failed_c();
# spent 57.6ms making 15825 calls to WISE::Ingest::NAIFXS::failed_c, avg 4µs/call
139 return $et;
140}
141
142
# spent 762ms (237+524) within WISE::Ingest::NAIF::et2utc which was called 14208 times, avg 54µs/call: # 14206 times (237ms+502ms) by main::get_event_info at line 466 of /wise/base/deliv/dev/bin/wdate, avg 52µs/call # 2 times (86µs+22.2ms) by main::dat_to_secs at line 419 of /wise/base/deliv/dev/bin/wdate, avg 11.1ms/call
sub et2utc {
1431278720.662965.2e-6 my $this = shift;
144 my $opts = @_ && _isopt($_[-1]) ? pop : {};
# spent 80.6ms making 14208 calls to WISE::Ingest::NAIF::_isopt, avg 6µs/call
145 my $fmt = $opts->{fmt} || "ISOD";
146 my $prec= $opts->{prec} || 3;
147 my $et = shift;
148 cluck("$err: No time provided.\n"), return if ! defined $et;
149 my $utc = WISE::Ingest::NAIFXS::et2utc_c($et,$fmt,$prec);
# spent 394ms making 14208 calls to WISE::Ingest::NAIFXS::et2utc_c, avg 28µs/call
150 return if WISE::Ingest::NAIFXS::failed_c();
# spent 49.6ms making 14208 calls to WISE::Ingest::NAIFXS::failed_c, avg 3µs/call
151 return $utc;
152}
153
154
# spent 450ms (286+165) within WISE::Ingest::NAIF::etordate2et which was called 15825 times, avg 28µs/call: # 15825 times (286ms+165ms) by WISE::Ingest::NAIF::sce2c at line 191, avg 28µs/call
sub etordate2et {
155949500.280903.0e-6 my $this = shift;
156 my $opts = @_ && _isopt($_[-1]) ? pop : {};
# spent 165ms making 15825 calls to WISE::Ingest::NAIF::_isopt, avg 10µs/call
157 my $et = shift;
158 cluck("$err: No time provided.\n"), return if ! defined $et;
159 if($et !~ /^[-+]?\d+(\.\d*)?$/ || $opts->{unix}) {
160 # Convert from date/time
161 my $t = WISE::Time::Str_time($et,{z=>1}) or die;
162 my $date = WISE::Time::Time_str($t,{form=>4});
163 $et = $this->utc2et($date);
164 return if ! $et;
165 }
166 return $et;
167}
168
169
# spent 2.77s (723ms+2.05) within WISE::Ingest::NAIF::et2date which was called 47475 times, avg 58µs/call: # 15825 times (249ms+738ms) at line 203 of /wise/base/deliv/dev/bin/wdate, avg 62µs/call # 15825 times (235ms+656ms) by WISE::Ingest::NAIF::et2plan at line 604, avg 56µs/call # 15825 times (239ms+652ms) at line 204 of /wise/base/deliv/dev/bin/wdate, avg 56µs/call
sub et2date {
1704747502.228984.7e-6 my $this = shift;
171 my $opts = @_ && _isopt($_[-1]) ? pop : {};
# spent 522ms making 47475 calls to WISE::Ingest::NAIF::_isopt, avg 11µs/call
172 my $fmt = $opts->{fmt} || "YYYY-DOYTHR:MN:SC.###";
173 if($fmt eq 'JD') {
174 $fmt = "JULIAND.########";
175 }
176 if($fmt eq 'TJD') {
177 $fmt = "JULIAND.######## ::TDT";
178 }
179 my $et = shift;
180 cluck("$err: No time provided.\n"), return if ! defined $et;
181 my $utc = WISE::Ingest::NAIFXS::timout_c($et,$fmt);
# spent 1.36s making 47475 calls to WISE::Ingest::NAIFXS::timout_c, avg 29µs/call
182 return if WISE::Ingest::NAIFXS::failed_c();
# spent 162ms making 47475 calls to WISE::Ingest::NAIFXS::failed_c, avg 3µs/call
183 return $utc;
184}
185
186
# spent 1.09s (255ms+834ms) within WISE::Ingest::NAIF::sce2c which was called 15825 times, avg 69µs/call: # 15825 times (255ms+834ms) by WISE::Ingest::NAIF::et2vtc at line 250, avg 69µs/call
sub sce2c {
1871424250.591224.2e-6 my $this = shift;
188 my $opts = @_ && _isopt($_[-1]) ? pop : {};
# spent 76.7ms making 15825 calls to WISE::Ingest::NAIF::_isopt, avg 5µs/call
189 my $et = shift;
190 cluck("$err: No time provided.\n"), return if ! defined $et;
191 $et = $this->etordate2et($et,$opts);
# spent 450ms making 15825 calls to WISE::Ingest::NAIF::etordate2et, avg 28µs/call
192 print "--- sce2c: ET=$et\n" if $this->{debug};
193 my $sclkdp = WISE::Ingest::NAIFXS::sce2c_c($this->{scid},$et);
# spent 254ms making 15825 calls to WISE::Ingest::NAIFXS::sce2c_c, avg 16µs/call
194 return if WISE::Ingest::NAIFXS::failed_c();
# spent 53.0ms making 15825 calls to WISE::Ingest::NAIFXS::failed_c, avg 3µs/call
195 return $sclkdp;
196}
197
198sub sce2t {
199 my $this = shift;
200 my $opts = @_ && _isopt($_[-1]) ? pop : {};
201 my $et = shift;
202 cluck("$err: No time provided.\n"), return if ! defined $et;
203 $et = $this->etordate2et($et,$opts);
204 print "--- sce2t: ET=$et\n" if $this->{debug};
205 my $sclk = WISE::Ingest::NAIFXS::sce2t_c($this->{scid},$et);
206 return if WISE::Ingest::NAIFXS::failed_c();
207 return $sclk;
208}
209
210sub sce2c_secs {
211 my $this = shift;
212 my $opts = @_ && _isopt($_[-1]) ? pop : {};
213 my $et = shift;
214 cluck("$err: No time provided.\n"), return if ! defined $et;
215 my $sclkdp = $this->sce2c($et) or return;
216 my $sclks = $sclkdp / $this->{tps};
217 return if WISE::Ingest::NAIFXS::failed_c();
218 return $sclks;
219}
220
221sub sct2e {
222 my $this = shift;
223 my $opts = @_ && _isopt($_[-1]) ? pop : {};
224 my $sclkdp = shift;
225 cluck("$err: No time provided.\n"), return if ! defined $sclkdp;
226 my $et = WISE::Ingest::NAIFXS::sct2e_c($this->{scid},$sclkdp);
227 return if WISE::Ingest::NAIFXS::failed_c();
228 return $et;
229}
230
231sub vtc2et {
232 my $this = shift;
233 my $opts = @_ && _isopt($_[-1]) ? pop : {};
234 my $vtc = shift;
235 my $part = $opts->{part};
236 $part = length($part//'') ? "$part/" : "";
237 cluck("$err: No time provided.\n"), return if ! defined $vtc;
238 my $sclkch = sprintf("$part%010d:%03d",
239 int($vtc),int(($vtc - int($vtc))*$this->{tps}+0.5));
240 my $et = WISE::Ingest::NAIFXS::scs2e_c($this->{scid},$sclkch);
241 return if WISE::Ingest::NAIFXS::failed_c();
242 return $et;
243}
244
245
# spent 1.89s (379ms+1.51) within WISE::Ingest::NAIF::et2vtc which was called 15825 times, avg 120µs/call: # 15825 times (379ms+1.51s) at line 205 of /wise/base/deliv/dev/bin/wdate, avg 120µs/call
sub et2vtc() {
2461582500.753684.8e-6 my $this = shift;
247 my $opts = @_ && _isopt($_[-1]) ? pop : {};
# spent 83.0ms making 15825 calls to WISE::Ingest::NAIF::_isopt, avg 5µs/call
248 my $et = shift;
249 cluck("$err: No time provided.\n"), return if ! defined $et;
250 my $sclkdp = $this->sce2c($et) or return;
# spent 1.09s making 15825 calls to WISE::Ingest::NAIF::sce2c, avg 69µs/call
251 my $clkstr = WISE::Ingest::NAIFXS::scdecd_c($this->{scid},$sclkdp);
# spent 288ms making 15825 calls to WISE::Ingest::NAIFXS::scdecd_c, avg 18µs/call
252 return if WISE::Ingest::NAIFXS::failed_c();
# spent 52.0ms making 15825 calls to WISE::Ingest::NAIFXS::failed_c, avg 3µs/call
253 my ($f1,$f2) = $clkstr =~ m|(\d+):(\d+)|;
254 my $vtc = $f1 + $f2/$this->{tps};
255 return $vtc;
256}
257
258sub tps {
259 my $this = shift;
260 return $this->{tps};
261}
262
263sub et2radectwist {
264 my $this = shift;
265 my $opts = @_ && _isopt($_[-1]) ? pop : {};
266 my $et = shift;
267 my $verbose = $opts->{verbose};
268 my $alt = $opts->{alt};
269 cluck("$err: No time provided.\n"), return if ! defined $et;
270 print "Et2radectwist: input time = $et\n" if $verbose;
271 if($et !~ /^[-+]?\d+(\.\d*)?$/) {
272 # Convert from date/time
273 $et = $this->utc2et($et);
274 print "Et2radectwist: converted ET = $et\n" if $verbose;
275 return if ! $et;
276 }
277 my $sct;
278 if(! $opts->{et_is_sct}) {
279 $sct = $this->sce2c($et) or return;
280 print "Et2radectwist: converted SCT = $sct\n" if $verbose;
281 } else {
282 $sct = $et;
283 }
284 my ($found,$cmat,$av,$clkout) = $this->ckgpav($sct,$opts);
285 warn("$err: Time not found in ckgpav; SCT=$sct, ET=$et\n"),return
286 if ! $found;
287 return if WISE::Ingest::NAIFXS::failed_c();
288 my @q = $this->m2q($cmat);
289 print "Et2radectwist: Quaternion = @q\n" if $verbose;
290 my @avb = $this->mxv($cmat,$av);
291 my ($ra,$dec,$twist) = $this->q2llt(\@q,$opts);
292 return if WISE::Ingest::NAIFXS::failed_c();
293 print "Et2radectwist: RA,Dec,Twist = $ra,$dec,$twist\n" if $verbose;
294 return ($ra,$dec,$twist,@q);
295}
296
297sub et2radectwist_euler313 {
298 my $this = shift;
299 my $opts = @_ && _isopt($_[-1]) ? pop : {};
300 my $et = shift;
301 my $verbose = $opts->{verbose};
302 cluck("$err: No time provided.\n"), return if ! defined $et;
303 print "Et2radectwist_euler313: input time = $et\n" if $verbose;
304 if($et !~ /^[-+]?\d+(\.\d*)?$/) {
305 # Convert from date/time
306 $et = $this->utc2et($et);
307 print "Et2radectwist_euler313: converted ET = $et\n" if $verbose;
308 return if ! $et;
309 }
310 my $sct;
311 if(! $opts->{et_is_sct}) {
312 if($opts->{sce2t}) {
313 print "Et2radectwist_euler313: convert using sce2t\n" if $verbose;
314 $sct = $this->sce2t($et) or return;
315 } else {
316 print "Et2radectwist_euler313: convert using sce2c\n" if $verbose;
317 $sct = $this->sce2c($et) or return;
318 }
319 print "Et2radectwist_euler313: converted SCT = $sct\n" if $verbose;
320 } else {
321 $sct = $et;
322 }
323 my ($found,$cmat,$av,$clkout) = $this->ckgpav($sct,$opts);
324 return if WISE::Ingest::NAIFXS::failed_c();
325 warn("$err: Time not found in ckgpav; SCT=$sct, ET=$et\n"),return
326 if ! $found;
327 # Pass on $opts since it may contain a xform option cm2llt needs
328 my ($ra,$dec,$twist,$rawtwist) = $this->cm2llt($cmat,$opts);
329 return if WISE::Ingest::NAIFXS::failed_c();
330 print "Et2radectwist_euler313: RA,Dec,Twist = $ra,$dec,$twist\n" if $verbose;
331 my @avb = $this->mxv($cmat,$av);
332 my $avres = ! $opts->{raw_av} ? \@avb : $av;
333 return ($ra,$dec,$twist,$avres,$rawtwist);
334}
335
336sub ckgpav {
337 my $this = shift;
338 my $opts = @_ && _isopt($_[-1]) ? pop : {};
339 my $sclkdp = shift;
340 my ($found,$cmat,$av,$clkout) =
341 WISE::Ingest::NAIFXS::ckgpav_c($this->{ck_scid},$sclkdp,
342 $opts->{tol}//$this->{tol},
343 $this->{ref});
344 if(! $found && $opts->{try_scid} &&
345 $this->{ck_scid} != $this->{scid}) {
346 ($found,$cmat,$av,$clkout) =
347 WISE::Ingest::NAIFXS::ckgpav_c($this->{scid},$sclkdp,
348 $opts->{tol}//$this->{tol},
349 $this->{ref});
350 return if WISE::Ingest::NAIFXS::failed_c();
351 }
352 return if WISE::Ingest::NAIFXS::failed_c();
353 return ($found,$cmat,$av,$clkout);
354}
355
356sub ckcov_et {
357 my $this = shift;
358 my $opts = @_ && _isopt($_[-1]) ? pop : {};
359 my $ck = shift || $this->{bc};
360 $ck = [$ck] if ! ref $ck;
361 my $ets = WISE::Ingest::NAIFXS::ckcov_c($this->{ck_scid},$ck);
362 return if WISE::Ingest::NAIFXS::failed_c();
363 my @pairs;
364 while(@$ets) {
365 push @pairs, [shift(@$ets),shift(@$ets)];
366 }
367 return @pairs;
368}
369
370sub spkcov_et {
371 my $this = shift;
372 my $opts = @_ && _isopt($_[-1]) ? pop : {};
373 my $spk = shift || $this->{bsp};
374 my $objid = $opts->{objid} || $this->{scid};
375 $spk = [$spk] if ! ref $spk;
376 my $ets = WISE::Ingest::NAIFXS::spkcov_c($objid,$spk);
377 return if WISE::Ingest::NAIFXS::failed_c();
378 my @pairs;
379 while(@$ets) {
380 push @pairs, [shift(@$ets),shift(@$ets)];
381 }
382 return @pairs;
383}
384
385sub scpart_et {
386 my $this = shift;
387 my $opts = @_ && _isopt($_[-1]) ? pop : {};
388 my $sclkfile = shift; # Optional
389 my $scs = WISE::Ingest::NAIFXS::scpart_c($this->{scid},$sclkfile);
390 warn "$err/scpart: No Partitions returned.\n"
391 if ! $scs;
392 return if WISE::Ingest::NAIFXS::failed_c() || ! $scs;
393 my @pairs;
394 while(@$scs) {
395 my ($sc0,$sc1) = (shift(@$scs),shift(@$scs));
396 my $et0 = $this->sct2e($sc0);
397 my $et1 = $this->sct2e($sc1);
398 push @pairs, [$et0, $et1];
399 }
400 return @pairs;
401}
402
403# sub scpart_et {
404# my $this = shift;
405# my $opts = @_ && _isopt($_[-1]) ? pop : {};
406# my $sclkfile = shift; # Optional
407# my $scs = WISE::Ingest::NAIFXS::scpart_c($this->{scid},$sclkfile);
408# warn "$err/scpart: No Partitions returned.\n"
409# if ! $scs;
410# return if WISE::Ingest::NAIFXS::failed_c() || ! $scs;
411# #my $nparts = @$scs/2;
412# #my $partsum = 0;
413# #for my $i (0..$nparts-1) { $partsum += $scs->[2*$i+1] - $scs->[2*$i]; }
414# #my $n = 0;
415# my @pairs;
416# while(@$scs) {
417# #++$n;
418# my ($sc0,$sc1) = (shift(@$scs),shift(@$scs));
419# #my $et0 = $this->sct2e($sc0);
420# my $et0 = $this->vtc2et($sc0/$this->{tps});
421# #if($n == $nparts && $sc1 > $partsum) {
422# # warn "$err/scpart: Using max. tick value of $partsum ".
423# # "instead of SCT $sc1 .\n";
424# # $sc1 = $partsum;
425# #}
426# #my $et1 = $this->sct2e($sc1);
427# my $et1 = $this->vtc2et($sc1/$this->{tps});
428# push @pairs, [$et0, $et1];
429# }
430# return @pairs;
431# }
432
433sub m2q {
434 my $this = shift;
435 my $opts = @_ && _isopt($_[-1]) ? pop : {};
436 my $cmat = shift;
437 return if WISE::Ingest::NAIFXS::failed_c();
438 my @q = WISE::Ingest::NAIFXS::m2q_c(@$cmat);
439 return if WISE::Ingest::NAIFXS::failed_c();
440 return @q;
441}
442
443sub q2m {
444 my $this = shift;
445 my $opts = @_ && _isopt($_[-1]) ? pop : {};
446 my $q = shift;
447 return if WISE::Ingest::NAIFXS::failed_c();
448 my @cm = WISE::Ingest::NAIFXS::q2m_c(@$q);
449 return if WISE::Ingest::NAIFXS::failed_c();
450 return @cm;
451}
452
453sub scfmt {
454 my $this = shift;
455 my $opts = @_ && _isopt($_[-1]) ? pop : {};
456 my $ticks= shift;
457 my $clkstr = WISE::Ingest::NAIFXS::scfmt_c($this->{scid},$ticks);
458 return if WISE::Ingest::NAIFXS::failed_c();
459 return $clkstr;
460}
461
462sub mxv {
463 my $this = shift;
464 my $opts = @_ && _isopt($_[-1]) ? pop : {};
465 my $cmat = shift;
466 my $v = shift;
467 my @vo = WISE::Ingest::NAIFXS::mxv_c(@$cmat,@$v);
468 return if WISE::Ingest::NAIFXS::failed_c();
469 return @vo;
470}
471
472sub mtxv {
473 my $this = shift;
474 my $opts = @_ && _isopt($_[-1]) ? pop : {};
475 my $cmat = shift;
476 my $v = shift;
477 my @vo = WISE::Ingest::NAIFXS::mtxv_c(@$cmat,@$v);
478 return if WISE::Ingest::NAIFXS::failed_c();
479 return @vo;
480}
481
482sub recrad {
483 my $this = shift;
484 my $opts = @_ && _isopt($_[-1]) ? pop : {};
485 my $v = shift;
486 my ($lon,$lat,$rad)=WISE::Ingest::NAIFXS::recrad_deg(@$v);
487 return if WISE::Ingest::NAIFXS::failed_c();
488 return ($lon,$lat,$rad);
489}
490
491sub q2llt {
492 my $this = shift;
493 my $opts = @_ && _isopt($_[-1]) ? pop : {};
494 my $alt = $opts->{alt};
495 my $q = shift;
496 my ($lon,$lat,$twist);
497 if(! $alt) {
498 ($lon,$lat,$twist)=WISE::Ingest::NAIFXS::q2llt(@$q);
499 } else {
500 # Alternative, experimental version
501 ($lon,$lat,$twist)=WISE::Ingest::NAIFXS::q2llt_test(@$q);
502 }
503 return if WISE::Ingest::NAIFXS::failed_c();
504 return ($lon,$lat,$twist);
505}
506
507# Rotation matrix to lon,lat,twist
508# (This is the one we're using right now.)
509sub cm2llt {
510 my $this = shift;
511 my $opts = @_ && _isopt($_[-1]) ? pop : {};
512 my $cm = shift;
513 my @t = @{ $opts->{xform} || [] };
514 my ($lon,$lat,$twist);
515 ($lon,$lat,$twist)=WISE::Ingest::NAIFXS::cm2euler313llt(@$cm);
516 my $rawtwist = $twist;
517 return if WISE::Ingest::NAIFXS::failed_c();
518 if(@t) {
519 # Adjust twist to conform to a transform (flipped/rotated) image
520 warn("$err/cm2llt: Transform doesn't have 4 elements; @t.\n"),return
521 if @t != 4;
522 # !!! These are still somewhat questionable.
523 # !!! This is the old way that matches the Ned sim and is
524 # !!! surely wrong and incomplete.
525 #if($t[1]!=0 || $t[2]!=0) { $twist = 90-$twist; } # swap x/y
526 #if($t[0]< 0 || $t[1] <0) { $twist = 180-$twist; } # flip x-axis
527 #if($t[2]< 0 || $t[3] <0) { $twist = 360-$twist; } # flip y-axis
528 # New way. Results are off from above; old = new + 180.
52930.001860.00062 use WISE::CoUtils ('$R2D');
# spent 181µs making 1 call to Exporter::import
530 my ($x,$y) = (-sin($twist/$R2D), cos($twist/$R2D));
531 my $xp = $x*$t[0] + $y*$t[1];
532 my $yp = $x*$t[2] + $y*$t[3];
533 my $twistp = atan2(-$xp, $yp)*$R2D;
534 $twist = $twistp;
535 }
536 $twist -= 360 if $twist > 360;
537 $twist += 360 if $twist < 0;
538 return ($lon,$lat,$twist,$rawtwist);
539}
540
541# Rotation matrix to lon,lat,twist
542# (This is the on we're using right now.)
543sub llt2cm {
544 my $this = shift;
545 my $opts = @_ && _isopt($_[-1]) ? pop : {};
546 my ($lon,$lat,$twist) = (shift,shift,shift);
547 my @t = @{ $opts->{xform} || [] };
548 my $rawtwist = $twist;
549 if(@t) {
550 warn("$err/llt2cm: Transform doesn't have 4 elements; @t.\n"),return
551 if @t != 4;
552 # !!! These are still somewhat questionable.
553 # !!! This is the old way that matches the Ned sim and is
554 # !!! surely wrong and incomplete.
555 if($t[1]!=0 || $t[2]!=0) { $rawtwist = $twist+90; } # swap x/y
556 if($t[0]< 0 || $t[1] <0) { $rawtwist = $twist+180; } # flip x-axis
557 if($t[2]< 0 || $t[3] <0) { $rawtwist = $twist+360; } # flip y-axis
558 } else {
559 $rawtwist = $twist;
560 }
561 my @cm = WISE::Ingest::NAIFXS::euler313llt2cm($lon,$lat,$rawtwist);
562 return if WISE::Ingest::NAIFXS::failed_c();
563 return @cm;
564}
565
56611.0e-61.0e-6my $plan_epoch_jd = 2440000.5;
56711.0e-61.0e-6my $ls_may24_1968 = 38.66;
568
569sub plan_epoch_jd {
570 my $this = shift;
571 return $plan_epoch_jd;
572}
573
574sub ls_may24_1968 {
575 return $ls_may24_1968;
576}
577
578sub plan2tjd {
579 my $this = shift;
580 my $t = shift;
581 cluck("$err: No time provided.\n"), return if ! defined $t;
582 return $plan_epoch_jd + ($t + $ls_may24_1968)/(24*3600);
583}
584
585
# spent 135ms within WISE::Ingest::NAIF::tjd2plan which was called 15825 times, avg 9µs/call: # 15825 times (135ms+0) by WISE::Ingest::NAIF::et2plan at line 605, avg 9µs/call
sub tjd2plan {
586633000.089181.4e-6 my $this = shift;
587 my $tjd = shift;
588 cluck("$err: No time provided.\n"), return if ! defined $tjd;
589 return ($tjd - $plan_epoch_jd)*(24*3600) - $ls_may24_1968;
590}
591
592sub plan2et {
593 my $this = shift;
594 my $t = shift;
595 cluck("$err: No time provided.\n"), return if ! defined $t;
596 my $tjd = plan2tjd($this, $t);
597 return WISE::Ingest::NAIFXS::str2et_c("JD$tjd TDT");
598}
599
600
# spent 1.22s (197ms+1.03) within WISE::Ingest::NAIF::et2plan which was called 15825 times, avg 77µs/call: # 15825 times (197ms+1.03s) at line 206 of /wise/base/deliv/dev/bin/wdate, avg 77µs/call
sub et2plan {
601791250.230722.9e-6 my $this = shift;
602 my $t = shift;
603 cluck("$err: No time provided.\n"), return if ! defined $t;
604 my $tjd = et2date($this,$t,{fmt=>"TJD"});
# spent 892ms making 15825 calls to WISE::Ingest::NAIF::et2date, avg 56µs/call
605 return tjd2plan($this,$tjd);
# spent 135ms making 15825 calls to WISE::Ingest::NAIF::tjd2plan, avg 9µs/call
606}
607
608sub plan2utc {
609 my $this = shift;
610 my $t = shift;
611 my $opts = shift || {};
612 cluck("$err: No time provided.\n"), return if ! defined $t;
613 return et2utc($this,plan2et($this,$t),$opts);
614}
615
616sub utc2plan {
617 my $this = shift;
618 my $utc = shift;
619 my $opts = shift || {};
620 return et2plan($this,utc2et($this,$utc));
621}
622
623sub utc2deltat {
624 my $this = shift;
625 my $utc = shift;
626 cluck("$err: No time provided.\n"), return if ! defined $utc;
627 my $et = WISE::Ingest::NAIFXS::utc2et_c($utc);
628 return WISE::Ingest::NAIFXS::deltet_c($et,"ET");
629}
630
631sub body_name {
632 my $this = shift;
633 my $targ = shift;
634 my ($name,$code,$found);
635 $targ = $this->{scid} if $targ =~ /^wise$/i;
636 if($targ !~ /^[-+]?\d+$/) {
637 if($targ !~ /sun|mercury|venus|earth|moon|mars|barycenter/i) {
638 $targ = uc "$targ barycenter";
639 }
640 my $tmp = $targ;
641 ($code,$found) = WISE::Ingest::NAIFXS::bodn2c_c($targ);
642 warn("$err: Body '$tmp' not found.\n"),return if ! $found;
643 return if WISE::Ingest::NAIFXS::failed_c();
644 } else {
645 $code = $targ;
646 }
647 if($code == $this->{scid}) {
648 $name = 'WISE';
649 } else {
650 ($name,$found) = WISE::Ingest::NAIFXS::bodc2n_c($code);
651 warn("$err: Body code '$code' not found.\n"),return if ! $found;
652 return if WISE::Ingest::NAIFXS::failed_c();
653 }
654 return wantarray ? ($name,$code) : $name;
655}
656
657sub et2relpos {
658 my $this = shift;
659 my $et = shift; # Ephemerous time (secs) or character UTC date/time
660 my $targ = shift; # Target; name or NAIF ID
661 my $obs = shift; # Observer; name or NAIF ID
662 my $opts = shift || {};
663 my $ref = $opts->{ref} || $this->{ref} || 'j2000';
664 my $ab = $opts->{ab} || $this->{ab} || 'none';
665 my $au = $opts->{au}; # Use AU and AU/day units rather than km & km/s
666 my ($earthid) = WISE::Ingest::NAIFXS::bodn2c_c("earth");
667 my $etorig = $et;
668 my $found;
669 cluck("$err: No time provided.\n"), return if ! defined $et;
670 $et = $this->etordate2et($et,$opts);
671 $targ = $this->{scid} if $targ =~ /wise/i;
672 $obs = $this->{scid} if $obs =~ /wise/i;
673 if($targ !~ /^[-+]?\d+$/) {
674 if($targ !~ /sun|mercury|venus|earth|moon|mars|barycenter/i) {
675 $targ = uc "$targ barycenter";
676 }
677 my $tmp = $targ;
678 ($targ,$found) = WISE::Ingest::NAIFXS::bodn2c_c($targ);
679 warn("$err: Object '$tmp' not found.\n"),return if ! $found;
680 return if WISE::Ingest::NAIFXS::failed_c();
681 }
682 if($obs !~ /^[-+]?\d+$/) {
683 if($obs !~ /sun|mercury|venus|earth|moon|mars|barycenter/i) {
684 $obs = uc "$obs barycenter";
685 }
686 my $tmp = $obs;
687 ($obs,$found) = WISE::Ingest::NAIFXS::bodn2c_c($obs);
688 warn("$err: Object '$tmp' not found.\n"),return if ! $found;
689 return if WISE::Ingest::NAIFXS::failed_c();
690 }
691 print "et2relpos: ET=$et ($etorig) TARG=$targ, OBS=$obs\n"
692 if $opts->{verbose};
693 my ($lt,$state);
694 if(($targ == $this->{scid} && $obs != $earthid) ||
695 ($obs == $this->{scid} && $targ != $earthid)) {
696 # WISE S/C must be relative to Earth; compute info relative
697 # to Earth, then propagate from there by adding vectors
698 my ($targ2,$obs2);
699 # S/C to/from Earth
700 ($targ2,$obs2) = ($targ,$obs);
701 $targ2 = $earthid if $targ != $this->{scid};
702 $obs2 = $earthid if $obs != $this->{scid};
703 my $wise = $this->et2relpos($et,$targ2,$obs2,{%$opts,au=>0}) or return;
704 # Earth to/from desired object
705 ($targ2,$obs2) = ($targ,$obs);
706 $targ2 = $earthid if $targ == $this->{scid};
707 $obs2 = $earthid if $obs == $this->{scid};
708 my $obj = $this->et2relpos($et,$targ2,$obs2,{%$opts,au=>0}) or return;
709 # Compute combined relative vectors
710 $state = [map {$wise->{state}[$_]+$obj->{state}[$_]} 0..5];
711 } else {
712 ($lt,$state) = WISE::Ingest::NAIFXS::spkez_c($targ,$et,$ref,$ab,$obs);
713 }
714 return if ! $state || WISE::Ingest::NAIFXS::failed_c();
715 my @pos = WISE::Ingest::NAIFXS::recrad_deg(@{$state}[0..2]);
716 return if ! @pos || WISE::Ingest::NAIFXS::failed_c();
717 # Recompute light travel time in case we went through the WISE S/C
718 # branch or changed units
719 $lt = $pos[2]/WISE::Ingest::NAIFXS::clight_c();
720 if($au) {
721 # Convert units
722 my $au_km = WISE::Ingest::NAIFXS::convrt_c(1,"km","au");
723 my $s_day = WISE::Ingest::NAIFXS::spd_c();
724 $_ *= $au_km for @{$state}[0..2];
725 $_ *= $au_km*$s_day for @{$state}[3..5];
726 $pos[2] *= $au_km;
727 $lt /= $s_day;
728 }
729 print "et2relpos: Lon,lat=$pos[0],$pos[1], R=$pos[2], LT=$lt\n"
730 if $opts->{verbose};
731 return wantarray ? (@pos) : {state=>$state, lt=>$lt,
732 lon=>$pos[0], lat=>$pos[1], r=>$pos[2]};
733}
734
735
# spent 19µs within WISE::Ingest::NAIF::_ticks_per_sec which was called # once (19µs+0) by WISE::Ingest::NAIF::new at line 69
sub _ticks_per_sec {
73658.0e-61.6e-6 my $this = shift;
737 my $opts = @_ && _isopt($_[-1]) ? pop : {};
738 my $tps;
739 #my $t0 = sce2c($this,1);
740 #return if WISE::Ingest::NAIFXS::failed_c();
741 #my $t1 = sce2c($this,2);
742 #return if WISE::Ingest::NAIFXS::failed_c();
743 #$tps = $t1 - $t0;
744 $tps = 256;
745 return $tps;
746}
747
748
# spent 1.02s (819ms+199ms) within WISE::Ingest::NAIF::_isopt which was called 124985 times, avg 8µs/call: # 47475 times (372ms+150ms) by WISE::Ingest::NAIF::et2date at line 171, avg 11µs/call # 15825 times (116ms+49.0ms) by WISE::Ingest::NAIF::etordate2et at line 156, avg 10µs/call # 15825 times (91.1ms+0) by WISE::Ingest::NAIF::utc2et at line 130, avg 6µs/call # 15825 times (83.0ms+0) by WISE::Ingest::NAIF::et2vtc at line 247, avg 5µs/call # 15825 times (76.7ms+0) by WISE::Ingest::NAIF::sce2c at line 188, avg 5µs/call # 14208 times (80.6ms+0) by WISE::Ingest::NAIF::et2utc at line 144, avg 6µs/call # once (16µs+6µs) by WISE::Ingest::NAIF::new at line 31 # once (10µs+3µs) by WISE::Ingest::NAIF::_init at line 76
sub _isopt {
7492499700.733812.9e-6 my $r = @_ ? shift : $_;
750 return ref($r)=~/hash/i && ! UNIVERSAL::isa($r,__PACKAGE__);
# spent 199ms making 63302 calls to UNIVERSAL::isa, avg 3µs/call
751}
752
753sub DESTROY {
754 my $this = shift;
755 WISE::Ingest::NAIFXS::kclear_c();
756}
757
75817.0e-67.0e-61;

Report produced by the NYTProf 2.07 Perl profiler, developed by Tim Bunce and Adam Kaplan.