C     LE PROGRAMME TRS MODIFIE LA BANQUE DE LA FACON SUIVANTE POUR
C     STOCKER LA LISTE DES TRANSITIONS  :
C     EN RECORD 1 AJOUTER APRES IFIN LA VALEUR  LL1
C     A PARTIR DU RECORD IFIN INCLUS ECRIRE LL1 RECORDS OU EST STOCKE
C     LE TABLEAU P DU PROGRAMME TRS
C       
C     MODE=-1  APPEL NORMAL DE TRS POUR LISTER LES TRANSITIONS
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 TRANSITIONS DE LA BANQUE PAR MOLECULE SANS
C              LECTURE DU FICHIER(OPTION PROVENANT DE PGM='INF')
C       
C     CE PROGRAMME LISTE LE NOMBRE DE TRANSITIONS VIBRATIONNELLES
C     PRESENTES DANS LA BANQUE DANS UN DOMAINE SPECTRAL DONNE,
C     POUR UNE OU PLUSIEURS MOLECULES.
C     SONT AUSSI INDIQUES   LA PREMIERE ET LA DERNIERE RAIE AINSI QUE
C     LES VALEURS DES INTENSITES ET L'INTENSITE MAXIMALE.
C       
C     NBI(I)=NB MAX DE TRANSITIONS # PREVUS POUR LA MOLECULE I DANS P
C     NBT(I)=NOMBRE D'OCTETS DEFINISSANT LA TRANSITION DE LA MOLECULE I
C     LE TABLEAU NBI EST A METTRE A JOUR CHAQUE FOIS QUE LA BANQUE
C     EST MODIFIEE  SOMME(NBT/4 + 1 + 7)*NBI=80000   (A CETTE DATE)
C     PREVOIR DIMENSION P=KP>=80000
C     PLACE OCCUPEE DANS P PAR UNE TRANSITION DONNEE :
C            (NBT+3)/4 MOTS + 7 MOTS DEFINIS PLUS LOIN
C       
C     P,PP,Q NOMS # D'UNE MEME REGION EN MEMOIRE CENTRALE
C     P  TABLEAU D'ENTIERS
C     Q  TABLEAU DE REELS
C     PP TABLEAU D'OCTETS
C     JDEB(I)=ADRESSE DANS NN DU NB D'ISOTOPES DE LA MOLECULE I
C     NN(JDEB(I))=NB D'ISOTOPES DE LA MOLECULE I
C     IDEB(I)=ADRESSE DANS P=Q DU DEBUT DE STOCKAGE DES RENSEIGNEMENTS
C             CONCERNANT LA MOLECULE I
C       
C     DANS P=Q SONT STOCKES LES RENSEIGNEMENTS SUIVANTS :
C     DE L'ADRESSE IDEB(I)+1 A L'ADRESSE IDEB(I)+(NBT(I)/4+8)*NBI(I)
C     TRANSITIONS DE TOUS LES ISOTOPES DE LA MOLECULE I(POUR UNE
C     MOLECULE DONNEE NBI(I) TRANSITIONS DIFFERENTES SONT POSSIBLES)
C     POUR LA MOLECULE I
C     SI IN=IDEB(I) ET NTR=NBT(I)
C     (PP(IN*4+J),J=1,NTR)= NTR OCTETS  DEFINISSANT LA TRANSITION DE I
C     NTN=(NTR+3)/4
C     P(IN+NTN+1)=CODE ISOTOPE
C     P(IN+NTN+2)=FREQUENCE D'UNE TRANSITION DONNEE
C     Q(IN+NTN+3)=PREMIERE RAIE
C     Q(IN+NTN+4)=DERNIERE RAIE
C     Q(IN+NTN+5)=MIN INTENSITE ENTRE Q(3) ET Q(4)
C     Q(IN+NTN+6)=MAX INTENSITE ENTRE Q(3) ET Q(4)
C     Q(IN+NTN+7)=SOMME DES INTENSITES DE CETTE TRANSITION
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *
C       
C      MODIF : 07.05.1991 PASSAGE DE 40 A 75 MOLECULES DANS LES COMMON
C LAST MODIF : 11.03.1997 PASSAGE DE v(2) en double precision par cor 
C       
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *
      subroutine trsi(p,pp,q,qq,*)
C       
      character*44 fmt
      character*9  trs1,trs2
      character*7  form,bin,unite
      character*4  mole,ctlg,code,blanc
      character*3  iopt,pgm,ianl,iext,itrs,ilst,icop,info,icre,
     &             liste,modif,iinf,oui,non,ncoef,trans
      character*2  icod,ikod,slas
      character*1   moins,slash,bl,bc,cs,sla(2),ch5,ch6,ia(36),pp(1)
      logical*1 qq(1)
      integer ib(10),p(1),ideb(75),vers
C       
C GEISA90 : 16 -> 29
C       
      real q(1),nu1,nu2,v(29)
      real*8 cor,aa2,qq7,qq3,qq4,qq5
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       
      equivalence (izot,v(15)),(imol,v(16))
      equivalence (a,v(1)),(ai,v(2)),(a3,v(3)),(a4,v(4)),(ia(1),v(5))
      equivalence (sla(1),slas)
C       
      data moins,slash/'-','/'/,bl/' '/,cs/'s'/,iinf/'inf'/,sla/' ','/'/
      data fmt/'(44x,i2,2h) ,a4,a2,2h /,   (i3,a1))'/
      data coeff/2.479426e19/,non/'not'/,cor/1.d50/
C     DATA FMT/'(4','8X',',A','4,','A1',', ','  ','(I','3,','A1','))'/
C       
C     LPQ=NOMBRE DE MOTS RESERVES POUR UNE   TRANSITION
C       
      lpq=7
C ICI *******************************
      if(mode.eq.-1) go to 5
      call pgeisa(0.,99999.,9999)
9999  read (iuni,rec=1)
     &nu1,nu2,anu,n203,nbraie,nbmol,iecr,ifin,ll1,ll2,ll3,ll4
c     print *,' lecture rec=1 '
c     print *,nu1,nu2,anu,n203,nbraie,nbmol,iecr,ifin,ll1,ll2,ll3,ll4
      if(mode.eq.0.or.ll1.ne.0) go to 66
      write(isor,2000)
2000  format(///' *inf*   this option is only available for spectroscopi
     &c   '/9x,'data bank *** geisa ***'///)
      write(*,*) mode,ll1
      go to 900
5     continue
C     IMPRESSION DE L'ENTETE AVEC LES MOLECULES ET ISOTOPES DEMANDES
      call pgeisa(nu1,nu2,*900)
66    continue
      if(mode.eq.1) pgm=iinf
      write(isor,3000)  vers,pgm,pgm,nu1,nu2
3000  format(1x,17('*'),98x,17('*')/1x,'* geisa   geisa *',
     &31x,'available transitions in geisa',i2.2,35x,
     &'* geisa   geisa *'/' *',6x,a3,6x,'*',98x,'*',6x,a3,6x,'*'/
     &' * geisa   geisa *',20x,'spectral  interval (cm-1) ',
     &' nu1=',f10.3,3x,'nu2=',f10.3,
     &20x      ,'* geisa   geisa *'/1x,17('*'),98x,17('*'))
      write(isor,3500)
3500  format( 44x,' extraction of the following ',
     &'molecules and isotopes '/)
C     RECHERCHE DES MOLECULES ET ISOTOPES DEMANDES POUR LES IMPRIMER
c      print *,nmol,(qq(i),i=1,nmol)
      do 35 i=1,nmol
      if(.not.qq(i)) go to 35
      kk=jdeb(i)
      ki=kk+1
      kf=kk+nn(kk)
c     PRINT *,' KK,KI,KF',KK,KI,KF
      jj=0
      do 33 j=ki,kf
      if(pp(nn(j)).eq.'1')go to 33
      jj=jj+1
      ib(jj)=nn(j)
33    continue
      j1=jj-1
      fmt(26:27)=icod(jj)
      sla(1)=bl
      sla(2)=bl
C     IF(I.EQ.19) PRINT *,' CLO CLO'
      if(i.eq.34) sla(1)='l'
      if(i.eq.37) sla(1)='h'
      if(i.eq.42) sla(1)='o'
      if(i.eq.42) sla(2)='2'
      if(jj.ne.1)
     &write(isor,fmt)i,code(i),slas ,(ib(j),moins,j=1,j1),ib(jj),slash
      if(jj.eq.1) write(isor,fmt) i,code(i),slas ,ib(jj),slash
35    continue
      do 40 i=1,kp
40    p(i)=0
C     IF(MODE.EQ.1) GO TO 46
      k=0
C     TEST POUR SAVOIR SI LA DIMENSION DE P EST SUFFISANTE
      do 45 i=1,nmol
      if(.not.qq(i)) go to 45
      kbit=((nbt(i)+3)/4 + lpq)*nbi(i)
      k=k+kbit
45    continue
C     PRINT *,' K,KP=',K,KP
      if(k.le.kp) go to 46
      write(isor,460) k,kp
460   format(///' *trs*   faites votre liste en deux fois'/
     &9x,'k=',i6,'    kp=',i6//)
      go to 900
46    continue
      k=0
C     CALCUL DU TABLEAU IDEB
      ideb(1)=0
      do 109 i=2,nmol
      i1=i-1
C ICI *******************************
C     IF(.NOT.QQ(I).AND.MODE.EQ.-1) GO TO 109
      ideb(i)=ideb(i1)+((nbt(i1)+3)/4 + lpq)*nbi(i1)
109   continue
      if(mode.eq.1) go to 200
100   continue
C     LECTURE D'UNE RAIE ET STOCKAGE DANS P
      call lgeisa(v,*200)
      if(.not.qq(imol)) go to 100
      do 205 j=1,kksot
      if(izot.eq.isot(j)) go to 210
205   continue
      go to 100
210   continue
      nis=nbi(imol)
      ntr=nbt(imol)
      ntn=(ntr+3)/4
C     PRINT *,' NTR1=',NTR
      incr=ntn+lpq
      nsot=incr*nis
      in=-incr+ideb(imol)
C     PRINT *,' IMOL=',IMOL
C       
C            H2O  CO2  O3   N2O  CO   CH4  O2   NO   SO2  NO2  NH3  PH3
      go to (275, 265, 275, 352, 255, 254, 277, 254, 275, 275, 265, 265,
C            HNO3 OH   HF   HCL  HBR  HI   CLO  OCS  H2CO C2H6 CH3D C2H2
     &       254, 254, 255, 255, 255, 255, 254, 352, 260, 254, 254, 254,
C            C2H4 GEH4 HCN  C3H8 C2N2 C4H2 HC3N HOCL N2  CH3CL H2O2 H2S
     &       254, 254, 352, 260, 361, 260, 260, 275, 255, 254, 260, 275,
C           HCOOH COF2 SF6  C3H4 HO2 ClONO2
     &       260, 260, 254, 260, 275, 254 ) imol
C       
      write(isor,3600) pgm,imol,izot
3600  format(///' *',a3,'*   erreur sur le code molecule'///
     &9x,'le code molecule ',i4, '/',i3,' n''existe pas dans le catalogu
     &e'///)
      go to 100
C       
C     H2O - O3 - SO2 - NO2 - HOCL - H2S - HO2
C       
275   continue
      i=0
      do 276 jj=7,9
      i=i+1
      ia(i)=ia(jj)
      ia(i+3)=ia(jj+9)
276   continue
      go to 400
C       
C      O2
C       
277   continue
      i=0
      do 278 jj=8,9
      i=i+1
      ia(i)=ia(jj)
      ia(i+2)=ia(jj+9)
278   continue
C     PRINT 999,'IA=',IA
      go to 400
C       
C     N2O - OCS - HCN
C       
352   continue
      i=0
      do 371 jj=6,9
      i=i+1
      ia(i)=ia(jj)
      ia(i+4)=ia(jj+9)
371   continue
C     PRINT 999,'IA=',IA
      go to 400
C       
C C2H2 - CH4 - CH3D - CH3CL - C2H6 - HNO3 - SF6 - NO - OH - HCN
C ClONO2
C       
254   continue
      do 291 jj=2,9
      ia(jj-1)=ia(jj)
291   continue
      do 292 jj=11,18
      ia(jj-2)=ia(jj)
292   continue
      go to 400
C       
C     CO - N2 -  HF - HCL - HBR - HI
C       
255   continue
      ia(1)=ia(9)
      ia(2)=ia(18)
      go to 400
C       
C     H2CO - HC3N - H2O2 - C3H8 - COF2 - C3H4 - HCOOH -C4H2
C       
260   continue
      i=0
      do 293 jj=4,9
      i=i+1
293   ia(i)=ia(jj)
      do 294 jj=13,18
      i=i+1
      ia(i)=ia(jj)
294   continue
      go to 400
C       
C     C2N2
C       
361   continue
      i=0
      do 324 jj=3,9
      i=i+1
      ia(i)=ia(jj)
324   continue
      do 325 jj=12,18
      i=i+1
      ia(i)=ia(jj)
325   continue
      go to 400
C       
C   CO2 - NH3 - PH3
C       
265   continue
      i=0
      do 297 jj=5,9
      i=i+1
297   ia(i)=ia(jj)
      do 298 jj=14,18
      i=i+1
      ia(i)=ia(jj)
298   continue
C     PRINT 999,'IA=',IA
999   format(1x,a,36a1)
      go to 400
C     SUITE POUR D'AUTRES MOLECULES
400   continue
      do 402 i=1,nsot
      in=in+incr
      in4=in*4
      k=p(in+ntn+1)
C     IF(IMOL.EQ.11) PRINT *,' K=',K,NSOT
      if(k.eq.0) go to 410
      if(k.ne.izot) goto 402
      do 401 j=1,ntr
      if(ia(j).ne.pp(in4 +j)) goto 402
401   continue
      if(imol.ne.7) go to 468
      if(q(in+ntn+3).le.1000..and.a.gt.1000.) goto 402
468   continue
      p(in+ntn+2)=p(in+ntn+2)+1
      q(in+ntn+4)=a
      q(in+ntn+5)=amin1(q(in+ntn+5),ai)
      q(in+ntn+6)=amax1(q(in+ntn+6),ai)
      q(in+ntn+7)=q(in+ntn+7)+ai
      go to 100
402   continue
      go to 700
410   continue
C     IF(IMOL.EQ.11)
C    &PRINT *,' NB ',PP(IN+NTN+2),' PP=',(PP(IN4+J-1+KL),KL=1,NTR)
      do 415 j =1,ntr
      pp(in4 +j)=ia(j)
C     IF(IMOL.EQ.11) PRINT *,' IA2',IA(J),' PP=',PP(IN4+J)
415   continue
1     format(1x,a,i10,a,10a1)
      p(in+ntn+1)=izot
      p(in+ntn+2)=1
      q(in+ntn+3)=a
      q(in+ntn+4)=a
      q(in+ntn+5)=ai
      q(in+ntn+6)=ai
      q(in+ntn+7)=ai
      go to 100
200   continue
C ICI **************************************************************
      if(mode.ne.0.or.modif.ne.oui) go to 420
      read (iuni,rec=1)
     &nu1,nu2,anu,n203,nbraie,nbmol,iecr,ifin,ll1,ll2,ll3,ll4
c     print *,
c    &nu1,nu2,anu,n203,nbraie,nbmol,iecr,ifin,ll1,ll2,ll3,ll4
c modif 03.04.97 calcul ll1 (nb pistes) obsolete
      ll1=kp/lre + 1
c     ll1=0
c     print *, ll1,kp,lre
c     print *,nu1,nu2,anu,n203,nbraie,nbmol,iecr,ifin,ll1,ll2,ll3,ll4
      write(iuni,rec=1)
     &nu1,nu2,anu,n203,nbraie,nbmol,iecr,ifin,ll1,ll2,ll3,ll4
      ll1=kp/lre + 1
      ki=1
      kf=lre
      do 416 i=1,ll1
      if(i.eq.ll1) kf=kp
c     print *,ifin,ki,kf,(p(j),j=ki,kf)
      write(iuni,rec=ifin) ki,kf,(p(j),j=ki,kf)
      ki=ki+lre
      kf=kf+lre
      ifin=ifin+1
416   continue
420   continue
      if(mode.ne.1) go to 430
      do 425 i=1,ll1
      read (iuni,rec=ifin) ki,kf,(p(j),j=ki,kf)
      ifin=ifin+1
425   continue
430   continue
C       
C     IMPRESSION DES RESULTATS PAR MOLECULE
C       
      kk=1
      do 620 ii=1,nmol
      ch5=bl
      ch6=bl
      if(ii.eq.34) ch5='l'
      if(ii.eq.37) ch5='h'
      if(ii.eq.42) ch5='o'
      if(ii.eq.42) ch6='2'
      lid=0
      kn=nq(kk)
      kk=kk+kn+1
      if(.not.qq(ii)) go to 620
      ki=kk-kn
      kf=kk-1
      bc=cs
      if(kn.eq.1) bc=bl
      nis=nbi(ii)
      ntr=nbt(ii)
      ntn=(ntr+3)/4
      incr=ntn+lpq
      nsot=incr*nis
      in=-incr+ideb(ii)
C     PRINT*,' NTR2=',NTR,' NBI(II)=',NBI(II),' NBT(II)=',NBT(II)
C     PRINT*,' LPQ=',LPQ,' NSOT=',NSOT,' IN=',IN,' IDEB(II=',IDEB(II)
      kis=0
      iii=0
      do 618 i=1,nsot
      in=in+incr
      k=p(in+ntn+1)
      idim=in+ntn+1
C     PRINT *,IDIM
      if(k.eq.0) go to 619
      if(iii.ne.0) go to 3995
      ncoef=blanc
C     IF(II.LE.7.OR.II.EQ.11.OR.II.EQ.23.OR.II.EQ.24) NCOEF=BLANC
      if(code(ii).eq.'h2o ') write(isor,4033)
4033  format(////)
      write(isor,4000) ii,code(ii),ch5,ch6,bc,(nq(j),j=ki,kf)
4000  format(////1x,i2.2,') molecule : ',a4,a1,a1,
C    &2X,'4<N> ',A3,' AVAILABLE )',
     &2x,'quantum number',a1,         ' : ',10a4)
      write(isor,3990)
3990  format(5x,8('*'),11x,15('*')/)
3995  continue
      lid=lid+1
CBB  passage des energies en double precision
      qq3=q(in+ntn+5)*(1./cor)
      qq4=q(in+ntn+6)*(1./cor)
      qq5=q(in+ntn+7)*(1./cor)
c     qq7=q(in+ntn+7)*coeff*(1./cor)
      qq7=dble(q(in+ntn+7))*dble(coeff)*(1./dble(cor))
CBB fin
C       
      go to (620,  2,620,  4,620,  6,620,  8,  9, 10,620, 12,620, 14,
     &       620, 16, 17, 18,620,620,620,620,620,620,620,620),ntr
C       
C     NTR=2  CO   HF   HCL  HBR  HI N2
C       
2     continue
      if(iii.eq.0) write(isor,4001)
4001  format(6x,'   ident ',3x,'nb.lines',4x,2he',2x,3he'',3x,
     &3x,'nu.min',7x,'nu.max',8x,'min.i',8x,'max.i',12x,'sum.i'/
     &92x,10('-'),5x,10('-')/92x,'cm molec-1     cm-2 atm-1'/)
      write(isor,5001) lid,
     &code(ii),ch5,ch6,k,p(in+ntn+2),(pp(in*4+j),j=1,ntr),
     &(q(in+ntn+2+j),j=1,2),qq3,qq4,qq5,qq7
5001  format(1x,i4,')',a4,a1,a1,'/',i3,2x,i6,6x,a1,3x,a1,1x,
     &f12.3,1x,f12.3,1x,1pd12.3,1x,1pd12.3,1x,1pd12.3,2x,1pd12.3)
      go to 615
C       
C     NTR=4  O2
C       
4     continue
      if(iii.eq.0) write(isor,4002)
4002  format(6x,'   ident ',3x,'nb.lines',3x,1x,2he',2x,3he'',3x,
     &3x,'nu.min',7x,'nu.max',8x,'min.i',8x,'max.i',12x,'sum.i'/
     &1x,091x,10('-'),5x,10('-')/1x,091x,'cm molec-1     cm-2 atm-1'/)
      write(isor,5002) lid,
     &code(ii),ch5,ch6,k,p(in+ntn+2),(pp(in*4+j),j=1,ntr),
     &(q(in+ntn+2+j),j=1,2),qq3,qq4,qq5,qq7
C       
C  OLD VERSION PRESENTATION DES TRANS EN A1 ET A3 AU LIEU DE A2 A2
C       
C5002 FORMAT(1X,I4,')',A4,A1,'/',I3,2X,I6,6X,1X,A1,2X,3A1,1X,
C       
 5002 format(1x,i4,')',a4,a1,a1,'/',i3,2x,i6,6x,2a1,3x,2a1,1x,
     &f12.3,1x,f12.3,1x,1pd12.3,1x,1pd12.3,1x,1pd12.3,2x,1pd12.3)
      go to 615
C       
C     NTR=6 H2O  O3  SO2  NO2  HOCL  H2S HO2
C       
6     continue
      if(iii.eq.0) write(isor,4003)
4003  format(6x,'   ident ',3x,'nb.lines',3x,3x,2he',5x,3he'',5x,
     &3x,'nu.min',7x,'nu.max',8x,'min.i',8x,'max.i',12x,'sum.i'/
     &1x,098x,10('-'),5x,10('-')/1x,098x,'cm molec-1     cm-2 atm-1'/)
      write(isor,5003) lid,
     &code(ii),ch5,ch6,k,p(in+ntn+2),(pp(in*4+j),j=1,ntr),
     &(q(in+ntn+2+j),j=1,2),qq3,qq4,qq5,qq7
5003  format(1x,i4,')',a4,a1,a1,'/',i3,2x,i6,6x,2x,3a1,1x,3x,1x,3a1,2x,
     &f12.3,1x,f12.3,1x,1pd12.3,1x,1pd12.3,1x,1pd12.3,2x,1pd12.3)
      go to 615
C       
C     NTR=8  N2O OCS  HCN
C       
8     continue
      if(iii.eq.0) write(isor,4004)
4004  format(6x,'   ident ',3x,'nb.lines',3x,3x,2he',9x,3he'',2x,3x,
     &3x,'nu.min',7x,'nu.max',8x,'min.i',8x,'max.i',12x,'sum.i'/
     &1x,102x,10('-'),5x,10('-')/1x,102x,'cm molec-1     cm-2 atm-1'/)
      write(isor,5004) lid,
     &code(ii),ch5,ch6,k,p(in+ntn+2),(pp(in*4+j),j=1,ntr),
     &(q(in+ntn+2+j),j=1,2),qq3,qq4,qq5,qq7
5004  format(1x,i4,')',a4,a1,a1,'/',i3,2x,i6,6x,2x,4a1,2x,3x,2x,4a1,2x,
     &f12.3,1x,f12.3,1x,1pd12.3,1x,1pd12.3,1x,1pd12.3,2x,1pd12.3)
      go to 615
C       
C     NTR=9
C       
9     continue
      if(iii.eq.0) write(isor,4005)
4005  format(6x,'   ident ',3x,'nb.lines',3x,1x,2he',5x,3he'',1x,3x,
     &3x,'nu.min',7x,'nu.max',8x,'min.i',8x,'max.i',12x,'sum.i'/
     &1x,095x,10('-'),5x,10('-')/1x,095x,'cm molec-1     cm-2 atm-1'/)
      write(isor,5005) lid,
     &code(ii),ch5,ch6,k,p(in+ntn+2),(pp(in*4+j),j=1,ntr),
     &(q(in+ntn+2+j),j=1,2),qq3,qq4,qq5,qq7
5005  format(1x,i4,')',a4,a1,a1,'/',i3,2x,i6,6x,4a1,3x,4a1,a1,
     &f12.3,1x,f12.3,1x,1pd12.3,1x,1pd12.3,1x,1pd12.3,2x,1pd12.3)
      go to 615
C       
C     NTR=10 CO2 NH3 PH3
C       
10    continue
      if(iii.eq.0) write(isor,4006)
4006  format(6x,'   ident ',3x,'nb.lines',3x,5x,2he',9x,3he'',4x,3x,
     &3x,'nu.min',7x,'nu.max',8x,'min.i',8x,'max.i',12x,'sum.i'/
     &1x,106x,10('-'),5x,10('-')/1x,106x,'cm molec-1     cm-2 atm-1'/)
      write(isor,5006) lid,
     &code(ii),ch5,ch6,k,p(in+ntn+2),(pp(in*4+j),j=1,ntr),
     &(q(in+ntn+2+j),j=1,2),qq3,qq4,qq5,qq7
5006  format(1x,i4,')',a4,a1,a1,'/',i3,2x,i6,6x,3x,5a1,2x,3x,2x,5a1,3x,
     &f12.3,1x,f12.3,1x,1pd12.3,1x,1pd12.3,1x,1pd12.3,2x,1pd12.3)
      go to 615
C       
C     NTR=12  H2CO  HC3N  H2O2 C3H8 COF2 C3H4 HCOOH C4H2
C       
12    continue
      if(iii.eq.0) write(isor,4007)
4007  format(6x,'  ident ',3x,'nb.lines',4x,3x,2he',9x,3he'',2x,3x,
     &3x,'nu.min',7x,'nu.max',8x,'min.i',8x,'max.i',12x,'sum.i'/
     &1x,102x,10('-'),5x,10('-')/1x,102x,'cm molec-1     cm-2 atm-1'/)
      write(isor,5007) lid,
     &code(ii),ch5,ch6,k,p(in+ntn+2),(pp(in*4+j),j=1,ntr),
     &(q(in+ntn+2+j),j=1,2),qq3,qq4,qq5,qq7
5007  format(1x,i4,')',a4,a1,a1,'/',i3,2x,i6,7x,6a1,5x,6a1,1x,
     &f12.3,1x,f12.3,1x,1pd12.3,1x,1pd12.3,1x,1pd12.3,2x,1pd12.3)
      go to 615
C       
C     NTR=14 C2N2
C       
14    continue
      if(iii.eq.0) write(isor,4007)
      write(isor,5008) lid,
     &code(ii),ch5,ch6,k,p(in+ntn+2),(pp(in*4+j),j=1,ntr),
     &(q(in+ntn+2+j),j=1,2),qq3,qq4,qq5,qq7
5008  format(1x,i4,')',a4,a1,a1,'/',i3,2x,i6,7x,7a1,4x,7a1,
     &f12.3,1x,f12.3,1x,1pd12.3,1x,1pd12.3,1x,1pd12.3,2x,1pd12.3)
      go to 615
C       
C  NTR=16
C   CH4 NO HNO3 OH CLO C2H6 CH3D C2H2 C2H4 GEH4 CH3CL SF6 ClONO2
C       
16    continue
      if(iii.eq.0) write(isor,4007)
      write(isor,5009) lid,
     &code(ii),ch5,ch6,k,p(in+ntn+2),(pp(in*4+j),j=1,ntr),
     &(q(in+ntn+2+j),j=1,2),qq3,qq4,qq5,qq7
5009  format(1x,i4,')',a4,a1,a1,'/',i3,2x,i6,6x,8a1,3x,8a1,
     &f12.3,1x,f12.3,1x,1pd12.3,1x,1pd12.3,1x,1pd12.3,2x,1pd12.3)
      go to 615
C     NTR=17 C2H2
17    continue
      if(iii.eq.0) write(isor,4007)
      write(isor,5010) lid,
     &code(ii),ch5,ch6,k,p(in+ntn+2),(pp(in*4+j),j=1,ntr),
     &(q(in+ntn+2+j),j=1,2),qq3,qq4,qq5,qq7
5010  format(1x,i4,')',a4,a1,a1,'/',i3,2x,i6,5x,9a1,3x,8a1,
     &f12.3,1x,f12.3,1x,1pd12.3,1x,1pd12.3,1x,1pd12.3,2x,1pd12.3)
      go to 615
C     NTR=18 CLO
18    continue
      if(iii.eq.0) write(isor,4007)
      write(isor,5012) lid,
     &code(ii),ch5,ch6,k,p(in+ntn+2),(pp(in*4+j),j=1,ntr),
     &(q(in+ntn+2+j),j=1,2),qq3,qq4,qq5,qq7
5012  format(1x,i4,')',a4,a1,a1,'/',i3,2x,i6,5x,9a1,3x,9a1,
     &f12.3,1x,f12.3,1x,1pd12.3,1x,1pd12.3,1x,1pd12.3,2x,1pd12.3)
      go to 615
C       
C     SUITE ............
615   continue
      iii=1
      kis=kis+p(in+ntn+2)
618   continue
619   continue
      if(kis.ne.0) write(isor,699) kis
699   format(1x,17x,6('-')/1x,3x,'total : ',6x,i6)
620   continue
      go to 900
700   continue
      write(isor,777) code(imol),izot,ia,v(1)
777   format(///' *trs*   erreur transition vibrationnelle'/
     &9x,a4,'/',i3,5x,36a1///' les calculs sont arretes a la transi
     &tion : ',f15.6//)
      go to 200
900   continue
      return 1
      end