C-------------------------------------------------------------------------------
C   L I N E R H - Converter of a .LIN file for the ERHam program 
C-------------------------------------------------------------------------------
C
C   This program goes through the .LIN file for Pickett's SPFIT program
C   and produces line listing compatible with input required by 
C   Groner's ERHAM program
C
C   Pertinent control data is to be placed in file LINERH.INP
C
C
C       ver. 17.IX.2009                            ----- Zbigniew KISIEL -----
C                          __________________________________________________
C                         | Institute of Physics, Polish Academy of Sciences |
C                         | Al.Lotnikow 32/46, Warszawa, POLAND              |
C                         |                             kisiel@ifpan.edu.pl  |
C                         |     http://info.ifpan.edu.pl/~kisiel/prospe.htm  |
C_________________________/--------------------------------------------------
C
C  Modification history:
C
c  15.09.06:  creation
c  17.09.09:  dealing with blends and end of line comments
C_____________________________________________________________________________
C
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER*4 (I-N)
      parameter (maxlin=5000,maxc=200)
      character line*200,filein*30,filout*30
      character*100 descr(maxlin)
      integer lq(6),linq(12)
      dimension is1out(maxlin),is2out(maxlin),jupout(maxlin),
     *          nupout(maxlin),jloout(maxlin),nloout(maxlin),
     *          freqout(maxlin),wtout(maxlin),ferrout(maxlin)
c
c...Deal with the control file
c
      WRITE(*,5500)
5500  FORMAT(1X//'  ',76(1H_)/' |',T79,'|'/
     * ' |   LINERH  - Converter of a .LIN file for the ERHam prog',
     * 'ram           ',T79,'|'/
     * ' |',76(1H_),'|'/'  version 17.IX.2009',T64,'Zbigniew KISIEL'/)
cc
      open(4,file='linerh.inp',status='old')
      read(4,'(40x,a)')filein
      read(4,'(40x,a)')filout
      read(4,'(40x,6i5)')lq
      read(4,'(40x,2i5)')is1,is2
      close(4)
c
      open(2,file=filein,status='old')
      write(*,'(1x,2a)')'Reading from:  ',filein(1:len_trim(filein))
      open(3,file=filout,status='unknown')
      write(*,'(1x,2a)')'  Writing to:  ',filout(1:len_trim(filout))
c
c...Go through the .LIN file and read lines
c
      nlin=0
1     read(2,'(a)',err=4,end=4)line
      read(line,'(12I3)',err=4,end=4)linq
      line=line(37:len_trim(line))
c
      read(line,*,err=4,end=4)freq,ferr,rint
c
      jup=linq(lq(1))
      kau=linq(lq(2))
      kpu=linq(lq(3))
      jlo=linq(lq(4))
      kal=linq(lq(5))
      kpl=linq(lq(6))
c
      nup=kau-kpu+jup+1
      nlo=kal-kpl+jlo+1
c     
      if(freq.eq.0.d0)ferr=0.d0
      nlin=nlin+1
      is1out(nlin)=is1
      is2out(nlin)=is2
      jupout(nlin)=jup
      nupout(nlin)=nup
      jloout(nlin)=jlo
      nloout(nlin)=nlo
      freqout(nlin)=freq
      wtout(nlin)=rint
      ferrout(nlin)=ferr
c
      descr(nlin)='  '
      do 6 n=37,len_trim(line)
        if(line(n:n).eq.'!'.or.line(n:n).eq.'#')then
          descr(nlin)='  '//line(n:len_trim(line))
          goto 1
        endif
6     continue       
c
      goto 1
c
c...assign blending as required by ERHAM
c
4     write(*,'(1x/i7,a)')nlin,' lines have been read in'
c
      nbl=0
      do 3 n=1,nlin-1
        if(ferrout(n).gt.100.)ferrout(n)=0.0d0
        if(freqout(n+1).eq.freqout(n))then
          nbl=1
          goto 3
        else
          if(nbl.eq.0)then
            wtout(n)=0.d0
            goto 3
          endif
          if(nbl.eq.1)then
            wtout(n)=-wtout(n)
            nbl=0
            goto 3
          endif
        endif
3     continue       
      if(ferrout(nlin).gt.100.)ferrout(nlin)=0.0d0
      if(freqout(nlin-1).ne.freqout(nlin))wtout(nlin)=0.d0
C
C...write lines out
C
      nout=0
      do 2 n=1,nlin
        if(descr(n)(3:3).eq.'!')then
          write(3,'(1x)')
          nout=nout+1
        endif
        if(ferrout(n).eq.0.d0)descr(n)='  # excluded'  
c
        write(3,5)is1out(n),is2out(n),jupout(n),nupout(n),jloout(n),
     *            nloout(n),freqout(n),wtout(n),ferrout(n),
     *            descr(n)(1:len_trim(descr(n)))
5       format(2i3,i5,i3,i5,i3,f20.6,f7.1,f12.6,a)
        nout=nout+1
2     continue
c
c      
      close(2)
      close(3)
      write(*,'(i7,a//)')nout,
     *  ' lines have been output (counting also empty lines)'
c
c
      stop
      end
C_____________________________________________________________________________
C_____________________________________________________________________________