C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *
C       
C LAST MODIF : 07.05.1991 PASSAGE DE 40 A 75 MOLECULES DANS LES COMMON
C       
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - *
C       
      subroutine utili(p,pgm)
C       
      character*7   form,bin
      character*4   code,blanc,kk,ivab(32)
      character*3   modif,pgm,mpgx,oui
      character*2   ikod,icod
      character*1   slash,moins,bl,aster,vb(128),p(1),zk(4)
      logical*1 qqq
      integer vers,njm(12)
      dimension vab(32)
      real*8 nom,nomj
C       
      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/p8/ npgx,nfff,mpgx,qqq(75)
      common/entsor/iuni,juni,kuni,ient,isor,iper,nresv,maxx,blanc,oui
C       
      equivalence (vb(1),vab(1),ivab(1),nomj),(kk,zk(1))
C       
      data njm /31,28,31,30,31,30,31,31,30,31,30,31/
      data slash,moins,bl,aster/'/','-',' ','*'/
C       
      nfff=1
      call pgeisa(0.,99999.)
      read (iuni,rec=1)
     &aa1,aa2,anu,n203,nbraie,nbmol,iecr,ifin,ll1,ll2,ll3,ll4
c     vers=ll3
      if(ll1.eq.0.or.ll2.eq.0) go to 300
      write(isor,1000)  pgm,pgm,vers
1000  format(1x,17('*'),98x,17('*')/1x,'* geisa   geisa *',
     &31x,'      spectroscopic data bank      ',32x,
     &'* geisa   geisa *'/' *',6x,a3,6x,'*',98x,'*',6x,a3,6x,'*'/
     &' * geisa   geisa *',26x,15x,'*** GEISA',i2.2,' ***',16x,
     &      26x,'* geisa   geisa *'/1x,17('*'),98x,17('*')/
     &       1x,33x,' management and study of atmospheric spectroscopic
     &informations')
      write(isor,2000)
2000  format(//1x,51x,'  list of the user records   '///
     &'  |',128('-'),'|'/
     &2x,         '|  date  |   nu1    |   nu2    |pgm|',30x,
     &'    used molecule  ',44x,'|')
      lll1=ifin+ll1+ll2
      lll2=lll1+ll4
      if(ll4.lt.0) lll2=ifin+ll1+ll2-ll4-1
C       
C     CODAGE DU TABLEAU VB
C     1  ---> 8  NOM
C     9  ---> 15 SIGLE NUM
C     16 ---> 23 DATE
C     25 ---> 28 NU1
C     29 ---> 32 NU2
C     33 ---> 36 PGM
C     37 ---> 120 MOLECULES
C       
      do 20 lll=lll1,lll2
      read (iuni,rec=lll) kb,longr,max,nxx,(p(j),j=1,kb)
      if(lll.eq.lll1.and.kb.eq.0) go to 200
      if(kb.eq.0) go to 20
      i1=0
      do 18 i=1,kb,nxx
      i1=i1+1
C       
C     COPIE DU NOM ET DU SIGLE NUM
C       
      do 5 j=1,15
      vb(j)= p(i+j-1)
5     continue
C       
C     DECODAGE DE LA DATE EN XX/XX/XX
C       
      read (p(i+15),'(i2)') lan
      read (p(i+17),'(i2)') jour
      njm2=njm(2)
      if(mod(lan,4).eq.0) njm(2)=29
      do  6 j=1,12
      mois=j
      if(jour.le.njm(j)) go to 7
      jour=jour-njm(j)
6     continue
7     continue
      njm(2)=njm2
      write (jour,'(i2)') vb(16)
      vb(18)=slash
      write (mois,'(i2)') vb(19)
      vb(21)=slash
      write (lan ,'(i2)') vb(22)
C       
C     COPIE DE NU1 ET NU2 ET NOM PROGRAMME
C       
      do 8 j=21,32
      vb(j+4)=p(i+j-1)
8     continue
C     MISE A BLANC DE LA REGION MOLECULE
C       
      do 10 j=10,32
      ivab(j)=blanc
10    continue
C       
C     SI PROGRAMME LEC LAISSER DES BLANCS
C       
C     DECODAGE DES MOLECULES
C       
      i2=36
      do 14 j=33,nxx
      if(p(i+j-1).eq.'1') go to 14
      kk=code(j-32)
      do 12 jj=1,4
      if(zk(jj).eq.bl) go to 13
      i2=i2+1
C     NE PAS DEBORDER DANS LE TABLEAU VB
      if(i2.le.128) vb(i2)=zk(jj)
12    continue
13    continue
      i2=i2+1
      if(i2.le.128) vb(i2)=moins
14    continue
      if(i2.le.128) vb(i2)=bl
      write(juni) vab
18    continue
20    continue
      end file juni
      rewind juni
C       
C     TRI SELON LES VARIABLES SUIVANTES :
C     NOM - SIGLENUM - ANNEE - MOIS - JOUR .
C       
c     call tri('*sort fields=(5,8,ch,a,13,7,ch,a,26,2,ch,a,23,2,ch,a,20,
c    &2,ch,a)*','*record type=v*',irc)
C       
      if(irc.ne.0) go to 100
      luni=juni+1
      rewind luni
      nom=0.
      i=0
35    continue
      read (luni,end=40) vab
      i=i+1
      if(nom.eq.nomj) go to 37
      ii=0
      do 36 j=1,8
      if(vb(j).ne.bl) ii=ii+1
36    continue
      nom=nomj
      iii=8-ii
      write(isor,2010) nom,(vb(j),j=9,15),(aster,j=1,ii),(bl,j=1,iii)
2010  format(  '  |',128('-'),'|'/  '  |',128x,'|'/
     &'  |---',a8,5x,7a1,105x,'|'/'  |   ',8a1,117x,'|'/'  |',128('-'),
     &'|')
37    continue
      write(isor,2020)(vb(j),j=16,23),vab(7),vab(8),ivab(9),
     &(vb(j),j=37,128)
2020  format('  |',8a1,'|',f10.3,'|',f10.3,'|',a3,'|',92a1,' |')
      go to 35
40    continue
      write(isor,2030)
2030  format(  '  |',128('-'),'|')
      return
100   continue
      write(isor,3000)
3000  format(///' *uti*   error in step sort'///)
      return
200   continue
      write(isor,4000)
4000  format(///' *uti*   record empty, no call to the data bank '//)
      return
300   continue
      write(isor,5000) pgm
5000  format(///' *',a3,'*   trs and anl options must be run with parame
     &ter modif=oui before this call'///)
      return
      end