C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *
C     SUBROUTINE QUI RECHERCHE LES MOLECULES ET ISOTOPES A CHOISIR
C     (QQ(J),J=1,NMOL)  QQ(J)=.TRUE. MOLECULE J A RETENIR
C                            =.FALSE. MOLECULE NON CHOISIE
C     (P(J),J=1,1000)  P(J)=.TRUE. ISOTOPE J A RETENIR
C                          =.FALSE. ISOTOPE J NON CHOISI
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *
C       
C LAST MODIF : 07.05.1991 PASSAGE DE 40 MOLECULES A 75 DANS LES COMMON
C       
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *
C       
      subroutine molis(p,qq,*)
C       
      character*9 trs1,trs2
      character*7 form,bin
      character*4 mole,ctlg,code,blanc
      character*3 iopt,pgm,ianl,iext,itrs,ilst,icop,info,icre,
     &            modif,oui,liste,trans
      character*2 ikod,icod
      real nu1,nu2
      integer  vers
      logical*1 p (1),qq(1)
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/entsor/iuni,juni,kuni,ient,isor,iper,nresv,maxx,blanc,oui
C       
C     KAN=0  ANL-HISTO  1 MOLECULE  ET  1 ISOTOPE
C     KAN=1  ANL-HISTO  1 MOLECULE
      iarr=0
C     POUR CRE NE PAS FAIRE DE TESTS SUR MOLE ET ISOT
C     POUR COP INCLURE TOUTES LES MOLECULES
      if(liste.eq.ctlg) go to 100
      if(liste.eq.iopt) go to 150
      if(pgm.eq.icre) go to 100
      nzot=0
      kan=0
      iran=2
      do  5 i=1,nmol
      qq(i)=.false.
5     continue
      do  6 i=1,ntab
6     p(i)=.false.
c     print *,' knmol=',knmol
      if(knmol.ne.0) go to 20
      if(kksot.eq.0) go to 10
      iarr=1
      write(isor,1000) pgm
1000  format(///' *',a3,'*  mole parameter must be specified'///)
      go to 100
10    continue
C     CAS DE TOUTES LES MOLECULES ET TOUS LES ISOTOPES
      do 15 i=1,nmol
      qq(i)=.true.
      kk=jdeb(i)
      ki=kk+1
      kf=kk+nn(kk)
      do 15 j=ki,kf
      nzot=nzot+1
      isot(nzot)=nn(j)
      p(nn(j))=.true.
15    continue
      if(pgm.eq.info) return
      go to 40
20    continue
C     CAS MOLE#0
      do 22 i=1,knmol
      do 21 k=1,nmol
      if(mole(i).eq.code(k)) qq(k)=.true.
21    continue
22    continue
c     print *,'qq=',(qq(kkk),kkk=1,nmol)
      if(kksot.ne.0) go to 25
C     CAS DE MOLE#0 ET ISOT=0
      kan=1
      do 24 i=1,nmol
      if(.not.qq(i)) go to 24
      kk=jdeb(i)
      ki=kk+1
      kf=kk+nn(kk)
      do 23 j=ki,kf
      nzot=nzot+1
      isot(nzot)=nn(j)
      p(nn(j))=.true.
23    continue
24    continue
      go to 40
25    continue
C     CAS DE MOLE#0 ET ISOT#0
      do 29 i=1,nmol
      if(.not.qq(i)) go to 29
      kk=jdeb(i)
      ki=kk+1
      kf=kk+nn(kk)
      n1=0
      do 27 k=1,kksot
      do 26 j=ki,kf
      if(nn(j).ne.isot(k)) go to 26
      n1=n1+1
      p (nn(j))=.true.
26    continue
27    continue
      if(n1.ne.0) go to 29
      do 28 j=ki,kf
      p (nn(j))=.true.
28    continue
29    continue
C     MISE DES ISOTOPES AU DEBUT DU TABLEAU ISOT
      do 30  j=1,ksot
      isot(j)=0
30    continue
      do 35 j=1,ntab
      if(.not.p (j)) go to 35
      nzot=nzot+1
      isot(nzot)=j
35    continue
40    continue
      kksot=nzot
      knmol=0
      do 45 i=1,nmol
      if(.not.qq(i)) go to 45
      knmol=knmol+1
45    continue
C     POUR EXT ,TRS ET KANAL=1(ANAL='OUI') KNMOL>=1
C     POUR INF AVEC ANAL='OUI' OU TRANS='OUI'
      if(pgm.eq.ianl.and.knmol.eq.1.or.pgm.eq.ilst) go to 50
      if(pgm.eq.iext.or.pgm.eq.itrs.or.pgm.eq.icop.or.kanal.eq.1
     &.or.mode.eq.1) go to 100
C     POUR ANL ET HISTO UNE SEULE MOLECULE
      iarr=1
      write(isor,2000) pgm
2000  format(///' *',a3,'*   choosen a molecule'///)
      go to 100
50    continue
      if(pgm.eq.ianl.and.kan.eq.1) go to 55
      if(pgm.eq.ianl.and.kksot.eq.1) go to 55
      if(pgm.eq.ilst.and.knmol*kksot.eq.1) go to 55
      iarr=1
      write(isor,3000) pgm
3000  format(///' *',a3,'*   choosen a molecule and an isotope'///)
      go to 100
55    continue
      do 57 i=1,nmol
      if(qq(i)) go to 58
57    continue
58    continue
      ival=i
      imole=i
      if(kan.eq.1) go to 100
      iran=1
      ival=isot(1)
100   continue
150   continue
      return
      end