home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol080 / sightred.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-04-29  |  3.2 KB  |  113 lines
  1. program sightred;
  2. {this program performs the navigational(spherical) triangle
  3. solution for celestial navigation sight reduction}
  4. const convert = 0.0174532925;
  5. var lat,x,Z,Hc,LHA,Dec : real;
  6.     hemis, hemi, loop  : char;
  7.     continue           : boolean;
  8.  
  9. function arcsin(x:real):real;
  10. begin arcsin := arctan(x/sqrt(-x*x+1)) end;
  11.  
  12. function arccos(x:real):real;
  13. begin arccos := -arctan(x/sqrt(-x*x+1))+1.5708 end;
  14.  
  15. procedure getlat;
  16. var degrees : integer;
  17.     minutes : real;
  18. begin
  19.     repeat
  20.     writeln;
  21.     writeln('  Enter dead reckoning latitude in the format:');
  22.     writeln('degrees <cr> minutes <cr> N/S <cr>');
  23.     writeln;
  24.     write  ('degrees: '); readln(degrees);
  25.     write  ('minutes: '); readln(minutes);
  26.     write  ('N or S : '); read  (hemi);
  27.     until (hemi = 'N') or (hemi = 'S');
  28. lat := (degrees + minutes/60) * convert;     
  29. {change degrees to decimal, then convert degrees to radians}
  30. end;  {getlat procedure}
  31.  
  32. procedure getlha;
  33. var degrees : integer;
  34.     minutes : real;
  35.     check   : char;
  36. begin
  37.     repeat
  38.     writeln;
  39.     writeln('  Enter local hour angle (LHA) in the format:');
  40.     writeln('degrees <cr> minutes <cr> and A to accept.');
  41.     writeln(' (any character other than A will repeat input)');
  42.     writeln;
  43.     write  ('degrees: ');readln(degrees);
  44.     write  ('minutes: ');readln(minutes);
  45.     write  ('Accept?  ');read  (check);
  46.     until (check = 'a') or (check = 'A');
  47. LHA := (degrees + minutes/60) * convert;
  48. end;      {of getlha procedure}
  49.  
  50. procedure getdec;
  51. var degrees : integer;
  52.     minutes : real;
  53.     check   : char;
  54. begin
  55.     repeat
  56.     writeln;
  57.     writeln('  Enter declination in the format:');
  58.     writeln('hemisphere <cr> degrees <cr> minutes <cr>');
  59.     writeln('Then A to accept (any other char will repeat input)');
  60.     writeln;
  61.     repeat
  62.     write  ('hemisphere (N/S) : ');read(hemis);
  63.     until (hemis = 'N') or (hemis = 'S');
  64.     write  ('degrees          : ');readln(degrees);
  65.     write  ('minutes          : ');readln(minutes);
  66.     write  ('Accept ?         : ');read  (check);
  67.     until (check = 'a') or (check = 'A');
  68. Dec := (degrees + minutes/60) * convert;
  69. end;    {getdec procedure}
  70.  
  71. procedure altitude (var Hc:real);
  72. var alt1 : integer;
  73.     alt2 : real;
  74. begin
  75.     alt1 := trunc(Hc);
  76.     alt2 := (Hc-alt1)*60;
  77.     writeln;
  78.     writeln('  Computed altitude, Hc, is ',alt1,'-',alt2:5:2);
  79. end;    {altitude procedure}
  80.  
  81. procedure azimuth (var Z,LHA:real; hemi:char);
  82. var Zn : real;
  83. begin
  84. LHA := LHA/convert;
  85.     begin {quadrant determination}
  86.     if hemi = 'N' then if LHA > 180 then Zn := Z
  87.                                         else Zn := 360 - Z
  88.               else if LHA > 180 then Zn := 180 - Z
  89.                     else Zn := 180 + Z
  90.     end;  {of quadrant determination}
  91. writeln('  True azimuth, Zn = ',Zn:5:1);
  92. end;    {azimuth procedure}
  93.  
  94. begin    {main program}
  95.     continue := true;
  96. getlat;
  97.     while continue = true do
  98.     begin
  99.     getdec;
  100.     getlha;
  101.     if hemi <> hemis then dec := -(dec); {contrary name}
  102. Hc := arcsin(sin(lat)*sin(dec)+cos(lat)*cos(dec)*cos(LHA));
  103. Z  := arccos((sin(dec)-(sin(lat)*sin(Hc)))/(cos(lat)*cos(Hc)));
  104. Hc := Hc/convert; Z := Z/convert; {radians to degrees}
  105. altitude(Hc);
  106. azimuth (Z,LHA,hemi);
  107. writeln;
  108. write  ('  Another reduction from same DR latitude? Y/N ');
  109. read   (loop);
  110. if (loop <> 'Y') and (loop <> 'y') then continue := false;
  111. end;
  112. end.
  113.