From d01c4e2db4cfd159ccff850c6eacc14c494ded87 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Wed, 17 Jan 2018 12:01:19 +0000 Subject: [PATCH] systools: Add astronomy units and corresponding demos git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6145 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../examples/astronomy_calculator/astcal.lpi | 83 + .../examples/astronomy_calculator/astcal.lpr | 46 + .../examples/astronomy_calculator/astcalu.lfm | 1068 ++++++++++ .../examples/astronomy_calculator/astcalu.pas | 494 +++++ .../systools/examples/eclipses/eclipse.lpi | 85 + .../systools/examples/eclipses/eclipse.lpr | 46 + .../systools/examples/eclipses/eclipseu.lfm | 68 + .../systools/examples/eclipses/eclipseu.pas | 200 ++ .../examples/jupiter_moons/exjupst.lpi | 86 + .../examples/jupiter_moons/exjupst.lpr | 46 + .../examples/jupiter_moons/exjupstu.lfm | 82 + .../examples/jupiter_moons/exjupstu.pas | 152 ++ components/systools/laz_systools.lpk | 54 +- components/systools/laz_systools.pas | 4 +- components/systools/source/design/StReg.pas | 20 +- components/systools/source/run/stastro.pas | 1799 +++++++++++++++++ components/systools/source/run/stastrop.pas | 499 +++++ components/systools/source/run/steclpse.pas | 737 +++++++ components/systools/source/run/stjup.pas | 620 ++++++ components/systools/source/run/stjupsat.pas | 1109 ++++++++++ components/systools/source/run/stlist.pas | 1050 ++++++++++ components/systools/source/run/stmars.pas | 424 ++++ components/systools/source/run/stmerc.pas | 280 +++ components/systools/source/run/stneptun.pas | 286 +++ components/systools/source/run/stpluto.pas | 202 ++ components/systools/source/run/stsaturn.pas | 744 +++++++ components/systools/source/run/sturanus.pas | 515 +++++ components/systools/source/run/stvenus.pas | 222 ++ 28 files changed, 11010 insertions(+), 11 deletions(-) create mode 100644 components/systools/examples/astronomy_calculator/astcal.lpi create mode 100644 components/systools/examples/astronomy_calculator/astcal.lpr create mode 100644 components/systools/examples/astronomy_calculator/astcalu.lfm create mode 100644 components/systools/examples/astronomy_calculator/astcalu.pas create mode 100644 components/systools/examples/eclipses/eclipse.lpi create mode 100644 components/systools/examples/eclipses/eclipse.lpr create mode 100644 components/systools/examples/eclipses/eclipseu.lfm create mode 100644 components/systools/examples/eclipses/eclipseu.pas create mode 100644 components/systools/examples/jupiter_moons/exjupst.lpi create mode 100644 components/systools/examples/jupiter_moons/exjupst.lpr create mode 100644 components/systools/examples/jupiter_moons/exjupstu.lfm create mode 100644 components/systools/examples/jupiter_moons/exjupstu.pas create mode 100644 components/systools/source/run/stastro.pas create mode 100644 components/systools/source/run/stastrop.pas create mode 100644 components/systools/source/run/steclpse.pas create mode 100644 components/systools/source/run/stjup.pas create mode 100644 components/systools/source/run/stjupsat.pas create mode 100644 components/systools/source/run/stlist.pas create mode 100644 components/systools/source/run/stmars.pas create mode 100644 components/systools/source/run/stmerc.pas create mode 100644 components/systools/source/run/stneptun.pas create mode 100644 components/systools/source/run/stpluto.pas create mode 100644 components/systools/source/run/stsaturn.pas create mode 100644 components/systools/source/run/sturanus.pas create mode 100644 components/systools/source/run/stvenus.pas diff --git a/components/systools/examples/astronomy_calculator/astcal.lpi b/components/systools/examples/astronomy_calculator/astcal.lpi new file mode 100644 index 000000000..c63e153bf --- /dev/null +++ b/components/systools/examples/astronomy_calculator/astcal.lpi @@ -0,0 +1,83 @@ + + + + + + + + + + <Scaled Value="True"/> + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <XPManifest> + <DpiAware Value="True"/> + </XPManifest> + <Icon Value="0"/> + </General> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + <Modes Count="0"/> + </RunParams> + <RequiredPackages Count="2"> + <Item1> + <PackageName Value="laz_systools"/> + </Item1> + <Item2> + <PackageName Value="LCL"/> + </Item2> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="astcal.lpr"/> + <IsPartOfProject Value="True"/> + <UnitName Value="Astcal"/> + </Unit0> + <Unit1> + <Filename Value="astcalu.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="AstCalU"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="astcal"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/components/systools/examples/astronomy_calculator/astcal.lpr b/components/systools/examples/astronomy_calculator/astcal.lpr new file mode 100644 index 000000000..0afa3a9c7 --- /dev/null +++ b/components/systools/examples/astronomy_calculator/astcal.lpr @@ -0,0 +1,46 @@ +(* ***** BEGIN LICENSE BLOCK ***** + * Version: MPL 1.1 + * + * The contents of this file are subject to the Mozilla Public License Version + * 1.1 (the "License"); you may not use this file except in compliance with + * the License. You may obtain a copy of the License at + * http://www.mozilla.org/MPL/ + * + * Software distributed under the License is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License + * for the specific language governing rights and limitations under the + * License. + * + * The Original Code is TurboPower SysTools + * + * The Initial Developer of the Original Code is + * TurboPower Software + * + * Portions created by the Initial Developer are Copyright (C) 1996-2002 + * the Initial Developer. All Rights Reserved. + * + * Contributor(s): + * + * ***** END LICENSE BLOCK ***** *) + +{$IFDEF FPC} + {$mode DELPHI} +{$ENDIF} + +program Astcal; + +uses + Interfaces, + Forms, lclversion, + AstCalU in 'AstCalU.pas' {Form1}; + +{$R *.res} + +begin + {$IF LCL_FULLVERSION >= 1080000} + Application.Scaled := True; + {$ENDIF} + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/components/systools/examples/astronomy_calculator/astcalu.lfm b/components/systools/examples/astronomy_calculator/astcalu.lfm new file mode 100644 index 000000000..94772818e --- /dev/null +++ b/components/systools/examples/astronomy_calculator/astcalu.lfm @@ -0,0 +1,1068 @@ +object Form1: TForm1 + Left = 239 + Height = 526 + Top = 160 + Width = 597 + Caption = 'SysTools Astronomical Calendar' + ClientHeight = 526 + ClientWidth = 597 + Color = clBtnFace + Font.Color = clBlack + OnCreate = FormCreate + ShowHint = True + LCLVersion = '1.9.0.0' + object Panel1: TPanel + Left = 450 + Height = 217 + Top = 10 + Width = 137 + BevelInner = bvRaised + BevelOuter = bvLowered + ClientHeight = 217 + ClientWidth = 137 + TabOrder = 0 + object Label1: TLabel + Left = 46 + Height = 15 + Top = 6 + Width = 24 + Caption = 'Date' + ParentColor = False + end + object Label2: TLabel + Left = 16 + Height = 15 + Top = 86 + Width = 30 + Caption = 'Long.' + ParentColor = False + end + object Label3: TLabel + Left = 18 + Height = 15 + Top = 122 + Width = 19 + Caption = 'Lat.' + ParentColor = False + end + object Label4: TLabel + Left = 20 + Height = 15 + Top = 56 + Width = 11 + Caption = 'M' + ParentColor = False + end + object Label5: TLabel + Left = 54 + Height = 15 + Top = 56 + Width = 8 + Caption = 'D' + ParentColor = False + end + object Label6: TLabel + Left = 94 + Height = 15 + Top = 56 + Width = 7 + Caption = 'Y' + ParentColor = False + end + object Button1: TButton + Left = 28 + Height = 33 + Hint = 'Generate Data' + Top = 159 + Width = 89 + Caption = '&Compute' + Default = True + OnClick = Button1Click + TabOrder = 5 + end + object MonthEF: TEdit + Left = 12 + Height = 22 + Hint = '1 to 12' + Top = 28 + Width = 27 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + TabOrder = 0 + end + object DateEF: TEdit + Left = 44 + Height = 22 + Hint = '1 to 31' + Top = 28 + Width = 27 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + TabOrder = 1 + end + object YearEF: TEdit + Left = 78 + Height = 22 + Hint = '1800 to 2200' + Top = 28 + Width = 45 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + TabOrder = 2 + end + object LongEF: TEdit + Left = 60 + Height = 22 + Hint = '-180 to 180 (DDD.dd)' + Top = 82 + Width = 57 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + TabOrder = 3 + end + object LatEF: TEdit + Left = 60 + Height = 22 + Hint = '-90 to 90 (DD.dd)' + Top = 118 + Width = 57 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + TabOrder = 4 + end + end + object GB1: TGroupBox + Left = 6 + Height = 90 + Top = 6 + Width = 161 + Caption = ' Time ' + ClientHeight = 70 + ClientWidth = 157 + TabOrder = 1 + object Label7: TLabel + Left = 24 + Height = 15 + Top = 11 + Width = 28 + Caption = 'Local' + ParentColor = False + end + object Label8: TLabel + Left = 16 + Height = 15 + Top = 39 + Width = 41 + Caption = 'Sidereal' + ParentColor = False + end + object LocalTimeEF: TEdit + Left = 66 + Height = 22 + Top = 9 + Width = 61 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 0 + end + object SiderealTimeEF: TEdit + Left = 66 + Height = 22 + Top = 35 + Width = 61 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 1 + end + end + object GB2: TGroupBox + Left = 6 + Height = 123 + Top = 104 + Width = 161 + Caption = ' Rise/Set/Twilight ' + ClientHeight = 103 + ClientWidth = 157 + TabOrder = 2 + object Label9: TLabel + Left = 48 + Height = 15 + Top = 1 + Width = 50 + Caption = 'Rise/Start' + ParentColor = False + end + object Label10: TLabel + Left = 108 + Height = 15 + Top = 1 + Width = 41 + Caption = 'Set/End' + ParentColor = False + end + object Label11: TLabel + Left = 6 + Height = 15 + Top = 23 + Width = 20 + Caption = 'Sun' + ParentColor = False + end + object Label12: TLabel + Left = 6 + Height = 15 + Top = 50 + Width = 32 + Caption = 'Moon' + ParentColor = False + end + object Label13: TLabel + Left = 6 + Height = 15 + Top = 77 + Width = 42 + Caption = 'Twilight' + ParentColor = False + end + object SunRiseEF: TEdit + Left = 52 + Height = 22 + Top = 21 + Width = 45 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 0 + end + object MoonRiseEF: TEdit + Left = 52 + Height = 22 + Top = 47 + Width = 45 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 2 + end + object SunSetEF: TEdit + Left = 110 + Height = 22 + Top = 21 + Width = 43 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 1 + end + object MoonSetEF: TEdit + Left = 110 + Height = 22 + Top = 47 + Width = 43 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 3 + end + object TwiStartEF: TEdit + Left = 52 + Height = 22 + Top = 73 + Width = 45 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 4 + end + object TwiEndEF: TEdit + Left = 110 + Height = 22 + Top = 73 + Width = 43 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 5 + end + end + object GB3: TGroupBox + Left = 172 + Height = 221 + Top = 6 + Width = 271 + Caption = ' Positions ' + ClientHeight = 201 + ClientWidth = 267 + TabOrder = 3 + object PositionsLB: TListBox + Left = 10 + Height = 153 + Top = 40 + Width = 251 + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ItemHeight = 0 + ParentFont = False + TabOrder = 0 + end + object Header1: THeaderControl + Left = 10 + Height = 21 + Top = 9 + Width = 251 + DragReorder = False + Sections = < + item + Alignment = taLeftJustify + Text = 'Object' + Width = 84 + Visible = True + end + item + Alignment = taLeftJustify + Text = 'RA' + Width = 84 + Visible = True + end + item + Alignment = taLeftJustify + Text = 'Dec' + Width = 84 + Visible = True + end> + end + end + object GB4: TGroupBox + Left = 8 + Height = 168 + Top = 240 + Width = 579 + Caption = ' Phases ' + ClientHeight = 148 + ClientWidth = 575 + TabOrder = 4 + object Label14: TLabel + Left = 8 + Height = 15 + Top = 36 + Width = 59 + Caption = 'New Moon' + ParentColor = False + end + object Label15: TLabel + Left = 8 + Height = 15 + Top = 65 + Width = 65 + Caption = 'First Quarter' + ParentColor = False + end + object Label16: TLabel + Left = 8 + Height = 15 + Top = 95 + Width = 54 + Caption = 'Full Moon' + ParentColor = False + end + object Label17: TLabel + Left = 8 + Height = 15 + Top = 124 + Width = 64 + Caption = 'Last Quarter' + ParentColor = False + end + object PhaseLabel: TLabel + Left = 8 + Height = 15 + Top = 6 + Width = 31 + Caption = 'Phase' + ParentColor = False + end + object NMFirstDate: TEdit + Left = 78 + Height = 22 + Top = 32 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 0 + end + object FQFirstDate: TEdit + Left = 78 + Height = 22 + Top = 61 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 8 + end + object NMFirstTime: TEdit + Left = 136 + Height = 22 + Top = 32 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 1 + end + object FQFirstTime: TEdit + Left = 136 + Height = 22 + Top = 61 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 9 + end + object FMFirstDate: TEdit + Left = 78 + Height = 22 + Top = 91 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 16 + end + object LQFirstDate: TEdit + Left = 78 + Height = 22 + Top = 120 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 24 + end + object LQFirstTime: TEdit + Left = 136 + Height = 22 + Top = 120 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 25 + end + object FMFirstTime: TEdit + Left = 136 + Height = 22 + Top = 91 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 17 + end + object NMSecondDate: TEdit + Left = 208 + Height = 22 + Top = 32 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 2 + end + object NMSecondTime: TEdit + Left = 266 + Height = 22 + Top = 32 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 3 + end + object FQSecondDate: TEdit + Left = 208 + Height = 22 + Top = 61 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 10 + end + object FQSecondTime: TEdit + Left = 266 + Height = 22 + Top = 61 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 11 + end + object FMSecondDate: TEdit + Left = 208 + Height = 22 + Top = 91 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 18 + end + object FMSecondTime: TEdit + Left = 266 + Height = 22 + Top = 91 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 19 + end + object LQSecondTime: TEdit + Left = 266 + Height = 22 + Top = 120 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 27 + end + object LQSecondDate: TEdit + Left = 208 + Height = 22 + Top = 120 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 26 + end + object NMPrevDate: TEdit + Left = 336 + Height = 22 + Top = 32 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 4 + end + object FQPrevDate: TEdit + Left = 336 + Height = 22 + Top = 61 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 12 + end + object FMPrevDate: TEdit + Left = 336 + Height = 22 + Top = 91 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 20 + end + object LQPrevDate: TEdit + Left = 336 + Height = 22 + Top = 120 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 28 + end + object LQPrevTime: TEdit + Left = 394 + Height = 22 + Top = 120 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 29 + end + object FMPrevTime: TEdit + Left = 394 + Height = 22 + Top = 91 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 21 + end + object FQPrevTime: TEdit + Left = 394 + Height = 22 + Top = 61 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 13 + end + object NMPrevTime: TEdit + Left = 394 + Height = 22 + Top = 32 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 5 + end + object NMNextDate: TEdit + Left = 464 + Height = 22 + Top = 32 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 6 + end + object FQNextDate: TEdit + Left = 464 + Height = 22 + Top = 61 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 14 + end + object FMNextDate: TEdit + Left = 464 + Height = 22 + Top = 91 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 22 + end + object LQNextDate: TEdit + Left = 464 + Height = 22 + Top = 120 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 30 + end + object LQNextTime: TEdit + Left = 522 + Height = 22 + Top = 120 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 31 + end + object FMNextTime: TEdit + Left = 522 + Height = 22 + Top = 91 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 23 + end + object FQNextTime: TEdit + Left = 522 + Height = 22 + Top = 61 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 15 + end + object NMNextTime: TEdit + Left = 522 + Height = 22 + Top = 32 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 7 + end + object Header2: THeaderControl + Left = 78 + Height = 21 + Top = 0 + Width = 495 + DragReorder = False + Sections = < + item + Alignment = taLeftJustify + Text = 'First' + Width = 128 + Visible = True + end + item + Alignment = taLeftJustify + Text = 'Second' + Width = 128 + Visible = True + end + item + Alignment = taLeftJustify + Text = 'Previous' + Width = 129 + Visible = True + end + item + Alignment = taLeftJustify + Text = 'Next' + Width = 120 + Visible = True + end> + end + end + object GB5: TGroupBox + Left = 6 + Height = 96 + Top = 416 + Width = 581 + Caption = ' Other Events ' + ClientHeight = 76 + ClientWidth = 577 + TabOrder = 5 + object Label18: TLabel + Left = 24 + Height = 15 + Top = 44 + Width = 31 + Caption = 'Easter' + ParentColor = False + end + object Label19: TLabel + Left = 170 + Height = 15 + Top = 12 + Width = 34 + Caption = 'Spring' + ParentColor = False + end + object Label20: TLabel + Left = 170 + Height = 15 + Top = 44 + Width = 45 + Caption = 'Summer' + ParentColor = False + end + object Label21: TLabel + Left = 376 + Height = 15 + Top = 12 + Width = 18 + Caption = 'Fall' + ParentColor = False + end + object Label22: TLabel + Left = 376 + Height = 15 + Top = 44 + Width = 35 + Caption = 'Winter' + ParentColor = False + end + object Label23: TLabel + Left = 24 + Height = 15 + Top = 15 + Width = 44 + Caption = 'Sunlight' + ParentColor = False + end + object SpringTime: TEdit + Left = 282 + Height = 22 + Top = 8 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 3 + end + object SummerTime: TEdit + Left = 282 + Height = 22 + Top = 40 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 5 + end + object SummerDate: TEdit + Left = 222 + Height = 22 + Top = 40 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 4 + end + object SpringDate: TEdit + Left = 222 + Height = 22 + Top = 8 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 2 + end + object FallTime: TEdit + Left = 486 + Height = 22 + Top = 8 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 7 + end + object WinterTime: TEdit + Left = 486 + Height = 22 + Top = 40 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 9 + end + object WinterDate: TEdit + Left = 428 + Height = 22 + Top = 40 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 8 + end + object FallDate: TEdit + Left = 428 + Height = 22 + Top = 8 + Width = 51 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 6 + end + object EasterEF: TEdit + Left = 72 + Height = 22 + Top = 42 + Width = 49 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 1 + end + object SunlightEF: TEdit + Left = 74 + Height = 22 + Top = 12 + Width = 47 + Alignment = taCenter + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ReadOnly = True + TabOrder = 0 + end + end + object Timer1: TTimer + OnTimer = Timer1Timer + left = 538 + top = 388 + end +end diff --git a/components/systools/examples/astronomy_calculator/astcalu.pas b/components/systools/examples/astronomy_calculator/astcalu.pas new file mode 100644 index 000000000..93252fe64 --- /dev/null +++ b/components/systools/examples/astronomy_calculator/astcalu.pas @@ -0,0 +1,494 @@ +(* ***** BEGIN LICENSE BLOCK ***** + * Version: MPL 1.1 + * + * The contents of this file are subject to the Mozilla Public License Version + * 1.1 (the "License"); you may not use this file except in compliance with + * the License. You may obtain a copy of the License at + * http://www.mozilla.org/MPL/ + * + * Software distributed under the License is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License + * for the specific language governing rights and limitations under the + * License. + * + * The Original Code is TurboPower SysTools + * + * The Initial Developer of the Original Code is + * TurboPower Software + * + * Portions created by the Initial Developer are Copyright (C) 1996-2002 + * the Initial Developer. All Rights Reserved. + * + * Contributor(s): + * + * ***** END LICENSE BLOCK ***** *) + +{$IFDEF FPC} + {$mode DELPHI} +{$ENDIF} + +unit AstCalU; + +interface + +uses + {$IFNDEF FPC} + Windows, + {$ENDIF} + SysUtils, Classes, Graphics, Controls, + Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls, + + StConst, + StDate, + StDateSt, + StAstro, + StAstroP; + + +type + TForm1 = class(TForm) + Panel1: TPanel; + Label1: TLabel; + Button1: TButton; + Label2: TLabel; + Label3: TLabel; + MonthEF: TEdit; + DateEF: TEdit; + YearEF: TEdit; + Label4: TLabel; + Label5: TLabel; + Label6: TLabel; + GB1: TGroupBox; + Label7: TLabel; + Label8: TLabel; + LocalTimeEF: TEdit; + SiderealTimeEF: TEdit; + GB2: TGroupBox; + Label9: TLabel; + Label10: TLabel; + Label11: TLabel; + Label12: TLabel; + Label13: TLabel; + SunRiseEF: TEdit; + MoonRiseEF: TEdit; + SunSetEF: TEdit; + MoonSetEF: TEdit; + TwiStartEF: TEdit; + TwiEndEF: TEdit; + GB3: TGroupBox; + PositionsLB: TListBox; + Header1: THeaderControl; + GB4: TGroupBox; + NMFirstDate: TEdit; + FQFirstDate: TEdit; + NMFirstTime: TEdit; + FQFirstTime: TEdit; + FMFirstDate: TEdit; + LQFirstDate: TEdit; + LQFirstTime: TEdit; + FMFirstTime: TEdit; + Label14: TLabel; + Label15: TLabel; + Label16: TLabel; + Label17: TLabel; + NMSecondDate: TEdit; + NMSecondTime: TEdit; + FQSecondDate: TEdit; + FQSecondTime: TEdit; + FMSecondDate: TEdit; + FMSecondTime: TEdit; + LQSecondTime: TEdit; + LQSecondDate: TEdit; + NMPrevDate: TEdit; + FQPrevDate: TEdit; + FMPrevDate: TEdit; + LQPrevDate: TEdit; + LQPrevTime: TEdit; + FMPrevTime: TEdit; + FQPrevTime: TEdit; + NMPrevTime: TEdit; + NMNextDate: TEdit; + FQNextDate: TEdit; + FMNextDate: TEdit; + LQNextDate: TEdit; + LQNextTime: TEdit; + FMNextTime: TEdit; + FQNextTime: TEdit; + NMNextTime: TEdit; + Header2: THeaderControl; + GB5: TGroupBox; + Label18: TLabel; + Label19: TLabel; + Label20: TLabel; + Label21: TLabel; + Label22: TLabel; + SpringTime: TEdit; + SummerTime: TEdit; + SummerDate: TEdit; + SpringDate: TEdit; + FallTime: TEdit; + WinterTime: TEdit; + WinterDate: TEdit; + FallDate: TEdit; + EasterEF: TEdit; + PhaseLabel: TLabel; + Label23: TLabel; + SunlightEF: TEdit; + LongEF: TEdit; + LatEF: TEdit; + Timer1: TTimer; + procedure Button1Click(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure Timer1Timer(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + + TheDT : TStDateTimeRec; + RS : TStRiseSetRec; + + D, M, Y : Integer; + + ObsLat, + ObsLong : Double; + + procedure DoCalcTimes; + procedure DoFixedCalcs; + procedure DoCalcs(ObsLong, ObsLat : Double); + + end; + +var + Form1: TForm1; + + +implementation + +{$R *.lfm} + + +procedure TForm1.DoCalcTimes; +var + TT : TStTime; +begin + LocalTimeEF.Text := CurrentTimeString('hh:mm:ss', False); + TheDT.T := CurrentTime; + TT := Round(SiderealTime(TheDT) * 240); + SiderealTimeEF.Text := StTimeToTimeString('hh:mm:ss', TT, False); +end; + + +procedure TForm1.DoFixedCalcs; +var + Y, + M , + D : integer; + DTR : TStDateTimeRec; + MPR : TStMoonPosRec; + SPR : TStPosRec; + LR : TStLunarRecord; + PA : TStPlanetsArray; + +begin + +{Calculate Positions} + + SPR := SunPos(TheDT); + PositionsLB.Items.Add('Sun ' + HoursMin(SPR.RA) + ' ' + DegsMin(SPR.DC)); + + MPR := MoonPos(TheDT); + PositionsLB.Items.Add('Moon ' + HoursMin(MPR.RA) + ' ' + DegsMin(MPR.DC)); + + PlanetsPos(AstJulianDate(TheDT.D) + TheDT.T/86400, PA); + PositionsLB.Items.Add('Mercury ' + HoursMin(PA[1].RA) + ' ' + DegsMin(PA[1].DC)); + PositionsLB.Items.Add('Venus ' + HoursMin(PA[2].RA) + ' ' + DegsMin(PA[2].DC)); + PositionsLB.Items.Add('Mars ' + HoursMin(PA[3].RA) + ' ' + DegsMin(PA[3].DC)); + PositionsLB.Items.Add('Jupiter ' + HoursMin(PA[4].RA) + ' ' + DegsMin(PA[4].DC)); + PositionsLB.Items.Add('Saturn ' + HoursMin(PA[5].RA) + ' ' + DegsMin(PA[5].DC)); + PositionsLB.Items.Add('Uranus ' + HoursMin(PA[6].RA) + ' ' + DegsMin(PA[6].DC)); + PositionsLB.Items.Add('Neptune ' + HoursMin(PA[7].RA) + ' ' + DegsMin(PA[7].DC)); + PositionsLB.Items.Add('Pluto ' + HoursMin(PA[8].RA) + ' ' + DegsMin(PA[8].DC)); + + +{Calculate lunar phases} + + if LunarPhase(TheDT) >= 0 then + PhaseLabel.Caption := 'Waxing' + else + PhaseLabel.Caption := 'Waning'; + + + LR := NewMoon(TheDT.D); + NMFirstDate.Text := StDateToDateString('mm/dd', LR.T[0].D, False); + NMFirstTime.Text := StTimeToTimeString('hh:mm', LR.T[0].T, False); + if LR.T[1].D <> BadDate then + begin + NMSecondDate.Text := StDateToDateString('mm/dd', LR.T[1].D, False); + NMSecondTime.Text := StTimeToTimeString('hh:mm', LR.T[1].T, False); + end else + begin + NMSecondDate.Text := ''; + NMSecondTime.Text := ''; + end; + + LR := FirstQuarter(TheDT.D); + FQFirstDate.Text := StDateToDateString('mm/dd', LR.T[0].D, False); + FQFirstTime.Text := StTimeToTimeString('hh:mm', LR.T[0].T, False); + if LR.T[1].D <> BadDate then + begin + FQSecondDate.Text := StDateToDateString('mm/dd', LR.T[1].D, False); + FQSecondTime.Text := StTimeToTimeString('hh:mm', LR.T[1].T, False); + end else + begin + FQSecondDate.Text := ''; + FQSecondTime.Text := ''; + end; + + LR := FullMoon(TheDT.D); + FMFirstDate.Text := StDateToDateString('mm/dd', LR.T[0].D, False); + FMFirstTime.Text := StTimeToTimeString('hh:mm', LR.T[0].T, False); + if LR.T[1].D <> BadDate then + begin + FMSecondDate.Text := StDateToDateString('mm/dd', LR.T[1].D, False); + FMSecondTime.Text := StTimeToTimeString('hh:mm', LR.T[1].T, False); + end else + begin + FMSecondDate.Text := ''; + FMSecondTime.Text := ''; + end; + + LR := LastQuarter(TheDT.D); + LQFirstDate.Text := StDateToDateString('mm/dd', LR.T[0].D, False); + LQFirstTime.Text := StTimeToTimeString('hh:mm', LR.T[0].T, False); + if LR.T[1].D <> BadDate then + begin + LQSecondDate.Text := StDateToDateString('mm/dd', LR.T[1].D, False); + LQSecondTime.Text := StTimeToTimeString('hh:mm', LR.T[1].T, False); + end else + begin + LQSecondDate.Text := ''; + LQSecondTime.Text := ''; + end; + + +{Calculate Next/Previous} + + DTR := PrevNewMoon(TheDT.D); + if DTR.D <> BadDate then + begin + NMPrevDate.Text := StDateToDateString('mm/dd', DTR.D, False); + NMPrevTime.Text := StTimeToTimeString('hh:mm', DTR.T, False); + end else + begin + NMPrevDate.Text := ''; + NMPrevTime.Text := ''; + end; + + DTR := NextNewMoon(TheDT.D); + if DTR.D <> BadDate then + begin + NMNextDate.Text := StDateToDateString('mm/dd', DTR.D, False); + NMNextTime.Text := StTimeToTimeString('hh:mm', DTR.T, False); + end else + begin + NMNextDate.Text := ''; + NMNextTime.Text := ''; + end; + + + DTR := PrevFirstQuarter(TheDT.D); + if DTR.D <> BadDate then + begin + FQPrevDate.Text := StDateToDateString('mm/dd', DTR.D, False); + FQPrevTime.Text := StTimeToTimeString('hh:mm', DTR.T, False); + end else + begin + FQPrevDate.Text := ''; + FQPrevTime.Text := ''; + end; + + DTR := NextFirstQuarter(TheDT.D); + if DTR.D <> BadDate then + begin + FQNextDate.Text := StDateToDateString('mm/dd', DTR.D, False); + FQNextTime.Text := StTimeToTimeString('hh:mm', DTR.T, False); + end else + begin + FQNextDate.Text := ''; + FQNextTime.Text := ''; + end; + + + DTR := PrevFullMoon(TheDT.D); + if DTR.D <> BadDate then + begin + FMPrevDate.Text := StDateToDateString('mm/dd', DTR.D, False); + FMPrevTime.Text := StTimeToTimeString('hh:mm', DTR.T, False); + end else + begin + FMPrevDate.Text := ''; + FMPrevTime.Text := ''; + end; + + DTR := NextFullMoon(TheDT.D); + if DTR.D <> BadDate then + begin + FMNextDate.Text := StDateToDateString('mm/dd', DTR.D, False); + FMNextTime.Text := StTimeToTimeString('hh:mm', DTR.T, False); + end else + begin + FMNextDate.Text := ''; + FMNextTime.Text := ''; + end; + + + DTR := PrevLastQuarter(TheDT.D); + if DTR.D <> BadDate then + begin + LQPrevDate.Text := StDateToDateString('mm/dd', DTR.D, False); + LQPrevTime.Text := StTimeToTimeString('hh:mm', DTR.T, False); + end else + begin + LQPrevDate.Text := ''; + LQPrevTime.Text := ''; + end; + + DTR := NextLastQuarter(TheDT.D); + if DTR.D <> BadDate then + begin + LQNextDate.Text := StDateToDateString('mm/dd', DTR.D, False); + LQNextTime.Text := StTimeToTimeString('hh:mm', DTR.T, False); + end else + begin + LQNextDate.Text := ''; + LQNextTime.Text := ''; + end; + + +{Calculate Other Events} + + StDateToDMY(TheDT.D, D, M, Y); + EasterEF.Text := StDateToDateString('mm/dd', Easter(Y, 0), False); + + + DTR := Equinox(Y, 0, True); + SpringDate.Text := StDateToDateString('mm/dd', DTR.D, False); + SpringTime.Text := StTimeToTimeString('hh:mm', DTR.T, False); + + + DTR := Equinox(Y, 0, False); + FallDate.Text := StDateToDateString('mm/dd', DTR.D, False); + FallTime.Text := StTimeToTimeString('hh:mm', DTR.T, False); + + + DTR := Solstice(Y, 0, True); + SummerDate.Text := StDateToDateString('mm/dd', DTR.D, False); + SummerTime.Text := StTimeToTimeString('hh:mm', DTR.T, False); + + + DTR := Solstice(Y, 0, False); + WinterDate.Text := StDateToDateString('mm/dd', DTR.D, False); + WinterTime.Text := StTimeToTimeString('hh:mm', DTR.T, False); +end; + + + +procedure TForm1.DoCalcs(ObsLong, ObsLat : Double); +begin + SunlightEF.Text := StTimeToTimeString('hh:mm', + AmountOfSunlight(TheDT.D, ObsLong, ObsLat), False); + + + RS := SunRiseSet(TheDT.D, ObsLong, ObsLat); + SunRiseEF.Text := StTimeToTimeString('hh:mm', RS.ORise, False); + SunSetEF.Text := StTimeToTimeString('hh:mm', RS.OSet, False); + + RS := MoonRiseSet(TheDT.D, ObsLong, ObsLat); + MoonRiseEF.Text := StTimeToTimeString('hh:mm', RS.ORise, False); + MoonSetEF.Text := StTimeToTimeString('hh:mm', RS.OSet, False); + + RS := Twilight(TheDT.D, ObsLong, ObsLat, ttAstronomical); + TwiStartEF.Text := StTimeToTimeString('hh:mm', RS.ORise, False); + TwiEndEF.Text := StTimeToTimeString('hh:mm', RS.OSet, False); +end; + + +procedure TForm1.Button1Click(Sender: TObject); +begin + try + M := StrToInt(MonthEF.Text); + if not (M in [1..12]) then + begin + ShowMessage('Month value out of range (1..12)'); + Exit; + end; + + D := StrToInt(DateEF.Text); + if not (D in [1..31]) then + begin + ShowMessage('Date value out of range (1..31)'); + Exit; + end; + + Y := StrToInt(YearEF.Text); + if (Y < 1800) or (Y > 2200) then + begin + ShowMessage('Year value out of range (1800..2200)'); + Exit; + end; + + TheDT.D := DMYToStDate(D, M, Y, 0); + if TheDT.D = BadDate then + begin + ShowMessage('Invalid date'); + Exit; + end; + TheDT.T := CurrentTime; + + ObsLong := StrToFloat(LongEF.Text); + if (ObsLong < -180) or (ObsLong > 180) then + begin + ShowMessage('Longitude out of range (-180..180)'); + Exit; + end; + + ObsLat := StrToFloat(LatEF.Text); + if (ObsLat < -90) or (ObsLat > 90) then + begin + ShowMessage('Latitude out of range (-90..90)'); + Exit; + end; + + PositionsLB.Clear; + DoFixedCalcs; + DoCalcs(ObsLong, ObsLat); + + except + ShowMessage('One or more entry fields has illegal data'); + end; +end; + +procedure TForm1.FormCreate(Sender: TObject); +begin + TheDT.D := CurrentDate; + TheDT.T := CurrentTime; + + StDateToDMY(TheDT.D, D, M, Y); + MonthEF.Text := IntToStr(M); + DateEF.Text := IntToStr(D); + YearEF.Text := IntToStr(Y); + + LongEF.Text := FloatToStr(-105.27); + LatEF.Text := FloatToStr(38.87); + + DoCalcTimes; + Button1Click(Button1); +end; + +procedure TForm1.Timer1Timer(Sender: TObject); +begin + DoCalcTimes; +end; + +end. diff --git a/components/systools/examples/eclipses/eclipse.lpi b/components/systools/examples/eclipses/eclipse.lpi new file mode 100644 index 000000000..b0b132401 --- /dev/null +++ b/components/systools/examples/eclipses/eclipse.lpi @@ -0,0 +1,85 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <General> + <Flags> + <UseDefaultCompilerOptions Value="True"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="eclipse"/> + <Scaled Value="True"/> + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <XPManifest> + <DpiAware Value="True"/> + </XPManifest> + <Icon Value="0"/> + </General> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + <Modes Count="0"/> + </RunParams> + <RequiredPackages Count="2"> + <Item1> + <PackageName Value="laz_systools"/> + </Item1> + <Item2> + <PackageName Value="LCL"/> + </Item2> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="eclipse.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="eclipseu.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="EclipseU"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="eclipse"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/components/systools/examples/eclipses/eclipse.lpr b/components/systools/examples/eclipses/eclipse.lpr new file mode 100644 index 000000000..3c9fc4d8e --- /dev/null +++ b/components/systools/examples/eclipses/eclipse.lpr @@ -0,0 +1,46 @@ +(* ***** BEGIN LICENSE BLOCK ***** + * Version: MPL 1.1 + * + * The contents of this file are subject to the Mozilla Public License Version + * 1.1 (the "License"); you may not use this file except in compliance with + * the License. You may obtain a copy of the License at + * http://www.mozilla.org/MPL/ + * + * Software distributed under the License is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License + * for the specific language governing rights and limitations under the + * License. + * + * The Original Code is TurboPower SysTools + * + * The Initial Developer of the Original Code is + * TurboPower Software + * + * Portions created by the Initial Developer are Copyright (C) 1996-2002 + * the Initial Developer. All Rights Reserved. + * + * Contributor(s): + * + * ***** END LICENSE BLOCK ***** *) + +{$IFDEF FPC} + {$mode DELPHI} +{$ENDIF} + +program eclipse; + +uses + Interfaces, + Forms, lclversion, + eclipseu in 'eclipseu.pas' {Form1}; + +{$R *.res} + +begin + {$IF LCL_FULLVERSION >= 1080000} + Application.Scaled := True; + {$ENDIF} + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/components/systools/examples/eclipses/eclipseu.lfm b/components/systools/examples/eclipses/eclipseu.lfm new file mode 100644 index 000000000..f637d43dd --- /dev/null +++ b/components/systools/examples/eclipses/eclipseu.lfm @@ -0,0 +1,68 @@ +object Form1: TForm1 + Left = 325 + Height = 283 + Top = 192 + Width = 430 + ActiveControl = Button1 + Caption = 'Eclipse Example' + ClientHeight = 283 + ClientWidth = 430 + Color = clBtnFace + Font.Color = clBlack + OnCreate = FormCreate + Position = poScreenCenter + LCLVersion = '1.9.0.0' + object Memo1: TMemo + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = YearEF + Left = 4 + Height = 219 + Top = 4 + Width = 422 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 4 + BorderSpacing.Top = 4 + BorderSpacing.Right = 4 + BorderSpacing.Bottom = 4 + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'Courier New' + ParentFont = False + ScrollBars = ssVertical + TabOrder = 1 + end + object Button1: TButton + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 112 + Height = 25 + Top = 254 + Width = 206 + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 4 + Caption = 'Generate Eclipse Information' + OnClick = Button1Click + TabOrder = 0 + end + object YearEF: TSpinEdit + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideBottom.Control = Button1 + Left = 179 + Height = 23 + Top = 227 + Width = 72 + Alignment = taCenter + Anchors = [akLeft, akBottom] + BorderSpacing.Bottom = 4 + MaxValue = 32000 + MinValue = -32000 + TabOrder = 2 + Value = 2017 + end +end diff --git a/components/systools/examples/eclipses/eclipseu.pas b/components/systools/examples/eclipses/eclipseu.pas new file mode 100644 index 000000000..4ebd9cefd --- /dev/null +++ b/components/systools/examples/eclipses/eclipseu.pas @@ -0,0 +1,200 @@ +(* ***** BEGIN LICENSE BLOCK ***** + * Version: MPL 1.1 + * + * The contents of this file are subject to the Mozilla Public License Version + * 1.1 (the "License"); you may not use this file except in compliance with + * the License. You may obtain a copy of the License at + * http://www.mozilla.org/MPL/ + * + * Software distributed under the License is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License + * for the specific language governing rights and limitations under the + * License. + * + * The Original Code is TurboPower SysTools + * + * The Initial Developer of the Original Code is + * TurboPower Software + * + * Portions created by the Initial Developer are Copyright (C) 1996-2002 + * the Initial Developer. All Rights Reserved. + * + * Contributor(s): + * + * ***** END LICENSE BLOCK ***** *) + +{$IFDEF FPC} + {$mode DELPHI} +{$ENDIF} + +unit EclipseU; + +interface + +uses + {$IFNDEF FPC} + Windows, Messages, + {$ENDIF} + SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Spin, + StBase, StDate, StList, StEclpse; + +type + + { TForm1 } + + TForm1 = class(TForm) + Memo1: TMemo; + Button1: TButton; + YearEF: TSpinEdit; + procedure Button1Click(Sender: TObject); + procedure FormCreate(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + + procedure WriteLunarData(Eclipse : TStEclipseRecord; SL : TStrings); + procedure WriteSolarData(Eclipse : TStEclipseRecord; SL : TStrings); + end; + +var + Form1: TForm1; + +implementation + +{$R *.lfm} + +procedure TForm1.FormCreate(Sender: TObject); +begin + YearEF.Text := '2017'; +end; + +{-----------------------------------------------------------------------------} + +procedure TForm1.Button1Click(Sender: TObject); +var + I : integer; + Data : TStEclipses; + Eclipse : TStEclipseRecord; +begin + Memo1.Clear; + Data := TStEclipses.Create(TStListNode); + try + Data.FindEclipses(StrToInt(YearEF.Text)); + for I := 0 to pred(Data.Count) do begin + Eclipse := TStEclipseRecord(Data.Eclipses[I]^); + if (Eclipse.Etype in [etLunarPenumbral, etLunarPartial, etLunarTotal]) then + WriteLunarData(Eclipse, Memo1.Lines) + else + WriteSolarData(Eclipse, Memo1.Lines); + end; + finally + Data.Free; + end; +end; + +{-----------------------------------------------------------------------------} + +procedure TForm1.WriteLunarData(Eclipse : TStEclipseRecord; SL : TStrings); +var + S : string[255]; +begin + case Eclipse.EType of + etLunarPenumbral : SL.Add('Lunar - Penumbra'); + etLunarPartial : SL.Add('Lunar - Partial'); + etLunarTotal : SL.Add('Lunar - Total'); + end; + Str(Eclipse.Magnitude : 5 : 3, S); + SL.Add('Mag: ' + S); + + SL.Add('Penumbral Starts: ' + DateTimeToStr(Eclipse.LContacts.UT1)); + SL.Add('First Contact: ' + DateTimeToStr(Eclipse.LContacts.FirstContact)); + SL.Add('Second Contact: ' + DateTimeToStr(Eclipse.LContacts.SecondContact)); + SL.Add('Mid Eclipse ' + DateTimeToStr(Eclipse.LContacts.MidEclipse)); + SL.Add('Third Contact: ' + DateTimeToStr(Eclipse.LContacts.ThirdContact)); + SL.Add('Fourth Contact: ' + DateTimeToStr(Eclipse.LContacts.FourthContact)); + SL.Add('Penumbral Ends: ' + DateTimeToStr(Eclipse.LContacts.UT2)); + + SL.Add(''); + SL.Add(''); + SL.Add(''); +end; + +{-----------------------------------------------------------------------------} + +procedure TForm1.WriteSolarData(Eclipse : TStEclipseRecord; SL : TStrings); +var + I : integer; + S, + P : string[255]; + LL : TStLongLat; +begin + case Eclipse.EType of + etSolarPartial : begin + SL.Add('Solar - Partial'); + Str(Eclipse.Magnitude : 5 : 3, S); + SL.Add('Mag: ' + S); + if Eclipse.Hemisphere = htNorthern then + SL.Add('Hemisphere: Northern') + else + SL.Add('Hemisphere: Southern'); + SL.Add('Mid Eclipse: ' + + DateTimeToStr(Eclipse.LContacts.MidEclipse)); + end; + etSolarTotal : begin + SL.Add('Solar - Total'); + SL.Add('Mag: N/A'); + if Eclipse.Hemisphere = htNorthern then + SL.Add('Hemisphere: Northern') + else + SL.Add('Hemisphere: Southern'); + SL.Add('Mid Eclipse: ' + + DateTimeToStr(Eclipse.LContacts.MidEclipse)); + end; + + etSolarAnnularTotal : begin + Str(Eclipse.Magnitude : 5 : 3, S); + SL.Add('Mag: N/A'); + if Eclipse.Hemisphere = htNorthern then + SL.Add('Hemisphere: Northern') + else + SL.Add('Hemisphere: Southern'); + SL.Add('Mid Eclipse: ' + + DateTimeToStr(Eclipse.LContacts.MidEclipse)); + end; + + etSolarAnnular : begin + SL.Add('Solar - Annular'); + SL.Add('Mag: N/A'); + if Eclipse.Hemisphere = htNorthern then + SL.Add('Hemisphere: Northern') + else + SL.Add('Hemisphere: Southern'); + SL.Add('Mid Eclipse: ' + + DateTimeToStr(Eclipse.LContacts.MidEclipse)); + end; + end; + if Assigned(Eclipse.Path) then begin + for I := 0 to pred(Eclipse.Path.Count) do begin + LL := TStLongLat(Eclipse.Path.Items[I].Data^); + P := ' ' + DateTimeToStr(LL.JD) + ' '; + + Str(LL.Longitude : 7 : 2, S); + P := P + S + ' '; + + Str(LL.Latitude : 6 : 2, S); + P := P + S + ' '; + + Str(LL.Duration : 4 : 2, S); + P := P + S; + SL.Add(P); + end; + end; + SL.Add(''); + SL.Add(''); + SL.Add(''); +end; + + + +end. diff --git a/components/systools/examples/jupiter_moons/exjupst.lpi b/components/systools/examples/jupiter_moons/exjupst.lpi new file mode 100644 index 000000000..7a403fc8c --- /dev/null +++ b/components/systools/examples/jupiter_moons/exjupst.lpi @@ -0,0 +1,86 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <General> + <Flags> + <UseDefaultCompilerOptions Value="True"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="exjupst"/> + <Scaled Value="True"/> + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <XPManifest> + <DpiAware Value="True"/> + </XPManifest> + <Icon Value="0"/> + </General> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + <Modes Count="0"/> + </RunParams> + <RequiredPackages Count="2"> + <Item1> + <PackageName Value="laz_systools"/> + </Item1> + <Item2> + <PackageName Value="LCL"/> + </Item2> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="exjupst.lpr"/> + <IsPartOfProject Value="True"/> + <UnitName Value="ExJupSt"/> + </Unit0> + <Unit1> + <Filename Value="exjupstu.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="ExJupStU"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="exjupst"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/components/systools/examples/jupiter_moons/exjupst.lpr b/components/systools/examples/jupiter_moons/exjupst.lpr new file mode 100644 index 000000000..1c124dcf6 --- /dev/null +++ b/components/systools/examples/jupiter_moons/exjupst.lpr @@ -0,0 +1,46 @@ +(* ***** BEGIN LICENSE BLOCK ***** + * Version: MPL 1.1 + * + * The contents of this file are subject to the Mozilla Public License Version + * 1.1 (the "License"); you may not use this file except in compliance with + * the License. You may obtain a copy of the License at + * http://www.mozilla.org/MPL/ + * + * Software distributed under the License is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License + * for the specific language governing rights and limitations under the + * License. + * + * The Original Code is TurboPower SysTools + * + * The Initial Developer of the Original Code is + * TurboPower Software + * + * Portions created by the Initial Developer are Copyright (C) 1996-2002 + * the Initial Developer. All Rights Reserved. + * + * Contributor(s): + * + * ***** END LICENSE BLOCK ***** *) + +{$IFDEF FPC} + {$mode DELPHI} +{$ENDIF} + +program ExJupSt; + +uses + Interfaces, + Forms, lclversion, + exjupstu in 'exjupstu.pas' {Form1}; + +{$R *.res} + +begin + {$IF LCL_FULLVERSION >= 1080000} + Application.Scaled := True; + {$ENDIF} + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/components/systools/examples/jupiter_moons/exjupstu.lfm b/components/systools/examples/jupiter_moons/exjupstu.lfm new file mode 100644 index 000000000..9958062fd --- /dev/null +++ b/components/systools/examples/jupiter_moons/exjupstu.lfm @@ -0,0 +1,82 @@ +object Form1: TForm1 + Left = 247 + Height = 320 + Top = 125 + Width = 296 + Caption = 'Jupiter''s "Gallilean" Moon Data' + ClientHeight = 320 + ClientWidth = 296 + Color = clBtnFace + Font.Color = clBlack + Font.Height = -11 + Font.Name = 'MS Sans Serif' + OnCreate = FormCreate + Position = poScreenCenter + LCLVersion = '1.9.0.0' + object Label1: TLabel + Left = 42 + Height = 13 + Top = 258 + Width = 23 + Caption = 'Date' + ParentColor = False + end + object Label2: TLabel + Left = 171 + Height = 13 + Top = 258 + Width = 15 + Caption = 'UT' + ParentColor = False + end + object Button1: TButton + Left = 108 + Height = 30 + Top = 285 + Width = 89 + Caption = 'Compute' + Default = True + OnClick = Button1Click + TabOrder = 3 + end + object Memo1: TMemo + Left = 5 + Height = 240 + Top = 7 + Width = 290 + Font.Color = clBlack + Font.Height = -13 + Font.Name = 'Courier New' + Lines.Strings = ( + '' + ) + ParentFont = False + ScrollBars = ssVertical + TabOrder = 0 + WordWrap = False + end + object edDate: TEdit + Cursor = crIBeam + Left = 71 + Height = 21 + Hint = 'mm/dd/yyyy' + Top = 255 + Width = 66 + MaxLength = 10 + ParentShowHint = False + ShowHint = True + TabOrder = 1 + end + object edTime: TEdit + Cursor = crIBeam + Left = 191 + Height = 21 + Hint = 'hh:mm:ss' + Top = 255 + Width = 53 + MaxLength = 8 + ParentShowHint = False + ShowHint = True + TabOrder = 2 + end +end diff --git a/components/systools/examples/jupiter_moons/exjupstu.pas b/components/systools/examples/jupiter_moons/exjupstu.pas new file mode 100644 index 000000000..b445912aa --- /dev/null +++ b/components/systools/examples/jupiter_moons/exjupstu.pas @@ -0,0 +1,152 @@ +(* ***** BEGIN LICENSE BLOCK ***** + * Version: MPL 1.1 + * + * The contents of this file are subject to the Mozilla Public License Version + * 1.1 (the "License"); you may not use this file except in compliance with + * the License. You may obtain a copy of the License at + * http://www.mozilla.org/MPL/ + * + * Software distributed under the License is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License + * for the specific language governing rights and limitations under the + * License. + * + * The Original Code is TurboPower SysTools + * + * The Initial Developer of the Original Code is + * TurboPower Software + * + * Portions created by the Initial Developer are Copyright (C) 1996-2002 + * the Initial Developer. All Rights Reserved. + * + * Contributor(s): + * + * ***** END LICENSE BLOCK ***** *) + +{$IFDEF FPC} + {$mode DELPHI} +{$ENDIF} + +unit ExJupStU; + +interface + +uses + {$IFNDEF FPC} + Windows, Messages, + {$ENDIF} + SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; + +type + TForm1 = class(TForm) + Button1: TButton; + Memo1: TMemo; + edDate: TEdit; + edTime: TEdit; + Label1: TLabel; + Label2: TLabel; + procedure Button1Click(Sender: TObject); + procedure FormCreate(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + end; + +var + Form1: TForm1; + +implementation + +{$R *.lfm} + +uses + StDate, StDateSt, StAstro, StJupSat; + +procedure TForm1.Button1Click(Sender: TObject); +var + D : TDateTime; + XS, + YS : string[20]; + JS : TStJupSats; +begin + Memo1.Clear; + + D := StrToDate(edDate.Text); + if edTime.Text > '' then + D := D + StrToTime(edTime.Text); + + JS := GetJupSats(D, False, False); + + Memo1.Lines.Add('Low Precision'); + Memo1.Lines.Add('--------------------------------'); + Str(JS.Io.X:6:2, XS); + Str(JS.Io.Y:6:2, YS); + Memo1.Lines.Add('Io ' + XS + ' ' + YS); + + Str(JS.Europa.X:6:2, XS); + Str(JS.Europa.Y:6:2, YS); + Memo1.Lines.Add('Europa ' + XS + ' ' + YS); + + Str(JS.Ganymede.X:6:2, XS); + Str(JS.Ganymede.Y:6:2, YS); + Memo1.Lines.Add('Ganymede ' + XS + ' ' + YS); + + Str(JS.Callisto.X:6:2, XS); + Str(JS.Callisto.Y:6:2, YS); + Memo1.Lines.Add('Callisto ' + XS + ' ' + YS); + + + Memo1.Lines.Add(' '); + + JS := GetJupSats(D, True, False); + Memo1.Lines.Add('High Precision - Non Shadow'); + Memo1.Lines.Add('--------------------------------'); + + Str(JS.Io.X:8:4, XS); + Str(JS.Io.Y:8:4, YS); + Memo1.Lines.Add('Io ' + XS + ' ' + YS); + + Str(JS.Europa.X:8:4, XS); + Str(JS.Europa.Y:8:4, YS); + Memo1.Lines.Add('Europa ' + XS + ' ' + YS); + + Str(JS.Ganymede.X:8:4, XS); + Str(JS.Ganymede.Y:8:4, YS); + Memo1.Lines.Add('Ganymede ' + XS + ' ' + YS); + + Str(JS.Callisto.X:8:4, XS); + Str(JS.Callisto.Y:8:4, YS); + Memo1.Lines.Add('Callisto ' + XS + ' ' + YS); + + + Memo1.Lines.Add(' '); + + JS := GetJupSats(D, True, True); + Memo1.Lines.Add('High Precision - Shadow'); + Memo1.Lines.Add('--------------------------------'); + + Str(JS.Io.X:8:4, XS); + Str(JS.Io.Y:8:4, YS); + Memo1.Lines.Add('Io ' + XS + ' ' + YS); + + Str(JS.Europa.X:8:4, XS); + Str(JS.Europa.Y:8:4, YS); + Memo1.Lines.Add('Europa ' + XS + ' ' + YS); + + Str(JS.Ganymede.X:8:4, XS); + Str(JS.Ganymede.Y:8:4, YS); + Memo1.Lines.Add('Ganymede ' + XS + ' ' + YS); + + Str(JS.Callisto.X:8:4, XS); + Str(JS.Callisto.Y:8:4, YS); + Memo1.Lines.Add('Callisto ' + XS + ' ' + YS); +end; + +procedure TForm1.FormCreate(Sender: TObject); +begin + edDate.Text := DateToStr(Date); + edTime.Text := ''; +end; + +end. diff --git a/components/systools/laz_systools.lpk b/components/systools/laz_systools.lpk index 96294863a..fae708501 100644 --- a/components/systools/laz_systools.lpk +++ b/components/systools/laz_systools.lpk @@ -16,7 +16,7 @@ <Description Value="Lazarus port of TurboPower SysTools (Delphi version at https://sourceforge.net/projects/tpsystools/) - runtime package"/> <License Value="MPL 1.1"/> <Version Major="4" Release="4"/> - <Files Count="27"> + <Files Count="40"> <Item1> <Filename Value="source\run\stbarc.pas"/> <UnitName Value="StBarC"/> @@ -125,6 +125,58 @@ <Filename Value="source\run\ststrs.pas"/> <UnitName Value="StStrS"/> </Item27> + <Item28> + <Filename Value="source\run\stastro.pas"/> + <UnitName Value="StAstro"/> + </Item28> + <Item29> + <Filename Value="source\run\steclpse.pas"/> + <UnitName Value="StEclpse"/> + </Item29> + <Item30> + <Filename Value="source\run\stlist.pas"/> + <UnitName Value="StList"/> + </Item30> + <Item31> + <Filename Value="source\run\stmerc.pas"/> + <UnitName Value="StMerc"/> + </Item31> + <Item32> + <Filename Value="source\run\stastrop.pas"/> + <UnitName Value="StAstroP"/> + </Item32> + <Item33> + <Filename Value="source\run\stvenus.pas"/> + <UnitName Value="StVenus"/> + </Item33> + <Item34> + <Filename Value="source\run\stmars.pas"/> + <UnitName Value="StMars"/> + </Item34> + <Item35> + <Filename Value="source\run\stjup.pas"/> + <UnitName Value="StJup"/> + </Item35> + <Item36> + <Filename Value="source\run\stsaturn.pas"/> + <UnitName Value="StSaturn"/> + </Item36> + <Item37> + <Filename Value="source\run\sturanus.pas"/> + <UnitName Value="StUranus"/> + </Item37> + <Item38> + <Filename Value="source\run\stneptun.pas"/> + <UnitName Value="StNeptun"/> + </Item38> + <Item39> + <Filename Value="source\run\stpluto.pas"/> + <UnitName Value="StPluto"/> + </Item39> + <Item40> + <Filename Value="source\run\stjupsat.pas"/> + <UnitName Value="StJupsat"/> + </Item40> </Files> <RequiredPkgs Count="2"> <Item1> diff --git a/components/systools/laz_systools.pas b/components/systools/laz_systools.pas index 38b0493c6..1b54a9de2 100644 --- a/components/systools/laz_systools.pas +++ b/components/systools/laz_systools.pas @@ -10,7 +10,9 @@ interface uses StBarC, StBase, StConst, StBarPN, StStrL, St2DBarC, StDate, StUtils, StCRC, StHASH, StToHTML, StStrms, StDict, StIniStm, StDecMth, StExpr, StMath, - StFIN, StDateSt, StMoney, StRandom, StStat, StLArr, StBCD, StRegEx, StStrS; + StFIN, StDateSt, StMoney, StRandom, StStat, StLArr, StBCD, StRegEx, StStrS, + StAstro, StEclpse, StList, StMerc, StAstroP, StVenus, StMars, StJup, + StSaturn, StUranus, StNeptun, StPluto, StJupsat; implementation diff --git a/components/systools/source/design/StReg.pas b/components/systools/source/design/StReg.pas index 229fe757a..8abde1f19 100644 --- a/components/systools/source/design/StReg.pas +++ b/components/systools/source/design/StReg.pas @@ -85,12 +85,12 @@ uses (* StVInfo, StWMDCpy, + *) {forces these units to be compiled when components are installed} {vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv} StAstro, StAstroP, - *) StBCD, (* StBits, @@ -103,36 +103,38 @@ uses (* StDict, StDQue, - StEclpse, *) + StEclpse, StExpr, StFIN, (* StFirst, *) StHASH, - (* StJup, StJupsat, - *) StLArr, - (* StList, StMars, - *) StMath, - (* StMerc, + (* StMime, + *) StNeptun, + (* StNet, StNetApi, StNVCont, StOStr, + *) StPluto, + (* StPQueue, StRegIni, + *) StSaturn, + (* StSort, *) StStat, @@ -144,14 +146,14 @@ uses StStrZ, StText, StTree, - StUranus, *) + StUranus, StUtils, (* StVArr, + *) StVenus, { new units in ver 4: } - *) StIniStm, (* StMerge, diff --git a/components/systools/source/run/stastro.pas b/components/systools/source/run/stastro.pas new file mode 100644 index 000000000..e11d917e5 --- /dev/null +++ b/components/systools/source/run/stastro.pas @@ -0,0 +1,1799 @@ +// Upgraded to Delphi 2009: Sebastian Zierer + +(* ***** BEGIN LICENSE BLOCK ***** + * Version: MPL 1.1 + * + * The contents of this file are subject to the Mozilla Public License Version + * 1.1 (the "License"); you may not use this file except in compliance with + * the License. You may obtain a copy of the License at + * http://www.mozilla.org/MPL/ + * + * Software distributed under the License is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License + * for the specific language governing rights and limitations under the + * License. + * + * The Original Code is TurboPower SysTools + * + * The Initial Developer of the Original Code is + * TurboPower Software + * + * Portions created by the Initial Developer are Copyright (C) 1996-2002 + * the Initial Developer. All Rights Reserved. + * + * Contributor(s): + * + * ***** END LICENSE BLOCK ***** *) + +{*********************************************************} +{* SysTools: StAstro.pas 4.04 *} +{*********************************************************} +{* SysTools: Astronomical Routines *} +{*********************************************************} + +{$IFDEF FPC} + {$mode DELPHI} +{$ENDIF} + +//{$I StDefine.inc} + +{ ************************************************************** } +{ Sources: } +{ 1. Astronomical Algorithms, Jean Meeus, Willmann-Bell, 1991. } +{ } +{ 2. Planetary and Lunar Coordinates (1984-2000), U.S. Govt, } +{ 1983. } +{ } +{ 3. Supplement to the American Ephemeris and Nautical Almanac,} +{ U.S. Govt, 1964. } +{ } +{ 4. MPO96 source files, Brian D. Warner, 1995. } +{ } +{ ************************************************************** } + +unit StAstro; + +interface + +uses + {$IFNDEF FPC} + Windows, + {$ENDIF} + SysUtils, + StConst, StBase, StDate, StStrS, StDateSt, StMath; + +type + TStTwilight = (ttCivil, ttNautical, ttAstronomical); + + TStRiseSetRec = record + ORise : TStTime; + OSet : TStTime; + end; + + TStPosRec = record + RA, + DC : Double; + end; + TStPosRecArray = array[1..3] of TStPosRec; + + TStSunXYZRec = record + SunX, + SunY, + SunZ, + RV, + SLong, + SLat : Double; + end; + + TStLunarRecord = record + T : array[0..1] of TStDateTimeRec; + end; + + TStPhaseRecord = packed record + NMDate, + FQDate, + FMDate, + LQDate : Double; + end; + TStPhaseArray = array[0..13] of TStPhaseRecord; + + TStDLSDateRec = record + Starts : TStDate; + Ends : TStDate; + end; + + TStMoonPosRec = record + RA, + DC, + Phase, + Dia, + Plx, + Elong : Double; + end; + + +const + radcor = 57.29577951308232; {number of degrees in a radian} + StdDate = 2451545.0; {Ast. Julian Date for J2000 Epoch} + OB2000 = 0.409092804; {J2000 obliquity of the ecliptic (radians)} + + +{Sun procedures/functions} +function AmountOfSunlight(LD : TStDate; Longitude, Latitude : Double) : TStTime; + {-compute the hours, min, sec of sunlight on a given date} +function FixedRiseSet(LD : TStDate; RA, DC, Longitude, Latitude : Double) : TStRiseSetRec; + {-compute the rise and set time for a fixed object, e.g., a star} +function SunPos(UT : TStDateTimeRec) : TStPosRec; + {-compute the J2000 RA/Declination of the Sun} +function SunPosPrim(UT : TStDateTimeRec) : TStSunXYZRec; + {-compute the J2000 geocentric rectangular & ecliptic coordinates of the sun} +function SunRiseSet(LD : TStDate; Longitude, Latitude : Double) : TStRiseSetRec; + {-compute the Sun rise or set time} +function Twilight(LD : TStDate; Longitude, Latitude : Double; TwiType : TStTwilight) : TStRiseSetRec; + {-compute the beginning and end of twilight (civil, nautical, or astron.)} + +{Lunar procedures/functions} +function LunarPhase(UT : TStDateTimeRec) : Double; + {-compute the phase of the moon} +function MoonPos(UT : TStDateTimeRec) : TStMoonPosRec; + {-compute the J2000 RA/Declination of the moon} +function MoonRiseSet(LD : TStDate; Longitude, Latitude : Double) : TStRiseSetRec; + {-compute the Moon rise and set time} +function FirstQuarter(D : TStDate) : TStLunarRecord; + {-compute date/time of FirstQuarter(s)} +function FullMoon(D : TStDate) : TStLunarRecord; + {-compute the date/time of FullMoon(s)} +function LastQuarter(D : TStDate) : TStLunarRecord; + {-compute the date/time of LastQuarter(s)} +function NewMoon(D : TStDate) : TStLunarRecord; + {-compute the date/time of NewMoon(s)} +function NextFirstQuarter(D : TStDate) : TStDateTimeRec; + {-compute the date/time of the next closest FirstQuarter} +function NextFullMoon(D : TStDate) : TStDateTimeRec; + {-compute the date/time of the next closest FullMoon} +function NextLastQuarter(D : TStDate) : TStDateTimeRec; + {-compute the date/time of the next closest LastQuarter} +function NextNewMoon(D : TStDate) : TStDateTimeRec; + {-compute the date/time of the next closest NewMoon} +function PrevFirstQuarter(D : TStDate) : TStDateTimeRec; + {-compute the date/time of the prev closest FirstQuarter} +function PrevFullMoon(D : TStDate) : TStDateTimeRec; + {-compute the date/time of the prev closest FullMoon} +function PrevLastQuarter(D : TStDate) : TStDateTimeRec; + {-compute the date/time of the prev closest LastQuarter} +function PrevNewMoon(D : TStDate) : TStDateTimeRec; + {-compute the date/time of the prev closest NewMoon} + +{Calendar procedures/functions} +function SiderealTime(UT : TStDateTimeRec) : Double; + {-compute Sidereal Time at Greenwich} +function Solstice(Y, Epoch : Integer; Summer : Boolean) : TStDateTimeRec; + {-compute the date/time of the summer or winter solstice} +function Equinox(Y, Epoch : Integer; Vernal : Boolean) : TStDateTimeRec; + {-compute the date/time of the vernal/autumnal equinox} +function Easter(Y, Epoch : Integer) : TStDate; + {-compute the date of Easter (astronmical calendar)} + +{Astronomical Julian Date Conversions} +function DateTimeToAJD(D : TDateTime) : Double; + +{Conversion routines} +function HoursMin(RA : Double) : String; + {-convert RA to hh:mm:ss string} +function DegsMin(DC : Double) : String; + {-convert Declination to +/-dd:mm:ss string} +function AJDToDateTime(D : Double) : TDateTime; + + +implementation + +var + AJDOffset : Double; + +function CheckDate(UT : TStDateTimeRec) : Boolean; +begin + with UT do begin + if (D < MinDate) or (D > MaxDate) or + (T < 0) or (T > MaxTime) then + Result := False + else + Result := True; + end; +end; + +function CheckYear(Y, Epoch : Integer) : Integer; +begin + if Y < 100 then begin + if Y >= (Epoch mod 100) then + Result := ((Epoch div 100) * 100) + Y + else + Result := ((Epoch div 100) * 100) + 100 + Y; + end else + Result := Y; +end; + +function SiderealTime(UT : TStDateTimeRec) : Double; + {-compute Sidereal Time at Greenwich in degrees} +var + T, + JD : Double; +begin + if not CheckDate(UT) then begin + Result := -1; + Exit; + end; + + JD := AstJulianDate(UT.D) + UT.T/86400; + + T := (JD - 2451545.0) / 36525.0; + + Result := 280.46061837 + + 360.98564736629 * (JD - 2451545.0) + + 0.000387933 * sqr(T) + - (sqr(T) * T / 38710000); + Result := Frac(Result/360.0) * 360.0; + if Result < 0 then + Result := 360 + Result; +end; + +function SunPosPrim(UT : TStDateTimeRec) : TStSunXYZRec; + {-compute J2000 XYZ coordinates of the Sun} +var + JD, + T0, + A, + L, + B, + X,Y,Z : Double; + +begin + if not CheckDate(UT) then begin + with Result do begin + SunX := -99; + SunY := -99; + SunZ := -99; + RV := -99; + SLong := -99; + SLat := -99; + end; + Exit; + end; + + JD := AstJulianDate(UT.D) + UT.T/86400; + T0 := (JD - StdDate) / 365250; + +{solar longitude} + L := 175347046 + + 3341656 * cos(4.6692568 + 6283.07585*T0) + + 34894 * cos(4.6261000 + 12566.1517*T0) + + 3497 * cos(2.7441000 + 5753.3849*T0) + + 3418 * cos(2.8289000 + 3.5231*T0) + + 3136 * cos(3.6277000 + 77713.7715*T0) + + 2676 * cos(4.4181000 + 7860.4194*T0) + + 2343 * cos(6.1352000 + 3930.2097*T0) + + 1324 * cos(0.7425000 + 11506.7698*T0) + + 1273 * cos(2.0371000 + 529.6910*T0) + + 1199 * cos(1.1096000 + 1577.3435*T0) + + 990 * cos(5.2330000 + 5884.9270*T0) + + 902 * cos(2.0450000 + 26.1490*T0) + + 857 * cos(3.5080000 + 398.149*T0) + + 780 * cos(1.1790000 + 5223.694*T0) + + 753 * cos(2.5330000 + 5507.553*T0) + + 505 * cos(4.5830000 + 18849.228*T0) + + 492 * cos(4.2050000 + 775.523*T0) + + 357 * cos(2.9200000 + 0.067*T0) + + 317 * cos(5.8490000 + 11790.626*T0) + + 284 * cos(1.8990000 + 796.298*T0) + + 271 * cos(0.3150000 + 10977.079*T0) + + 243 * cos(0.3450000 + 5486.778*T0) + + 206 * cos(4.8060000 + 2544.314*T0) + + 205 * cos(1.8690000 + 5573.143*T0) + + 202 * cos(2.4580000 + 6069.777*T0) + + 156 * cos(0.8330000 + 213.299*T0) + + 132 * cos(3.4110000 + 2942.463*T0) + + 126 * cos(1.0830000 + 20.775*T0) + + 115 * cos(0.6450000 + 0.980*T0) + + 103 * cos(0.6360000 + 4694.003*T0) + + 102 * cos(0.9760000 + 15720.839*T0) + + 102 * cos(4.2670000 + 7.114*T0) + + 99 * cos(6.2100000 + 2146.170*T0) + + 98 * cos(0.6800000 + 155.420*T0) + + 86 * cos(5.9800000 +161000.690*T0) + + 85 * cos(1.3000000 + 6275.960*T0) + + 85 * cos(3.6700000 + 71430.700*T0) + + 80 * cos(1.8100000 + 17260.150*T0); + + A := 628307584999.0 + + 206059 * cos(2.678235 + 6283.07585*T0) + + 4303 * cos(2.635100 + 12566.1517*T0) + + 425 * cos(1.590000 + 3.523*T0) + + 119 * cos(5.796000 + 26.298*T0) + + 109 * cos(2.966000 + 1577.344*T0) + + 93 * cos(2.590000 + 18849.23*T0) + + 72 * cos(1.140000 + 529.69*T0) + + 68 * cos(1.870000 + 398.15*T0) + + 67 * cos(4.410000 + 5507.55*T0) + + 59 * cos(2.890000 + 5223.69*T0) + + 56 * cos(2.170000 + 155.42*T0) + + 45 * cos(0.400000 + 796.30*T0) + + 36 * cos(0.470000 + 775.52*T0) + + 29 * cos(2.650000 + 7.11*T0) + + 21 * cos(5.340000 + 0.98*T0) + + 19 * cos(1.850000 + 5486.78*T0) + + 19 * cos(4.970000 + 213.30*T0) + + 17 * cos(2.990000 + 6275.96*T0) + + 16 * cos(0.030000 + 2544.31*T0); + L := L + (A * T0); + + A := 8722 * cos(1.0725 + 6283.0758*T0) + + 991 * cos(3.1416) + + 295 * cos(0.437 + 12566.1520*T0) + + 27 * cos(0.050 + 3.52*T0) + + 16 * cos(5.190 + 26.30*T0) + + 16 * cos(3.69 + 155.42*T0) + + 9 * cos(0.30 + 18849.23*T0) + + 9 * cos(2.06 + 77713.77*T0); + L := L + (A * sqr(T0)); + + A := 289 * cos(5.842 + 6283.076*T0) + + 21 * cos(6.05 + 12566.15*T0) + + 3 * cos(5.20 + 155.42*T0) + + 3 * cos(3.14); + L := L + (A * sqr(T0) * T0); + L := L / 1.0E+8; + + +{solar latitude} + B := 280 * cos(3.199 + 84334.662*T0) + + 102 * cos(5.422 + 5507.553*T0) + + 80 * cos(3.88 + 5223.69*T0) + + 44 * cos(3.70 + 2352.87*T0) + + 32 * cos(4.00 + 1577.34*T0); + B := B / 1.0E+8; + + A := 227778 * cos(3.413766 + 6283.07585*T0) + + 3806 * cos(3.3706 + 12566.1517*T0) + + 3620 + + 72 * cos(3.33 + 18849.23*T0) + + 8 * cos(3.89 + 5507.55*T0) + + 8 * cos(1.79 + 5223.69*T0) + + 6 * cos(5.20 + 2352.87*T0); + B := B + (A * T0 / 1.0E+8); + + A := 9721 * cos(5.1519 + 6283.07585*T0) + + 233 * cos(3.1416) + + 134 * cos(0.644 + 12566.152*T0) + + 7 * cos(1.07 + 18849.23*T0); + B := B + (A * sqr(T0) / 1.0E+8); + + A := 276 * cos(0.595 + 6283.076*T0) + + 17 * cos(3.14) + + 4 * cos(0.12 + 12566.15*T0); + B := B + (A * sqr(T0) * T0 / 1.0E+8); + + +{solar radius vector (astronomical units)} + Result.RV := 100013989 + + 1670700 * cos(3.0984635 + 6283.07585*T0) + + 13956 * cos(3.05525 + 12566.15170*T0) + + 3084 * cos(5.1985 + 77713.7715*T0) + + 1628 * cos(1.1739 + 5753.3849*T0) + + 1576 * cos(2.8649 + 7860.4194*T0) + + 925 * cos(5.453 + 11506.770*T0) + + 542 * cos(4.564 + 3930.210*T0) + + 472 * cos(3.661 + 5884.927*T0) + + 346 * cos(0.964 + 5507.553*T0) + + 329 * cos(5.900 + 5223.694*T0) + + 307 * cos(0.299 + 5573.143*T0) + + 243 * cos(4.273 + 11790.629*T0) + + 212 * cos(5.847 + 1577.344*T0) + + 186 * cos(5.022 + 10977.079*T0) + + 175 * cos(3.012 + 18849.228*T0) + + 110 * cos(5.055 + 5486.778*T0) + + 98 * cos(0.89 + 6069.78*T0) + + 86 * cos(5.69 + 15720.84*T0) + + 86 * cos(1.27 +161000.69*T0) + + 65 * cos(0.27 + 17260.15*T0) + + 63 * cos(0.92 + 529.69*T0) + + 57 * cos(2.01 + 83996.85*T0) + + 56 * cos(5.24 + 71430.70*T0) + + 49 * cos(3.25 + 2544.31*T0) + + 47 * cos(2.58 + 775.52*T0) + + 45 * cos(5.54 + 9437.76*T0) + + 43 * cos(6.01 + 6275.96*T0) + + 39 * cos(5.36 + 4694.00*T0) + + 38 * cos(2.39 + 8827.39*T0) + + 37 * cos(0.83 + 19651.05*T0) + + 37 * cos(4.90 + 12139.55*T0) + + 36 * cos(1.67 + 12036.46*T0) + + 35 * cos(1.84 + 2942.46*T0) + + 33 * cos(0.24 + 7084.90*T0) + + 32 * cos(0.18 + 5088.63*T0) + + 32 * cos(1.78 + 398.15*T0) + + 28 * cos(1.21 + 6286.60*T0) + + 28 * cos(1.90 + 6279.55*T0) + + 26 * cos(4.59 + 10447.39*T0); + Result.RV := Result.RV / 1.0E+8; + + A := 103019 * cos(1.107490 + 6283.075850*T0) + + 1721 * cos(1.0644 + 12566.1517*T0) + + 702 * cos(3.142) + + 32 * cos(1.02 + 18849.23*T0) + + 31 * cos(2.84 + 5507.55*T0) + + 25 * cos(1.32 + 5223.69*T0) + + 18 * cos(1.42 + 1577.34*T0) + + 10 * cos(5.91 + 10977.08*T0) + + 9 * cos(1.42 + 6275.96*T0) + + 9 * cos(0.27 + 5486.78*T0); + Result.RV := Result.RV + (A * T0 / 1.0E+8); + + A := 4359 * cos(5.7846 + 6283.0758*T0) + + 124 * cos(5.579 + 12566.152*T0) + + 12 * cos(3.14) + + 9 * cos(3.63 + 77713.77*T0) + + 6 * cos(1.87 + 5573.14*T0) + + 3 * cos(5.47 + 18849.23*T0); + Result.RV := Result.RV + (A * sqr(T0) / 1.0E+8); + + L := (L + PI); + L := Frac(L / 2.0 / PI) * 2.0 * Pi; + if L < 0 then + L := L + (2.0*PI); + B := -B; + + Result.SLong := L * radcor; + Result.SLat := B * radcor; + + X := Result.RV * cos(B) * cos(L); + Y := Result.RV * cos(B) * sin(L); + Z := Result.RV * sin(B); + + Result.SunX := X + 4.40360E-7 * Y - 1.90919E-7 * Z; + Result.SunY := -4.79966E-7 * X + 0.917482137087 * Y - 0.397776982902 * Z; + Result.SunZ := 0.397776982902 * Y + 0.917482137087 * Z; +end; + +function MoonPosPrim(UT : TStDateTimeRec) : TStMoonPosRec; + {-computes J2000 coordinates of the moon} +var + JD, + TD, + JCent, + JC2, JC3, JC4, + LP, D, + M, MP, + F, I, + A1,A2,A3, + MoonLong, + MoonLat, + MoonDst, + S1,C1, + SunRA, + SunDC, + EE,EES : Double; + + SP : TStSunXYZRec; + +begin + JD := AstJulianDate(UT.D) + UT.T/86400; + JCent := (JD - 2451545) / 36525; + JC2 := sqr(JCent); + JC3 := JC2 * JCent; + JC4 := sqr(JC2); + + SP := SunPosPrim(UT); + SunRA := StInvTan2(SP.SunX, SP.SunY) * radcor; + SunDC := StInvSin(SP.SunZ / SP.RV) * radcor; + + +{Lunar mean longitude} + LP := 218.3164591 + (481267.88134236 * JCent) + - (1.3268E-3 * JC2) + (JC3 / 538841) - (JC4 / 65194000); + LP := Frac(LP/360) * 360; + if LP < 0 then + LP := LP + 360; + LP := LP/radcor; + +{Lunar mean elongation} + D := 297.8502042 + (445267.1115168 * JCent) + - (1.63E-3 * JC2) + (JC3 / 545868) - (JC4 / 113065000); + D := Frac(D/360) * 360; + if D < 0 then + D := D + 360; + D := D/radcor; + +{Solar mean anomaly} + M := 357.5291092 + (35999.0502909 * JCent) + - (1.536E-4 * JC2) + (JC3 / 24490000); + M := Frac(M/360) * 360; + if M < 0 then + M := M + 360; + M := M/radcor; + +{Lunar mean anomaly} + MP := 134.9634114 + (477198.8676313 * JCent) + + (8.997E-3 * JC2) + (JC3 / 69699) - (JC4 / 14712000); + MP := Frac(MP/360) * 360; + if MP < 0 then + MP := MP + 360; + MP := MP/radcor; + +{Lunar argument of latitude} + F := 93.2720993 + (483202.0175273 * JCent) + - (3.4029E-3 * JC2) - (JC3 / 3526000) + (JC4 / 863310000); + F := Frac(F/360) * 360; + if F < 0 then + F := F + 360; + F := F/radcor; + + +{Other required arguments} + A1 := 119.75 + (131.849 * JCent); + A1 := Frac(A1/360) * 360; + if A1 < 0 then + A1 := A1 + 360; + A1 := A1/radcor; + + A2 := 53.09 + (479264.290 * JCent); + A2 := Frac(A2/360) * 360; + if A2 < 0 then + A2 := A2 + 360; + A2 := A2/radcor; + + A3 := 313.45 + (481266.484 * JCent); + A3 := Frac(A3/360) * 360; + if A3 < 0 then + A3 := A3 + 360; + A3 := A3/radcor; + +{Earth's orbital eccentricity} + EE := 1.0 - (2.516E-3 * JCent) - (7.4E-6 * JC2); + EES := sqr(EE); + + MoonLong := 6288774 * sin(MP) + + 1274027 * sin(2*D - MP) + + 658314 * sin(2*D) + + 213618 * sin(2*MP) + - 185116 * sin(M) * EE + - 114332 * sin(2*F) + + 58793 * sin(2*(D-MP)) + + 57066 * sin(2*D-M-MP) * EE + + 53322 * sin(2*D-MP) + + 45758 * sin(2*D-M) * EE + - 40923 * sin(M-MP) * EE + - 34720 * sin(D) + - 30383 * sin(M+MP) * EE + + 15327 * sin(2*(D-F)) + - 12528 * sin(MP+2*F) + + 10980 * sin(MP-2*F) + + 10675 * sin(4*D-MP) + + 10034 * sin(3*MP) + + 8548 * sin(4*D-2*MP) + - 7888 * sin(2*D+M-MP) * EE + - 6766 * sin(2*D+M) * EE + - 5163 * sin(D-MP) + + 4987 * sin(D+M) * EE + + 4036 * sin(2*D-M+MP) * EE + + 3994 * sin(2*(D+MP)) + + 3861 * sin(4*D) + + 3665 * sin(2*D-3*MP) + - 2689 * sin(M-2*MP) * EE + - 2602 * sin(2*D-MP+2*F) + + 2390 * sin(2*D-M-2*MP) * EE + - 2348 * sin(D-MP) + + 2236 * sin(2*(D-M)) * EES + - 2120 * sin(M-2*MP) * EE + - 2069 * sin(2*M) * EE + + 2048 * sin(2*D-2*M-MP) * EES + - 1773 * sin(2*D+MP-2*F) + - 1595 * sin(2*(D+F)) + + 1215 * sin(4*D-M-MP) * EE + - 1110 * sin(2*(MP+F)) + - 892 * sin(3*D-MP) + - 810 * sin(2*D-M-MP) * EE + + 759 * sin(4*D-M-2*MP) * EE + - 713 * sin(2*M-MP) * EE + - 700 * sin(2*D+2*M-MP) * EES + + 691 * sin(2*D+M-2*MP) * EE + + 596 * sin(2*D-M-2*F) * EE + + 549 * sin(4*D+MP) + + 537 * sin(4*MP) + + 520 * sin(4*D-M) * EE; + + MoonDst := - 20905355 * cos(MP) + - 3699111 * cos(2*D - MP) + - 2955968 * cos(2*D) + - 569925 * cos(2*MP) + + 48888 * cos(M) * EE + - 3149 * cos(2*F) + + 246158 * cos(2*(D-MP)) + - 152138 * cos(2*D-M-MP) * EE + - 170733 * cos(2*D-MP) + - 204586 * cos(2*D-M) * EE + - 129620 * cos(M-MP) * EE + + 108743 * cos(D) + + 104755 * cos(M-MP) * EE + + 10321 * cos(2*D-2*F) + + 79661 * cos(MP-2*F) + - 34782 * cos(4*D-MP) + - 23210 * cos(3*MP) + - 21636 * cos(4*D-2*MP) + + 24208 * cos(2*D+M-MP) * EE + + 30824 * cos(2*D-M) * EE + - 8379 * cos(D-MP) + - 16675 * cos(D+M) * EE + - 12831 * cos(2*D-M+MP) * EE + - 10445 * cos(2*D+2*MP) + - 11650 * cos(4*D) * EE + + 14403 * cos(2*D+3*MP) + - 7003 * cos(M-2*MP) * EE + + 10056 * cos(2*D-M-2*MP) * EE + + 6322 * cos(D+MP) + - 9884 * cos(2*D-2*M) * EES + + 5751 * cos(M+2*MP) * EE + - 4950 * cos(2*D-2*M-MP) * EES + + 4130 * cos(2*D+MP+2*F) + - 3958 * cos(4*D-M-MP) * EE + + 3258 * cos(3*D-MP) + + 2616 * cos(2*D+M+MP) * EE + - 1897 * cos(4*D-M-2*MP) * EE + - 2117 * cos(2*M-MP) * EES + + 2354 * cos(2*D+2*M-MP) * EES + - 1423 * cos(4*D+MP) + - 1117 * cos(4*MP) + - 1571 * cos(4*D-M) * EE + - 1739 * cos(D-2*MP) + - 4421 * cos(2*MP-2*F) + + 1165 * cos(2*M+MP) + + 8752 * cos(2*D-MP-2*F); + + MoonLat := 5128122 * sin(F) + + 280602 * sin(MP+F) + + 277693 * sin(MP-F) + + 173237 * sin(2*D-F) + + 55413 * sin(2*D-MP+F) + + 46271 * sin(2*D-MP-F) + + 32573 * sin(2*D+F) + + 17198 * sin(2*MP+F) + + 9266 * sin(2*D+MP-F) + + 8822 * sin(2*MP-F) + + 8216 * sin(2*D-M-F) * EE + + 4324 * sin(2*D-2*MP-F) + + 4200 * sin(2*D+MP+F) + - 3359 * sin(2*D+M-F) * EE + + 2463 * sin(2*D-M-MP+F) * EE + + 2211 * sin(2*D-M+F) * EE + + 2065 * sin(2*D-M-MP-F) * EE + - 1870 * sin(M-MP-F) * EE + + 1828 * sin(4*D-MP-F) + - 1794 * sin(M+F) * EE + - 1749 * sin(3*F) + - 1565 * sin(M-MP+F) * EE + - 1491 * sin(D+F) + - 1475 * sin(M+MP+F) * EE + - 1410 * sin(M+MP-F) * EE + - 1344 * sin(M-F) * EE + - 1335 * sin(D-F) + + 1107 * sin(3*MP+F) + + 1021 * sin(4*D-F) + + 833 * sin(4*D-MP+F) + + 777 * sin(MP-3*F) + + 671 * sin(4*D-2*MP+F) + + 607 * sin(2*D-3*F) + + 596 * sin(2*D+2*MP-F) + + 491 * sin(2*D-M+MP-F) * EE + - 451 * sin(2*D-2*MP+F) + + 439 * sin(3*MP-F) + + 422 * sin(2*D+2*MP+F) + + 421 * sin(2*D-3*MP-F) + - 366 * sin(2*D+M-MP+F) * EE + - 351 * sin(2*D+M+F) * EE + + 331 * sin(4*D+F) + + 315 * sin(2*D-M+MP+F) * EE + + 302 * sin(2*D-2*M-F) * EES + - 283 * sin(MP + 3*F) + - 229 * sin(2*D+M+MP-F) * EE + + 223 * sin(D+M-F) * EE + + 223 * sin(D+M+F) * EE; + + MoonLong := MoonLong + + 3958 * sin(A1) + + 1962 * sin(LP-F) + + 318 * sin(A2); + + MoonLat := MoonLat + - 2235 * sin(LP) + + 382 * sin(A3) + + 175 * sin(A1-F) + + 175 * sin(A1+F) + + 127 * sin(LP-MP) + - 115 * sin(LP+MP); + + MoonLong := LP + MoonLong/1000000/radcor; + MoonLat := MoonLat/1000000/radcor; + MoonDst := 385000.56 + MoonDst/1000; + + Result.Plx := StInvSin(6378.14/MoonDst) * radcor; + Result.Dia := 358473400 / MoonDst * 2 / 3600; + + S1 := sin(MoonLong) * cos(OB2000) - StTan(MoonLat) * sin(OB2000); + C1 := cos(MoonLong); + Result.RA := StInvTan2(C1, S1) * radcor; + + TD := sin(MoonLat) * cos(OB2000) + + cos(MoonLat) * sin(OB2000) * sin(MoonLong); + TD := StInvSin(TD); + Result.DC := TD * radcor; + + I := sin(SunDC/radcor) * sin(TD) + + cos(SunDC/radcor) * cos(TD) * cos((SunRA-Result.RA)/radcor); + Result.Phase := (1 - I) / 2; + + I := StInvCos(I) * radcor; + Result.Elong := (Result.RA - SunRA); + if Result.Elong < 0 then + Result.Elong := 360 + Result.Elong; + if Result.Elong >= 180 then begin + Result.Phase := -Result.Phase; {waning moon} + Result.Elong := -I + end else + Result.Elong := I; +end; + +function AmountOfSunlight(LD : TStDate; Longitude, Latitude : Double): TStTime; + {-compute the hours, min, sec of sunlight on a given date} +var + RS : TStRiseSetRec; +begin + RS := SunRiseSet(LD, Longitude, Latitude); + with RS do begin + if ORise = -3 then begin + {sun is always above the horizon} + Result := SecondsInDay; + Exit; + end; + + if ORise = -2 then begin + {sun is always below horizon} + Result := 0; + Exit; + end; + + if (ORise > -1) then begin + if (OSet > -1) then + Result := OSet - ORise + else + Result := SecondsInDay - ORise; + end else begin + if (OSet > -1) then + Result := OSet + else + Result := 0; + end; + end; + if (Result < 0) then + Result := Result + SecondsInDay + else if (Result >= SecondsInDay) then + Result := Result - SecondsInDay; +end; + +function SunPos(UT : TStDateTimeRec) : TStPosRec; + {-compute the RA/Declination of the Sun} +var + SP : TStSunXYZRec; +begin + if not CheckDate(UT) then begin + Result.RA := -1; + Result.DC := -99; + Exit; + end; + + SP := SunPosPrim(UT); + Result.RA := StInvTan2(SP.SunX, SP.SunY) * radcor; + Result.DC := StInvSin(SP.SunZ / SP.RV) * radcor; +end; + +function RiseSetPrim(LD : TStDate; + Longitude, Latitude, H0 : Double; + PR : TStPosRecArray; + ApproxOnly : Boolean) : TStRiseSetRec; + {-primitive routine for finding rise/set times} +var + ST, + NST, + HA, + LatR, + N1, + N2, + N3, + TTran, + TRise, + TSet, + TV1, + TV2, + A1, + A2, + DeltaR, + DeltaS, + RA, + DC, + Alt : Double; + + ICount : SmallInt; + + UT : TStDateTimeRec; +begin + H0 := H0/radcor; + + UT.D := LD; + UT.T := 0; + ST := SiderealTime(UT); + + LatR := Latitude/radcor; + +{check if object never rises/sets} + N1 := sin(H0) - sin(LatR) * sin(PR[2].DC/radcor); + N2 := cos(LatR) * cos(PR[2].DC/radcor); + + HA := N1 / N2; + if (abs(HA) >= 1) then begin +{ if ((Latitude - 90) >= 90) then begin} + if (HA > 0) then begin +{object never rises} + Result.ORise := -2; + Result.OSet := -2; + end else begin +{object never sets, i.e., it is circumpolar} + Result.ORise := -3; + Result.OSet := -3; + end; + Exit; + end; + + HA := StInvCos(HA) * radcor; + if HA > 180 then + HA := HA - 180; + if HA < 0 then + HA := HA + 180; + +{compute approximate hour angle at transit} + TTran := (PR[2].RA - Longitude - ST) / 360; + if abs(TTran) >= 1 then + TTran:= Frac(TTran); + if TTran < 0 then + TTran := TTran + 1; + + TRise := TTran - HA/360; + TSet := TTran + HA/360; + if abs(TRise) >= 1 then + TRise:= Frac(TRise); + if TRise < 0 then + TRise := TRise + 1; + + if abs(TSet) >= 1 then + TSet := Frac(TSet); + if TSet < 0 then + TSet := TSet + 1; + + if not ApproxOnly then begin +{refine rise time by interpolation/iteration} + ICount := 0; + TV1 := 0; + A1 := 0; + repeat + NST := ST + 360.985647 * TRise; + NST := Frac(NST / 360.0) * 360; + N1 := PR[2].RA - PR[1].RA; + N2 := PR[3].RA - PR[2].RA; + N3 := N2 - N1; + RA := PR[2].RA + TRise/2 * (N1 + N2 + TRise*N3); + + N1 := PR[2].DC - PR[1].DC; + N2 := PR[3].DC - PR[2].DC; + N3 := N2 - N1; + DC := PR[2].DC + TRise/2 * (N1 + N2 + TRise*N3); + DC := DC/radcor; + + HA := (NST + Longitude - RA) / radcor; + Alt := StInvSin(sin(LatR) * sin(DC) + cos(LatR) * cos(DC) * cos(HA)); + DeltaR := ((Alt - H0) * radcor) / (360 * cos(DC) * cos(LatR) * sin(HA)); + TRise := TRise + DeltaR; + Inc(ICount); + if (ICount > 3) and (abs(DeltaR) >= 0.0005) then begin + if (ICount = 4) then begin + TV1 := TRise; + A1 := (Alt-H0) * radcor; + end else if (ICount = 5) then begin + TV2 := TRise; + A2 := (Alt-H0) * radcor; + + TRise := TV1 + (A1 / A2) * (TV1 - TV2); + break; + end; + end; + until (abs(DeltaR) < 0.0005); {0.0005d = 0.72 min} + + {refine set time by interpolation/iteration} + ICount := 0; + TV1 := 0; + A1 := 0; + repeat + NST := ST + 360.985647 * TSet; + NST := Frac(NST / 360.0) * 360; + N1 := PR[2].RA - PR[1].RA; + N2 := PR[3].RA - PR[2].RA; + N3 := N2 - N1; + RA := PR[2].RA + TSet/2 * (N1 + N2 + TSet*N3); + + N1 := PR[2].DC - PR[1].DC; + N2 := PR[3].DC - PR[2].DC; + N3 := N2 - N1; + DC := PR[2].DC + TSet/2 * (N1 + N2 + TSet*N3); + DC := DC/radcor; + + HA := (NST + Longitude - RA) / radcor; + Alt := StInvSin(sin(LatR) * sin(DC) + cos(LatR) * cos(DC) * cos(HA)); + DeltaS := ((Alt - H0) * radcor) / (360 * cos(DC) * cos(LatR) * sin(HA)); + TSet := TSet + DeltaS; + Inc(ICount); + if (ICount > 3) and (abs(DeltaS) >= 0.0005) then begin + if (ICount = 4) then begin + TV1 := TSet; + A1 := (Alt-H0) * radcor; + end else if (ICount = 5) then begin + TV2 := TSet; + A2 := (Alt-H0) * radcor; + + TSet := TV1 + (A1 / A2) * (TV1 - TV2); + break; + end; + end; + until (abs(DeltaS) < 0.0005); {0.0005d = 0.72 min} + end; + + if (TRise >= 0) and (TRise < 1) then + Result.ORise := Trunc(TRise * SecondsInDay) + else begin + if TRise < 0 then + Result.ORise := Trunc((TRise + 1) * SecondsInDay) + else + Result.ORise := Trunc(Frac(TRise) * SecondsInDay); + end; + if Result.ORise < 0 then + Inc(Result.ORise, SecondsInDay); + if Result.ORise >= SecondsInDay then + Dec(Result.ORise, SecondsInDay); + + + if (TSet >= 0) and (TSet < 1) then + Result.OSet := Trunc(TSet * SecondsInDay) + else begin + if TSet < 0 then + Result.OSet := Trunc((TSet + 1) * SecondsInDay) + else + Result.OSet := Trunc(Frac(TSet) * SecondsInDay); + end; + if Result.OSet < 0 then + Inc(Result.OSet, SecondsInDay); + if Result.OSet >= SecondsInDay then + Dec(Result.OSet, SecondsInDay); +end; + +function SunRiseSet(LD : TStDate; Longitude, Latitude : Double) : TStRiseSetRec; + {-compute the Sun rise or set time} + {the value for H0 accounts for approximate refraction of 0.5667 deg. and} + {that rise or set is based on the upper limb instead of the center of the solar disc} +var + I : Integer; + H0 : Double; + UT : TStDateTimeRec; + RP : TStPosRecArray; +begin + Dec(LD); + H0 := -0.8333; + UT.T := 0; + UT.D := LD-1; + + if CheckDate(UT) then begin + UT.D := UT.D + 2; + if (not CheckDate(UT)) then begin + Result.ORise := -4; + Result.OSet := -4; + Exit; + end else + UT.D := UT.D-2; + end else begin + Result.ORise := -4; + Result.OSet := -4; + Exit; + end; + + for I := 1 to 3 do begin + RP[I] := SunPos(UT); + if I >= 2 then begin + if RP[I].RA < RP[I-1].RA then + RP[I].RA := RP[I].RA + 360; + end; + Inc(UT.D); + end; + Result := RiseSetPrim(LD, Longitude, Latitude, H0, RP, False); +end; + +function Twilight(LD : TStDate; Longitude, Latitude : Double; + TwiType : TStTwilight) : TStRiseSetRec; + {-compute the beginning or end of twilight} + {twilight computations are based on the zenith distance of the center } + {of the solar disc.} + {Civil = 6 deg. below the horizon} + {Nautical = 12 deg. below the horizon} + {Astronomical = 18 deg. below the horizon} +var + I : Integer; + H0 : Double; + UT : TStDateTimeRec; + RP : TStPosRecArray; +begin + UT.D := LD-1; + UT.T := 0; + + if CheckDate(UT) then begin + UT.D := UT.D + 2; + if (not CheckDate(UT)) then begin + Result.ORise := -4; + Result.OSet := -4; + Exit; + end else + UT.D := UT.D-2; + end else begin + Result.ORise := -4; + Result.OSet := -4; + Exit; + end; + + case TwiType of + ttCivil : H0 := -6.0; + ttNautical : H0 := -12.0; + ttAstronomical : H0 := -18.0; + else + H0 := -18.0; + end; + + for I := 1 to 3 do begin + UT.D := LD + I-1; + RP[I] := SunPos(UT); + if (I > 1) then begin + if RP[I].RA < RP[I-1].RA then + RP[I].RA := RP[I].RA + 360.0; + end; + end; + Result := RiseSetPrim(LD, Longitude, Latitude, H0, RP, False); +end; + +function FixedRiseSet(LD : TStDate; + RA, DC, Longitude, Latitude : Double) : TStRiseSetRec; + {-compute the rise/set time for a fixed object, e.g., star} + {the value for H0 accounts for approximate refraction of 0.5667 deg.} + {this routine does not refine the intial estimate and so may be off by five} + {minutes or so} +var + H0 : Double; + UT : TStDateTimeRec; + RP : TStPosRecArray; +begin + H0 := -0.5667; + UT.T := 0; + UT.D := LD; + + if not CheckDate(UT) then begin + Result.ORise := -4; + Result.OSet := -4; + Exit; + end; + + RP[2].RA := RA; + RP[2].DC := DC; + Result := RiseSetPrim(LD, Longitude, Latitude, H0, RP, True); +end; + +function MoonPos(UT : TStDateTimeRec) : TStMoonPosRec; + {-compute the J2000 RA/Declination of the moon} +begin + if not CheckDate(UT) then begin + Result.RA := -1; + Result.DC := -1; + Exit; + end; + Result := MoonPosPrim(UT); +end; + +function MoonRiseSet(LD : TStDate; Longitude, Latitude : Double) : TStRiseSetRec; + {compute the Moon rise and set time} + {the value for H0 accounts for approximate refraction of 0.5667 deg., } + {that rise or set is based on the upper limb instead of the center of the} + {lunar disc, and the lunar parallax. In accordance with American Ephemeris } + {practice, the phase of the moon is not taken into account, i.e., the time} + {is based on the upper limb whether it is lit or not} +var + I : Integer; + H0 : Double; + UT : TStDateTimeRec; + RP : TStPosRecArray; + MPR : TStMoonPosRec; +begin + H0 := 0.125; { default value } + + Dec(LD); + UT.T := 0; + UT.D := LD; + + if CheckDate(UT) then begin + UT.D := UT.D + 2; + if (not CheckDate(UT)) then begin + Result.ORise := -4; + Result.OSet := -4; + Exit; + end else + UT.D := UT.D-2; + end else begin + Result.ORise := -4; + Result.OSet := -4; + Exit; + end; + + for I := 1 to 3 do begin + MPR := MoonPos(UT); + RP[I].RA := MPR.RA; + RP[I].DC := MPR.DC; + if I >= 2 then begin + if I = 2 then + H0 := 0.7275*MPR.Plx - 0.5667; + if RP[I].RA < RP[I-1].RA then + RP[I].RA := RP[I].RA + 360; + end; + Inc(UT.D); + end; + Result := RiseSetPrim(LD, Longitude, Latitude, H0, RP, False); +end; + +function LunarPhase(UT : TStDateTimeRec) : Double; + {-compute the phase of the moon} + {The value is positive if between New and Full Moon} + { negative if between Full and New Moon} +var + MPR : TStMoonPosRec; +begin + MPR := MoonPosPrim(UT); + Result := MPR.Phase; +end; + +procedure GetPhases(K : Double; var PR : TStPhaseRecord); +{primitive routine to find the date/time of phases in a lunar cycle} +var + JD, + NK, + TD, + J1, + J2, + J3 : Double; + + step : Integer; + + E, + FP, + S1, + M1, + M2, + M3 : Double; + + function AddCor : Double; + begin + AddCor := 0.000325 * sin((299.77 + 0.107408*K - 0.009173*J2)/radcor) + + 0.000165 * sin((251.88 + 0.016321*K)/radcor) + + 0.000164 * sin((251.83 + 26.651886*K)/radcor) + + 0.000126 * sin((349.42 + 36.412478*K)/radcor) + + 0.000110 * sin((84.660 + 18.206239*K)/radcor) + + 0.000062 * sin((141.74 + 53.303771*K)/radcor) + + 0.000060 * sin((207.14 + 2.453732*K)/radcor) + + 0.000056 * sin((154.84 + 7.306860*K)/radcor) + + 0.000047 * sin((34.520 + 27.261239*K)/radcor) + + 0.000042 * sin((207.19 + 0.121824*K)/radcor) + + 0.000040 * sin((291.34 + 1.844379*K)/radcor) + + 0.000037 * sin((161.72 + 24.198154*K)/radcor) + + 0.000035 * sin((239.56 + 25.513099*K)/radcor) + + 0.000023 * sin((331.55 + 3.592518*K)/radcor); + end; + +begin + NK := K; + FillChar(PR, SizeOf(TStPhaseRecord), #0); + for step := 0 to 3 do begin + K := NK + (step*0.25); + FP := Frac(K); + if FP < 0 then + FP := FP + 1; + +{compute Julian Centuries} + J1 := K / 1236.85; + J2 := Sqr(J1); + J3 := J2 * J1; + + +{solar mean anomaly} + S1 := 2.5534 + + 29.1053569 * K + - 0.0000218 * J2 + - 0.00000011 * J3; + S1 := Frac(S1 / 360.0) * 360; + if S1 < 0 then + S1 := S1 + 360.0; + +{lunar mean anomaly} + M1 := 201.5643 + + 385.81693528 * K + + 0.0107438 * J2 + + 0.00001239 * J3 + - 0.000000058 * J2 * J2; + M1 := Frac(M1 / 360.0) * 360; + if M1 < 0 then + M1 := M1 + 360.0; + +{lunar argument of latitude} + M2 := 160.7108 + + 390.67050274 * K + - 0.0016341 * J2 + - 0.00000227 * J3 + + 0.000000011 * J2 * J2; + M2 := Frac(M2 / 360.0) * 360; + if M2 < 0 then + M2 := M2 + 360.0; + +{lunar ascending node} + M3 := 124.7746 + - 1.56375580 * K + + 0.0020691 * J2 + + 0.00000215 * J3; + M3 := Frac(M3 / 360.0) * 360; + if M3 < 0 then + M3 := M3 + 360.0; + +{convert to radians} + S1 := S1/radcor; + M1 := M1/radcor; + M2 := M2/radcor; + M3 := M3/radcor; + +{mean Julian Date for phase} + JD := 2451550.09765 + + 29.530588853 * K + + 0.0001337 * J2 + - 0.000000150 * J3 + + 0.00000000073 * J2 * J2; + +{earth's orbital eccentricity} + E := 1.0 - 0.002516 * J1 - 0.0000074 * J2; + +{New Moon date time} + if FP < 0.01 then begin + TD := - 0.40720 * sin(M1) + + 0.17241 * E * sin(S1) + + 0.01608 * sin(2*M1) + + 0.01039 * sin(2*M2) + + 0.00739 * E * sin(M1-S1) + - 0.00514 * E * sin(M1 + S1) + + 0.00208 * E * E * sin(2 * S1) + - 0.00111 * sin(M1 - 2*M2) + - 0.00057 * sin(M1 + 2*M2) + + 0.00056 * E * sin(2*M1 + S1) + - 0.00042 * sin(3 * M1) + + 0.00042 * E * sin(S1 + 2*M2) + + 0.00038 * E * sin(S1 - 2*M2) + - 0.00024 * E * sin(2*(M1-S1)) + - 0.00017 * sin(M3) + - 0.00007 * sin(M1 + 2*S1); + JD := JD + TD + AddCor; + PR.NMDate := JD; + end; + +{Full Moon date/time} + if Abs(FP - 0.5) < 0.01 then begin + TD := - 0.40614 * sin(M1) + + 0.17302 * E * sin(S1) + + 0.01614 * sin(2*M1) + + 0.01043 * sin(2*M2) + + 0.00734 * E * sin(M1-S1) + - 0.00515 * E * sin(M1 + S1) + + 0.00209 * E * E * sin(2 * S1) + - 0.00111 * sin(M1 - 2*M2) + - 0.00057 * sin(M1 + 2*M2) + + 0.00056 * E * sin(2*M1 + S1) + - 0.00042 * sin(3 * M1) + + 0.00042 * E * sin(S1 + 2*M2) + + 0.00038 * E * sin(S1 - 2*M2) + - 0.00024 * E * sin(2*(M1-S1)) + - 0.00017 * sin(M3) + - 0.00007 * sin(M1 + 2*S1); + JD := JD + TD + AddCor; + PR.FMDate := JD; + end; + +{Quarters date/time} + if (abs(FP - 0.25) < 0.01) or (abs(FP - 0.75) < 0.01) then begin + TD := - 0.62801 * sin(M1) + + 0.17172 * sin(S1) * E + - 0.01183 * sin(M1+S1) * E + + 0.00862 * sin(2*M1) + + 0.00804 * sin(2*M2) + + 0.00454 * sin(M1-S1) * E + + 0.00204 * sin(2*S1) * E * E + - 0.00180 * sin(M1 - 2*M2) + - 0.00070 * sin(M1 + 2*M2) + - 0.00040 * sin(3*M1) + - 0.00034 * sin(2*M1-S1) * E + + 0.00032 * sin(S1 + 2*M2) * E + + 0.00032 * sin(S1 - 2*M2) * E + - 0.00028 * sin(M1 + 2*S1) * E * E + + 0.00027 * sin(2*M1 + S1) * E + - 0.00017 * sin(M3) + - 0.00005 * sin(M1 - S1 - 2*M2); + JD := JD + TD + AddCor; + +{adjustment to computed Julian Date} + TD := 0.00306 + - 0.00038 * E * cos(S1) + + 0.00026 * cos(M1) + - 0.00002 * cos(M1-S1) + + 0.00002 * cos(M1+S1) + + 0.00002 * cos(2*M2); + + if Abs(FP - 0.25) < 0.01 then + PR.FQDate := JD + TD + else + PR.LQDate := JD - TD; + end; + end; +end; + +procedure PhasePrim(LD : TStDate; var PhaseArray : TStPhaseArray); + {-primitive phase calculation} +var + I, + D, + M, + Y : Integer; + K, TD, + LYear : Double; + +begin + StDateToDMY(LD, D, M, Y); + LYear := Y - 0.05; + K := (LYear - 2000) * 12.3685; + K := Int(K); + TD := K / 12.3685 + 2000; + if TD > Y then + K := K-1; + +{compute phases for each lunar cycle throughout the year} + for I := 0 to 13 do begin + GetPhases(K, PhaseArray[I]); + K := K + 1; + end; +end; + +function GenSearchPhase(SD : TStDate; PV : Byte) : TStLunarRecord; +{searches for the specified phase in the given month/year expressed by SD} +var + I, + C, + LD, + LM, + LY, + TD, + TM, + TY : Integer; + ADate : TStDate; + JD : Double; + PhaseArray : TStPhaseArray; +begin + C := 0; + FillChar(Result, SizeOf(Result), $FF); + + StDateToDMY(SD, LD, LM, LY); + PhasePrim(SD, PhaseArray); + for I := LM-1 to LM+1 do begin + if (PV = 0) then + JD := PhaseArray[I].NMDate + else if (PV = 1) then + JD := PhaseArray[I].FQDate + else if (PV = 2) then + JD := PhaseArray[I].FMDate + else + JD := PhaseArray[I].LQDate; + ADate := AstJulianDateToStDate(JD, True); + + StDateToDMY(ADate, TD, TM, TY); + if TM < LM then + continue + else if TM = LM then begin + Result.T[C].D := ADate; + Result.T[C].T := Trunc((Frac(JD) + 0.5) * 86400); + if Result.T[C].T >= SecondsInDay then + Dec(Result.T[C].T, SecondsInDay); + Inc(C); + end; + end; +end; + +function FirstQuarter(D : TStDate) : TStLunarRecord; + {-compute date/time of FirstQuarter(s)} +begin + Result := GenSearchPhase(D, 1); +end; + +function FullMoon(D : TStDate) : TStLunarRecord; + {-compute the date/time of FullMoon(s)} +begin + Result := GenSearchPhase(D, 2); +end; + +function LastQuarter(D: TStDate) : TStLunarRecord; + {-compute the date/time of LastQuarter(s)} +begin + Result := GenSearchPhase(D, 3); +end; + +function NewMoon(D : TStDate) : TStLunarRecord; + {-compute the date/time of NewMoon(s)} +begin + Result := GenSearchPhase(D, 0); +end; + +function NextPrevPhase(D : TStDate; Ph : Byte; + FindNext : Boolean) : TStDateTimeRec; +var + LD, + LM, + LY : Integer; + K, + JD, + TJD : Double; + PR : TStPhaseRecord; + OK : Boolean; +begin + if (D < MinDate) or (D > MaxDate) then begin + Result.D := BadDate; + Result.T := BadTime; + Exit; + end; + + StDateToDMY(D, LD, LM, LY); + K := ((LY + LM/12 + LD/365.25) - 2000) * 12.3685 - 0.5; + if FindNext then + K := Round(K)-1 + else + K := Round(K)-2; + + OK := False; + TJD := AstJulianDate(D); + repeat + GetPhases(K, PR); + + if (Ph = 0) then + JD := PR.NMDate + else if (Ph = 1) then + JD := PR.FQDate + else if (Ph = 2) then + JD := PR.FMDate + else + JD := PR.LQDate; + + if (FindNext) then begin + if (JD > TJD) then + OK := True + else + K := K + 1; + end else begin + if (JD < TJD) then + OK := True + else + K := K - 1; + end; + until OK; + + Result.D := AstJulianDateToStDate(JD, True); + if (Result.D <> BadDate) then begin + Result.T := Trunc((Frac(JD) + 0.5) * 86400); + if Result.T >= SecondsInDay then + Dec(Result.T, SecondsInDay); + end else + Result.T := BadTime; +end; + +function NextFirstQuarter(D : TStDate) : TStDateTimeRec; + {-compute the date/time of the next closest FirstQuarter} +begin + Result := NextPrevPhase(D, 1, True); +end; + +function NextFullMoon(D : TStDate) : TStDateTimeRec; + {-compute the date/time of the next closest FullMoon} +begin + Result := NextPrevPhase(D, 2, True); +end; + +function NextLastQuarter(D : TStDate) : TStDateTimeRec; + {-compute the date/time of the next closest LastQuarter} +begin + Result := NextPrevPhase(D, 3, True); +end; + +function NextNewMoon(D : TStDate) : TStDateTimeRec; + {-compute the date/time of the next closest NewMoon} +begin + Result := NextPrevPhase(D, 0, True); +end; + +function PrevFirstQuarter(D : TStDate) : TStDateTimeRec; + {-compute the date/time of the prev closest FirstQuarter} +begin + Result := NextPrevPhase(D, 1, False); +end; + +function PrevFullMoon(D : TStDate) : TStDateTimeRec; + {-compute the date/time of the prev closest FullMoon} +begin + Result := NextPrevPhase(D, 2, False); +end; + +function PrevLastQuarter(D : TStDate) : TStDateTimeRec; + {-compute the date/time of the prev closest LastQuarter} +begin + Result := NextPrevPhase(D, 3, False); +end; + +function PrevNewMoon(D : TStDate) : TStDateTimeRec; + {-compute the date/time of the prev closest NewMoon} +begin + Result := NextPrevPhase(D, 0, False); +end; + +{Calendar procedures/functions} + +function SolEqPrim(Y : Integer; K : Byte) : TStDateTimeRec; +{primitive routine for finding equinoxes and solstices} +var + JD, TD, LY, + JCent, MA, + SLong : Double; + +begin + JD := 0; + Result.D := BadDate; + Result.T := BadTime; + +{the following algorithm is valid only in the range of [1000..3000 AD]} +{but is limited to returning dates in [MinYear..MaxYear]} + if (Y < MinYear) or (Y > MaxYear) then + Exit; + +{compute approximate date/time for specified event} + LY := (Y - 2000) / 1000; + case K of + 0 : JD := 2451623.80984 + + 365242.37404 * LY + + 0.05169 * sqr(LY) + - 0.00411 * LY * sqr(LY) + - 0.00057 * sqr(sqr(LY)); + + 1 : JD := 2451716.56767 + + 365241.62603 * LY + + 0.00325 * sqr(LY) + + 0.00888 * LY * sqr(LY) + - 0.00030 * sqr(sqr(LY)); + + 2 : JD := 2451810.21715 + + 365242.01767 * LY + - 0.11575 * sqr(LY) + + 0.00337 * sqr(LY) * LY + + 0.00078 * sqr(sqr(LY)); + + 3 : JD := 2451900.05952 + + 365242.74049 * LY + - 0.06223 * sqr(LY) + - 0.00823 * LY * sqr(LY) + + 0.00032 * sqr(sqr(LY)); + end; + +{refine date/time by computing corrections due to solar longitude,} +{nutation and abberation. Iterate using the corrected time until} +{correction is less than one minute} + repeat + Result.D := AstJulianDateToStDate(JD, True); + Result.T := Trunc((Frac(JD) + 0.5) * 86400); + if Result.T >= SecondsInDay then + Dec(Result.T, SecondsInDay); + JCent := (JD - 2451545.0)/36525.0; + +{approximate solar longitude - no FK5 correction} + SLong := 280.46645 + + 36000.76983 * JCent + + 0.0003032 * sqr(JCent); + SLong := Frac((SLong)/360.0) * 360.0; + if SLong < 0 then + SLong := SLong + 360; + +{Equation of the center correction} + MA := 357.52910 + + 35999.05030 * JCent; + MA := MA/radcor; + SLong := SLong + + (1.914600 - 0.004817 * JCent - 0.000014 * sqr(JCent)) * sin(MA) + + (0.019993 - 0.000101 * JCent) * sin(2*MA); + +{approximate nutation} + TD := 125.04452 + - 1934.136261 * JCent + + 0.0020708 * sqr(JCent); + TD := TD/radcor; + TD := (-17.20 * sin(TD) - 1.32 * sin(2*SLong/radcor))/3600; + +{approximate abberation - solar distance is assumed to be 1 A.U.} + SLong := SLong - (20.4989/3600) + TD; + +{correction to compute Julian Date for event} + TD := 58 * sin((K*90 - SLong)/radcor); + if abs(TD) >= 0.0005 then + JD := JD + TD; + until abs(TD) < 0.0005; +end; + +function Solstice(Y, Epoch : Integer; Summer : Boolean) : TStDateTimeRec; + {-compute the date/time of the summer or winter solstice} + {if Summer = True, compute astronomical summer solstice (summer in N. Hem.)} + { = False, compute astronomical winter solstice (winter in N. Hem.)} +begin + Y := CheckYear(Y, Epoch); + if Summer then + Result := SolEqPrim(Y, 1) + else + Result := SolEqPrim(Y, 3); +end; + +function Equinox(Y, Epoch : Integer; Vernal : Boolean) : TStDateTimeRec; + {-compute the date/time of the vernal/autumnal equinox} + {if Vernal = True, compute astronomical vernal equinox (spring in N. Hem.)} + { = False, compute astronomical autumnal equinox (fall in N. Hem.)} +begin + Y := CheckYear(Y, Epoch); + if Vernal then + Result := SolEqPrim(Y, 0) + else + Result := SolEqPrim(Y, 2); +end; + +function Easter(Y : Integer; Epoch : Integer) : TStDate; + {-compute the date of Easter} +var + A, B, + C, D, + E, F, + G, H, + I, K, + L, M, + N, P : LongInt; +begin + Y := CheckYear(Y, Epoch); + + if (Y < MinYear) or (Y > MaxYear) then begin + Result := BadDate; + Exit; + end; + + A := Y mod 19; + B := Y div 100; + C := Y mod 100; + D := B div 4; + E := B mod 4; + F := (B+8) div 25; + G := (B-F+1) div 3; + H := (19*A + B - D - G + 15) mod 30; + I := C div 4; + K := C mod 4; + L := (32 + 2*E + 2*I - H - K) mod 7; + M := (A + 11*H + 22*L) div 451; + N := (H + L - 7*M + 114) div 31; + P := (H + L - 7*M + 114) mod 31 + 1; + + Result := DMYToStDate(P, N, Y, Epoch); +end; + +{Conversion routines} +function HoursMin(RA : Double) : String; + {-convert RA to formatted hh:mm:ss string} +var + HR, MR : Double; + HS, MS : string[12]; + +begin + if abs(RA) >= 360.0 then + RA := Frac(RA / 360.0) * 360; + if RA < 0 then + RA := RA + 360.0; + + HR := Int(RA / 15.0); + MR := Frac(RA / 15.0) * 60; + + Str(MR:5:2, MS); + if MS = '60.00' then begin + MS := '00.00'; + HR := HR + 1; + if HR = 24 then + HS := '0' + else + Str(HR:2:0, HS); + end else begin + if MS[1] = ' ' then + MS[1] := '0'; + Str(Hr:2:0, HS); + end; + Result := HS + ' ' + MS; +end; + +function DegsMin(DC : Double) : String; + {-convert Declination to formatted +/-dd:mm:ss string} +var + DR, MR : Double; + DS, MS : string[12]; +begin + if abs(DC) > 90 then + DC := Frac(DC / 90.0) * 90.0; + + DR := Int(DC); + MR := Frac(abs(DC)) * 60; + + Str(MR:4:1, MS); + if MS = '60.0' then begin + MS := '00.0'; + if DC >= 0 then + DR := DR + 1 + else + DR := DR - 1; + end; + + if abs(DC) < 10 then begin + Str(DR:2:0, DS); + DS := TrimLeadS(DS); + if DC < 0 then begin + if DC > -1 then + DS := '- 0' + else + DS := '- ' + DS[2]; + end else + DS := '+ ' + DS; + end else begin + Str(DR:3:0, DS); + DS := TrimLeadS(DS); + if DC < 0 then begin + Delete(DS,1,1); + DS := '-' + DS; + end else + DS := '+' + DS; + end; + if MS[1] = ' ' then + MS[1] := '0'; + Result := DS + ' ' + MS; +end; + +function DateTimeToAJD(D : TDateTime) : Double; +begin + Result := D + AJDOffset; +end; + +function AJDToDateTime(D : Double) : TDateTime; +begin + Result := D - AJDOffset; +end; + + +initialization + AJDOffSet := AstJulianDatePrim(1600, 1, 1, 0) - EncodeDate(1600, 1, 1); +end. diff --git a/components/systools/source/run/stastrop.pas b/components/systools/source/run/stastrop.pas new file mode 100644 index 000000000..c01f3c1fa --- /dev/null +++ b/components/systools/source/run/stastrop.pas @@ -0,0 +1,499 @@ +// Upgraded to Delphi 2009: Sebastian Zierer + +(* ***** BEGIN LICENSE BLOCK ***** + * Version: MPL 1.1 + * + * The contents of this file are subject to the Mozilla Public License Version + * 1.1 (the "License"); you may not use this file except in compliance with + * the License. You may obtain a copy of the License at + * http://www.mozilla.org/MPL/ + * + * Software distributed under the License is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License + * for the specific language governing rights and limitations under the + * License. + * + * The Original Code is TurboPower SysTools + * + * The Initial Developer of the Original Code is + * TurboPower Software + * + * Portions created by the Initial Developer are Copyright (C) 1996-2002 + * the Initial Developer. All Rights Reserved. + * + * Contributor(s): + * + * ***** END LICENSE BLOCK ***** *) + +{*********************************************************} +{* SysTools: StAstroP.pas 4.04 *} +{*********************************************************} +{* SysTools: Astronomical Routines (general Planetary) *} +{*********************************************************} + +{$IFDEF FPC} + {$mode DELPHI} +{$ENDIF} + +//{$I StDefine.inc} + +{ ************************************************************** } +{ Sources: } +{ 1. Astronomical Algorithms, Jean Meeus, Willmann-Bell, 1991. } +{ } +{ 2. Planetary and Lunar Coordinates (1984-2000), U.S. Govt, } +{ 1983. } +{ } +{ 3. Supplement to the American Ephemeris and Nautical Almanac,} +{ U.S. Govt, 1964. } +{ } +{ 4. MPO96-MPO98 source files, Brian D. Warner, 1995-2000. } +{ } +{ ************************************************************** } + +unit StAstroP; + +interface + +const + StdDate = 2451545.0; {Ast. Julian Date for J2000 Epoch} + OB2000 = 0.409092804; {J2000 obliquity of the ecliptic (radians)} + +type + TStEclipticalCord = packed record + L0, + B0, + R0 : Double; + end; + + TStRectangularCord = packed record + X, + Y, + Z : Double; + end; + + TStPlanetsRec = packed record + RA, + DC, + Elong : Double; + end; + TStPlanetsArray = array[1..8] of TStPlanetsRec; + + +procedure PlanetsPos(JD : Double; var PA : TStPlanetsArray); + + +implementation + +uses + Windows, + StDate, StMerc, StVenus, StMars, StJup, StSaturn, StUranus, StNeptun, + StPluto, StMath; + +var + PlanEC : TStEclipticalCord; + PlanRC, + SunRC : TStRectangularCord; + SunEQ : TStPlanetsRec; + + +{--------------------------------------------------------------------------} + +function RealAngle(Value2, Value1, Start : Double) : Double; +begin + Result := Start; + + if (Value1 = 0) then begin + if Value2 > 0 then + Result := Pi / 2.0 + else + Result := 3.0 * Pi / 2.0; + end else begin + if (Value2 > 0.0) then begin + if (Value1 < 0.0) then + Result := Start + Pi + else + Result := Start; + end else begin + if (Value2 = 0) then begin + if Value1 > 0 then + Result := 0 + else + Result := Pi; + end else begin + if (Value2 < 0) then begin + if (Value1 < 0) then + Result := Start + Pi + else + Result := Start + (2.0 * Pi) + end; + end; + end; + end; +end; + +{--------------------------------------------------------------------------} + +function SunOfDate(JD : Double) : TStRectangularCord; + {-compute J2000 XYZ coordinates of the Sun} +var + T0, + A, + L, + B, + RV, + TX, + TY, + TZ : Double; + +begin + T0 := (JD - StdDate) / 365250; + +{solar longitude} + L := 175347046 + + 3341656 * cos(4.6692568 + 6283.07585*T0) + + 34894 * cos(4.6261000 + 12566.1517*T0) + + 3497 * cos(2.7441000 + 5753.3849*T0) + + 3418 * cos(2.8289000 + 3.5231*T0) + + 3136 * cos(3.6277000 + 77713.7715*T0) + + 2676 * cos(4.4181000 + 7860.4194*T0) + + 2343 * cos(6.1352000 + 3930.2097*T0) + + 1324 * cos(0.7425000 + 11506.7698*T0) + + 1273 * cos(2.0371000 + 529.6910*T0) + + 1199 * cos(1.1096000 + 1577.3435*T0) + + 990 * cos(5.2330000 + 5884.9270*T0) + + 902 * cos(2.0450000 + 26.1490*T0) + + 857 * cos(3.5080000 + 398.149*T0) + + 780 * cos(1.1790000 + 5223.694*T0) + + 753 * cos(2.5330000 + 5507.553*T0) + + 505 * cos(4.5830000 + 18849.228*T0) + + 492 * cos(4.2050000 + 775.523*T0) + + 357 * cos(2.9200000 + 0.067*T0) + + 317 * cos(5.8490000 + 11790.626*T0) + + 284 * cos(1.8990000 + 796.298*T0) + + 271 * cos(0.3150000 + 10977.079*T0) + + 243 * cos(0.3450000 + 5486.778*T0) + + 206 * cos(4.8060000 + 2544.314*T0) + + 205 * cos(1.8690000 + 5573.143*T0) + + 202 * cos(2.4580000 + 6069.777*T0) + + 156 * cos(0.8330000 + 213.299*T0) + + 132 * cos(3.4110000 + 2942.463*T0) + + 126 * cos(1.0830000 + 20.775*T0) + + 115 * cos(0.6450000 + 0.980*T0) + + 103 * cos(0.6360000 + 4694.003*T0) + + 102 * cos(0.9760000 + 15720.839*T0) + + 102 * cos(4.2670000 + 7.114*T0) + + 99 * cos(6.2100000 + 2146.170*T0) + + 98 * cos(0.6800000 + 155.420*T0) + + 86 * cos(5.9800000 +161000.690*T0) + + 85 * cos(1.3000000 + 6275.960*T0) + + 85 * cos(3.6700000 + 71430.700*T0) + + 80 * cos(1.8100000 + 17260.150*T0); + + A := 628307584999.0 + + 206059 * cos(2.678235 + 6283.07585*T0) + + 4303 * cos(2.635100 + 12566.1517*T0) + + 425 * cos(1.590000 + 3.523*T0) + + 119 * cos(5.796000 + 26.298*T0) + + 109 * cos(2.966000 + 1577.344*T0) + + 93 * cos(2.590000 + 18849.23*T0) + + 72 * cos(1.140000 + 529.69*T0) + + 68 * cos(1.870000 + 398.15*T0) + + 67 * cos(4.410000 + 5507.55*T0) + + 59 * cos(2.890000 + 5223.69*T0) + + 56 * cos(2.170000 + 155.42*T0) + + 45 * cos(0.400000 + 796.30*T0) + + 36 * cos(0.470000 + 775.52*T0) + + 29 * cos(2.650000 + 7.11*T0) + + 21 * cos(5.340000 + 0.98*T0) + + 19 * cos(1.850000 + 5486.78*T0) + + 19 * cos(4.970000 + 213.30*T0) + + 17 * cos(2.990000 + 6275.96*T0) + + 16 * cos(0.030000 + 2544.31*T0); + L := L + (A * T0); + + A := 8722 * cos(1.0725 + 6283.0758*T0) + + 991 * cos(3.1416) + + 295 * cos(0.437 + 12566.1520*T0) + + 27 * cos(0.050 + 3.52*T0) + + 16 * cos(5.190 + 26.30*T0) + + 16 * cos(3.69 + 155.42*T0) + + 9 * cos(0.30 + 18849.23*T0) + + 9 * cos(2.06 + 77713.77*T0); + L := L + (A * sqr(T0)); + + A := 289 * cos(5.842 + 6283.076*T0) + + 21 * cos(6.05 + 12566.15*T0) + + 3 * cos(5.20 + 155.42*T0) + + 3 * cos(3.14); + L := L + (A * sqr(T0) * T0); + L := L / 1.0E+8; + + +{solar latitude} + B := 280 * cos(3.199 + 84334.662*T0) + + 102 * cos(5.422 + 5507.553*T0) + + 80 * cos(3.88 + 5223.69*T0) + + 44 * cos(3.70 + 2352.87*T0) + + 32 * cos(4.00 + 1577.34*T0); + B := B / 1.0E+8; + + A := 227778 * cos(3.413766 + 6283.07585*T0) + + 3806 * cos(3.3706 + 12566.1517*T0) + + 3620 + + 72 * cos(3.33 + 18849.23*T0) + + 8 * cos(3.89 + 5507.55*T0) + + 8 * cos(1.79 + 5223.69*T0) + + 6 * cos(5.20 + 2352.87*T0); + B := B + (A * T0 / 1.0E+8); + + A := 9721 * cos(5.1519 + 6283.07585*T0) + + 233 * cos(3.1416) + + 134 * cos(0.644 + 12566.152*T0) + + 7 * cos(1.07 + 18849.23*T0); + B := B + (A * sqr(T0) / 1.0E+8); + + A := 276 * cos(0.595 + 6283.076*T0) + + 17 * cos(3.14) + + 4 * cos(0.12 + 12566.15*T0); + B := B + (A * sqr(T0) * T0 / 1.0E+8); + + +{solar radius vector (astronomical units)} + RV := 100013989 + + 1670700 * cos(3.0984635 + 6283.07585*T0) + + 13956 * cos(3.05525 + 12566.15170*T0) + + 3084 * cos(5.1985 + 77713.7715*T0) + + 1628 * cos(1.1739 + 5753.3849*T0) + + 1576 * cos(2.8649 + 7860.4194*T0) + + 925 * cos(5.453 + 11506.770*T0) + + 542 * cos(4.564 + 3930.210*T0) + + 472 * cos(3.661 + 5884.927*T0) + + 346 * cos(0.964 + 5507.553*T0) + + 329 * cos(5.900 + 5223.694*T0) + + 307 * cos(0.299 + 5573.143*T0) + + 243 * cos(4.273 + 11790.629*T0) + + 212 * cos(5.847 + 1577.344*T0) + + 186 * cos(5.022 + 10977.079*T0) + + 175 * cos(3.012 + 18849.228*T0) + + 110 * cos(5.055 + 5486.778*T0) + + 98 * cos(0.89 + 6069.78*T0) + + 86 * cos(5.69 + 15720.84*T0) + + 86 * cos(1.27 +161000.69*T0) + + 65 * cos(0.27 + 17260.15*T0) + + 63 * cos(0.92 + 529.69*T0) + + 57 * cos(2.01 + 83996.85*T0) + + 56 * cos(5.24 + 71430.70*T0) + + 49 * cos(3.25 + 2544.31*T0) + + 47 * cos(2.58 + 775.52*T0) + + 45 * cos(5.54 + 9437.76*T0) + + 43 * cos(6.01 + 6275.96*T0) + + 39 * cos(5.36 + 4694.00*T0) + + 38 * cos(2.39 + 8827.39*T0) + + 37 * cos(0.83 + 19651.05*T0) + + 37 * cos(4.90 + 12139.55*T0) + + 36 * cos(1.67 + 12036.46*T0) + + 35 * cos(1.84 + 2942.46*T0) + + 33 * cos(0.24 + 7084.90*T0) + + 32 * cos(0.18 + 5088.63*T0) + + 32 * cos(1.78 + 398.15*T0) + + 28 * cos(1.21 + 6286.60*T0) + + 28 * cos(1.90 + 6279.55*T0) + + 26 * cos(4.59 + 10447.39*T0); + RV := RV / 1.0E+8; + + A := 103019 * cos(1.107490 + 6283.075850*T0) + + 1721 * cos(1.0644 + 12566.1517*T0) + + 702 * cos(3.142) + + 32 * cos(1.02 + 18849.23*T0) + + 31 * cos(2.84 + 5507.55*T0) + + 25 * cos(1.32 + 5223.69*T0) + + 18 * cos(1.42 + 1577.34*T0) + + 10 * cos(5.91 + 10977.08*T0) + + 9 * cos(1.42 + 6275.96*T0) + + 9 * cos(0.27 + 5486.78*T0); + RV := RV + (A * T0 / 1.0E+8); + + A := 4359 * cos(5.7846 + 6283.0758*T0) + + 124 * cos(5.579 + 12566.152*T0) + + 12 * cos(3.14) + + 9 * cos(3.63 + 77713.77*T0) + + 6 * cos(1.87 + 5573.14*T0) + + 3 * cos(5.47 + 18849.23*T0); + RV := RV + (A * sqr(T0) / 1.0E+8); + + L := (L + PI); + L := Frac(L / 2.0 / PI) * 2.0 * Pi; + if L < 0 then + L := L + (2.0*PI); + B := -B; + + TX := RV * cos(B) * cos(L); + TY := RV * cos(B) * sin(L); + TZ := RV * sin(B); + + Result.X := TX + 4.40360E-7 * TY - 1.90919E-7 * TZ; + Result.Y := -4.79966E-7 * TX + 0.917482137087 * TY - 0.397776982902 * TZ; + Result.Z := 0.397776982902 * TY + 0.917482137087 * TZ; +end; + +{--------------------------------------------------------------------------} + +function EclipticToRectangular(Longitude, Latitude, + RadiusVector : Double) : TStRectangularCord; +var + var1, + var2, + var3 : Double; +begin + var1 := RadiusVector * cos(Longitude) * cos(Latitude); + var2 := RadiusVector * sin(Longitude) * cos(Latitude); + var3 := RadiusVector * sin(Latitude); + + Result.X := var1; + Result.Y := var2 * cos(OB2000) - var3 * sin(OB2000); + Result.Z := var2 * sin(OB2000) + var3 * cos(OB2000); +end; + +{--------------------------------------------------------------------------} + +function RADec(Planet, Sun : TStRectangularCord; + ComputeElong : Boolean) : TStPlanetsRec; +var + var1, + var2, + var3, + var4, + var5 : Double; +begin + FillChar(Result, SizeOf(TStPlanetsRec), #0); + + var1 := Sun.X + Planet.X; + var2 := Sun.Y + Planet.Y; + var3 := Sun.Z + Planet.Z; + + var4 := arctan(var2/var1); + var4 := RealAngle(var2, var1, var4) * radcor; + + var5 := sqrt(sqr(var1) + sqr(var2) + sqr(var3)); + var3 := StInvsin(var3/var5) * radcor; + + Result.RA := var4; + Result.DC := var3; + + var4 := Result.RA / radcor; + var3 := Result.DC / radcor; + + if (ComputeElong) then begin + var1 := sin(SunEQ.DC/radcor) * sin(var3); + var2 := cos(SunEQ.DC/radcor) * cos(var3) * cos(SunEQ.RA/radcor - var4); + Result.Elong := StInvcos(var1+var2) * radcor; + end; +end; + +{--------------------------------------------------------------------------} + +function MercuryPosition(JD : Double) : TStPlanetsRec; +begin + PlanEC := ComputeMercury(JD); + PlanRC := EclipticToRectangular(PlanEC.L0, PlanEC.B0, PlanEC.R0); + Result := RADec(PlanRC, SunRC, True); +end; + +{--------------------------------------------------------------------------} + +function VenusPosition(JD : Double) : TStPlanetsRec; +begin + PlanEC := ComputeVenus(JD); + PlanRC := EclipticToRectangular(PlanEC.L0, PlanEC.B0, PlanEC.R0); + Result := RADec(PlanRC, SunRC, True); +end; + +{--------------------------------------------------------------------------} + +function MarsPosition(JD : Double) : TStPlanetsRec; +begin + PlanEC := ComputeMars(JD); + PlanRC := EclipticToRectangular(PlanEC.L0, PlanEC.B0, PlanEC.R0); + Result := RADec(PlanRC, SunRC, True); +end; + +{--------------------------------------------------------------------------} + +function JupiterPosition(JD : Double) : TStPlanetsRec; +begin + PlanEC := ComputeJupiter(JD); + PlanRC := EclipticToRectangular(PlanEC.L0, PlanEC.B0, PlanEC.R0); + Result := RADec(PlanRC, SunRC, True); +end; + +{--------------------------------------------------------------------------} + +function SaturnPosition(JD : Double) : TStPlanetsRec; +begin + PlanEC := ComputeSaturn(JD); + PlanRC := EclipticToRectangular(PlanEC.L0, PlanEC.B0, PlanEC.R0); + Result := RADec(PlanRC, SunRC, True); +end; + +{--------------------------------------------------------------------------} + +function UranusPosition(JD : Double) : TStPlanetsRec; +begin + PlanEC := ComputeUranus(JD); + PlanRC := EclipticToRectangular(PlanEC.L0, PlanEC.B0, PlanEC.R0); + Result := RADec(PlanRC, SunRC, True); +end; + +{--------------------------------------------------------------------------} + +function NeptunePosition(JD : Double) : TStPlanetsRec; +begin + PlanEC := ComputeNeptune(JD); + PlanRC := EclipticToRectangular(PlanEC.L0, PlanEC.B0, PlanEC.R0); + Result := RADec(PlanRC, SunRC, True); +end; + +{--------------------------------------------------------------------------} + +function PlutoPosition(JD : Double) : TStPlanetsRec; +begin + PlanEC := ComputePluto(JD); + PlanRC := EclipticToRectangular(PlanEC.L0, PlanEC.B0, PlanEC.R0); + Result := RADec(PlanRC, SunRC, True); +end; + +{--------------------------------------------------------------------------} + +procedure PlanetsPos(JD : Double; var PA : TStPlanetsArray); +var + I : Integer; + Sun : TStRectangularCord; +begin + {find Sun's Rectangular Coordinates} + SunRC := SunofDate(JD); + + FillChar(SunEQ, SizeOf(TStPlanetsRec), #0); + FillChar(Sun, SizeOf(TStRectangularCord), #0); + + {find Sun's RA/Dec} + SunEQ := RADec(SunRC, Sun, False); + PA[1] := PlutoPosition(JD); + + {find RA/Dec of each planet} + for I := 1 to 8 do begin + case I of + 1 : PA[I] := MercuryPosition(JD); + 2 : PA[I] := VenusPosition(JD); + 3 : PA[I] := MarsPosition(JD); + 4 : PA[I] := JupiterPosition(JD); + 5 : PA[I] := SaturnPosition(JD); + 6 : PA[I] := UranusPosition(JD); + 7 : PA[I] := NeptunePosition(JD); + 8 : PA[I] := PlutoPosition(JD); + end; + end; +end; + + +end. diff --git a/components/systools/source/run/steclpse.pas b/components/systools/source/run/steclpse.pas new file mode 100644 index 000000000..569a5e98f --- /dev/null +++ b/components/systools/source/run/steclpse.pas @@ -0,0 +1,737 @@ +// Upgraded to Delphi 2009: Sebastian Zierer + +(* ***** BEGIN LICENSE BLOCK ***** + * Version: MPL 1.1 + * + * The contents of this file are subject to the Mozilla Public License Version + * 1.1 (the "License"); you may not use this file except in compliance with + * the License. You may obtain a copy of the License at + * http://www.mozilla.org/MPL/ + * + * Software distributed under the License is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License + * for the specific language governing rights and limitations under the + * License. + * + * The Original Code is TurboPower SysTools + * + * The Initial Developer of the Original Code is + * TurboPower Software + * + * Portions created by the Initial Developer are Copyright (C) 1996-2002 + * the Initial Developer. All Rights Reserved. + * + * Contributor(s): + * + * ***** END LICENSE BLOCK ***** *) + +{*********************************************************} +{* SysTools: StEclpse.pas 4.04 *} +{*********************************************************} +{* SysTools: Lunar/Solar Eclipses *} +{*********************************************************} + +{$IFDEF FPC} + {$mode DELPHI} +{$ENDIF} + +//{$I StDefine.inc} + +{ ************************************************************** } +{ Sources: } +{ 1. Astronomical Algorithms, Jean Meeus, Willmann-Bell, 1991. } +{ } +{ 2. Planetary and Lunar Coordinates (1984-2000), U.S. Govt, } +{ 1983. } +{ } +{ 3. Supplement to the American Ephemeris and Nautical Almanac,} +{ U.S. Govt, 1964. } +{ } +{ 4. MPO96-98 source files, Brian D. Warner, 1995-98. } +{ } +{ ************************************************************** } + + +unit StEclpse; + +interface + +uses + {$IFDEF UseMathUnit} Math, {$ENDIF} + StBase, StList, StDate, StAstro, StMath; + +type + TStEclipseType = (etLunarPenumbral, etLunarPartial, etLunarTotal, + etSolarPartial, etSolarAnnular, etSolarTotal, + etSolarAnnularTotal); + + TStHemisphereType = (htNone, htNorthern, htSouthern); + + TStContactTimes = packed record + UT1, {start of lunar penumbral phase} + UT2, {end of lunar penumbral phase} + FirstContact, {start of partial eclipse} + SecondContact, {start of totality} + MidEclipse, {mid-eclipse} + ThirdContact, {end of totality} + FourthContact : TDateTime; {end of partial phase} + end; + + TStLongLat = packed record + JD : TDateTime; + Longitude, + Latitude, + Duration : Double; + end; + PStLongLat = ^TStLongLat; + + TStEclipseRecord = packed record + EType : TStEclipseType; {type of Eclipse} + Magnitude : Double; {magnitude of eclipse} + Hemisphere : TStHemisphereType; {favored hemisphere - solar} + LContacts : TStContactTimes; {Universal Times of critical points} + { in lunar eclipses} + Path : TStList; {longitude/latitude of moon's shadow} + end; { during solar eclipse} + PStEclipseRecord = ^TStEclipseRecord; + + TStBesselianRecord = packed record + JD : TDateTime; + Delta, + Angle, + XAxis, + YAxis, + L1, + L2 : Double; + end; + + TStEclipses = class(TStList) + {.Z+} + protected {private} + FBesselianElements : array[1..25] of TStBesselianRecord; + F0, + FUPrime, + FDPrime : Double; + + function GetEclipse(Idx : longint) : PStEclipseRecord; + procedure CentralEclipseTime(JD, K, J2, + SunAnom, MoonAnom, + ArgLat, AscNode, EFac : Double; + var F1, A1, CentralTime : Double); + procedure CheckForEclipse(K : Double); + procedure TotalLunarEclipse(CentralJD, MoonAnom, Mu, + PMag, UMag, Gamma : Double); + procedure PartialLunarEclipse(CentralJD, MoonAnom, Mu, + PMag, UMag, Gamma : Double); + procedure PenumbralLunarEclipse(CentralJD, MoonAnom, Mu, + PMag, UMag, Gamma : Double); + + procedure GetBesselianElements(CentralJD : Double); + procedure GetShadowPath(I1, I2 : Integer; Path : TStList); + procedure NonPartialSolarEclipse(CentralJD, Mu, Gamma : Double); + procedure PartialSolarEclipse(CentralJD, Mu, Gamma : Double); + {.Z-} + public + constructor Create(NodeClass : TStNodeClass); + override; + procedure FindEclipses(Year : integer); + + property Eclipses[Idx : longint] : PStEclipseRecord + read GetEclipse; + end; + + +implementation + +procedure DisposePathData(Data : Pointer); far; +begin + Dispose(PStLongLat(Data)); +end; + +procedure DisposeEclipseRecord(Data : Pointer); far; +var + EcData : TStEclipseRecord; +begin + EcData := TStEclipseRecord(Data^); + if (Assigned(EcData.Path)) then + EcData.Path.Free; + Dispose(PStEclipseRecord(Data)); +end; + +constructor TStEclipses.Create(NodeClass : TStNodeClass); +begin + inherited Create(NodeClass); + + DisposeData := DisposeEclipseRecord; +end; + +function TStEclipses.GetEclipse(Idx : longint) : PStEclipseRecord; +begin + if (Idx < 0) or (Idx > pred(Count)) then + Result := nil + else + Result := PStEclipseRecord(Items[Idx].Data); +end; + +procedure TStEclipses.FindEclipses(Year : integer); +var + K, + MeanJD, + JDofFirst, + JDofLast : Double; + +begin + JDofFirst := AstJulianDatePrim(Year, 1, 1, 0); + JDofLast := AstJulianDatePrim(Year, 12, 31, pred(SecondsInDay)); + K := Int((Year - 2000) * 12.3685 - 1); + repeat + MeanJD := 2451550.09765 + 29.530588853 * K; + if (MeanJD < JDofFirst) then + K := K + 0.5; + until (MeanJD >= JDofFirst); + + while (MeanJD < JDofLast) do begin + CheckForEclipse(K); + K := K + 0.5; + MeanJD := 2451550.09765 + 29.530588853 * K; + end; +end; + +procedure TStEclipses.CentralEclipseTime(JD, K, J2, + SunAnom, MoonAnom, + ArgLat, AscNode, EFac : Double; + var F1, A1, CentralTime : Double); +{the mean error of this routine is 0.36 minutes in a test between} +{1951 through 2050 with a maximum of 1.1 - Meeus} +begin + F1 := ArgLat - (0.02665/radcor) * sin(AscNode); + A1 := (299.77/radcor) + + (0.107408/radcor) * K + - (0.009173/radcor) * J2; + + if (Frac(K) > 0.1) then + {correction at Full Moon - Lunar eclipse} + CentralTime := JD + - 0.4065 * sin(MoonAnom) + + 0.1727 * EFac * sin(SunAnom) + else + {correction at New Moon - solar eclipse} + CentralTime := JD + - 0.4075 * sin(MoonAnom) + + 0.1721 * EFac * sin(SunAnom); + + CentralTime := CentralTime + + 0.0161 * sin(2 * MoonAnom) + - 0.0097 * sin(2 * F1) + + 0.0073 * sin(MoonAnom - SunAnom) * EFac + - 0.0050 * sin(MoonAnom + SunAnom) * EFac + - 0.0023 * sin(MoonAnom - 2*F1) + + 0.0021 * sin(2*SunAnom) * EFac + + 0.0012 * sin(MoonAnom + 2*F1) + + 0.0006 * sin(2*MoonAnom + SunAnom) * EFac + - 0.0004 * sin(3*MoonAnom) + - 0.0003 * sin(SunAnom + 2*F1) * EFac + + 0.0003 * sin(A1) + - 0.0002 * sin(SunAnom - 2*F1) * EFac + - 0.0002 * sin(2*MoonAnom - SunAnom) * EFac + - 0.0002 * sin(AscNode); +end; + +procedure TStEclipses.CheckForEclipse(K : Double); +var + MeanJD, + J1, J2, J3, + PMag, UMag, + CentralJD, + SunAnom, + MoonAnom, + ArgLat, + AscNode, + EFac, + DeltaT, + F1, A1, + P, Q, W, + Gamma, Mu : Double; +begin +{compute Julian Centuries} + J1 := K / 1236.85; + J2 := Sqr(J1); + J3 := J2 * J1; + +{mean Julian Date for phase} + MeanJD := 2451550.09765 + + 29.530588853 * K + + 0.0001337 * J2 + - 0.000000150 * J3 + + 0.00000000073 * J2 * J2; + +{solar mean anomaly} + SunAnom := 2.5534 + + 29.1053569 * K + - 0.0000218 * J2 + - 0.00000011 * J3; + SunAnom := Frac(SunAnom / 360.0) * 360; + if (SunAnom < 0) then + SunAnom := SunAnom + 360.0; + +{lunar mean anomaly} + MoonAnom := 201.5643 + + 385.81693528 * K + + 0.0107438 * J2 + + 0.00001239 * J3 + - 0.000000058 * J2 * J2; + MoonAnom := Frac(MoonAnom / 360.0) * 360; + if (MoonAnom < 0) then + MoonAnom := MoonAnom + 360.0; + +{lunar argument of latitude} + ArgLat := 160.7108 + + 390.67050274 * K + - 0.0016341 * J2 + - 0.00000227 * J3 + + 0.000000011 * J2 * J2; + ArgLat := Frac(ArgLat / 360.0) * 360; + if (ArgLat < 0) then + ArgLat := ArgLat + 360.0; + +{lunar ascending node} + AscNode := 124.7746 + - 1.56375580 * K + + 0.0020691 * J2 + + 0.00000215 * J3; + AscNode := Frac(AscNode / 360.0) * 360; + if (AscNode < 0) then + AscNode := AscNode + 360.0; + +{convert to radians} + SunAnom := SunAnom/radcor; + MoonAnom := MoonAnom/radcor; + ArgLat := ArgLat/radcor; + AscNode := AscNode/radcor; + +{correction factor} + EFac := 1.0 - 0.002516 * J1 - 0.0000074 * J2; + +{if AscNode > 21 deg. from 0 or 180 then no eclipse} + if (abs(sin(ArgLat)) > (sin(21.0/radcor))) then Exit; + +{there is probably an eclipse - what kind? when?} + + CentralEclipseTime(MeanJD, K, J2, SunAnom, MoonAnom, + ArgLat, AscNode, EFac, + F1, A1, CentralJD); + +{Central JD is in Dynamical Time. Sun/Moon Positions are based on UT} +{An APPROXIMATE conversion is made to UT. This has limited accuracy} + + DeltaT := (-15 + (sqr(CentralJD - 2382148) / 41048480)) / 86400; + CentralJD := CentralJD - DeltaT; + + P := 0.2070 * sin(SunAnom) * EFac + + 0.0024 * sin(2*SunAnom) * EFac + - 0.0392 * sin(MoonAnom) + + 0.0116 * sin(2*MoonAnom) + - 0.0073 * sin(SunAnom + MoonAnom) * EFac + + 0.0067 * sin(MoonAnom - SunAnom) * EFac + + 0.0118 * sin(2*F1); + + Q := 5.2207 + - 0.0048 * cos(SunAnom) * EFac + + 0.0020 * cos(2*SunAnom) * EFac + - 0.3299 * cos(MoonAnom) + - 0.0060 * cos(SunAnom + MoonAnom) * EFac + + 0.0041 * cos(MoonAnom - SunAnom) * EFac; + + W := abs(cos(F1)); + + Gamma := (P * cos(F1) + Q * sin(F1)) * (1 - 0.0048 * W); + + Mu := 0.0059 + + 0.0046 * cos(SunAnom) * EFac + - 0.0182 * cos(MoonAnom) + + 0.0004 * cos(2*MoonAnom) + - 0.0005 * cos(SunAnom + MoonAnom); + + if (Frac(abs(K)) > 0.1) then begin +{Check for Lunar Eclipse possibilities} + PMag := (1.5573 + Mu - abs(Gamma)) / 0.5450; + UMag := (1.0128 - Mu - abs(Gamma)) / 0.5450; + + if (UMag >= 1.0) then + TotalLunarEclipse(CentralJD, MoonAnom, Mu, PMag, UMag, Gamma) + else if (UMag > 0) then + PartialLunarEclipse(CentralJD, MoonAnom, Mu, PMag, UMag, Gamma) + else if ((UMag < 0) and (PMag > 0)) then + PenumbralLunarEclipse(CentralJD, MoonAnom, Mu, PMag, UMag, Gamma); + end else begin +{Check for Solar Eclipse possibilities} +{ + Non-partial eclipses + -------------------- + central Axis of moon's umbral shadow touches earth's surface + Can be total, annular, or both + + non-central Axis of moon's umbral shadow does not touch earth's surface + Eclipse is usually partial but can be one of possibilities + for central eclipse if very near one of the earth's poles + + Partial eclipses + ---------------- + partial None of the moon's umbral shadow touches the earth's surface +} + + if (abs(Gamma) <= (0.9972 + abs(Mu))) then + NonPartialSolarEclipse(CentralJD, Mu, Gamma) + else begin + if (abs(Gamma) < 1.5433 + Mu) then + PartialSolarEclipse(CentralJD, Mu, Gamma); + end; + end; +end; + +procedure TStEclipses.TotalLunarEclipse(CentralJD, MoonAnom, Mu, + PMag, UMag, Gamma : Double); +var + TLE : PStEclipseRecord; + PartialSemiDur, + TotalSemiDur, + Dbl1 : Double; +begin + New(TLE); + TLE^.Magnitude := UMag; + TLE^.Hemisphere := htNone; + TLE^.EType := etLunarTotal; + TLE^.Path := nil; + CentralJD := AJDToDateTime(CentralJD); + + PartialSemiDur := 1.0128 - Mu; + TotalSemiDur := 0.4678 - Mu; + Dbl1 := 0.5458 + 0.0400 * cos(MoonAnom); + + PartialSemiDur := 60/Dbl1 * sqrt(sqr(PartialSemiDur) - sqr(Gamma)) / 1440; + TotalSemiDur := 60/Dbl1 * sqrt(sqr(TotalSemiDur) - sqr(Gamma)) / 1440; + + TLE^.LContacts.FirstContact := CentralJD - PartialSemiDur; + TLE^.LContacts.SecondContact := CentralJD - TotalSemiDur; + TLE^.LContacts.MidEclipse := CentralJD; + TLE^.LContacts.ThirdContact := CentralJD + TotalSemiDur; + TLE^.LContacts.FourthContact := CentralJD + PartialSemiDur; + + PartialSemiDur := 60/Dbl1 * sqrt(sqr(1.5573 + Mu) - sqr(Gamma)) / 1440; + TLE^.LContacts.UT1 := CentralJD - PartialSemiDur; + TLE^.LContacts.UT2 := CentralJD + PartialSemiDur; + + Self.Append(TLE); +end; + +procedure TStEclipses.PartialLunarEclipse(CentralJD, MoonAnom, Mu, + PMag, UMag, Gamma : Double); +var + TLE : PStEclipseRecord; + PartialSemiDur, + Dbl1 : Double; +begin + New(TLE); + TLE^.Magnitude := UMag; + TLE^.Hemisphere := htNone; + TLE^.EType := etLunarPartial; + TLE^.Path := nil; + CentralJD := AJDToDateTime(CentralJD); + + PartialSemiDur := 1.0128 - Mu; + Dbl1 := 0.5458 + 0.0400 * cos(MoonAnom); + + PartialSemiDur := 60/Dbl1 * sqrt(sqr(PartialSemiDur) - sqr(Gamma)) / 1440; + + TLE^.LContacts.FirstContact := CentralJD - PartialSemiDur; + TLE^.LContacts.SecondContact := 0; + TLE^.LContacts.MidEclipse := CentralJD; + TLE^.LContacts.ThirdContact := 0; + TLE^.LContacts.FourthContact := CentralJD + PartialSemiDur; + + PartialSemiDur := 60/Dbl1 * sqrt(sqr(1.5573 + Mu) - sqr(Gamma)) / 1440; + TLE^.LContacts.UT1 := CentralJD - PartialSemiDur; + TLE^.LContacts.UT2 := CentralJD + PartialSemiDur; + + Self.Append(TLE); +end; + +procedure TStEclipses.PenumbralLunarEclipse(CentralJD, MoonAnom, Mu, + PMag, UMag, Gamma : Double); +var + TLE : PStEclipseRecord; + PartialSemiDur, + Dbl1 : Double; +begin + New(TLE); + TLE^.Magnitude := PMag; + TLE^.Hemisphere := htNone; + TLE^.EType := etLunarPenumbral; + TLE^.Path := nil; + CentralJD := AJDToDateTime(CentralJD); + + TLE^.LContacts.FirstContact := 0; + TLE^.LContacts.SecondContact := 0; + TLE^.LContacts.MidEclipse := CentralJD; + TLE^.LContacts.ThirdContact := 0; + TLE^.LContacts.FourthContact := 0; + + Dbl1 := 0.5458 + 0.0400 * cos(MoonAnom); + PartialSemiDur := 60/Dbl1 * sqrt(sqr(1.5573 + Mu) - sqr(Gamma)) / 1440; + TLE^.LContacts.UT1 := CentralJD - PartialSemiDur; + TLE^.LContacts.UT2 := CentralJD + PartialSemiDur; + + Self.Append(TLE); +end; + +procedure TStEclipses.GetBesselianElements(CentralJD : Double); +var + I, + Mins : LongInt; + CurJD, + SidTime, + SunDist, + MoonDist, + DistRatio, + Alpha, + Theta, + Sun1, + Sun2, + Moon1, + Moon2, + Dbl3, + F1, F2 : Double; + DTRec : TStDateTimeRec; + SunXYZ : TStSunXYZRec; + Sun : TStPosRec; + Moon : TStMoonPosRec; +begin +{compute BesselianElements every 10 minutes starting 2 hours prior to CentralJD} +{but forcing positions to be at multiple of ten minutes} + for I := 1 to 25 do begin + CurJD := CentralJD + ((I-13) * (10/1440)); + DTRec.D := AstJulianDateToStDate(CurJD, True); + if ((Frac(CurJD) + 0.5) >= 1) then + Mins := Trunc(((Frac(CurJD) + 0.5)-1) * 1440) + else + Mins := Trunc((Frac(CurJD) + 0.5) * 1440); + {changed because, for example, both 25 and 35 rounded to 30} + Mins := ((Mins + 5) div 10) * 10; + if (Mins = 1440) then + Mins := 0; + DTRec.T := Mins * 60; + + SidTime := SiderealTime(DTRec) / radcor; + SunXYZ := SunPosPrim(DTRec); + Sun := SunPos(DTRec); + Moon := MoonPos(DTRec); + + Sun1 := Sun.RA/radcor; + Sun2 := Sun.DC/radcor; + Moon1 := Moon.RA/radcor; + Moon2 := Moon.DC/radcor; + + FBesselianElements[I].JD := StDateToDateTime(DTRec.D) + + StTimeToDateTime(DTRec.T); + + SunDist := 1.0 / sin(8.794/SunXYZ.RV/3600.0/radcor); + MoonDist := 1.0 / sin(Moon.Plx/radcor); + DistRatio := MoonDist / SunDist; + + Theta := DistRatio/cos(Sun2) * cos(Moon2) * (Moon1 - Sun1); + Theta := Theta/(1.0-DistRatio); + Alpha := Sun1 - Theta; + + Theta := DistRatio/(1.0 - DistRatio) * (Moon2 - Sun2); + + FBesselianElements[I].Delta := Sun2 - Theta; + FBesselianElements[I].Angle := SidTime - Alpha; + FBesselianElements[I].XAxis := MoonDist * cos(Moon2) * (sin(Moon1 - Alpha)); + + Dbl3 := FBesselianElements[I].Delta; + FBesselianElements[I].YAxis := MoonDist * (sin(Moon2) * cos(Dbl3) + - cos(Moon2) * sin(Dbl3) * cos(Moon1 - Alpha)); + + Theta := DistRatio * SunXYZ.RV; + Theta := SunXYZ.RV - Theta; + F1 := StInvSin(0.004664012/Theta); + F2 := StInvSin(0.004640787/Theta); + + Theta := MoonDist * (sin(Moon2) * sin(Dbl3) + cos(Moon2) + * cos(Dbl3) * cos(Moon1 - Alpha)); + FBesselianElements[I].L1 := (Theta + 0.272453/sin(F1)) * StTan(F1); + FBesselianElements[I].L2 := (Theta - 0.272453/sin(F2)) * StTan(F2); + + if (I = 13) then + F0 := StTan(F2); + + if (I = 16) then begin + FUPrime := FBesselianElements[16].Angle - FBesselianElements[10].Angle; + FDPrime := FBesselianElements[16].Delta - FBesselianElements[10].Delta; + end; + end; +end; + +procedure TStEclipses.GetShadowPath(I1, I2 : Integer; Path : TStList); +var + J, + I3, I4, + I5, I6 : integer; + + Delta, + Dbl1, + Dbl2, + P1, + XAxis, + YAxis, + Eta, + R1, R2, + D1, D2, + D3, D4, + V3, V4, + V5, V6, V7, + XPrime, + YPrime : Double; + + Position : PStLongLat; +begin + for J := I1 to I2 do begin + Eta := 0.00669454; + Delta := FBesselianElements[J].Delta; + XAxis := FBesselianElements[J].XAxis; + YAxis := FBesselianElements[J].YAxis; + + R1 := sqrt(1.0 - Eta * sqr(cos(Delta))); + R2 := sqrt(1.0 - Eta * sqr(sin(Delta))); + + D1 := sin(Delta) / R1; + D2 := sqrt(1.0 - Eta) * cos(Delta) / R1; + D3 := Eta * sin(Delta) * cos(Delta) / R1 / R2; + D4 := sqrt(1.0 - Eta) / R1 / R2; + + V3 := YAxis / R1; + V4 := sqrt(1.0 - sqr(XAxis) - sqr(V3)); + V5 := R2 * (V4 * D4 - V3 * D3); + V6 := FUPrime * (-YAxis * sin(Delta) + V5 * cos(Delta)); + V7 := FUPrime * XAxis * sin(Delta) - FDPrime * V5; + + if ((I2-I1) div 2) >= 4 then begin + I3 := (I2-I1) div 2; + I4 := I1 + I3; + I5 := I4 - 3; + I6 := I4 + 3; + XPrime := FBesselianElements[I6].XAxis + - FBesselianElements[I5].XAxis; + YPrime := FBesselianElements[I6].YAxis + - FBesselianElements[I5].YAxis; + end else begin + XPrime := (FBesselianElements[J+1].XAxis - + FBesselianElements[J-1].XAxis) * 3; + YPrime := (FBesselianElements[J+1].YAxis - + FBesselianElements[J-1].YAxis) * 3; + end; + + New(Position); + Dbl1 := sqrt(sqr(XPrime - V6) + sqr(YPrime - V7)); + Position^.JD := FBesselianElements[J].JD; + + Dbl2 := (FBesselianElements[J].L2 - V5 * F0) / Dbl1; + Dbl2 := abs(Dbl2 * 120); + Position^.Duration := int(Dbl2) + frac(Dbl2) * 0.6; + + Dbl1 := -V3 * D1 + V4 * D2; + P1 := StInvTan2(Dbl1, XAxis); + + Dbl2 := (FBesselianElements[J].Angle - P1) * radcor; + Dbl2 := frac(Dbl2 / 360.0) * 360; + if (Dbl2 < 0) then + Dbl2 := Dbl2 + 360.0; + if (Dbl2 > 180.0) and (Dbl2 < 360.0) then + Dbl2 := Dbl2 - 360.0; + Position^.Longitude := Dbl2; + + Dbl1 := StInvSin(V3 * D2 + V4 * D1); + Dbl2 := ArcTan(1.003364 * StTan(Dbl1)) * radcor; + Position^.Latitude := Dbl2; + + Path.Append(Position); + end; +end; + +procedure TStEclipses.NonPartialSolarEclipse(CentralJD, Mu, Gamma : Double); +var + SolEc : PStEclipseRecord; + I1, I2 : Integer; +begin + New(SolEc); + if (Mu < 0) then + SolEc^.EType := etSolarTotal + else if (Mu > 0.0047) then + SolEc^.EType := etSolarAnnular + else begin + if (Mu < (0.00464 * sqrt(1 - sqr(Gamma)))) then + SolEc^.EType := etSolarAnnularTotal + else + SolEc^.EType := etSolarTotal; + end; + + SolEc^.Magnitude := -1; + if (Gamma > 0) then + SolEc^.Hemisphere := htNorthern + else + SolEc^.Hemisphere := htSouthern; + FillChar(SolEc^.LContacts, SizeOf(TStContactTimes), #0); + SolEc^.LContacts.MidEclipse := AJDtoDateTime(CentralJD); + + GetBesselianElements(CentralJD); + +{find limits - then go one step inside at each end} + I1 := 1; + while (sqr(FBesselianElements[I1].XAxis) + + sqr(FBesselianElements[I1].YAxis) >= 1.0) and (I1 < 25) do + Inc(I1); + Inc(I1); + + I2 := I1; + repeat + if (I2 < 25) then begin + if (sqr(FBesselianElements[I2+1].XAxis) + + sqr(FBesselianElements[I2+1].YAxis) < 1) then + Inc(I2) + else + break; + end; + until (sqr(FBesselianElements[I2].XAxis) + + sqr(FBesselianElements[I2].YAxis) >= 1) or (I2 >= 25); + Dec(I2); + +{this test accounts for non-central eclipses, i.e., those that are total} +{and/or annular but the axis of the moon's shadow does not touch the earth} + if (I1 <> I2) and (I1 < 26) and (I2 < 26) then begin + SolEc^.Path := TStList.Create(TStListNode); + SolEc^.Path.DisposeData := DisposePathData; + GetShadowPath(I1, I2, SolEc^.Path); + end else + SolEc^.Path := nil; + Self.Append(SolEc); +end; + +procedure TStEclipses.PartialSolarEclipse(CentralJD, Mu, Gamma : Double); +var + SolEc : PStEclipseRecord; +begin + New(SolEc); + SolEc^.EType := etSolarPartial; + SolEc^.Magnitude := (1.5433 + Mu - abs(Gamma)) / (0.5461 + 2*Mu); + if (Gamma > 0) then + SolEc^.Hemisphere := htNorthern + else + SolEc^.Hemisphere := htSouthern; + FillChar(SolEc^.LContacts, SizeOf(TStContactTimes), #0); + SolEc^.LContacts.MidEclipse := AJDToDateTime(CentralJD); + SolEc^.Path := nil; + Self.Append(SolEc); +end; + + +end. diff --git a/components/systools/source/run/stjup.pas b/components/systools/source/run/stjup.pas new file mode 100644 index 000000000..d2ef74ea5 --- /dev/null +++ b/components/systools/source/run/stjup.pas @@ -0,0 +1,620 @@ +// Upgraded to Delphi 2009: Sebastian Zierer + +(* ***** BEGIN LICENSE BLOCK ***** + * Version: MPL 1.1 + * + * The contents of this file are subject to the Mozilla Public License Version + * 1.1 (the "License"); you may not use this file except in compliance with + * the License. You may obtain a copy of the License at + * http://www.mozilla.org/MPL/ + * + * Software distributed under the License is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License + * for the specific language governing rights and limitations under the + * License. + * + * The Original Code is TurboPower SysTools + * + * The Initial Developer of the Original Code is + * TurboPower Software + * + * Portions created by the Initial Developer are Copyright (C) 1996-2002 + * the Initial Developer. All Rights Reserved. + * + * Contributor(s): + * + * ***** END LICENSE BLOCK ***** *) + +{*********************************************************} +{* SysTools: StJup.pas 4.04 *} +{*********************************************************} +{* SysTools: Astronomical Routines (for Jupiter) *} +{*********************************************************} + +{$IFDEF FPC} + {$mode DELPHI} +{$ENDIF} + +//{$I StDefine.inc} + +unit StJup; + +interface + +uses + StAstroP; + +function ComputeJupiter(JD : Double) : TStEclipticalCord; + + +implementation + +{--------------------------------------------------------------------------} + +function GetLongitude(Tau, Tau2, Tau3, Tau4, Tau5 : Double) : Double; +var + L0, L1, + L2, L3, + L4, L5 : Double; +begin + L0 := 0.59954691495 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.09695898711 * cos(5.06191793110 + 529.69096509000 * Tau) + + 0.00573610145 * cos(1.44406205980 + 7.11354700080 * Tau) + + 0.00306389180 * cos(5.41734729980 + 1059.38193020000 * Tau) + + 0.00097178280 * cos(4.14264708820 + 632.78373931000 * Tau) + + 0.00072903096 * cos(3.64042909250 + 522.57741809000 * Tau) + + 0.00064263986 * cos(3.41145185200 + 103.09277422000 * Tau) + + 0.00039806051 * cos(2.29376744860 + 419.48464388000 * Tau) + + 0.00038857780 * cos(1.27231724860 + 316.39186966000 * Tau) + + 0.00027964622 * cos(1.78454589490 + 536.80451210000 * Tau) + + 0.00013589738 * cos(5.77481031590 + 1589.07289530000 * Tau) + + 0.00008768686 * cos(3.63000324420 + 949.17560897000 * Tau) + + 0.00008246362 * cos(3.58227961650 + 206.18554844000 * Tau) + + 0.00007368057 * cos(5.08101125610 + 735.87651353000 * Tau) + + 0.00006263171 * cos(0.02497643742 + 213.29909544000 * Tau) + + 0.00006114050 * cos(4.51319531670 + 1162.47470440000 * Tau) + + 0.00005305457 * cos(4.18625053490 + 1052.26838320000 * Tau) + + 0.00005305283 * cos(1.30671236850 + 14.22709400200 * Tau) + + 0.00004905419 * cos(1.32084631680 + 110.20632122000 * Tau) + + 0.00004647249 * cos(4.69958109500 + 3.93215326310 * Tau) + + 0.00003045009 * cos(4.31675960320 + 426.59819088000 * Tau) + + 0.00002610001 * cos(1.56667594850 + 846.08283475000 * Tau) + + 0.00002028191 * cos(1.06376547380 + 3.18139373770 * Tau) + + 0.00001920959 * cos(0.97168928755 + 639.89728631000 * Tau) + + 0.00001764768 * cos(2.14148077770 + 1066.49547720000 * Tau) + + 0.00001722983 * cos(3.88036008870 + 1265.56747860000 * Tau) + + 0.00001633217 * cos(3.58201089760 + 515.46387109000 * Tau) + + 0.00001431997 * cos(4.29683690270 + 625.67019231000 * Tau) + + 0.00000973278 * cos(4.09764957060 + 95.97922721800 * Tau) + + 0.00000884439 * cos(2.43701426120 + 412.37109687000 * Tau) + + 0.00000732875 * cos(6.08534113240 + 838.96928775000 * Tau) + + 0.00000731072 * cos(3.80591233960 + 1581.95934830000 * Tau) + + 0.00000709190 * cos(1.29272573660 + 742.99006053000 * Tau) + + 0.00000691928 * cos(6.13368222940 + 2118.76386040000 * Tau) + + 0.00000614464 * cos(4.10853496760 + 1478.86657410000 * Tau) + + 0.00000581902 * cos(4.53967717550 + 309.27832266000 * Tau) + + 0.00000495224 * cos(3.75567461380 + 323.50541666000 * Tau) + + 0.00000440854 * cos(2.95818460940 + 454.90936653000 * Tau) + + 0.00000417266 * cos(1.03554430160 + 2.44768055480 * Tau) + + 0.00000389864 * cos(4.89716105850 + 1692.16566950000 * Tau) + + 0.00000375657 * cos(4.70299124830 + 1368.66025280000 * Tau) + + 0.00000341006 * cos(5.71452525780 + 533.62311836000 * Tau) + + 0.00000330458 * cos(4.74049819490 + 0.04818410980 * Tau) + + 0.00000261540 * cos(1.87652461030 + 0.96320784650 * Tau) + + 0.00000261009 * cos(0.82047246448 + 380.12776796000 * Tau) + + 0.00000256568 * cos(3.72410724160 + 199.07200144000 * Tau) + + 0.00000244170 * cos(5.22020878900 + 728.76296653000 * Tau) + + 0.00000235141 * cos(1.22693908120 + 909.81873305000 * Tau) + + 0.00000220382 * cos(1.65115016000 + 543.91805910000 * Tau) + + 0.00000207327 * cos(1.85461666590 + 525.75881183000 * Tau) + + 0.00000201996 * cos(1.80684574190 + 1375.77379980000 * Tau) + + 0.00000197046 * cos(5.29252149020 + 1155.36115740000 * Tau) + + 0.00000175191 * cos(3.72966554760 + 942.06206197000 * Tau) + + 0.00000175184 * cos(3.22634903430 + 1898.35121790000 * Tau) + + 0.00000174809 * cos(5.90973505280 + 956.28915597000 * Tau) + + 0.00000157909 * cos(4.36483921770 + 1795.25844370000 * Tau) + + 0.00000150502 * cos(3.90625022620 + 74.78159856700 * Tau) + + 0.00000149368 * cos(4.37745104270 + 1685.05212250000 * Tau) + + 0.00000141445 * cos(3.13568357860 + 491.55792946000 * Tau) + + 0.00000137871 * cos(1.31797920780 + 1169.58825140000 * Tau) + + 0.00000130531 * cos(4.16867945490 + 1045.15483620000 * Tau) + + 0.00000117495 * cos(2.50022140890 + 1596.18644230000 * Tau) + + 0.00000116757 * cos(3.38920921040 + 0.52126486180 * Tau) + + 0.00000105895 * cos(4.55439798240 + 526.50957136000 * Tau); + + L1 := 529.93480758000 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00489741194 * cos(4.22066689930 + 529.69096509000 * Tau) + + 0.00228918538 * cos(6.02647464020 + 7.11354700080 * Tau) + + 0.00027655380 * cos(4.57265956820 + 1059.38193020000 * Tau) + + 0.00020720943 * cos(5.45938936290 + 522.57741809000 * Tau) + + 0.00012105732 * cos(0.16985765041 + 536.80451210000 * Tau) + + 0.00006068051 * cos(4.42419502010 + 103.09277422000 * Tau) + + 0.00005433924 * cos(3.98478382570 + 419.48464388000 * Tau) + + 0.00004237795 * cos(5.89009351270 + 14.22709400200 * Tau) + + 0.00002211854 * cos(5.26771446620 + 206.18554844000 * Tau) + + 0.00001745919 * cos(4.92669378490 + 1589.07289530000 * Tau) + + 0.00001295769 * cos(5.55132765090 + 3.18139373770 * Tau) + + 0.00001173129 * cos(5.85647304350 + 1052.26838320000 * Tau) + + 0.00001163411 * cos(0.51450895328 + 3.93215326310 * Tau) + + 0.00001098735 * cos(5.30704981590 + 515.46387109000 * Tau) + + 0.00001007216 * cos(0.46478398551 + 735.87651353000 * Tau) + + 0.00001003574 * cos(3.15040301820 + 426.59819088000 * Tau) + + 0.00000847678 * cos(5.75805850450 + 110.20632122000 * Tau) + + 0.00000827329 * cos(4.80312015730 + 213.29909544000 * Tau) + + 0.00000816397 * cos(0.58643054886 + 1066.49547720000 * Tau) + + 0.00000725447 * cos(5.51827471470 + 639.89728631000 * Tau) + + 0.00000567845 * cos(5.98867049450 + 625.67019231000 * Tau) + + 0.00000474181 * cos(4.13245269170 + 412.37109687000 * Tau) + + 0.00000412930 * cos(5.73652891260 + 95.97922721800 * Tau) + + 0.00000345249 * cos(4.24159565410 + 632.78373931000 * Tau) + + 0.00000335817 * cos(3.73248749050 + 1162.47470440000 * Tau) + + 0.00000234340 * cos(4.03469970330 + 949.17560897000 * Tau) + + 0.00000234066 * cos(6.24302226650 + 309.27832266000 * Tau) + + 0.00000198525 * cos(1.50458442830 + 838.96928775000 * Tau) + + 0.00000194784 * cos(2.21879010910 + 323.50541666000 * Tau) + + 0.00000186899 * cos(6.08620565910 + 742.99006053000 * Tau) + + 0.00000183938 * cos(6.27963588820 + 543.91805910000 * Tau) + + 0.00000171380 * cos(5.41655983840 + 199.07200144000 * Tau) + + 0.00000130771 * cos(0.62643377351 + 728.76296653000 * Tau) + + 0.00000115393 * cos(0.68019050174 + 846.08283475000 * Tau) + + 0.00000115047 * cos(5.28641699140 + 2118.76386040000 * Tau) + + 0.00000107575 * cos(4.49282760120 + 956.28915597000 * Tau) + + 0.00000079686 * cos(5.82412400270 + 1045.15483620000 * Tau) + + 0.00000071643 * cos(5.34162650320 + 942.06206197000 * Tau) + + 0.00000069618 * cos(5.97263450280 + 532.87235883000 * Tau) + + 0.00000066824 * cos(5.73365126530 + 21.34064100200 * Tau) + + 0.00000065635 * cos(0.12924191430 + 526.50957136000 * Tau) + + 0.00000064850 * cos(6.08803490290 + 1581.95934830000 * Tau) + + 0.00000058509 * cos(0.58626971028 + 1155.36115740000 * Tau) + + 0.00000057939 * cos(0.99453087342 + 1596.18644230000 * Tau) + + 0.00000057368 * cos(5.96851304800 + 1169.58825140000 * Tau) + + 0.00000056600 * cos(1.41198438840 + 533.62311836000 * Tau) + + 0.00000054935 * cos(5.42806383720 + 10.29494073800 * Tau) + + 0.00000052309 * cos(5.72661448390 + 117.31986822000 * Tau) + + 0.00000052016 * cos(0.22981299129 + 1368.66025280000 * Tau) + + 0.00000050418 * cos(6.08075147810 + 525.75881183000 * Tau) + + 0.00000047418 * cos(3.62611843240 + 1478.86657410000 * Tau) + + 0.00000046678 * cos(0.51144073175 + 1265.56747860000 * Tau) + + 0.00000039888 * cos(4.16158013600 + 1692.16566950000 * Tau) + + 0.00000033558 * cos(0.09913904872 + 302.16477566000 * Tau) + + 0.00000032827 * cos(5.03596689460 + 220.41264244000 * Tau) + + 0.00000032449 * cos(5.37492530700 + 508.35032409000 * Tau) + + 0.00000029483 * cos(5.42208897100 + 1272.68102560000 * Tau) + + 0.00000029379 * cos(3.35927241530 + 4.66586644600 * Tau) + + 0.00000029307 * cos(0.75907909735 + 88.86568021700 * Tau) + + 0.00000025195 * cos(1.60723063390 + 831.85574075000 * Tau); + + L2 := 0.00047233598 * cos(4.32148323550 + 7.11354700080 * Tau) + + 0.00038965550 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00030629053 * cos(2.93021440220 + 529.69096509000 * Tau) + + 0.00003189317 * cos(1.05504615600 + 522.57741809000 * Tau) + + 0.00002729292 * cos(4.84545481350 + 536.80451210000 * Tau) + + 0.00002723358 * cos(3.41411526640 + 1059.38193020000 * Tau) + + 0.00001721069 * cos(4.18734385160 + 14.22709400200 * Tau) + + 0.00000383258 * cos(5.76790714390 + 419.48464388000 * Tau) + + 0.00000377524 * cos(0.76048964872 + 515.46387109000 * Tau) + + 0.00000367498 * cos(6.05509120410 + 103.09277422000 * Tau) + + 0.00000337386 * cos(3.78644384240 + 3.18139373770 * Tau) + + 0.00000308200 * cos(0.69356654052 + 206.18554844000 * Tau) + + 0.00000218408 * cos(3.81389191350 + 1589.07289530000 * Tau) + + 0.00000198883 * cos(5.33996443440 + 1066.49547720000 * Tau) + + 0.00000197445 * cos(2.48356402050 + 3.93215326310 * Tau) + + 0.00000155862 * cos(1.40642426470 + 1052.26838320000 * Tau) + + 0.00000146230 * cos(3.81373196840 + 639.89728631000 * Tau) + + 0.00000141932 * cos(1.63435169020 + 426.59819088000 * Tau) + + 0.00000129570 * cos(5.83738872530 + 412.37109687000 * Tau) + + 0.00000117327 * cos(1.41435462590 + 625.67019231000 * Tau) + + 0.00000096733 * cos(4.03383427890 + 110.20632122000 * Tau) + + 0.00000090823 * cos(1.10630629040 + 95.97922721800 * Tau) + + 0.00000087292 * cos(2.52235174820 + 632.78373931000 * Tau) + + 0.00000078769 * cos(4.63726131330 + 543.91805910000 * Tau) + + 0.00000072392 * cos(2.21716670030 + 735.87651353000 * Tau) + + 0.00000058475 * cos(0.83216317444 + 199.07200144000 * Tau) + + 0.00000056910 * cos(3.12292059850 + 213.29909544000 * Tau) + + 0.00000048622 * cos(1.67283791620 + 309.27832266000 * Tau) + + 0.00000040150 * cos(4.02485444740 + 21.34064100200 * Tau) + + 0.00000039784 * cos(0.62416945827 + 323.50541666000 * Tau) + + 0.00000035718 * cos(2.32581247000 + 728.76296653000 * Tau) + + 0.00000029255 * cos(3.60838327800 + 10.29494073800 * Tau) + + 0.00000027814 * cos(3.23992013740 + 838.96928775000 * Tau) + + 0.00000025993 * cos(4.50118298290 + 742.99006053000 * Tau) + + 0.00000025620 * cos(2.51240623860 + 1162.47470440000 * Tau) + + 0.00000025194 * cos(1.21868110690 + 1045.15483620000 * Tau) + + 0.00000023591 * cos(3.00532139310 + 956.28915597000 * Tau) + + 0.00000019458 * cos(4.29028644670 + 532.87235883000 * Tau) + + 0.00000017660 * cos(0.80953941560 + 508.35032409000 * Tau) + + 0.00000017058 * cos(4.20001977720 + 2118.76386040000 * Tau) + + 0.00000017040 * cos(1.83402146640 + 526.50957136000 * Tau) + + 0.00000015355 * cos(5.81037986940 + 1596.18644230000 * Tau) + + 0.00000015292 * cos(0.68174165476 + 942.06206197000 * Tau) + + 0.00000014661 * cos(3.99989622590 + 117.31986822000 * Tau) + + 0.00000013920 * cos(5.95169568480 + 316.39186966000 * Tau) + + 0.00000013639 * cos(1.80336677960 + 302.16477566000 * Tau) + + 0.00000013230 * cos(2.51856643600 + 88.86568021700 * Tau) + + 0.00000012756 * cos(4.36856232410 + 1169.58825140000 * Tau) + + 0.00000010986 * cos(4.43586634640 + 525.75881183000 * Tau) + + 0.00000009681 * cos(1.71563161050 + 1581.95934830000 * Tau) + + 0.00000009437 * cos(2.17684563460 + 1155.36115740000 * Tau) + + 0.00000008812 * cos(3.29452783340 + 220.41264244000 * Tau) + + 0.00000008690 * cos(3.31924493610 + 831.85574075000 * Tau) + + 0.00000007823 * cos(5.75672228350 + 846.08283475000 * Tau) + + 0.00000007549 * cos(2.70955516780 + 533.62311836000 * Tau) + + 0.00000006685 * cos(2.17560093280 + 1265.56747860000 * Tau) + + 0.00000006285 * cos(0.49939863541 + 949.17560897000 * Tau); + + L3 := 0.00006501665 * cos(2.59862880480 + 7.11354700080 * Tau) + + 0.00001356524 * cos(1.34635886410 + 529.69096509000 * Tau) + + 0.00000470716 * cos(2.47503977880 + 14.22709400200 * Tau) + + 0.00000416960 * cos(3.24451243210 + 536.80451210000 * Tau) + + 0.00000352851 * cos(2.97360159000 + 522.57741809000 * Tau) + + 0.00000154880 * cos(2.07565585820 + 1059.38193020000 * Tau) + + 0.00000086771 * cos(2.51431584320 + 515.46387109000 * Tau) + + 0.00000044378 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00000033538 * cos(3.82633794500 + 1066.49547720000 * Tau) + + 0.00000028457 * cos(2.44754756060 + 206.18554844000 * Tau) + + 0.00000023737 * cos(1.27667172310 + 412.37109687000 * Tau) + + 0.00000022644 * cos(2.98231326770 + 543.91805910000 * Tau) + + 0.00000019798 * cos(2.10099934010 + 639.89728631000 * Tau) + + 0.00000019740 * cos(1.40255938970 + 419.48464388000 * Tau) + + 0.00000018768 * cos(1.59368403500 + 103.09277422000 * Tau) + + 0.00000017033 * cos(2.30214681200 + 21.34064100200 * Tau) + + 0.00000016774 * cos(2.59821460670 + 1589.07289530000 * Tau) + + 0.00000016214 * cos(3.14521117300 + 625.67019231000 * Tau) + + 0.00000016055 * cos(3.36030126300 + 1052.26838320000 * Tau) + + 0.00000013392 * cos(2.75973892200 + 95.97922721800 * Tau) + + 0.00000013234 * cos(2.53862244340 + 199.07200144000 * Tau) + + 0.00000012611 * cos(6.26578110400 + 426.59819088000 * Tau) + + 0.00000008701 * cos(1.76334960740 + 10.29494073800 * Tau) + + 0.00000008637 * cos(2.26563256290 + 110.20632122000 * Tau) + + 0.00000006725 * cos(3.42566433320 + 309.27832266000 * Tau) + + 0.00000006527 * cos(4.03869562910 + 728.76296653000 * Tau) + + 0.00000005675 * cos(2.52096417680 + 508.35032409000 * Tau) + + 0.00000005399 * cos(2.91184687110 + 1045.15483620000 * Tau) + + 0.00000005368 * cos(5.25196153540 + 323.50541666000 * Tau) + + 0.00000003996 * cos(4.30290261180 + 88.86568021700 * Tau) + + 0.00000003857 * cos(3.52381361550 + 302.16477566000 * Tau) + + 0.00000003774 * cos(4.09125315150 + 735.87651353000 * Tau) + + 0.00000003269 * cos(1.43175991270 + 956.28915597000 * Tau) + + 0.00000002783 * cos(4.35817507670 + 1596.18644230000 * Tau) + + 0.00000002661 * cos(1.25276590760 + 213.29909544000 * Tau) + + 0.00000002656 * cos(5.01505839850 + 838.96928775000 * Tau) + + 0.00000002553 * cos(2.23785673280 + 117.31986822000 * Tau) + + 0.00000002371 * cos(2.89662409240 + 742.99006053000 * Tau) + + 0.00000002279 * cos(2.35581871230 + 942.06206197000 * Tau); + + L4 := 0.00000669483 * cos(0.85282421090 + 7.11354700080 * Tau) + + 0.00000114019 * cos(3.14159265360 + 0.00000000000 * Tau) + + 0.00000099961 * cos(0.74258947751 + 14.22709400200 * Tau) + + 0.00000050024 * cos(1.65346208250 + 536.80451210000 * Tau) + + 0.00000043585 * cos(5.82026386620 + 529.69096509000 * Tau) + + 0.00000031813 * cos(4.85829986650 + 522.57741809000 * Tau) + + 0.00000014742 * cos(4.29061635780 + 515.46387109000 * Tau) + + 0.00000008899 * cos(0.71478520741 + 1059.38193020000 * Tau) + + 0.00000004957 * cos(1.29502259430 + 543.91805910000 * Tau) + + 0.00000004484 * cos(2.31715516630 + 1066.49547720000 * Tau) + + 0.00000004251 * cos(0.48326797501 + 21.34064100200 * Tau) + + 0.00000003100 * cos(3.00245542680 + 412.37109687000 * Tau) + + 0.00000002055 * cos(0.39858940218 + 639.89728631000 * Tau) + + 0.00000001902 * cos(4.25925620270 + 199.07200144000 * Tau) + + 0.00000001762 * cos(4.90536207310 + 625.67019231000 * Tau) + + 0.00000001695 * cos(4.26147580800 + 206.18554844000 * Tau) + + 0.00000001375 * cos(5.25546955670 + 1052.26838320000 * Tau) + + 0.00000001203 * cos(4.71614633840 + 95.97922721800 * Tau) + + 0.00000001086 * cos(1.28604571170 + 1589.07289530000 * Tau); + + L5 := 0.00000049577 * cos(5.25658966180 + 7.11354700080 * Tau) + + 0.00000015761 * cos(5.25126837480 + 14.22709400200 * Tau) + + 0.00000004343 * cos(0.01461869263 + 536.80451210000 * Tau) + + 0.00000001526 * cos(1.09739911440 + 522.57741809000 * Tau) + + 0.00000000845 * cos(3.14159265360 + 0.00000000000 * Tau); + Result := (L0 + L1*Tau + L2*Tau2 + L3*Tau3 + L4*Tau4 + L5*Tau5); +end; + +{---------------------------------------------------------------------------} + +function GetLatitude(Tau, Tau2, Tau3, Tau4, Tau5 : Double) : Double; +var + B0, B1, + B2, B3, + B4, B5 : Double; +begin + B0 := 0.02268615703 * cos(3.55852606720 + 529.69096509000 * Tau) + + 0.00110090358 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00109971634 * cos(3.90809347390 + 1059.38193020000 * Tau) + + 0.00008101427 * cos(3.60509573370 + 522.57741809000 * Tau) + + 0.00006437782 * cos(0.30627121409 + 536.80451210000 * Tau) + + 0.00006043996 * cos(4.25883108790 + 1589.07289530000 * Tau) + + 0.00001106880 * cos(2.98534421930 + 1162.47470440000 * Tau) + + 0.00000944328 * cos(1.67522288400 + 426.59819088000 * Tau) + + 0.00000941651 * cos(2.93619072400 + 1052.26838320000 * Tau) + + 0.00000894088 * cos(1.75447429920 + 7.11354700080 * Tau) + + 0.00000835861 * cos(5.17881973230 + 103.09277422000 * Tau) + + 0.00000767280 * cos(2.15473594060 + 632.78373931000 * Tau) + + 0.00000684220 * cos(3.67808770100 + 213.29909544000 * Tau) + + 0.00000629223 * cos(0.64343282328 + 1066.49547720000 * Tau) + + 0.00000558524 * cos(0.01354830508 + 846.08283475000 * Tau) + + 0.00000531670 * cos(2.70305954350 + 110.20632122000 * Tau) + + 0.00000464449 * cos(1.17337249190 + 949.17560897000 * Tau) + + 0.00000431072 * cos(2.60825000490 + 419.48464388000 * Tau) + + 0.00000351433 * cos(4.61062990710 + 2118.76386040000 * Tau) + + 0.00000132160 * cos(4.77816990670 + 742.99006053000 * Tau) + + 0.00000123148 * cos(3.34968181380 + 1692.16566950000 * Tau) + + 0.00000116379 * cos(1.38688232030 + 323.50541666000 * Tau) + + 0.00000115038 * cos(5.04892295440 + 316.39186966000 * Tau) + + 0.00000103762 * cos(3.70103838110 + 515.46387109000 * Tau) + + 0.00000103402 * cos(2.31878999570 + 1478.86657410000 * Tau) + + 0.00000102420 * cos(3.15293785440 + 1581.95934830000 * Tau); + + B1 := 0.00177351787 * cos(5.70166488490 + 529.69096509000 * Tau) + + 0.00003230171 * cos(5.77941619340 + 1059.38193020000 * Tau) + + 0.00003081364 * cos(5.47464296530 + 522.57741809000 * Tau) + + 0.00002211914 * cos(4.73477480210 + 536.80451210000 * Tau) + + 0.00001694232 * cos(3.14159265360 + 0.00000000000 * Tau) + + 0.00000346445 * cos(4.74595174110 + 1052.26838320000 * Tau) + + 0.00000234264 * cos(5.18856099930 + 1066.49547720000 * Tau) + + 0.00000196154 * cos(6.18554286640 + 7.11354700080 * Tau) + + 0.00000150468 * cos(3.92721226090 + 1589.07289530000 * Tau) + + 0.00000114128 * cos(3.43897271830 + 632.78373931000 * Tau) + + 0.00000096667 * cos(2.91426304090 + 949.17560897000 * Tau) + + 0.00000081671 * cos(5.07666097500 + 1162.47470440000 * Tau) + + 0.00000076599 * cos(2.50522188660 + 103.09277422000 * Tau) + + 0.00000076572 * cos(0.61288981445 + 419.48464388000 * Tau) + + 0.00000073875 * cos(5.49958292150 + 515.46387109000 * Tau) + + 0.00000060544 * cos(5.44740084360 + 213.29909544000 * Tau) + + 0.00000049915 * cos(3.94799616570 + 735.87651353000 * Tau) + + 0.00000046032 * cos(0.53850360901 + 110.20632122000 * Tau) + + 0.00000045123 * cos(1.89516645240 + 846.08283475000 * Tau) + + 0.00000036561 * cos(4.69828392840 + 543.91805910000 * Tau) + + 0.00000036019 * cos(6.10952578760 + 316.39186966000 * Tau) + + 0.00000031975 * cos(4.92452714630 + 1581.95934830000 * Tau); + + B2 := 0.00008094051 * cos(1.46322843660 + 529.69096509000 * Tau) + + 0.00000813244 * cos(3.14159265360 + 0.00000000000 * Tau) + + 0.00000742415 * cos(0.95691639003 + 522.57741809000 * Tau) + + 0.00000398951 * cos(2.89888666450 + 536.80451210000 * Tau) + + 0.00000342226 * cos(1.44683789730 + 1059.38193020000 * Tau) + + 0.00000073948 * cos(0.40724675866 + 1052.26838320000 * Tau) + + 0.00000046151 * cos(3.48036895770 + 1066.49547720000 * Tau) + + 0.00000029717 * cos(1.92504171330 + 1589.07289530000 * Tau) + + 0.00000029314 * cos(0.99088831805 + 515.46387109000 * Tau) + + 0.00000022753 * cos(4.27124052440 + 7.11354700080 * Tau) + + 0.00000013916 * cos(2.92242387340 + 543.91805910000 * Tau) + + 0.00000012067 * cos(5.22168932480 + 632.78373931000 * Tau) + + 0.00000010703 * cos(4.88024222480 + 949.17560897000 * Tau) + + 0.00000006078 * cos(6.21089108430 + 1045.15483620000 * Tau); + + B3 := 0.00000251624 * cos(3.38087923080 + 529.69096509000 * Tau) + + 0.00000121738 * cos(2.73311837200 + 522.57741809000 * Tau) + + 0.00000048694 * cos(1.03689996680 + 536.80451210000 * Tau) + + 0.00000010988 * cos(2.31463561350 + 1052.26838320000 * Tau) + + 0.00000008067 * cos(2.76729757620 + 515.46387109000 * Tau) + + 0.00000007287 * cos(4.25268318970 + 1059.38193020000 * Tau) + + 0.00000006205 * cos(1.78115827370 + 1066.49547720000 * Tau) + + 0.00000003627 * cos(1.13028917220 + 543.91805910000 * Tau) + + 0.00000002798 * cos(3.14159265360 + 0.00000000000 * Tau); + + B4 := 0.00000015050 * cos(4.52956999640 + 522.57741809000 * Tau) + + 0.00000005370 * cos(4.47427159140 + 529.69096509000 * Tau) + + 0.00000004456 * cos(5.43908581050 + 536.80451210000 * Tau) + + 0.00000003422 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00000001833 * cos(4.51807036230 + 515.46387109000 * Tau) + + 0.00000001322 * cos(4.20117611580 + 1052.26838320000 * Tau); + + B5 := 0.00000001445 * cos(0.09198554072 + 522.57741809000 * Tau); + Result := (B0 + B1*Tau + B2*Tau2 + B3*Tau3 + B4*Tau4 + B5*Tau5); +end; + +{---------------------------------------------------------------------------} + +function GetRadiusVector(Tau, Tau2, Tau3, Tau4, Tau5 : Double) : Double; +var + R0, R1, + R2, R3, + R4, R5 : Double; +begin + R0 := 5.20887429470 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.25209327020 * cos(3.49108640020 + 529.69096509000 * Tau) + + 0.00610599902 * cos(3.84115365600 + 1059.38193020000 * Tau) + + 0.00282029465 * cos(2.57419879930 + 632.78373931000 * Tau) + + 0.00187647391 * cos(2.07590380080 + 522.57741809000 * Tau) + + 0.00086792941 * cos(0.71001090609 + 419.48464388000 * Tau) + + 0.00072062869 * cos(0.21465694745 + 536.80451210000 * Tau) + + 0.00065517227 * cos(5.97995850840 + 316.39186966000 * Tau) + + 0.00030135275 * cos(2.16132058450 + 949.17560897000 * Tau) + + 0.00029134620 * cos(1.67759243710 + 103.09277422000 * Tau) + + 0.00023947340 * cos(0.27457854894 + 7.11354700080 * Tau) + + 0.00023453209 * cos(3.54023147300 + 735.87651353000 * Tau) + + 0.00022283710 * cos(4.19362773550 + 1589.07289530000 * Tau) + + 0.00013032600 * cos(2.96043055740 + 1162.47470440000 * Tau) + + 0.00012749004 * cos(2.71550102860 + 1052.26838320000 * Tau) + + 0.00009703346 * cos(1.90669572400 + 206.18554844000 * Tau) + + 0.00009161431 * cos(4.41352618940 + 213.29909544000 * Tau) + + 0.00007894539 * cos(2.47907551400 + 426.59819088000 * Tau) + + 0.00007057978 * cos(2.18184753110 + 1265.56747860000 * Tau) + + 0.00006137755 * cos(6.26417542510 + 846.08283475000 * Tau) + + 0.00005477093 * cos(5.65729325170 + 639.89728631000 * Tau) + + 0.00004170012 * cos(2.01605033910 + 515.46387109000 * Tau) + + 0.00004136890 * cos(2.72219979680 + 625.67019231000 * Tau) + + 0.00003502519 * cos(0.56531297394 + 1066.49547720000 * Tau) + + 0.00002616955 * cos(2.00993967130 + 1581.95934830000 * Tau) + + 0.00002499966 * cos(4.55182055940 + 838.96928775000 * Tau) + + 0.00002127644 * cos(6.12751461750 + 742.99006053000 * Tau) + + 0.00001911876 * cos(0.85621927419 + 412.37109687000 * Tau) + + 0.00001610549 * cos(3.08867789270 + 1368.66025280000 * Tau) + + 0.00001479484 * cos(2.68026191370 + 1478.86657410000 * Tau) + + 0.00001230708 * cos(1.89042979700 + 323.50541666000 * Tau) + + 0.00001216810 * cos(1.80171561020 + 110.20632122000 * Tau) + + 0.00001014959 * cos(1.38673237670 + 454.90936653000 * Tau) + + 0.00000998579 * cos(2.87208940110 + 309.27832266000 * Tau) + + 0.00000961072 * cos(4.54876989810 + 2118.76386040000 * Tau) + + 0.00000885708 * cos(4.14785948470 + 533.62311836000 * Tau) + + 0.00000821465 * cos(1.59342534400 + 1898.35121790000 * Tau) + + 0.00000812036 * cos(5.94091899140 + 909.81873305000 * Tau) + + 0.00000776700 * cos(3.67696954690 + 728.76296653000 * Tau) + + 0.00000727162 * cos(3.98824686400 + 1155.36115740000 * Tau) + + 0.00000655289 * cos(2.79065604220 + 1685.05212250000 * Tau) + + 0.00000653981 * cos(3.38150775270 + 1692.16566950000 * Tau) + + 0.00000620798 * cos(4.82284338960 + 956.28915597000 * Tau) + + 0.00000614784 * cos(2.27624915600 + 942.06206197000 * Tau) + + 0.00000562120 * cos(0.08095987241 + 543.91805910000 * Tau) + + 0.00000542221 * cos(0.28360266386 + 525.75881183000 * Tau); + + R1 := 0.01271801596 * cos(2.64937511120 + 529.69096509000 * Tau) + + 0.00061661771 * cos(3.00076251020 + 1059.38193020000 * Tau) + + 0.00053443592 * cos(3.89717644230 + 522.57741809000 * Tau) + + 0.00041390257 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00031185167 * cos(4.88276663530 + 536.80451210000 * Tau) + + 0.00011847190 * cos(2.41329588180 + 419.48464388000 * Tau) + + 0.00009166360 * cos(4.75979408590 + 7.11354700080 * Tau) + + 0.00003403605 * cos(3.34688538000 + 1589.07289530000 * Tau) + + 0.00003203446 * cos(5.21083285480 + 735.87651353000 * Tau) + + 0.00003175763 * cos(2.79297987070 + 103.09277422000 * Tau) + + 0.00002806064 * cos(3.74223693580 + 515.46387109000 * Tau) + + 0.00002676575 * cos(4.33052878700 + 1052.26838320000 * Tau) + + 0.00002600003 * cos(3.63435101620 + 206.18554844000 * Tau) + + 0.00002412207 * cos(1.46947308300 + 426.59819088000 * Tau) + + 0.00002100507 * cos(3.92762682310 + 639.89728631000 * Tau) + + 0.00001646182 * cos(5.30953510950 + 1066.49547720000 * Tau) + + 0.00001641257 * cos(4.41628669820 + 625.67019231000 * Tau) + + 0.00001049866 * cos(3.16113622960 + 213.29909544000 * Tau) + + 0.00001024802 * cos(2.55432643020 + 412.37109687000 * Tau) + + 0.00000806404 * cos(2.67750801380 + 632.78373931000 * Tau) + + 0.00000740996 * cos(2.17094630560 + 1162.47470440000 * Tau) + + 0.00000676928 * cos(6.24953479790 + 838.96928775000 * Tau) + + 0.00000567076 * cos(4.57655414710 + 742.99006053000 * Tau) + + 0.00000484689 * cos(2.46882793190 + 949.17560897000 * Tau) + + 0.00000468895 * cos(4.70973463480 + 543.91805910000 * Tau) + + 0.00000444683 * cos(0.40281181402 + 323.50541666000 * Tau) + + 0.00000415894 * cos(5.36836018210 + 728.76296653000 * Tau) + + 0.00000401738 * cos(4.60528841540 + 309.27832266000 * Tau) + + 0.00000347378 * cos(4.68148808720 + 14.22709400200 * Tau) + + 0.00000337555 * cos(3.16781951120 + 956.28915597000 * Tau) + + 0.00000260753 * cos(5.34290306100 + 846.08283475000 * Tau) + + 0.00000246603 * cos(3.92313823540 + 942.06206197000 * Tau) + + 0.00000220084 * cos(4.84210964960 + 1368.66025280000 * Tau) + + 0.00000203217 * cos(5.59995425430 + 1155.36115740000 * Tau) + + 0.00000200190 * cos(4.43888814440 + 1045.15483620000 * Tau) + + 0.00000197134 * cos(3.70551461390 + 2118.76386040000 * Tau) + + 0.00000196005 * cos(3.75877587140 + 199.07200144000 * Tau) + + 0.00000183504 * cos(4.26526769700 + 95.97922721800 * Tau) + + 0.00000180134 * cos(4.40165491160 + 532.87235883000 * Tau) + + 0.00000170225 * cos(4.84647488870 + 526.50957136000 * Tau) + + 0.00000146335 * cos(6.12958365530 + 533.62311836000 * Tau) + + 0.00000133483 * cos(1.32245735860 + 110.20632122000 * Tau) + + 0.00000132076 * cos(4.51187950810 + 525.75881183000 * Tau); + + R2 := 0.00079644833 * cos(1.35865896600 + 529.69096509000 * Tau) + + 0.00008251618 * cos(5.77773935440 + 522.57741809000 * Tau) + + 0.00007029864 * cos(3.27476965830 + 536.80451210000 * Tau) + + 0.00005314006 * cos(1.83835109710 + 1059.38193020000 * Tau) + + 0.00001860833 * cos(2.97682139370 + 7.11354700080 * Tau) + + 0.00000964466 * cos(5.48031822020 + 515.46387109000 * Tau) + + 0.00000836267 * cos(4.19889881720 + 419.48464388000 * Tau) + + 0.00000497920 * cos(3.14159265360 + 0.00000000000 * Tau) + + 0.00000426570 * cos(2.22753101800 + 639.89728631000 * Tau) + + 0.00000406453 * cos(3.78250730350 + 1066.49547720000 * Tau) + + 0.00000377316 * cos(2.24248352870 + 1589.07289530000 * Tau) + + 0.00000362943 * cos(5.36761847270 + 206.18554844000 * Tau) + + 0.00000342048 * cos(6.09922969320 + 1052.26838320000 * Tau) + + 0.00000339043 * cos(6.12690864040 + 625.67019231000 * Tau) + + 0.00000332578 * cos(0.00328961161 + 426.59819088000 * Tau) + + 0.00000279920 * cos(4.26162555830 + 412.37109687000 * Tau) + + 0.00000257290 * cos(0.96295364983 + 632.78373931000 * Tau) + + 0.00000229777 * cos(0.70530766213 + 735.87651353000 * Tau) + + 0.00000200783 * cos(3.06850623370 + 543.91805910000 * Tau) + + 0.00000199807 * cos(4.42884165320 + 103.09277422000 * Tau) + + 0.00000138606 * cos(2.93235671610 + 14.22709400200 * Tau) + + 0.00000113535 * cos(0.78713911289 + 728.76296653000 * Tau) + + 0.00000094565 * cos(1.70498041070 + 838.96928775000 * Tau) + + 0.00000086025 * cos(5.14434751990 + 323.50541666000 * Tau) + + 0.00000083469 * cos(0.05834873484 + 309.27832266000 * Tau) + + 0.00000080328 * cos(2.98122361800 + 742.99006053000 * Tau) + + 0.00000075198 * cos(1.60495195910 + 956.28915597000 * Tau) + + 0.00000070451 * cos(1.50988357480 + 213.29909544000 * Tau) + + 0.00000066572 * cos(5.47307178080 + 199.07200144000 * Tau) + + 0.00000061649 * cos(6.10137889850 + 1045.15483620000 * Tau) + + 0.00000056203 * cos(0.95534810533 + 1162.47470440000 * Tau) + + 0.00000051904 * cos(5.58435625610 + 942.06206197000 * Tau) + + 0.00000050057 * cos(2.72063162320 + 532.87235883000 * Tau) + + 0.00000044548 * cos(5.52445621410 + 508.35032409000 * Tau) + + 0.00000044282 * cos(0.27118152557 + 526.50957136000 * Tau) + + 0.00000039833 * cos(5.94566506230 + 95.97922721800 * Tau); + + R3 := 0.00003519257 * cos(6.05800633850 + 529.69096509000 * Tau) + + 0.00001073239 * cos(1.67321345760 + 536.80451210000 * Tau) + + 0.00000915666 * cos(1.41329676120 + 522.57741809000 * Tau) + + 0.00000341593 * cos(0.52296542656 + 1059.38193020000 * Tau) + + 0.00000254893 * cos(1.19625473530 + 7.11354700080 * Tau) + + 0.00000221512 * cos(0.95225226237 + 515.46387109000 * Tau) + + 0.00000089729 * cos(3.14159265360 + 0.00000000000 * Tau) + + 0.00000069078 * cos(2.26885282310 + 1066.49547720000 * Tau) + + 0.00000057827 * cos(1.41389745340 + 543.91805910000 * Tau) + + 0.00000057653 * cos(0.52580117593 + 639.89728631000 * Tau) + + 0.00000051079 * cos(5.98016364680 + 412.37109687000 * Tau) + + 0.00000046935 * cos(1.57864237960 + 625.67019231000 * Tau) + + 0.00000042824 * cos(6.11689609100 + 419.48464388000 * Tau) + + 0.00000037477 * cos(1.18262762330 + 14.22709400200 * Tau) + + 0.00000033816 * cos(1.66671706950 + 1052.26838320000 * Tau) + + 0.00000033531 * cos(0.84784977903 + 206.18554844000 * Tau) + + 0.00000031195 * cos(1.04290245900 + 1589.07289530000 * Tau) + + 0.00000030023 * cos(4.63236245030 + 426.59819088000 * Tau) + + 0.00000020804 * cos(2.50071243810 + 728.76296653000 * Tau) + + 0.00000015023 * cos(0.89136998434 + 199.07200144000 * Tau) + + 0.00000014466 * cos(0.96040197071 + 508.35032409000 * Tau) + + 0.00000012969 * cos(1.50233788550 + 1045.15483620000 * Tau) + + 0.00000012319 * cos(2.60952614500 + 735.87651353000 * Tau) + + 0.00000011654 * cos(3.55513510120 + 323.50541666000 * Tau) + + 0.00000011160 * cos(1.79041437550 + 309.27832266000 * Tau) + + 0.00000010554 * cos(6.27845112680 + 956.28915597000 * Tau) + + 0.00000009812 * cos(6.26016859520 + 103.09277422000 * Tau) + + 0.00000009301 * cos(3.45126812480 + 838.96928775000 * Tau); + + R4 := 0.00000128628 * cos(0.08419309557 + 536.80451210000 * Tau) + + 0.00000113458 * cos(4.24858855780 + 529.69096509000 * Tau) + + 0.00000082650 * cos(3.29754909410 + 522.57741809000 * Tau) + + 0.00000037883 * cos(2.73326611140 + 515.46387109000 * Tau) + + 0.00000026694 * cos(5.69142588560 + 7.11354700080 * Tau) + + 0.00000017650 * cos(5.40012536920 + 1059.38193020000 * Tau) + + 0.00000012612 * cos(6.01560416060 + 543.91805910000 * Tau) + + 0.00000009287 * cos(0.76813946494 + 1066.49547720000 * Tau) + + 0.00000008107 * cos(5.68228065710 + 14.22709400200 * Tau) + + 0.00000006978 * cos(1.42751292060 + 412.37109687000 * Tau) + + 0.00000006271 * cos(5.12286932530 + 639.89728631000 * Tau) + + 0.00000005377 * cos(3.33501947270 + 625.67019231000 * Tau) + + 0.00000002911 * cos(3.40334805050 + 1052.26838320000 * Tau) + + 0.00000002593 * cos(4.16090412980 + 728.76296653000 * Tau) + + 0.00000002562 * cos(2.89802035070 + 426.59819088000 * Tau); + + R5 := 0.00000011188 * cos(4.75249399940 + 536.80451210000 * Tau) + + 0.00000004255 * cos(5.91516229170 + 522.57741809000 * Tau) + + 0.00000002079 * cos(5.56781555860 + 515.46387109000 * Tau) + + 0.00000001908 * cos(4.29659647290 + 543.91805910000 * Tau) + + 0.00000001875 * cos(3.69357495840 + 7.11354700080 * Tau) + + 0.00000001612 * cos(4.13222808530 + 1059.38193020000 * Tau) + + 0.00000001590 * cos(5.49312796170 + 1066.49547720000 * Tau); + + Result := (R0 + R1*Tau + R2*Tau2 + R3*Tau3 + R4*Tau4 + R5*Tau5); +end; + +{---------------------------------------------------------------------------} + +function ComputeJupiter(JD : Double) : TStEclipticalCord; +var + Tau, + Tau2, + Tau3, + Tau4, + Tau5 : Double; +begin + Tau := (JD - 2451545.0) / 365250.0; + Tau2 := sqr(Tau); + Tau3 := Tau * Tau2; + Tau4 := sqr(Tau2); + Tau5 := Tau2 * Tau3; + + Result.L0 := GetLongitude(Tau, Tau2, Tau3, Tau4, Tau5); + Result.B0 := GetLatitude(Tau, Tau2, Tau3, Tau4, Tau5); + Result.R0 := GetRadiusVector(Tau, Tau2, Tau3, Tau4, Tau5); +end; + +end. diff --git a/components/systools/source/run/stjupsat.pas b/components/systools/source/run/stjupsat.pas new file mode 100644 index 000000000..ac38807c5 --- /dev/null +++ b/components/systools/source/run/stjupsat.pas @@ -0,0 +1,1109 @@ +// Upgraded to Delphi 2009: Sebastian Zierer + +(* ***** BEGIN LICENSE BLOCK ***** + * Version: MPL 1.1 + * + * The contents of this file are subject to the Mozilla Public License Version + * 1.1 (the "License"); you may not use this file except in compliance with + * the License. You may obtain a copy of the License at + * http://www.mozilla.org/MPL/ + * + * Software distributed under the License is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License + * for the specific language governing rights and limitations under the + * License. + * + * The Original Code is TurboPower SysTools + * + * The Initial Developer of the Original Code is + * TurboPower Software + * + * Portions created by the Initial Developer are Copyright (C) 1996-2002 + * the Initial Developer. All Rights Reserved. + * + * Contributor(s): + * + * ***** END LICENSE BLOCK ***** *) + +{*********************************************************} +{* SysTools: StJupsat.pas 4.04 *} +{*********************************************************} +{* SysTools: Astronomical Routines *} +{* (for the four "Gallilean" moons of Jupiter *} +{* Callisto, Europa, Ganymede, and Io) *} +{*********************************************************} + +{$IFDEF FPC} + {$mode DELPHI} +{$ENDIF} + +//{$I StDefine.inc} + +{ ************************************************************** } +{ Sources: } +{ 1. Astronomical Algorithms, Jean Meeus, Willmann-Bell, 1991. } +{ } +{ 2. Planetary and Lunar Coordinates (1984-2000), U.S. Govt, } +{ 1983. } +{ } +{ 3. Supplement to the American Ephemeris and Nautical Almanac,} +{ U.S. Govt, 1964. } +{ } +{ 4. MPO96-98 source files, Brian D. Warner, 1995-98. } +{ } +{ ************************************************************** } + +(* ************************************************************** + +The formulae in this unit are based on DYNAMICAL time, which is based +on the actual rotation of the Earth and is gradually slowing. Universal +Time is based on a fixed rotation rate. To directly compare results in +the astronomical literature (and Meeus' examples), you must use a Universal +Time that is adjusted by the value Delta T. This value is approximately 1 min +in the latter part of the 20th century and will be about 80 seconds in the +year 2020. As an example, to compare the High Precision positions for +1992 December 16 (Meeus' example), you must use a Universal Time of +1992 December 16 at 00:00:59 which equals 00:00:00 Dynamical Time + + +The Shadows parameter is used for high precision calculations only. If True, +the positions are calculated as seen from the SUN, not the Earth. For eclipses +of the satellites by Jupiter, in effect, the position is in reference to the +SHADOW of Jupiter in space, not the planet itself. For shadow transits, where +the shadow of the satellite is projected onto the surface of the planet, the +position is that of the satellite's shadow in reference to Jupiter and not +the satellite itself. + +The purpose of the Shadows parameter is to complete the prediction for +satellite phenomenon. For example, using Shadow := False, the result may +indicate that a satellite goes behind Jupiter at a given instant but not +if the satellite is visible because it is in Jupiter's shadow. Setting +Shadow := True for the same time will indicate if the planet is in or out +of Jupiter's shadow. + +(Shadow := FALSE) and (abs(satellite X-coordinate) = 1) +------------------------------------------------------- +If the X-value is negative and heading towards 0, the satellite is entering +the front of the planet. +If the X-value is negative and increasing, the satellite is coming from +behind the planet. +If the X-value is positive and heading towards 0, the satellite is going +behind the planet. +If the X-value is positive and increasing, the satellite is leaving +the front of the planet. + +(Shadow := TRUE) and (abs(satellite X-coordinate) = 1) +------------------------------------------------------- +If the X-value is negative and heading towards 0, the satellite's shadow is +entering the planet's disc. +If the X-value is negative and increasing, the satellite is leaving the +planet's shadow. +If the X-value is positive and heading towards 0, the satellite entering +the planet's shadow. +If the X-value is positive and increasing, the satellite's shadow is +leaving the planet. + +The X and Y coordinates are based on the equatorial radius of Jupiter. Because +the planet is considerably flattened by its rapid rotation, the polar diameter +is less than 1. To avoid dealing with an elliptical disc for Jupiter, multiply +the Y values only by 1.071374. This creates a "circular Jupiter" and so makes +determining if the satellite is above or below Jupiter easier +(abs(Y-coordinate) > 1). + +****************************************************************** *) + +unit StJupsat; + +interface + +type + TStJupSatPos = packed record + X : Double; + Y : Double; + end; + + TStJupSats = packed record + Io : TStJupSatPos; + Europa : TStJupSatPos; + Ganymede : TStJupSatPos; + Callisto : TStJupSatPos; + end; + +function GetJupSats(JD : TDateTime; HighPrecision, Shadows : Boolean) : TStJupSats; + +implementation +uses + StDate, StAstro, StAstroP, StJup, StMath; + +type + SunCoordsRec = packed record + X, Y, Z : Double; + L, B, R : Double; + end; + + TranformRec = packed record + A, B, C : array[1..6] of Double; + end; + + +function SunCoords(JD : Double) : SunCoordsRec; +var + L, B, R, + T0, TM, + RS, + OB, A : Double; +begin + T0 := (JD - StdDate) / 365250; + TM := T0/100; + RS := radcor * 3600; + OB := 0.4090928042223 + - 4680.93/RS * TM + - 1.55/RS * sqr(TM) + + 1999.25/RS * sqr(TM) * TM + - 51.38/RS * sqr(sqr(TM)) + - 249.67/RS * sqr(sqr(TM)) * TM + - 39.05/RS * sqr(sqr(TM)) * sqr(TM) + + 7.12/RS * sqr(sqr(TM)) * sqr(TM) * TM + + 27.87/RS * sqr(sqr(sqr(TM))); + + L := 175347046 + + 3341656 * cos(4.6692568 + 6283.07585*T0) + + 34894 * cos(4.6261000 + 12566.1517*T0) + + 3497 * cos(2.7441000 + 5753.3849*T0) + + 3418 * cos(2.8289000 + 3.5231*T0) + + 3136 * cos(3.6277000 + 77713.7715*T0) + + 2676 * cos(4.4181000 + 7860.4194*T0) + + 2343 * cos(6.1352000 + 3930.2097*T0) + + 1324 * cos(0.7425000 + 11506.7698*T0) + + 1273 * cos(2.0371000 + 529.6910*T0) + + 1199 * cos(1.1096000 + 1577.3435*T0) + + 990 * cos(5.2330000 + 5884.9270*T0) + + 902 * cos(2.0450000 + 26.1490*T0) + + 857 * cos(3.5080000 + 398.149*T0) + + 780 * cos(1.1790000 + 5223.694*T0) + + 753 * cos(2.5330000 + 5507.553*T0) + + 505 * cos(4.5830000 + 18849.228*T0) + + 492 * cos(4.2050000 + 775.523*T0) + + 357 * cos(2.9200000 + 0.067*T0) + + 317 * cos(5.8490000 + 11790.626*T0) + + 284 * cos(1.8990000 + 796.298*T0) + + 271 * cos(0.3150000 + 10977.079*T0) + + 243 * cos(0.3450000 + 5486.778*T0) + + 206 * cos(4.8060000 + 2544.314*T0) + + 205 * cos(1.8690000 + 5573.143*T0) + + 202 * cos(2.4580000 + 6069.777*T0) + + 156 * cos(0.8330000 + 213.299*T0) + + 132 * cos(3.4110000 + 2942.463*T0) + + 126 * cos(1.0830000 + 20.775*T0) + + 115 * cos(0.6450000 + 0.980*T0) + + 103 * cos(0.6360000 + 4694.003*T0) + + 102 * cos(0.9760000 + 15720.839*T0) + + 102 * cos(4.2670000 + 7.114*T0) + + 99 * cos(6.2100000 + 2146.170*T0) + + 98 * cos(0.6800000 + 155.420*T0) + + 86 * cos(5.9800000 +161000.690*T0) + + 85 * cos(1.3000000 + 6275.960*T0) + + 85 * cos(3.6700000 + 71430.700*T0) + + 80 * cos(1.8100000 + 17260.150*T0); + + A := 628331966747.0 + + 206059 * cos(2.678235 + 6283.07585*T0) + + 4303 * cos(2.635100 + 12566.1517*T0) + + 425 * cos(1.590000 + 3.523*T0) + + 119 * cos(5.796000 + 26.298*T0) + + 109 * cos(2.966000 + 1577.344*T0) + + 93 * cos(2.590000 + 18849.23*T0) + + 72 * cos(1.140000 + 529.69*T0) + + 68 * cos(1.870000 + 398.15*T0) + + 67 * cos(4.410000 + 5507.55*T0) + + 59 * cos(2.890000 + 5223.69*T0) + + 56 * cos(2.170000 + 155.42*T0) + + 45 * cos(0.400000 + 796.30*T0) + + 36 * cos(0.470000 + 775.52*T0) + + 29 * cos(2.650000 + 7.11*T0) + + 21 * cos(5.340000 + 0.98*T0) + + 19 * cos(1.850000 + 5486.78*T0) + + 19 * cos(4.970000 + 213.30*T0) + + 17 * cos(2.990000 + 6275.96*T0) + + 16 * cos(0.030000 + 2544.31*T0); + L := L + (A * T0); + + A := 52919 + + 8720 * cos(1.0721 + 6283.0758*T0) + + 309 * cos(0.867 + 12566.152*T0) + + 27 * cos(0.050 + 3.52*T0) + + 16 * cos(5.190 + 26.30*T0) + + 16 * cos(3.68 + 155.42*T0) + + 10 * cos(0.76 + 18849.23*T0) + + 9 * cos(2.06 + 77713.77*T0) + + 7 * cos(0.83 + 775.52*T0) + + 5 * cos(4.66 + 1577.34*T0); + L := L + (A * sqr(T0)); + + A := 289 * cos(5.844 + 6283.076*T0) + + 35 + + 17 * cos(5.49 + 12566.15*T0) + + 3 * cos(5.20 + 155.42*T0) + + 1 * cos(4.72 + 3.52*T0); + L := L + (A * sqr(T0) * T0); + + A := 114 * cos(3.142); + L := L + (A * sqr(sqr(T0))); + L := L / 1.0E+8; + +{solar latitude} + B := 280 * cos(3.199 + 84334.662*T0) + + 102 * cos(5.422 + 5507.553*T0) + + 80 * cos(3.88 + 5223.69*T0) + + 44 * cos(3.70 + 2352.87*T0) + + 32 * cos(4.00 + 1577.34*T0); + + A := 9 * cos(3.90 + 5507.550*T0) + + 6 * cos(1.73 + 5223.690*T0); + B := B + (A * T0); + B := B / 1.0E+8; + + +{solar radius vector (astronomical units)} + R := 100013989 + + 1670700 * cos(3.0984635 + 6283.07585*T0) + + 13956 * cos(3.05525 + 12566.15170*T0) + + 3084 * cos(5.1985 + 77713.7715*T0) + + 1628 * cos(1.1739 + 5753.3849*T0) + + 1576 * cos(2.8649 + 7860.4194*T0) + + 925 * cos(5.453 + 11506.770*T0) + + 542 * cos(4.564 + 3930.210*T0) + + 472 * cos(3.661 + 5884.927*T0) + + 346 * cos(0.964 + 5507.553*T0) + + 329 * cos(5.900 + 5223.694*T0) + + 307 * cos(0.299 + 5573.143*T0) + + 243 * cos(4.273 + 11790.629*T0) + + 212 * cos(5.847 + 1577.344*T0) + + 186 * cos(5.022 + 10977.079*T0) + + 175 * cos(3.012 + 18849.228*T0) + + 110 * cos(5.055 + 5486.778*T0) + + 98 * cos(0.89 + 6069.78*T0) + + 86 * cos(5.69 + 15720.84*T0) + + 86 * cos(1.27 +161000.69*T0) + + 65 * cos(0.27 + 17260.15*T0) + + 63 * cos(0.92 + 529.69*T0) + + 57 * cos(2.01 + 83996.85*T0) + + 56 * cos(5.24 + 71430.70*T0) + + 49 * cos(3.25 + 2544.31*T0) + + 47 * cos(2.58 + 775.52*T0) + + 45 * cos(5.54 + 9437.76*T0) + + 43 * cos(6.01 + 6275.96*T0) + + 39 * cos(5.36 + 4694.00*T0) + + 38 * cos(2.39 + 8827.39*T0) + + 37 * cos(0.83 + 19651.05*T0) + + 37 * cos(4.90 + 12139.55*T0) + + 36 * cos(1.67 + 12036.46*T0) + + 35 * cos(1.84 + 2942.46*T0) + + 33 * cos(0.24 + 7084.90*T0) + + 32 * cos(0.18 + 5088.63*T0) + + 32 * cos(1.78 + 398.15*T0) + + 28 * cos(1.21 + 6286.60*T0) + + 28 * cos(1.90 + 6279.55*T0) + + 26 * cos(4.59 + 10447.39*T0); + R := R / 1.0E+8; + + A := 103019 * cos(1.107490 + 6283.075850*T0) + + 1721 * cos(1.0644 + 12566.1517*T0) + + 702 * cos(3.142) + + 32 * cos(1.02 + 18849.23*T0) + + 31 * cos(2.84 + 5507.55*T0) + + 25 * cos(1.32 + 5223.69*T0) + + 18 * cos(1.42 + 1577.34*T0) + + 10 * cos(5.91 + 10977.08*T0) + + 9 * cos(1.42 + 6275.96*T0) + + 9 * cos(0.27 + 5486.78*T0); + R := R + (A * T0 / 1.0E+8); + + A := 4359 * cos(5.7846 + 6283.0758*T0) + + 124 * cos(5.579 + 12566.152*T0) + + 12 * cos(3.14) + + 9 * cos(3.63 + 77713.77*T0) + + 6 * cos(1.87 + 5573.14*T0) + + 3 * cos(5.47 + 18849.23*T0); + R := R + (A * sqr(T0) / 1.0E+8); + + L := (L + PI); + L := Frac(L / 2.0 / PI) * 2.0 * Pi; + if L < 0 then + L := L + (2.0*PI); + B := -B; + + Result.L := L; + Result.B := B; + Result.R := R; + Result.X := R * cos(B) * cos(L); + Result.Y := R * (cos(B) * sin(L) * cos(OB) - sin(B) * sin(OB)); + Result.Z := R * (cos(B) * sin(L) * sin(OB) + sin(B) * cos(OB)); +end; + + +{-------------------------------------------------------------------------} + +function JupSatsLo(AJD : Double) : TStJupSats; +var + DateDif, {d} + ArgJup, {V} + AnomE, {M} + AnomJ, {N} + DeltaLong, {J} + ECenterE, {A} + ECenterJ, {B} + K, + RVE, {R} + RVJ, {r} + EJDist, {Delta} + Phase, {Psi} + Lambda, {Lambda} + DS, DE, {DS, DE} + Mu1, Mu2, + Mu3, Mu4, {Mu1 - Mu4} + G, H, {G, H} + TmpDbl1, + TmpDbl2, + R1, R2, + R3, R4 {R1 - R4} + : Double; + +begin + AJD := DateTimeToAJD(AJD); + DateDif := AJD - 2451545.0; + ArgJup := 172.74 + (0.00111588 * DateDif); + ArgJup := Frac(ArgJup/360.0) * 360.0; + if (ArgJup < 0) then + ArgJup := 360.0 + ArgJup; + ArgJup := ArgJup / radcor; + + AnomE := 357.529 + (0.9856003 * DateDif); + AnomE := Frac(AnomE/360.0) * 360.0; + if (AnomE < 0) then + AnomE := 360.0 + AnomE; + AnomE := AnomE / radcor; + + AnomJ := 20.020 + (0.0830853 * DateDif + (0.329 * sin(ArgJup))); + AnomJ := Frac(AnomJ/360.0) * 360.0; + if (AnomJ < 0) then + AnomJ := 360.0 + AnomJ; + AnomJ := AnomJ / radcor; + + DeltaLong := 66.115 + (0.9025179 * DateDif - (0.329 * sin(ArgJup))); + DeltaLong := Frac(DeltaLong/360.0) * 360.0; + if (DeltaLong < 0) then + DeltaLong := 360.0 + DeltaLong; + DeltaLong := DeltaLong / radcor; + + ECenterE := 1.915 * sin(AnomE) + 0.020 * sin(2*AnomE); + ECenterE := ECenterE / radcor; + + ECenterJ := 5.555 * sin(AnomJ) + 0.168 * sin(2*AnomJ); + ECenterJ := ECenterJ / radcor; + + K := (DeltaLong + ECenterE - ECenterJ); + + RVE := 1.00014 - (0.01671 * cos(AnomE)) - (0.00014 * cos(2*AnomE)); + RVJ := 5.20872 - (0.25208 * cos(AnomJ)) - (0.00611 * cos(2*AnomJ)); + + EJDist := sqrt(sqr(RVJ) + sqr(RVE) - (2 * RVJ * RVE * cos(K))); + + Phase := RVE/EJDist * sin(K); + Phase := StInvSin(Phase); + + if ((sin(K) < 0) and (Phase > 0)) or + ((sin(K) > 0) and (Phase < 0)) then + Phase := -Phase; + + Lambda := 34.35 + (0.083091 * DateDif) + (0.329 * sin(ArgJup)); + Lambda := Lambda / radcor + ECenterJ; + + DS := 3.12 * sin(Lambda + 42.8 / radcor); + DE := DS - 2.22 * sin(Phase) * cos(Lambda + 22/radcor) + - 1.30 * ((RVJ - EJDist) / EJDist) * sin(Lambda - 100.5/radcor); + DE := DE / radcor; + + Mu1 := 163.8067 + 203.4058643 * (DateDif - (EJDist / 173)); + Mu1 := Frac(Mu1/360.0) * 360.0; + if (Mu1 < 0) then + Mu1 := 360.0 + Mu1; + Mu1 := Mu1 / radcor + Phase - ECenterJ; + + Mu2 := 358.4108 + 101.2916334 * (DateDif - (EJDist / 173)); + Mu2 := Frac(Mu2/360.0) * 360.0; + if (Mu2 < 0) then + Mu2 := 360.0 + Mu2; + Mu2 := Mu2 / radcor + Phase - ECenterJ; + + Mu3 := 5.7129 + 50.2345179 * (DateDif - (EJDist / 173)); + Mu3 := Frac(Mu3/360.0) * 360.0; + if (Mu3 < 0) then + Mu3 := 360.0 + Mu3; + Mu3 := Mu3 / radcor + Phase - ECenterJ; + + Mu4 := 224.8151 + 21.4879801 * (DateDif - (EJDist / 173)); + Mu4 := Frac(Mu4/360.0) * 360.0; + if (Mu4 < 0) then + Mu4 := 360.0 + Mu4; + Mu4 := Mu4 / radcor + Phase - ECenterJ; + + G := 331.18 + 50.310482 * (DateDif - (EJDist / 173)); + G := Frac(G/360.0) * 360.0; + if (G < 0) then + G := 360.0 + G; + G := G / radcor; + H := 87.40 + 21.569231 * (DateDif - (EJDist / 173)); + H := Frac(H/360.0) * 360.0; + if (H < 0) then + H := 360.0 + H; + H := H / radcor; + + TmpDbl1 := 0.473 * sin(2 * (Mu1 - Mu2)) / radcor; + TmpDbl2 := 1.065 * sin(2 * (Mu2 - Mu3)) / radcor; + + R1 := 5.9073 - 0.0244 * cos(2 * (Mu1 - Mu2)); + R2 := 9.3991 - 0.0882 * cos(2 * (Mu2 - Mu3)); + R3 := 14.9924 - 0.0216 * cos(G); + R4 := 26.3699 - 0.1935 * cos(H); + + Mu1 := Mu1 + TmpDbl1; + Mu2 := Mu2 + TmpDbl2; + Mu3 := Mu3 + (0.165 * sin(G)) / radcor; + Mu4 := Mu4 + (0.841 * sin(H)) / radcor; + + Result.Io.X := R1 * sin(Mu1); + Result.Io.Y := -R1 * cos(Mu1) * sin(DE); + + Result.Europa.X := R2 * sin(Mu2); + Result.Europa.Y := -R2 * cos(Mu2) * sin(DE); + + Result.Ganymede.X := R3 * sin(Mu3); + Result.Ganymede.Y := -R3 * cos(Mu3) * sin(DE); + + Result.Callisto.X := R4 * sin(Mu4); + Result.Callisto.Y := -R4 * cos(Mu4) * sin(DE); +end; + +{-------------------------------------------------------------------------} + +function JupSatsHi(AJD : Double; Shadows : Boolean) : TStJupSats; +var + I : longint; + SunPos : SunCoordsRec; + STUT : TStDateTimeRec; + JupPos : TStEclipticalCord; + + SatX : array[1..5] of Double; + SatY : array[1..5] of Double; + SatZ : array[1..5] of Double; + + TD1, + TD2, + Angle, {Temporary Double values} + LTime, {Tau} + AJDT, {AJD adjusted for light time (Tau)} + JupX, + JupY, + JupZ, {Jupiter's geocentric rectangular coordinates} + EJDist, {Delta} + Jup1, + Jup2, {/\, Alpha} + DateDif, {t} + L1, L2, + L3, L4, {script L1-4} + Pi1, Pi2, + Pi3, Pi4, {Pi1-4} + W1, W2, + W3, W4, {Omega1-4} + Inequality, {upside down L} + PhiLambda, + NodeJup, {Psi} + AnomJup, {G} + AnomSat, {G'} + LongPerJ, + S1, S2, + S3, S4, {Sum1-4} + TL1, TL2, + TL3, TL4, {Capital L1-4} + B1, B2, + B3, B4, {tangent of latitude} + R1, R2, + R3, R4, {radius vector} + T0, {Julian Centuries} + Precession, {P} + Inclination {I} + + : Double; + Transforms : array[1..5] of TranformRec; + +begin + FillChar(Result, SizeOf(TStJupSats), #0); + AJD := DateTimeToAJD(AJD); + SunPos := SunCoords(AJD); + + if not Shadows then begin + TD1 := 5; + AJDT := AJD - 0.0057755183 * TD1; {first guess} + repeat + JupPos := ComputeJupiter(AJDT); + + JupX := JupPos.R0 * cos(JupPos.B0) * cos(JupPos.L0) + + SunPos.R * cos(SunPos.L); + JupY := JupPos.R0 * cos(JupPos.B0) * sin(JupPos.L0) + + SunPos.R * sin(SunPos.L); + JupZ := JupPos.R0 * sin(JupPos.B0); + + EJDist := sqrt(sqr(JupX) + sqr(JupY) + sqr(JupZ)); + TD2 := abs(EJDist - TD1); + if abs(TD2) > 0.0005 then begin + AJDT := AJD - 0.0057755183 * ((EJDist + TD1) / 2); + TD1 := EJDist; + end; + until (TD2 <= 0.0005); + end else begin + JupPos := ComputeJupiter(AJD); + + JupX := JupPos.R0 * cos(JupPos.B0) * cos(JupPos.L0); + JupY := JupPos.R0 * cos(JupPos.B0) * sin(JupPos.L0); + JupZ := JupPos.R0 * sin(JupPos.B0); + EJDist := sqrt(sqr(JupX+SunPos.X) + + sqr(JupY+SunPos.Y) + sqr(JupZ+SunPos.Z)); + end; + + Jup1 := StInvTan2(JupX, JupY); + Jup2 := ArcTan(JupZ / sqrt(sqr(JupX) + sqr(JupY))); + + DateDif := AJD - 2443000.5 - (0.0057755183 * EJDist); + + L1 := 106.07947 + 203.488955432 * DateDif; + L1 := Frac(L1/360.0) * 360.0; + if (L1 < 0) then + L1 := 360.0 + L1; + L1 := L1 / radcor; + + L2 := 175.72938 + 101.374724550 * DateDif; + L2 := Frac(L2/360.0) * 360.0; + if (L2 < 0) then + L2 := 360.0 + L2; + L2 := L2 / radcor; + + L3 := 120.55434 + 50.317609110 * DateDif; + L3 := Frac(L3/360.0) * 360.0; + if (L3 < 0) then + L3 := 360.0 + L3; + L3 := L3 / radcor; + + L4 := 84.44868 + 21.571071314 * DateDif; + L4 := Frac(L4/360.0) * 360.0; + if (L4 < 0) then + L4 := 360.0 + L4; + L4 := L4 / radcor; + + Pi1 := 58.3329 + 0.16103936 * DateDif; + Pi1 := Frac(Pi1/360.0) * 360.0; + if (Pi1 < 0) then + Pi1 := 360.0 + Pi1; + Pi1 := Pi1 / radcor; + + Pi2 := 132.8959 + 0.04647985 * DateDif; + Pi2 := Frac(Pi2/360.0) * 360.0; + if (Pi2 < 0) then + Pi2 := 360.0 + Pi2; + Pi2 := Pi2 / radcor; + + Pi3 := 187.2887 + 0.00712740 * DateDif; + Pi3 := Frac(Pi3/360.0) * 360.0; + if (Pi3 < 0) then + Pi3 := 360.0 + Pi3; + Pi3 := Pi3 / radcor; + + Pi4 := 335.3418 + 0.00183998 * DateDif; + Pi4 := Frac(Pi4/360.0) * 360.0; + if (Pi4 < 0) then + Pi4 := 360.0 + Pi4; + Pi4 := Pi4 / radcor; + + W1 := 311.0793 - 0.13279430 * DateDif; + W1 := Frac(W1/360.0) * 360.0; + if (W1 < 0) then + W1 := 360.0 + W1; + W1 := W1 / radcor; + + W2 := 100.5099 - 0.03263047 * DateDif; + W2 := Frac(W2/360.0) * 360.0; + if (W2 < 0) then + W2 := 360.0 + W2; + W2 := W2 / radcor; + + W3 := 119.1688 - 0.00717704 * DateDif; + W3 := Frac(W3/360.0) * 360.0; + if (W3 < 0) then + W3 := 360.0 + W3; + W3 := W3 / radcor; + + W4 := 322.5729 - 0.00175934 * DateDif; + W4 := Frac(W4/360.0) * 360.0; + if (W4 < 0) then + W4 := 360.0 + W4; + W4 := W4 / radcor; + + Inequality := 0.33033 * sin((163.679 + 0.0010512*DateDif) / radcor) + + 0.03439 * sin((34.486 - 0.0161731*DateDif) / radcor); + Inequality := Inequality / radcor; + + PhiLambda := 191.8132 + 0.17390023 * DateDif; + PhiLambda := Frac(PhiLambda / 360.0) * 360.0; + if (PhiLambda < 0) then + PhiLambda := 360.0 + PhiLambda; + PhiLambda := PhiLambda / radcor; + + NodeJup := 316.5182 - 0.00000208 * DateDif; + NodeJup := Frac(NodeJup / 360.0) * 360.0; + if (NodeJup < 0) then + NodeJup := 360.0 + NodeJup; + NodeJup := NodeJup / radcor; + + AnomJup := 30.23756 + 0.0830925701 * DateDif; + AnomJup := Frac(AnomJup / 360.0) * 360.0; + if (AnomJup < 0) then + AnomJup := 360.0 + AnomJup; + AnomJup := AnomJup / radcor + Inequality; + + AnomSat := 31.97853 + 0.0334597339 * DateDif; + AnomSat := Frac(AnomSat / 360.0) * 360.0; + if (AnomSat < 0) then + AnomSat := 360.0 + AnomSat; + AnomSat := AnomSat / radcor; + + LongPerJ := 13.469942 / radcor; + + S1 := 0.47259 * sin(2*(L1-L2)) + - 0.03480 * sin(Pi3-Pi4) + - 0.01756 * sin(Pi1 + Pi3 - 2*LongPerJ - 2*AnomJup) + + 0.01080 * sin(L2 - 2*L3 + Pi3) + + 0.00757 * sin(PhiLambda) + + 0.00663 * sin(L2 - 2*L3 + Pi4) + + 0.00453 * sin(L1 - Pi3) + + 0.00453 * sin(L2 - 2*L3 + Pi2) + - 0.00354 * sin(L1-L2) + - 0.00317 * sin(2*NodeJup - 2*LongPerJ) + - 0.00269 * sin(L2 - 2*L3 + Pi1) + + 0.00263 * sin(L1 - Pi4) + + 0.00186 * sin(L1 - Pi1) + - 0.00186 * sin(AnomJup) + + 0.00167 * sin(Pi2 - Pi3) + + 0.00158 * sin(4*(L1-L2)) + - 0.00155 * sin(L1 - L3) + - 0.00142 * sin(NodeJup + W3 - 2*LongPerJ - 2*AnomJup) + - 0.00115 * sin(2*(L1 - 2*L2 + W2)) + + 0.00089 * sin(Pi2 - Pi4) + + 0.00084 * sin(W2 - W3) + + 0.00084 * sin(L1 + Pi3 - 2*LongPerJ - 2*AnomJup) + + 0.00053 * sin(NodeJup - W2); + + S2 := 1.06476 * sin(2*(L2-L3)) + + 0.04253 * sin(L1 - 2*L2 + Pi3) + + 0.03579 * sin(L2 - Pi3) + + 0.02383 * sin(L1 - 2*L2 + Pi4) + + 0.01977 * sin(L2 - Pi4) + - 0.01843 * sin(PhiLambda) + + 0.01299 * sin(Pi3 - Pi4) + - 0.01142 * sin(L2 - L3) + + 0.01078 * sin(L2 - Pi2) + - 0.01058 * sin(AnomJup) + + 0.00870 * sin(L2 - 2*L3 + Pi2) + - 0.00775 * sin(2*(NodeJup - LongPerJ)) + + 0.00524 * sin(2*(L1-L2)) + - 0.00460 * sin(L1-L3) + + 0.00450 * sin(L2 - 2*L3 + Pi1) + + 0.00327 * sin(NodeJup - 2*AnomJup + W3 - 2*LongPerJ) + - 0.00296 * sin(Pi1 + Pi3 - 2*LongPerJ - 2*AnomJup) + - 0.00151 * sin(2*AnomJup) + + 0.00146 * sin(NodeJup - W3) + + 0.00125 * sin(NodeJup - W4) + - 0.00117 * sin(L1 -2*L3 + Pi3) + - 0.00095 * sin(2*(L2-W2)) + + 0.00086 * sin(2*(L1-2*L2 +W2)) + - 0.00086 * sin(5*AnomSat - 2*AnomJup + 52.225/radcor) + - 0.00078 * sin(L2-L4) + - 0.00064 * sin(L1 - 2*L3 + Pi4) + - 0.00063 * sin(3*L3 - 7*L4 + 4*Pi4) + + 0.00061 * sin(Pi1 - Pi4) + + 0.00058 * sin(2*(NodeJup - LongPerJ - AnomJup)) + + 0.00058 * sin(W3 - W4) + + 0.00056 * sin(2*(L2-L4)) + + 0.00055 * sin(2*(L1-L3)) + + 0.00052 * sin(3*L3 - 7*L4 + Pi3 + 3*Pi4) + - 0.00043 * sin(L1 - Pi3) + + 0.00042 * sin(Pi3 - Pi2) + + 0.00041 * sin(5*(L2-L3)) + + 0.00041 * sin(Pi4 - LongPerJ) + + 0.00038 * sin(L2 - Pi1) + + 0.00032 * sin(W2 - W3) + + 0.00032 * sin(2*(L3 - AnomJup - LongPerJ)) + + 0.00029 * sin(Pi1 - Pi3); + + S3 := 0.16477 * sin(L3 - Pi3) + + 0.09062 * sin(L3 - Pi4) + - 0.06907 * sin(L2 - L3) + + 0.03786 * sin(Pi3 - Pi4) + + 0.01844 * sin(2*(L3-L4)) + - 0.01340 * sin(AnomJup) + + 0.00703 * sin(L2 - 2*L3 + Pi3) + - 0.00670 * sin(2*(NodeJup - LongPerJ)) + - 0.00540 * sin(L3-L4) + + 0.00481 * sin(Pi1 + Pi3 -2*LongPerJ - 2*AnomJup) + - 0.00409 * sin(L2 - 2*L3 + Pi2) + + 0.00379 * sin(L2 - 2*L3 + Pi4) + + 0.00235 * sin(NodeJup - W3) + + 0.00198 * sin(NodeJup - W4) + + 0.00180 * sin(PhiLambda) + + 0.00129 * sin(3*(L3-L4)) + + 0.00124 * sin(L1-L3) + - 0.00119 * sin(5*AnomSat - 2*AnomJup + 52.225/radcor) + + 0.00109 * sin(L1-L2) + - 0.00099 * sin(3*L3 - 7*L4 + 4*Pi4) + + 0.00091 * sin(W3 - W4) + + 0.00081 * sin(3*L3 - 7*L4 + Pi3 + 3*Pi4) + - 0.00076 * sin(2*L2 - 3*L3 + Pi3) + + 0.00069 * sin(Pi4 - LongPerJ) + - 0.00058 * sin(2*L3 - 3*L4 + Pi4) + + 0.00057 * sin(L3 + Pi3 - 2*LongPerJ - 2*AnomJup) + - 0.00057 * sin(L3 - 2*L4 + Pi4) + - 0.00052 * sin(Pi2 - Pi3) + - 0.00052 * sin(L2 - 2*L3 + Pi1) + + 0.00048 * sin(L3 - 2*L4 + Pi3) + - 0.00045 * sin(2*L2 - 3*L3 + Pi4) + - 0.00041 * sin(Pi2 - Pi4) + - 0.00038 * sin(2*AnomJup) + - 0.00033 * sin(Pi3 - Pi4 + W3 - W4) + - 0.00032 * sin(3*L3 - 7*L4 + 2*Pi3 + 2*Pi4) + + 0.00030 * sin(4*(L3-L4)) + - 0.00029 * sin(W3 + NodeJup - 2*LongPerJ - 2*AnomJup) + + 0.00029 * sin(L3 + Pi4 - 2*LongPerJ - 2*AnomJup) + + 0.00026 * sin(L3 - LongPerJ - AnomJup) + + 0.00024 * sin(L2 - 3*L3 + 2*L4) + + 0.00021 * sin(2*(L3 - LongPerJ - AnomJup)) + - 0.00021 * sin(L3 - Pi2) + + 0.00017 * sin(2*(L3 - Pi3)); + + S4 := 0.84109 * sin(L4 - Pi4) + + 0.03429 * sin(Pi4 - Pi3) + - 0.03305 * sin(2*(NodeJup - LongPerJ)) + - 0.03211 * sin(AnomJup) + - 0.01860 * sin(L4 - Pi3) + + 0.01182 * sin(NodeJup - W4) + + 0.00622 * sin(L4 + Pi4 - 2*AnomJup - 2*LongPerJ) + + 0.00385 * sin(2*(L4 - Pi4)) + - 0.00284 * sin(5*AnomSat - 2*AnomJup + 52.225/radcor) + - 0.00233 * sin(2*(NodeJup - Pi4)) + - 0.00223 * sin(L3 - L4) + - 0.00208 * sin(L4 - LongPerJ) + + 0.00177 * sin(NodeJup + W4 - 2*Pi4) + + 0.00134 * sin(Pi4 - LongPerJ) + + 0.00125 * sin(2*(L4 - AnomJup - LongPerJ)) + - 0.00117 * sin(2*AnomJup) + - 0.00112 * sin(2*(L3 - L4)) + + 0.00106 * sin(3*L3 - 7*L4 + 4*Pi4) + + 0.00102 * sin(L4 - AnomJup - LongPerJ) + + 0.00096 * sin(2*L4 - NodeJup - W4) + + 0.00087 * sin(2*(NodeJup - W4)) + - 0.00087 * sin(3*L3 - 7*L4 + Pi3 + 3*Pi4) + + 0.00085 * sin(L3 - 2*L4 + Pi4) + - 0.00081 * sin(2*(L4 - NodeJup)) + + 0.00071 * sin(L4 + Pi4 -2*LongPerJ - 3*AnomJup) + + 0.00060 * sin(L1 - L4) + - 0.00056 * sin(NodeJup - W3) + - 0.00055 * sin(L3 - 2*L4 + Pi3) + + 0.00051 * sin(L2 - L4) + + 0.00042 * sin(2*(NodeJup - AnomJup - LongPerJ)) + + 0.00039 * sin(2*(Pi4 - W4)) + + 0.00036 * sin(NodeJup + LongPerJ - Pi4 - W4) + + 0.00035 * sin(2*AnomSat - AnomJup + 188.37/radcor) + - 0.00035 * sin(L4 - Pi4 + 2*LongPerJ - 2*NodeJup) + - 0.00032 * sin(L4 + Pi4 - 2*LongPerJ - AnomJup) + + 0.00030 * sin(3*L3 - 7*L4 + 2*Pi3 + 2*Pi4) + + 0.00030 * sin(2*AnomSat - 2*AnomJup + 149.15/radcor) + + 0.00028 * sin(L4 - Pi4 + 2*NodeJup - 2*LongPerJ) + - 0.00028 * sin(2*(L4 - W4)) + - 0.00027 * sin(Pi3 - Pi4 + W3 - W4) + - 0.00026 * sin(5*AnomSat - 3*AnomJup + 188.37/radcor) + + 0.00025 * sin(W4 - W3) + - 0.00025 * sin(L2 - 3*L3 + 2*L4) + - 0.00023 * sin(3*(L3 - L4)) + + 0.00021 * sin(2*L4 - 2*LongPerJ - 3*AnomJup) + - 0.00021 * sin(2*L3 - 3*L4 + Pi4) + + 0.00019 * sin(L4 - Pi4 - AnomJup) + - 0.00019 * sin(2*L4 - Pi3 - Pi4) + - 0.00018 * sin(L4 - Pi4 + AnomJup) + - 0.00016 * sin(L4 + Pi3 -2*LongPerJ - 2*AnomJup); + + S1 := S1/radcor; + S2 := S2/radcor; + S3 := S3/radcor; + S4 := S4/radcor; + + TL1 := L1 + S1; + TL2 := L2 + S2; + TL3 := L3 + S3; + TL4 := L4 + S4; + + B1 := 0.0006502 * sin(TL1 - W1) + + 0.0001835 * sin(TL1 - W2) + + 0.0000329 * sin(TL1 - W3) + - 0.0000311 * sin(TL1 - NodeJup) + + 0.0000093 * sin(TL1 - W4) + + 0.0000075 * sin(3*TL1 - 4*L2 - 1.9927/radcor * S1 + W2) + + 0.0000046 * sin(TL1 + NodeJup - 2*LongPerJ - 2*AnomJup); + B1 := ArcTan(B1); + + B2 := 0.0081275 * sin(TL2 - W2) + + 0.0004512 * sin(TL2 - W3) + - 0.0003286 * sin(TL2 - NodeJup) + + 0.0001164 * sin(TL2 - W4) + + 0.0000273 * sin(L1 - 2*L3 + 1.0146/radcor * S2 + W2) + + 0.0000143 * sin(TL2 + NodeJup - 2*LongPerJ - 2*AnomJup) + - 0.0000143 * sin(TL2 - W1) + + 0.0000035 * sin(TL2 - NodeJup + AnomJup) + - 0.0000028 * sin(L1 - 2*L3 + 1.0146/radcor * S2 + W3); + B2 := ArcTan(B2); + + B3 := 0.0032364 * sin(TL3 - W3) + - 0.0016911 * sin(TL3 - NodeJup) + + 0.0006849 * sin(TL3 - W4) + - 0.0002806 * sin(TL3 - W2) + + 0.0000321 * sin(TL3 + NodeJup - 2*LongPerJ - 2*AnomJup) + + 0.0000051 * sin(TL3 - NodeJup + AnomJup) + - 0.0000045 * sin(TL3 - NodeJup - AnomJup) + - 0.0000045 * sin(TL3 + NodeJup - 2*LongPerJ) + + 0.0000037 * sin(TL3 + NodeJup - 2*LongPerJ - 3*AnomJup) + + 0.0000030 * sin(2*L2 - 3*TL3 + 4.03/radcor * S3 + W2) + - 0.0000021 * sin(2*L2 - 3*TL3 + 4.03/radcor * S3 + W3); + B3 := ArcTan(B3); + + B4 := -0.0076579 * sin(TL4 - NodeJup) + + 0.0044148 * sin(TL4 - W4) + - 0.0005106 * sin(TL4 - W3) + + 0.0000773 * sin(TL4 + NodeJup - 2*LongPerJ - 2*AnomJup) + + 0.0000104 * sin(TL4 - NodeJup + AnomJup) + - 0.0000102 * sin(TL4 - NodeJup - AnomJup) + + 0.0000088 * sin(TL4 + NodeJup - 2*LongPerJ - 3*AnomJup) + - 0.0000038 * sin(TL4 + NodeJup - 2*LongPerJ - AnomJup); + B4 := ArcTan(B4); + + R1 := -0.0041339 * cos(2*(L1-L2)) + - 0.0000395 * cos(L1 - Pi3) + - 0.0000214 * cos(L1 - Pi4) + + 0.0000170 * cos(L1 - L2) + - 0.0000162 * cos(L1 - Pi1) + - 0.0000130 * cos(4*(L1-L2)) + + 0.0000106 * cos(L1 - L3) + - 0.0000063 * cos(L1 + Pi3 - 2*LongPerJ - 2*AnomJup); + + R2 := 0.0093847 * cos(L1-L2) + - 0.0003114 * cos(L2 - Pi3) + - 0.0001738 * cos(L2 - Pi4) + - 0.0000941 * cos(L2 - Pi2) + + 0.0000553 * cos(L2 - L3) + + 0.0000523 * cos(L1 - L3) + - 0.0000290 * cos(2*(L1-L2)) + + 0.0000166 * cos(2*(L2-W2)) + + 0.0000107 * cos(L1 - 2*L3 + Pi3) + - 0.0000102 * cos(L2 - Pi1) + - 0.0000091 * cos(2*(L1-L3)); + + R3 := -0.0014377 * cos(L3 - Pi3) + - 0.0007904 * cos(L3 - Pi4) + + 0.0006342 * cos(L2 - L3) + - 0.0001758 * cos(2*(L3-L4)) + + 0.0000294 * cos(L3 - L4) + - 0.0000156 * cos(3*(L3-L4)) + + 0.0000155 * cos(L1 - L3) + - 0.0000153 * cos(L1 - L2) + + 0.0000070 * cos(2*L2 - 3*L3 + Pi3) + - 0.0000051 * cos(L3 + Pi3 - 2*LongPerJ - 2*AnomJup); + + R4 := -0.0073391 * cos(L4 - Pi4) + + 0.0001620 * cos(L4 - Pi3) + + 0.0000974 * cos(L3 - L4) + - 0.0000541 * cos(L4 + Pi4 - 2*LongPerJ - 2*AnomJup) + - 0.0000269 * cos(2*(L4-Pi4)) + + 0.0000182 * cos(L4- LongPerJ) + + 0.0000177 * cos(2*(L3-L4)) + - 0.0000167 * cos(2*L4 - NodeJup - W4) + + 0.0000167 * cos(NodeJup - W4) + - 0.0000155 * cos(2*(L4-LongPerj-AnomJup)) + + 0.0000142 * cos(2*(L4-NodeJup)) + + 0.0000104 * cos(L1 - L4) + + 0.0000092 * cos(L2 - L4) + - 0.0000089 * cos(L4 - LongPerJ - AnomJup) + - 0.0000062 * cos(L4 + Pi4 - 2*LongPerJ - 3*AnomJup) + + 0.0000048 * cos(2*(L4-W4)); + + R1 := 5.90730 * (1 + R1); + R2 := 9.39912 * (1 + R2); + R3 := 14.99240 * (1 + R3); + R4 := 26.36990 * (1 + R4); + + T0 := (AJD - 2433282.423) / 36525; + Precession := (1.3966626*T0 + 0.0003088*sqr(T0)) / radcor; + + TL1 := TL1 + Precession; + TL2 := TL2 + Precession; + TL3 := TL3 + Precession; + TL4 := TL4 + Precession; + NodeJup := NodeJup + Precession; + + T0 := (AJD - AstJulianDatePrim(1900, 1, 1, 0)) / 36525; + Inclination := (3.120262 + 0.0006*T0) / radcor; + + SatX[1] := R1 * cos(TL1 - NodeJup) * cos(B1); + SatY[1] := R1 * sin(TL1 - NodeJup) * cos(B1); + SatZ[1] := R1 * sin(B1); + + SatX[2] := R2 * cos(TL2 - NodeJup) * cos(B2); + SatY[2] := R2 * sin(TL2 - NodeJup) * cos(B2); + SatZ[2] := R2 * sin(B2); + + SatX[3] := R3 * cos(TL3 - NodeJup) * cos(B3); + SatY[3] := R3 * sin(TL3 - NodeJup) * cos(B3); + SatZ[3] := R3 * sin(B3); + + SatX[4] := R4 * cos(TL4 - NodeJup) * cos(B4); + SatY[4] := R4 * sin(TL4 - NodeJup) * cos(B4); + SatZ[4] := R4 * sin(B4); + + SatX[5] := 0; + SatY[5] := 0; + SatZ[5] := 1; + + T0 := (AJD - 2451545.0) / 36525.0; + TD1 := 100.464441 + + 1.0209550 * T0 + + 0.00040117 * sqr(T0) + + 0.000000569 * sqr(T0) * T0; + TD1 := TD1 / radcor; + + TD2 := 1.303270 + - 0.0054966 * T0 + + 0.00000465 * sqr(T0) + - 0.000000004 * sqr(T0) * T0; + TD2 := TD2 / radcor; + + for I := 1 to 5 do begin + Transforms[I].A[1] := SatX[I]; + Transforms[I].B[1] := SatY[I] * cos(Inclination) + - SatZ[I] * sin(Inclination); + Transforms[I].C[1] := SatY[I] * sin(Inclination) + + SatZ[I] * cos(Inclination); + + Transforms[I].A[2] := Transforms[I].A[1] * cos(NodeJup - TD1) + - Transforms[I].B[1] * sin(NodeJup - TD1); + Transforms[I].B[2] := Transforms[I].A[1] * sin(NodeJup - TD1) + + Transforms[I].B[1] * cos(NodeJup - TD1); + Transforms[I].C[2] := Transforms[I].C[1]; + + Transforms[I].A[3] := Transforms[I].A[2]; + Transforms[I].B[3] := Transforms[I].B[2] * cos(TD2) + - Transforms[I].C[2] * sin(TD2); + Transforms[I].C[3] := Transforms[I].B[2] * sin(TD2) + + Transforms[I].C[2] * cos(TD2); + + Transforms[I].A[4] := Transforms[I].A[3] * cos(TD1) + - Transforms[I].B[3] * sin(TD1); + Transforms[I].B[4] := Transforms[I].A[3] * sin(TD1) + + Transforms[I].B[3] * cos(TD1); + Transforms[I].C[4] := Transforms[I].C[3]; + + Transforms[I].A[5] := Transforms[I].A[4] * sin(Jup1) + - Transforms[I].B[4] * cos(Jup1); + Transforms[I].B[5] := Transforms[I].A[4] * cos(Jup1) + + Transforms[I].B[4] * sin(Jup1); + Transforms[I].C[5] := Transforms[I].C[4]; + + Transforms[I].A[6] := Transforms[I].A[5]; + Transforms[I].B[6] := Transforms[I].C[5] * sin(Jup2) + + Transforms[I].B[5] * cos(Jup2); + Transforms[I].C[6] := Transforms[I].C[5] * cos(Jup2) + - Transforms[I].B[5] * sin(Jup2); + end; + + Angle := StInvTan2(Transforms[5].C[6], Transforms[5].A[6]); + +{Io calculations} + Result.Io.X := Transforms[1].A[6] * cos(Angle) + - Transforms[1].C[6] * sin(Angle); + Result.Io.Y := Transforms[1].A[6] * sin(Angle) + + Transforms[1].C[6] * cos(Angle); + TD1 := Transforms[1].B[6]; + + {correct for light time} + TD2 := abs(TD1) / 17295 * sqrt(1 - sqr(Result.Io.X/R1)); + Result.Io.X := Result.Io.X + TD2; + + {correct for perspective} + TD2 := EJDist / (EJDist + TD1/2095); + Result.Io.X := Result.Io.X * TD2; + Result.Io.Y := Result.Io.Y * TD2; + +{Europa calculations} + Result.Europa.X := Transforms[2].A[6] * cos(Angle) + - Transforms[2].C[6] * sin(Angle); + Result.Europa.Y := Transforms[2].A[6] * sin(Angle) + + Transforms[2].C[6] * cos(Angle); + TD1 := Transforms[2].B[6]; + + {correct for light time} + TD2 := abs(TD1) / 21819 * sqrt(1 - sqr(Result.Europa.X/R2)); + Result.Europa.X := Result.Europa.X + TD2; + + {correct for perspective} + TD2 := EJDist / (EJDist + TD1/2095); + Result.Europa.X := Result.Europa.X * TD2; + Result.Europa.Y := Result.Europa.Y * TD2; + +{Ganymede calculations} + Result.Ganymede.X := Transforms[3].A[6] * cos(Angle) + - Transforms[3].C[6] * sin(Angle); + Result.Ganymede.Y := Transforms[3].A[6] * sin(Angle) + + Transforms[3].C[6] * cos(Angle); + TD1 := Transforms[3].B[6]; + + {correct for light time} + TD2 := abs(TD1) / 27558 * sqrt(1 - sqr(Result.Ganymede.X/R3)); + Result.Ganymede.X := Result.Ganymede.X + TD2; + + {correct for perspective} + TD2 := EJDist / (EJDist + TD1/2095); + Result.Ganymede.X := Result.Ganymede.X * TD2; + Result.Ganymede.Y := Result.Ganymede.Y * TD2; + +{Callisto calculations} + Result.Callisto.X := Transforms[4].A[6] * cos(Angle) + - Transforms[4].C[6] * sin(Angle); + Result.Callisto.Y := Transforms[4].A[6] * sin(Angle) + + Transforms[4].C[6] * cos(Angle); + TD1 := Transforms[4].B[6]; + + {correct for light time} + TD2 := abs(TD1) / 36548 * sqrt(1 - sqr(Result.Callisto.X/R4)); + Result.Callisto.X := Result.Callisto.X + TD2; + + {correct for perspective} + TD2 := EJDist / (EJDist + TD1/2095); + Result.Callisto.X := Result.Callisto.X * TD2; + Result.Callisto.Y := Result.Callisto.Y * TD2; +end; + +{-------------------------------------------------------------------------} + +function GetJupSats(JD : TDateTime; HighPrecision, Shadows : Boolean) : TStJupSats; +begin + if not HighPrecision then + Result := JupSatsLo(JD) + else + Result := JupSatsHi(JD, Shadows); +end; + +end. diff --git a/components/systools/source/run/stlist.pas b/components/systools/source/run/stlist.pas new file mode 100644 index 000000000..2251cc61b --- /dev/null +++ b/components/systools/source/run/stlist.pas @@ -0,0 +1,1050 @@ +// Upgraded to Delphi 2009: Sebastian Zierer + +(* ***** BEGIN LICENSE BLOCK ***** + * Version: MPL 1.1 + * + * The contents of this file are subject to the Mozilla Public License Version + * 1.1 (the "License"); you may not use this file except in compliance with + * the License. You may obtain a copy of the License at + * http://www.mozilla.org/MPL/ + * + * Software distributed under the License is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License + * for the specific language governing rights and limitations under the + * License. + * + * The Original Code is TurboPower SysTools + * + * The Initial Developer of the Original Code is + * TurboPower Software + * + * Portions created by the Initial Developer are Copyright (C) 1996-2002 + * the Initial Developer. All Rights Reserved. + * + * Contributor(s): + * + * ***** END LICENSE BLOCK ***** *) + +{*********************************************************} +{* SysTools: StList.pas 4.04 *} +{*********************************************************} +{* SysTools: Linked list class *} +{*********************************************************} + +{$IFDEF FPC} + {$mode DELPHI} +{$ENDIF} + +//{$I StDefine.inc} + +{Notes: + Nodes stored in the list can be of type TStListNode or of a derived type. + Pass the node class to the list constructor. + + TStList is a doubly-linked list that can be scanned backward just as + efficiently as forward. + + The list retains the index and node of the last node found by Nth (or by + the indexed array property). This makes For loops that scan a list much + faster and speeds up random calls to Nth by about a factor of two. +} + +unit StList; + +interface + +uses + {$IFNDEF FPC} + Windows, + {$ENDIF} + SysUtils, Classes, + StConst, StBase; + +type + TStListNode = class(TStNode) + {.Z+} + protected + FNext : TStListNode; {Next node} + FPrev : TStListNode; {Previous node} + + {.Z-} + public + constructor Create(AData : Pointer); override; + {-Initialize node} + end; + + TStList = class(TStContainer) + {.Z+} + protected + {property instance variables} + FHead : TStListNode; {Start of list} + FTail : TStListNode; {End of list} + + {private instance variables} + lsLastI : LongInt; {Last index requested from Nth} + lsLastP : TStListNode; {Last node returned by Nth} + + {protected undocumented methods} + procedure ForEachPointer(Action : TIteratePointerFunc; + OtherData : pointer); + override; + function StoresPointers : boolean; + override; + {.Z-} + public + constructor Create(NodeClass : TStNodeClass); virtual; + {-Initialize an empty list} + + procedure LoadFromStream(S : TStream); override; + {-Create a list and its data from a stream} + procedure StoreToStream(S : TStream); override; + {-Write a list and its data to a stream} + + procedure Clear; override; + {-Remove all nodes from container but leave it instantiated} + + function Append(Data : Pointer) : TStListNode; + {-Add a new node to the end of a list} + function Insert(Data : Pointer) : TStListNode; + {-Insert a new node at the start of a list} + function Place(Data : Pointer; P : TStListNode) : TStListNode; + {-Place a new node into a list after an existing node P} + function PlaceBefore(Data : Pointer; P : TStListNode) : TStListNode; + {-Place a new node into a list before an existing node P} + function InsertSorted(Data : Pointer) : TStListNode; + {-Insert a new node in sorted order} + procedure MoveToHead(P : TStListNode); + {-Move P to the head of the list} + + procedure Assign(Source: TPersistent); override; + {-Assign another container's contents to this one} + procedure Join(P : TStListNode; L : TStList); + {-Join list L after P in the current list. L is freed} + function Split(P : TStListNode) : TStList; + {-Split list, creating a new list that starts with P} + + procedure Sort; + {-Put the list into sorted order} + + procedure Delete(P : TStListNode); + {-Remove an element and dispose of its contents} + + function Next(P : TStListNode) : TStListNode; + {-Return the node after P, nil if none} + function Prev(P : TStListNode) : TStListNode; + {-Return the node before P, nil if none} + function Nth(Index : LongInt) : TStListNode; + {-Return the Index'th node in the list, Index >= 0 (cached)} + function NthFrom(P : TStListNode; Index : LongInt) : TStListNode; + {-Return the Index'th node from P, either direction} + function Posn(P : TStListNode) : LongInt; + {-Return the ordinal position of an element in the list} + function Distance(P1, P2 : TStListNode) : LongInt; + {-Return the number of nodes separating P1 and P2 (signed)} + function Find(Data : Pointer) : TStListNode; + {-Return the first node whose data equals Data} + function Iterate(Action : TIterateFunc; Up : Boolean; + OtherData : Pointer) : TStListNode; + {-Call Action for all the nodes, returning the last node visited} + + property Head : TStListNode + {-Return the head node} + read FHead; + property Tail : TStListNode + {-Return the tail node} + read FTail; + property Items[Index : LongInt] : TStListNode + {-Return the Index'th node, 0-based} + read Nth; + default; + end; + + {.Z+} + TStListClass = class of TStList; + {.Z-} + +{======================================================================} + +implementation + +{$IFDEF ThreadSafe} +var + ClassCritSect : TRTLCriticalSection; +{$ENDIF} + +procedure EnterClassCS; +begin +{$IFDEF ThreadSafe} + EnterCriticalSection(ClassCritSect); +{$ENDIF} +end; + +procedure LeaveClassCS; +begin +{$IFDEF ThreadSafe} + LeaveCriticalSection(ClassCritSect); +{$ENDIF} +end; + +constructor TStListNode.Create(AData : Pointer); +begin + inherited Create(AData); +end; + +{----------------------------------------------------------------------} + +function FindNode(Container : TStContainer; + Node : TStNode; + OtherData : Pointer) : Boolean; far; +begin + Result := (Node.Data <> OtherData); +end; + +function AssignData(Container : TStContainer; + Data, OtherData : Pointer) : Boolean; far; + var + OurList : TStList absolute OtherData; + begin + OurList.Append(Data); + Result := true; + end; + +{----------------------------------------------------------------------} + +function TStList.Append(Data : Pointer) : TStListNode; +var + N : TStListNode; +begin +{$IFDEF ThreadSafe} + EnterCS; + try +{$ENDIF} + N := TStListNode(conNodeClass.Create(Data)); + N.FPrev := FTail; + if not Assigned(FHead) then begin + {Special case for first node} + FHead := N; + FTail := N; + end else begin + {Add at end of existing list} + FTail.FNext := N; + FTail := N; + end; + Inc(FCount); + Result := N; +{$IFDEF ThreadSafe} + finally + LeaveCS; + end; +{$ENDIF} +end; + +procedure TStList.Assign(Source: TPersistent); + begin + {$IFDEF ThreadSafe} + EnterCS; + try + {$ENDIF} + {The only containers that we allow to be assigned to a linked list are + - another SysTools linked list (TStList) + - a SysTools binary search tree (TStTree) + - a SysTools collection (TStCollection, TStSortedCollection)} + if not AssignPointers(Source, AssignData) then + inherited Assign(Source); + {$IFDEF ThreadSafe} + finally + LeaveCS; + end;{try..finally} + {$ENDIF} + end; + +procedure TStList.Clear; +begin +{$IFDEF ThreadSafe} + EnterCS; + try +{$ENDIF} + if Count > 0 then begin + Iterate(DestroyNode, True, nil); + FCount := 0; + end; + FHead := nil; + FTail := nil; + lsLastI := -1; + lsLastP := nil; +{$IFDEF ThreadSafe} + finally + LeaveCS; + end; +{$ENDIF} +end; + +constructor TStList.Create(NodeClass : TStNodeClass); +begin + CreateContainer(NodeClass, 0); + Clear; +end; + +procedure TStList.Delete(P : TStListNode); +begin +{$IFDEF ThreadSafe} + EnterCS; + try +{$ENDIF} + if (not Assigned(P)) or (Count <= 0) then + Exit; + if not (P is conNodeClass) then + RaiseContainerError(stscBadType); + + with P do begin + {Fix pointers of surrounding nodes} + if Assigned(FNext) then + FNext.FPrev := FPrev; + if Assigned(FPrev) then + FPrev.FNext := FNext; + end; + + {Fix head and tail of list} + if FTail = P then + FTail := FTail.FPrev; + if FHead = P then + FHead := FHead.FNext; + + {Dispose of the node} + DisposeNodeData(P); + P.Free; + Dec(FCount); + lsLastI := -1; +{$IFDEF ThreadSafe} + finally + LeaveCS; + end; +{$ENDIF} +end; + +function TStList.Distance(P1, P2 : TStListNode) : LongInt; +var + I : LongInt; + N : TStListNode; +begin +{$IFDEF ThreadSafe} + EnterCS; + try +{$ENDIF} + {Count forward} + I := 0; + N := P1; + while Assigned(N) and (N <> P2) do begin + Inc(I); + N := N.FNext; + end; + if N = P2 then begin + Result := I; + Exit; + end; + + {Count backward} + I := 0; + N := P1; + while Assigned(N) and (N <> P2) do begin + Dec(I); + N := N.FPrev; + end; + if N = P2 then begin + Result := I; + Exit; + end; + + {Not on same list} + Result := MaxLongInt; +{$IFDEF ThreadSafe} + finally + LeaveCS; + end; +{$ENDIF} +end; + +function TStList.Find(Data : Pointer) : TStListNode; +begin +{$IFDEF ThreadSafe} + EnterCS; + try +{$ENDIF} + Result := Iterate(FindNode, True, Data); +{$IFDEF ThreadSafe} + finally + LeaveCS; + end; +{$ENDIF} +end; + +procedure TStList.ForEachPointer(Action : TIteratePointerFunc; + OtherData : pointer); +var + N : TStListNode; + P : TStListNode; +begin +{$IFDEF ThreadSafe} + EnterCS; + try +{$ENDIF} + N := FHead; + while Assigned(N) do begin + P := N.FNext; + if Action(Self, N.Data, OtherData) then + N := P + else + Exit; + end; +{$IFDEF ThreadSafe} + finally + LeaveCS; + end; +{$ENDIF} +end; + +function TStList.Insert(Data : Pointer) : TStListNode; +var + N : TStListNode; +begin +{$IFDEF ThreadSafe} + EnterCS; + try +{$ENDIF} + N := TStListNode(conNodeClass.Create(Data)); + {N.FPrev := nil;} + N.FNext := FHead; + if not Assigned(FHead) then + {Special case for first node} + FTail := N + else + {Add at start of existing list} + FHead.FPrev := N; + FHead := N; + Inc(FCount); + lsLastI := -1; + Result := N; +{$IFDEF ThreadSafe} + finally + LeaveCS; + end; +{$ENDIF} +end; + +function TStList.InsertSorted(Data : Pointer) : TStListNode; +var + N : TStListNode; + P : TStListNode; +begin +{$IFDEF ThreadSafe} + EnterCS; + try +{$ENDIF} + N := TStListNode(conNodeClass.Create(Data)); + Result := N; + Inc(FCount); + lsLastI := -1; + + if not Assigned(FHead) then begin + {First element added to list} + FHead := N; + FTail := N; + end else begin + P := FHead; + while Assigned(P) do begin + if DoCompare(N.Data, P.Data) < 0 then begin + if not Assigned(P.FPrev) then begin + {New head} + FHead := N; + end else begin + P.FPrev.FNext := N; + N.FPrev := P.FPrev; + end; + P.FPrev := N; + N.FNext := P; + Exit; + end; + P := P.FNext; + end; + {New tail} + FTail.FNext := N; + N.FPrev := FTail; + FTail := N; + end; +{$IFDEF ThreadSafe} + finally + LeaveCS; + end; +{$ENDIF} +end; + +function TStList.Iterate(Action : TIterateFunc; Up : Boolean; + OtherData : Pointer) : TStListNode; +var + N : TStListNode; + P : TStListNode; +begin +{$IFDEF ThreadSafe} + EnterCS; + try +{$ENDIF} + if Up then begin + N := FHead; + while Assigned(N) do begin + P := N.FNext; + if Action(Self, N, OtherData) then + N := P + else begin + Result := N; + Exit; + end; + end; + end else begin + N := FTail; + while Assigned(N) do begin + P := N.FPrev; + if Action(Self, N, OtherData) then + N := P + else begin + Result := N; + Exit; + end; + end; + end; + Result := nil; +{$IFDEF ThreadSafe} + finally + LeaveCS; + end; +{$ENDIF} +end; + +procedure TStList.Join(P : TStListNode; L : TStList); +var + N : TStListNode; + Q : TStListNode; +begin +{$IFDEF ThreadSafe} + EnterClassCS; + EnterCS; + L.EnterCS; + try +{$ENDIF} + if Assigned(L) then begin + if Assigned(P) and (L.Count > 0) then begin + {Patch the list into the current one} + N := L.Head; + Q := P.FNext; + + P.FNext := N; + N.FPrev := P; + + if Assigned(Q) then begin + N := L.Tail; + N.FNext := Q; + Q.FPrev := N; + end; + + Inc(FCount, L.Count); + lsLastI := -1; + end; + + {Free L (but not its nodes)} + L.IncNodeProtection; + L.Free; + end; +{$IFDEF ThreadSafe} + finally + L.LeaveCS; + LeaveCS; + LeaveClassCS; + end; +{$ENDIF} +end; + +procedure TStList.LoadFromStream(S : TStream); +var + Data : pointer; + Reader : TReader; + StreamedClass : TPersistentClass; + StreamedNodeClass : TPersistentClass; + StreamedClassName : string; + StreamedNodeClassName : string; +begin +{$IFDEF ThreadSafe} + EnterCS; + try +{$ENDIF} + Clear; + Reader := TReader.Create(S, 1024); + try + with Reader do + begin + StreamedClassName := ReadString; + StreamedClass := GetClass(StreamedClassName); + if (StreamedClass = nil) then + RaiseContainerErrorFmt(stscUnknownClass, [StreamedClassName]); + if (not IsOrInheritsFrom(StreamedClass, Self.ClassType)) or + (not IsOrInheritsFrom(TStList, StreamedClass)) then + RaiseContainerError(stscWrongClass); + StreamedNodeClassName := ReadString; + StreamedNodeClass := GetClass(StreamedNodeClassName); + if (StreamedNodeClass = nil) then + RaiseContainerErrorFmt(stscUnknownNodeClass, [StreamedNodeClassName]); + if (not IsOrInheritsFrom(StreamedNodeClass, conNodeClass)) or + (not IsOrInheritsFrom(TStListNode, StreamedNodeClass)) then + RaiseContainerError(stscWrongNodeClass); + ReadListBegin; + while not EndOfList do + begin + Data := DoLoadData(Reader); + Append(Data); + end; + ReadListEnd; + end; + finally + Reader.Free; + end; +{$IFDEF ThreadSafe} + finally + LeaveCS; + end; +{$ENDIF} +end; + +procedure TStList.MoveToHead(P : TStListNode); +begin +{$IFDEF ThreadSafe} + EnterCS; + try +{$ENDIF} + if Assigned(P) then + if P <> Head then begin + with P do begin + {Fix pointers of surrounding nodes} + if FTail = P then + FTail := FTail.FPrev + else + FNext.FPrev := FPrev; + FPrev.FNext := FNext; + + FNext := FHead; + FPrev := nil; + end; + FHead.FPrev := P; + FHead := P; + end; +{$IFDEF ThreadSafe} + finally + LeaveCS; + end; +{$ENDIF} +end; + +function TStList.Next(P : TStListNode) : TStListNode; +begin +{$IFDEF ThreadSafe} + EnterCS; + try +{$ENDIF} + Result := P.FNext; +{$IFDEF ThreadSafe} + finally + LeaveCS; + end; +{$ENDIF} +end; + +function TStList.Nth(Index : LongInt) : TStListNode; +var + MinI : LongInt; + MinP : TStListNode; +begin +{$IFDEF ThreadSafe} + EnterCS; + try +{$ENDIF} + if (Index < 0) or (Index >= FCount) then + Result := nil + else begin + MinI := Index; + MinP := FHead; + if lsLastI >= 0 then + {scan the fewest possible nodes} + if Index <= lsLastI then begin + if lsLastI-Index < Index then begin + MinI := Index-lsLastI; + MinP := lsLastP; + end; + end else if Index-lsLastI < FCount-1-Index then begin + MinI := Index-lsLastI; + MinP := lsLastP; + end else begin + MinI := Index-(FCount-1); + MinP := FTail; + end; + + Result := NthFrom(MinP, MinI); + lsLastI := Index; + lsLastP := Result; + end; +{$IFDEF ThreadSafe} + finally + LeaveCS; + end; +{$ENDIF} +end; + +function TStList.NthFrom(P : TStListNode; Index : LongInt) : TStListNode; +var + I : LongInt; +begin +{$IFDEF ThreadSafe} + EnterCS; + try +{$ENDIF} + if Assigned(P) then begin + if not (P is conNodeClass) then + RaiseContainerError(stscBadType); + if Index > 0 then begin + for I := 1 to Index do begin + P := P.FNext; + if not Assigned(P) then + break; + end; + end else begin + for I := 1 to -Index do begin + P := P.FPrev; + if not Assigned(P) then + break; + end; + end; + end; + Result := P; +{$IFDEF ThreadSafe} + finally + LeaveCS; + end; +{$ENDIF} +end; + +function TStList.Place(Data : Pointer; P : TStListNode) : TStListNode; +var + N : TStListNode; +begin +{$IFDEF ThreadSafe} + EnterCS; + try +{$ENDIF} + if not Assigned(P) then + Result := Insert(Data) + else if P = FTail then + Result := Append(Data) + else begin + N := TStListNode(conNodeClass.Create(Data)); + N.FPrev := P; + N.FNext := P.FNext; + P.FNext.FPrev := N; + P.FNext := N; + Inc(FCount); + lsLastI := -1; + Result := N; + end; +{$IFDEF ThreadSafe} + finally + LeaveCS; + end; +{$ENDIF} +end; + +function TStList.PlaceBefore(Data : Pointer; P : TStListNode) : TStListNode; +var + N : TStListNode; +begin +{$IFDEF ThreadSafe} + EnterCS; + try +{$ENDIF} + if (not Assigned(P)) or (P = Head) then + {Place the new element at the start of the list} + Result := Insert(Data) + else begin + {Patch in the new element} + N := TStListNode(conNodeClass.Create(Data)); + N.FNext := P; + N.FPrev := P.FPrev; + P.FPrev.FNext := N; + P.FPrev := N; + lsLastI := -1; + Inc(FCount); + Result := N; + end; +{$IFDEF ThreadSafe} + finally + LeaveCS; + end; +{$ENDIF} +end; + +function TStList.Posn(P : TStListNode) : LongInt; +var + I : LongInt; + N : TStListNode; +begin +{$IFDEF ThreadSafe} + EnterCS; + try +{$ENDIF} + if not Assigned(P) then + Result := -1 + else begin + if not (P is conNodeClass) then + RaiseContainerError(stscBadType); + I := 0; + N := FHead; + while Assigned(N) do begin + if P = N then begin + Result := I; + exit; + end; + Inc(I); + N := N.FNext; + end; + Result := -1; + end; +{$IFDEF ThreadSafe} + finally + LeaveCS; + end; +{$ENDIF} +end; + +function TStList.Prev(P : TStListNode) : TStListNode; +begin +{$IFDEF ThreadSafe} + EnterCS; + try +{$ENDIF} + Result := P.FPrev; +{$IFDEF ThreadSafe} + finally + LeaveCS; + end; +{$ENDIF} +end; + +procedure TStList.Sort; +const + StackSize = 32; +type + Stack = array[0..StackSize-1] of TStListNode; +var + L : TStListNode; + R : TStListNode; + PL : TStListNode; + PR : TStListNode; + PivotData : Pointer; + TmpData : Pointer; + Dist : LongInt; + DistL : LongInt; + DistR : LongInt; + StackP : Integer; + LStack : Stack; + RStack : Stack; + DStack : array[0..StackSize-1] of LongInt; +begin +{$IFDEF ThreadSafe} + EnterCS; + try +{$ENDIF} + {Need at least 2 elements to sort} + if Count <= 1 then + Exit; + lsLastI := -1; + + {Initialize the stacks} + StackP := 0; + LStack[0] := FHead; + RStack[0] := FTail; + DStack[0] := Count-1; + + {Repeatedly take top partition from stack} + repeat + + {Pop the stack} + L := LStack[StackP]; + R := RStack[StackP]; + Dist := DStack[StackP]; + Dec(StackP); + + if L <> R then + {Sort current partition} + repeat + + {Load the pivot element} + PivotData := NthFrom(L, Dist div 2).Data; + PL := L; + PR := R; + DistL := Dist; + DistR := Dist; + + {Swap items in sort order around the pivot index} + repeat + while DoCompare(PL.Data, PivotData) < 0 do begin + PL := PL.FNext; + Dec(Dist); + Dec(DistR); + end; + while DoCompare(PivotData, PR.Data) < 0 do begin + PR := PR.FPrev; + Dec(Dist); + Dec(DistL); + end; + if Dist >= 0 then begin + if PL <> PR then begin + {Swap the two elements} + TmpData := PL.Data; + PL.Data := PR.Data; + PR.Data := TmpData; + end; + if Assigned(PL.FNext) then begin + PL := PL.FNext; + Dec(Dist); + Dec(DistR); + end; + if Assigned(PR.FPrev) then begin + PR := PR.FPrev; + Dec(Dist); + Dec(DistL); + end; + end; + until Dist < 0; + + {Decide which partition to sort next} + if DistL < DistR then begin + {Right partition is bigger} + if DistR > 0 then begin + {Stack the request for sorting right partition} + Inc(StackP); + LStack[StackP] := PL; + RStack[StackP] := R; + DStack[StackP] := DistR; + end; + {Continue sorting left partition} + R := PR; + Dist := DistL; + end else begin + {Left partition is bigger} + if DistL > 0 then begin + {Stack the request for sorting left partition} + Inc(StackP); + LStack[StackP] := L; + RStack[StackP] := PR; + DStack[StackP] := DistL; + end; + {Continue sorting right partition} + L := PL; + Dist := DistR; + end; + + until Dist <= 0; + until StackP < 0; +{$IFDEF ThreadSafe} + finally + LeaveCS; + end; +{$ENDIF} +end; + +function TStList.Split(P : TStListNode) : TStList; +var + I : LongInt; +begin +{$IFDEF ThreadSafe} + EnterCS; + try +{$ENDIF} + I := Posn(P); + if I < 0 then begin + Result := nil; + Exit; + end; + + {Create and initialize the new list} + Result := TStListClass(ClassType).Create(conNodeClass); + Result.Compare := Compare; + Result.OnCompare := OnCompare; + Result.DisposeData := DisposeData; + Result.OnDisposeData := OnDisposeData; + Result.LoadData := LoadData; + Result.OnLoadData := OnLoadData; + Result.StoreData := StoreData; + Result.OnStoreData := OnStoreData; + Result.FHead := P; + Result.FTail := FTail; + Result.FCount := Count-I; + Result.lsLastI := -1; + + {Truncate the old list} + if Assigned(P.FPrev) then begin + P.FPrev.FNext := nil; + FTail := P.FPrev; + P.FPrev := nil; + end; + if P = FHead then + FHead := nil; + FCount := I; + lsLastI := -1; +{$IFDEF ThreadSafe} + finally + LeaveCS; + end; +{$ENDIF} +end; + +function TStList.StoresPointers : Boolean; +begin + Result := true; +end; + +procedure TStList.StoreToStream(S : TStream); +var + Writer : TWriter; + Walker : TStListNode; +begin +{$IFDEF ThreadSafe} + EnterCS; + try +{$ENDIF} + Writer := TWriter.Create(S, 1024); + try + with Writer do + begin + WriteString(Self.ClassName); + WriteString(conNodeClass.ClassName); + WriteListBegin; + Walker := Head; + while Walker <> nil do + begin + DoStoreData(Writer, Walker.Data); + Walker := Next(Walker); + end; + WriteListEnd; + end; + finally + Writer.Free; + end; +{$IFDEF ThreadSafe} + finally + LeaveCS; + end; +{$ENDIF} +end; + +{$IFDEF ThreadSafe} +initialization + Windows.InitializeCriticalSection(ClassCritSect); +finalization + Windows.DeleteCriticalSection(ClassCritSect); +{$ENDIF} +end. diff --git a/components/systools/source/run/stmars.pas b/components/systools/source/run/stmars.pas new file mode 100644 index 000000000..2501c6355 --- /dev/null +++ b/components/systools/source/run/stmars.pas @@ -0,0 +1,424 @@ +// Upgraded to Delphi 2009: Sebastian Zierer + +(* ***** BEGIN LICENSE BLOCK ***** + * Version: MPL 1.1 + * + * The contents of this file are subject to the Mozilla Public License Version + * 1.1 (the "License"); you may not use this file except in compliance with + * the License. You may obtain a copy of the License at + * http://www.mozilla.org/MPL/ + * + * Software distributed under the License is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License + * for the specific language governing rights and limitations under the + * License. + * + * The Original Code is TurboPower SysTools + * + * The Initial Developer of the Original Code is + * TurboPower Software + * + * Portions created by the Initial Developer are Copyright (C) 1996-2002 + * the Initial Developer. All Rights Reserved. + * + * Contributor(s): + * + * ***** END LICENSE BLOCK ***** *) + +{*********************************************************} +{* SysTools: StMars.pas 4.04 *} +{*********************************************************} +{* SysTools: Astronomical Routines (for Mars) *} +{*********************************************************} + +{$IFDEF FPC} + {$mode DELPHI} +{$ENDIF} + +//{$I StDefine.inc} + +unit StMars; + +interface + +uses + StAstroP; + +function ComputeMars(JD : Double) : TStEclipticalCord; + + +implementation + +function GetLongitude(Tau, Tau2, Tau3, Tau4, Tau5 : Double) : Double; +var + L0, L1, + L2, L3, + L4, L5 : Double; +begin + L0 := 6.20347711580 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.18656368100 * cos(5.05037100300 + 3340.61242670000 * Tau) + + 0.01108216792 * cos(5.40099836960 + 6681.22485340000 * Tau) + + 0.00091798394 * cos(5.75478745110 + 10021.83728000000 * Tau) + + 0.00027744987 * cos(5.97049512940 + 3.52311834900 * Tau) + + 0.00012315897 * cos(0.84956081238 + 2810.92146160000 * Tau) + + 0.00010610230 * cos(2.93958524970 + 2281.23049650000 * Tau) + + 0.00008926772 * cos(4.15697845940 + 0.01725365220 * Tau) + + 0.00008715688 * cos(6.11005159790 + 13362.44970700000 * Tau) + + 0.00007774867 * cos(3.33968655070 + 5621.84292320000 * Tau) + + 0.00006797552 * cos(0.36462243626 + 398.14900341000 * Tau) + + 0.00004161101 * cos(0.22814975330 + 2942.46342330000 * Tau) + + 0.00003575079 * cos(1.66186540140 + 2544.31441990000 * Tau) + + 0.00003075250 * cos(0.85696597082 + 191.44826611000 * Tau) + + 0.00002937543 * cos(6.07893711410 + 0.06731030280 * Tau) + + 0.00002628122 * cos(0.64806143570 + 3337.08930840000 * Tau) + + 0.00002579842 * cos(0.02996706197 + 3344.13554500000 * Tau) + + 0.00002389420 * cos(5.03896401350 + 796.29800682000 * Tau) + + 0.00001798808 * cos(0.65634026844 + 529.69096509000 * Tau) + + 0.00001546408 * cos(2.91579633390 + 1751.53953140000 * Tau) + + 0.00001528140 * cos(1.14979306230 + 6151.53388830000 * Tau) + + 0.00001286232 * cos(3.06795924630 + 2146.16541650000 * Tau) + + 0.00001264356 * cos(3.62275092230 + 5092.15195810000 * Tau) + + 0.00001024907 * cos(3.69334293550 + 8962.45534990000 * Tau) + + 0.00000891567 * cos(0.18293899090 + 16703.06213300000 * Tau) + + 0.00000858760 * cos(2.40093704200 + 2914.01423580000 * Tau) + + 0.00000832724 * cos(4.49495753460 + 3340.62968040000 * Tau) + + 0.00000832718 * cos(2.46418591280 + 3340.59517300000 * Tau) + + 0.00000748724 * cos(3.82248399470 + 155.42039943000 * Tau) + + 0.00000723863 * cos(0.67497565801 + 3738.76143010000 * Tau) + + 0.00000712899 * cos(3.66336014790 + 1059.38193020000 * Tau) + + 0.00000655163 * cos(0.48864075176 + 3127.31333130000 * Tau) + + 0.00000635557 * cos(2.92182704270 + 8432.76438480000 * Tau) + + 0.00000552746 * cos(4.47478863020 + 1748.01641310000 * Tau) + + 0.00000550472 * cos(3.81001205410 + 0.98032106820 * Tau) + + 0.00000472164 * cos(3.62547819410 + 1194.44701020000 * Tau) + + 0.00000425972 * cos(0.55365138172 + 6283.07585000000 * Tau) + + 0.00000415132 * cos(0.49662314774 + 213.29909544000 * Tau) + + 0.00000312141 * cos(0.99853322843 + 6677.70173500000 * Tau) + + 0.00000306552 * cos(0.38052862973 + 6684.74797180000 * Tau) + + 0.00000302377 * cos(4.48618150320 + 3532.06069280000 * Tau) + + 0.00000299396 * cos(2.78323705700 + 6254.62666250000 * Tau) + + 0.00000293199 * cos(4.22131277910 + 20.77539549200 * Tau) + + 0.00000283600 * cos(5.76885494120 + 3149.16416060000 * Tau) + + 0.00000281073 * cos(5.88163372940 + 1349.86740970000 * Tau) + + 0.00000274035 * cos(0.13372501211 + 3340.67973700000 * Tau) + + 0.00000274028 * cos(0.54222141841 + 3340.54511640000 * Tau) + + 0.00000238857 * cos(5.37155471670 + 4136.91043350000 * Tau) + + 0.00000236114 * cos(5.75504515580 + 3333.49887970000 * Tau) + + 0.00000231185 * cos(1.28240685290 + 3870.30339180000 * Tau) + + 0.00000221225 * cos(3.50466672200 + 382.89653222000 * Tau) + + 0.00000204161 * cos(2.82133266180 + 1221.84856630000 * Tau) + + 0.00000193126 * cos(3.35715137750 + 3.59042865180 * Tau) + + 0.00000188639 * cos(1.49103016490 + 9492.14631500000 * Tau) + + 0.00000179196 * cos(1.00561112570 + 951.71840625000 * Tau) + + 0.00000174068 * cos(2.41360332580 + 553.56940284000 * Tau) + + 0.00000172110 * cos(0.43943041719 + 5486.77784320000 * Tau) + + 0.00000160011 * cos(3.94854735190 + 4562.46099300000 * Tau) + + 0.00000144305 * cos(1.41874193420 + 135.06508004000 * Tau) + + 0.00000139897 * cos(3.32592516160 + 2700.71514040000 * Tau) + + 0.00000138245 * cos(4.30145176910 + 7.11354700080 * Tau) + + 0.00000130993 * cos(4.04491720260 + 12303.06777700000 * Tau) + + 0.00000128102 * cos(2.20806651010 + 1592.59601360000 * Tau) + + 0.00000128062 * cos(1.80665643330 + 5088.62883980000 * Tau) + + 0.00000116945 * cos(3.12805282210 + 7903.07341970000 * Tau) + + 0.00000113486 * cos(3.70070798120 + 1589.07289530000 * Tau) + + 0.00000110375 * cos(1.05195079690 + 242.72860397000 * Tau) + + 0.00000104541 * cos(0.78535382076 + 8827.39026990000 * Tau) + + 0.00000100090 * cos(3.24343740860 + 11773.37681200000 * Tau); + + L1 := 3340.85627470000 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.01458227051 * cos(3.60426053610 + 3340.61242670000 * Tau) + + 0.00164901343 * cos(3.92631250960 + 6681.22485340000 * Tau) + + 0.00019963338 * cos(4.26594061030 + 10021.83728000000 * Tau) + + 0.00003452399 * cos(4.73210386370 + 3.52311834900 * Tau) + + 0.00002485480 * cos(4.61277567320 + 13362.44970700000 * Tau) + + 0.00000841551 * cos(4.45858256760 + 2281.23049650000 * Tau) + + 0.00000537566 * cos(5.01589727490 + 398.14900341000 * Tau) + + 0.00000521041 * cos(4.99422678180 + 3344.13554500000 * Tau) + + 0.00000432614 * cos(2.56066402860 + 191.44826611000 * Tau) + + 0.00000429656 * cos(5.31646162370 + 155.42039943000 * Tau) + + 0.00000381747 * cos(3.53881289440 + 796.29800682000 * Tau) + + 0.00000314129 * cos(4.96335266050 + 16703.06213300000 * Tau) + + 0.00000282804 * cos(3.15967518200 + 2544.31441990000 * Tau) + + 0.00000205664 * cos(4.56891455660 + 2146.16541650000 * Tau) + + 0.00000168805 * cos(1.32894813370 + 3337.08930840000 * Tau) + + 0.00000157587 * cos(4.18501035950 + 1751.53953140000 * Tau) + + 0.00000133686 * cos(2.23325104200 + 0.98032106820 * Tau) + + 0.00000133563 * cos(5.97421903930 + 1748.01641310000 * Tau) + + 0.00000117591 * cos(6.02407213860 + 6151.53388830000 * Tau) + + 0.00000116561 * cos(2.21347652540 + 1059.38193020000 * Tau) + + 0.00000113876 * cos(2.12869455090 + 1194.44701020000 * Tau) + + 0.00000113595 * cos(5.42803224320 + 3738.76143010000 * Tau) + + 0.00000091098 * cos(1.09627836590 + 1349.86740970000 * Tau) + + 0.00000085342 * cos(3.90854841010 + 553.56940284000 * Tau) + + 0.00000083301 * cos(5.29636626270 + 6684.74797180000 * Tau) + + 0.00000080776 * cos(4.42813405870 + 529.69096509000 * Tau) + + 0.00000079531 * cos(2.24864266330 + 8962.45534990000 * Tau) + + 0.00000072946 * cos(2.50189460550 + 951.71840625000 * Tau) + + 0.00000072505 * cos(5.84208163240 + 242.72860397000 * Tau) + + 0.00000071487 * cos(3.85636094440 + 2914.01423580000 * Tau) + + 0.00000067582 * cos(5.02327686470 + 382.89653222000 * Tau) + + 0.00000065089 * cos(1.01802439310 + 3340.59517300000 * Tau) + + 0.00000065089 * cos(3.04879603980 + 3340.62968040000 * Tau) + + 0.00000061508 * cos(4.15183159800 + 3149.16416060000 * Tau) + + 0.00000056520 * cos(3.88813699320 + 4136.91043350000 * Tau) + + 0.00000048477 * cos(4.87362121540 + 213.29909544000 * Tau) + + 0.00000047613 * cos(1.18238046060 + 3333.49887970000 * Tau) + + 0.00000046584 * cos(1.31452419910 + 3185.19202730000 * Tau) + + 0.00000041343 * cos(0.71385375517 + 1592.59601360000 * Tau) + + 0.00000040272 * cos(2.72542480610 + 7.11354700080 * Tau) + + 0.00000040055 * cos(5.31611875490 + 20043.67456000000 * Tau) + + 0.00000032886 * cos(5.41067411970 + 6283.07585000000 * Tau) + + 0.00000028244 * cos(0.04534124888 + 9492.14631500000 * Tau) + + 0.00000026579 * cos(3.88960724780 + 1221.84856630000 * Tau) + + 0.00000026554 * cos(5.11271747610 + 2700.71514040000 * Tau); + + L2 := 0.00058015791 * cos(2.04979463280 + 3340.61242670000 * Tau) + + 0.00054187645 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00013908426 * cos(2.45742359890 + 6681.22485340000 * Tau) + + 0.00002465104 * cos(2.80000020930 + 10021.83728000000 * Tau) + + 0.00000398379 * cos(3.14118428290 + 13362.44970700000 * Tau) + + 0.00000222022 * cos(3.19436080020 + 3.52311834900 * Tau) + + 0.00000120957 * cos(0.54325292454 + 155.42039943000 * Tau) + + 0.00000061517 * cos(3.48529427370 + 16703.06213300000 * Tau) + + 0.00000053638 * cos(3.54191121460 + 3344.13554500000 * Tau) + + 0.00000034268 * cos(6.00188499120 + 2281.23049650000 * Tau) + + 0.00000031665 * cos(4.14015171790 + 191.44826611000 * Tau) + + 0.00000029839 * cos(1.99870679840 + 796.29800682000 * Tau) + + 0.00000023168 * cos(4.33403365930 + 242.72860397000 * Tau) + + 0.00000021659 * cos(3.44532466380 + 398.14900341000 * Tau) + + 0.00000020370 * cos(5.42191375400 + 553.56940284000 * Tau) + + 0.00000016227 * cos(0.65678953303 + 0.98032106820 * Tau) + + 0.00000016044 * cos(6.11000472440 + 2146.16541650000 * Tau) + + 0.00000015648 * cos(1.22086121940 + 1748.01641310000 * Tau) + + 0.00000014927 * cos(6.09541783560 + 3185.19202730000 * Tau) + + 0.00000014416 * cos(4.01923812100 + 951.71840625000 * Tau) + + 0.00000014317 * cos(2.61851897590 + 1349.86740970000 * Tau) + + 0.00000013352 * cos(0.60189008414 + 1194.44701020000 * Tau) + + 0.00000011934 * cos(3.86122163020 + 6684.74797180000 * Tau) + + 0.00000011260 * cos(4.71822363670 + 2544.31441990000 * Tau) + + 0.00000010396 * cos(0.25038714677 + 382.89653222000 * Tau) + + 0.00000009468 * cos(0.68170713564 + 1059.38193020000 * Tau) + + 0.00000009229 * cos(3.83209092320 + 20043.67456000000 * Tau) + + 0.00000009005 * cos(3.88271826100 + 3738.76143010000 * Tau) + + 0.00000007501 * cos(5.46498630410 + 1751.53953140000 * Tau) + + 0.00000006859 * cos(2.57522504140 + 3149.16416060000 * Tau) + + 0.00000006681 * cos(2.37843690340 + 4136.91043350000 * Tau) + + 0.00000006497 * cos(5.47773072870 + 1592.59601360000 * Tau) + + 0.00000006311 * cos(2.34104793670 + 3097.88382270000 * Tau); + + L3 := 0.00001482423 * cos(0.44434694876 + 3340.61242670000 * Tau) + + 0.00000662095 * cos(0.88469178686 + 6681.22485340000 * Tau) + + 0.00000188268 * cos(1.28799982500 + 10021.83728000000 * Tau) + + 0.00000041474 * cos(1.64850787000 + 13362.44970700000 * Tau) + + 0.00000025994 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00000022661 * cos(2.05267665260 + 155.42039943000 * Tau) + + 0.00000010454 * cos(1.58006906380 + 3.52311834900 * Tau) + + 0.00000008024 * cos(1.99858757690 + 16703.06213300000 * Tau) + + 0.00000004900 * cos(2.82452457970 + 242.72860397000 * Tau) + + 0.00000003782 * cos(2.01914272510 + 3344.13554500000 * Tau) + + 0.00000003176 * cos(4.59144897930 + 3185.19202730000 * Tau) + + 0.00000003134 * cos(0.65044714325 + 553.56940284000 * Tau); + + L4 := 0.00000113969 * cos(3.14159265360 + 0.00000000000 * Tau) + + 0.00000028725 * cos(5.63662412040 + 6681.22485340000 * Tau) + + 0.00000024447 * cos(5.13868481450 + 3340.61242670000 * Tau) + + 0.00000011187 * cos(6.03161074430 + 10021.83728000000 * Tau) + + 0.00000003252 * cos(0.13228350651 + 13362.44970700000 * Tau) + + 0.00000003190 * cos(3.56267988300 + 155.42039943000 * Tau) + + 0.00000000787 * cos(0.49340783377 + 16703.06213300000 * Tau) + + 0.00000000776 * cos(1.31734531590 + 242.72860397000 * Tau); + + L5 := 0.00000000868 * cos(3.14159265360 + 0.00000000000 * Tau) + + 0.00000000710 * cos(4.04089996520 + 6681.22485340000 * Tau); + Result := (L0 + L1*Tau + L2*Tau2 + L3*Tau3 + L4*Tau4 + L5*Tau5); +end; + +{-------------------------------------------------------------------------} + +function GetLatitude(Tau, Tau2, Tau3, Tau4, Tau5 : Double) : Double; +var + B0, B1, + B2, B3, + B4, B5 : Double; +begin + B0 := 0.03197134986 * cos(3.76832042430 + 3340.61242670000 * Tau) + + 0.00298033234 * cos(4.10616996240 + 6681.22485340000 * Tau) + + 0.00289104742 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00031365538 * cos(4.44651052850 + 10021.83728000000 * Tau) + + 0.00003484100 * cos(4.78812547890 + 13362.44970700000 * Tau) + + 0.00000443401 * cos(5.02642620490 + 3344.13554500000 * Tau) + + 0.00000442999 * cos(5.65233015880 + 3337.08930840000 * Tau) + + 0.00000399109 * cos(5.13056814700 + 16703.06213300000 * Tau) + + 0.00000292506 * cos(3.79290644590 + 2281.23049650000 * Tau) + + 0.00000181982 * cos(6.13648011700 + 6151.53388830000 * Tau) + + 0.00000163159 * cos(4.26399626630 + 529.69096509000 * Tau) + + 0.00000159678 * cos(2.23194610250 + 1059.38193020000 * Tau) + + 0.00000149297 * cos(2.16501209920 + 5621.84292320000 * Tau) + + 0.00000142686 * cos(1.18215016110 + 3340.59517300000 * Tau) + + 0.00000142685 * cos(3.21292180820 + 3340.62968040000 * Tau) + + 0.00000139323 * cos(2.41796344240 + 8962.45534990000 * Tau); + + B1 := 0.00350068845 * cos(5.36847836210 + 3340.61242670000 * Tau) + + 0.00014116030 * cos(3.14159265360 + 0.00000000000 * Tau) + + 0.00009670755 * cos(5.47877786510 + 6681.22485340000 * Tau) + + 0.00001471918 * cos(3.20205766790 + 10021.83728000000 * Tau) + + 0.00000425864 * cos(3.40843812880 + 13362.44970700000 * Tau) + + 0.00000102039 * cos(0.77617286189 + 3337.08930840000 * Tau) + + 0.00000078848 * cos(3.71768293870 + 16703.06213300000 * Tau) + + 0.00000032708 * cos(3.45803723680 + 5621.84292320000 * Tau) + + 0.00000026171 * cos(2.48293558070 + 2281.23049650000 * Tau); + + B2 := 0.00016726690 * cos(0.60221392419 + 3340.61242670000 * Tau) + + 0.00004986799 * cos(3.14159265360 + 0.00000000000 * Tau) + + 0.00000302141 * cos(5.55871276020 + 6681.22485340000 * Tau) + + 0.00000025767 * cos(1.89662673500 + 13362.44970700000 * Tau) + + 0.00000021452 * cos(0.91749968618 + 10021.83728000000 * Tau) + + 0.00000011820 * cos(2.24240738700 + 3337.08930840000 * Tau) + + 0.00000007985 * cos(2.24892866610 + 16703.06213300000 * Tau); + + B3 := 0.00000606506 * cos(1.98050633530 + 3340.61242670000 * Tau) + + 0.00000042611 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00000013652 * cos(1.79588228800 + 6681.22485340000 * Tau) + + 0.00000002730 * cos(3.45377082120 + 10021.83728000000 * Tau); + + B4 := 0.00000013369 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00000011334 * cos(3.45724352590 + 3340.61242670000 * Tau) + + 0.00000000744 * cos(0.50445805257 + 6681.22485340000 * Tau); + + B5 := 0.00000000000; + Result := (B0 + B1*Tau + B2*Tau2 + B3*Tau3 + B4*Tau4 + B5*Tau5); +end; + +{-------------------------------------------------------------------------} + +function GetRadiusVector(Tau, Tau2, Tau3, Tau4, Tau5 : Double) : Double; +var + R0, R1, + R2, R3, + R4, R5 : Double; +begin + R0 := 1.53033488280 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.14184953153 * cos(3.47971283520 + 3340.61242670000 * Tau) + + 0.00660776357 * cos(3.81783442100 + 6681.22485340000 * Tau) + + 0.00046179117 * cos(4.15595316280 + 10021.83728000000 * Tau) + + 0.00008109738 * cos(5.55958460170 + 2810.92146160000 * Tau) + + 0.00007485315 * cos(1.77238998070 + 5621.84292320000 * Tau) + + 0.00005523193 * cos(1.36436318880 + 2281.23049650000 * Tau) + + 0.00003825160 * cos(4.49407182410 + 13362.44970700000 * Tau) + + 0.00002484385 * cos(4.92545577890 + 2942.46342330000 * Tau) + + 0.00002306539 * cos(0.09081742493 + 2544.31441990000 * Tau) + + 0.00001999399 * cos(5.36059605230 + 3337.08930840000 * Tau) + + 0.00001960198 * cos(4.74249386320 + 3344.13554500000 * Tau) + + 0.00001167115 * cos(2.11261501150 + 5092.15195810000 * Tau) + + 0.00001102828 * cos(5.00908264160 + 398.14900341000 * Tau) + + 0.00000992252 * cos(5.83862401070 + 6151.53388830000 * Tau) + + 0.00000899077 * cos(4.40790433990 + 529.69096509000 * Tau) + + 0.00000807348 * cos(2.10216647100 + 1059.38193020000 * Tau) + + 0.00000797910 * cos(3.44839026170 + 796.29800682000 * Tau) + + 0.00000740980 * cos(1.49906336890 + 2146.16541650000 * Tau) + + 0.00000725583 * cos(1.24516913470 + 8432.76438480000 * Tau) + + 0.00000692340 * cos(2.13378814790 + 8962.45534990000 * Tau) + + 0.00000633144 * cos(0.89353285018 + 3340.59517300000 * Tau) + + 0.00000633140 * cos(2.92430448170 + 3340.62968040000 * Tau) + + 0.00000629976 * cos(1.28738135860 + 1751.53953140000 * Tau) + + 0.00000574352 * cos(0.82896196337 + 2914.01423580000 * Tau) + + 0.00000526187 * cos(5.38292276230 + 3738.76143010000 * Tau) + + 0.00000472776 * cos(5.19850457870 + 3127.31333130000 * Tau) + + 0.00000348095 * cos(4.83219198910 + 16703.06213300000 * Tau) + + 0.00000283702 * cos(2.90692294910 + 3532.06069280000 * Tau) + + 0.00000279552 * cos(5.25749247550 + 6283.07585000000 * Tau) + + 0.00000275501 * cos(1.21767967780 + 6254.62666250000 * Tau) + + 0.00000275224 * cos(2.90818883830 + 1748.01641310000 * Tau) + + 0.00000269891 * cos(3.76394728620 + 5884.92684660000 * Tau) + + 0.00000239133 * cos(2.03669896240 + 1194.44701020000 * Tau) + + 0.00000233827 * cos(5.10546492530 + 5486.77784320000 * Tau) + + 0.00000228128 * cos(3.25529020620 + 6872.67311950000 * Tau) + + 0.00000223190 * cos(4.19861593780 + 3149.16416060000 * Tau) + + 0.00000219428 * cos(5.58340248780 + 191.44826611000 * Tau) + + 0.00000208336 * cos(4.84626442120 + 3340.67973700000 * Tau) + + 0.00000208333 * cos(5.25476080770 + 3340.54511640000 * Tau) + + 0.00000186213 * cos(5.69871555750 + 6677.70173500000 * Tau) + + 0.00000182686 * cos(5.08062683360 + 6684.74797180000 * Tau) + + 0.00000178613 * cos(4.18423025540 + 3333.49887970000 * Tau) + + 0.00000175995 * cos(5.95341786370 + 3870.30339180000 * Tau) + + 0.00000163534 * cos(3.79889068110 + 4136.91043350000 * Tau); + + R1 := 0.01107433340 * cos(2.03250524950 + 3340.61242670000 * Tau) + + 0.00103175886 * cos(2.37071845680 + 6681.22485340000 * Tau) + + 0.00012877200 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00010815880 * cos(2.70888093800 + 10021.83728000000 * Tau) + + 0.00001194550 * cos(3.04702182500 + 13362.44970700000 * Tau) + + 0.00000438579 * cos(2.88835072630 + 2281.23049650000 * Tau) + + 0.00000395698 * cos(3.42324611290 + 3344.13554500000 * Tau) + + 0.00000182572 * cos(1.58428644000 + 2544.31441990000 * Tau) + + 0.00000135850 * cos(3.38507017990 + 16703.06213300000 * Tau) + + 0.00000128362 * cos(6.04343360440 + 3337.08930840000 * Tau) + + 0.00000128204 * cos(0.62991220570 + 1059.38193020000 * Tau) + + 0.00000127068 * cos(1.95389775740 + 796.29800682000 * Tau) + + 0.00000118443 * cos(2.99761345070 + 2146.16541650000 * Tau) + + 0.00000087537 * cos(3.42052758980 + 398.14900341000 * Tau) + + 0.00000083026 * cos(3.85574986650 + 3738.76143010000 * Tau) + + 0.00000075598 * cos(4.45101839350 + 6151.53388830000 * Tau) + + 0.00000071999 * cos(2.76442180680 + 529.69096509000 * Tau) + + 0.00000066542 * cos(2.54892602690 + 1751.53953140000 * Tau) + + 0.00000066430 * cos(4.40597549960 + 1748.01641310000 * Tau) + + 0.00000057518 * cos(0.54354327916 + 1194.44701020000 * Tau) + + 0.00000054314 * cos(0.67750943459 + 8962.45534990000 * Tau) + + 0.00000051035 * cos(3.72585409210 + 6684.74797180000 * Tau) + + 0.00000049428 * cos(5.72959428360 + 3340.59517300000 * Tau) + + 0.00000049424 * cos(1.47717922230 + 3340.62968040000 * Tau) + + 0.00000048318 * cos(2.58061691300 + 3149.16416060000 * Tau) + + 0.00000047863 * cos(2.28527896840 + 2914.01423580000 * Tau) + + 0.00000038953 * cos(2.31900090550 + 4136.91043350000 * Tau); + + R2 := 0.00044242247 * cos(0.47930603943 + 3340.61242670000 * Tau) + + 0.00008138042 * cos(0.86998398093 + 6681.22485340000 * Tau) + + 0.00001274915 * cos(1.22594050810 + 10021.83728000000 * Tau) + + 0.00000187387 * cos(1.57298991980 + 13362.44970700000 * Tau) + + 0.00000052396 * cos(3.14159265360 + 0.00000000000 * Tau) + + 0.00000040744 * cos(1.97080175060 + 3344.13554500000 * Tau) + + 0.00000026616 * cos(1.91665615760 + 16703.06213300000 * Tau) + + 0.00000017825 * cos(4.43499505330 + 2281.23049650000 * Tau) + + 0.00000011713 * cos(4.52510453730 + 3185.19202730000 * Tau) + + 0.00000010209 * cos(5.39143469550 + 1059.38193020000 * Tau) + + 0.00000009950 * cos(0.41870577185 + 796.29800682000 * Tau); + + R3 := 0.00001113107 * cos(5.14987350140 + 3340.61242670000 * Tau) + + 0.00000424446 * cos(5.61343766480 + 6681.22485340000 * Tau) + + 0.00000100044 * cos(5.99726827030 + 10021.83728000000 * Tau) + + 0.00000019606 * cos(0.07633062094 + 13362.44970700000 * Tau) + + 0.00000004693 * cos(3.14159265360 + 0.00000000000 * Tau) + + 0.00000003477 * cos(0.42951907576 + 16703.06213300000 * Tau); + + R4 := 0.00000019552 * cos(3.58211650470 + 3340.61242670000 * Tau) + + 0.00000016323 * cos(4.05116076920 + 6681.22485340000 * Tau) + + 0.00000005848 * cos(4.46383962090 + 10021.83728000000 * Tau) + + 0.00000001532 * cos(4.84374321620 + 13362.44970700000 * Tau); + + R5 := 0.00000000000; + Result := (R0 + R1*Tau + R2*Tau2 + R3*Tau3 + R4*Tau4 + R5*Tau5); +end; + +{-------------------------------------------------------------------------} + +function ComputeMars(JD : Double) : TStEclipticalCord; +var + Tau, + Tau2, + Tau3, + Tau4, + Tau5 : Double; +begin + Tau := (JD - 2451545.0) / 365250.0; + Tau2 := sqr(Tau); + Tau3 := Tau * Tau2; + Tau4 := sqr(Tau2); + Tau5 := Tau2 * Tau3; + + Result.L0 := GetLongitude(Tau, Tau2, Tau3, Tau4, Tau5); + Result.B0 := GetLatitude(Tau, Tau2, Tau3, Tau4, Tau5); + Result.R0 := GetRadiusVector(Tau, Tau2, Tau3, Tau4, Tau5); +end; + + +end. diff --git a/components/systools/source/run/stmerc.pas b/components/systools/source/run/stmerc.pas new file mode 100644 index 000000000..6df2d7d4e --- /dev/null +++ b/components/systools/source/run/stmerc.pas @@ -0,0 +1,280 @@ +// Upgraded to Delphi 2009: Sebastian Zierer + + +(* ***** BEGIN LICENSE BLOCK ***** + * Version: MPL 1.1 + * + * The contents of this file are subject to the Mozilla Public License Version + * 1.1 (the "License"); you may not use this file except in compliance with + * the License. You may obtain a copy of the License at + * http://www.mozilla.org/MPL/ + * + * Software distributed under the License is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License + * for the specific language governing rights and limitations under the + * License. + * + * The Original Code is TurboPower SysTools + * + * The Initial Developer of the Original Code is + * TurboPower Software + * + * Portions created by the Initial Developer are Copyright (C) 1996-2002 + * the Initial Developer. All Rights Reserved. + * + * Contributor(s): + * + * ***** END LICENSE BLOCK ***** *) + +{*********************************************************} +{* SysTools: StMerc.pas 4.04 *} +{*********************************************************} +{* SysTools: Astronomical Routines (for Mercury) *} +{*********************************************************} + +{$IFDEF FPC} + {$mode DELPHI} +{$ENDIF} + +//{$I StDefine.inc} + +unit StMerc; + +interface + +uses + StAstroP; + +function ComputeMercury(JD : Double) : TStEclipticalCord; + + +implementation + +function GetLongitude(Tau, Tau2, Tau3, Tau4, Tau5 : Double) : Double; +var + L0, L1, + L2, L3, + L4, L5 : Double; +begin + L0 := 4.40250710140 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.40989414976 * cos(1.48302034190 + 26087.90314200000 * Tau) + + 0.05046294199 * cos(4.47785489540 + 52175.80628300000 * Tau) + + 0.00855346843 * cos(1.16520322350 + 78263.70942500000 * Tau) + + 0.00165590362 * cos(4.11969163180 + 104351.61257000000 * Tau) + + 0.00034561897 * cos(0.77930765817 + 130439.51571000000 * Tau) + + 0.00007583476 * cos(3.71348400510 + 156527.41885000000 * Tau) + + 0.00003559740 * cos(1.51202669420 + 1109.37855210000 * Tau) + + 0.00001803463 * cos(4.10333178410 + 5661.33204920000 * Tau) + + 0.00001726012 * cos(0.35832239908 + 182615.32199000000 * Tau) + + 0.00001589923 * cos(2.99510417810 + 25028.52121100000 * Tau) + + 0.00001364682 * cos(4.59918318740 + 27197.28169400000 * Tau) + + 0.00001017332 * cos(0.88031439040 + 31749.23519100000 * Tau) + + 0.00000714182 * cos(1.54144865260 + 24978.52458900000 * Tau) + + 0.00000643759 * cos(5.30266110790 + 21535.94964400000 * Tau) + + 0.00000451137 * cos(6.04989275290 + 51116.42435300000 * Tau) + + 0.00000404200 * cos(3.28228847030 + 208703.22513000000 * Tau) + + 0.00000352441 * cos(5.24156297100 + 20426.57109200000 * Tau) + + 0.00000345212 * cos(2.79211901540 + 15874.61759500000 * Tau) + + 0.00000343313 * cos(5.76531885340 + 955.59974161000 * Tau) + + 0.00000339214 * cos(5.86327765000 + 25558.21217600000 * Tau) + + 0.00000325335 * cos(1.33674334780 + 53285.18483500000 * Tau) + + 0.00000272947 * cos(2.49451163980 + 529.69096509000 * Tau) + + 0.00000264336 * cos(3.91705094010 + 57837.13833200000 * Tau) + + 0.00000259587 * cos(0.98732428184 + 4551.95349710000 * Tau) + + 0.00000238793 * cos(0.11343953378 + 1059.38193020000 * Tau) + + 0.00000234830 * cos(0.26672118900 + 11322.66409800000 * Tau) + + 0.00000216645 * cos(0.65987207348 + 13521.75144200000 * Tau) + + 0.00000208995 * cos(2.09178234010 + 47623.85278600000 * Tau) + + 0.00000183359 * cos(2.62878670780 + 27043.50288300000 * Tau) + + 0.00000181629 * cos(2.43413502470 + 25661.30495100000 * Tau) + + 0.00000175965 * cos(4.53636829860 + 51066.42773100000 * Tau) + + 0.00000172643 * cos(2.45200164170 + 24498.83024600000 * Tau) + + 0.00000142316 * cos(3.36003948840 + 37410.56724000000 * Tau) + + 0.00000137942 * cos(0.29098447849 + 10213.28554600000 * Tau) + + 0.00000125219 * cos(3.72079804430 + 39609.65458300000 * Tau) + + 0.00000118233 * cos(2.78149786370 + 77204.32749400000 * Tau) + + 0.00000106422 * cos(4.20572116250 + 19804.82729200000 * Tau); + + L1 := 26088.1470620 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.01126007832 * cos(6.21703971000 + 26087.90314200000 * Tau) + + 0.00303471395 * cos(3.05565472360 + 52175.80628300000 * Tau) + + 0.00080538452 * cos(6.10454743370 + 78263.70942500000 * Tau) + + 0.00021245035 * cos(2.83531934450 + 104351.61257000000 * Tau) + + 0.00005592094 * cos(5.82675673330 + 130439.51571000000 * Tau) + + 0.00001472233 * cos(2.51845458400 + 156527.41885000000 * Tau) + + 0.00000388318 * cos(5.48039225890 + 182615.32199000000 * Tau) + + 0.00000352244 * cos(3.05238094400 + 1109.37855210000 * Tau) + + 0.00000102743 * cos(2.14879173780 + 208703.22513000000 * Tau) + + 0.00000093540 * cos(6.11791163930 + 27197.28169400000 * Tau) + + 0.00000090579 * cos(0.00045481669 + 24978.52458900000 * Tau) + + 0.00000051941 * cos(5.62107554050 + 5661.33204920000 * Tau) + + 0.00000044370 * cos(4.57348500460 + 25028.52121100000 * Tau) + + 0.00000028070 * cos(3.04195430990 + 51066.42773100000 * Tau) + + 0.00000027295 * cos(5.09210138840 + 234791.12827000000 * Tau); + + L2 := 0.00053049845 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00016903658 * cos(4.69072300650 + 26087.90314200000 * Tau) + + 0.00007396711 * cos(1.34735624670 + 52175.80628300000 * Tau) + + 0.00003018297 * cos(4.45643539700 + 78263.70942500000 * Tau) + + 0.00001107419 * cos(1.26226537550 + 104351.61257000000 * Tau) + + 0.00000378173 * cos(4.31998055900 + 130439.51571000000 * Tau) + + 0.00000122998 * cos(1.06868541050 + 156527.41885000000 * Tau) + + 0.00000038663 * cos(4.08011610180 + 182615.32199000000 * Tau) + + 0.00000014898 * cos(4.63343085810 + 1109.37855210000 * Tau) + + 0.00000011861 * cos(0.79187646439 + 208703.22513000000 * Tau); + + L3 := 0.00000188077 * cos(0.03466830117 + 52175.80628300000 * Tau) + + 0.00000142152 * cos(3.12505452600 + 26087.90314200000 * Tau) + + 0.00000096877 * cos(3.00378171920 + 78263.70942500000 * Tau) + + 0.00000043669 * cos(6.01867965830 + 104351.61257000000 * Tau) + + 0.00000035395 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00000018045 * cos(2.77538373990 + 130439.51571000000 * Tau) + + 0.00000006971 * cos(5.81808665740 + 156527.41885000000 * Tau) + + 0.00000002556 * cos(2.57014364450 + 182615.32199000000 * Tau); + + L4 := 0.00000114078 * cos(3.14159265360 + 0.00000000000 * Tau) + + 0.00000003247 * cos(2.02848007620 + 26087.90314200000 * Tau) + + 0.00000001914 * cos(1.41731803760 + 78263.70942500000 * Tau) + + 0.00000001727 * cos(4.50137643800 + 52175.80628300000 * Tau) + + 0.00000001237 * cos(4.49970181060 + 104351.61257000000 * Tau) + + 0.00000000645 * cos(1.26591776990 + 130439.51571000000 * Tau); + + L5 := 0.00000000877 * cos(3.14159265360 + 0.00000000000 * Tau); + Result := (L0 + L1*Tau + L2*Tau2 + L3*Tau3 + L4*Tau4 + L5*Tau5); +end; + +{-------------------------------------------------------------------------} + +function GetLatitude(Tau, Tau2, Tau3, Tau4, Tau5 : Double) : Double; +var + B0, B1, + B2, B3, + B4, B5 : Double; +begin + + B0 := 0.11737528962 * cos(1.98357498770 + 26087.90314200000 * Tau) + + 0.02388076996 * cos(5.03738959690 + 52175.80628300000 * Tau) + + 0.01222839532 * cos(3.14159265360 + 0.00000000000 * Tau) + + 0.00543251810 * cos(1.79644363960 + 78263.70942500000 * Tau) + + 0.00129778770 * cos(4.83232503960 + 104351.61257000000 * Tau) + + 0.00031866927 * cos(1.58088495670 + 130439.51571000000 * Tau) + + 0.00007963301 * cos(4.60972126350 + 156527.41885000000 * Tau) + + 0.00002014189 * cos(1.35324164690 + 182615.32199000000 * Tau) + + 0.00000513953 * cos(4.37835409310 + 208703.22513000000 * Tau) + + 0.00000208584 * cos(2.02020294150 + 24978.52458900000 * Tau) + + 0.00000207674 * cos(4.91772564070 + 27197.28169400000 * Tau) + + 0.00000132013 * cos(1.11908492280 + 234791.12827000000 * Tau) + + 0.00000121395 * cos(1.81271752060 + 53285.18483500000 * Tau) + + 0.00000100454 * cos(5.65684734210 + 20426.57109200000 * Tau); + + B1 := 0.00429151362 * cos(3.50169780390 + 26087.90314200000 * Tau) + + 0.00146233668 * cos(3.14159265360 + 0.00000000000 * Tau) + + 0.00022675295 * cos(0.01515366880 + 52175.80628300000 * Tau) + + 0.00010894981 * cos(0.48540174006 + 78263.70942500000 * Tau) + + 0.00006353462 * cos(3.42943919980 + 104351.61257000000 * Tau) + + 0.00002495743 * cos(0.16051210665 + 130439.51571000000 * Tau) + + 0.00000859585 * cos(3.18452433650 + 156527.41885000000 * Tau) + + 0.00000277503 * cos(6.21020774180 + 182615.32199000000 * Tau) + + 0.00000086233 * cos(2.95244391820 + 208703.22513000000 * Tau) + + 0.00000027696 * cos(0.29068938889 + 27197.28169400000 * Tau) + + 0.00000026133 * cos(5.97708962690 + 234791.12827000000 * Tau); + + B2 := 0.00011830934 * cos(4.79065585780 + 26087.90314200000 * Tau) + + 0.00001913516 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00001044801 * cos(1.21216540540 + 52175.80628300000 * Tau) + + 0.00000266213 * cos(4.43418336530 + 78263.70942500000 * Tau) + + 0.00000170280 * cos(1.62255638710 + 104351.61257000000 * Tau) + + 0.00000096300 * cos(4.80023692020 + 130439.51571000000 * Tau) + + 0.00000044692 * cos(1.60758267770 + 156527.41885000000 * Tau) + + 0.00000018316 * cos(4.66904655380 + 182615.32199000000 * Tau) + + 0.00000006927 * cos(1.43404888930 + 208703.22513000000 * Tau); + + B3 := 0.00000235423 * cos(0.35387524604 + 26087.90314200000 * Tau) + + 0.00000160537 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00000018904 * cos(4.36275460260 + 52175.80628300000 * Tau) + + 0.00000006376 * cos(2.50715381440 + 78263.70942500000 * Tau) + + 0.00000004580 * cos(6.14257817570 + 104351.61257000000 * Tau) + + 0.00000003061 * cos(3.12497552680 + 130439.51571000000 * Tau) + + 0.00000001732 * cos(6.26642412060 + 156527.41885000000 * Tau); + + B4 := 0.00000004276 * cos(1.74579932120 + 26087.90314200000 * Tau) + + 0.00000001023 * cos(3.14159265360 + 0.00000000000 * Tau); + + B5 := 0.00000000000 * cos(0.00000000000 + 0.00000000000 * Tau); + Result := (B0 + B1*Tau + B2*Tau2 + B3*Tau3 + B4*Tau4 + B5*Tau5); +end; + +{-------------------------------------------------------------------------} + +function GetRadiusVector(Tau, Tau2, Tau3, Tau4, Tau5 : Double) : Double; +var + R0, R1, + R2, R3, + R4, R5 : Double; +begin + R0 := 0.39528271652 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.07834131817 * cos(6.19233722600 + 26087.90314200000 * Tau) + + 0.00795525557 * cos(2.95989690100 + 52175.80628300000 * Tau) + + 0.00121281763 * cos(6.01064153810 + 78263.70942500000 * Tau) + + 0.00021921969 * cos(2.77820093970 + 104351.61257000000 * Tau) + + 0.00004354065 * cos(5.82894543260 + 130439.51571000000 * Tau) + + 0.00000918228 * cos(2.59650562600 + 156527.41885000000 * Tau) + + 0.00000289955 * cos(1.42441936950 + 25028.52121100000 * Tau) + + 0.00000260033 * cos(3.02817753480 + 27197.28169400000 * Tau) + + 0.00000201855 * cos(5.64725040350 + 182615.32199000000 * Tau) + + 0.00000201499 * cos(5.59227724200 + 31749.23519100000 * Tau) + + 0.00000141980 * cos(6.25264202640 + 24978.52458900000 * Tau) + + 0.00000100144 * cos(3.73435608690 + 21535.94964400000 * Tau); + + R1 := 0.00217347739 * cos(4.65617158660 + 26087.90314200000 * Tau) + + 0.00044141826 * cos(1.42385543980 + 52175.80628300000 * Tau) + + 0.00010094479 * cos(4.47466326320 + 78263.70942500000 * Tau) + + 0.00002432804 * cos(1.24226083430 + 104351.61257000000 * Tau) + + 0.00001624367 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00000603996 * cos(4.29303116560 + 130439.51571000000 * Tau) + + 0.00000152851 * cos(1.06060779810 + 156527.41885000000 * Tau) + + 0.00000039202 * cos(4.11136751420 + 182615.32199000000 * Tau); + + R2 := 0.00003117867 * cos(3.08231840300 + 26087.90314200000 * Tau) + + 0.00001245396 * cos(6.15183317420 + 52175.80628300000 * Tau) + + 0.00000424822 * cos(2.92583352960 + 78263.70942500000 * Tau) + + 0.00000136130 * cos(5.97983925840 + 104351.61257000000 * Tau) + + 0.00000042175 * cos(2.74936980630 + 130439.51571000000 * Tau) + + 0.00000021759 * cos(3.14159265360 + 0.00000000000 * Tau) + + 0.00000012793 * cos(5.80143162210 + 156527.41885000000 * Tau); + + R3 := 0.00000032676 * cos(1.67971635360 + 26087.90314200000 * Tau) + + 0.00000024166 * cos(4.63403169000 + 52175.80628300000 * Tau) + + 0.00000012133 * cos(1.38983781540 + 78263.70942500000 * Tau) + + 0.00000005140 * cos(4.43915386930 + 104351.61257000000 * Tau) + + 0.00000001981 * cos(1.20733880270 + 130439.51571000000 * Tau); + + R4 := 0.00000000000; + + R5 := 0.00000000000; + Result := (R0 + R1*Tau + R2*Tau2 + R3*Tau3 + R4*Tau4 + R5*Tau5); +end; + +{---------------------------------------------------------------------------} + +function ComputeMercury(JD : Double) : TStEclipticalCord; +var + Tau, + Tau2, + Tau3, + Tau4, + Tau5 : Double; +begin + Tau := (JD - 2451545.0) / 365250.0; + Tau2 := sqr(Tau); + Tau3 := Tau * Tau2; + Tau4 := sqr(Tau2); + Tau5 := Tau2 * Tau3; + + Result.L0 := GetLongitude(Tau, Tau2, Tau3, Tau4, Tau5); + Result.B0 := GetLatitude(Tau, Tau2, Tau3, Tau4, Tau5); + Result.R0 := GetRadiusVector(Tau, Tau2, Tau3, Tau4, Tau5); +end; + + +end. diff --git a/components/systools/source/run/stneptun.pas b/components/systools/source/run/stneptun.pas new file mode 100644 index 000000000..98c65565d --- /dev/null +++ b/components/systools/source/run/stneptun.pas @@ -0,0 +1,286 @@ +// Upgraded to Delphi 2009: Sebastian Zierer + +(* ***** BEGIN LICENSE BLOCK ***** + * Version: MPL 1.1 + * + * The contents of this file are subject to the Mozilla Public License Version + * 1.1 (the "License"); you may not use this file except in compliance with + * the License. You may obtain a copy of the License at + * http://www.mozilla.org/MPL/ + * + * Software distributed under the License is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License + * for the specific language governing rights and limitations under the + * License. + * + * The Original Code is TurboPower SysTools + * + * The Initial Developer of the Original Code is + * TurboPower Software + * + * Portions created by the Initial Developer are Copyright (C) 1996-2002 + * the Initial Developer. All Rights Reserved. + * + * Contributor(s): + * + * ***** END LICENSE BLOCK ***** *) + +{*********************************************************} +{* SysTools: StNeptun.pas 4.04 *} +{*********************************************************} +{* SysTools: Astronomical Routines (for Neptune) *} +{*********************************************************} + +{$IFDEF FPC} + {$mode DELPHI} +{$ENDIF} + +//{$I StDefine.inc} + +unit StNeptun; + +interface + +uses + StAstroP; + +function ComputeNeptune(JD : Double) : TStEclipticalCord; + + +implementation + +function GetLongitude(Tau, Tau2, Tau3, Tau4, Tau5 : Double) : Double; +var + L0, L1, + L2, L3, + L4, L5 : Double; +begin + L0 := 5.31188633050 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.01798475509 * cos(2.90101273050 + 38.13303563800 * Tau) + + 0.01019727662 * cos(0.48580923660 + 1.48447270830 * Tau) + + 0.00124531845 * cos(4.83008090680 + 36.64856292900 * Tau) + + 0.00042064450 * cos(5.41054991610 + 2.96894541660 * Tau) + + 0.00037714589 * cos(6.09221834950 + 35.16409022100 * Tau) + + 0.00033784734 * cos(1.24488865580 + 76.26607127600 * Tau) + + 0.00016482741 * cos(0.00007729261 + 491.55792946000 * Tau) + + 0.00009198582 * cos(4.93747059920 + 39.61750834600 * Tau) + + 0.00008994249 * cos(0.27462142569 + 175.16605980000 * Tau) + + 0.00004216235 * cos(1.98711914360 + 73.29712585900 * Tau) + + 0.00003364818 * cos(1.03590121820 + 33.67961751300 * Tau) + + 0.00002284800 * cos(4.20606932560 + 4.45341812490 * Tau) + + 0.00001433512 * cos(2.78340432710 + 74.78159856700 * Tau) + + 0.00000900240 * cos(2.07606702420 + 109.94568879000 * Tau) + + 0.00000744996 * cos(3.19032530140 + 71.81265315100 * Tau) + + 0.00000506206 * cos(5.74785370250 + 114.39910691000 * Tau) + + 0.00000399552 * cos(0.34972342569 + 1021.24889460000 * Tau) + + 0.00000345195 * cos(3.46186210170 + 41.10198105400 * Tau) + + 0.00000340323 * cos(3.30369900420 + 77.75054398400 * Tau) + + 0.00000323004 * cos(2.24815188610 + 32.19514480500 * Tau) + + 0.00000306338 * cos(0.49684039897 + 0.52126486180 * Tau) + + 0.00000287322 * cos(4.50523446020 + 0.04818410980 * Tau) + + 0.00000282170 * cos(2.24565579690 + 146.59425172000 * Tau) + + 0.00000266605 * cos(4.88932609480 + 0.96320784650 * Tau) + + 0.00000251941 * cos(5.78166597290 + 388.46515524000 * Tau) + + 0.00000244722 * cos(1.24693337930 + 9.56122755560 * Tau) + + 0.00000232887 * cos(2.50459795020 + 137.03302416000 * Tau) + + 0.00000227079 * cos(1.79713054540 + 453.42489382000 * Tau) + + 0.00000170404 * cos(3.32390630650 + 108.46121608000 * Tau) + + 0.00000151401 * cos(2.19153094280 + 33.94024994400 * Tau) + + 0.00000150180 * cos(2.99706110410 + 5.93789083320 * Tau) + + 0.00000148295 * cos(0.85948986145 + 111.43016150000 * Tau) + + 0.00000118672 * cos(3.67706204310 + 2.44768055480 * Tau) + + 0.00000109300 * cos(2.41599378050 + 183.24281465000 * Tau) + + 0.00000103305 * cos(0.04078966679 + 0.26063243090 * Tau) + + 0.00000103054 * cos(4.40441222000 + 70.32818044200 * Tau) + + 0.00000101821 * cos(5.70539236950 + 0.11187458460 * Tau); + + L1 := 38.37687716700 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00016604187 * cos(4.86319129560 + 1.48447270830 * Tau) + + 0.00015807148 * cos(2.27923488530 + 38.13303563800 * Tau) + + 0.00003334701 * cos(3.68199676020 + 76.26607127600 * Tau) + + 0.00001305840 * cos(3.67320813490 + 2.96894541660 * Tau) + + 0.00000604832 * cos(1.50477747550 + 35.16409022100 * Tau) + + 0.00000178623 * cos(3.45318524150 + 39.61750834600 * Tau) + + 0.00000106537 * cos(2.45126138330 + 4.45341812490 * Tau) + + 0.00000105747 * cos(2.75479326550 + 33.67961751300 * Tau) + + 0.00000072684 * cos(5.48724732700 + 36.64856292900 * Tau) + + 0.00000057355 * cos(1.85767603380 + 114.39910691000 * Tau) + + 0.00000057069 * cos(5.21649804970 + 0.52126486180 * Tau) + + 0.00000035368 * cos(4.51676827540 + 74.78159856700 * Tau) + + 0.00000032216 * cos(5.90411489680 + 77.75054398400 * Tau) + + 0.00000029871 * cos(3.67043294110 + 388.46515524000 * Tau) + + 0.00000028866 * cos(5.16877529160 + 9.56122755560 * Tau) + + 0.00000028742 * cos(5.16732589020 + 2.44768055480 * Tau) + + 0.00000025507 * cos(5.24526281930 + 168.05251280000 * Tau); + + L2 := 0.00053892649 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00000295693 * cos(1.85520292250 + 1.48447270830 * Tau) + + 0.00000281251 * cos(1.19084538890 + 38.13303563800 * Tau) + + 0.00000270190 * cos(5.72143228150 + 76.26607127600 * Tau) + + 0.00000023023 * cos(1.21035596450 + 2.96894541660 * Tau) + + 0.00000009057 * cos(4.42544992040 + 35.16409022100 * Tau) + + 0.00000007333 * cos(0.54033306830 + 2.44768055480 * Tau); + + L3 := 0.00000031254 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00000014541 * cos(1.35337075860 + 76.26607127600 * Tau) + + 0.00000012461 * cos(6.04431418810 + 1.48447270830 * Tau) + + 0.00000011547 * cos(6.11257808370 + 38.13303563800 * Tau); + + L4 := 0.00000113998 * cos(3.14159265360 + 0.00000000000 * Tau); + + L5 := 0.00000000000; + Result := (L0 + L1*Tau + L2*Tau2 + L3*Tau3 + L4*Tau4 + L5*Tau5); +end; + +{---------------------------------------------------------------------------} + +function GetLatitude(Tau, Tau2, Tau3, Tau4, Tau5 : Double) : Double; +var + B0, B1, + B2, B3, + B4, B5 : Double; +begin + B0 := 0.03088622933 * cos(1.44104372630 + 38.13303563800 * Tau) + + 0.00027780087 * cos(5.91271882840 + 76.26607127600 * Tau) + + 0.00027623609 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00015448133 * cos(3.50877080890 + 39.61750834600 * Tau) + + 0.00015355490 * cos(2.52123799480 + 36.64856292900 * Tau) + + 0.00001999919 * cos(1.50998669500 + 74.78159856700 * Tau) + + 0.00001967540 * cos(4.37778195770 + 1.48447270830 * Tau) + + 0.00001015137 * cos(3.21561035880 + 35.16409022100 * Tau) + + 0.00000605767 * cos(2.80246601410 + 73.29712585900 * Tau) + + 0.00000594878 * cos(2.12892708110 + 41.10198105400 * Tau) + + 0.00000588805 * cos(3.18655882500 + 2.96894541660 * Tau) + + 0.00000401830 * cos(4.16883287240 + 114.39910691000 * Tau) + + 0.00000279964 * cos(1.68165309700 + 77.75054398400 * Tau) + + 0.00000261647 * cos(3.76722704750 + 213.29909544000 * Tau) + + 0.00000254333 * cos(3.27120499440 + 453.42489382000 * Tau) + + 0.00000205590 * cos(4.25652348860 + 529.69096509000 * Tau) + + 0.00000140455 * cos(3.52969556380 + 137.03302416000 * Tau); + + B1 := 0.00227279214 * cos(3.80793089870 + 38.13303563800 * Tau) + + 0.00001803120 * cos(1.97576485380 + 76.26607127600 * Tau) + + 0.00001433300 * cos(3.14159265360 + 0.00000000000 * Tau) + + 0.00001385733 * cos(4.82555548020 + 36.64856292900 * Tau) + + 0.00001073298 * cos(6.08054240710 + 39.61750834600 * Tau) + + 0.00000147903 * cos(3.85766231350 + 74.78159856700 * Tau) + + 0.00000136448 * cos(0.47764957338 + 1.48447270830 * Tau) + + 0.00000070285 * cos(6.18782052140 + 35.16409022100 * Tau) + + 0.00000051899 * cos(5.05221791890 + 73.29712585900 * Tau) + + 0.00000042568 * cos(0.30721737205 + 114.39910691000 * Tau) + + 0.00000037273 * cos(4.89476629250 + 41.10198105400 * Tau) + + 0.00000037104 * cos(5.75999349110 + 2.96894541660 * Tau) + + 0.00000026399 * cos(5.21566335940 + 213.29909544000 * Tau); + + B2 := 0.00009690766 * cos(5.57123750290 + 38.13303563800 * Tau) + + 0.00000078815 * cos(3.62705474220 + 76.26607127600 * Tau) + + 0.00000071523 * cos(0.45476688580 + 36.64856292900 * Tau) + + 0.00000058646 * cos(3.14159265360 + 0.00000000000 * Tau) + + 0.00000029915 * cos(1.60671721860 + 39.61750834600 * Tau) + + 0.00000006472 * cos(5.60736756580 + 74.78159856700 * Tau); + + B3 := 0.00000273423 * cos(1.01688979070 + 38.13303563800 * Tau) + + 0.00000002393 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00000002274 * cos(2.36805657130 + 36.64856292900 * Tau) + + 0.00000002029 * cos(5.33364321340 + 76.26607127600 * Tau); + + B4 := 0.00000005728 * cos(2.66872693320 + 38.13303563800 * Tau); + + B5 := 0.00000000000; + Result := (B0 + B1*Tau + B2*Tau2 + B3*Tau3 + B4*Tau4 + B5*Tau5); +end; + +{---------------------------------------------------------------------------} + +function GetRadiusVector(Tau, Tau2, Tau3, Tau4, Tau5 : Double) : Double; +var + R0, R1, + R2, R3, + R4, R5 : Double; +begin + R0 := 30.07013206100 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.27062259490 * cos(1.32999458930 + 38.13303563800 * Tau) + + 0.01691764281 * cos(3.25186138900 + 36.64856292900 * Tau) + + 0.00807830737 * cos(5.18592836170 + 1.48447270830 * Tau) + + 0.00537760613 * cos(4.52113902850 + 35.16409022100 * Tau) + + 0.00495725642 * cos(1.57105654810 + 491.55792946000 * Tau) + + 0.00274571970 * cos(1.84552256800 + 175.16605980000 * Tau) + + 0.00135134095 * cos(3.37220607380 + 39.61750834600 * Tau) + + 0.00121801825 * cos(5.79754444300 + 76.26607127600 * Tau) + + 0.00100895397 * cos(0.37702748681 + 73.29712585900 * Tau) + + 0.00069791722 * cos(3.79617226930 + 2.96894541660 * Tau) + + 0.00046687838 * cos(5.74937810090 + 33.67961751300 * Tau) + + 0.00024593778 * cos(0.50801728204 + 109.94568879000 * Tau) + + 0.00016939242 * cos(1.59422166990 + 71.81265315100 * Tau) + + 0.00014229686 * cos(1.07786112900 + 74.78159856700 * Tau) + + 0.00012011825 * cos(1.92062131640 + 1021.24889460000 * Tau) + + 0.00008394731 * cos(0.67816895547 + 146.59425172000 * Tau) + + 0.00007571800 * cos(1.07149263430 + 388.46515524000 * Tau) + + 0.00005720852 * cos(2.59059512270 + 4.45341812490 * Tau) + + 0.00004839672 * cos(1.90685991070 + 41.10198105400 * Tau) + + 0.00004483492 * cos(2.90573457530 + 529.69096509000 * Tau) + + 0.00004420804 * cos(1.74993796500 + 108.46121608000 * Tau) + + 0.00004353790 * cos(0.67985662370 + 32.19514480500 * Tau) + + 0.00004270202 * cos(3.41343865820 + 453.42489382000 * Tau) + + 0.00003380930 * cos(0.84810683275 + 183.24281465000 * Tau) + + 0.00002881063 * cos(1.98600105120 + 137.03302416000 * Tau) + + 0.00002878942 * cos(3.67415901850 + 350.33211960000 * Tau) + + 0.00002635535 * cos(3.09755943420 + 213.29909544000 * Tau) + + 0.00002530149 * cos(5.79839567010 + 490.07345675000 * Tau) + + 0.00002523132 * cos(0.48630800015 + 493.04240217000 * Tau) + + 0.00002306293 * cos(2.80962935720 + 70.32818044200 * Tau) + + 0.00002087303 * cos(0.61858378281 + 33.94024994400 * Tau); + + R1 := 0.00236338502 * cos(0.70498011235 + 38.13303563800 * Tau) + + 0.00013220279 * cos(3.32015499890 + 1.48447270830 * Tau) + + 0.00008621863 * cos(6.21628951630 + 35.16409022100 * Tau) + + 0.00002701740 * cos(1.88140666780 + 39.61750834600 * Tau) + + 0.00002154735 * cos(2.09431198090 + 2.96894541660 * Tau) + + 0.00002153150 * cos(5.16873840980 + 76.26607127600 * Tau) + + 0.00001603165 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00001463924 * cos(1.18417031050 + 33.67961751300 * Tau) + + 0.00001135773 * cos(3.91891199650 + 36.64856292900 * Tau) + + 0.00000897650 * cos(5.24122933530 + 388.46515524000 * Tau) + + 0.00000789908 * cos(0.53315484580 + 168.05251280000 * Tau) + + 0.00000760030 * cos(0.02051033644 + 182.27960680000 * Tau) + + 0.00000607183 * cos(1.07706500350 + 1021.24889460000 * Tau) + + 0.00000571622 * cos(3.40060785430 + 484.44438246000 * Tau) + + 0.00000560790 * cos(2.88685815670 + 498.67147646000 * Tau); + + R2 := 0.00004247412 * cos(5.89910679120 + 38.13303563800 * Tau) + + 0.00000217570 * cos(0.34581829080 + 1.48447270830 * Tau) + + 0.00000163025 * cos(2.23872947130 + 168.05251280000 * Tau) + + 0.00000156285 * cos(4.59414467340 + 182.27960680000 * Tau) + + 0.00000127141 * cos(2.84786298080 + 35.16409022100 * Tau); + + R3 := 0.00000166297 * cos(4.55243893490 + 38.13303563800 * Tau); + + R4 := 0.00000000000; + + R5 := 0.00000000000; + Result := (R0 + R1*Tau + R2*Tau2 + R3*Tau3 + R4*Tau4 + R5*Tau5); +end; + +{---------------------------------------------------------------------------} + +function ComputeNeptune(JD : Double) : TStEclipticalCord; +var + Tau, + Tau2, + Tau3, + Tau4, + Tau5 : Double; +begin + Tau := (JD - 2451545.0) / 365250.0; + Tau2 := sqr(Tau); + Tau3 := Tau * Tau2; + Tau4 := sqr(Tau2); + Tau5 := Tau2 * Tau3; + + Result.L0 := GetLongitude(Tau, Tau2, Tau3, Tau4, Tau5); + Result.B0 := GetLatitude(Tau, Tau2, Tau3, Tau4, Tau5); + Result.R0 := GetRadiusVector(Tau, Tau2, Tau3, Tau4, Tau5); +end; + + +end. diff --git a/components/systools/source/run/stpluto.pas b/components/systools/source/run/stpluto.pas new file mode 100644 index 000000000..fb8e9998a --- /dev/null +++ b/components/systools/source/run/stpluto.pas @@ -0,0 +1,202 @@ +// Upgraded to Delphi 2009: Sebastian Zierer + +(* ***** BEGIN LICENSE BLOCK ***** + * Version: MPL 1.1 + * + * The contents of this file are subject to the Mozilla Public License Version + * 1.1 (the "License"); you may not use this file except in compliance with + * the License. You may obtain a copy of the License at + * http://www.mozilla.org/MPL/ + * + * Software distributed under the License is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License + * for the specific language governing rights and limitations under the + * License. + * + * The Original Code is TurboPower SysTools + * + * The Initial Developer of the Original Code is + * TurboPower Software + * + * Portions created by the Initial Developer are Copyright (C) 1996-2002 + * the Initial Developer. All Rights Reserved. + * + * Contributor(s): + * + * ***** END LICENSE BLOCK ***** *) + +{*********************************************************} +{* SysTools: StPluto.pas 4.04 *} +{*********************************************************} +{* SysTools: Astronomical Routines (for Pluto) *} +{*********************************************************} + +{$IFDEF FPC} + {$mode DELPHI} +{$ENDIF} + +//{$I StDefine.inc} + +unit StPluto; + +interface + +uses + StAstroP, StMath; + +function ComputePluto(JD : Double) : TStEclipticalCord; + +implementation + +function ComputePluto(JD : Double) : TStEclipticalCord; +var + T, + J, S, P, + L, + B, + R : Double; +begin + T := (JD - 2451545.0) / 36525.0; + J := ( 34.35 + 3034.9057 * T) / radcor; + S := ( 50.08 + 1222.1138 * T) / radcor; + P := (238.96 + 144.9600 * T) / radcor; + + L := + - 19798886 * sin(P) + 19848454 * cos(P) + + 897499 * sin(2*P) - 4955707 * cos(2*P) + + 610820 * sin(3*P) + 1210521 * cos(3*P) + - 341639 * sin(4*P) - 189719 * cos(4*P) + + 129027 * sin(5*P) - 34863 * cos(5*P) + - 38215 * sin(6*P) + 31061 * cos(6*P) + + 20349 * sin(S-P) - 9886 * cos(S-P) + - 4045 * sin(S) - 4904 * cos(S) + - 5885 * sin(S+P) - 3238 * cos(S+P) + - 3812 * sin(S+2*P) + 3011 * cos(s+2*P) + - 601 * sin(S+3*P) + 3468 * cos(S+3*P) + + 1237 * sin(2*(S-P)) + 463 * cos(2*(S-P)) + + 1086 * sin(2*S-P) - 911 * cos(2*S-P) + + 595 * sin(2*S) - 1229 * cos(2*S) + + 2484 * sin(J-S) - 485 * cos(J-S) + + 839 * sin(J-S+P) - 1414 * cos(J-S+P) + - 964 * sin(J-3*P) + 1059 * cos(J-3*P) + - 2303 * sin(J-2*P) - 1038 * cos(J-2*P) + + 7049 * sin(J-P) + 747 * cos(J-P) + + 1179 * sin(J) - 358 * cos(J) + + 393 * sin(J+P) - 63 * cos(J+P) + + 111 * sin(J+2*P) - 268 * cos(J+2*P) + - 52 * sin(J+3*P) - 154 * cos(J+3*P) + - 78 * sin(J+4*P) - 30 * cos(J+4*P) + - 34 * sin(J+S-3*P) - 26 * cos(J+S-3*P) + - 43 * sin(J+S-2*P) + 1 * cos(J+S-2*P) + - 15 * sin(J+S-P) + 21 * cos(J+S-P) + - 1 * sin(J+S) + 15 * cos(J+S) + + 4 * sin(J+S+P) + 7 * cos(J+S+P) + + 1 * sin(J+S+3*P) + 5 * cos(J+S+3*P) + + 8 * sin(2*J-6*P) + 3 * cos(2*J-6*P) + - 3 * sin(2*J-5*P) + 6 * cos(2*J-5*P) + + 6 * sin(2*J-4*P) - 13 * cos(2*J-4*P) + + 10 * sin(2*J-3*P) + 22 * cos(2*J-3*P) + - 57 * sin(2*J-2*P) - 32 * cos(2*J-2*P) + + 157 * sin(2*J-P) - 46 * cos(2*J-P) + + 12 * sin(2*J) - 18 * cos(2*J) + - 4 * sin(2*J-P) + 8 * cos(2*J-P) + - 5 * sin(2*(J+P)) + 0 * sin(2*(J+P)) + + 3 * sin(2*J+3*P) + 4 * cos(2*J+3*P) + - 1 * sin(3*J-2*P) - 1 * cos(3*J-2*P) + + 6 * sin(3*J-P) - 3 * cos(3*J-P) + - 1 * sin(3*J) - 2 * cos(3*J); + Result.L0 := (238.956785 + 144.96*T + (L/1000000)) / radcor; + + B := -5453098 * sin(P) - 14974876 * cos(P) + + 3527363 * sin(2*P) + 1672673 * cos(2*P) + - 1050939 * sin(3*P) + 327763 * cos(3*P) + + 178691 * sin(4*P) - 291925 * cos(4*P) + + 18763 * sin(5*P) + 100448 * cos(5*P) + - 30594 * sin(6*P) - 25838 * cos(6*P) + + 4965 * sin(S-P) + 11263 * cos(S-P) + + 310 * sin(S) - 132 * cos(S) + + 2036 * sin(S+P) - 947 * cos(S+P) + - 2 * sin(S+2*P) - 674 * cos(S+2*P) + - 329 * sin(S+3*P) - 563 * cos(S+3*P) + - 64 * sin(2*(S-P)) + 39 * cos(2*(S-P)) + - 94 * sin(2*S-P) + 210 * cos(2*S-P) + - 8 * sin(2*S) - 160 * cos(2*S) + + 177 * sin(J-S) + 259 * cos(J-S) + + 17 * sin(J-S+P) + 234 * cos(J-S+P) + + 582 * sin(J-3*P) - 285 * cos(J-3*P) + - 298 * sin(J-2*P) + 692 * cos(J-2*P) + + 157 * sin(J-P) + 201 * cos(J-P) + + 304 * sin(J) + 825 * cos(J) + - 124 * sin(J+P) - 29 * cos(J+P) + + 15 * sin(J+2*P) + 8 * cos(J+2*P) + + 7 * sin(J+3*P) + 15 * cos(J+3*P) + + 2 * sin(J+4*P) + 2 * cos(J+4*P) + + 4 * sin(J+S-3*P) + 2 * cos(J+S-3*P) + + 3 * sin(J+S-2*P) + 0 * cos(J+S-2*P) + + 1 * sin(J+S-P) - 1 * cos(J+S-P) + + 0 * sin(J+S) - 2 * cos(J+S) + + 1 * sin(J+S+P) - 0 * cos(J+S+P) + + 1 * sin(J+S+3*P) - 1 * cos(J+S+3*P) + - 2 * sin(2*J-6*P) - 3 * cos(2*J-6*P) + + 1 * sin(2*J-5*P) + 2 * cos(2*J-5*P) + - 8 * sin(2*J-4*P) + 2 * cos(2*J-4*P) + + 10 * sin(2*J-3*P) - 7 * cos(2*J-3*P) + + 0 * sin(2*J-2*P) + 21 * cos(2*J-2*P) + + 8 * sin(2*J-P) + 5 * cos(2*J-P) + + 13 * sin(2*J) + 16 * cos(2*J) + - 2 * sin(2*J-P) - 3 * cos(2*J-P) + + 0 * sin(2*(J+P)) + 0 * cos(2*(J+P)) + + 0 * sin(2*J+3*P) + 1 * cos(2*J+3*P) + + 0 * sin(3*J-2*P) + 1 * cos(3*J-2*P) + + 0 * sin(3*J-P) + 0 * cos(3*J-P) + + 0 * sin(3*J) + 1 * cos(3*J); + Result.B0 := (-3.908202 + B/1000000) / radcor; + + R := 66867334 * sin(P) + 68955876 * cos(P) + - 11826086 * sin(2*P) - 333765 * cos(2*P) + + 1593657 * sin(3*P) - 1439953 * cos(3*P) + - 18948 * sin(4*P) + 482443 * cos(4*P) + - 66634 * sin(5*P) - 85576 * cos(5*P) + + 30841 * sin(6*P) - 5765 * cos(6*P) + - 6140 * sin(S-P) + 22254 * cos(S-P) + + 4434 * sin(S) + 4443 * cos(S) + - 1518 * sin(S+P) + 641 * cos(S+P) + - 5 * sin(S+2*P) + 792 * cos(s+2*P) + + 518 * sin(S+3*P) + 518 * cos(S+3*P) + - 13 * sin(2*(S-P)) - 221 * cos(2*(S-P)) + + 837 * sin(2*S-P) - 494 * cos(2*S-P) + - 281 * sin(2*S) + 616 * cos(2*S) + + 260 * sin(J-S) - 395 * cos(J-S) + - 191 * sin(J-S+P) - 396 * cos(J-S+P) + - 3218 * sin(J-3*P) + 370 * cos(J-3*P) + + 8019 * sin(J-2*P) - 7689 * cos(J-2*P) + + 105 * sin(J-P) + 45637 * cos(J-P) + + 8623 * sin(J) + 8444 * cos(J) + - 896 * sin(J+P) - 801 * cos(J+P) + + 208 * sin(J+2*P) - 122 * cos(J+2*P) + - 133 * sin(J+3*P) + 65 * cos(J+3*P) + - 16 * sin(J+4*P) + 1 * cos(J+4*P) + - 22 * sin(J+S-3*P) + 7 * cos(J+S-3*P) + - 8 * sin(J+S-2*P) + 16 * cos(J+S-2*P) + + 2 * sin(J+S-P) + 9 * cos(J+S-P) + + 12 * sin(J+S) + 5 * cos(J+S) + + 1 * sin(J+S+P) - 3 * cos(J+S+P) + + 1 * sin(J+S+3*P) + 0 * cos(J+S+3*P) + + 9 * sin(2*J-6*P) + 5 * cos(2*J-6*P) + + 2 * sin(2*J-5*P) - 1 * cos(2*J-5*P) + + 14 * sin(2*J-4*P) + 10 * cos(2*J-4*P) + - 65 * sin(2*J-3*P) + 12 * cos(2*J-3*P) + + 126 * sin(2*J-2*P) - 233 * cos(2*J-2*P) + + 270 * sin(2*J-P) + 1068 * cos(2*J-P) + + 254 * sin(2*J) + 155 * cos(2*J) + - 26 * sin(2*J-P) - 2 * cos(2*J-P) + + 7 * sin(2*(J+P)) + 0 * cos(2*(J+P)) + - 11 * sin(2*J+3*P) + 4 * cos(2*J+3*P) + + 4 * sin(3*J-2*P) - 14 * cos(3*J-2*P) + + 18 * sin(3*J-P) + 35 * cos(3*J-P) + + 13 * sin(3*J) + 3 * cos(3*J); + Result.R0 := 40.7247248 + R / 10000000; +end; + + +end. diff --git a/components/systools/source/run/stsaturn.pas b/components/systools/source/run/stsaturn.pas new file mode 100644 index 000000000..b2a1bb793 --- /dev/null +++ b/components/systools/source/run/stsaturn.pas @@ -0,0 +1,744 @@ +// Upgraded to Delphi 2009: Sebastian Zierer + +(* ***** BEGIN LICENSE BLOCK ***** + * Version: MPL 1.1 + * + * The contents of this file are subject to the Mozilla Public License Version + * 1.1 (the "License"); you may not use this file except in compliance with + * the License. You may obtain a copy of the License at + * http://www.mozilla.org/MPL/ + * + * Software distributed under the License is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License + * for the specific language governing rights and limitations under the + * License. + * + * The Original Code is TurboPower SysTools + * + * The Initial Developer of the Original Code is + * TurboPower Software + * + * Portions created by the Initial Developer are Copyright (C) 1996-2002 + * the Initial Developer. All Rights Reserved. + * + * Contributor(s): + * + * ***** END LICENSE BLOCK ***** *) + +{*********************************************************} +{* SysTools: StSaturn.pas 4.04 *} +{*********************************************************} +{* SysTools: Astronomical Routines (for Saturn) *} +{*********************************************************} + +{$IFDEF FPC} + {$mode DELPHI} +{$ENDIF} + +//{$I StDefine.inc} + +unit StSaturn; + +interface + +uses + StAstroP; + +function ComputeSaturn(JD : Double) : TStEclipticalCord; + + +implementation + +function GetLongitude(Tau, Tau2, Tau3, Tau4, Tau5 : Double) : Double; +var + L0, L1, + L2, L3, + L4, L5 : Double; +begin + L0 := 0.87401354029 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.11107659780 * cos(3.96205090190 + 213.29909544000 * Tau) + + 0.01414150958 * cos(4.58581515870 + 7.11354700080 * Tau) + + 0.00398379386 * cos(0.52112025957 + 206.18554844000 * Tau) + + 0.00350769223 * cos(3.30329903020 + 426.59819088000 * Tau) + + 0.00206816296 * cos(0.24658366938 + 103.09277422000 * Tau) + + 0.00079271288 * cos(3.84007078530 + 220.41264244000 * Tau) + + 0.00023990338 * cos(4.66976934860 + 110.20632122000 * Tau) + + 0.00016573583 * cos(0.43719123541 + 419.48464388000 * Tau) + + 0.00015820300 * cos(0.93808953760 + 632.78373931000 * Tau) + + 0.00015053509 * cos(2.71670027880 + 639.89728631000 * Tau) + + 0.00014906995 * cos(5.76903283840 + 316.39186966000 * Tau) + + 0.00014609562 * cos(1.56518573690 + 3.93215326310 * Tau) + + 0.00013160308 * cos(4.44891180180 + 14.22709400200 * Tau) + + 0.00013005305 * cos(5.98119067060 + 11.04570026400 * Tau) + + 0.00010725066 * cos(3.12939596470 + 202.25339517000 * Tau) + + 0.00006126308 * cos(1.76328499660 + 277.03499374000 * Tau) + + 0.00005863207 * cos(0.23657028777 + 529.69096509000 * Tau) + + 0.00005227771 * cos(4.20783162380 + 3.18139373770 * Tau) + + 0.00005019658 * cos(3.17787919530 + 433.71173788000 * Tau) + + 0.00004592541 * cos(0.61976424374 + 199.07200144000 * Tau) + + 0.00004005862 * cos(2.24479893940 + 63.73589830300 * Tau) + + 0.00003873696 * cos(3.22282692570 + 138.51749687000 * Tau) + + 0.00003269490 * cos(0.77491895787 + 949.17560897000 * Tau) + + 0.00002953815 * cos(0.98280385206 + 95.97922721800 * Tau) + + 0.00002461172 * cos(2.03163631210 + 735.87651353000 * Tau) + + 0.00001758143 * cos(3.26580514770 + 522.57741809000 * Tau) + + 0.00001640183 * cos(5.50504966220 + 846.08283475000 * Tau) + + 0.00001580641 * cos(4.37266314120 + 309.27832266000 * Tau) + + 0.00001391336 * cos(4.02331978120 + 323.50541666000 * Tau) + + 0.00001123515 * cos(2.83726793570 + 415.55249061000 * Tau) + + 0.00001087237 * cos(4.18343232480 + 2.44768055480 * Tau) + + 0.00001017258 * cos(3.71698151810 + 227.52618944000 * Tau) + + 0.00000956752 * cos(0.50740889886 + 1265.56747860000 * Tau) + + 0.00000852677 * cos(3.42141350700 + 175.16605980000 * Tau) + + 0.00000848643 * cos(3.19149825840 + 209.36694217000 * Tau) + + 0.00000789205 * cos(5.00745123150 + 0.96320784650 * Tau) + + 0.00000748811 * cos(2.14398149300 + 853.19638175000 * Tau) + + 0.00000743584 * cos(5.25276954620 + 224.34479570000 * Tau) + + 0.00000686965 * cos(1.74714407830 + 1052.26838320000 * Tau) + + 0.00000654470 * cos(1.59889331510 + 0.04818410980 * Tau) + + 0.00000633980 * cos(2.29889903020 + 412.37109687000 * Tau) + + 0.00000624904 * cos(0.97046831256 + 210.11770170000 * Tau) + + 0.00000579857 * cos(3.09259007050 + 74.78159856700 * Tau) + + 0.00000546358 * cos(2.12678554210 + 350.33211960000 * Tau) + + 0.00000542643 * cos(1.51824320510 + 9.56122755560 * Tau) + + 0.00000529861 * cos(4.44938897120 + 117.31986822000 * Tau) + + 0.00000478054 * cos(2.96488054340 + 137.03302416000 * Tau) + + 0.00000474279 * cos(5.47527185990 + 742.99006053000 * Tau) + + 0.00000451827 * cos(1.04436664240 + 490.33408918000 * Tau) + + 0.00000448542 * cos(1.28990416160 + 127.47179661000 * Tau) + + 0.00000372308 * cos(2.27819108630 + 217.23124870000 * Tau) + + 0.00000354944 * cos(3.01286483030 + 838.96928775000 * Tau) + + 0.00000347413 * cos(1.53928227760 + 340.77089205000 * Tau) + + 0.00000343475 * cos(0.24604039134 + 0.52126486180 * Tau) + + 0.00000330196 * cos(0.24715617844 + 1581.95934830000 * Tau) + + 0.00000322185 * cos(0.96137456104 + 203.73786788000 * Tau) + + 0.00000321543 * cos(2.57182354540 + 647.01083331000 * Tau) + + 0.00000309001 * cos(3.49486734910 + 216.48048918000 * Tau) + + 0.00000286688 * cos(2.37043745860 + 351.81659231000 * Tau) + + 0.00000277775 * cos(0.40020408926 + 211.81462273000 * Tau) + + 0.00000249116 * cos(1.47010534420 + 1368.66025280000 * Tau) + + 0.00000226609 * cos(4.91003163140 + 12.53017297200 * Tau) + + 0.00000220225 * cos(4.20422424870 + 200.76892247000 * Tau) + + 0.00000208655 * cos(1.34516255300 + 625.67019231000 * Tau) + + 0.00000207663 * cos(0.48349820488 + 1162.47470440000 * Tau) + + 0.00000207659 * cos(1.28302218900 + 39.35687591500 * Tau) + + 0.00000204500 * cos(6.01082206600 + 265.98929348000 * Tau) + + 0.00000184690 * cos(3.50344404960 + 149.56319713000 * Tau) + + 0.00000183511 * cos(0.97254952728 + 4.19278569400 * Tau) + + 0.00000182454 * cos(5.49122292430 + 2.92076130680 * Tau) + + 0.00000173914 * cos(1.86305806810 + 0.75075952540 * Tau) + + 0.00000164541 * cos(0.44005517520 + 5.41662597140 * Tau) + + 0.00000149299 * cos(5.73594349790 + 52.69019803900 * Tau) + + 0.00000147526 * cos(1.53529320510 + 5.62907429250 * Tau) + + 0.00000146068 * cos(6.23102544070 + 195.13984817000 * Tau) + + 0.00000139666 * cos(4.29450260070 + 21.34064100200 * Tau) + + 0.00000131283 * cos(4.06828961900 + 10.29494073800 * Tau) + + 0.00000124969 * cos(6.27737805830 + 1898.35121790000 * Tau) + + 0.00000122373 * cos(1.97588777200 + 4.66586644600 * Tau) + + 0.00000118156 * cos(5.34072933900 + 554.06998748000 * Tau) + + 0.00000117283 * cos(2.67920400580 + 1155.36115740000 * Tau) + + 0.00000113747 * cos(5.59427544710 + 1059.38193020000 * Tau) + + 0.00000112437 * cos(1.10502663530 + 191.20769491000 * Tau) + + 0.00000110399 * cos(0.16604024090 + 1.48447270830 * Tau) + + 0.00000109275 * cos(3.43812715690 + 536.80451210000 * Tau) + + 0.00000106570 * cos(4.01156608510 + 956.28915597000 * Tau) + + 0.00000103956 * cos(2.19210363070 + 88.86568021700 * Tau) + + 0.00000102702 * cos(1.19748124060 + 1685.05212250000 * Tau) + + 0.00000100631 * cos(4.96513666540 + 269.92144674000 * Tau); + + L1 := 213.54295596000 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.01296855005 * cos(1.82820544700 + 213.29909544000 * Tau) + + 0.00564347566 * cos(2.88500136430 + 7.11354700080 * Tau) + + 0.00107678770 * cos(2.27769911870 + 206.18554844000 * Tau) + + 0.00098323030 * cos(1.08070061330 + 426.59819088000 * Tau) + + 0.00040254586 * cos(2.04128257090 + 220.41264244000 * Tau) + + 0.00019941734 * cos(1.27954662740 + 103.09277422000 * Tau) + + 0.00010511706 * cos(2.74880392800 + 14.22709400200 * Tau) + + 0.00006939233 * cos(0.40493079985 + 639.89728631000 * Tau) + + 0.00004803325 * cos(2.44194097670 + 419.48464388000 * Tau) + + 0.00004056325 * cos(2.92166618780 + 110.20632122000 * Tau) + + 0.00003768630 * cos(3.64965631460 + 3.93215326310 * Tau) + + 0.00003384684 * cos(2.41694251650 + 3.18139373770 * Tau) + + 0.00003302200 * cos(1.26256486710 + 433.71173788000 * Tau) + + 0.00003071382 * cos(2.32739317750 + 199.07200144000 * Tau) + + 0.00001953036 * cos(3.56394683300 + 11.04570026400 * Tau) + + 0.00001249348 * cos(2.62803737520 + 95.97922721800 * Tau) + + 0.00000921683 * cos(1.96089834250 + 227.52618944000 * Tau) + + 0.00000705587 * cos(4.41689249330 + 529.69096509000 * Tau) + + 0.00000649654 * cos(6.17418093660 + 202.25339517000 * Tau) + + 0.00000627603 * cos(6.11088227170 + 309.27832266000 * Tau) + + 0.00000486843 * cos(6.03998200310 + 853.19638175000 * Tau) + + 0.00000478501 * cos(4.98776987980 + 522.57741809000 * Tau) + + 0.00000468377 * cos(4.61707843910 + 63.73589830300 * Tau) + + 0.00000417010 * cos(2.11708169280 + 323.50541666000 * Tau) + + 0.00000407630 * cos(1.29949556680 + 209.36694217000 * Tau) + + 0.00000352489 * cos(2.31707079460 + 632.78373931000 * Tau) + + 0.00000343826 * cos(3.95854178570 + 412.37109687000 * Tau) + + 0.00000339724 * cos(3.63396398750 + 316.39186966000 * Tau) + + 0.00000335936 * cos(3.77173072710 + 735.87651353000 * Tau) + + 0.00000331933 * cos(2.86077699880 + 210.11770170000 * Tau) + + 0.00000289429 * cos(2.73263080240 + 117.31986822000 * Tau) + + 0.00000280911 * cos(5.74398845420 + 2.44768055480 * Tau) + + 0.00000265801 * cos(0.54344631312 + 647.01083331000 * Tau) + + 0.00000230493 * cos(1.64428879620 + 216.48048918000 * Tau) + + 0.00000191667 * cos(2.96512946580 + 224.34479570000 * Tau) + + 0.00000172891 * cos(4.07695221040 + 846.08283475000 * Tau) + + 0.00000167131 * cos(2.59745202660 + 21.34064100200 * Tau) + + 0.00000136328 * cos(2.28580246630 + 10.29494073800 * Tau) + + 0.00000131364 * cos(3.44108355650 + 742.99006053000 * Tau) + + 0.00000127838 * cos(4.09533471250 + 217.23124870000 * Tau) + + 0.00000108862 * cos(6.16141072260 + 415.55249061000 * Tau) + + 0.00000097584 * cos(4.72845436680 + 838.96928775000 * Tau) + + 0.00000093909 * cos(3.48397279900 + 1052.26838320000 * Tau) + + 0.00000092482 * cos(3.94755499930 + 88.86568021700 * Tau) + + 0.00000086600 * cos(1.21951325060 + 440.82528488000 * Tau) + + 0.00000083463 * cos(3.11269504720 + 625.67019231000 * Tau) + + 0.00000077588 * cos(6.24408938830 + 302.16477566000 * Tau) + + 0.00000067106 * cos(0.28961738595 + 4.66586644600 * Tau) + + 0.00000065843 * cos(5.64757042730 + 9.56122755560 * Tau) + + 0.00000061900 * cos(4.29344363380 + 127.47179661000 * Tau) + + 0.00000061557 * cos(1.82789612600 + 195.13984817000 * Tau) + + 0.00000057780 * cos(2.47630552040 + 191.95845444000 * Tau) + + 0.00000056919 * cos(5.01889578110 + 137.03302416000 * Tau) + + 0.00000054585 * cos(0.28356341456 + 74.78159856700 * Tau) + + 0.00000054160 * cos(5.12628572380 + 490.33408918000 * Tau) + + 0.00000051425 * cos(1.45766406060 + 536.80451210000 * Tau) + + 0.00000046799 * cos(1.17721211050 + 149.56319713000 * Tau) + + 0.00000046649 * cos(5.14818326900 + 515.46387109000 * Tau) + + 0.00000045891 * cos(2.23198878760 + 956.28915597000 * Tau) + + 0.00000044444 * cos(2.70873627670 + 5.41662597140 * Tau) + + 0.00000040400 * cos(0.41281520440 + 269.92144674000 * Tau) + + 0.00000040380 * cos(3.88870105680 + 728.76296653000 * Tau) + + 0.00000037969 * cos(0.64665967180 + 422.66603761000 * Tau) + + 0.00000037768 * cos(2.53379013860 + 12.53017297200 * Tau) + + 0.00000037191 * cos(3.78239026410 + 2.92076130680 * Tau) + + 0.00000035116 * cos(6.08421794090 + 5.62907429250 * Tau) + + 0.00000033778 * cos(3.21070688050 + 1368.66025280000 * Tau) + + 0.00000033217 * cos(4.64063092110 + 277.03499374000 * Tau) + + 0.00000033050 * cos(5.43038091190 + 1066.49547720000 * Tau) + + 0.00000032857 * cos(0.30063884563 + 351.81659231000 * Tau) + + 0.00000031876 * cos(4.38622923770 + 1155.36115740000 * Tau) + + 0.00000031329 * cos(2.43455855530 + 52.69019803900 * Tau) + + 0.00000030276 * cos(2.84067004930 + 203.00415470000 * Tau) + + 0.00000030089 * cos(6.18684614310 + 284.14854074000 * Tau) + + 0.00000029667 * cos(3.39052569130 + 1059.38193020000 * Tau) + + 0.00000028913 * cos(2.02614760510 + 330.61896366000 * Tau) + + 0.00000028264 * cos(2.74178954000 + 265.98929348000 * Tau) + + 0.00000026493 * cos(4.51214170120 + 340.77089205000 * Tau); + + L2 := 0.00116441181 * cos(1.17987850630 + 7.11354700080 * Tau) + + 0.00091920844 * cos(0.07425261094 + 213.29909544000 * Tau) + + 0.00090592251 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00015276909 * cos(4.06492007500 + 206.18554844000 * Tau) + + 0.00010631396 * cos(0.25778277414 + 220.41264244000 * Tau) + + 0.00010604979 * cos(5.40963595890 + 426.59819088000 * Tau) + + 0.00004265368 * cos(1.04595556630 + 14.22709400200 * Tau) + + 0.00001215527 * cos(2.91860042120 + 103.09277422000 * Tau) + + 0.00001164684 * cos(4.60942128970 + 639.89728631000 * Tau) + + 0.00001081967 * cos(5.69130351670 + 433.71173788000 * Tau) + + 0.00001044754 * cos(4.04206453610 + 199.07200144000 * Tau) + + 0.00001020079 * cos(0.63369182642 + 3.18139373770 * Tau) + + 0.00000633582 * cos(4.38825410040 + 419.48464388000 * Tau) + + 0.00000549329 * cos(5.57303134240 + 3.93215326310 * Tau) + + 0.00000456914 * cos(1.26840971350 + 110.20632122000 * Tau) + + 0.00000425100 * cos(0.20935499279 + 227.52618944000 * Tau) + + 0.00000273739 * cos(4.28841011780 + 95.97922721800 * Tau) + + 0.00000161571 * cos(1.38139149420 + 11.04570026400 * Tau) + + 0.00000129494 * cos(1.56586884170 + 309.27832266000 * Tau) + + 0.00000117008 * cos(3.88120915960 + 853.19638175000 * Tau) + + 0.00000105415 * cos(4.90003203600 + 647.01083331000 * Tau) + + 0.00000100967 * cos(0.89270493100 + 21.34064100200 * Tau) + + 0.00000095659 * cos(2.91093561540 + 316.39186966000 * Tau) + + 0.00000095227 * cos(5.62561150600 + 412.37109687000 * Tau) + + 0.00000084860 * cos(5.73472777960 + 209.36694217000 * Tau) + + 0.00000082727 * cos(6.05030934790 + 216.48048918000 * Tau) + + 0.00000081948 * cos(1.02477558310 + 117.31986822000 * Tau) + + 0.00000074857 * cos(4.76178468160 + 210.11770170000 * Tau) + + 0.00000067184 * cos(0.45648612616 + 522.57741809000 * Tau) + + 0.00000066459 * cos(0.48297940601 + 10.29494073800 * Tau) + + 0.00000063696 * cos(0.35179804917 + 323.50541666000 * Tau) + + 0.00000060647 * cos(4.87517850190 + 632.78373931000 * Tau) + + 0.00000053281 * cos(2.74730541390 + 529.69096509000 * Tau) + + 0.00000045827 * cos(5.69296621750 + 440.82528488000 * Tau) + + 0.00000045293 * cos(1.66856699800 + 202.25339517000 * Tau) + + 0.00000042330 * cos(5.70768187700 + 88.86568021700 * Tau) + + 0.00000032140 * cos(0.07050050346 + 63.73589830300 * Tau) + + 0.00000031573 * cos(1.67190022210 + 302.16477566000 * Tau) + + 0.00000031150 * cos(4.16379537690 + 191.95845444000 * Tau) + + 0.00000026558 * cos(0.83256214407 + 224.34479570000 * Tau) + + 0.00000024631 * cos(5.65564728570 + 735.87651353000 * Tau) + + 0.00000020108 * cos(5.94364609980 + 217.23124870000 * Tau) + + 0.00000017511 * cos(4.90014736800 + 625.67019231000 * Tau) + + 0.00000017130 * cos(1.62593421270 + 742.99006053000 * Tau) + + 0.00000016040 * cos(0.57886320845 + 515.46387109000 * Tau) + + 0.00000014068 * cos(0.20675293700 + 838.96928775000 * Tau) + + 0.00000013744 * cos(3.76497167300 + 195.13984817000 * Tau) + + 0.00000012236 * cos(4.71789723980 + 203.00415470000 * Tau) + + 0.00000011940 * cos(0.12620714199 + 234.63973644000 * Tau) + + 0.00000011718 * cos(3.12098483550 + 846.08283475000 * Tau) + + 0.00000011154 * cos(5.92216844780 + 536.80451210000 * Tau) + + 0.00000011013 * cos(5.60207982770 + 728.76296653000 * Tau) + + 0.00000010601 * cos(3.20327613030 + 1066.49547720000 * Tau) + + 0.00000010240 * cos(4.98736656070 + 422.66603761000 * Tau) + + 0.00000010072 * cos(0.25709351996 + 330.61896366000 * Tau) + + 0.00000009962 * cos(4.15472049130 + 860.30992875000 * Tau) + + 0.00000009490 * cos(0.46379969328 + 956.28915597000 * Tau) + + 0.00000008287 * cos(2.13990364270 + 269.92144674000 * Tau) + + 0.00000007730 * cos(5.24602742310 + 429.77958461000 * Tau) + + 0.00000007550 * cos(4.03401153930 + 9.56122755560 * Tau) + + 0.00000007238 * cos(5.39724715260 + 1052.26838320000 * Tau) + + 0.00000006353 * cos(4.46211130730 + 284.14854074000 * Tau) + + 0.00000006082 * cos(5.93416924840 + 405.25754987000 * Tau); + + L3 := 0.00016038734 * cos(5.73945377420 + 7.11354700080 * Tau) + + 0.00004249793 * cos(4.58539675600 + 213.29909544000 * Tau) + + 0.00001906524 * cos(4.76082050210 + 220.41264244000 * Tau) + + 0.00001465687 * cos(5.91326678320 + 206.18554844000 * Tau) + + 0.00001162041 * cos(5.61973132430 + 14.22709400200 * Tau) + + 0.00001066581 * cos(3.60816533140 + 426.59819088000 * Tau) + + 0.00000239377 * cos(3.86088273440 + 433.71173788000 * Tau) + + 0.00000236975 * cos(5.76826451460 + 199.07200144000 * Tau) + + 0.00000165641 * cos(5.11641150220 + 3.18139373770 * Tau) + + 0.00000151352 * cos(2.73594641860 + 639.89728631000 * Tau) + + 0.00000131409 * cos(4.74327544610 + 227.52618944000 * Tau) + + 0.00000063365 * cos(0.22850089497 + 419.48464388000 * Tau) + + 0.00000061630 * cos(4.74287052460 + 103.09277422000 * Tau) + + 0.00000040437 * cos(5.47298059140 + 21.34064100200 * Tau) + + 0.00000040205 * cos(5.96420266720 + 95.97922721800 * Tau) + + 0.00000038746 * cos(5.83386199530 + 110.20632122000 * Tau) + + 0.00000028025 * cos(3.01235311510 + 647.01083331000 * Tau) + + 0.00000025029 * cos(0.98808170740 + 3.93215326310 * Tau) + + 0.00000019014 * cos(1.91614237460 + 853.19638175000 * Tau) + + 0.00000018262 * cos(4.96738415930 + 10.29494073800 * Tau) + + 0.00000018101 * cos(1.02506397060 + 412.37109687000 * Tau) + + 0.00000017919 * cos(4.20376505350 + 216.48048918000 * Tau) + + 0.00000017879 * cos(3.31913418970 + 309.27832266000 * Tau) + + 0.00000016208 * cos(3.89825272750 + 440.82528488000 * Tau) + + 0.00000015763 * cos(5.61667809630 + 117.31986822000 * Tau) + + 0.00000012947 * cos(1.18068953940 + 88.86568021700 * Tau) + + 0.00000011453 * cos(5.57520615100 + 11.04570026400 * Tau) + + 0.00000010548 * cos(5.92906266270 + 191.95845444000 * Tau) + + 0.00000010389 * cos(3.94838736950 + 209.36694217000 * Tau) + + 0.00000008650 * cos(3.39335369700 + 302.16477566000 * Tau) + + 0.00000007580 * cos(4.87736913160 + 323.50541666000 * Tau) + + 0.00000006697 * cos(0.38198725552 + 632.78373931000 * Tau) + + 0.00000006327 * cos(2.25492722760 + 522.57741809000 * Tau) + + 0.00000005864 * cos(1.05621157680 + 210.11770170000 * Tau) + + 0.00000005449 * cos(4.64268475490 + 234.63973644000 * Tau) + + 0.00000003701 * cos(3.14159265360 + 0.00000000000 * Tau) + + 0.00000003602 * cos(2.30677010960 + 515.46387109000 * Tau) + + 0.00000003229 * cos(2.20309400070 + 860.30992875000 * Tau) + + 0.00000002850 * cos(0.58604395010 + 529.69096509000 * Tau) + + 0.00000002583 * cos(4.93447677060 + 224.34479570000 * Tau) + + 0.00000002543 * cos(0.42393884183 + 625.67019231000 * Tau) + + 0.00000002421 * cos(4.76621391810 + 330.61896366000 * Tau) + + 0.00000002296 * cos(3.34809165900 + 429.77958461000 * Tau) + + 0.00000002213 * cos(3.19814958290 + 202.25339517000 * Tau) + + 0.00000002194 * cos(1.18918501010 + 1066.49547720000 * Tau) + + 0.00000002154 * cos(1.35488209140 + 405.25754987000 * Tau) + + 0.00000002090 * cos(4.15631351320 + 223.59403618000 * Tau) + + 0.00000002018 * cos(3.06693569700 + 654.12438032000 * Tau); + + L4 := 0.00001661894 * cos(3.99826248980 + 7.11354700080 * Tau) + + 0.00000257107 * cos(2.98436499010 + 220.41264244000 * Tau) + + 0.00000236344 * cos(3.90241428080 + 14.22709400200 * Tau) + + 0.00000149418 * cos(2.74110824210 + 213.29909544000 * Tau) + + 0.00000113953 * cos(3.14159265360 + 0.00000000000 * Tau) + + 0.00000109598 * cos(1.51515739250 + 206.18554844000 * Tau) + + 0.00000068390 * cos(1.72120953340 + 426.59819088000 * Tau) + + 0.00000040060 * cos(2.04644897410 + 433.71173788000 * Tau) + + 0.00000037699 * cos(1.23795458360 + 199.07200144000 * Tau) + + 0.00000031219 * cos(3.01094184090 + 227.52618944000 * Tau) + + 0.00000015111 * cos(0.82897064529 + 639.89728631000 * Tau) + + 0.00000009444 * cos(3.71485300870 + 21.34064100200 * Tau) + + 0.00000005690 * cos(2.41995290630 + 419.48464388000 * Tau) + + 0.00000005608 * cos(1.15607095740 + 647.01083331000 * Tau) + + 0.00000004470 * cos(1.45120818750 + 95.97922721800 * Tau) + + 0.00000004463 * cos(2.11783225180 + 440.82528488000 * Tau) + + 0.00000003229 * cos(4.09278077830 + 110.20632122000 * Tau) + + 0.00000002871 * cos(2.77203153870 + 412.37109687000 * Tau) + + 0.00000002796 * cos(3.00730249560 + 88.86568021700 * Tau) + + 0.00000002638 * cos(0.00255721254 + 853.19638175000 * Tau) + + 0.00000002574 * cos(0.39246854091 + 103.09277422000 * Tau) + + 0.00000002225 * cos(3.77689198140 + 117.31986822000 * Tau); + + L5 := 0.00000123615 * cos(2.25923345730 + 7.11354700080 * Tau) + + 0.00000034190 * cos(2.16250652690 + 14.22709400200 * Tau) + + 0.00000027546 * cos(1.19868150220 + 220.41264244000 * Tau) + + 0.00000005818 * cos(1.21584270180 + 227.52618944000 * Tau) + + 0.00000005318 * cos(0.23550400093 + 433.71173788000 * Tau) + + 0.00000003677 * cos(6.22669694360 + 426.59819088000 * Tau) + + 0.00000003057 * cos(2.97372046320 + 199.07200144000 * Tau) + + 0.00000002861 * cos(4.28710932680 + 206.18554844000 * Tau); + + Result := (L0 + L1*Tau + L2*Tau2 + L3*Tau3 + L4*Tau4 + L5*Tau5); +end; + +{---------------------------------------------------------------------------} + +function GetLatitude(Tau, Tau2, Tau3, Tau4, Tau5 : Double) : Double; +var + B0, B1, + B2, B3, + B4, B5 : Double; +begin + B0 := 0.04330678040 * cos(3.60284428400 + 213.29909544000 * Tau) + + 0.00240348303 * cos(2.85238489390 + 426.59819088000 * Tau) + + 0.00084745939 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00034116063 * cos(0.57297307844 + 206.18554844000 * Tau) + + 0.00030863357 * cos(3.48441504470 + 220.41264244000 * Tau) + + 0.00014734070 * cos(2.11846597870 + 639.89728631000 * Tau) + + 0.00009916668 * cos(5.79003189410 + 419.48464388000 * Tau) + + 0.00006993564 * cos(4.73604689180 + 7.11354700080 * Tau) + + 0.00004807587 * cos(5.43305315600 + 316.39186966000 * Tau) + + 0.00004788392 * cos(4.96512927420 + 110.20632122000 * Tau) + + 0.00003432125 * cos(2.73255752120 + 433.71173788000 * Tau) + + 0.00001506129 * cos(6.01304536140 + 103.09277422000 * Tau) + + 0.00001060298 * cos(5.63099292410 + 529.69096509000 * Tau) + + 0.00000969071 * cos(5.20434966100 + 632.78373931000 * Tau) + + 0.00000942050 * cos(1.39646678090 + 853.19638175000 * Tau) + + 0.00000707645 * cos(3.80302329550 + 323.50541666000 * Tau) + + 0.00000552313 * cos(5.13149109040 + 202.25339517000 * Tau) + + 0.00000399675 * cos(3.35891413960 + 227.52618944000 * Tau) + + 0.00000319380 * cos(3.62571550980 + 209.36694217000 * Tau) + + 0.00000316063 * cos(1.99716764200 + 647.01083331000 * Tau) + + 0.00000314225 * cos(0.46510272410 + 217.23124870000 * Tau) + + 0.00000284494 * cos(4.88648481620 + 224.34479570000 * Tau) + + 0.00000236442 * cos(2.13887472280 + 11.04570026400 * Tau) + + 0.00000215354 * cos(5.94982610100 + 846.08283475000 * Tau) + + 0.00000208522 * cos(2.12003893770 + 415.55249061000 * Tau) + + 0.00000207213 * cos(0.73021462851 + 199.07200144000 * Tau) + + 0.00000178958 * cos(2.95361514670 + 63.73589830300 * Tau) + + 0.00000140585 * cos(0.64417620299 + 490.33408918000 * Tau) + + 0.00000139240 * cos(4.59535168020 + 14.22709400200 * Tau) + + 0.00000139140 * cos(1.99821990940 + 735.87651353000 * Tau) + + 0.00000134884 * cos(5.24500819600 + 742.99006053000 * Tau) + + 0.00000121669 * cos(3.11537140880 + 522.57741809000 * Tau) + + 0.00000115524 * cos(3.10891547170 + 216.48048918000 * Tau) + + 0.00000114218 * cos(0.96261442133 + 210.11770170000 * Tau); + + B1 := 0.00397554998 * cos(5.33289992560 + 213.29909544000 * Tau) + + 0.00049478641 * cos(3.14159265360 + 0.00000000000 * Tau) + + 0.00018571607 * cos(6.09919206380 + 426.59819088000 * Tau) + + 0.00014800587 * cos(2.30586060520 + 206.18554844000 * Tau) + + 0.00009643981 * cos(1.69674660120 + 220.41264244000 * Tau) + + 0.00003757161 * cos(1.25429514020 + 419.48464388000 * Tau) + + 0.00002716647 * cos(5.91166664790 + 639.89728631000 * Tau) + + 0.00001455309 * cos(0.85161616532 + 433.71173788000 * Tau) + + 0.00001290595 * cos(2.91770857090 + 7.11354700080 * Tau) + + 0.00000852630 * cos(0.43572078997 + 316.39186966000 * Tau) + + 0.00000297726 * cos(0.91909206723 + 632.78373931000 * Tau) + + 0.00000292185 * cos(5.31574251270 + 853.19638175000 * Tau) + + 0.00000284386 * cos(1.61881754770 + 227.52618944000 * Tau) + + 0.00000275090 * cos(3.88864137340 + 103.09277422000 * Tau) + + 0.00000172359 * cos(0.05215146556 + 647.01083331000 * Tau) + + 0.00000166237 * cos(2.44351613170 + 199.07200144000 * Tau) + + 0.00000158220 * cos(5.20850125770 + 110.20632122000 * Tau) + + 0.00000127731 * cos(1.20711452530 + 529.69096509000 * Tau) + + 0.00000109839 * cos(2.45695551630 + 217.23124870000 * Tau) + + 0.00000081759 * cos(2.75839171350 + 210.11770170000 * Tau) + + 0.00000081010 * cos(2.86038377190 + 14.22709400200 * Tau) + + 0.00000068658 * cos(1.65537623150 + 202.25339517000 * Tau) + + 0.00000065161 * cos(1.25527521310 + 216.48048918000 * Tau) + + 0.00000061024 * cos(1.25273412090 + 209.36694217000 * Tau) + + 0.00000059281 * cos(1.82410768230 + 323.50541666000 * Tau) + + 0.00000046386 * cos(0.81534705304 + 440.82528488000 * Tau) + + 0.00000036163 * cos(1.81851057690 + 224.34479570000 * Tau) + + 0.00000034041 * cos(2.83971298000 + 117.31986822000 * Tau) + + 0.00000033114 * cos(1.30557080010 + 412.37109687000 * Tau) + + 0.00000032164 * cos(1.18676132340 + 846.08283475000 * Tau) + + 0.00000027282 * cos(4.64744847590 + 1066.49547720000 * Tau) + + 0.00000027128 * cos(4.44228739190 + 11.04570026400 * Tau); + + B2 := 0.00020629977 * cos(0.50482422817 + 213.29909544000 * Tau) + + 0.00003719555 * cos(3.99833475830 + 206.18554844000 * Tau) + + 0.00001627158 * cos(6.18189939500 + 220.41264244000 * Tau) + + 0.00001346067 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00000705842 * cos(3.03914308840 + 419.48464388000 * Tau) + + 0.00000365042 * cos(5.09928680710 + 426.59819088000 * Tau) + + 0.00000329632 * cos(5.27899210040 + 433.71173788000 * Tau) + + 0.00000219335 * cos(3.82841533790 + 639.89728631000 * Tau) + + 0.00000139393 * cos(1.04272623500 + 7.11354700080 * Tau) + + 0.00000103980 * cos(6.15730992970 + 227.52618944000 * Tau) + + 0.00000092961 * cos(1.97994412850 + 316.39186966000 * Tau) + + 0.00000071242 * cos(4.14754353430 + 199.07200144000 * Tau) + + 0.00000051927 * cos(2.88364833900 + 632.78373931000 * Tau) + + 0.00000048961 * cos(4.43390206740 + 647.01083331000 * Tau) + + 0.00000041373 * cos(3.15927770080 + 853.19638175000 * Tau) + + 0.00000028602 * cos(4.52978327560 + 210.11770170000 * Tau) + + 0.00000023969 * cos(1.11595912150 + 14.22709400200 * Tau) + + 0.00000020511 * cos(4.35095844200 + 217.23124870000 * Tau) + + 0.00000019532 * cos(5.30779711220 + 440.82528488000 * Tau) + + 0.00000018263 * cos(0.85391476786 + 110.20632122000 * Tau) + + 0.00000016840 * cos(5.68112084130 + 216.48048918000 * Tau) + + 0.00000015742 * cos(4.25767226300 + 103.09277422000 * Tau) + + 0.00000013613 * cos(2.99904334070 + 412.37109687000 * Tau) + + 0.00000011567 * cos(2.52679928410 + 529.69096509000 * Tau) + + 0.00000007963 * cos(3.31512423920 + 202.25339517000 * Tau) + + 0.00000006648 * cos(5.55714129950 + 209.36694217000 * Tau) + + 0.00000006599 * cos(0.28766025146 + 323.50541666000 * Tau) + + 0.00000006312 * cos(1.16121321340 + 117.31986822000 * Tau) + + 0.00000006192 * cos(3.61231886520 + 860.30992875000 * Tau); + + B3 := 0.00000666252 * cos(1.99006340180 + 213.29909544000 * Tau) + + 0.00000632350 * cos(5.69778316810 + 206.18554844000 * Tau) + + 0.00000398051 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00000187838 * cos(4.33779804810 + 220.41264244000 * Tau) + + 0.00000091884 * cos(4.84104208220 + 419.48464388000 * Tau) + + 0.00000051548 * cos(3.42149490330 + 433.71173788000 * Tau) + + 0.00000042369 * cos(2.38073239060 + 426.59819088000 * Tau) + + 0.00000025661 * cos(4.40167213110 + 227.52618944000 * Tau) + + 0.00000020551 * cos(5.85313509870 + 199.07200144000 * Tau) + + 0.00000018081 * cos(1.99321433230 + 639.89728631000 * Tau) + + 0.00000010874 * cos(5.37344546550 + 7.11354700080 * Tau) + + 0.00000009590 * cos(2.54901825870 + 647.01083331000 * Tau) + + 0.00000007085 * cos(3.45518372720 + 316.39186966000 * Tau) + + 0.00000006002 * cos(4.80055225130 + 632.78373931000 * Tau) + + 0.00000005778 * cos(0.01680378777 + 210.11770170000 * Tau) + + 0.00000005542 * cos(3.51756747770 + 440.82528488000 * Tau) + + 0.00000004881 * cos(5.63719730880 + 14.22709400200 * Tau) + + 0.00000004501 * cos(1.22424419010 + 853.19638175000 * Tau) + + 0.00000003548 * cos(4.71299370890 + 412.37109687000 * Tau) + + 0.00000002851 * cos(0.62679207578 + 103.09277422000 * Tau) + + 0.00000002173 * cos(3.71982274460 + 216.48048918000 * Tau); + + B4 := 0.00000080384 * cos(1.11918414680 + 206.18554844000 * Tau) + + 0.00000031660 * cos(3.12218745100 + 213.29909544000 * Tau) + + 0.00000017143 * cos(2.48073200410 + 220.41264244000 * Tau) + + 0.00000011844 * cos(3.14159265360 + 0.00000000000 * Tau) + + 0.00000009005 * cos(0.38441424927 + 419.48464388000 * Tau) + + 0.00000006164 * cos(1.56186379540 + 433.71173788000 * Tau) + + 0.00000004775 * cos(2.63498295490 + 227.52618944000 * Tau) + + 0.00000004660 * cos(1.28235639570 + 199.07200144000 * Tau) + + 0.00000001487 * cos(1.43096671620 + 426.59819088000 * Tau) + + 0.00000001424 * cos(0.66988083613 + 647.01083331000 * Tau) + + 0.00000001145 * cos(1.72041928130 + 440.82528488000 * Tau) + + 0.00000001075 * cos(6.18092274060 + 639.89728631000 * Tau); + + B5 := 0.00000007895 * cos(2.81927558650 + 206.18554844000 * Tau) + + 0.00000001014 * cos(0.51187210270 + 220.41264244000 * Tau); + Result := (B0 + B1*Tau + B2*Tau2 + B3*Tau3 + B4*Tau4 + B5*Tau5); +end; + +{---------------------------------------------------------------------------} + +function GetRadiusVector(Tau, Tau2, Tau3, Tau4, Tau5 : Double) : Double; +var + R0, R1, + R2, R3, + R4, R5 : Double; +begin + R0 := 9.55758135800 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.52921382465 * cos(2.39226219730 + 213.29909544000 * Tau) + + 0.01873679934 * cos(5.23549605090 + 206.18554844000 * Tau) + + 0.01464663959 * cos(1.64763045470 + 426.59819088000 * Tau) + + 0.00821891059 * cos(5.93520025370 + 316.39186966000 * Tau) + + 0.00547506899 * cos(5.01532628450 + 103.09277422000 * Tau) + + 0.00371684449 * cos(2.27114833430 + 220.41264244000 * Tau) + + 0.00361778433 * cos(3.13904303260 + 7.11354700080 * Tau) + + 0.00140617548 * cos(5.70406652990 + 632.78373931000 * Tau) + + 0.00108974737 * cos(3.29313595580 + 110.20632122000 * Tau) + + 0.00069007015 * cos(5.94099622450 + 419.48464388000 * Tau) + + 0.00061053350 * cos(0.94037761156 + 639.89728631000 * Tau) + + 0.00048913044 * cos(1.55733388470 + 202.25339517000 * Tau) + + 0.00034143794 * cos(0.19518550682 + 277.03499374000 * Tau) + + 0.00032401718 * cos(5.47084606950 + 949.17560897000 * Tau) + + 0.00020936573 * cos(0.46349163993 + 735.87651353000 * Tau) + + 0.00020839118 * cos(1.52102590640 + 433.71173788000 * Tau) + + 0.00020746678 * cos(5.33255667600 + 199.07200144000 * Tau) + + 0.00015298457 * cos(3.05943652880 + 529.69096509000 * Tau) + + 0.00014296479 * cos(2.60433537910 + 323.50541666000 * Tau) + + 0.00012884128 * cos(1.64892310390 + 138.51749687000 * Tau) + + 0.00011993314 * cos(5.98051421880 + 846.08283475000 * Tau) + + 0.00011380261 * cos(1.73105746570 + 522.57741809000 * Tau) + + 0.00009796061 * cos(5.20475864000 + 1265.56747860000 * Tau) + + 0.00007752769 * cos(5.85191318900 + 95.97922721800 * Tau) + + 0.00006770621 * cos(3.00433479280 + 14.22709400200 * Tau) + + 0.00006465967 * cos(0.17733160145 + 1052.26838320000 * Tau) + + 0.00005850443 * cos(1.45519636080 + 415.55249061000 * Tau) + + 0.00005307481 * cos(0.59737534050 + 63.73589830300 * Tau) + + 0.00004695746 * cos(2.14919036960 + 227.52618944000 * Tau) + + 0.00004043988 * cos(1.64010323860 + 209.36694217000 * Tau) + + 0.00003688132 * cos(0.78016133170 + 412.37109687000 * Tau) + + 0.00003460943 * cos(1.85088802880 + 175.16605980000 * Tau) + + 0.00003419551 * cos(4.94549148890 + 1581.95934830000 * Tau) + + 0.00003400616 * cos(0.55386747515 + 350.33211960000 * Tau) + + 0.00003376457 * cos(3.69528478830 + 224.34479570000 * Tau) + + 0.00002976033 * cos(5.68467931120 + 210.11770170000 * Tau) + + 0.00002885348 * cos(1.38764077630 + 838.96928775000 * Tau) + + 0.00002881181 * cos(0.17960757891 + 853.19638175000 * Tau) + + 0.00002507630 * cos(3.53851863260 + 742.99006053000 * Tau) + + 0.00002448325 * cos(6.18412386320 + 1368.66025280000 * Tau) + + 0.00002406138 * cos(2.96559220270 + 117.31986822000 * Tau) + + 0.00002173959 * cos(0.01508587396 + 340.77089205000 * Tau) + + 0.00002024483 * cos(5.05411271270 + 11.04570026400 * Tau); + + R1 := 0.06182981282 * cos(0.25843515034 + 213.29909544000 * Tau) + + 0.00506577574 * cos(0.71114650941 + 206.18554844000 * Tau) + + 0.00341394136 * cos(5.79635773960 + 426.59819088000 * Tau) + + 0.00188491375 * cos(0.47215719444 + 220.41264244000 * Tau) + + 0.00186261540 * cos(3.14159265360 + 0.00000000000 * Tau) + + 0.00143891176 * cos(1.40744864240 + 7.11354700080 * Tau) + + 0.00049621111 * cos(6.01744469580 + 103.09277422000 * Tau) + + 0.00020928189 * cos(5.09245654470 + 639.89728631000 * Tau) + + 0.00019952612 * cos(1.17560125010 + 419.48464388000 * Tau) + + 0.00018839639 * cos(1.60819563170 + 110.20632122000 * Tau) + + 0.00013876565 * cos(0.75886204364 + 199.07200144000 * Tau) + + 0.00012892827 * cos(5.94330258430 + 433.71173788000 * Tau) + + 0.00005396699 * cos(1.28852405910 + 14.22709400200 * Tau) + + 0.00004869308 * cos(0.86793894213 + 323.50541666000 * Tau) + + 0.00004247455 * cos(0.39299384543 + 227.52618944000 * Tau) + + 0.00003252084 * cos(1.25853470490 + 95.97922721800 * Tau) + + 0.00003081408 * cos(3.43662557420 + 522.57741809000 * Tau) + + 0.00002909411 * cos(4.60679154790 + 202.25339517000 * Tau) + + 0.00002856006 * cos(2.16731405370 + 735.87651353000 * Tau) + + 0.00001987689 * cos(2.45054204800 + 412.37109687000 * Tau) + + 0.00001941309 * cos(6.02393385140 + 209.36694217000 * Tau) + + 0.00001581446 * cos(1.29191789710 + 210.11770170000 * Tau) + + 0.00001339511 * cos(4.30801821810 + 853.19638175000 * Tau) + + 0.00001315590 * cos(1.25296446020 + 117.31986822000 * Tau) + + 0.00001203085 * cos(1.86654673790 + 316.39186966000 * Tau) + + 0.00001091088 * cos(0.07527246854 + 216.48048918000 * Tau) + + 0.00000966012 * cos(0.47991379141 + 632.78373931000 * Tau) + + 0.00000954403 * cos(5.15173410520 + 647.01083331000 * Tau) + + 0.00000897512 * cos(0.98343776092 + 529.69096509000 * Tau) + + 0.00000881827 * cos(1.88471724480 + 1052.26838320000 * Tau) + + 0.00000874215 * cos(1.40224683860 + 224.34479570000 * Tau) + + 0.00000784866 * cos(3.06377517460 + 838.96928775000 * Tau) + + 0.00000739892 * cos(1.38225356690 + 625.67019231000 * Tau) + + 0.00000658210 * cos(4.14362930980 + 309.27832266000 * Tau) + + 0.00000649600 * cos(1.72489486160 + 742.99006053000 * Tau) + + 0.00000612961 * cos(3.03307306770 + 63.73589830300 * Tau) + + 0.00000599236 * cos(2.54924174760 + 217.23124870000 * Tau) + + 0.00000502886 * cos(2.12958819480 + 3.93215326310 * Tau); + + R2 := 0.00436902464 * cos(4.78671673040 + 213.29909544000 * Tau) + + 0.00071922760 * cos(2.50069994870 + 206.18554844000 * Tau) + + 0.00049766792 * cos(4.97168150870 + 220.41264244000 * Tau) + + 0.00043220894 * cos(3.86940443790 + 426.59819088000 * Tau) + + 0.00029645554 * cos(5.96310264280 + 7.11354700080 * Tau) + + 0.00004720909 * cos(2.47527992420 + 199.07200144000 * Tau) + + 0.00004141650 * cos(4.10670940820 + 433.71173788000 * Tau) + + 0.00003789370 * cos(3.09771025070 + 639.89728631000 * Tau) + + 0.00002963990 * cos(1.37206248850 + 103.09277422000 * Tau) + + 0.00002556363 * cos(2.85065721530 + 419.48464388000 * Tau) + + 0.00002326801 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00002208457 * cos(6.27588858710 + 110.20632122000 * Tau) + + 0.00002187621 * cos(5.85545832220 + 14.22709400200 * Tau) + + 0.00001956896 * cos(4.92448618040 + 227.52618944000 * Tau) + + 0.00000923840 * cos(5.46392422740 + 323.50541666000 * Tau) + + 0.00000705936 * cos(2.97081280100 + 95.97922721800 * Tau) + + 0.00000546115 * cos(4.12854181520 + 412.37109687000 * Tau) + + 0.00000431485 * cos(5.17825414610 + 522.57741809000 * Tau) + + 0.00000405018 * cos(4.17294157870 + 209.36694217000 * Tau) + + 0.00000390627 * cos(4.48106176890 + 216.48048918000 * Tau) + + 0.00000373838 * cos(5.83435991810 + 117.31986822000 * Tau) + + 0.00000360882 * cos(3.27703082370 + 647.01083331000 * Tau) + + 0.00000356350 * cos(3.19152043940 + 210.11770170000 * Tau) + + 0.00000325598 * cos(2.26867601660 + 853.19638175000 * Tau) + + 0.00000206854 * cos(4.02188336740 + 735.87651353000 * Tau) + + 0.00000204494 * cos(0.08774848590 + 202.25339517000 * Tau) + + 0.00000180143 * cos(3.59704903950 + 632.78373931000 * Tau) + + 0.00000178474 * cos(4.09716541450 + 440.82528488000 * Tau) + + 0.00000153656 * cos(3.13470530380 + 625.67019231000 * Tau) + + 0.00000147779 * cos(0.13614300541 + 302.16477566000 * Tau) + + 0.00000133076 * cos(2.59350469420 + 191.95845444000 * Tau) + + 0.00000131975 * cos(5.93293968940 + 309.27832266000 * Tau); + + R3 := 0.00020315005 * cos(3.02186626040 + 213.29909544000 * Tau) + + 0.00008923581 * cos(3.19144205750 + 220.41264244000 * Tau) + + 0.00006908677 * cos(4.35174889350 + 206.18554844000 * Tau) + + 0.00004087129 * cos(4.22406927380 + 7.11354700080 * Tau) + + 0.00003879041 * cos(2.01056445990 + 426.59819088000 * Tau) + + 0.00001070788 * cos(4.20360341240 + 199.07200144000 * Tau) + + 0.00000907332 * cos(2.28344368030 + 433.71173788000 * Tau) + + 0.00000606121 * cos(3.17458570530 + 227.52618944000 * Tau) + + 0.00000596639 * cos(4.13455753350 + 14.22709400200 * Tau) + + 0.00000483181 * cos(1.17345973260 + 639.89728631000 * Tau) + + 0.00000393174 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00000229472 * cos(4.69838526380 + 419.48464388000 * Tau) + + 0.00000188250 * cos(4.59003889010 + 110.20632122000 * Tau) + + 0.00000149508 * cos(3.20199444400 + 103.09277422000 * Tau) + + 0.00000121442 * cos(3.76831374100 + 323.50541666000 * Tau) + + 0.00000102146 * cos(4.70974422800 + 95.97922721800 * Tau) + + 0.00000101215 * cos(5.81884137750 + 412.37109687000 * Tau) + + 0.00000093078 * cos(1.43531270910 + 647.01083331000 * Tau) + + 0.00000084347 * cos(2.63462379690 + 216.48048918000 * Tau) + + 0.00000072601 * cos(4.15395598510 + 117.31986822000 * Tau) + + 0.00000062198 * cos(2.31239345500 + 440.82528488000 * Tau) + + 0.00000054829 * cos(0.30526468471 + 853.19638175000 * Tau) + + 0.00000049536 * cos(2.38854232910 + 209.36694217000 * Tau) + + 0.00000045145 * cos(4.37317047300 + 191.95845444000 * Tau) + + 0.00000040671 * cos(0.68845183210 + 522.57741809000 * Tau) + + 0.00000040498 * cos(1.83836569760 + 302.16477566000 * Tau) + + 0.00000038089 * cos(5.94455115520 + 88.86568021700 * Tau) + + 0.00000032243 * cos(4.01146349390 + 21.34064100200 * Tau); + + R4 := 0.00001202050 * cos(1.41499446470 + 220.41264244000 * Tau) + + 0.00000707796 * cos(1.16153570100 + 213.29909544000 * Tau) + + 0.00000516121 * cos(6.23973568330 + 206.18554844000 * Tau) + + 0.00000426664 * cos(2.46924890290 + 7.11354700080 * Tau) + + 0.00000267736 * cos(0.18659206741 + 426.59819088000 * Tau) + + 0.00000170171 * cos(5.95926972380 + 199.07200144000 * Tau) + + 0.00000150339 * cos(0.47970167140 + 433.71173788000 * Tau) + + 0.00000145113 * cos(1.44211060140 + 227.52618944000 * Tau) + + 0.00000121033 * cos(2.40527320820 + 14.22709400200 * Tau) + + 0.00000047332 * cos(5.56857488680 + 639.89728631000 * Tau) + + 0.00000018954 * cos(5.85626429120 + 647.01083331000 * Tau) + + 0.00000016668 * cos(0.52920774279 + 440.82528488000 * Tau) + + 0.00000015745 * cos(2.90112466280 + 110.20632122000 * Tau) + + 0.00000014724 * cos(0.29905316786 + 419.48464388000 * Tau) + + 0.00000014074 * cos(1.30343550660 + 412.37109687000 * Tau) + + 0.00000012708 * cos(2.09349305930 + 323.50541666000 * Tau) + + 0.00000011320 * cos(0.21785507019 + 95.97922721800 * Tau) + + 0.00000011133 * cos(2.46304825990 + 117.31986822000 * Tau) + + 0.00000009552 * cos(3.14159265360 + 0.00000000000 * Tau) + + 0.00000009246 * cos(1.56496312830 + 88.86568021700 * Tau) + + 0.00000009233 * cos(2.28127318070 + 21.34064100200 * Tau) + + 0.00000008970 * cos(0.68301278041 + 216.48048918000 * Tau) + + 0.00000008360 * cos(1.27239488460 + 234.63973644000 * Tau); + + R5 := 0.00000128612 * cos(5.91282565140 + 220.41264244000 * Tau) + + 0.00000032273 * cos(0.69256228602 + 7.11354700080 * Tau) + + 0.00000026698 * cos(5.91428528630 + 227.52618944000 * Tau) + + 0.00000020223 * cos(4.95136801770 + 433.71173788000 * Tau) + + 0.00000019923 * cos(0.67370653385 + 14.22709400200 * Tau) + + 0.00000014097 * cos(2.67074280190 + 206.18554844000 * Tau) + + 0.00000013537 * cos(1.45669521410 + 199.07200144000 * Tau) + + 0.00000013364 * cos(4.58826996370 + 426.59819088000 * Tau) + + 0.00000007257 * cos(4.62966127160 + 213.29909544000 * Tau) + + 0.00000004876 * cos(3.61448275000 + 639.89728631000 * Tau) + + 0.00000003759 * cos(4.89624165040 + 440.82528488000 * Tau) + + 0.00000003303 * cos(4.07190859540 + 647.01083331000 * Tau) + + 0.00000003136 * cos(4.65661021910 + 191.95845444000 * Tau) + + 0.00000002917 * cos(0.48665273315 + 323.50541666000 * Tau) + + 0.00000002883 * cos(3.18003019200 + 419.48464388000 * Tau) + + 0.00000002338 * cos(3.69553554330 + 88.86568021700 * Tau) + + 0.00000002052 * cos(3.31663577370 + 95.97922721800 * Tau) + + 0.00000002028 * cos(0.56025552769 + 117.31986822000 * Tau); + Result := (R0 + R1*Tau + R2*Tau2 + R3*Tau3 + R4*Tau4 + R5*Tau5); +end; + +{---------------------------------------------------------------------------} + +function ComputeSaturn(JD : Double) : TStEclipticalCord; +var + Tau, + Tau2, + Tau3, + Tau4, + Tau5 : Double; +begin + Tau := (JD - 2451545.0) / 365250.0; + Tau2 := sqr(Tau); + Tau3 := Tau * Tau2; + Tau4 := sqr(Tau2); + Tau5 := Tau2 * Tau3; + + Result.L0 := GetLongitude(Tau, Tau2, Tau3, Tau4, Tau5); + Result.B0 := GetLatitude(Tau, Tau2, Tau3, Tau4, Tau5); + Result.R0 := GetRadiusVector(Tau, Tau2, Tau3, Tau4, Tau5); +end; + + +end. diff --git a/components/systools/source/run/sturanus.pas b/components/systools/source/run/sturanus.pas new file mode 100644 index 000000000..098ed0bb5 --- /dev/null +++ b/components/systools/source/run/sturanus.pas @@ -0,0 +1,515 @@ +// Upgraded to Delphi 2009: Sebastian Zierer + +(* ***** BEGIN LICENSE BLOCK ***** + * Version: MPL 1.1 + * + * The contents of this file are subject to the Mozilla Public License Version + * 1.1 (the "License"); you may not use this file except in compliance with + * the License. You may obtain a copy of the License at + * http://www.mozilla.org/MPL/ + * + * Software distributed under the License is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License + * for the specific language governing rights and limitations under the + * License. + * + * The Original Code is TurboPower SysTools + * + * The Initial Developer of the Original Code is + * TurboPower Software + * + * Portions created by the Initial Developer are Copyright (C) 1996-2002 + * the Initial Developer. All Rights Reserved. + * + * Contributor(s): + * + * ***** END LICENSE BLOCK ***** *) + +{*********************************************************} +{* SysTools: StUranus.pas 4.04 *} +{*********************************************************} +{* SysTools: Astronomical Routines (for Uranus) *} +{*********************************************************} + +{$IFDEF FPC} + {$mode DELPHI} +{$ENDIF} + +//{$I StDefine.inc} + +unit StUranus; + +interface + +uses + StAstroP; + +function ComputeUranus(JD : Double) : TStEclipticalCord; + +implementation + +function GetLongitude(Tau, Tau2, Tau3, Tau4, Tau5 : Double) : Double; +var + L0, L1, + L2, L3, + L4, L5 : Double; +begin + L0 := 5.48129294300 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.09260408252 * cos(0.89106421530 + 74.78159856700 * Tau) + + 0.01504247826 * cos(3.62719262190 + 1.48447270830 * Tau) + + 0.00365981718 * cos(1.89962189070 + 73.29712585900 * Tau) + + 0.00272328132 * cos(3.35823710520 + 149.56319713000 * Tau) + + 0.00070328499 * cos(5.39254431990 + 63.73589830300 * Tau) + + 0.00068892609 * cos(6.09292489050 + 76.26607127600 * Tau) + + 0.00061998592 * cos(2.26952040470 + 2.96894541660 * Tau) + + 0.00061950714 * cos(2.85098907570 + 11.04570026400 * Tau) + + 0.00026468869 * cos(3.14152087890 + 71.81265315100 * Tau) + + 0.00025710505 * cos(6.11379842940 + 454.90936653000 * Tau) + + 0.00021078897 * cos(4.36059465140 + 148.07872443000 * Tau) + + 0.00017818665 * cos(1.74436982540 + 36.64856292900 * Tau) + + 0.00014613471 * cos(4.73732047980 + 3.93215326310 * Tau) + + 0.00011162535 * cos(5.82681993690 + 224.34479570000 * Tau) + + 0.00010997934 * cos(0.48865493179 + 138.51749687000 * Tau) + + 0.00009527487 * cos(2.95516893090 + 35.16409022100 * Tau) + + 0.00007545543 * cos(5.23626440670 + 109.94568879000 * Tau) + + 0.00004220170 * cos(3.23328535510 + 70.84944530400 * Tau) + + 0.00004051850 * cos(2.27754158720 + 151.04766984000 * Tau) + + 0.00003490352 * cos(5.48305567290 + 146.59425172000 * Tau) + + 0.00003354607 * cos(1.06549008890 + 4.45341812490 * Tau) + + 0.00003144093 * cos(4.75199307600 + 77.75054398400 * Tau) + + 0.00002926671 * cos(4.62903695490 + 9.56122755560 * Tau) + + 0.00002922410 * cos(5.35236743380 + 85.82729883100 * Tau) + + 0.00002272790 * cos(4.36600802760 + 70.32818044200 * Tau) + + 0.00002148599 * cos(0.60745800902 + 38.13303563800 * Tau) + + 0.00002051209 * cos(1.51773563460 + 0.11187458460 * Tau) + + 0.00001991726 * cos(4.92437290830 + 277.03499374000 * Tau) + + 0.00001666910 * cos(3.62744580850 + 380.12776796000 * Tau) + + 0.00001533223 * cos(2.58593414270 + 52.69019803900 * Tau) + + 0.00001376208 * cos(2.04281409050 + 65.22037101200 * Tau) + + 0.00001372100 * cos(4.19641615560 + 111.43016150000 * Tau) + + 0.00001284183 * cos(3.11346336880 + 202.25339517000 * Tau) + + 0.00001281641 * cos(0.54269869505 + 222.86032299000 * Tau) + + 0.00001244342 * cos(0.91612680579 + 2.44768055480 * Tau) + + 0.00001220998 * cos(0.19901396193 + 108.46121608000 * Tau) + + 0.00001150993 * cos(4.17898207050 + 33.67961751300 * Tau) + + 0.00001150416 * cos(0.93344454002 + 3.18139373770 * Tau) + + 0.00001090461 * cos(1.77501638910 + 12.53017297200 * Tau) + + 0.00001072008 * cos(0.23564502877 + 62.25142559500 * Tau) + + 0.00000946195 * cos(1.19249463070 + 127.47179661000 * Tau) + + 0.00000707875 * cos(5.18285226580 + 213.29909544000 * Tau) + + 0.00000653401 * cos(0.96586909116 + 78.71375183000 * Tau) + + 0.00000627562 * cos(0.18210181975 + 984.60033162000 * Tau) + + 0.00000606827 * cos(5.43209728950 + 529.69096509000 * Tau) + + 0.00000559370 * cos(3.35776737700 + 0.52126486180 * Tau) + + 0.00000524495 * cos(2.01276707000 + 299.12639427000 * Tau) + + 0.00000483219 * cos(2.10553990150 + 0.96320784650 * Tau) + + 0.00000471288 * cos(1.40664336450 + 184.72728736000 * Tau) + + 0.00000467211 * cos(0.41484068933 + 145.10977901000 * Tau) + + 0.00000433532 * cos(5.52142978260 + 183.24281465000 * Tau) + + 0.00000404891 * cos(5.98689011390 + 8.07675484730 * Tau) + + 0.00000398996 * cos(0.33810765436 + 415.55249061000 * Tau) + + 0.00000395614 * cos(5.87039580950 + 351.81659231000 * Tau) + + 0.00000378609 * cos(2.34975805010 + 56.62235130300 * Tau) + + 0.00000309885 * cos(5.83301304670 + 145.63104387000 * Tau) + + 0.00000300379 * cos(5.64353974150 + 22.09140052800 * Tau) + + 0.00000294172 * cos(5.83916826230 + 39.61750834600 * Tau) + + 0.00000251792 * cos(1.63696775580 + 221.37585029000 * Tau) + + 0.00000249229 * cos(4.74617120580 + 225.82926841000 * Tau) + + 0.00000239334 * cos(2.35045874710 + 137.03302416000 * Tau) + + 0.00000224097 * cos(0.51574863468 + 84.34282612300 * Tau) + + 0.00000222588 * cos(2.84309380330 + 0.26063243090 * Tau) + + 0.00000219621 * cos(1.92212987980 + 67.66805156700 * Tau) + + 0.00000216549 * cos(6.14211862700 + 5.93789083320 * Tau) + + 0.00000216480 * cos(4.77847481360 + 340.77089205000 * Tau) + + 0.00000207828 * cos(5.58020570040 + 68.84370773400 * Tau) + + 0.00000201963 * cos(1.29693040860 + 0.04818410980 * Tau) + + 0.00000199146 * cos(0.95634155010 + 152.53214255000 * Tau) + + 0.00000193652 * cos(1.88800122610 + 456.39383924000 * Tau) + + 0.00000192998 * cos(0.91616058506 + 453.42489382000 * Tau) + + 0.00000187474 * cos(1.31924326250 + 0.16005869440 * Tau) + + 0.00000181934 * cos(3.53624029240 + 79.23501669200 * Tau) + + 0.00000173145 * cos(1.53860728050 + 160.60889740000 * Tau) + + 0.00000171968 * cos(5.67952685530 + 219.89137758000 * Tau) + + 0.00000170300 * cos(3.67717520690 + 5.41662597140 * Tau) + + 0.00000168648 * cos(5.87874000880 + 18.15924726500 * Tau) + + 0.00000164588 * cos(1.42379714840 + 106.97674337000 * Tau) + + 0.00000162792 * cos(3.05029377670 + 112.91463421000 * Tau) + + 0.00000158028 * cos(0.73811997211 + 54.17467074800 * Tau) + + 0.00000146653 * cos(1.26300172260 + 59.80374504000 * Tau) + + 0.00000143058 * cos(1.29995487560 + 35.42472265200 * Tau) + + 0.00000139453 * cos(5.38597723400 + 32.19514480500 * Tau) + + 0.00000138585 * cos(4.25994786670 + 909.81873305000 * Tau) + + 0.00000123840 * cos(1.37359990340 + 7.11354700080 * Tau) + + 0.00000110163 * cos(2.02685778980 + 554.06998748000 * Tau) + + 0.00000109376 * cos(5.70581833290 + 77.96299230500 * Tau) + + 0.00000104414 * cos(5.02820888810 + 0.75075952540 * Tau) + + 0.00000103562 * cos(1.45770270250 + 24.37902238800 * Tau) + + 0.00000103277 * cos(0.68095301267 + 14.97785352700 * Tau); + + L1 := 75.02543121600 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00154458244 * cos(5.24201658070 + 74.78159856700 * Tau) + + 0.00024456413 * cos(1.71255705310 + 1.48447270830 * Tau) + + 0.00009257828 * cos(0.42844639064 + 11.04570026400 * Tau) + + 0.00008265977 * cos(1.50220035110 + 63.73589830300 * Tau) + + 0.00007841715 * cos(1.31983607250 + 149.56319713000 * Tau) + + 0.00003899105 * cos(0.46483574024 + 3.93215326310 * Tau) + + 0.00002283777 * cos(4.17367534000 + 76.26607127600 * Tau) + + 0.00001926600 * cos(0.53013080152 + 2.96894541660 * Tau) + + 0.00001232727 * cos(1.58634458240 + 70.84944530400 * Tau) + + 0.00000791206 * cos(5.43641224140 + 3.18139373770 * Tau) + + 0.00000766954 * cos(1.99555409580 + 73.29712585900 * Tau) + + 0.00000481671 * cos(2.98401996910 + 85.82729883100 * Tau) + + 0.00000449798 * cos(4.13826237510 + 138.51749687000 * Tau) + + 0.00000445600 * cos(3.72300400330 + 224.34479570000 * Tau) + + 0.00000426554 * cos(4.73126059390 + 71.81265315100 * Tau) + + 0.00000353752 * cos(2.58324496890 + 148.07872443000 * Tau) + + 0.00000347735 * cos(2.45372261290 + 9.56122755560 * Tau) + + 0.00000317084 * cos(5.57855232070 + 52.69019803900 * Tau) + + 0.00000205585 * cos(2.36263144250 + 2.44768055480 * Tau) + + 0.00000189068 * cos(4.20242881380 + 56.62235130300 * Tau) + + 0.00000183762 * cos(0.28371004654 + 151.04766984000 * Tau) + + 0.00000179920 * cos(5.68367730920 + 12.53017297200 * Tau) + + 0.00000171084 * cos(3.00060075290 + 78.71375183000 * Tau) + + 0.00000158029 * cos(2.90931969500 + 0.96320784650 * Tau) + + 0.00000154670 * cos(5.59083925610 + 4.45341812490 * Tau) + + 0.00000153515 * cos(4.65186885940 + 35.16409022100 * Tau) + + 0.00000151984 * cos(2.94217326890 + 77.75054398400 * Tau) + + 0.00000143464 * cos(2.59049246730 + 62.25142559500 * Tau) + + 0.00000121452 * cos(4.14839204920 + 127.47179661000 * Tau) + + 0.00000115546 * cos(3.73224603790 + 65.22037101200 * Tau) + + 0.00000102022 * cos(4.18754517990 + 145.63104387000 * Tau) + + 0.00000101718 * cos(6.03385875010 + 0.11187458460 * Tau) + + 0.00000088202 * cos(3.99035787990 + 18.15924726500 * Tau) + + 0.00000087549 * cos(6.15520787580 + 202.25339517000 * Tau) + + 0.00000080530 * cos(2.64124743930 + 22.09140052800 * Tau) + + 0.00000072047 * cos(6.04545933580 + 70.32818044200 * Tau) + + 0.00000068570 * cos(4.05071895260 + 77.96299230500 * Tau) + + 0.00000059173 * cos(3.70413919080 + 67.66805156700 * Tau) + + 0.00000047267 * cos(3.54312460520 + 351.81659231000 * Tau) + + 0.00000044339 * cos(5.90865821910 + 7.11354700080 * Tau) + + 0.00000042534 * cos(5.72357370900 + 5.41662597140 * Tau) + + 0.00000038544 * cos(4.91519003850 + 222.86032299000 * Tau) + + 0.00000036116 * cos(5.89964278800 + 33.67961751300 * Tau) + + 0.00000035605 * cos(3.29197259180 + 8.07675484730 * Tau) + + 0.00000035524 * cos(3.32784616140 + 71.60020483000 * Tau) + + 0.00000034996 * cos(5.08034112150 + 38.13303563800 * Tau) + + 0.00000031454 * cos(5.62015632300 + 984.60033162000 * Tau) + + 0.00000030811 * cos(5.49591403860 + 59.80374504000 * Tau) + + 0.00000030608 * cos(5.46414592600 + 160.60889740000 * Tau) + + 0.00000029866 * cos(1.65980844670 + 447.79581953000 * Tau) + + 0.00000029206 * cos(1.14722640420 + 462.02291353000 * Tau) + + 0.00000028947 * cos(4.51867390410 + 84.34282612300 * Tau) + + 0.00000026627 * cos(5.54127301040 + 131.40394987000 * Tau) + + 0.00000026605 * cos(6.14640604130 + 299.12639427000 * Tau) + + 0.00000025753 * cos(4.99362028420 + 137.03302416000 * Tau) + + 0.00000025373 * cos(5.73584678600 + 380.12776796000 * Tau); + + L2 := 0.00053033277 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00002357636 * cos(2.26014661700 + 74.78159856700 * Tau) + + 0.00000769129 * cos(4.52561041820 + 11.04570026400 * Tau) + + 0.00000551533 * cos(3.25814281020 + 63.73589830300 * Tau) + + 0.00000541532 * cos(2.27573907420 + 3.93215326310 * Tau) + + 0.00000529473 * cos(4.92348433830 + 1.48447270830 * Tau) + + 0.00000257521 * cos(3.69059216860 + 3.18139373770 * Tau) + + 0.00000238835 * cos(5.85806638400 + 149.56319713000 * Tau) + + 0.00000181904 * cos(6.21763603410 + 70.84944530400 * Tau) + + 0.00000053504 * cos(1.44225240950 + 76.26607127600 * Tau) + + 0.00000049401 * cos(6.03101301720 + 56.62235130300 * Tau) + + 0.00000044753 * cos(3.90904910520 + 2.44768055480 * Tau) + + 0.00000044530 * cos(0.81152639478 + 85.82729883100 * Tau) + + 0.00000038222 * cos(1.78467827780 + 52.69019803900 * Tau) + + 0.00000037403 * cos(4.46228598030 + 2.96894541660 * Tau) + + 0.00000033029 * cos(0.86388149962 + 9.56122755560 * Tau) + + 0.00000029423 * cos(5.09818697710 + 73.29712585900 * Tau) + + 0.00000024292 * cos(2.10702559050 + 18.15924726500 * Tau) + + 0.00000022491 * cos(5.99320728690 + 138.51749687000 * Tau) + + 0.00000022135 * cos(4.81730808580 + 78.71375183000 * Tau) + + 0.00000021392 * cos(2.39880709310 + 77.96299230500 * Tau) + + 0.00000020578 * cos(2.16918786540 + 224.34479570000 * Tau) + + 0.00000017226 * cos(2.53537183200 + 145.63104387000 * Tau) + + 0.00000016777 * cos(3.46631344090 + 12.53017297200 * Tau) + + 0.00000012012 * cos(0.01941361902 + 22.09140052800 * Tau) + + 0.00000011010 * cos(0.08496274370 + 127.47179661000 * Tau) + + 0.00000010476 * cos(5.16453084070 + 71.60020483000 * Tau) + + 0.00000010466 * cos(4.45556032590 + 62.25142559500 * Tau) + + 0.00000008668 * cos(4.25550086980 + 7.11354700080 * Tau) + + 0.00000008387 * cos(5.50115930050 + 67.66805156700 * Tau) + + 0.00000007160 * cos(1.24903906390 + 5.41662597140 * Tau) + + 0.00000006109 * cos(3.36320161280 + 447.79581953000 * Tau) + + 0.00000006087 * cos(5.44611674380 + 65.22037101200 * Tau) + + 0.00000006013 * cos(4.51836836350 + 151.04766984000 * Tau) + + 0.00000006003 * cos(5.72500086740 + 462.02291353000 * Tau); + + L3 := 0.00000120936 * cos(0.02418789918 + 74.78159856700 * Tau) + + 0.00000068064 * cos(4.12084267730 + 3.93215326310 * Tau) + + 0.00000052828 * cos(2.38964061260 + 11.04570026400 * Tau) + + 0.00000045806 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00000045300 * cos(2.04423798410 + 3.18139373770 * Tau) + + 0.00000043754 * cos(2.95965039730 + 1.48447270830 * Tau) + + 0.00000024969 * cos(4.88741307920 + 63.73589830300 * Tau) + + 0.00000021061 * cos(4.54511486860 + 70.84944530400 * Tau) + + 0.00000019897 * cos(2.31320314140 + 149.56319713000 * Tau) + + 0.00000008901 * cos(1.57548871760 + 56.62235130300 * Tau) + + 0.00000004271 * cos(0.22777319552 + 18.15924726500 * Tau) + + 0.00000003613 * cos(5.39244611310 + 76.26607127600 * Tau) + + 0.00000003572 * cos(0.95052448578 + 77.96299230500 * Tau) + + 0.00000003488 * cos(4.97622811780 + 85.82729883100 * Tau) + + 0.00000003479 * cos(4.12969359980 + 52.69019803900 * Tau) + + 0.00000002696 * cos(0.37287796344 + 78.71375183000 * Tau) + + 0.00000002328 * cos(0.85770961794 + 145.63104387000 * Tau) + + 0.00000002156 * cos(5.65647821520 + 9.56122755560 * Tau); + + L4 := 0.00000113855 * cos(3.14159265360 + 0.00000000000 * Tau) + + 0.00000005599 * cos(4.57882424420 + 74.78159856700 * Tau) + + 0.00000003203 * cos(0.34623003207 + 11.04570026400 * Tau) + + 0.00000001217 * cos(3.42199121830 + 56.62235130300 * Tau); + + L5 := 0.00000000000; + Result := (L0 + L1*Tau + L2*Tau2 + L3*Tau3 + L4*Tau4 + L5*Tau5); +end; + +{---------------------------------------------------------------------------} + +function GetLatitude(Tau, Tau2, Tau3, Tau4, Tau5 : Double) : Double; +var + B0, B1, + B2, B3, + B4, B5 : Double; +begin + B0 := 0.01346277639 * cos(2.61877810550 + 74.78159856700 * Tau) + + 0.00062341405 * cos(5.08111175860 + 149.56319713000 * Tau) + + 0.00061601203 * cos(3.14159265360 + 0.00000000000 * Tau) + + 0.00009963744 * cos(1.61603876360 + 76.26607127600 * Tau) + + 0.00009926151 * cos(0.57630387917 + 73.29712585900 * Tau) + + 0.00003259455 * cos(1.26119385960 + 224.34479570000 * Tau) + + 0.00002972318 * cos(2.24367035540 + 1.48447270830 * Tau) + + 0.00002010257 * cos(6.05550401090 + 148.07872443000 * Tau) + + 0.00001522172 * cos(0.27960386377 + 63.73589830300 * Tau) + + 0.00000924055 * cos(4.03822927850 + 151.04766984000 * Tau) + + 0.00000760624 * cos(6.14000431920 + 71.81265315100 * Tau) + + 0.00000522309 * cos(3.32085194770 + 138.51749687000 * Tau) + + 0.00000462630 * cos(0.74256727574 + 85.82729883100 * Tau) + + 0.00000436843 * cos(3.38082524320 + 529.69096509000 * Tau) + + 0.00000434625 * cos(0.34065281858 + 77.75054398400 * Tau) + + 0.00000430668 * cos(3.55445034850 + 213.29909544000 * Tau) + + 0.00000420265 * cos(5.21279984790 + 11.04570026400 * Tau) + + 0.00000244698 * cos(0.78795150326 + 2.96894541660 * Tau) + + 0.00000232649 * cos(2.25716421380 + 222.86032299000 * Tau) + + 0.00000215838 * cos(1.59121704940 + 38.13303563800 * Tau) + + 0.00000179935 * cos(3.72487952670 + 299.12639427000 * Tau) + + 0.00000174895 * cos(1.23550262210 + 146.59425172000 * Tau) + + 0.00000173667 * cos(1.93654269130 + 380.12776796000 * Tau) + + 0.00000160368 * cos(5.33635436460 + 111.43016150000 * Tau) + + 0.00000144064 * cos(5.96239326410 + 35.16409022100 * Tau) + + 0.00000116363 * cos(5.73877190010 + 70.84944530400 * Tau) + + 0.00000106441 * cos(0.94103112994 + 70.32818044200 * Tau) + + 0.00000102049 * cos(2.61876256510 + 78.71375183000 * Tau); + + B1 := 0.00206366162 * cos(4.12394311410 + 74.78159856700 * Tau) + + 0.00008563230 * cos(0.33819986165 + 149.56319713000 * Tau) + + 0.00001725703 * cos(2.12193159900 + 73.29712585900 * Tau) + + 0.00001374449 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00001368860 * cos(3.06861722050 + 76.26607127600 * Tau) + + 0.00000450639 * cos(3.77656180980 + 1.48447270830 * Tau) + + 0.00000399847 * cos(2.84767037790 + 224.34479570000 * Tau) + + 0.00000307214 * cos(1.25456766740 + 148.07872443000 * Tau) + + 0.00000154336 * cos(3.78575467750 + 63.73589830300 * Tau) + + 0.00000112432 * cos(5.57299891500 + 151.04766984000 * Tau) + + 0.00000110888 * cos(5.32888676460 + 138.51749687000 * Tau) + + 0.00000083493 * cos(3.59152795560 + 71.81265315100 * Tau) + + 0.00000055573 * cos(3.40135416350 + 85.82729883100 * Tau) + + 0.00000053690 * cos(1.70455769940 + 77.75054398400 * Tau) + + 0.00000041912 * cos(1.21476607430 + 11.04570026400 * Tau) + + 0.00000041377 * cos(4.45476669140 + 78.71375183000 * Tau) + + 0.00000031959 * cos(3.77446207750 + 222.86032299000 * Tau) + + 0.00000030297 * cos(2.56371683640 + 2.96894541660 * Tau) + + 0.00000026977 * cos(5.33695500290 + 213.29909544000 * Tau) + + 0.00000026222 * cos(0.41620628369 + 380.12776796000 * Tau); + + B2 := 0.00009211656 * cos(5.80044305790 + 74.78159856700 * Tau) + + 0.00000556926 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00000286265 * cos(2.17729776350 + 149.56319713000 * Tau) + + 0.00000094969 * cos(3.84237569810 + 73.29712585900 * Tau) + + 0.00000045419 * cos(4.87822046060 + 76.26607127600 * Tau) + + 0.00000020107 * cos(5.46264485370 + 1.48447270830 * Tau) + + 0.00000014793 * cos(0.87983715652 + 138.51749687000 * Tau) + + 0.00000014261 * cos(2.84517742690 + 148.07872443000 * Tau) + + 0.00000013963 * cos(5.07234043990 + 63.73589830300 * Tau) + + 0.00000010122 * cos(5.00290894860 + 224.34479570000 * Tau) + + 0.00000008299 * cos(6.26655615200 + 78.71375183000 * Tau); + + B3 := 0.00000267832 * cos(1.25097888290 + 74.78159856700 * Tau) + + 0.00000011048 * cos(3.14159265360 + 0.00000000000 * Tau) + + 0.00000006154 * cos(4.00663614490 + 149.56319713000 * Tau) + + 0.00000003361 * cos(5.77804694940 + 73.29712585900 * Tau); + + B4 := 0.00000005719 * cos(2.85499529310 + 74.78159856700 * Tau); + + B5 := 0.00000000000; + Result := (B0 + B1*Tau + B2*Tau2 + B3*Tau3 + B4*Tau4 + B5*Tau5); +end; + +{---------------------------------------------------------------------------} + +function GetRadiusVector(Tau, Tau2, Tau3, Tau4, Tau5 : Double) : Double; +var + R0, R1, + R2, R3, + R4, R5 : Double; +begin + R0 := 19.21264847900 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.88784984055 * cos(5.60377526990 + 74.78159856700 * Tau) + + 0.03440835545 * cos(0.32836098991 + 73.29712585900 * Tau) + + 0.02055653495 * cos(1.78295170030 + 149.56319713000 * Tau) + + 0.00649321851 * cos(4.52247298120 + 76.26607127600 * Tau) + + 0.00602248144 * cos(3.86003820460 + 63.73589830300 * Tau) + + 0.00496404171 * cos(1.40139934720 + 454.90936653000 * Tau) + + 0.00338525522 * cos(1.58002682950 + 138.51749687000 * Tau) + + 0.00243508222 * cos(1.57086595070 + 71.81265315100 * Tau) + + 0.00190521915 * cos(1.99809364500 + 1.48447270830 * Tau) + + 0.00161858251 * cos(2.79137863470 + 148.07872443000 * Tau) + + 0.00143705902 * cos(1.38368574480 + 11.04570026400 * Tau) + + 0.00093192359 * cos(0.17437193645 + 36.64856292900 * Tau) + + 0.00089805842 * cos(3.66105366330 + 109.94568879000 * Tau) + + 0.00071424265 * cos(4.24509327400 + 224.34479570000 * Tau) + + 0.00046677322 * cos(1.39976563940 + 35.16409022100 * Tau) + + 0.00039025681 * cos(3.36234710690 + 277.03499374000 * Tau) + + 0.00039009624 * cos(1.66971128870 + 70.84944530400 * Tau) + + 0.00036755160 * cos(3.88648934740 + 146.59425172000 * Tau) + + 0.00030348875 * cos(0.70100446346 + 151.04766984000 * Tau) + + 0.00029156264 * cos(3.18056174560 + 77.75054398400 * Tau) + + 0.00025785805 * cos(3.78537741500 + 85.82729883100 * Tau) + + 0.00025620360 * cos(5.25656292800 + 380.12776796000 * Tau) + + 0.00022637152 * cos(0.72519137745 + 529.69096509000 * Tau) + + 0.00020473163 * cos(2.79639811630 + 70.32818044200 * Tau) + + 0.00020471584 * cos(1.55588961500 + 202.25339517000 * Tau) + + 0.00017900561 * cos(0.55455488605 + 2.96894541660 * Tau) + + 0.00015502809 * cos(5.35405037600 + 38.13303563800 * Tau) + + 0.00014701566 * cos(4.90434406650 + 108.46121608000 * Tau) + + 0.00012896507 * cos(2.62154018240 + 111.43016150000 * Tau) + + 0.00012328151 * cos(5.96039150920 + 127.47179661000 * Tau) + + 0.00011959355 * cos(1.75044072170 + 984.60033162000 * Tau) + + 0.00011852996 * cos(0.99342814582 + 52.69019803900 * Tau) + + 0.00011696085 * cos(3.29825599110 + 3.93215326310 * Tau) + + 0.00011494701 * cos(0.43774027872 + 65.22037101200 * Tau) + + 0.00010792699 * cos(1.42104858470 + 213.29909544000 * Tau) + + 0.00009111446 * cos(4.99638600050 + 62.25142559500 * Tau) + + 0.00008420550 * cos(5.25350716620 + 222.86032299000 * Tau) + + 0.00008402147 * cos(5.03877516490 + 415.55249061000 * Tau) + + 0.00007449125 * cos(0.79491905956 + 351.81659231000 * Tau) + + 0.00007329454 * cos(3.97277527840 + 183.24281465000 * Tau) + + 0.00006046370 * cos(5.67960948360 + 78.71375183000 * Tau) + + 0.00005524133 * cos(3.11499484160 + 9.56122755560 * Tau) + + 0.00005444878 * cos(5.10575635360 + 145.10977901000 * Tau) + + 0.00005238103 * cos(2.62960141800 + 33.67961751300 * Tau) + + 0.00004079167 * cos(3.22064788670 + 340.77089205000 * Tau) + + 0.00003919476 * cos(4.25015288870 + 39.61750834600 * Tau) + + 0.00003801606 * cos(6.10985558500 + 184.72728736000 * Tau) + + 0.00003781219 * cos(3.45840272870 + 456.39383924000 * Tau) + + 0.00003686787 * cos(2.48718116540 + 453.42489382000 * Tau) + + 0.00003101743 * cos(4.14031063900 + 219.89137758000 * Tau) + + 0.00002962641 * cos(0.82977991995 + 56.62235130300 * Tau) + + 0.00002942239 * cos(0.42393808854 + 299.12639427000 * Tau) + + 0.00002940492 * cos(2.14637460320 + 137.03302416000 * Tau) + + 0.00002937799 * cos(3.67657450930 + 140.00196958000 * Tau) + + 0.00002865128 * cos(0.30996903761 + 12.53017297200 * Tau) + + 0.00002538032 * cos(4.85457831990 + 131.40394987000 * Tau) + + 0.00002363550 * cos(0.44253328372 + 554.06998748000 * Tau) + + 0.00002182572 * cos(2.94040431640 + 305.34616939000 * Tau); + + R1 := 0.01479896370 * cos(3.67205705320 + 74.78159856700 * Tau) + + 0.00071212085 * cos(6.22601006670 + 63.73589830300 * Tau) + + 0.00068626972 * cos(6.13411265050 + 149.56319713000 * Tau) + + 0.00024059649 * cos(3.14159265360 + 0.00000000000 * Tau) + + 0.00021468152 * cos(2.60176704270 + 76.26607127600 * Tau) + + 0.00020857262 * cos(5.24625494220 + 11.04570026400 * Tau) + + 0.00011405346 * cos(0.01848461561 + 70.84944530400 * Tau) + + 0.00007496775 * cos(0.42360033283 + 73.29712585900 * Tau) + + 0.00004243800 * cos(1.41692350370 + 85.82729883100 * Tau) + + 0.00003926694 * cos(3.15513991320 + 71.81265315100 * Tau) + + 0.00003578446 * cos(2.31160668310 + 224.34479570000 * Tau) + + 0.00003505936 * cos(2.58354048850 + 138.51749687000 * Tau) + + 0.00003228835 * cos(5.25499602900 + 3.93215326310 * Tau) + + 0.00003060010 * cos(0.15321893225 + 1.48447270830 * Tau) + + 0.00002564251 * cos(0.98076846352 + 148.07872443000 * Tau) + + 0.00002429445 * cos(3.99440122470 + 52.69019803900 * Tau) + + 0.00001644719 * cos(2.65349313120 + 127.47179661000 * Tau) + + 0.00001583766 * cos(1.43045619200 + 78.71375183000 * Tau) + + 0.00001508028 * cos(5.05996325430 + 151.04766984000 * Tau) + + 0.00001489525 * cos(2.67559167320 + 56.62235130300 * Tau) + + 0.00001413112 * cos(4.57461892060 + 202.25339517000 * Tau) + + 0.00001403237 * cos(1.36985349740 + 77.75054398400 * Tau) + + 0.00001228220 * cos(1.04703640150 + 62.25142559500 * Tau) + + 0.00001032731 * cos(0.26459059027 + 131.40394987000 * Tau) + + 0.00000992085 * cos(2.17168865910 + 65.22037101200 * Tau) + + 0.00000861867 * cos(5.05530802220 + 351.81659231000 * Tau) + + 0.00000744445 * cos(3.07640148940 + 35.16409022100 * Tau) + + 0.00000687470 * cos(2.49912565670 + 77.96299230500 * Tau) + + 0.00000646851 * cos(4.47290422910 + 70.32818044200 * Tau) + + 0.00000623602 * cos(0.86253073820 + 9.56122755560 * Tau) + + 0.00000604362 * cos(0.90717667985 + 984.60033162000 * Tau) + + 0.00000574710 * cos(3.23070708460 + 447.79581953000 * Tau) + + 0.00000561839 * cos(2.71778158980 + 462.02291353000 * Tau) + + 0.00000530364 * cos(5.91655309050 + 213.29909544000 * Tau) + + 0.00000527794 * cos(5.15136007080 + 2.96894541660 * Tau); + + R2 := 0.00022439904 * cos(0.69953118760 + 74.78159856700 * Tau) + + 0.00004727037 * cos(1.69901641490 + 63.73589830300 * Tau) + + 0.00001681903 * cos(4.64833551730 + 70.84944530400 * Tau) + + 0.00001649559 * cos(3.09660078980 + 11.04570026400 * Tau) + + 0.00001433755 * cos(3.52119917950 + 149.56319713000 * Tau) + + 0.00000770188 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00000500429 * cos(6.17229032220 + 76.26607127600 * Tau) + + 0.00000461009 * cos(0.76676632849 + 3.93215326310 * Tau) + + 0.00000390371 * cos(4.49605283500 + 56.62235130300 * Tau) + + 0.00000389945 * cos(5.52673426380 + 85.82729883100 * Tau) + + 0.00000292097 * cos(0.20389012095 + 52.69019803900 * Tau) + + 0.00000286579 * cos(3.53357683270 + 73.29712585900 * Tau) + + 0.00000272898 * cos(3.84707823650 + 138.51749687000 * Tau) + + 0.00000219674 * cos(1.96418942890 + 131.40394987000 * Tau) + + 0.00000215788 * cos(0.84812474187 + 77.96299230500 * Tau) + + 0.00000205449 * cos(3.24758017120 + 78.71375183000 * Tau) + + 0.00000148554 * cos(4.89840863840 + 127.47179661000 * Tau) + + 0.00000128834 * cos(2.08146849520 + 3.18139373770 * Tau); + + R3 := 0.00001164382 * cos(4.73453291600 + 74.78159856700 * Tau) + + 0.00000212367 * cos(3.34255735000 + 63.73589830300 * Tau) + + 0.00000196408 * cos(2.98004616320 + 70.84944530400 * Tau) + + 0.00000104527 * cos(0.95807937648 + 11.04570026400 * Tau) + + 0.00000072540 * cos(0.99701907912 + 149.56319713000 * Tau) + + 0.00000071681 * cos(0.02528455665 + 56.62235130300 * Tau) + + 0.00000054875 * cos(2.59436811270 + 3.93215326310 * Tau) + + 0.00000036377 * cos(5.65035573020 + 77.96299230500 * Tau) + + 0.00000034029 * cos(3.81553325640 + 76.26607127600 * Tau) + + 0.00000032081 * cos(3.59825177840 + 131.40394987000 * Tau); + + R4 := 0.00000052996 * cos(3.00838033090 + 74.78159856700 * Tau) + + 0.00000009887 * cos(1.91399083600 + 56.62235130300 * Tau); + + R5 := 0.00000000000; + Result := (R0 + R1*Tau + R2*Tau2 + R3*Tau3 + R4*Tau4 + R5*Tau5); +end; + +{---------------------------------------------------------------------------} + +function ComputeUranus(JD : Double) : TStEclipticalCord; +var + Tau, + Tau2, + Tau3, + Tau4, + Tau5 : Double; +begin + Tau := (JD - 2451545.0) / 365250.0; + Tau2 := sqr(Tau); + Tau3 := Tau * Tau2; + Tau4 := sqr(Tau2); + Tau5 := Tau2 * Tau3; + + Result.L0 := GetLongitude(Tau, Tau2, Tau3, Tau4, Tau5); + Result.B0 := GetLatitude(Tau, Tau2, Tau3, Tau4, Tau5); + Result.R0 := GetRadiusVector(Tau, Tau2, Tau3, Tau4, Tau5); +end; + + +end. diff --git a/components/systools/source/run/stvenus.pas b/components/systools/source/run/stvenus.pas new file mode 100644 index 000000000..45472ae3f --- /dev/null +++ b/components/systools/source/run/stvenus.pas @@ -0,0 +1,222 @@ +// Upgraded to Delphi 2009: Sebastian Zierer + +(* ***** BEGIN LICENSE BLOCK ***** + * Version: MPL 1.1 + * + * The contents of this file are subject to the Mozilla Public License Version + * 1.1 (the "License"); you may not use this file except in compliance with + * the License. You may obtain a copy of the License at + * http://www.mozilla.org/MPL/ + * + * Software distributed under the License is distributed on an "AS IS" basis, + * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License + * for the specific language governing rights and limitations under the + * License. + * + * The Original Code is TurboPower SysTools + * + * The Initial Developer of the Original Code is + * TurboPower Software + * + * Portions created by the Initial Developer are Copyright (C) 1996-2002 + * the Initial Developer. All Rights Reserved. + * + * Contributor(s): + * + * ***** END LICENSE BLOCK ***** *) + +{*********************************************************} +{* SysTools: StVenus.pas 4.04 *} +{*********************************************************} +{* SysTools: Astronomical Routines (for Venus) *} +{*********************************************************} + +{$IFDEF FPC} + {$mode DELPHI} +{$ENDIF} + +{$I StDefine.inc} + +unit StVenus; + +interface + +uses + StAstroP; + +function ComputeVenus(JD : Double) : TStEclipticalCord; + + +implementation + +function GetLongitude(Tau, Tau2, Tau3, Tau4, Tau5 : Double) : Double; +var + L0, L1, + L2, L3, + L4, L5 : Double; +begin + L0 := 3.17614666770 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.01353968419 * cos(5.59313319620 + 10213.28554600000 * Tau) + + 0.00089891645 * cos(5.30650048470 + 20426.57109200000 * Tau) + + 0.00005477201 * cos(4.41630652530 + 7860.41939240000 * Tau) + + 0.00003455732 * cos(2.69964470780 + 11790.62908900000 * Tau) + + 0.00002372061 * cos(2.99377539570 + 3930.20969620000 * Tau) + + 0.00001664069 * cos(4.25018935030 + 1577.34354240000 * Tau) + + 0.00001438322 * cos(4.15745043960 + 9683.59458110000 * Tau) + + 0.00001317108 * cos(5.18668219090 + 26.29831980000 * Tau) + + 0.00001200521 * cos(6.15357115320 + 30639.85663900000 * Tau) + + 0.00000769314 * cos(0.81629615911 + 9437.76293490000 * Tau) + + 0.00000761380 * cos(1.95014702120 + 529.69096509000 * Tau) + + 0.00000707676 * cos(1.06466707210 + 775.52261132000 * Tau) + + 0.00000584836 * cos(3.99839884760 + 191.44826611000 * Tau) + + 0.00000499915 * cos(4.12340210070 + 15720.83878500000 * Tau) + + 0.00000429498 * cos(3.58642859750 + 19367.18916200000 * Tau) + + 0.00000326967 * cos(5.67736583710 + 5507.55323870000 * Tau) + + 0.00000326221 * cos(4.59056473100 + 10404.73381200000 * Tau) + + 0.00000231937 * cos(3.16251057070 + 9153.90361600000 * Tau) + + 0.00000179695 * cos(4.65337915580 + 1109.37855210000 * Tau) + + 0.00000155464 * cos(5.57043888950 + 19651.04848100000 * Tau) + + 0.00000128263 * cos(4.22604493740 + 20.77539549200 * Tau) + + 0.00000127907 * cos(0.96209822685 + 5661.33204920000 * Tau) + + 0.00000105547 * cos(1.53721191250 + 801.82093112000 * Tau); + + L1 := 10213.52943100000 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00095707712 * cos(2.46424448980 + 10213.28554600000 * Tau) + + 0.00014444977 * cos(0.51624564679 + 20426.57109200000 * Tau) + + 0.00000213374 * cos(1.79547929370 + 30639.85663900000 * Tau) + + 0.00000173904 * cos(2.65535879440 + 26.29831980000 * Tau) + + 0.00000151669 * cos(6.10635282370 + 1577.34354240000 * Tau) + + 0.00000082233 * cos(5.70234133730 + 191.44826611000 * Tau) + + 0.00000069734 * cos(2.68136034980 + 9437.76293490000 * Tau) + + 0.00000052408 * cos(3.60013087660 + 775.52261132000 * Tau) + + 0.00000038318 * cos(1.03379038030 + 529.69096509000 * Tau) + + 0.00000029633 * cos(1.25056322350 + 5507.55323870000 * Tau) + + 0.00000025056 * cos(6.10664792860 + 10404.73381200000 * Tau); + + L2 := + + 0.00054127076 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00003891460 * cos(0.34514360047 + 10213.28554600000 * Tau) + + 0.00001337880 * cos(2.02011286080 + 20426.57109200000 * Tau) + + 0.00000023836 * cos(2.04592119010 + 26.29831980000 * Tau) + + 0.00000019331 * cos(3.53527371460 + 30639.85663900000 * Tau) + + 0.00000009984 * cos(3.97130221100 + 775.52261132000 * Tau) + + 0.00000007046 * cos(1.51962593410 + 1577.34354240000 * Tau) + + 0.00000006014 * cos(0.99926757893 + 191.44826611000 * Tau); + + L3 := + + 0.00000135742 * cos(4.80389020990 + 10213.28554600000 * Tau) + + 0.00000077846 * cos(3.66876371590 + 20426.57109200000 * Tau) + + 0.00000026023 * cos(0.00000000000 + 0.00000000000 * Tau); + + L4 := + + 0.00000114016 * cos(3.14159265360 + 0.00000000000 * Tau) + + 0.00000003209 * cos(5.20514170160 + 20426.57109200000 * Tau) + + 0.00000001714 * cos(2.51099591710 + 10213.28554600000 * Tau); + + L5 := 0.00000000874 * cos(3.14159265360 + 0.00000000000 * Tau); + Result := (L0 + L1*Tau + L2*Tau2 + L3*Tau3 + L4*Tau4 + L5*Tau5); +end; + +{-------------------------------------------------------------------------} + +function GetLatitude(Tau, Tau2, Tau3, Tau4, Tau5 : Double) : Double; +var + B0, B1, + B2, B3, + B4, B5 : Double; +begin + B0 := 0.05923638472 * cos(0.26702775813 + 10213.28554600000 * Tau) + + 0.00040107978 * cos(1.14737178110 + 20426.57109200000 * Tau) + + 0.00032814918 * cos(3.14159265360 + 0.00000000000 * Tau) + + 0.00001011392 * cos(1.08946123020 + 30639.85663900000 * Tau) + + 0.00000149458 * cos(6.25390296070 + 18073.70493900000 * Tau) + + 0.00000137788 * cos(0.86020146523 + 1577.34354240000 * Tau) + + 0.00000129973 * cos(3.67152483650 + 9437.76293490000 * Tau) + + 0.00000119507 * cos(3.70468812800 + 2352.86615380000 * Tau) + + 0.00000107971 * cos(4.53903677650 + 22003.91463500000 * Tau); + + B1 := 0.00513347602 * cos(1.80364310800 + 10213.28554600000 * Tau) + + 0.00004380100 * cos(3.38615711590 + 20426.57109200000 * Tau) + + 0.00000199162 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00000196586 * cos(2.53001197490 + 30639.85663900000 * Tau); + + B2 := 0.00022377665 * cos(3.38509143880 + 10213.28554600000 * Tau) + + 0.00000281739 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00000173164 * cos(5.25563766920 + 20426.57109200000 * Tau) + + 0.00000026945 * cos(3.87040891570 + 30639.85663900000 * Tau); + + B3 := 0.00000646671 * cos(4.99166565280 + 10213.28554600000 * Tau) + + 0.00000019952 * cos(3.14159265360 + 0.00000000000 * Tau) + + 0.00000005540 * cos(0.77376923951 + 20426.57109200000 * Tau) + + 0.00000002526 * cos(5.44493763020 + 30639.85663900000 * Tau); + + B4 := 0.00000014102 * cos(0.31537190181 + 10213.28554600000 * Tau); + + B5 := 0.00000000000; + Result := (B0 + B1*Tau + B2*Tau2 + B3*Tau3 + B4*Tau4 + B5*Tau5); +end; + +{-------------------------------------------------------------------------} + +function GetRadiusVector(Tau, Tau2, Tau3, Tau4, Tau5 : Double) : Double; +var + R0, R1, + R2, R3, + R4, R5 : Double; +begin + R0 := 0.72334820905 * cos(0.00000000000 + 0.00000000000 * Tau) + + 0.00489824185 * cos(4.02151832270 + 10213.28554600000 * Tau) + + 0.00001658058 * cos(4.90206728010 + 20426.57109200000 * Tau) + + 0.00001632093 * cos(2.84548851890 + 7860.41939240000 * Tau) + + 0.00001378048 * cos(1.12846590600 + 11790.62908900000 * Tau) + + 0.00000498399 * cos(2.58682187720 + 9683.59458110000 * Tau) + + 0.00000373958 * cos(1.42314837060 + 3930.20969620000 * Tau) + + 0.00000263616 * cos(5.52938185920 + 9437.76293490000 * Tau) + + 0.00000237455 * cos(2.55135903980 + 15720.83878500000 * Tau) + + 0.00000221983 * cos(2.01346776770 + 19367.18916200000 * Tau) + + 0.00000125896 * cos(2.72769833560 + 1577.34354240000 * Tau) + + 0.00000119467 * cos(3.01975365260 + 10404.73381200000 * Tau); + + R1 := + + 0.00034551039 * cos(0.89198710598 + 10213.28554600000 * Tau) + + 0.00000234203 * cos(1.77224942710 + 20426.57109200000 * Tau) + + 0.00000233998 * cos(3.14159265360 + 0.00000000000 * Tau); + + R2 := + + 0.00001406587 * cos(5.06366395190 + 10213.28554600000 * Tau) + + 0.00000015529 * cos(5.47321687980 + 20426.57109200000 * Tau) + + 0.00000013059 * cos(0.00000000000 + 0.00000000000 * Tau); + + R3 := + + 0.00000049582 * cos(3.22263554520 + 10213.28554600000 * Tau); + + R4 := + + 0.00000000573 * cos(0.92229697820 + 10213.28554600000 * Tau); + + R5 := 0.00000000000; + Result := (R0 + R1*Tau + R2*Tau2 + R3*Tau3 + R4*Tau4 + R5*Tau5); +end; + +{-------------------------------------------------------------------------} + +function ComputeVenus(JD : Double) : TStEclipticalCord; +var + Tau, + Tau2, + Tau3, + Tau4, + Tau5 : Double; +begin + Tau := (JD - 2451545.0) / 365250.0; + Tau2 := sqr(Tau); + Tau3 := Tau * Tau2; + Tau4 := sqr(Tau2); + Tau5 := Tau2 * Tau3; + + Result.L0 := GetLongitude(Tau, Tau2, Tau3, Tau4, Tau5); + Result.B0 := GetLatitude(Tau, Tau2, Tau3, Tau4, Tau5); + Result.R0 := GetRadiusVector(Tau, Tau2, Tau3, Tau4, Tau5); +end; + + +end.