开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 图形图像 > OpenGL > 查看源码
spectbins.pl
资源名称：celestia-1.6.0.tar.gz　[点击查看]
上传用户：center1979
上传日期：2022-07-26
资源大小：50633k
文件大小：19k
源码类别：

OpenGL

开发平台：

Visual C++

spectbins.pl：源码内容
  1. #!/usr/bin/perl
  2. # Author: Fridger.Schrempp@desy.de
  3. use Math::Libm ':all';
  5. open(ELMTS, ">spectbins.stc") || die "Can not create spectbins.stcn";
  6. # boilerplate
  7. ($ver = "Revision: 1.6.0 ") =~ s/$//g;
  8. ($me = $0) =~ s/.*///;
  9. ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime;
  10. $year += 1900;
  11. $mon += 1;
  12. print ELMTS "# ---------------------------------------------n";
  13. print ELMTS "# Orbits of spectroscopic binaries for Celestia: $me, $ver,n";
  14. print ELMTS "# ---------------------------------------------n";
  15. print ELMTS "# from D. Pourbaix, Astron. Astrophys. Suppl. Ser. 145, 2000, 215-222.n";
  16. print ELMTS "# Refereed publication freely available atn"; 
  17. print ELMTS "# http://aas.aanda.org/index.php?option=article&access=standard&Itemid=129&url=/articles/aas/pdf/2000/14/ds9259.pdfn";
  18. print ELMTS "n";
  19. print ELMTS "# Binaries within 25 ly distance have been commented out here.n"; 
  20. print ELMTS "# They are included in Celestia's 'nearstars.stc'.n";
  21. print ELMTS "# Entries appearing also in 'visualbins.stc' are commented out here as welln"; 
  22. print ELMTS "# to avoid redoubling. Data on spectral types were moved to 'visualbins.stc'.n"; 
  23. print ELMTS "# This update features SIMBAD-compatible nomenclature for all barycenters.n"; 
  24. print ELMTS "# Leading and alternative star designations were extracted via SIMBAD'sn"; 
  25. print ELMTS "# scripting facility, available at http://simbad.u-strasbg.fr/simbad/,n";
  26. print ELMTS "# and from Celestia's 'starnames.dat'. Missing spectral typesn";
  27. print ELMTS "# and visual magnitudes for components were added from scanning then"; 
  28. print ELMTS "# '9th Catalogue of Spectroscopic Binary Orbits (SB9) (Pourbaix+ 2004-2009)',n";
  29. print ELMTS "# http://cdsarc.u-strasbg.fr/viz-bin/Cat?B/sb9,n";
  30. print ELMTS "# Coordinates and distances for barycenters and some spectral types are fromn"; 
  31. print ELMTS "# Celestia's stars, ('stars.txt' merged with 'revised.stc'), based onn";
  32. print ELMTS "# Floor van Leeuwen, 2007 'Hipparcos, the New Reduction of the Raw Data',n";
  33. print ELMTS "# Astrophysics & Space Science Library #350.n";
  34. print ELMTS "# available at http://cdsarc.u-strasbg.fr/viz-bin/Cat?I/311n";
  35. print ELMTS "#n";
  36. print ELMTS "# Processed $year-$mon-$mday $hour:$min:$sec UTCn";
  37. print ELMTS "# by Dr. Fridger Schrempp, fridger.schrempp@desy.den";
  38. print ELMTS "# ------------------------------------------------------ n";
  39. print ELMTS "n";
  40. #
  41. # constants
  42. #
  43. $pi = 3.14159265359;
  44. $ly2AU = 63239.7;
  45. $d_sol = 1.0/$ly2AU; # in ly
  46. $c = $ly2AU/3600.0*$pi/180.0; # conversion a["] -> a[ly]
  47. $cons='And|Cap|Col|Dra|Lac|Mus|Psc|Tau|Ant|Car|Com|Eql|Leo|Nor|Pup|Tel|Aps|Cas|CrA|Eri|Lep|Oct|Pyx|TrA|Aql|Cen|CrB|For|Lib|Oph|Ret|Tri|Aqr|Cep|Crt|Gem|LMi|Ori|Scl|Tuc|Ara|Cet|Cru|Gru|Lup|Pav|Sco|UMa|Ari|Cha|Crv|Her|Lyn|Peg|Sct|UMi|Aur|Cir|CVn|Hor|Lyr|Per|Ser|Vel|Boo|CMa|Cyg|Hya|Men|Phe|Sex|Vir|Cae|CMi|Del|Hyi|Mic|Pic|Sge|Vol|Cam|Cnc|Dor|Ind|Mon|PsA|Sgr|Vul';
  49. @commenting_out = ("","#  Star already in 'nearstars.stc', since d < 25 lyn#n", "# Commented out to avoid redoublingn#n");
  51. @quality = ("","","# lacking, used HIP data of the entire system!", "# mentioned in D.Pourbaix's paper (discussion)");
  53. %Vis = NULL;
  54. #
  55. # check visual binaries for doubles <=> $Vis{$hipSim} = 1
  56. #
  57. open(SIMVIS,"<simbad_vis.txt")|| die "Can not read simbad_vis.txtn";
  58. while (<SIMVIS>){
  59.     chop();    
  60.     if (/^Identifiers=/){
  61.         if (/|HIP (d+)|/){$hipSim = $1;$Vis{$hipSim} = 1;}
  62.     }
  63. }
  64. close(SIMVIS);    
  65. #
  66. # implement matching Celestia starnames
  67. #
  68. open(STN,"<starnames.dat")|| die "Can not read starnames.datn";
  69. while (<STN>){
  70.     chop();
  71.     # extract main name
  72.     ($hipStn, $name1, $dummy) = ($_ =~ /(^d+):([a-zA-Z]+s?[a-zA-Z]{4,}):(.*)/);
  73.     # is there a second name?
  74.     ($name2, $dummy2) = ($dummy =~ /(^[a-zA-Z]+s?[a-zA-Z]{4,}):(.*)/);
  75.     if ($name1){
  76.         $name1A = "$name1 A";
  77.         $name1B = "$name1 B";
  78.     } 
  79.     if ($name2){
  80.         $name2 = ":$name2";
  81.         $name2A = "$name2 A";
  82.         $name2B = "$name2 B";
  83.     } else {
  84.         $name2A = "";
  85.         $name2B = "";    
  86.     }
  87.     $Stn{$hipStn} = $name1.$name2;
  88.     $StnA{$hipStn} = $name1A.$name2A;
  89.     $StnB{$hipStn} = $name1B.$name2B;
  90.     
  91.     #print "$hipStn      $Stn{$hipStn}n" if $Stn{$hipStn};
  92. }
  93. close (STN);
  94. #
  95. # implement SIMBAD naming compatibility, SIMBATCH output ('simbad_spect.txt')
  96. #
  97. open(SIMBAD,"<simbad_spect.txt")|| die "Can not read simbad_spect.txtn";
  98. while (<SIMBAD>){
  99.     chop();
  100.         $alt  = ""; $altA = ""; $altB = ""; $nx = ":"; $comp="";    
  101.     if (/^Identifiers=/){
  102.         if (/|HIP (d+)|/){$hipSim = $1;}
  103.         if (/|.*s([a-zA-Z]+ )($cons)(s?[A-B]?)|/){
  104.             $comp = $3;
  105.             $constell = $2;
  106.             $pre  = $1;            
  107.             $pre  =~ tr/a-z/A-Z/;
  108.             $pre  =~ s/KSI/XI/g;
  109.             &update ($pre, $constell, $comp);
  110.         }          
  111.         if (/|V*s(Vd+ )($cons)(s?[A-B]?)|/){             
  112.             $comp = $3;
  113.             $constell = $2;
  114.             $pre  = $1;
  115.             &update ($pre, $constell, $comp);           
  116.         } 
  117.         if (/|.*s(w+.?0d )(($cons))/){
  118.             $constell = $2;
  119.             $pre  = $1;            
  120.             $pre  =~ s/.?01/1/g;
  121.             $pre  =~ s/.?02/2/g;
  122.             $pre  =~ tr/a-z/A-Z/;
  123.             $pre  =~ s/KSI/XI/g;
  124.             &update ($pre, $constell, " ");
  125.         }            
  126.         if (/|.?s(d+ )($cons)(s?[A-B]?)|/){             
  127.             $comp = $3;
  128.             $constell = $2;
  129.             $pre  = $1;
  130.             &update ($pre, $constell, $comp);
  131.         }      
  132.         if (/|(GJ d+)(s?[A-C]*)|/){
  133.             $pre = $1;
  134.             $comp = $2;
  135.             &update ($pre, "", $comp);
  136.         }
  137.         if (/|(ADS d+)(s?[A-P]*)|/){
  138.             $pre = $1;            
  139.             $comp = $2;            
  140.             &update ($pre, "", $comp);
  141.         }        
  142.         if (/|(CCDMsJd+[+-]d+)([A-P]*)|/){
  143.             $pre = $1;
  144.             $comp = $2;
  145.             &update ($pre, "", $comp);
  146.         }        
  147.                       
  148.         $alt{$hipSim, 'AB'} = $alt?$alt:"HIP $hipSim";       
  149.         $alt{$hipSim, 'A'}  = $altA?$altA:"HIP $hipSim A";
  150.         $alt{$hipSim, 'B'}  = $altB?$altB:"HIP $hipSim B";
  151.         
  152.         if ($Stn{$hipSim}){
  153.             $alt{$hipSim, 'AB'} =  $Stn{$hipSim}.$nx.$alt{$hipSim, 'AB'};
  154.             $alt{$hipSim, 'A'}  =  $StnA{$hipSim}.$nx.$alt{$hipSim, 'A'};
  155.             $alt{$hipSim, 'B'}  =  $StnB{$hipSim}.$nx.$alt{$hipSim, 'B'};
  156.         }         
  157.                  
  158.         ($orbitRef{$hipSim},$tmp) = split(":",$alt{$hipSim, 'AB'});
  159.     }
  160. }     
  161. close(SIMBAD);
  162. #
  163. # read in SB9 looking for spectral types/mags of components
  164. #
  165. open(SB9,"< SB9.dat")|| die "Can not read SB9.datn";
  166. while (<SB9>){
  167.     #chop();
  168.     $hipSb9             =  &clean(&ss(86,110));
  169.     $hipSb9             =~ s/HIP //g;
  170.     $colorSb9A{$hipSb9} = &clean(&ss(58,73));
  171.     $colorSb9B{$hipSb9} = &clean(&ss(75,84));
  172.     $mVSb9A{$hipSb9}    = &clean(&ss(42,47));
  173.     $mVSb9B{$hipSb9}    = &clean(&ss(50,55));
  174.     $filterA{$hipSb9}   = &ss(48);
  175.     $filterB{$hipSb9}   = &ss(56);    
  176.     #print "$hipSb9     $colorSb9A{$hipSb9}    $colorSb9B{$hipSb9}  $mVSb9A{$hipSb9}   $mVSb9B{$hipSb9}  $filterA{$hipSb9}  $filterB{$hipSb9}n";
  177. }
  178. close(SB9);
  179. #
  180. # merge with corrections in revised.stc
  181. #
  182. open(HIP,"<stars.txt")|| die "Can not read stars.txtn";
  183. while (<HIP>){
  184.     chop();
  185.     $line = $_;
  186.     ($hipnr1,$tmp) = split (/  /);
  188.     # squeeze out all spaces and use as a key
  190.     $hipnr1 =~ s/ //g;
  191.     $stars{$hipnr1} = &clean($line);
  193.     #print STDOUT "$stars{$hipnr1}n";
  194. }
  195. close (HIP);
  196. #
  197. # merge with corrections in revised.stc
  198. #
  199. open(HIPREV,"<revised.stc")|| die "Can not read revised.stcn";
  200. while (<HIPREV>){
  201.     next if (/^#/);
  202.     if (/(^d+)/ || /^Modify (d+)/){
  203.         $hiprev = $1; 
  204.         ($h,$c1,$c2,$dd,$magapp,$color) = split(/[ t]+/,$stars{$hiprev});
  205. #        if (!$stars{$hiprev}){
  206. #            print "ORG: HIP star missing!n";
  207. #        } else {    
  208. #            print "ORG: HIP $stars{$hiprev}n";
  209. #        }
  210.         next;
  211.     }
  212.     next if(/^{/);
  213.     if(/RAbs+([d.]+)/){$c1              = $1; next;} 
  214.     if(/Decbs+([-d.]+)/){$c2            = $1; next;}
  215.     if(/Distancebs+([d.]+)/){$dd        = $1; next;}
  216.     if(/SpectralTypebs+"(.*)"/){$color = $1; next;}
  217.     if(/AppMagbs+([d.]+)/){$magapp      = $1; next;}
  218.     if (/^}/){        
  219.         $stars{$hiprev} = join (" ",$hiprev,$c1,$c2,$dd,$magapp,$color);
  220. #        print "REV: HIP $stars{$hiprev}nn"; 
  221.     }   
  222. }
  223. close (HIPREV);
  225. $count = 0;
  226. $kAsb9 = 0; $kBsb9 = 0; $kApx = 0; $kBpx = 0; $kAhip = 0; $kBhip = 0;
  227. open(BINDAT1,"<Pourbaix-stars.txt")|| die "Can not read Pourbaix-stars.txtn";
  228. while (<BINDAT1>){
  229. chop();
  230. next if (/^#/);
  231. $line = $_;
  232. ($hipnr,$tmp) = split (/|/);
  234. # squeeze out all spaces and use as a key
  236. $hipnr =~ s/_| //g;
  237. $spects{$hipnr} = $line;
  238. }
  239. close (BINDAT1);
  241. open(BINDAT2,"<Pourbaix-orbits.txt")|| die "Can not read Pourbaix-orbits.txtn";
  242. while (<BINDAT2>) {
  243. chop();
  244. next if (/^#/);
  245. ($hip,$a,$i,$omega,$OMEGA,$e,$Per,$T,$v0,$plx,$kappa,$MA,$MB) = split (/|/,$_);
  246. # squeeze out all superfluous spaces
  247. $hip=~s/_| //g;
  248. $a=~s/_| //g;
  249. $i=~s/_| //g;
  250. $omega=~s/_| //g;
  251. $OMEGA=~s/_| //g;
  252. $e=~s/_| //g;
  253. $Per=~s/_| //g;
  254. $T=~s/_| //g;
  255. $plx=~s/_| //g;
  256. $kappa=~s/_| //g;
  257. $MA=~s/_| //g;
  258. $MB=~s/_| //g;
  259. #print STDOUT "$hip $a $i $omega $OMEGA $e $Per $T  $plx $kappa $MA $MBn";
  260. #exit
  261. next if($plx eq "");
  262. $d=1000/($ly2AU*$plx)*3600/$pi*180; # d in [ly]; $plx in [mas]
  263. $q= $MB/$MA;
  264. $a2 = $d*$c*$a/(1.0 + $q); # a2 [ly]
  265. $a1 = $a2*$q;              # a1 [ly]
  266. #
  267. next if ($stars{$hip} eq "");
  268. ($h,$c1,$c2,$dd,$magapp,$color) = split(/[ t]+/,$stars{$hip});
  270. # coordinates in decimal-degrees
  272. $c1 =~ s/ //g;
  273. $c2 =~ s/ //g;
  275. ($hip2,$name,$hd,$mvPxA,$colorA,$mvPxB,$colorB,$type,$ref) = split(/|/,$spects{$hip});
  277. $name=~s/_//g;
  278. $mvPxA=~s/_| //g;
  279. $colorA=~s/_| //g;
  280. $colorB=~s/_| //g;
  281. $mvPxB=~s/_| //g;
  282.     # try app.mag entries from SB9 first      
  283.     if ($mVSb9A{$hip}){
  284.         $mquA = $quality[0];
  285.         $mvA = $mVSb9A{$hip};
  286.     } elsif ($mvPxA) {
  287.         $mquA = $quality[1];
  288.         $mvA = $mvPxA;
  289.     }
  290.     if ($mVSb9B{$hip}){
  291.         $mquB = $quality[0];
  292.         $mvB = $mVSb9B{$hip};
  293.     } elsif ($mvPxB) {
  294.         $mquB = $quality[1];
  295.         $mvB = $mvPxB;
  296.     } elsif ($hip == 10644){                         
  297.         # HIP 10644 = DEL Tri
  298.         # rough estimate from discussion about DEL Tri in Pourbaix's paper
  299.         $mquB = $quality[3]; 
  300.         $mvB = $mvA + 2.0;         
  301.     } else {
  302.         # identify the rest with the visual app. mag of the entire system 
  303.         # from HIP. A rough approximation, but at this point unavoidable...
  304.         $mquB = $quality[2];
  305.         $mvB = $magapp; 
  306.     }
  307.     #print "$hip $mvA   $mvBn"; 
  309.     next if($plx eq "");
  310. $d=1000/($ly2AU*$plx)*3600/$pi*180; # d in [ly]; $plx in [mas]
  311. $q= $MB/$MA;
  312. # $a is in mas! $a1, $a2 in arc_secs
  313. $a2 = 0.001*$d*$c*$a/(1.0 + $q); # a2 [ly]
  314. $a1 = $a2*$q;              # a1 [ly]
  315. #            
  316. # eliminate certain binaries that are already in visualbins.stc
  317.     # have checked that this condition includes ALL previously known cases 
  318.     # (Cham's list)!
  319.     
  320.     $comment_flag = 0;
  321.     $onoff = "";
  322.     if ($Vis{$hip}){
  323.         $onoff = "# " if $Vis{$hip};
  324.         $comment_flag = 2;
  325.     }
  326.     #print "$hip    $Vis{$hip}n"  if $Vis{$hip};   
  327.     
  328. #
  329. # extract distance [ly] from 'stars.txt & revised stc'
  330. # use it to compile absolute magnitude
  331. #
  333. $epsrel = 0;
  334. if($d){ $epsrel = 100 * ($dd - $d)/$d;}
  335. if($epsrel > 10){
  336. print STDOUT "Distance mismatch of $epsrel % with (revised) stars.txt for HIP $hipn";     
  337. } 
  338. $d = $dd;
  339.     #
  340.     # comment out all binaries with earthbound distance <= 25 ly. 
  341.     # They are included in Grant Hutchison's 'nearstars.stc' file
  342.     # ALF Cen, 70 Oph
  343.             
  344.     if ($d <= 25){
  345.         $onoff = "# ";
  346.         $comment_flag = 1;
  347.         #print "$hip   $dn";
  348.     }             
  349. #
  350.     # separate spectral types of both components
  351.     #       
  352.     if ($colorSb9A{$hip}){
  353.         # first use SB9 catalog data that are most recent...        
  354.         $spectA = $colorSb9A{$hip};
  355.         $quA = $quality[0];
  356.         $kAsb9++ if !$onoff;
  357.     } elsif ($colorA){
  358.         # use up next the known spectral types from D. Pourbaix
  359.         $spectA = $colorA;
  360.         $quA = $quality[1];
  361.         $kApx++ if !$onoff;
  362.     } else {
  363.         # identify the leftovers with the system spectral type from HIP
  364.         $spectA = $color;
  365.         $quA = $quality[2];
  366.         $kAhip++ if !$onoff;
  367.     }
  368.     if ($colorSb9B{$hip}){
  369.         # first use SB9 data that are most recent...
  370.         $spectB = $colorSb9B{$hip};
  371.         $quB = $quality[0];
  372.         $kBsb9++ if !$onoff;
  373.     } elsif ($colorB){
  374.         # use up next the known spectral types from D. Pourbaix
  375.         $spectB = $colorB;
  376.         $quB = $quality[1];
  377.         $kBpx++ if !$onoff;
  378.     } else {
  379.         # approximate the rest by the system spectral type from HIP
  380.         $spectB = $color;
  381.         $quB = $quality[2];
  382.         $kBhip++ if !$onoff;
  383.     }
  384.     # cleaning up for Celestia notation     
  385.     $spectA =~ s/[a-z]|-I?V|.{3,}//g;  
  386.     $spectB =~ s/[a-zS]|-I?V|.{3,}//g;
  387.     $spectA = ""$spectA"";
  388.     $spectB = ""$spectB"";
  389.     
  390.     #printf "%2s %6d %10.2f %12s %8s %8s %8s %8sn", $onoff, $hip, $d,  $colorSb9A{$hip},$colorSb9B{$hip},$colorA,$colorB,$color; 
  391.     
  392.     #printf "%2s %6d %10.2f %10.2f %5s %5.2f %5s %5.2fn", $onoff, $hip, $d,  $mVSb9A{$hip},$mVSb9B{$hip},$mvPxA,$mvPxB,$magapp; 
  393.     
  394.     #if ($alt{$hip,'AB'} =~/($cons)/){$k++; print "$k $onoff $alt{$hip,'AB'}n";}
  395.     #if ($onoff){print "$hip $commenting_out[$comment_flag]n";}
  396. #print STDOUT "$hip $c1 $c2 $d $a $i $omega $OMEGA $e $Per $T  $plx $kappa $MA $MB $name $mvA $colorA $mvB $colorBn";
  398. &RotOrbits($c1,$c2,$Per,$a,$i,$OMEGA,$T,$e,$omega,$d);
  400.     print  ELMTS "$commenting_out[$comment_flag]";      
  401. print  ELMTS "$onoff Barycenter $hip "$alt{$hip,'AB'}"n";
  402. print  ELMTS "$onoff {n";
  403. printf ELMTS "$onoff     RA       %10.6fn", $c1;
  404. printf ELMTS "$onoff     Dec      %10.6fn",$c2;
  405. printf ELMTS "$onoff     Distance %10.6fn",$d;
  406. print  ELMTS "$onoff }n";
  407. print  ELMTS "$onoff n";
  408. print  ELMTS "$onoff "$alt{$hip,'A'}" n";
  409. print  ELMTS "$onoff {n";
  410. print  ELMTS "$onoff     OrbitBarycenter "$orbitRef{$hip}"n";
  411.     printf ELMTS "$onoff     SpectralType    %-8s %-40sn",$spectA,$quA;
  412.     printf ELMTS "$onoff     AppMag          %-5.2f    %-40sn",$mvA,$mquA;
  413.     print  ELMTS "$onoff n";
  414. print  ELMTS "$onoff     EllipticalOrbit {n";
  415. printf ELMTS "$onoff         Period          %10.3fn",$Period;
  416. printf ELMTS "$onoff         SemiMajorAxis   %10.3f # mass ratio %4.2f : %4.2fn",$a1,$MA,$MB;
  417. printf ELMTS "$onoff         Eccentricity    %10.3fn",$Eccentricity;
  418. printf ELMTS "$onoff         Inclination     %10.3fn",$Inclination;
  419. printf ELMTS "$onoff         AscendingNode   %10.3fn",$AscendingNode;
  420. $ArgOfPeri1 = $ArgOfPeri - 180;
  421. if ($ArgOfPeri1 < 0.0) { $ArgOfPeri1 = $ArgOfPeri + 180; }
  422. printf ELMTS "$onoff         ArgOfPericenter %10.3fn",$ArgOfPeri1;
  423. printf ELMTS "$onoff         MeanAnomaly     %10.3fn",$MeanAnomaly;
  424. print  ELMTS "$onoff     }n";
  425. print  ELMTS "$onoff }nn";
  426. print  ELMTS "$onoff "$alt{$hip,'B'}" n";
  427. print  ELMTS "$onoff {n";
  428. print  ELMTS "$onoff     OrbitBarycenter "$orbitRef{$hip}"n";
  429.     printf ELMTS "$onoff     SpectralType    %-8s %-40sn",$spectB,$quB;
  430.     printf ELMTS "$onoff     AppMag          %-5.2f    %-40sn",$mvB,$mquB;
  431. print  ELMTS "$onoff n";
  432. print  ELMTS "$onoff     EllipticalOrbit {n";
  433. printf ELMTS "$onoff         Period          %10.3fn",$Period;
  434. printf ELMTS "$onoff         SemiMajorAxis   %10.3f # mass ratio %4.2f : %4.2fn",$a2,$MA,$MB;
  435. printf ELMTS "$onoff         Eccentricity    %10.3fn",$Eccentricity;
  436. printf ELMTS "$onoff         Inclination     %10.3fn",$Inclination;
  437. printf ELMTS "$onoff         AscendingNode   %10.3fn",$AscendingNode;
  438. printf ELMTS "$onoff         ArgOfPericenter %10.3fn",$ArgOfPeri;
  439. printf ELMTS "$onoff         MeanAnomaly     %10.3fn",$MeanAnomaly;
  440. print  ELMTS "$onoff     }n";
  441. print  ELMTS "$onoff }nn";
  442.     $count++ if !$onoff;
  443. }
  444. close (BINDAT2);
  446. print "nNumber of enabled spectroscopic binaries: $countn";
  447. print "nA component:n------------n";
  448. printf STDOUT "nspectral types from SB9 catalog: => %3dn",$kAsb9;
  449. printf STDOUT "spectral types from D.Pourbaix : => %3dn",$kApx;
  450. printf STDOUT "spectral types from HIP catalog: => %3dn",$kAhip;
  451. print "nB component:n------------n";
  452. printf STDOUT "spectral types from SB9 catalog: => %3dn", $kBsb9;
  453. printf STDOUT "spectral types from D. Pourbaix: => %3dn",$kBpx;
  454. printf STDOUT "spectral types from HIP catalog: => %3dnn",$kBhip;
  458. sub RotOrbits {
  460. my($ra_deg,$del_deg,$P,$a_arcsec,$i,$PA_of_Node,$Epoch_of_peri,$e,$Arg_of_peri
  461. ,$dist_ly) = @_;
  462. my $del_rad = -$del_deg*$pi/180.0;
  463. my $ra_rad = $ra_deg*$pi/180.0 - $pi;
  464. my $eps = $pi/180.0*23.4392911;
  465. my $ii = $pi/180.0*(90.0 - $i);
  466. my $om = $pi/180.0*($PA_of_Node - 270.0)+1.0e-8;
  467. my $alpha = atan(cos($ii)*cos($pi/180.0*($PA_of_Node))/(sin($ii)*cos($del_rad) -
  468. cos($ii)*sin($del_rad)*sin($pi/180.0*($PA_of_Node)))) + $ra_rad;
  469. if( sin($ii)*cos($del_rad)-cos($ii)*sin($del_rad)*sin($pi/180.0*$PA_of_Node) < 0 ) { $alpha = $alpha + $pi };
  470. my $delta=asin(cos($ii)*cos($del_rad)*sin($pi/180.0*$PA_of_Node)+sin($ii)*sin(
  471. $del_rad));
  472. my $lambda=atan((sin($alpha)*cos($eps)+tan($delta)*sin($eps))/cos($alpha));
  473. if( cos($alpha) < 0 ) { $lambda = $lambda + $pi };
  474. my $beta = asin(sin($delta)*cos($eps) - cos($delta)*sin($eps)*sin($alpha));
  475. my $alphaOm = atan(cos($om)/(-sin($del_rad))/sin($om)) + $ra_rad;
  476. if( -sin($del_rad)*sin($om) < 0 ) { $alphaOm = $alphaOm + $pi };
  477. my $deltaOm = asin(cos($del_rad)*sin($om));
  478. my $lambdaOm = atan((sin($alphaOm)*cos($eps) +
  479. tan($deltaOm)*sin($eps))/cos($alphaOm));
  480. if( cos($alphaOm) < 0 ) { $lambdaOm = $lambdaOm + $pi };
  481. my $betaOm = asin(sin($deltaOm)*cos($eps) -
  482. cos($deltaOm)*sin($eps)*sin($alphaOm));
  483. my $sign = $betaOm > 0? 1.0:-1.0;
  484. my $dd = acos(cos($betaOm)*cos($lambdaOm - $lambda - $pi/2.0))*$sign;
  485. $Period = $P;
  486. $SemiMajorAxis = $dist_ly*63239.7*tan($pi/180.0*$a_arcsec/3600.0);
  487. $Eccentricity =  $e;
  488. $Inclination = 90 - $beta/$pi*180;
  489. $AscendingNode = $lambda/$pi*180 + 90  - floor(($lambda/$pi*180+90)/360.0)*360;
  490. $ArgOfPeri = $Arg_of_peri + $dd/$pi*180 - floor(($Arg_of_peri + $dd/$pi*180)/360.0)*360;
  491. $MeanAnomaly = 360*((2000.0 - $Epoch_of_peri)/$P - floor((2000.0 - $Epoch_of_peri)/$P));
  492. }
  493. sub clean {
  494. # squeeze out superfluous spaces
  495. my($string) = @_;
  496. $string =~ s/^s*//;
  497. $string =~ s/s*$//;
  498. $string =~ s/s+/ /g;
  499. $string;
  500. }
  502. # like substr($_,first,last), but one-based.
  503. sub ss {
  504.     substr ($_, $_[0]-1, $_[1]-$_[0]+1);
  505. }
  507. sub update {
  508. my($pre, $constell, $comp) = @_;
  509. # component parser for visual binaries
  510. my $name = $pre.$constell;
  511. my ($a, $b) = "";
  513. if (!$comp||$comp eq " "){$a = " A"; $b = " B"; $comp = "";}
  514. elsif ($comp =~ /(s?)ABC?P?/){$a = $1."A"; $b = $1."B";}
  515. elsif ($comp =~ /b[AB]b/){$a = $comp."a"; $b = $comp."b";}
  516. elsif ($comp =~ /(s?)BC/){$a = $1."B"; $b = $1."C";}
  517. elsif ($comp =~ /(s?)([AB])([PC])/){$a = $1.$2; $b = $1.$3;}
  519. $alt  = $alt?$alt.$nx.$name.$comp:$name.$comp;
  520. $altA = $altA?$altA.$nx.$name.$a:$name.$a;
  521. $altB = $altB?$altB.$nx.$name.$b:$name.$b;
  522. }