PROGRAM RTIOSCHWENKE
C     READS PACKED BINARY VERSION OF SCHWENKE'S TIO LINELIST
C     THROWS AWAY LEVEL INFORMATION IF LINOUT < 0
      PARAMETER (kw=99)
      REAL*4 XJTIO(269300)
      REAL*8 ETIO(269300,5),STATETIO(269300,5)
      REAL*8 WL,E,EP,LABEL(2),LABELP(2),WLVAC,VACAIR,RATIOLOG
      INTEGER*2 IELION,IELO,IGFLOG,IGR,IGS,IGW
      COMMON /IIIIIII/IWL,IELION,IELO,IGFLOG,IGR,IGS,IGW
      INTEGER*4 IIIIIII(4)
      EQUIVALENCE (IIIIIII(1),IWL)
      REAL*8 LABELISO(5)
      DATA LABELISO/2H46,2H47,2H48,2H49,2H50/
      RATIOLOG=LOG(1.D0+1.D0/2000000.D0)
      OPEN(UNIT=11,STATUS='OLD',READONLY,SHARED,FORM='UNFORMATTED',
     1RECORDTYPE='FIXED',BLOCKSIZE=8000,RECORDSIZE=4,ACCESS='DIRECT')
      OPEN(UNIT=12,STATUS='NEW',CARRIAGECONTROL='LIST')
      READ(48)ETIO,XJTIO,STATETIO
      CLOSE(UNIT=48)
      ICODE=822
      DO 20 ILINE=1,37744499
      READ(11,REC=ILINE)IIIIIII
      ISO=ABS(IELION)-8949
C      if(iso.ne.3)go to 20
      WLVAC=EXP(IWL*RATIOLOG)
      WL=VACAIR(WLVAC)
      KGW=IGW
      KGS=IGS
      LEVELLO=KGS*10+MOD(ABS(KGW),10)
      LEVELUP=KGW/10+LEVELLO
      E=ETIO(LEVELLO,ISO)
      EP=ETIO(LEVELUP,ISO)
      XJ=XJTIO(LEVELLO)
      XJP=XJTIO(LEVELUP)
      LABEL(1)=STATETIO(LEVELLO,ISO)
      LABELP(1)=STATETIO(LEVELUP,ISO)
      LABELP(2)=LABELISO(ISO)
      GFLOG=(IGFLOG-16384)*.001
      WRITE(12,12)WL,GFLOG,XJ,E,XJP,EP,ICODE,LABEL(1),LABELP(1),
     1            LABELP(2)
   12 FORMAT(F10.4,F7.3,F5.1,F10.3,F5.1,F10.3,I3,A8,A8,A2)
   20 CONTINUE
      CALL EXIT
      END
      FUNCTION VACAIR(W)
      IMPLICIT REAL*8 (A-H,O-Z)
C     W IS VACUUM WAVELENGTH IN NM
      WAVEN=1.D7/W
      VACAIR=W/(1.0000834213D0+
     1 2406030.D0/(1.30D10-WAVEN**2)+15997.D0/(3.89D9-WAVEN**2))
C    1(1.000064328+2949810./(1.46E10-WAVEN**2)+25540./(4.1E9-WAVEN**2))         
      RETURN
      END