home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 March / Chip_2002-03_cd1.bin / zkuste / delphi / kolekce / d123456 / SIMONS.ZIP / Units / TimeFunc.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2000-11-28  |  43.7 KB  |  1,720 lines
  1. unit TimeFunc;
  2.  
  3. interface
  4.  
  5. uses
  6.   sysutils;
  7.  
  8. type
  9.   TMoonPhase=(Newmoon,FirstQuarter,Fullmoon,LastQuarter);
  10.   TSeason=(Winter,Spring,Summer,Autumn);
  11.   TEclipse=(none, partial, noncentral, circular, circulartotal, total, halfshadow);
  12.   E_NoRiseSet=class(Exception);
  13.   E_OutOfAlgorithRange=class(Exception);
  14.  
  15. function julian_date(date:TDateTime):extended;
  16.  
  17. function sun_distance(date:TDateTime): extended;
  18. function moon_distance(date:TDateTime): extended;
  19. function age_of_moon(date:TDateTime): extended;
  20.  
  21. function last_phase(date:TDateTime; phase:TMoonPhase):TDateTime;
  22. function next_phase(date:TDateTime; phase:TMoonPhase):TDateTime;
  23.  
  24. function current_phase(date:TDateTime):extended;
  25. function lunation(date:TDateTime):integer;
  26.  
  27. function sun_diameter(date:TDateTime):extended;
  28. function moon_diameter(date:TDateTime):extended;
  29.  
  30. function star_time(date:TDateTime):extended;
  31. function StartSeason(year: integer; season:TSeason):TDateTime;
  32.  
  33. function Sun_Rise(date:TDateTime; latitude, longitude:extended):TDateTime;
  34. function Sun_Set(date:TDateTime; latitude, longitude:extended):TDateTime;
  35. function Sun_Transit(date:TDateTime; latitude, longitude:extended):TDateTime;
  36. function Moon_Rise(date:TDateTime; latitude, longitude:extended):TDateTime;
  37. function Moon_Set(date:TDateTime; latitude, longitude:extended):TDateTime;
  38. function Moon_Transit(date:TDateTime; latitude, longitude:extended):TDateTime;
  39.  
  40. function nextperigee(date:TDateTime):TDateTime;
  41. function nextapogee(date:TDateTime):TDateTime;
  42.  
  43. function NextEclipse(var date:TDateTime; sun:boolean):TEclipse;
  44.  
  45. implementation
  46.  
  47. uses MyMath;
  48.  
  49. const
  50.   AU=149597869;             (* astronomical unit in km *)
  51.   mean_lunation=29.530589;  (* Mean length of a month *)
  52.   earth_radius=6378.15;     (* Radius of the earth *)
  53.  
  54. type
  55. t_coord = record
  56.   longitude, latitude, radius: extended;
  57.   rektaszension, declination: extended;
  58.   parallax: extended;
  59.   end;
  60.   T_RiseSet=(_rise,_set,_transit);
  61.  
  62. function put_in_360(x:extended):extended;
  63. begin
  64.   result:=x-round(x/360)*360;
  65.   while result<0 do result:=result+360;
  66.   end;
  67.  
  68. { Angular functions with degrees }
  69. (*@/// function sin_d(x:extended):extended; *)
  70. function sin_d(x:extended):extended;
  71. begin
  72.   sin_d:=sin(put_in_360(x)*pi/180);
  73.   end;
  74. (*@\\\000000030A*)
  75. (*@/// function cos_d(x:extended):extended; *)
  76. function cos_d(x:extended):extended;
  77. begin
  78.   cos_d:=cos(put_in_360(x)*pi/180);
  79.   end;
  80. (*@\\\0000000301*)
  81. (*@/// function tan_d(x:extended):extended; *)
  82. function tan_d(x:extended):extended;
  83. begin
  84.   tan_d:=tan(put_in_360(x)*pi/180);
  85.   end;
  86. (*@\\\000000030D*)
  87. (*@/// function arctan2_d(a,b:extended):extended; *)
  88. function arctan2_d(a,b:extended):extended;
  89. begin
  90.   result:=arctan2(a,b)*180/pi;
  91.   end;
  92. (*@\\\000000030B*)
  93. (*@/// function arcsin_d(x:extended):extended; *)
  94. function arcsin_d(x:extended):extended;
  95. begin
  96.   result:=arcsin(x)*180/pi;
  97.   end;
  98. (*@\\\0000000301*)
  99. (*@/// function arccos_d(x:extended):extended; *)
  100. function arccos_d(x:extended):extended;
  101. begin
  102.   result:=arccos(x)*180/pi;
  103.   end;
  104. (*@\\\0000000301*)
  105. (*@/// function arctan_d(x:extended):extended; *)
  106. function arctan_d(x:extended):extended;
  107. begin
  108.   result:=arctan(x)*180/pi
  109.   end;
  110. (*@\\\0000000310*)
  111.  
  112. { Julian date }
  113. (*@/// function julian_date(date:TDateTime):extended; *)
  114. function julian_date(date:TDateTime):extended;
  115. begin
  116.   if date>encodedate(1582,10,14) then
  117.     julian_date:=2451544.5-encodedate(2000,1,1)+date
  118.   else
  119.     julian_date:=0;   { not yet implemented !!! }
  120.   end;
  121. (*@\\\0000000601*)
  122. (*@/// function delphi_date(juldat:extended):TDateTime; *)
  123. function delphi_date(juldat:extended):TDateTime;
  124. begin
  125.   if juldat>=julian_date(encodedate(1582,10,15)) then begin
  126.     delphi_date:= juldat-2451544.5+encodedate(2000,1,1);
  127.     end
  128.   else
  129.     delphi_date:=0;    { not yet implemented !!! }
  130.   end;
  131. (*@\\\0000000701*)
  132.  
  133. (*@/// function star_time(date:TDateTime):extended;            // degrees *)
  134. function star_time(date:TDateTime):extended;
  135. var
  136.   jd, t: extended;
  137. begin
  138.   jd:=julian_date(date);
  139.   t:=(jd-2451545.0)/36525;
  140.   result:=put_in_360(280.46061837+360.98564736629*(jd-2451545.0)+
  141.                      t*t*(0.000387933-t/38710000));
  142.   end;
  143. (*@\\\0000000901*)
  144.  
  145. { Coordinate functions }
  146. (*@/// procedure calc_geocentric(var coord:t_coord; date:TDateTime); *)
  147. { Based upon Chapter 12 and 21 of Meeus }
  148.  
  149. procedure calc_geocentric(var coord:t_coord; date:TDateTime);
  150. (*$ifndef correction_low *)
  151. const
  152. (*@///   arg_mul:array[0..30,0..4] of shortint = (..); *)
  153. arg_mul:array[0..30,0..4] of shortint = (
  154.    ( 0, 0, 0, 0, 1),
  155.    (-2, 0, 0, 2, 2),
  156.    ( 0, 0, 0, 2, 2),
  157.    ( 0, 0, 0, 0, 2),
  158.    ( 0, 1, 0, 0, 0),
  159.    ( 0, 0, 1, 0, 0),
  160.    (-2, 1, 0, 2, 2),
  161.    ( 0, 0, 0, 2, 1),
  162.    ( 0, 0, 1, 2, 2),
  163.    (-2,-1, 0, 2, 2),
  164.    (-2, 0, 1, 0, 0),
  165.    (-2, 0, 0, 2, 1),
  166.    ( 0, 0,-1, 2, 2),
  167.    ( 2, 0, 0, 0, 0),
  168.    ( 0, 0, 1, 0, 1),
  169.    ( 2, 0,-1, 2, 2),
  170.    ( 0, 0,-1, 0, 1),
  171.    ( 0, 0, 1, 2, 1),
  172.    (-2, 0, 2, 0, 0),
  173.    ( 0, 0,-2, 2, 1),
  174.    ( 2, 0, 0, 2, 2),
  175.    ( 0, 0, 2, 2, 2),
  176.    ( 0, 0, 2, 0, 0),
  177.    (-2, 0, 1, 2, 2),
  178.    ( 0, 0, 0, 2, 0),
  179.    (-2, 0, 0, 2, 0),
  180.    ( 0, 0,-1, 2, 1),
  181.    ( 0, 2, 0, 0, 0),
  182.    ( 2, 0,-1, 0, 1),
  183.    (-2, 2, 0, 2, 2),
  184.    ( 0, 1, 0, 0, 1)
  185.                  );
  186. (*@\\\0000000109*)
  187. (*@///   arg_phi:array[0..30,0..1] of longint = (); *)
  188. arg_phi:array[0..30,0..1] of longint = (
  189.    (-171996,-1742),
  190.    ( -13187,  -16),
  191.    (  -2274,   -2),
  192.    (   2062,    2),
  193.    (   1426,  -34),
  194.    (    712,    1),
  195.    (   -517,   12),
  196.    (   -386,   -4),
  197.    (   -301,    0),
  198.    (    217,   -5),
  199.    (   -158,    0),
  200.    (    129,    1),
  201.    (    123,    0),
  202.    (     63,    0),
  203.    (     63,    1),
  204.    (    -59,    0),
  205.    (    -58,   -1),
  206.    (    -51,    0),
  207.    (     48,    0),
  208.    (     46,    0),
  209.    (    -38,    0),
  210.    (    -31,    0),
  211.    (     29,    0),
  212.    (     29,    0),
  213.    (     26,    0),
  214.    (    -22,    0),
  215.    (     21,    0),
  216.    (     17,   -1),
  217.    (     16,    0),
  218.    (    -16,    1),
  219.    (    -15,    0)
  220.   );
  221. (*@\\\*)
  222. (*@///   arg_eps:array[0..30,0..1] of longint = (); *)
  223. arg_eps:array[0..30,0..1] of longint = (
  224.    ( 92025,   89),
  225.    (  5736,  -31),
  226.    (   977,   -5),
  227.    (  -895,    5),
  228.    (    54,   -1),
  229.    (    -7,    0),
  230.    (   224,   -6),
  231.    (   200,    0),
  232.    (   129,   -1),
  233.    (   -95,    3),
  234.    (     0,    0),
  235.    (   -70,    0),
  236.    (   -53,    0),
  237.    (     0,    0),
  238.    (   -33,    0),
  239.    (    26,    0),
  240.    (    32,    0),
  241.    (    27,    0),
  242.    (     0,    0),
  243.    (   -24,    0),
  244.    (    16,    0),
  245.    (    13,    0),
  246.    (     0,    0),
  247.    (   -12,    0),
  248.    (     0,    0),
  249.    (     0,    0),
  250.    (   -10,    0),
  251.    (     0,    0),
  252.    (    -8,    0),
  253.    (     7,    0),
  254.    (     9,    0)
  255.   );
  256. (*@\\\*)
  257. (*$endif *)
  258. var
  259.   t,omega: extended;
  260. (*$ifdef correction_low *)
  261.   l,ls: extended;
  262. (*$else *)
  263.   d,m,ms,f,s: extended;
  264.   i: integer;
  265. (*$endif *)
  266.   epsilon,epsilon_0,delta_epsilon: extended;
  267.   delta_phi: extended;
  268.   alpha,delta: extended;
  269. begin
  270.   t:=(julian_date(date)-2451545.0)/36525;
  271.  
  272.   (* longitude of rising knot *)
  273.   omega:=put_in_360(125.04452+(-1934.136261+(0.0020708+1/450000*t)*t)*t);
  274.  
  275. (*$ifdef correction_low *)
  276. (*@///   delta_phi and delta_epsilon - low accuracy *)
  277. (* mean longitude of sun (l) and moon (ls) *)
  278. l:=280.4665+36000.7698*t;
  279. ls:=218.3165+481267.8813*t;
  280.  
  281. (* correction due to nutation *)
  282. delta_epsilon:=9.20*cos_d(omega)+0.57*cos_d(2*l)+0.10*cos_d(2*ls)-0.09*cos_d(2*omega);
  283.  
  284. (* longitude correction due to nutation *)
  285. delta_phi:=(-17.20*sin_d(omega)-1.32*sin_d(2*l)-0.23*sin_d(2*ls)+0.21*sin_d(2*omega))/3600;
  286. (*@\\\0000000401*)
  287. (*$else *)
  288. (*@///   delta_phi and delta_epsilon - higher accuracy *)
  289. (* mean elongation of moon to sun *)
  290. d:=put_in_360(297.85036+(445267.111480+(-0.0019142+t/189474)*t)*t);
  291.  
  292. (* mean anomaly of the sun *)
  293. m:=put_in_360(357.52772+(35999.050340+(-0.0001603-t/300000)*t)*t);
  294.  
  295. (* mean anomly of the moon *)
  296. ms:=put_in_360(134.96298+(477198.867398+(0.0086972+t/56250)*t)*t);
  297.  
  298. (* argument of the latitude of the moon *)
  299. f:=put_in_360(93.27191+(483202.017538+(-0.0036825+t/327270)*t)*t);
  300.  
  301. delta_phi:=0;
  302. delta_epsilon:=0;
  303.  
  304. for i:=0 to 30 do begin
  305.   s:= arg_mul[i,0]*d
  306.      +arg_mul[i,1]*m
  307.      +arg_mul[i,2]*ms
  308.      +arg_mul[i,3]*f
  309.      +arg_mul[i,4]*omega;
  310.   delta_phi:=delta_phi+(arg_phi[i,0]+arg_phi[i,1]*t*0.1)*sin_d(s);
  311.   delta_epsilon:=delta_epsilon+(arg_eps[i,0]+arg_eps[i,1]*t*0.1)*cos_d(s);
  312.   end;
  313.  
  314. delta_phi:=delta_phi*0.0001/3600;
  315. delta_epsilon:=delta_epsilon*0.0001/3600;
  316. (*@\\\0000001B01*)
  317. (*$endif *)
  318.  
  319.   (* angle of ecliptic *)
  320.   epsilon_0:=84381.448+(-46.8150+(-0.00059+0.001813*t)*t)*t;
  321.  
  322.   epsilon:=(epsilon_0+delta_epsilon)/3600;
  323.  
  324.   coord.longitude:=put_in_360(coord.longitude+delta_phi);
  325.  
  326.   (* geocentric coordinates *)
  327. {   alpha:=arctan2_d(cos_d(epsilon)*sin_d(o),cos_d(o)); }
  328. {   delta:=arcsin_d(sin_d(epsilon)*sin_d(o)); }
  329.   alpha:=arctan2_d( sin_d(coord.longitude)*cos_d(epsilon)
  330.                    -tan_d(coord.latitude)*sin_d(epsilon)
  331.                   ,cos_d(coord.longitude));
  332.   delta:=arcsin_d( sin_d(coord.latitude)*cos_d(epsilon)
  333.                   +cos_d(coord.latitude)*sin_d(epsilon)*sin_d(coord.longitude));
  334.  
  335.   coord.rektaszension:=alpha;
  336.   coord.declination:=delta;
  337.   end;
  338. (*@\\\0000000501*)
  339.  
  340. (*@/// function sun_coordinate(date:TDateTime):t_coord; *)
  341. { Based upon Chapter 24 of Meeus }
  342.  
  343. function sun_coordinate(date:TDateTime):t_coord;
  344. var
  345.   t,e,m,c,nu: extended;
  346.   l0,o,omega,lambda: extended;
  347. begin
  348.   t:=(julian_date(date)-2451545.0)/36525;
  349.  
  350.   (* geometrical mean longitude of the sun *)
  351.   l0:=280.46645+(36000.76983+0.0003032*t)*t;
  352.  
  353.   (* excentricity of the erath orbit *)
  354.   e:=0.016708617+(-0.000042037-0.0000001236*t)*t;
  355.  
  356.   (* mean anomaly of the sun *)
  357.   m:=357.52910+(35999.05030-(0.0001559+0.00000048*t)*t)*t;
  358.  
  359.   (* mean point of sun *)
  360.   c:= (1.914600+(-0.004817-0.000014*t)*t)*sin_d(m)
  361.      +(0.019993-0.000101*t)*sin_d(2*m)
  362.      +0.000290*sin_d(3*m);
  363.  
  364.   (* true longitude of the sun *)
  365.   o:=put_in_360(l0+c);
  366.  
  367.   (* true anomaly of the sun *)
  368.   nu:=m+c;
  369.  
  370.   (* distance of the sun in km *)
  371.   result.radius:=(1.000001018*(1-e*e))/(1+e*cos_d(nu))*AU;
  372.  
  373.   (* apparent longitude of the sun *)
  374.   omega:=125.04452+(-1934.136261+(0.0020708+1/450000*t)*t)*t;
  375.   lambda:=put_in_360(o-0.00569-0.00478*sin_d(omega)
  376.                      -20.4898/3600/(result.radius/AU));
  377.  
  378.   result.longitude:=lambda;
  379.   result.latitude:=0;
  380.  
  381.   calc_geocentric(result,date);
  382.   end;
  383. (*@\\\0000002715*)
  384. (*@/// function moon_coordinate(date:TDateTime):t_coord; *)
  385. { Based upon Chapter 45 of Meeus }
  386.  
  387. function moon_coordinate(date:TDateTime):t_coord;
  388. const
  389. (*@///   arg_lr:array[0..59,0..3] of shortint = (..); *)
  390. arg_lr:array[0..59,0..3] of shortint = (
  391.    ( 0, 0, 1, 0),
  392.    ( 2, 0,-1, 0),
  393.    ( 2, 0, 0, 0),
  394.    ( 0, 0, 2, 0),
  395.    ( 0, 1, 0, 0),
  396.    ( 0, 0, 0, 2),
  397.    ( 2, 0,-2, 0),
  398.    ( 2,-1,-1, 0),
  399.    ( 2, 0, 1, 0),
  400.    ( 2,-1, 0, 0),
  401.    ( 0, 1,-1, 0),
  402.    ( 1, 0, 0, 0),
  403.    ( 0, 1, 1, 0),
  404.    ( 2, 0, 0,-2),
  405.    ( 0, 0, 1, 2),
  406.    ( 0, 0, 1,-2),
  407.    ( 4, 0,-1, 0),
  408.    ( 0, 0, 3, 0),
  409.    ( 4, 0,-2, 0),
  410.    ( 2, 1,-1, 0),
  411.    ( 2, 1, 0, 0),
  412.    ( 1, 0,-1, 0),
  413.    ( 1, 1, 0, 0),
  414.    ( 2,-1, 1, 0),
  415.    ( 2, 0, 2, 0),
  416.    ( 4, 0, 0, 0),
  417.    ( 2, 0,-3, 0),
  418.    ( 0, 1,-2, 0),
  419.    ( 2, 0,-1, 2),
  420.    ( 2,-1,-2, 0),
  421.    ( 1, 0, 1, 0),
  422.    ( 2,-2, 0, 0),
  423.    ( 0, 1, 2, 0),
  424.    ( 0, 2, 0, 0),
  425.    ( 2,-2,-1, 0),
  426.    ( 2, 0, 1,-2),
  427.    ( 2, 0, 0, 2),
  428.    ( 4,-1,-1, 0),
  429.    ( 0, 0, 2, 2),
  430.    ( 3, 0,-1, 0),
  431.    ( 2, 1, 1, 0),
  432.    ( 4,-1,-2, 0),
  433.    ( 0, 2,-1, 0),
  434.    ( 2, 2,-1, 0),
  435.    ( 2, 1,-2, 0),
  436.    ( 2,-1, 0,-2),
  437.    ( 4, 0, 1, 0),
  438.    ( 0, 0, 4, 0),
  439.    ( 4,-1, 0, 0),
  440.    ( 1, 0,-2, 0),
  441.    ( 2, 1, 0,-2),
  442.    ( 0, 0, 2,-2),
  443.    ( 1, 1, 1, 0),
  444.    ( 3, 0,-2, 0),
  445.    ( 4, 0,-3, 0),
  446.    ( 2,-1, 2, 0),
  447.    ( 0, 2, 1, 0),
  448.    ( 1, 1,-1, 0),
  449.    ( 2, 0, 3, 0),
  450.    ( 2, 0,-1,-2)
  451.                  );
  452. (*@\\\0000000701*)
  453. (*@///   arg_b:array[0..59,0..3] of shortint = (); *)
  454. arg_b:array[0..59,0..3] of shortint = (
  455.    ( 0, 0, 0, 1),
  456.    ( 0, 0, 1, 1),
  457.    ( 0, 0, 1,-1),
  458.    ( 2, 0, 0,-1),
  459.    ( 2, 0,-1, 1),
  460.    ( 2, 0,-1,-1),
  461.    ( 2, 0, 0, 1),
  462.    ( 0, 0, 2, 1),
  463.    ( 2, 0, 1,-1),
  464.    ( 0, 0, 2,-1),  (* !!! Error in German Meeus *)
  465.    ( 2,-1, 0,-1),
  466.    ( 2, 0,-2,-1),
  467.    ( 2, 0, 1, 1),
  468.    ( 2, 1, 0,-1),
  469.    ( 2,-1,-1, 1),
  470.    ( 2,-1, 0, 1),
  471.    ( 2,-1,-1,-1),
  472.    ( 0, 1,-1,-1),
  473.    ( 4, 0,-1,-1),
  474.    ( 0, 1, 0, 1),
  475.    ( 0, 0, 0, 3),
  476.    ( 0, 1,-1, 1),
  477.    ( 1, 0, 0, 1),
  478.    ( 0, 1, 1, 1),
  479.    ( 0, 1, 1,-1),
  480.    ( 0, 1, 0,-1),
  481.    ( 1, 0, 0,-1),
  482.    ( 0, 0, 3, 1),
  483.    ( 4, 0, 0,-1),
  484.    ( 4, 0,-1, 1),
  485.    ( 0, 0, 1,-3),
  486.    ( 4, 0,-2, 1),
  487.    ( 2, 0, 0,-3),
  488.    ( 2, 0, 2,-1),
  489.    ( 2,-1, 1,-1),
  490.    ( 2, 0,-2, 1),
  491.    ( 0, 0, 3,-1),
  492.    ( 2, 0, 2, 1),
  493.    ( 2, 0,-3,-1),
  494.    ( 2, 1,-1, 1),
  495.    ( 2, 1, 0, 1),
  496.    ( 4, 0, 0, 1),
  497.    ( 2,-1, 1, 1),
  498.    ( 2,-2, 0,-1),
  499.    ( 0, 0, 1, 3),
  500.    ( 2, 1, 1,-1),
  501.    ( 1, 1, 0,-1),
  502.    ( 1, 1, 0, 1),
  503.    ( 0, 1,-2,-1),
  504.    ( 2, 1,-1,-1),
  505.    ( 1, 0, 1, 1),
  506.    ( 2,-1,-2,-1),
  507.    ( 0, 1, 2, 1),
  508.    ( 4, 0,-2,-1),
  509.    ( 4,-1,-1,-1),
  510.    ( 1, 0, 1,-1),
  511.    ( 4, 0, 1,-1),
  512.    ( 1, 0,-1,-1),
  513.    ( 4,-1, 0,-1),
  514.    ( 2,-2, 0, 1)
  515.   );
  516. (*@\\\0000001224*)
  517. (*@///   sigma_r: array[0..59] of longint = (..); *)
  518. sigma_r: array[0..59] of longint = (
  519.  -20905355,
  520.   -3699111,
  521.   -2955968,
  522.    -569925,
  523.      48888,
  524.      -3149,
  525.     246158,
  526.    -152138,
  527.    -170733,
  528.    -204586,
  529.    -129620,
  530.     108743,
  531.     104755,
  532.      10321,
  533.          0,
  534.      79661,
  535.     -34782,
  536.     -23210,
  537.     -21636,
  538.      24208,
  539.      30824,
  540.      -8379,
  541.     -16675,
  542.     -12831,
  543.     -10445,
  544.     -11650,
  545.      14403,
  546.      -7003,
  547.          0,
  548.      10056,
  549.       6322,
  550.      -9884,
  551.       5751,
  552.          0,
  553.      -4950,
  554.       4130,
  555.          0,
  556.      -3958,
  557.          0,
  558.       3258,
  559.       2616,
  560.      -1897,
  561.      -2117,
  562.       2354,
  563.          0,
  564.          0,
  565.      -1423,
  566.      -1117,
  567.      -1571,
  568.      -1739,
  569.          0,
  570.      -4421,
  571.          0,
  572.          0,
  573.          0,
  574.          0,
  575.       1165,
  576.          0,
  577.          0,
  578.       8752
  579.             );
  580. (*@\\\*)
  581. (*@///   sigma_l: array[0..59] of longint = (..); *)
  582. sigma_l: array[0..59] of longint = (
  583.   6288774,
  584.   1274027,
  585.    658314,
  586.    213618,
  587.   -185116,
  588.   -114332,
  589.     58793,
  590.     57066,
  591.     53322,
  592.     45758,
  593.    -40923,
  594.    -34720,
  595.    -30383,
  596.     15327,
  597.    -12528,
  598.     10980,
  599.     10675,
  600.     10034,
  601.      8548,
  602.     -7888,
  603.     -6766,
  604.     -5163,
  605.      4987,
  606.      4036,
  607.      3994,
  608.      3861,
  609.      3665,
  610.     -2689,
  611.     -2602,
  612.      2390,
  613.     -2348,
  614.      2236,
  615.     -2120,
  616.     -2069,
  617.      2048,
  618.     -1773,
  619.     -1595,
  620.      1215,
  621.     -1110,
  622.      -892,
  623.      -810,
  624.       759,
  625.      -713,
  626.      -700,
  627.       691,
  628.       596,
  629.       549,
  630.       537,
  631.       520,
  632.      -487,
  633.      -399,
  634.      -381,
  635.       351,
  636.      -340,
  637.       330,
  638.       327,
  639.      -323,
  640.       299,
  641.       294,
  642.         0
  643.   );
  644. (*@\\\*)
  645. (*@///   sigma_b: array[0..59] of longint = (..); *)
  646. sigma_b: array[0..59] of longint = (
  647.   5128122,
  648.    280602,
  649.    277693,
  650.    173237,
  651.     55413,
  652.     46271,
  653.     32573,
  654.     17198,
  655.      9266,
  656.      8822,
  657.      8216,
  658.      4324,
  659.      4200,
  660.     -3359,
  661.      2463,
  662.      2211,
  663.      2065,
  664.     -1870,
  665.      1828,
  666.     -1794,
  667.     -1749,
  668.     -1565,
  669.     -1491,
  670.     -1475,
  671.     -1410,
  672.     -1344,
  673.     -1335,
  674.      1107,
  675.      1021,
  676.       833,
  677.       777,
  678.       671,
  679.       607,
  680.       596,
  681.       491,
  682.      -451,
  683.       439,
  684.       422,
  685.       421,
  686.      -366,
  687.      -351,
  688.       331,
  689.       315,
  690.       302,
  691.      -283,
  692.      -229,
  693.       223,
  694.       223,
  695.      -220,
  696.      -220,
  697.      -185,
  698.       181,
  699.      -177,
  700.       176,
  701.       166,
  702.      -164,
  703.       132,
  704.      -119,
  705.       115,
  706.       107
  707.   );
  708. (*@\\\*)
  709. var
  710.   t,d,m,ms,f,e,ls : extended;
  711.   sr,sl,sb,temp: extended;
  712.   a1,a2,a3: extended;
  713.   lambda,beta,delta: extended;
  714.   i: integer;
  715. begin
  716.   t:=(julian_date(date)-2451545)/36525;
  717.  
  718.   (* mean elongation of the moon *)
  719.   d:=297.8502042+(445267.1115168+(-0.0016300+(1/545868-1/113065000*t)*t)*t)*t;
  720.  
  721.   (* mean anomaly of the sun *)
  722.   m:=357.5291092+(35999.0502909+(-0.0001536+1/24490000*t)*t)*t;
  723.  
  724.   (* mean anomaly of the moon *)
  725.   ms:=134.9634114+(477198.8676313+(0.0089970+(1/69699-1/1471200*t)*t)*t)*t;
  726.  
  727.   (* argument of the longitude of the moon *)
  728.   f:=93.2720993+(483202.0175273+(-0.0034029+(-1/3526000+1/863310000*t)*t)*t)*t;
  729.  
  730.   (* correction term due to excentricity of the earth orbit *)
  731.   e:=1.0+(-0.002516-0.0000074*t)*t;
  732.  
  733.   (* mean longitude of the moon *)
  734.   ls:=218.3164591+(481267.88134236+(-0.0013268+(1/538841-1/65194000*t)*t)*t)*t;
  735.  
  736.   (* arguments of correction terms *)
  737.   a1:=119.75+131.849*t;
  738.   a2:=53.09+479264.290*t;
  739.   a3:=313.45+481266.484*t;
  740.  
  741. (*@///   sr := Σ r_i cos(d,m,ms,f);   !!!  gives different value than in Meeus *)
  742. sr:=0;
  743. for i:=0 to 59 do begin
  744.   temp:=sigma_r[i]*cos_d( arg_lr[i,0]*d
  745.                          +arg_lr[i,1]*m
  746.                          +arg_lr[i,2]*ms
  747.                          +arg_lr[i,3]*f);
  748.   if abs(arg_lr[i,1])=1 then temp:=temp*e;
  749.   if abs(arg_lr[i,1])=2 then temp:=temp*e;
  750.   sr:=sr+temp;
  751.   end;
  752. (*@\\\0000000301*)
  753. (*@///   sl := Σ l_i sin(d,m,ms,f); *)
  754. sl:=0;
  755. for i:=0 to 59 do begin
  756.   temp:=sigma_l[i]*sin_d( arg_lr[i,0]*d
  757.                          +arg_lr[i,1]*m
  758.                          +arg_lr[i,2]*ms
  759.                          +arg_lr[i,3]*f);
  760.   if abs(arg_lr[i,1])=1 then temp:=temp*e;
  761.   if abs(arg_lr[i,1])=2 then temp:=temp*e;
  762.   sl:=sl+temp;
  763.   end;
  764.  
  765. (* correction terms *)
  766. sl:=sl +3958*sin_d(a1)
  767.        +1962*sin_d(ls-f)
  768.         +318*sin_d(a2);
  769. (*@\\\0000000B01*)
  770. (*@///   sb := Σ b_i sin(d,m,ms,f); *)
  771. sb:=0;
  772. for i:=0 to 59 do begin
  773.   temp:=sigma_b[i]*sin_d( arg_b[i,0]*d
  774.                          +arg_b[i,1]*m
  775.                          +arg_b[i,2]*ms
  776.                          +arg_b[i,3]*f);
  777.   if abs(arg_b[i,1])=1 then temp:=temp*e;
  778.   if abs(arg_b[i,1])=2 then temp:=temp*e;
  779.   sb:=sb+temp;
  780.   end;
  781.  
  782. (* correction terms *)
  783. sb:=sb -2235*sin_d(ls)
  784.         +382*sin_d(a3)
  785.         +175*sin_d(a1-f)
  786.         +175*sin_d(a1+f)
  787.         +127*sin_d(ls-ms)
  788.         -115*sin_d(ls+ms);
  789. (*@\\\0000001216*)
  790.  
  791.   lambda:=ls+sl/1000000;
  792.   beta:=sb/1000000;
  793.   delta:=385000.56+sr/1000;
  794.  
  795.   result.radius:=delta;
  796.   result.longitude:=lambda;
  797.   result.latitude:=beta;
  798.  
  799.   calc_geocentric(result,date);
  800.   end;
  801. (*@\\\0000003601*)
  802.  
  803. (*@/// procedure correct_position(var position:t_coord; date:TDateTime; ...); *)
  804. { Based upon chapter 39 of Meeus }
  805.  
  806. procedure correct_position(var position:t_coord; date:TDateTime;
  807.                            latitude,longitude,height:extended);
  808. var
  809.   u,h,delta_alpha: extended;
  810.   rho_sin, rho_cos: extended;
  811. const
  812.   b_a=0.99664719;
  813. begin
  814.   u:=arctan_d(b_a*b_a*tan_d(longitude));
  815.   rho_sin:=b_a*sin_d(u)+height/6378140*sin_d(longitude);
  816.   rho_cos:=cos_d(u)+height/6378140*cos_d(longitude);
  817.  
  818.   position.parallax:=arcsin_d(sin_d(8.794/3600)/(moon_distance(date)/AU));
  819.   h:=star_time(date)-longitude-position.rektaszension;
  820.   delta_alpha:=arctan_d(
  821.                 (-rho_cos*sin_d(position.parallax)*sin_d(h))/
  822.                 (cos_d(position.declination)-
  823.                   rho_cos*sin_d(position.parallax)*cos_d(h)));
  824.   position.rektaszension:=position.rektaszension+delta_alpha;
  825.   position.declination:=arctan_d(
  826.       (( sin_d(position.declination)
  827.         -rho_sin*sin_d(position.parallax))*cos_d(delta_alpha))/
  828.       ( cos_d(position.declination)
  829.        -rho_cos*sin_d(position.parallax)*cos_d(h)));
  830.   end;
  831. (*@\\\0000001501*)
  832.  
  833. { Moon phases and age of the moon }
  834. (*@/// procedure calc_phase_data(date:TDateTime; phase:TMoonPhase; var jde,kk,m,ms,f,o,e: extended); *)
  835. { Based upon Chapter 47 of Meeus }
  836. { Both used for moon phases and moon and sun eclipses }
  837.  
  838. procedure calc_phase_data(date:TDateTime; phase:TMoonPhase; var jde,kk,m,ms,f,o,e: extended);
  839. var
  840.   t: extended;
  841.   k: longint;
  842.   ts: extended;
  843. begin
  844.   k:=round((date-encodedate(2000,1,1))/36525.0*1236.85);
  845.   ts:=(date-encodedate(2000,1,1))/36525.0;
  846.   kk:=int(k)+ord(phase)/4.0;
  847.   t:=kk/1236.85;
  848.   jde:=2451550.09765+29.530588853*kk
  849.        +t*t*(0.0001337-t*(0.000000150-0.00000000073*t));
  850.   m:=2.5534+29.10535669*kk-t*t*(0.0000218+0.00000011*t);
  851.   ms:=201.5643+385.81693528*kk+t*t*(0.1017438+t*(0.00001239-t*0.000000058));
  852.   f:= 160.7108+390.67050274*kk-t*t*(0.0016341+t*(0.00000227-t*0.000000011));
  853.   o:=124.7746-1.56375580*kk+t*t*(0.0020691+t*0.00000215);
  854.   e:=1-ts*(0.002516+ts*0.0000074);
  855.   end;
  856. (*@\\\0000000447*)
  857. (*@/// function nextphase(date:TDateTime; phase:TMoonPhase):TDateTime; *)
  858. { Based upon Chapter 47 of Meeus }
  859.  
  860. function nextphase(date:TDateTime; phase:TMoonPhase):TDateTime;
  861. var
  862.   t: extended;
  863.   kk: extended;
  864.   jde: extended;
  865.   m,ms,f,o,e: extended;
  866.   korr,w,akorr: extended;
  867.   a:array[1..14] of extended;
  868. begin
  869.   calc_phase_data(date,phase,jde,kk,m,ms,f,o,e);
  870. {   k:=round((date-encodedate(2000,1,1))/36525.0*1236.85); }
  871. {   ts:=(date-encodedate(2000,1,1))/36525.0; }
  872. {   kk:=int(k)+ord(phase)/4.0; }
  873.   t:=kk/1236.85;
  874. {   m:=2.5534+29.10535669*kk-t*t*(0.0000218+0.00000011*t); }
  875. {   ms:=201.5643+385.81693528*kk+t*t*(0.1017438+t*(0.00001239-t*0.000000058)); }
  876. {   f:= 160.7108+390.67050274*kk-t*t*(0.0016341+t*(0.00000227-t*0.000000011)); }
  877. {   o:=124.7746-1.56375580*kk+t*t*(0.0020691+t*0.00000215); }
  878. {   e:=1-ts*(0.002516+ts*0.0000074); }
  879.   case phase of
  880. (*@///     Newmoon: *)
  881. Newmoon:
  882. begin
  883.   korr:= -0.40720*sin_d(ms)
  884.          +0.17241*e*sin_d(m)
  885.          +0.01608*sin_d(2*ms)
  886.          +0.01039*sin_d(2*f)
  887.          +0.00739*e*sin_d(ms-m)
  888.          -0.00514*e*sin_d(ms+m)
  889.          +0.00208*e*e*sin_d(2*m)
  890.          -0.00111*sin_d(ms-2*f)
  891.          -0.00057*sin_d(ms+2*f)
  892.          +0.00056*e*sin_d(2*ms+m)
  893.          -0.00042*sin_d(3*ms)
  894.          +0.00042*e*sin_d(m+2*f)
  895.          +0.00038*e*sin_d(m-2*f)
  896.          -0.00024*e*sin_d(2*ms-m)
  897.          -0.00017*sin_d(o)
  898.          -0.00007*sin_d(ms+2*m)
  899.          +0.00004*sin_d(2*ms-2*f)
  900.          +0.00004*sin_d(3*m)
  901.          +0.00003*sin_d(ms+m-2*f)
  902.          +0.00003*sin_d(2*ms+2*f)
  903.          -0.00003*sin_d(ms+m+2*f)
  904.          +0.00003*sin_d(ms-m+2*f)
  905.          -0.00002*sin_d(ms-m-2*f)
  906.          -0.00002*sin_d(3*ms+m)
  907.          +0.00002*sin_d(4*ms);
  908.   end;
  909. (*@\\\0000001701*)
  910. (*@///     FirstQuarter,LastQuarter: *)
  911. FirstQuarter,LastQuarter:
  912. begin
  913.   korr:= -0.62801*sin_d(ms)
  914.          +0.17172*e*sin_d(m)
  915.          -0.01183*e*sin_d(ms+m)
  916.          +0.00862*sin_d(2*ms)
  917.          +0.00804*sin_d(2*f)
  918.          +0.00454*e*sin_d(ms-m)
  919.          +0.00204*e*e*sin_d(2*m)
  920.          -0.00180*sin_d(ms-2*f)
  921.          -0.00070*sin_d(ms+2*f)
  922.          -0.00040*sin_d(3*ms)
  923.          -0.00034*e*sin_d(2*ms-m)
  924.          +0.00032*e*sin_d(m+2*f)
  925.          +0.00032*e*sin_d(m-2*f)
  926.          -0.00028*e*e*sin_d(ms+2*m)
  927.          +0.00027*e*sin_d(2*ms+m)
  928.          -0.00017*sin_d(o)
  929.          -0.00005*sin_d(ms-m-2*f)
  930.          +0.00004*sin_d(2*ms+2*f)
  931.          -0.00004*sin_d(ms+m+2*f)
  932.          +0.00004*sin_d(ms-2*m)
  933.          +0.00003*sin_d(ms+m-2*f)
  934.          +0.00003*sin_d(3*m)
  935.          +0.00002*sin_d(2*ms-2*f)
  936.          +0.00002*sin_d(ms-m+2*f)
  937.          -0.00002*sin_d(3*ms+m);
  938.   w:=0.00306-0.00038*e*cos_d(m)
  939.             +0.00026*cos_d(ms)
  940.             -0.00002*cos_d(ms-m)
  941.             +0.00002*cos_d(ms+m)
  942.             +0.00002*cos_d(2*f);
  943.   if phase = FirstQuarter then begin
  944.     korr:=korr+w;
  945.     end
  946.   else begin
  947.     korr:=korr-w;
  948.     end;
  949.   end;
  950. (*@\\\*)
  951. (*@///     Fullmoon: *)
  952. Fullmoon:
  953. begin
  954.   korr:= -0.40614*sin_d(ms)
  955.          +0.17302*e*sin_d(m)
  956.          +0.01614*sin_d(2*ms)
  957.          +0.01043*sin_d(2*f)
  958.          +0.00734*e*sin_d(ms-m)
  959.          -0.00515*e*sin_d(ms+m)
  960.          +0.00209*e*e*sin_d(2*m)
  961.          -0.00111*sin_d(ms-2*f)
  962.          -0.00057*sin_d(ms+2*f)
  963.          +0.00056*e*sin_d(2*ms+m)
  964.          -0.00042*sin_d(3*ms)
  965.          +0.00042*e*sin_d(m+2*f)
  966.          +0.00038*e*sin_d(m-2*f)
  967.          -0.00024*e*sin_d(2*ms-m)
  968.          -0.00017*sin_d(o)
  969.          -0.00007*sin_d(ms+2*m)
  970.          +0.00004*sin_d(2*ms-2*f)
  971.          +0.00004*sin_d(3*m)
  972.          +0.00003*sin_d(ms+m-2*f)
  973.          +0.00003*sin_d(2*ms+2*f)
  974.          -0.00003*sin_d(ms+m+2*f)
  975.          +0.00003*sin_d(ms-m+2*f)
  976.          -0.00002*sin_d(ms-m-2*f)
  977.          -0.00002*sin_d(3*ms+m)
  978.          +0.00002*sin_d(4*ms);
  979.   end;
  980. (*@\\\*)
  981. (*@///     else *)
  982. else
  983.   korr:=0;   (* Delphi 2 shut up! *)
  984. (*@\\\*)
  985.     end;
  986. (*@///   Additional Corrections due to planets *)
  987. a[1]:=299.77+0.107408*kk-0.009173*t*t;
  988. a[2]:=251.88+0.016321*kk;
  989. a[3]:=251.83+26.651886*kk;
  990. a[4]:=349.42+36.412478*kk;
  991. a[5]:= 84.66+18.206239*kk;
  992. a[6]:=141.74+53.303771*kk;
  993. a[7]:=207.14+2.453732*kk;
  994. a[8]:=154.84+7.306860*kk;
  995. a[9]:= 34.52+27.261239*kk;
  996. a[10]:=207.19+0.121824*kk;
  997. a[11]:=291.34+1.844379*kk;
  998. a[12]:=161.72+24.198154*kk;
  999. a[13]:=239.56+25.513099*kk;
  1000. a[14]:=331.55+3.592518*kk;
  1001. akorr:=   +0.000325*sin_d(a[1])
  1002.           +0.000165*sin_d(a[2])
  1003.           +0.000164*sin_d(a[3])
  1004.           +0.000126*sin_d(a[4])
  1005.           +0.000110*sin_d(a[5])
  1006.           +0.000062*sin_d(a[6])
  1007.           +0.000060*sin_d(a[7])
  1008.           +0.000056*sin_d(a[8])
  1009.           +0.000047*sin_d(a[9])
  1010.           +0.000042*sin_d(a[10])
  1011.           +0.000040*sin_d(a[11])
  1012.           +0.000037*sin_d(a[12])
  1013.           +0.000035*sin_d(a[13])
  1014.           +0.000023*sin_d(a[14]);
  1015. korr:=korr+akorr;
  1016. (*@\\\*)
  1017.   nextphase:=delphi_date(jde+korr);
  1018.   end;
  1019. (*@\\\0000001D0E*)
  1020. (*@/// function last_phase(date:TDateTime; phase:TMoonPhase):TDateTime; *)
  1021. function last_phase(date:TDateTime; phase:TMoonPhase):TDateTime;
  1022. var
  1023.   temp_date: TDateTime;
  1024. begin
  1025.   temp_date:=date+28;
  1026.   result:=temp_date;
  1027.   while result>date do begin
  1028.     result:=nextphase(temp_date,phase);
  1029.     temp_date:=temp_date-28;
  1030.     end;
  1031.   end;
  1032. (*@\\\0000000303*)
  1033. (*@/// function next_phase(date:TDateTime; phase:TMoonPhase):TDateTime; *)
  1034. function next_phase(date:TDateTime; phase:TMoonPhase):TDateTime;
  1035. var
  1036.   temp_date: TDateTime;
  1037. begin
  1038.   temp_date:=date-28;
  1039.   result:=temp_date;
  1040.   while result<date do begin
  1041.     result:=nextphase(temp_date,phase);
  1042.     temp_date:=temp_date+28;
  1043.     end;
  1044.   end;
  1045. (*@\\\0000000201*)
  1046.  
  1047. (*@/// function moon_phase_angle(date: TDateTime):extended; *)
  1048. { Based upon Chapter 46 of Meeus }
  1049.  
  1050. function moon_phase_angle(date: TDateTime):extended;
  1051. var
  1052.   sun_coord,moon_coord: t_coord;
  1053.   phi,i: extended;
  1054. begin
  1055.   sun_coord:=sun_coordinate(date);
  1056.   moon_coord:=moon_coordinate(date);
  1057.   phi:=arccos(cos_d(moon_coord.latitude)
  1058.              *cos_d(moon_coord.longitude-sun_coord.longitude));
  1059.   i:=arctan(sun_coord.radius*sin(phi)/
  1060.             (moon_coord.radius-sun_coord.radius*cos(phi)));
  1061.   if i<0 then  result:=i/pi*180+180
  1062.          else  result:=i/pi*180;
  1063.  
  1064.   if put_in_360(moon_coord.longitude-sun_coord.longitude)>180 then
  1065.     result:=-result;
  1066.  
  1067.   end;
  1068. (*@\\\*)
  1069. (*@/// function age_of_moon(date: TDateTime):extended; *)
  1070. function age_of_moon(date: TDateTime):extended;
  1071. var
  1072.   sun_coord,moon_coord: t_coord;
  1073. begin
  1074.   sun_coord:=sun_coordinate(date);
  1075.   moon_coord:=moon_coordinate(date);
  1076.   result:=put_in_360(moon_coord.longitude-sun_coord.longitude)/360*mean_lunation;
  1077.   end;
  1078. (*@\\\*)
  1079. (*@/// function current_phase(date:TDateTime):extended; *)
  1080. function current_phase(date:TDateTime):extended;
  1081. begin
  1082.   result:=(1+cos_d(moon_phase_angle(date)))/2;
  1083.   end;
  1084. (*@\\\0000000301*)
  1085.  
  1086. (*@/// function lunation(date:TDateTime):integer; *)
  1087. function lunation(date:TDateTime):integer;
  1088. begin
  1089.   result:=round((last_phase(date,NewMoon)-delphi_date(2423436))/mean_lunation)+1;
  1090.   end;
  1091. (*@\\\0000000301*)
  1092.  
  1093. { The distances }
  1094. (*@/// function sun_distance(date: TDateTime): extended;    // AU *)
  1095. function sun_distance(date: TDateTime): extended;
  1096. begin
  1097.   result:=sun_coordinate(date).radius/au;
  1098.   end;
  1099. (*@\\\0000000301*)
  1100. (*@/// function moon_distance(date: TDateTime): extended;   // km *)
  1101. function moon_distance(date: TDateTime): extended;
  1102. begin
  1103.   result:=moon_coordinate(date).radius;
  1104.   end;
  1105. (*@\\\0000000301*)
  1106.  
  1107. { The angular diameter (which is 0.5 of the subtent in moontool) }
  1108. (*@/// function sun_diameter(date:TDateTime):extended;     // angular seconds *)
  1109. function sun_diameter(date:TDateTime):extended;
  1110. begin
  1111.   result:=959.63/(sun_coordinate(date).radius/au)*2;
  1112.   end;
  1113. (*@\\\0000000335*)
  1114. (*@/// function moon_diameter(date:TDateTime):extended;    // angular seconds *)
  1115. function moon_diameter(date:TDateTime):extended;
  1116. begin
  1117.   result:=358473400/moon_coordinate(date).radius*2;
  1118.   end;
  1119. (*@\\\0000000334*)
  1120.  
  1121. { Perigee and Apogee }
  1122. (*@/// function nextXXXgee(date:TDateTime; apo: boolean):TDateTime; *)
  1123. function nextXXXgee(date:TDateTime; apo: boolean):TDateTime;
  1124. const
  1125. (*@///   arg_apo:array[0..31,0..2] of shortint = (..); *)
  1126. arg_apo:array[0..31,0..2] of shortint = (
  1127.    { D  F  M }
  1128.    ( 2, 0, 0),
  1129.    ( 4, 0, 0),
  1130.    ( 0, 0, 1),
  1131.    ( 2, 0,-1),
  1132.    ( 0, 2, 0),
  1133.    ( 1, 0, 0),
  1134.    ( 6, 0, 0),
  1135.    ( 4, 0,-1),
  1136.    ( 2, 2, 0),
  1137.    ( 1, 0, 1),
  1138.    ( 8, 0, 0),
  1139.    ( 6, 0,-1),
  1140.    ( 2,-2, 0),
  1141.    ( 2, 0,-2),
  1142.    ( 3, 0, 0),
  1143.    ( 4, 2, 0),
  1144.    ( 8, 0,-1),
  1145.    ( 4, 0,-2),
  1146.    (10, 0, 0),
  1147.    ( 3, 0, 1),
  1148.    ( 0, 0, 2),
  1149.    ( 2, 0, 1),
  1150.    ( 2, 0, 2),
  1151.    ( 6, 2, 0),
  1152.    ( 6, 0,-2),
  1153.    (10, 0,-1),
  1154.    ( 5, 0, 0),
  1155.    ( 4,-2, 0),
  1156.    ( 0, 2, 1),
  1157.    (12, 0, 0),
  1158.    ( 2, 2,-1),
  1159.    ( 1, 0,-1)
  1160.              );
  1161. (*@\\\0000002201*)
  1162. (*@///   arg_per:array[0..59,0..2] of shortint = (..); *)
  1163. arg_per:array[0..59,0..2] of shortint = (
  1164.    { D  F  M }
  1165.    ( 2, 0, 0),
  1166.    ( 4, 0, 0),
  1167.    ( 6, 0, 0),
  1168.    ( 8, 0, 0),
  1169.    ( 2, 0,-1),
  1170.    ( 0, 0, 1),
  1171.    (10, 0, 0),
  1172.    ( 4, 0,-1),
  1173.    ( 6, 0,-1),
  1174.    (12, 0, 0),
  1175.    ( 1, 0, 0),
  1176.    ( 8, 0,-1),
  1177.    (14, 0, 0),
  1178.    ( 0, 2, 0),
  1179.    ( 3, 0, 0),
  1180.    (10, 0,-1),
  1181.    (16, 0, 0),
  1182.    (12, 0,-1),
  1183.    ( 5, 0, 0),
  1184.    ( 2, 2, 0),
  1185.    (18, 0, 0),
  1186.    (14, 0,-1),
  1187.    ( 7, 0, 0),
  1188.    ( 2, 1, 0),
  1189.    (20, 0, 0),
  1190.    ( 1, 0, 1),
  1191.    (16, 0,-1),
  1192.    ( 4, 0, 1),
  1193.    ( 2, 0,-2),
  1194.    ( 4, 0,-2),
  1195.    ( 6, 0,-2),
  1196.    (22, 0, 0),
  1197.    (18, 0,-1),
  1198.    ( 6, 0, 1),
  1199.    (11, 0, 0),
  1200.    ( 8, 0, 1),
  1201.    ( 4,-2, 0),
  1202.    ( 6, 2, 0),
  1203.    ( 3, 0, 1),
  1204.    ( 5, 0, 1),
  1205.    (13, 0, 0),
  1206.    (20, 0,-1),
  1207.    ( 3, 0, 2),
  1208.    ( 4, 2,-2),
  1209.    ( 1, 0, 2),
  1210.    (22, 0,-1),
  1211.    ( 0, 4, 0),
  1212.    ( 6,-2, 0),
  1213.    ( 2,-2, 1),
  1214.    ( 0, 0, 2),
  1215.    ( 0, 2,-1),
  1216.    ( 2, 4, 0),
  1217.    ( 0, 2,-2),
  1218.    ( 2,-2, 2),
  1219.    (24, 0, 0),
  1220.    ( 4,-4, 0),
  1221.    ( 9, 0, 0),
  1222.    ( 4, 2, 0),
  1223.    ( 2, 0, 2),
  1224.    ( 1, 0,-1)
  1225.              );
  1226. (*@\\\*)
  1227. (*@///   koe_apo:array[0..31,0..1] of longint = (..); *)
  1228. koe_apo:array[0..31,0..1] of longint = (
  1229.    {    1   T }
  1230.    ( 4392,  0),
  1231.    (  684,  0),
  1232.    (  456,-11),
  1233.    (  426,-11),
  1234.    (  212,  0),
  1235.    ( -189,  0),
  1236.    (  144,  0),
  1237.    (  113,  0),
  1238.    (   47,  0),
  1239.    (   36,  0),
  1240.    (   35,  0),
  1241.    (   34,  0),
  1242.    (  -34,  0),
  1243.    (   22,  0),
  1244.    (  -17,  0),
  1245.    (   13,  0),
  1246.    (   11,  0),
  1247.    (   10,  0),
  1248.    (    9,  0),
  1249.    (    7,  0),
  1250.    (    6,  0),
  1251.    (    5,  0),
  1252.    (    5,  0),
  1253.    (    4,  0),
  1254.    (    4,  0),
  1255.    (    4,  0),
  1256.    (   -4,  0),
  1257.    (   -4,  0),
  1258.    (    3,  0),
  1259.    (    3,  0),
  1260.    (    3,  0),
  1261.    (   -3,  0)
  1262.                );
  1263. (*@\\\0000001501*)
  1264. (*@///   koe_per:array[0..59,0..1] of longint = (..); *)
  1265. koe_per:array[0..59,0..1] of longint = (
  1266.    {     1   T }
  1267.    (-16769,  0),
  1268.    (  4589,  0),
  1269.    ( -1856,  0),
  1270.    (   883,  0),
  1271.    (  -773, 19),
  1272.    (   502,-13),
  1273.    (  -460,  0),
  1274.    (   422,-11),
  1275.    (  -256,  0),
  1276.    (   253,  0),
  1277.    (   237,  0),
  1278.    (   162,  0),
  1279.    (  -145,  0),
  1280.    (   129,  0),
  1281.    (  -112,  0),
  1282.    (  -104,  0),
  1283.    (    86,  0),
  1284.    (    69,  0),
  1285.    (    66,  0),
  1286.    (   -53,  0),
  1287.    (   -52,  0),
  1288.    (   -46,  0),
  1289.    (   -41,  0),
  1290.    (    40,  0),
  1291.    (    32,  0),
  1292.    (   -32,  0),
  1293.    (    31,  0),
  1294.    (   -29,  0),
  1295.    (   -27,  0),
  1296.    (    24,  0),
  1297.    (   -21,  0),
  1298.    (   -21,  0),
  1299.    (   -21,  0),
  1300.    (    19,  0),
  1301.    (   -18,  0),
  1302.    (   -14,  0),
  1303.    (   -14,  0),
  1304.    (   -14,  0),
  1305.    (    14,  0),
  1306.    (   -14,  0),
  1307.    (    13,  0),
  1308.    (    13,  0),
  1309.    (    11,  0),
  1310.    (   -11,  0),
  1311.    (   -10,  0),
  1312.    (    -9,  0),
  1313.    (    -8,  0),
  1314.    (     8,  0),
  1315.    (     8,  0),
  1316.    (     7,  0),
  1317.    (     7,  0),
  1318.    (     7,  0),
  1319.    (    -6,  0),
  1320.    (    -6,  0),
  1321.    (     6,  0),
  1322.    (     5,  0),
  1323.    (    27,  0),
  1324.    (    27,  0),
  1325.    (     5,  0),
  1326.    (    -4,  0)
  1327.                );
  1328. (*@\\\0000000410*)
  1329. var
  1330.   k, jde, t: extended;
  1331.   d,m,f,v: extended;
  1332.   i: integer;
  1333. begin
  1334.   k:=round(((date-encodedate(1999,1,1))/365.25-0.97)*13.2555);
  1335.   if apo then k:=k+0.5;
  1336.   t:=k/1325.55;
  1337.   jde:=2451534.6698+27.55454988*k+(-0.0006886+
  1338.        (-0.000001098+0.0000000052*t)*t)*t*t;
  1339.   d:=171.9179+335.9106046*k+(-0.0100250+(-0.00001156+0.000000055*t)*t)*t*t;
  1340.   m:=347.3477+27.1577721*k+(-0.0008323-0.0000010*t)*t*t;
  1341.   f:=316.6109+364.5287911*k+(-0.0125131-0.0000148*t)*t*t;
  1342.   v:=0;
  1343.   if apo then
  1344.     for i:=0 to 31 do
  1345.       v:=v+sin_d(arg_apo[i,0]*d+arg_apo[i,1]*f+arg_apo[i,2]*m)*
  1346.          (koe_apo[i,0]*0.0001+koe_apo[i,1]*0.00001*t)
  1347.   else
  1348.     for i:=0 to 59 do
  1349.       v:=v+sin_d(arg_per[i,0]*d+arg_per[i,1]*f+arg_per[i,2]*m)*
  1350.          (koe_per[i,0]*0.0001+koe_per[i,1]*0.00001*t);
  1351.   result:=delphi_date(jde+v);
  1352.   end;
  1353. (*@\\\0000001836*)
  1354. (*@/// function nextperigee(date:TDateTime):TDateTime; *)
  1355. function nextperigee(date:TDateTime):TDateTime;
  1356. var
  1357.   temp_date: TDateTime;
  1358. begin
  1359.   temp_date:=date-28;
  1360.   result:=temp_date;
  1361.   while result<date do begin
  1362.     result:=nextXXXgee(temp_date,false);
  1363.     temp_date:=temp_date+28;
  1364.     end;
  1365.   end;
  1366. (*@\\\*)
  1367. (*@/// function nextapogee(date:TDateTime):TDateTime; *)
  1368. function nextapogee(date:TDateTime):TDateTime;
  1369. var
  1370.   temp_date: TDateTime;
  1371. begin
  1372.   temp_date:=date-28;
  1373.   result:=temp_date;
  1374.   while result<date do begin
  1375.     result:=nextXXXgee(temp_date,true);
  1376.     temp_date:=temp_date+28;
  1377.     end;
  1378.   end;
  1379. (*@\\\0000000801*)
  1380.  
  1381. { The seasons }
  1382. (*@/// function StartSeason(year: integer; season:TSeason):TDateTime;  // maximum error 51 seconds *)
  1383. { Based upon chapter 26 of Meeus }
  1384.  
  1385. function StartSeason(year: integer; season:TSeason):TDateTime;
  1386. var
  1387.   y: extended;
  1388.   jde0: extended;
  1389.   t, w, dl, s: extended;
  1390.   i: integer;
  1391. const
  1392. (*@///   a: array[0..23] of integer = (..); *)
  1393. a: array[0..23] of integer = (
  1394.   485, 203, 199, 182, 156, 136, 77, 74, 70, 58, 52, 50,
  1395.   45, 44, 29, 18, 17, 16, 14, 12, 12, 12, 9, 8 );
  1396. (*@\\\000000010F*)
  1397. (*@///   bc:array[0..23,1..2] of extended = (..); *)
  1398. bc:array[0..23,1..2] of extended = (
  1399.    ( 324.96,   1934.136 ),
  1400.    ( 337.23,  32964.467 ),
  1401.    ( 342.08,     20.186 ),
  1402.    (  27.85, 445267.112 ),
  1403.    (  73.14,  45036.886 ),
  1404.    ( 171.52,  22518.443 ),
  1405.    ( 222.54,  65928.934 ),
  1406.    ( 296.72,   3034.906 ),
  1407.    ( 243.58,   9037.513 ),
  1408.    ( 119.81,  33718.147 ),
  1409.    ( 297.17,    150.678 ),
  1410.    (  21.02,   2281.226 ),
  1411.    ( 247.54,  29929.562 ),
  1412.    ( 325.15,  31555.956 ),
  1413.    (  60.93,   4443.417 ),
  1414.    ( 155.12,  67555.328 ),
  1415.    ( 288.79,   4562.452 ),
  1416.    ( 198.04,  62894.029 ),
  1417.    ( 199.76,  31436.921 ),
  1418.    (  95.39,  14577.848 ),
  1419.    ( 287.11,  31931.756 ),
  1420.    ( 320.81,  34777.259 ),
  1421.    ( 227.73,   1222.114 ),
  1422.    (  15.45,  16859.074 )
  1423.                            );
  1424. (*@\\\0000001901*)
  1425. begin
  1426.   case year of
  1427. (*@///     -1000..+999: *)
  1428. -1000..+999: begin
  1429.   y:=year/1000;
  1430.   case season of
  1431.     spring: jde0:=1721139.29189+(365242.13740+( 0.06134+( 0.00111-0.00071*y)*y)*y)*y;
  1432.     summer: jde0:=1721223.25401+(365241.72562+(-0.05323+( 0.00907+0.00025*y)*y)*y)*y;
  1433.     autumn: jde0:=1721325.70455+(365242.49558+(-0.11677+(-0.00297+0.00074*y)*y)*y)*y;
  1434.     winter: jde0:=1721414.39987+(365242.88257+(-0.00769+(-0.00933-0.00006*y)*y)*y)*y;
  1435.     else    jde0:=0;   (* this can't happen *)
  1436.     end;
  1437.   end;
  1438. (*@\\\0000000801*)
  1439. (*@///     +1000..+3000: *)
  1440. +1000..+3000: begin
  1441.   y:=(year-2000)/1000;
  1442.   case season of
  1443.     spring: jde0:=2451623.80984+(365242.37404+( 0.05169+(-0.00411-0.00057*y)*y)*y)*y;
  1444.     summer: jde0:=2451716.56767+(365241.62603+( 0.00325+( 0.00888-0.00030*y)*y)*y)*y;
  1445.     autumn: jde0:=2451810.21715+(365242.01767+(-0.11575+( 0.00337+0.00078*y)*y)*y)*y;
  1446.     winter: jde0:=2451900.05952+(365242.74049+(-0.06223+(-0.00823+0.00032*y)*y)*y)*y;
  1447.     else    jde0:=0;   (* this can't happen *)
  1448.     end;
  1449.   end;
  1450. (*@\\\0000000901*)
  1451.     else raise E_OutOfAlgorithRange.Create('Out of range of the algorithm');
  1452.     end;
  1453.   t:=(jde0-2451545.0)/36525;
  1454.   w:=35999.373*t-2.47;
  1455.   dl:=1+0.0334*cos_d(w)+0.0007*cos_d(2*w);
  1456. (*@///   s := Σ a cos(b+c*t) *)
  1457. s:=0;
  1458. for i:=0 to 23 do
  1459.   s:=s+a[i]*cos_d(bc[i,1]+bc[i,2]*t);
  1460. (*@\\\0000000301*)
  1461.   result:=delphi_date(jde0+(0.00001*s)/dl);
  1462.   end;
  1463. (*@\\\0000001001*)
  1464.  
  1465. { Rising and setting of moon and sun }
  1466. (*@/// function Calc_Set_Rise(date:TDateTime; latitude, longitude:extended; *)
  1467. { Based upon chapter 14 of Meeus }
  1468.  
  1469. function Calc_Set_Rise(date:TDateTime; latitude, longitude:extended;
  1470.                        sun: boolean; kind: T_RiseSet):TDateTime;
  1471. var
  1472.   h: Extended;
  1473.   pos1, pos2, pos3: t_coord;
  1474.   h0, theta0, cos_h0, cap_h0: extended;
  1475.   m0,m1,m2: extended;
  1476. (*@/// function interpolation(y1,y2,y3,n: extended):extended; *)
  1477. function interpolation(y1,y2,y3,n: extended):extended;
  1478. var
  1479.   a,b,c: extended;
  1480. begin
  1481.   a:=y2-y1;
  1482.   b:=y3-y2;
  1483.   if a>100 then  a:=a-360;
  1484.   if a<-100 then  a:=a+360;
  1485.   if b>100 then  b:=b-360;
  1486.   if b<-100 then  b:=b+360;
  1487.   c:=b-a;
  1488.   result:=y2+0.5*n*(a+b+n*c);
  1489.   end;
  1490. (*@\\\0000000A09*)
  1491. (*@/// function correction(m:extended; kind:integer):extended; *)
  1492. function correction(m:extended; kind:integer):extended;
  1493. var
  1494.   alpha,delta,h, height: extended;
  1495. begin
  1496.   alpha:=interpolation(pos1.rektaszension,
  1497.                        pos2.rektaszension,
  1498.                        pos3.rektaszension,
  1499.                        m);
  1500.   delta:=interpolation(pos1.declination,
  1501.                        pos2.declination,
  1502.                        pos3.declination,
  1503.                        m);
  1504.   h:=put_in_360((theta0+360.985647*m)-longitude-alpha);
  1505.   if h>180 then h:=h-360;
  1506.  
  1507.   height:=arcsin_d(sin_d(latitude)*sin_d(delta)
  1508.                    +cos_d(latitude)*cos_d(delta)*cos_d(h));
  1509.  
  1510.   case kind of
  1511.     0:   result:=-h/360;
  1512.     1,2: result:=(height-h0)/(360*cos_d(delta)*cos_d(latitude)*sin_d(h));
  1513.     else result:=0;   (* this cannot happen *)
  1514.     end;
  1515.   end;
  1516. (*@\\\0000001501*)
  1517. begin
  1518.   if sun then
  1519.     h0:=-0.8333
  1520.   else begin
  1521.     pos1:=moon_coordinate(date);
  1522.     correct_position(pos1,date,latitude,longitude,0);
  1523.     h0:=0.7275*pos1.parallax-34/60;
  1524.     end;
  1525.  
  1526.   h:=int(date);
  1527.   theta0:=star_time(h);
  1528.   if sun then begin
  1529.     pos1:=sun_coordinate(h-1);
  1530.     pos2:=sun_coordinate(h);
  1531.     pos3:=sun_coordinate(h+1);
  1532.     end
  1533.   else begin
  1534.     pos1:=moon_coordinate(h-1);
  1535.     correct_position(pos1,h-1,latitude,longitude,0);
  1536.     pos2:=moon_coordinate(h);
  1537.     correct_position(pos2,h,latitude,longitude,0);
  1538.     pos3:=moon_coordinate(h+1);
  1539.     correct_position(pos3,h+1,latitude,longitude,0);
  1540.     end;
  1541.  
  1542.   cos_h0:=(sin_d(h0)-sin_d(latitude)*sin_d(pos2.declination))/
  1543.           (cos_d(latitude)*cos_d(pos2.declination));
  1544.   if (cos_h0<-1) or (cos_h0>1) then
  1545.     raise E_NoRiseSet.Create('No rises or sets calculable');
  1546.   cap_h0:=arccos_d(cos_h0);
  1547.  
  1548.   m0:=(pos2.rektaszension+longitude-theta0)/360;
  1549.   m1:=m0-cap_h0/360;
  1550.   m2:=m0+cap_h0/360;
  1551.  
  1552.   m0:=frac(m0);
  1553.   if m0<0 then m0:=m0+1;
  1554.   m1:=frac(m1);
  1555.   if m1<0 then m1:=m1+1;
  1556.   m2:=frac(m2);
  1557.   if m2<0 then m2:=m2+1;
  1558.  
  1559.   m0:=m0+correction(m0,0);
  1560.   m1:=m1+correction(m1,1);
  1561.   m2:=m2+correction(m2,2);
  1562.  
  1563.   case kind of
  1564.     _rise:    result:=h+m1;
  1565.     _set:     result:=h+m2;
  1566.     _transit: result:=h+m0;
  1567.     else      result:=0;    (* this can't happen *)
  1568.     end;
  1569.  
  1570.   end;
  1571. (*@\\\0000000701*)
  1572.  
  1573. (*@/// function Sun_Rise(date:TDateTime; latitude, longitude:extended):TDateTime; *)
  1574. function Sun_Rise(date:TDateTime; latitude, longitude:extended):TDateTime;
  1575. begin
  1576.   result:=Calc_Set_Rise(date,latitude,longitude,true,_rise);
  1577.   end;
  1578. (*@\\\000000033B*)
  1579. (*@/// function Sun_Set(date:TDateTime; latitude, longitude:extended):TDateTime; *)
  1580. function Sun_Set(date:TDateTime; latitude, longitude:extended):TDateTime;
  1581. begin
  1582.   result:=Calc_Set_Rise(date,latitude,longitude,true,_set);
  1583.   end;
  1584. (*@\\\000000033A*)
  1585. (*@/// function Sun_Transit(date:TDateTime; latitude, longitude:extended):TDateTime; *)
  1586. function Sun_Transit(date:TDateTime; latitude, longitude:extended):TDateTime;
  1587. begin
  1588.   result:=Calc_Set_Rise(date,latitude,longitude,true,_transit);
  1589.   end;
  1590. (*@\\\0000000301*)
  1591. (*@/// function Moon_Rise(date:TDateTime; latitude, longitude:extended):TDateTime; *)
  1592. function Moon_Rise(date:TDateTime; latitude, longitude:extended):TDateTime;
  1593. begin
  1594.   result:=Calc_Set_Rise(date,latitude,longitude,false,_rise);
  1595.   end;
  1596. (*@\\\000000033C*)
  1597. (*@/// function Moon_Set(date:TDateTime; latitude, longitude:extended):TDateTime; *)
  1598. function Moon_Set(date:TDateTime; latitude, longitude:extended):TDateTime;
  1599. begin
  1600.   result:=Calc_Set_Rise(date,latitude,longitude,false,_set);
  1601.   end;
  1602. (*@\\\000000033B*)
  1603. (*@/// function Moon_Transit(date:TDateTime; latitude, longitude:extended):TDateTime; *)
  1604. function Moon_Transit(date:TDateTime; latitude, longitude:extended):TDateTime;
  1605. begin
  1606.   result:=Calc_Set_Rise(date,latitude,longitude,false,_transit);
  1607.   end;
  1608. (*@\\\000000033F*)
  1609.  
  1610. { Checking for eclipses }
  1611. (*@/// function Eclipse(var date:TDateTime; sun:boolean):TEclipse; *)
  1612. function Eclipse(var date:TDateTime; sun:boolean):TEclipse;
  1613. var
  1614.   jde,kk,m,ms,f,o,e: extended;
  1615.   t,f1,a1: extended;
  1616.   p,q,w,gamma,u: extended;
  1617. begin
  1618.   if sun then
  1619.     calc_phase_data(date,NewMoon,jde,kk,m,ms,f,o,e)
  1620.   else
  1621.     calc_phase_data(date,FullMoon,jde,kk,m,ms,f,o,e);
  1622.   t:=kk/1236.85;
  1623.   if abs(sin_d(f))>0.36 then
  1624.     result:=none
  1625. (*@///   else *)
  1626. else begin
  1627.   f1:=f-0.02665*sin_d(o);
  1628.   a1:=299.77+0.107408*kk-0.009173*t*t;
  1629.   if sun then
  1630.     jde:=jde - 0.4075     * sin_d(ms)
  1631.              + 0.1721 * e * sin_d(m)
  1632.   else
  1633.     jde:=jde - 0.4065     * sin_d(ms)
  1634.              + 0.1727 * e * sin_d(m);
  1635.   jde:=jde   + 0.0161     * sin_d(2*ms)
  1636.              - 0.0097     * sin_d(2*f1)
  1637.              + 0.0073 * e * sin_d(ms-m)
  1638.              - 0.0050 * e * sin_d(ms+m)
  1639.              - 0.0023     * sin_d(ms-2*f1)
  1640.              + 0.0021 * e * sin_d(2*m)
  1641.              + 0.0012     * sin_d(ms+2*f1)
  1642.              + 0.0006 * e * sin_d(2*ms+m)
  1643.              - 0.0004     * sin_d(3*ms)
  1644.              - 0.0003 * e * sin_d(m+2*f1)
  1645.              + 0.0003     * sin_d(a1)
  1646.              - 0.0002 * e * sin_d(m-2*f1)
  1647.              - 0.0002 * e * sin_d(2*ms-m)
  1648.              - 0.0002     * sin_d(o);
  1649.   p:=        + 0.2070 * e * sin_d(m)
  1650.              + 0.0024 * e * sin_d(2*m)
  1651.              - 0.0392     * sin_d(ms)
  1652.              + 0.0116     * sin_d(2*ms)
  1653.              - 0.0073 * e * sin_d(ms+m)
  1654.              + 0.0067 * e * sin_d(ms-m)
  1655.              + 0.0118     * sin_d(2*f1);
  1656.   q:=        + 5.2207
  1657.              - 0.0048 * e * cos_d(m)
  1658.              + 0.0020 * e * cos_d(2*m)
  1659.              - 0.3299     * cos_d(ms)
  1660.              - 0.0060 * e * cos_d(ms+m)
  1661.              + 0.0041 * e * cos_d(ms-m);
  1662.   w:=abs(cos_d(f1));
  1663.   gamma:=(p*cos_d(f1)+q*sin_d(f1))*(1-0.0048*w);
  1664.   u:= + 0.0059
  1665.       + 0.0046 * e * cos_d(m)
  1666.       - 0.0182     * cos_d(ms)
  1667.       + 0.0004     * cos_d(2*ms)
  1668.       - 0.0005     * cos_d(m+ms);
  1669. (*@///   if sun then *)
  1670. if sun then begin
  1671.   if abs(gamma)<0.9972 then begin
  1672.     if u<0 then
  1673.       result:=total
  1674.     else if u>0.0047 then
  1675.       result:=circular
  1676.     else if u<0.00464*sqrt(1-gamma*gamma) then
  1677.       result:=circulartotal
  1678.     else
  1679.       result:=circular;
  1680.     end
  1681.   else if abs(gamma)>1.5433+u then
  1682.     result:=none
  1683.   else if abs(gamma)<0.9972+abs(u) then
  1684.     result:=noncentral
  1685.   else
  1686.     result:=partial;
  1687.   end
  1688. (*@\\\*)
  1689. (*@///   else *)
  1690. else begin
  1691.   if (1.0128 - u - abs(gamma)) / 0.5450 > 0 then
  1692.     result:=total
  1693.   else if (1.5573 + u - abs(gamma)) / 0.5450 > 0 then
  1694.     result:=halfshadow
  1695.   else
  1696.     result:=none;
  1697.   end;
  1698. (*@\\\0000000801*)
  1699.   end;
  1700. (*@\\\*)
  1701.   date:=delphi_date(jde);
  1702.   end;
  1703. (*@\\\0000000E01*)
  1704. (*@/// function NextEclipse(var date:TDateTime; sun:boolean):TEclipse; *)
  1705. function NextEclipse(var date:TDateTime; sun:boolean):TEclipse;
  1706. var
  1707.   temp_date: TDateTime;
  1708. begin
  1709.   result:=none;    (* just to make Delphi 2/3 shut up, not needed really *)
  1710.   temp_date:=date-28*2;
  1711.   while temp_date<date do begin
  1712.     temp_date:=temp_date+28;
  1713.     result:=Eclipse(temp_date,sun);
  1714.     end;
  1715.   date:=temp_date;
  1716.   end;
  1717. (*@\\\003C000501000501000503000509000B01*)
  1718.  
  1719. end.
  1720.