PROGRAM NASA_NOR;

{  Programme de codage Two Lines d'un satellite aux normes NASA, pour une utilisation dans
   Traksat, STK et bien d'autres logiciels de trajectographie}

 uses wincrt;
 label fini;
 var A1,A2,A3,A4,ligne1,ligne2,nom,num,nomfichier:string;
     ch,reponse:char;
     fichier:text;
     existe: boolean;
     e,i,pw,gw,m,n,axe:string;
     datean,dateheure:string;
     a:real;

 PROCEDURE OUVERTURE_FICHIER;

 label INITIAL,FINI;

 var reponse: string;

 BEGIN

  INITIAL:

  clrscr; writeln;

  WriteLn('                     ****************************************');
  WriteLn('                     CODAGE TWO LINES ELEMENTS D''UN SATELLITE');
  WriteLn('                     ****************************************');
  WriteLn;
  writeln('       NOM DU FICHIER TEXTE EXISTANT DANS LEQUEL VOUS VOULEZ AJOUTER ULES DEUX');
  writeln('       LIGNES D''UN NOUVEAU SATELLITE  (Connez le chemin complet svp ):');
  writeLn('              Exemple : E:\Satellite\...\..\Liste.txt  ');
  writeLn;
  WriteLn('                     ****************************************');
  writeLn('       EVENTUELLEMENT CREEZ UN FICHIER TEXTE VIDE, ET REVENEZ DONNER SON CHEMIN');
  WriteLn('                     ****************************************');
  writeln;
  write('      NOM COMPLET DU FICHIER TEXTE RECEVANT LES 2 LIGNES (CHEMIN :====>');readln(nomfichier);
  writeln;

  {$I-}

  Assign(fichier,nomfichier);

  Append(fichier);

  existe:=(IORESULT<>0);

  If existe then
       begin
          Write('     ERREUR PROBABLE DE FICHIER,VOULEZ-VOUS RECOMMENCER (o/n)? ');
          readln(reponse);

          If reponse='o' then GOTO INITIAL;
       	  If reponse='n' then exit;

       end;

  Writeln('      LE FIChIER A ETE TROUVE ET OUVERT POUR ENREGISTRER LE CODAGE TWO LINES  ');
  writeln;
END;


  PROCEDURE NOM_SATELLITE;

  BEGIN


  Write('     Donnez un nom à votre satellite (11 caractères maximum) :--->');readln(nom);

  END;

(*-------------------------------------------------------------------------*)

PROCEDURE NUMERO;

 var numerosatellite:real;


BEGIN

     writeln;
     write('     Numéro du satellite en 5 chiffres maximum ( peu d''importance sauf pour une lign"e de satellites):---> ');
     readln(numerosatellite); writeln;
     str(numerosatellite:5:0,num);
     A1:='1'+' '+num+'U';
     ligne1:=A1;
END;

(*-------------------------------------------------------------------------*)

PROCEDURE DATE_JULIENNE_ANNEE;

 const jourmois:array[1..12] of real=(0,31,59,90,120,151,181,212,243,
		273,304,334);


 var jour,mois,annee,h,mn,s:integer;
     chnj,date,heure,an:string;
     erreur,x:integer;
     ajour,jj:real;

  BEGIN
	Begin
	 write('     Donnez la date sous la forme 09/04/93 --->');
	 readln(date);writeln;
	 {Analyse de la date}

	 chnj:=copy(date,1,2);
	 val(chnj,jour,erreur);
	 chnj:=copy(date,4,2);
	 val(chnj,mois,erreur);
	 chnj:=copy(date,7,2);
	 val(chnj,annee,erreur);

	 {Lecture et analyse de l'heure,tests de conformite}
	  write('     Donnez l''heure sous la forme 02:04:56 ---> ');
	  readln(heure);writeln;

	   chnj:=copy(heure,1,2);
           val(chnj,h,erreur);
           chnj:=copy(heure,4,2);
           val(chnj,mn,erreur);
           chnj:=copy(heure,7,2);
           val(chnj,s,erreur);

        x:=annee mod 4;
        if x<>0 then ajour:=jour
                else if(mois<3) then ajour:=jour
                                else ajour:=jour+1;
        ajour:=ajour+jourmois[mois];

        JJ:=ajour+(h+mn/60+s/3600)/24;

      end;
      str(JJ:3:8,A2);

      if JJ<10 then A2:='  '+A2;
      if ((JJ>=10) and (JJ<100)) then A2:= ' '+A2;

      str(annee:2,an);
      ligne1:=ligne1+'          '+an+A2+' ';
      datean:=date;dateheure:= heure;
    end;

 PROCEDURE DERIVEE_PREMIERE_MOYEN_MOUVEMENT;

 var deriveemoyenmouvement:string;

 BEGIN

   (*writeln('     On demande de donner la dérivée premiere du moyen mouvement ');
     writeln('     en révolutions par jour ou le coefficient balistique SCX/M');
     writeln('     A defaut de renseignementts plus precis donnez une valeur nulle ');
     writeln;
     write('     Donnez cette valeur:---> ');readln(deriveemoyenmouvement);  *)
     deriveemoyenmouvement:='0.00000000';

     (*str(deriveemoyenmouvement:10:8,A3);*)

     ligne1:=ligne1+deriveemoyenmouvement+' ';


 END;

 PROCEDURE DERIVEE_SECONDE_MOYEN_MOUVEMENT;

 BEGIN

    ligne1:=ligne1+'000000'+'-'+'0'+' ';

 END;

 PROCEDURE TERME_DE_TRAINEE;

 BEGIN

    ligne1:=ligne1+'000000'+'-'+'0'+' ';


 END;

 PROCEDURE TYPE_EPHEMERIDES;

 var ephem:integer;

 BEGIN

   {write('     Donnez le type d''éphémérides, 0 en general ( Sauf cas particulier ):---> ');readln(ephem);
   writeln;}
   ephem:=0;
   str(ephem:1,A4);
   ligne1:=ligne1+A4+' ';


 END;


 PROCEDURE NOMBRE_ELEMENTAIRE;

 BEGIN

   ligne1:=ligne1+'    ';


 END;


 PROCEDURE VERIFICATION1;

 var verif,i,j,v,erreur:integer;
     x,testligne1:string;

 const chiffres:array[1..9] of string=('1','2','3','4','5','6','7','8','9');


 BEGIN

  verif:=0;
  for i:=1 to length(ligne1) do


  	begin

        x:=copy(ligne1,i,1);

           for j:=1 to 9 do
           	begin
        	  if (x=chiffres[j]) then
			begin
                           val(x,v,erreur);
                           verif:=verif+v;
                        end;
                end;
         if x='-' then v:=1 else if x='+' then v:=2 else v:=0;

         verif:=verif+v;

        end;

   verif:=verif mod 10;
   str(verif:1,testligne1);

   ligne1:=ligne1+testligne1;


 END;

 PROCEDURE NUMERO_LIGNE2;

 BEGIN

 LIGNE2:='2'+' '+num+' ';

 END;


 PROCEDURE INCLINAISON;

 var inclinaison:real;
     incl:string;

 BEGIN

 Write('     Donnez l''inclinaison en degrés(4 décimales max)--->');
 readln(inclinaison);writeln;
 str(inclinaison:8:4,INCL);
 ligne2:=ligne2+incl+' ';
 i:=INCL;
 END;


 PROCEDURE LONGITUDE_VERNALE;

 var vernale:real;
     longitude:string;

 BEGIN

 Write('     Donnez la longitude vernale en degrés(4 décimales max)--->');
 readln(vernale);writeln;
 str(vernale:8:4,longitude);
 ligne2:=ligne2+longitude+' ';
 gw:=longitude;


 END;

 PROCEDURE EXCENTRICITE;

 var excentricite:real;
     exc:string;

 BEGIN
 writeln('     ATTENTION: même pour un cercle donner e = 0.0000001)');
 writeln;
 write('     Donnez l''excentricité sous forme 0.xxx(7 décimales max):--->');

 readln(excentricite);writeln;
 str(excentricite:1:7,exc);
 exc:=copy(exc,3,7);
 ligne2:=ligne2+exc+' ';
 e:=exc;
 END;


 PROCEDURE ARGUMENT_NODAL_PERIGEE;

 var argument:real;
     arg:string;

 BEGIN

 write('     Donnez l''argument nodal du périgée en degrés (4 décimales maximum):--->');

 readln(argument);writeln;
 str(argument:8:4,arg);
 ligne2:=ligne2+arg+' ';
 pw:=arg;
 END;



 PROCEDURE ANOMALIE_MOYENNE;

 var anomalie:real;
     anomal:string;

BEGIN

 write('     Donnez l''anomalie moyenne M en degrés(4 décimales max):--->');

 readln(anomalie);writeln;
 str(anomalie:8:4,anomal);
 ligne2:=ligne2+anomal+' ';
 m:=anomal;
 end;



PROCEDURE MOYEN_MOUVEMENT;

var moymouv:real;
    mouvmoy:string;

BEGIN

 write('     Donnez le moyen mouvement en révolutions/jour(8 décimales max):--->');

 readln(moymouv);writeln;
 str(moymouv:11:8,mouvmoy);
 ligne2:=ligne2+mouvmoy+' ';
 n:=mouvmoy;

END;

PROCEDURE REVOLUTIONS;

var nbre:integer;
    revol:string;

BEGIN


write('     Nombre entier de révolutions effectuées à ce jour(<10000):--->');

 readln(nbre);writeln;
 str(nbre:4,revol);
 ligne2:=ligne2+revol;


END;

  PROCEDURE VERIFICATION2;

 var verif,i,j,v,erreur:integer;
     x,testligne2:string;

 const chiffres:array[1..9] of string=('1','2','3','4','5','6','7','8','9');


 BEGIN

  verif:=0;
  for i:=1 to length(ligne2) do


  	begin

        x:=copy(ligne2,i,1);

           for j:=1 to 9 do
           	begin
        	  if (x=chiffres[j]) then
			begin
                           val(x,v,erreur);
                           verif:=verif+v;
                        end;
                end;
         if x='-' then v:=1 else if x='+' then v:=2 else v:=0;

         verif:=verif+v;

        end;

   verif:=verif mod 10;
   str(verif:1,testligne2);

   ligne2:=ligne2+testligne2;


 END;

 PROCEDURE ECRITURE_FICHIER;

 BEGIN
 writeLn(fichier,'-------------------------------------------------------------------------');
 writeln(fichier,nom);
 writeln(fichier,ligne1);
 writeln(fichier,ligne2);
 writeLn(fichier,'-------------------------------------------------------------------------');

 close(fichier);

 END;

 PROCEDURE RAPPELS;
 var nval:real;
     erreur:integer;
 BEGIN
 Val(n,nval,erreur);
 a:=EXP((1/3)*Ln(398600*(86400/nval)*(86400/nval)/4/pi/pi));
 str(a:8:4,axe);
 WriteLn('                         RAPPELS DE VOS DONNEES');
 writeLn;
 WriteLn('         Date calendaire = ',datean);
 WriteLn('         Heure = ',dateheure);
 WriteLn('         Inclinaison = ',i,'  degrés');
 WriteLn('         Longitude vernale de la ligne des noeuds = ',gw,'  degrés');
 WriteLn('         Argument nodal du périgée = ',pw,'  degrés');
 WriteLn('         Anomalie moyenne à la date ', datean,'  ',dateheure,'  = ',m,'  radians');
 WriteLn('         Moyen mouvement = ',n,'  revs/jour');
 WriteLn('         Soit un demi-grand axe a =',axe, ' km');
 WriteLn;
 WriteLn('     -------------------------------------------------------------');

 END;

(*-------------------------------------------------------------------------*)

(*PROGRAMME PRINCIPAL*)

BEGIN

 OUVERTURE_FICHIER;
 writeln;

 if existe then goto fini;

 writeln('                     CODAGE NASA-NORAD D''UN SATELLITE');
 writeln;writeln;
 writeln('                     *********************************');
 writeln('                        ** CODAGE DE LA LIGNE 1 **');

 NOM_SATELLITE;
 NUMERO;
 DATE_JULIENNE_ANNEE;
 DERIVEE_PREMIERE_MOYEN_MOUVEMENT;
 DERIVEE_SECONDE_MOYEN_MOUVEMENT;
 TERME_DE_TRAINEE;
 TYPE_EPHEMERIDES;
 NOMBRE_ELEMENTAIRE;
 VERIFICATION1;

 writeln('                       ** CODAGE DE LA LIGNE 2 **');writeln;

 NUMERO_LIGNE2;
 INCLINAISON;
 LONGITUDE_VERNALE;
 EXCENTRICITE;
 ARGUMENT_NODAL_PERIGEE;
 ANOMALIE_MOYENNE;
 MOYEN_MOUVEMENT;
 REVOLUTIONS;
 VERIFICATION2;
 writeln;
 write('     PUIS-JE ECRIRE DANS LE FICHIER ',nomfichier,' (o/n):--->');readln(reponse);
 if reponse='n' then goto fini;
 ECRITURE_FICHIER;


 writeln('     ------------------------------------------------------------');
 writeln('     Résultat du codage');writeln;
 Writeln('     ',nom);
 writeln('     ',ligne1);
 writeln('     ',ligne2);
 writeln;writeln('                            ECRITURE REALISEE AVEC SUCCES ');writeln;
 writeln;
 writeln('     ------------------------------------------------------------');
 writeln;
 RAPPELS;
 fini:writeln('                          Pour quitter appuyer sur une touche');

 ch:=readkey;
 donewincrt;

END.