{$N+}

program temporaire;
uses crt,strings,ecrt,printer,windos;

Const
eps =1E-6;
fich=11;
dimpix= 1024;
dimpa=300;


TYPE
Tab=Array[1..fich,1..dimpix] of single;
Arraypix=Array[1..dimpix] of single;
Arfich=Array[1..fich] of single;
Arraypa=Array[1..dimpa] of single;
IArray=Array[1..dimpix] of integer;

Var i,j,k,l,lmax,r,ia,imax,increment,nbfich:integer;
    nmes:INTEGER;
    inc:integer;
    rmin,rmax,dr,rminpa,rmaxpa:integer;
    ic,icc,accos,actot,acep:integer;
    mu,nu,contpa,contss:single;
    atest,btest,ctest,inf,sup,contmax,contremp,coup:single;
    rej,rej1,rejcos,rejfcos,spmoy:single;
    pacos,paf,acos,bcos:single;
    q1,q2,q3,q4,q5,qq,qt,ch,touche:char;
    qpa,qpa1,qpa2,qr:char;
    contfici:Tab;
    ict:IArray;
    rejf,contmoy:Arraypix;
    ctpa,ctsort,contcos,cosort,mu1:Arraypa;
    cpa,conts,contsorts:Arfich;
    spcos,spsort,spcosort,nu1:Arfich;
    poscent,nomb,puilas,pression,fente:string[10];
    theta,nomgaz,polaris:string[10];
    comm1,comm2:string[40];
    mpas:integer;
    apa,mpas1:single;
    r1,r2:integer;
    fabs,fabs1,tinteg:single;
    nom,nomfich,rens,txaf,txaf1:string;
    f_out,f_in:text;
    LABEL 10,20,40,45,50,99;


Procedure Lectcycle(Var contfici:tab;Var nbfich:integer);

Var i,j,k,increment,code,r:integer;
    num:real;
    txt,txt1,txt2,numc,fin:String;

BEGIN
   writeln;
   increment:=1;
   write(' Nom du fichier de donnees ? ');
   readln(rens);
   rens:=rens+'.asc';
   assign(f_in,rens);
   reset(f_in);
   For i:=1 to 5 DO readln(f_in,txt1);
   readln(f_in,nbfich);
   writeln;
   writeln(' Le nombre de fichiers lu est de:      ',nbfich:3);
   delay(200);
   For i:=1 to 88  DO readln (f_in,txt1);
   readln(f_in,txt2);
   writeln;
   writeln(txt2);
   numc:=copy(txt2,11,2);
   while Pos(' ', numc) > 0 do
   numc[Pos(' ', numc)] := '.';
   val(numc,num,code);
   r:=Trunc(num);
   For i:=1 to dimpix DO
   BEGIN
   readln(f_in,contfici[r,i]);
   END;
   IF(nbfich<=1) THEN  BEGIN
     readln(f_in,fin);
     Writeln;
     writeln(fin);
     Writeln;
     Writeln(' Tappez une touche pour continuer');
     q1:=readkey;
     END
   ELSE
   BEGIN
   increment:=2;
   REPEAT
   For i:=1 to 45  DO readln (f_in,txt1);
   readln(f_in,txt2);
   writeln;
   writeln(txt2);
   numc:=copy(txt2,11,2);
   while Pos(' ', numc) > 0 do
   numc[Pos(' ', numc)] := '.';
   val(numc,num,code);
   r:=Trunc(num);
     For i:=1 to dimpix DO
     BEGIN
     readln(f_in,contfici[r,i]);
     END;
     increment:=increment+1;
     UNTIL increment>=(nbfich+1);
   readln(f_in,fin);
   writeln;
   writeln(fin);
   Writeln;
   Writeln(' Tappez une touche pour continuer');
   q1:=readkey;
   END;
END;

{************************************************************}

Procedure sort(nm:integer;conts:Arfich;Var contsorts:Arfich);

Var i,ia,imax,increment:integer;
    contmax,contremp,contmed:real;
    label 20;


BEGIN
  increment:=nm;
  For ia:=increment DOWNTO 2 DO BEGIN
  contmax:=-70000;
    FOR i:=1 to ia DO BEGIN
        if(conts[i]<contmax) then goto 20;
        contmax:=conts[i];
        imax:=i;
        20:continue;
        END;
    contremp:=conts[ia];
    conts[ia]:=conts[imax];
    conts[imax]:=contremp;
  END;
For i:=1 to nm DO contsorts[i]:=conts[i];
END;

{************************************************************************}

Procedure test(nt,r:integer;contt:arfich;a,b,c:single;
               Var incremoy:integer;Var spcos:arfich;Var contmoy:single);

Var med,med1,med2:integer;
    contrac,inf,sup:single;
    acontmed,contmed:real;
    i,ib,increment:integer;

Label 30,35;


BEGIN
increment:=nt;
IF (nt mod (2)= 0 ) THEN BEGIN
   med1:=Trunc(increment/2);
   med2:=Trunc((increment/2)+1);
   contmed:=0.5*(contt[med1]+contt[med2]);
   END
ELSE
BEGIN
med:=increment+1;
med:=Trunc(med*0.5);
contmed:=contt[med];
END;
{acontmed:=Abs(contmed); }
IF contmed <=0.00001 THEN acontmed:=-contmed+0.00001
                     ELSE acontmed:=contmed;
contrac:=a + b*sqrt(acontmed)+c*acontmed;
inf:=contmed-contrac;
sup:=contmed+contrac;


{IF (sup<0) THEN BEGIN
   Writeln;
   Writeln('Numero pixel: ', r:3);
   Writeln('Valeur de la mediane : ',contmed:4:3);
   Writeln('Lim inf= ',inf:4:3,' Lim sup= ',sup:4:3);
   Writeln;
   Writeln('Test non possible car Lim inf et(ou) Li msup <0');
   Writeln('Tapez une touche pour sortir');
   ch:= readkey;
   Halt;
   END;}

incremoy:=0;
contmoy:=0;
FOR ib:=1 to increment DO BEGIN
    if (contt[ib]<inf) then goto 30;
    if (contt[ib]>sup) then goto 30;
    contmoy:=contmoy+contt[ib];
    incremoy:=incremoy+1;
    spcos[incremoy]:=contt[ib];
    30:continue;
    END;
IF (incremoy=0)  THEN contmoy:=0
                 ELSE contmoy:=contmoy/incremoy;
END;

{************************************************************************}
Procedure sorta(nm:integer;cont:Arraypa;Var contsort:Arraypa);

Var i,ia,imax,increment:integer;
    contmax,contremp,contmed:real;
    label 20;


BEGIN
  increment:=nm;
  IF increment>=dimpa THEN BEGIN
     Writeln (' Le nombre de points ne doit pas depasser ', dimpa:5);
     Delay(800);
     Halt;
     END;
  For ia:=increment DOWNTO 2 DO BEGIN
  contmax:=-70000;
    FOR i:=1 to ia DO BEGIN
        if(cont[i]<contmax) then goto 20;
        contmax:=cont[i];
        imax:=i;
        20:continue;
        END;
    contremp:=cont[ia];
    cont[ia]:=cont[imax];
    cont[imax]:=contremp;
  END;
For i:=1 to increment DO contsort[i]:=cont[i];

END;

{************************************************************************}
Procedure tpacos(nt:integer;contt:arraypa;a:single;
               Var ic:integer;Var contcos:Arraypa;Var contpa:single);

Var ib,increment,med,med1,med2:integer;
    contmed,inf,sup:single;

Label 30,35;


BEGIN
increment:=nt;
IF increment>=dimpa THEN BEGIN
   Writeln (' Le nombre de points ne doit pas depasser ', dimpa:5);
   Delay(800);
   Halt;
   END;
IF (increment mod (2)=0) then BEGIN
   med1:=Trunc(increment/2);
   med2:=Trunc((increment/2)+1);
   contmed:=0.5*(contt[med1]+contt[med2]);
   END
ELSE
   BEGIN
   med:=increment+1;
   med:=Trunc(med*0.5);
   contmed:=contt[med];
   END;
inf:=contmed-a;
sup:=contmed+a;

{IF (sup<0)THEN BEGIN
 Writeln;
 Writeln('Numero du spectre : ', i:3);
 Writeln('Valeur de la mediane : ',contmed:4:3);
 Writeln('Valeur de la constante de test : ',a:7:5);
 Writeln('Lim inf= ',inf:4:3,' Lim sup= ',sup:4:3);
 Writeln;
 Writeln('Test non possible car Lim sup <0');
 Writeln('Tapez une touche pour sortir');
 ch:= readkey;
 Halt;
 END; }

ic:=0;
contpa:=0;
FOR ib:=1 to increment DO BEGIN
    if (contt[ib]<inf) then goto 30;
    if (contt[ib]>sup) then goto 30;
    ic:=ic+1;
    contcos[ic]:=contt[ib];
    contpa:=contpa+contt[ib];
    30:continue;
    END;
IF (ic=0) THEN contpa:=0
          ELSE contpa:=contpa/ic;
END;

{********************************************************************}

procedure prelim;

BEGIN
 clrscr;
 writeln('RENSEIGNEMENTS PRELIMINAIRES');
 writeln;
 REPEAT
 write(' Temps d''integration (en s.) ? ');
 readln(tinteg);
 IF(tinteg<=0.0) THEN Writeln(' Le temps d''integration doit etre >0');
 UNTIL (tinteg>0.0);
 writeln;
 writeln('Voulez vous ecrire les autres renseignements preliminaires (o ui/n on) ? ');
 writeln;
 ch:=readkey;
 If (ch='o') or (ch='O') then Begin
    write('Nom du gaz ? ');
    readln(nomgaz);
    write('Position centrale (en cm-1) ? ');
    readln(poscent);
    write('Pression (en bars) ? ');
    readln(pression);
    write('Polarisation ? ');
    readln(polaris);
    write('Largeur de fente (en microns) ? ');
    readln(fente);
    write('Temp‚rature (en K.) ? ');
    readln(theta);
    write('Puissance Laser (en W.) ? ');
    readln(puilas);
    writeln('Commentaires (2 lignes) :');
    readln(comm1);
    readln(comm2);
    end;
END;


{***********************************************************************}

procedure affiche;
Var r,ligne,ligne1:integer;
label 5;

BEGIN
ligne:=21;
r:=rmin;
dr:=rmax-rmin+1;
txaf:= '     pixel         int (coups/s)        rejet total       nb cosmique';
txaf1:='  pixel             int (coups)        int.(coups/s)         (rej/points traites)';
Writeln(nmes:5,' spectres etudies du pixel ',rmin:4,' au  pixel ',rmax:4);
Writeln(txaf);
FOR inc:=1 TO ligne DO BEGIN
     writeln('    ',r:5,'              ',contmoy[r]/tinteg:8:5,'             ',rejf[r]:5:3,'          ',nmes-ict[r]:3);
{    contss:=contmoy[r]/tinteg;
{    writeln('',r:5,'           ',contmoy[r]:4:3,'             ',contss:4:3,'          ','( ',rejf[r]:3,' /',ict[r]:3,' )');}
     r:=r+1;
     END;
REPEAT
  BEGIN
   ch:=readkey;
   IF (ch='2') THEN BEGIN
     IF (r<=rmax) Then BEGIN
      clrscr;
      Writeln(nmes:5,' spectres etudies du pixel ',rmin:4,' au  pixel ',rmax:4);
      Writeln(txaf);
       FOR inc:=1 TO ligne DO BEGIN
        IF (r<=rmax) THEN BEGIN
        writeln('    ',r:5,'              ',contmoy[r]/tinteg:8:5,'             ',rejf[r]:5:3,'          ',nmes-ict[r]:3);
        {contss:=contmoy[r]/tinteg;
        writeln('',r:5,'           ',contmoy[r]:4:3,'             ',contss:4:3,'          ',
        '( ',rejf[r]:3,' /',ict[r]:3,' )'); }
        r:=r+1;
        END;
       END;
     END;
   END;   {ch='2'}


   IF (ch='8') THEN BEGIN
    ligne1:=2*ligne;
     IF (r >=rmin) THEN BEGIN
     r:=r-44;
     clrscr;
     Writeln(nmes:5,' spectres etudies du pixel ',rmin:4,' au  pixel ',rmax:4);
     Writeln(txaf);
      FOR inc:=1 TO ligne DO BEGIN
      {IF (r>=rmin) THEN BEGIN  }
       writeln('    ',r:5,'              ',contmoy[r]/tinteg:8:5,'             ',rejf[r]:5:3,'          ',nmes-ict[r]:3);
       {contss:=contmoy[r]/tinteg;
       writeln('',r:5,'           ',contmoy[r]:4:3,'             ',contss:4:3,'          ',
       '( ',rejf[r]:3,' /',ict[r]:3,' )'); }
       r:=r+1;
   {   END;   }
      END;
     END;
   END; {ch='8'}

  END; {fin du begin apres le repeat}
UNTIL ch=' ';
END;

{***********************************************************************}

PROCEDURE imprimentete;
Var i:integer;

BEGIN
assign(lst,'LPT1');
rewrite(lst);
Writeln(lst);
Writeln(lst);
writeln(lst,'      ***** RENSEIGNEMENTS PRELIMINAIRES *****');
writeln(lst);
writeln(lst,'      Nom du gaz.....................=',nomgaz);
writeln(lst,'      Nom du fichier.................=',rens);
{writeln(lst,'      Date...........................=',dat1,':',dat2,':',dat3);
writeln(lst,'      Heure..........................=',heure1,':',heure2);}
writeln(lst,'      Position centrale(en cm-1).....=',poscent);
writeln(lst,'      Temps d''integration(en s.)....=',tinteg:5:2);
writeln(lst,'      Pression(en bars)..............=',pression);
writeln(lst,'      Polarisation...................=',polaris);
writeln(lst,'      Largeur de fente(en microns)...=',fente);
writeln(lst,'      Temperature(en Kelvins)........=',theta);
writeln(lst,'      Puissance Laser(en Watts)......=',puilas);
writeln(lst,'      nombre de spectres trait‚s ....=', nmes:5);
writeln(lst,'      intervalle (pixel).............= de ',rmin:5,' a ',rmax:5);
FOR i:=1 to nmes DO BEGIN
Writeln(lst,'      PA du spectre ',i:3,' ........ =' ,cpa[i]:5:2,' (coups)');
END;
writeln(lst);
writeln(lst,'      Commentaires :');
writeln(lst,'      ',comm1);
writeln(lst,'      ',comm2);
writeln(lst);
writeln(lst);
Writeln(lst,nmes:5,' spectres etudies du pixel ',rmin:4,' au  pixel ',rmax:4);
Writeln(lst,txaf);
END;
{************************************************************************}
PROCEDURE impconst;

BEGIN
Writeln(lst);
Writeln(lst);
Writeln(lst);
Writeln(lst,' Nom du fichier .......................................:',rens);
Writeln(lst,'********** Valeur des constantes pour les test *************');
Writeln(lst);
Writeln(lst,' Constante pour pic cosmique dans Partie Aveugle(PA)...:',pacos:5:2);
Writeln(lst,' Constante pour fluctuation du bruit dans PA...........:',paf:5:2);
Writeln(lst);
Writeln(lst,' Cosmique dans spectre; Intervalle: med+/- (acos*sqrt(mediane)+bcos');
Writeln(lst,' Constante 1 pour cosmique dans spectre:.... acos........:',acos:5:2);
Writeln(lst,' Constante 2 pour cosmique dans spectre:.... bcos........:',acos:5:2);
Writeln(lst);
Writeln(lst,' Bruits dans spectre;Intervalle:');
Writeln(lst,'      med+/- atest+btest*sqrt(abs(mediane))+ctest*abs(mediane)');
Writeln(lst,' Constante 1 pour bruit dans spectre:........atest........:',atest:5:2);
Writeln(lst,' Constante 2 pour cosmique dans spectre:.... btest........:',btest:5:2);
Writeln(lst,' Constante 2 pour cosmique dans spectre:.... ctest........:',ctest:5:2);
Writeln(lst);
Writeln(lst);
END;
{************************************************************************}
PROCEDURE modconst;

BEGIN
Writeln;
Writeln(' Constante pour pic cosmique dans Partie Aveugle(PA) ? ');
Readln(pacos);
Writeln(' Constante pour fluctuation du bruit dans PA ? ');
Readln(paf);
Writeln;
Writeln(' Cosmique dans spectre; Intervalle: med+/- (acos*sqrt(mediane)+bcos');
Writeln(' Constante 1 pour cosmique dans spectre : acos ? ');
Readln(acos);
Writeln(' Constante 2 pour cosmique dans spectre : bcos ? ');
Readln(bcos);
Writeln;
Writeln(' Bruits dans spectre;Intervalle med+/- ');
Writeln('     atest+btest*sqrt(abs(mediane))+ctest*abs(mediane)');
Writeln(' Constante 1 pour bruit dans spectre:  atest  ? ');
Readln(atest);
Writeln(' Constante 2 pour bruit dans spectre:  btest  ? ');
Readln(btest);
Writeln(' Constante 3 pour bruit dans spectre:  ctest  ? ');
Readln(ctest);
END;


{************************************************************************}

PROCEDURE afconst;

BEGIN
Writeln;
Writeln('********** Valeur des constantes pour les test *************');
Writeln;
Writeln(' Constante pour pic cosmique dans Partie Aveugle(PA)...:',pacos:5:2);
Writeln(' Constante pour fluctuation du bruit dans PA...........:',paf:5:2);
Writeln;
Writeln(' Cosmique dans spectre; Intervalle: med+/- (acos*sqrt(mediane)+bcos');
Writeln(' Constante 1 pour cosmique dans spectre:.... acos........:',acos:5:2);
Writeln(' Constante 2 pour cosmique dans spectre:.... bcos........:',bcos:5:2);
Writeln;
Writeln(' Bruits dans spectre;Intervalle: ');
Writeln('        med+/- (atest+btest*sqrt(abs(mediane))+ctest*abs(mediane)');
Writeln(' Constante 1 pour bruit dans spectre:........atest........:',atest:5:2);
Writeln(' Constante 2 pour cosmique dans spectre:.... btest........:',btest:5:2);
Writeln(' Constante 3 pour cosmique dans spectre:.... ctest........:',ctest:5:2);
Writeln;
END;

{************************************************************************}

PROCEDURE impression;
VAR r,r1,r2:integer;

BEGIN
Writeln('Voulez-vous imprimer (t)out ou une (p)artie des donn‚es ? (espace=non)');
qq:=readkey;
IF qq='t' THEN BEGIN
   r:=rmin;
   imprimentete;
   REPEAT
    BEGIN
    writeln(lst,'    ',r:5,'              ',contmoy[r]/tinteg:8:5,'             ',rejf[r]:5:3,'          ',nmes-ict[r]:3);
    {contss:=contmoy[r]/tinteg;
    writeln(lst,'',r:5,'           ',contmoy[r]:4:3,'             ',
    contss:4:3,'          ','( ',rejf[r]:3,' /',ict[r]:3,' )');}
    r:=r+1;
    END;
   UNTIL r>rmax;
  END;

{Impression partielle}
IF qq='p' THEN BEGIN
    REPEAT
    Writeln(' Pixel de debut pour l impression? doit etre >=   ',rmin:5);
    readln(r1);
    UNTIL (r1>=rmin);
   r:=r1;
    REPEAT
    Writeln(' Pixel de fin pour l impression ? doit etre <=   ',rmax:5);
    readln(r2);
    IF (r2>r1) THEN Writeln(' Pixel de fin pour l impression doit etre > ',r1:5,' et <=   ',rmax:5);
    UNTIL (r2<=rmax) and (r2 > r1);
   mpas:=1;
   Writeln(' Le pas en pixel est : ',mpas:5);
    REPEAT
    Writeln(' Modifier le pas (Oui/Non) ?');
    q5:=readkey;
    q5:=upcase(q5);
    UNTIL (q5='O') or (q5='N');
   IF q5='O' THEN BEGIN
      writeln('pas en pixel ? ');
      readln(mpas1);
      mpas:=trunc(mpas1);
      END;
     imprimentete;
     REPEAT
      BEGIN
      writeln(lst,'    ',r:5,'              ',contmoy[r]/tinteg:8:5,'             ',rejf[r]:5:3,'          ',nmes-ict[r]:3);
      {contss:=contmoy[r]/tinteg;
      writeln(lst,'',r:5,'           ',contmoy[r]:4:3,'             ',
      contss:4:3,'          ','( ',rejf[r]:3,' /',ict[r]:3,' )');  }
      r:=r+mpas;
      END;
     UNTIL (r>r2);
  END;

END;

{*****************************************************************}
Procedure Ecrit(nom:String);


Var r: integer;

BEGIN
 writeln(' Ecriture du fichier de sortie : ',nom, ' en cours ');
 assign(f_out,nom);
 rewrite (f_out);
{ writeln(f_out,'#onde   ','  coups   ','coups/s ',' canal ','rejet');}
 FOR r:=rmin to rmax DO BEGIN
       contss:=contmoy[r]/tinteg;
       writeln(f_out,r:5,'  ',contmoy[r]:8:5,'   ',contss:8:5,'  ',rejf[r]:5:3,'  ',(nmes-ict[r]):3);
{       writeln(' ',r:5,'   ',contmoy[r]:6:3,'  ',rejf[r]/ict[r]:6:3);
       ch:=readkey; }
       END;
close (f_out);
END;

{************************ Programme principal ******************** }

BEGIN
clrscr;
Lectcycle(contfici,nbfich);
nmes:=nbfich;

pacos:=100.;{constante pour pic cosmique dans partie aveugle}
paf:=20.;{constante pour fluctuation du bruit dans partie aveugle}
acos:=100.; {constante pour cosmique dans le spectre}
bcos:=10.; {constante pour cosmique dans le spectre}
atest:=2.0; {constante pour bruit dans le spectre}
btest:=1.5;{constante pour bruit dans le spectre}
ctest:=0.01;{constante pour bruit dans le spectre}
rminpa:=920;
rmaxpa:=1020;
rmin:=200;
rmax:=850;

Writeln;
Writeln(' Afficher les valeurs des constantes pour les tests (Oui/Non) ?');
ch:=readkey;
ch:=UPCASE(ch);
IF ch='O' THEN BEGIN
   afconst;
   Writeln;
   Writeln(' Modifier les valeurs de ces constantes de test (Oui/Non) ?');
   q3:=readkey;
   q3:=UPCASE(q3);
   IF q3='O' THEN modconst;
   END;
clrscr;
Writeln;
Writeln(' Determiner partie aveugle Oui/Non ? ');
qpa:=readkey;
qpa:=Upcase(qpa);
For i:=1 to nmes DO BEGIN
 IF qpa ='O' THEN BEGIN
    REPEAT
    Writeln;
    Writeln( '+++++++++++  Spectre traite n ø    ',i:3,'  +++++++++++++');
    Writeln(' Le pixel inferieur pour la partie aveugle est    ',rminpa:5);
    Writeln(' Le pixel superieur pour la partie aveugle est    ',rmaxpa:5);
    Writeln(' D autres valeur Oui/Non ?');
    qpa1:=readkey;
    qpa1:=Upcase(qpa1);
    IF qpa1 = 'O' THEN BEGIN
       Writeln(' Valeur du pixel inferieur pour la partie aveugle ? ');
       readln(rminpa);
       IF (rminpa<=0) THEN BEGIN
          Writeln('inf doit etre >0');
          delay(800);
          Halt;
          END;
       Writeln(' Valeur du pixel superieur pour la partie aveugle ? ');
       readln(rmaxpa);
       IF (rmaxpa>=1025) THEN BEGIN
          Writeln(' sup doit etre <1024');
          delay(800);
          Halt;
          END;
    END;
    l:=0;
    lmax:=(rmaxpa-rminpa)+1;
    IF lmax>=dimpa THEN BEGIN
       Writeln (' Le nombre de points ne doit pas depasser ',dimpa:5,'(Pour la gestion de la memoire');
       Delay(800);
       Halt;
       END;

    For k:=rminpa to rmaxpa DO BEGIN
        l:=l+1;
        ctpa[l]:=contfici[i,k];
        END;
    sorta(lmax,ctpa,ctsort);
    tpacos(lmax,ctsort,pacos,accos,contcos,mu);
    sorta(accos,contcos,cosort);
    tpacos(accos,cosort,paf,actot,mu1,contpa);
    cpa[i]:=contpa;
    rejcos:=lmax-accos;
    rej:=lmax-actot;
    rej1:=rej/accos;
    Writeln;
    Writeln( '**** Partie aveugle PA. Spectre traite n ø    ',i:3,'  ***************');
    Writeln('    Intensite PA dans [ ',rminpa:5,' , ',rmaxpa:5,' ] : ',cpa[i]:7:2,'   ');
    Writeln('***********************************************************************');
    Writeln(' Avec rej cosmique/nb points dans intervalle :  ',rejcos:5:2,' / ',lmax:5);
    Writeln(' Rej fluctuation/nb points traites ',rej:5:2,' / ',accos:5,' = ',rej1:5:2);
    Writeln;
    Writeln('Modifier pixels inf/sup (M); non=espace');
    qr:=readkey;
    qr:=Upcase(qr);
    Writeln;
    Writeln;
    UNTIL (qr <> 'M');
    END
  ELSE {pas de retranchement de partie aveugle }
  BEGIN
   cpa[i]:=0.0;
   END;
 END; {fin partie aveugle}


{***************** Fin determination  partie aveugle *******************}

clrscr;
{ bornes inf et sup des spectres : rmin et rmax }
Writeln;
Writeln(' ***************** Etude des spectres ****************** ');
Writeln;
Writeln( '+++ Pour tous les spectres: 1 a ',nmes:3,'  ++++++++++++');
Writeln(' Le pixel inferieur pour les spectres est    ',rmin:5);
Writeln(' Le pixel superieur pour les spectres est    ',rmax:5);
Writeln(' D autres valeur Oui/Non ?');
qpa2:=readkey;
qpa2:=Upcase(qpa2);
    IF qpa2 = 'O' THEN BEGIN
       Writeln;
       Writeln(' Valeur du pixel inferieur pour les spectres ? ');
       readln(rmin);
       IF (rmin<=0) THEN BEGIN
          Writeln('inf doit etre >0');
          delay(800);
          Halt;
          END;
       Writeln(' Valeur du pixel superieur pour les spectres ? ');
       readln(rmax);
       IF (rmax>=1025) THEN BEGIN
          Writeln(' sup doit etre <1024');
          delay(800);
          Halt;
          END;
     END; {fin de  qpa2 = 'O',bornes inferieures et superieures des spectres}

prelim;
FOR r:=rmin to rmax DO BEGIN
    For i:=1 to nmes DO  BEGIN
    conts[i]:=contfici[i,r]-cpa[i];
    END;
sort(nmes,conts,spsort);
test(nmes,r,spsort,acos,bcos,0.,icc,spcos,nu); {Elimination pics cosmiques}
sort(icc,spcos,spcosort);
test(icc,r,spcosort,atest,btest,ctest,acep,nu1,spmoy);
ict[r]:=icc;
rejfcos:=nmes-icc;
rejf[r]:=(nmes-acep)/nmes;
contmoy[r]:=spmoy;
{Writeln('r ',r:4,' rejcos ',rejfcos:5:2,'  rejtot ',rejf[r]/icc:5:2,'  ',contmoy[r]:5:3,'  ',icc:3);
ch:=readkey; }
END; {Boucle sur les r pixels de rmin a rmax}

affiche;
impression;
clrscr;
Writeln;
Writeln(' Imprimer la valeur des constantes pour les test ? (Oui/Non)');
ch:=readkey;
ch:=UPCASE(ch);
IF ch='O' THEN impconst;
clrscr;
Writeln;
Writeln;
REPEAT
writeln(' Sauvegarder les donnees traitees dans un fichier? (Oui/Non) ');
ch:=readkey;
ch:=upcase(ch);
UNTIL (ch='O')or (ch='N');
Writeln;
if (ch='O') then
   begin
   write(' Donner le nom du fichier de sortie ?  ');
   readln(nom);
   nom:=nom+'.trt';
   Ecrit(nom);
   end;

99:
END.