C     CETTE OPTION DOIT VENIR APRES LA MODIFICATION PAR
C     &GEISA PGM='TRS',UNITE='BINAIRE',MODIF='OUI' &END
C     LE PROGRAMME ANL MODIFIE LA BANQUE DE LA FACON SUIVANTE POUR
C     STOCKER LES FREQUENCES DES ISOTOPES DES MOLECULES :
C     EN RECORD 1 AJOUTER APRES LL1 LA VALEUR  DE LL2=1
C     A PARTIR DU RECORD IFIN+LL1 ECRIRE LES VALEURS SUIVANTES :
C     NTAB,(TAB(J),J=1,NTAB),(YMOY(J),J=1,20),(YMAX(J),J=1,20),
C     (ALF(J),J=1,20)
C     MODE=-1  APPEL NORMAL DE ANL POUR LISTER LES FREQUENCES MOLECULES
C              ENTRE NU1 ET NU2
C     MODE=0   MODIFICATION DE LA BANQUE (VOIR PRECEDEMMENT) DANS CE CAS
C              MODIF='OUI'
C     MODE=1   LISTE DES FREQUENCES  DE LA BANQUE PAR MOLECULE SANS
C              LECTURE DU FICHIER(OPTION PROVENANT DE PGM='INF')
C       
C     ANALYSE PAR MOLECULE ET PAR VARIETE ISOTOPIQUE DU CONTENU
C     DE LA BANQUE DANS UN DOMAINE SPECTRAL DONNE
C     HISTOGRAMME DES FREQUENCES DES RAIES POUR UNE CLASSE
C     D'INTENSITE (K=1) OU DE NIVEAU DE BASE (K=2)
C       
C     NU1,NU2 LIMITES INF ET SUP DU DOMAINE SPECTRAL ETUDIE
C     DNU PAS D'ETUDE(JUSQU'A 500 PAS SONT PREVUS)
C     PAR DEFAUT TOUT LE FICHIER AVEC 1 PAS D'ETUDE
C     XMIN(K),XMAX(K),PAS(K) RESPECTIVEMENT MINIMUM,MAXIMUM,LARGEUR
C     DE LA CLASSE POUR LES VARIABLES INTENSITE OU NIVEAU DE BASE
C     TAB(I) TABLEAU INDICE PAR LA VALEUR DES ISOTOPES ET CONTENANT LES
C            FREQUENCES DES ISOTOPES
C     CODE(I) TABLEAU CONTENANT LES CODES MOLECULES
C     NN      TABLEAU CONTENANT LE NOMBRE D'ISOTOPES PAR MOLECULE
C             SUIVI DES CODES ISOTOPES
C     ALF(I)  MOYENNE DES 1/2 LARGEUR A MI-HAUTEUR PAR MOLECULE
C     HIST(I,J) TABLEAU CONTENANT L'HISTOGRAMME A REPRESENTER
C               I=NUMERO DE LA CLASSE
C               J=1 HISTOGRAMME DES INTENSITES
C               J=3 HAUTEUR DES CLASSES POUR LES INTENSITES
C               J=2 HISTOGRAMME DES NIVEAUX DE BASE
C               J=4 HAUTEUR DES CLASSES POUR LES NIVEAUX DE BASE
C     ICAR  HAUTEUR MAX D'UNE CLASSE(45 CARACTERES)
C     IVAL=0 ANALYSE POUR TOUTES MOLECULES ET TOUS ISOTOPES(OPTION PAR D
C     IVAL#0 ANALYSE POUR UNE MOLECULE OU UN ISOTOPE
C            IVAL=NUMERO DE LA MOLECULE OU DE L'ISOTOPE
C     IRAN=1 POUR MOLECULE
C     IRAN=2 POUR ISOTOPE
C     MOLE=MOLECULE DEMANDEE EXEMPLE MOLE='H2O' OU 'CO2' ...
C     ISOT=ISOTOPE DEMANDE EXEMPLE ISOT=161 OU 162 ...
C     ANAL='OUI' ANALYSE PAR MOLECULE
C     ANAL=AUTRE PAS D'ANALYSE
C     HISTO='INTE' HISTOGRAMME INTENSITE (KHIST=1)
C     HISTO='BASE' HISTOGRAMME NIVEAU DE BASE (KHIST=2)
C     HISTO='DEUX' HISTOGRAMME INTENSITE ET NIVEAU DE BASE (KHIST=-1)
C     HISTO=AUTRE PAS D'HISTOGRAMME (OPTION PAR DEFAUT)
C     NBCLAS NOMBRE DE CLASSES DE L'HISTOGRAMME (PAR DEFAUT 10)
C     NHIST NOMBRE MAXIMUM DE CLASSES(50)
C     KANAL=0        HISTO
C     KANAL=1        ANAL
C     IUNI UNITE LOGIQUE CORRESPONDANT AU FICHIER SPECTRAL
C       
C --> SUBROUTINES APPELEES : IMPANL
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *
C  LAST MODIF:  06.05.91 PASSAGE A 75 MOLECULES DANS LES COMMON
C       
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *
      subroutine analy(tab,hist,xmin,xmax,ymoy,ymax,alf,qq,*)
C       
      logical*1 qq(1)
      character*9 trs1,trs2
      character*7 form,bin
      character*4 code,ctlg,mole,blanc,base,deux
      character*3 pgm,ianl,iext,itrs,ilst,icop,info,icre,
     &            oui,liste,iopt,modif,trans
      character*2 ikod,icod
      character*1 bl
      dimension pas(2),kode(2),alf(40)
C  NOUVEAU TABLEAU V DE LECTURE ON PASSE DE 16 -> 29 OCTETS
      real*8 ymoyd(40),ymaxd(40),cor,a2
      real v(29),ymoy(40),ymax(40),xmin(40),xmax(40)
      real nu1,nu2
      integer hist(1),tab(1),vers
C       
      common/p1/ nu1,nu2,dnu,nbclas,khist,kanal,vers,mode,liste
      common/p2/ mole(75),isot(100),nbi(75),nbt(75),iopt,ctlg,trans,
     &           trs1,trs2
      common/p3/ imole,iran,ival,pgm,ianl,iext,itrs,ilst,icop,info,icre
      common/p4/ nmol,knmol,ksot,kksot,ntab,nhist,kp,lre,form,bin,modif
      common/p5/ code(75),nn(150),nq(150),ikod(18),icod(18),jdeb(75)
      common/inteh/ incr,pas1,pmax
      common/entsor/iuni,juni,kuni,ient,isor,iper,nresv,maxx,blanc,oui
C       
      equivalence (kode(1),izot),(kode(2),imol)
      equivalence (a,v(1)),(izot,v(15)),(imol,v(16))
C       
      data nbklas/500/,ibase/950/,cor/1.d50/
C       
C     INITIALISATION DES TABLEAUX
C       
c     print *,' entree dans ANL'
      impr=0
c     print *,' mode=',mode
      if(mode.eq.-1) go to 6
c     print *,' appel PGEISA'
      call pgeisa(0.,99999.,999)
c     print *,' retour PGEISA'
999   read (iuni,rec=1)
     &nu1,nu2,anu,n203,nbraie,nbmol,iecr,ifin,ll1,ll2,ll3,ll4
      if(mode.eq.0) go to 7
      if(mode.eq.1.and.ll2.ne.0) go to 5
      write(isor,2000)
2000  format(///' *inf*   cette option est uniquement valable pour la ba
     &nque'/9x,'des donnees spectroscopiques'///)
      go to 900
5     continue
      ifin=ifin+ll1
      read (iuni,rec=ifin)
     &ntab,(tab(j),j=1,ntab),nmol,(ymoy(j),j=1,nmol),
     &(ymax(j),j=1,nmol),(alf(j),j=1,nmol)
      do 12 j=1,nmol
      ymoyd(j)=ymoy(j)*(1./cor)
      ymaxd(j)=ymax(j)*(1./cor)
12    continue
      call impanl(tab,nu1,nu2,impr,ymoyd,ymaxd,alf,qq,ibase)
      go to 900
6     continue
      call pgeisa(nu1,nu2,*900)
7     continue
      do 1 j=1,nmol
      ymoy(j)=0.
      ymax(j)=0.
      ymoyd(j)=0.
      ymaxd(j)=0.
1     alf(j)=0.
      nbc2=nbclas*2
      npas=nbklas
      do 10 j=1,npas
      xmin(j)=1.e20
      xmax(j)=0.
10    continue
      lk=ntab+nbc2
      do 11 j=1,lk
11    tab(j)=0
C       
C     CALCUL DES FREQUENCES PAR MOLECULE ET PAR ISOTOPE ET DES
C     MOYENNES ALFMOY
C       
      if(dnu.ne.0.) im=(nu2-nu1)/dnu
      if(im.gt.nbklas) nu2=nu1+float(nbklas)*dnu
      im=0
      anu1=nu1
      anu2=nu1+dnu
      if(dnu.eq.0.) anu2=nu2
100   continue
      call lgeisa(v,*200)
C       
C     TRAITEMENT PARTICULIER DES MOLECULES AYANT DES ISOTOPES DUPLIQUES
C     MOLE= 9 10 17 18 19 25 26 28 30 31 36 42
C       
C     DANS LE TABLEAU TAB LES INDICES  951 A 992 SONT RESERVES POUR
C     LES ISOTOPES DUPLIQUES (IBASE=950)
C BB 06.05.97 cas c2h4 ( 2 isotopes dupliques le 2emendice=ibase=950
C       
C            H2O  CO2  O3  N2O  CO   CH4  O2   NO   SO2  NO2  NH3  PH3
      go to (541, 541,541, 541, 541, 541, 541, 541, 509, 510, 541, 541,
C            HNO3 OH   HF   HCL  HBR  HI   CLO  OCS  H2CO C2H6 CH3D C2H2
     &       541, 541, 541, 541, 517, 518, 519, 541, 541, 541, 541, 541,
C            C2H4 GEH4 HCN  C3H8 C2N2 C4H2 HC3N HOCL N2   CH3CLH2O2 H2S
     &       525, 526, 541, 528, 541, 530, 531, 541, 541, 541, 541, 536,
C            HCOOH COF2 SF6 C3H4  HO2  CLONO2
     &       541,  541, 541, 541, 537,  541 ),imol
C       
C     SO2
509   continue
      if(izot.eq.626) izot=ibase+imol
      go to 541
C       
C     NO2
510   continue
      if(izot.eq.646) izot=ibase+imol
      go to 541
C       
C     HBR
517   continue
      if(izot.eq. 19) izot=ibase+imol
      go to 541
C       
C     HI
518   continue
      if(izot.eq. 17) izot=ibase+imol
      go to 541
C       
C     CLO
519   continue
      if(izot.eq. 56) izot=ibase+imol
      go to 541
C       
C     C2H4
525   continue
      if(izot.eq.211) izot=ibase+imol
      if(izot.eq.311) izot=ibase
      go to 541
C       
C     GEH4
526   continue
      if(izot.eq.411) izot=ibase+imol
      go to 541
C       
C     C3H8
528   continue
      if(izot.eq.221) izot=ibase+imol
      go to 541
C       
C     C4H2
530   continue
      if(izot.eq.211) izot=ibase+imol
      go to 541
C       
C     HC3N
531   continue
      if(izot.eq.124) izot=ibase+imol
      go to 541
C       
C     H2S
536   continue
      if(izot.eq.131) izot=ibase+imol
C     GO TO 541
C
C     HO2
537   continue
      if(izot.eq.166) izot=ibase+imol
C     GO TO 541
C       
541   continue
      if(a.le.anu2) go to 19
      if(kanal.eq.1) go to 16
      im=im+1
      anu1=anu2
      anu2=amin1(nu2,anu2+dnu)
      go to 20
16    continue
      call impanl(tab,anu1,anu2,impr,ymoyd,ymaxd,alf,qq,ibase)
      anu1=anu2
      anu2=amin1(nu2,anu2+dnu)
      do 17 j=1,lk
17    tab(j)=0
      do 18 j=1,nmol
      ymoy(j)=0.
      ymax(j)=0.
      ymoyd(j)=0.
      ymaxd(j)=0.
18    alf(j)=0.
      im=im+1
19    continue
      if(.not.qq(imol)) go to 100
      if(kanal.eq.0) go to 20
      tab(izot)=tab(izot)+1
      alf(imol)=alf(imol)+v(3)
      a2=v(2)*(1./cor)
      ymoyd(imol)=ymoyd(imol)+a2
Camax1 -> dmax1 ( real 8) BB 19/11/96
      ymaxd(imol)=dmax1(ymaxd(imol),a2)
C     ymax(imol)=amax1(ymax(imol),v(2))
C       
C     CALCUL DES MIN ET DES MAX DES CLASSES POUR LES INTENSITES ET LES
C     NIVEAUX DE BASE
C       
      if(khist.eq.0.or.khist.eq.1) go to 100
20    continue
      if(ival.ne.0.and.kode(iran).ne.ival) go to 100
      xmax(im+1)=amax1(xmax(im+1),v(4))
      xmin(im+1)=amin1(xmin(im+1),v(4))
      go to 100
200   continue
      if(kanal.eq.0) go to 24
      call impanl(tab,anu1,anu2,impr,ymoyd,ymaxd,alf,qq,ibase)
      if(mode.ne.0.or.modif.ne.oui) go to 900
c     print *,' avant read rec=1   '
      read (iuni,rec=1)
     &nu1,nu2,anu,n203,nbraie,nbmol,iecr,ifin,ll1,ll2,ll3,ll4
c     print *,' apres read rec=1   '
c     print *,
c    &nu1,nu2,anu,n203,nbraie,nbmol,iecr,ifin,ll1,ll2,ll3,ll4
      ll2=1
c     print *,' avant write rec=1   '
c     print *, ifin,ll1
      write(iuni,rec=1)
     &nu1,nu2,anu,n203,nbraie,nbmol,iecr,ifin,ll1,ll2,ll3,ll4
c     print *,' apres write rec=1   '
c     print *,
c    &nu1,nu2,anu,n203,nbraie,nbmol,iecr,ifin,ll1,ll2,ll3,ll4      
c     print *, ifin,ll1
      ifin=ifin+ll1
      do 22 j=1,nmol
      ymoy(j)=ymoyd(j)*cor
22    ymax(j)=ymaxd(j)*cor
c     print *, ifin
c     write(iuni,rec=ifin)
c    & ntab,(tab(j),j=1,ntab),nmol,(ymoy(j),j=1,nmol),
c    &(ymax(j),j=1,nmol),(alf(j),j=1,nmol)
c     print *,
c    & ntab,(tab(j),j=1,ntab),nmol,(ymoy(j),j=1,nmol),
c    &(ymax(j),j=1,nmol),(alf(j),j=1,nmol)
      go to 900
24    continue
      impr=0
      im=0
      anu1=nu1
      anu2=nu1+dnu
      if(dnu.eq.0.) anu2=nu2
      pas(   2)=(xmax(im+1)-xmin(im+1))/nbclas
      if(pas(2).eq.0.) pas(2)=1.e+20
      call pgeisa(nu1,nu2,*900)
300   continue
      call lgeisa(v,*400)
C       
C     CALCUL DES FREQUENCES DES CLASSES DE HIST
C       
      if(a.le.anu2) go to 319
      call imph  (hist,xmin(im+1),xmax(im+1),pas,anu1,anu2,impr)
      im=im+1
      anu1=anu2
      anu2=amin1(nu2,anu2+dnu)
      pas(2)=(xmax(im+1)-xmin(im+1))/nbclas
      if(pas(2).eq.0.) pas(2)=1.e+20
      do 26 i=1,nbc2
      hist(i)=0
26    continue
319   continue
      if(ival.ne.0.and.kode(iran).ne.ival) go to 300
C alog -> dlog (real 8) BB 19/11/96
      a2=v(2)*(1./cor)
      kt=incr+dlog10(a2)
C     kt=incr+alog10(v(2))
      hist(kt)=hist(kt)+1
      if(khist.eq.1) go to 300
      kt=(v(4)-xmin(im+1) )/pas(2) + 1.
      kt=min0(kt,nbclas)
      ktk=kt+nbclas
      hist(ktk)=hist(ktk)+1
      go to 300
400   continue
      if(khist.ne.0) call imph(hist,xmin(im+1),xmax(im+1),pas
     &,anu1,anu2,impr)
900   continue
      return 1
      end