PROGRAM REPACKTIO
      IMPLICIT REAL*8 (A-H,O-Z)
      COMMON /PACK8000/PACK8000(4,2000)
      INTEGER*2 IELION,IELO,IGFLOG,IGR,IGS,IGW
      COMMON /IIIIIII/IWL,IELION,IELO,IGFLOG,IGR,IGS,IGW
      INTEGER*4 IIIIIII(4),PACK8000
      EQUIVALENCE (IIIIIII(1),IWL)
      RATIOLOG=LOG(1.D0+1.D0/2000000.D0)
      RATIOLG=LOG(1.D0+1.D0/500000.D0)
      WLBEG=8.97666
      WLEND=10000.
      IXWLBEG=DLOG(WLBEG)/RATIOLG
      IF(DEXP(IXWLBEG*RATIOLG).LT.WLBEG)IXWLBEG=IXWLBEG+1
      IWLSTART=DLOG(WLBEG)/RATIOLOG+.5
      IWLSTOP=DLOG(WLEND)/RATIOLOG+.5
      NLINES=0
C     TIOLINES
c!$MOUNT/MEDIA=CDROM/UNDEFINED_FAT=(FIXED:NONE:16) DKA270 CDROM24 CDROM24
c!$ASSIGN CDROM24:[CDROM24]SCHWENKE.BIN FOR011
c$ASSIGN TIOSCHWENKE.BIN FOR011
c$ASSIGN TIO:ETIOSCHWENKE.BIN FOR048
c$RUN SYNTHE:RTIOSCHWENKE
c$!
      OPEN(UNIT=11,TYPE='OLD',FORM='UNFORMATTED',
     1RECORDTYPE='FIXED',BLOCKSIZE=8000,RECL=4)
      OPEN(UNIT=12,TYPE='NEW',FORM='UNFORMATTED',
     1RECORDTYPE='FIXED',BLOCKSIZE=32000,RECL=8000)
      DO 5 LINE=1,50000000
      READ(11,END=8)IIIIIII
      IF(IWL.LT.IWLSTART)GO TO 5
      IF(IWL.GT.IWLSTOP)GO TO 5
      KGFLOG=IGFLOG
      ISO=ABS(IELION)-8949
      GO TO (811,812,813,814,815),ISO
C     46TiO
  811 IGFLOG=MAX(KGFLOG-1101,1)
      GO TO 816
C     47TiO
  812 IGFLOG=MAX(KGFLOG-1138,1)
      GO TO 816
C     48TiO
  813 IGFLOG=MAX(KGFLOG-131,1)
      GO TO 816
C     49TiO
  814 IGFLOG=MAX(KGFLOG-1259,1)
      GO TO 816
C     50TiO
  815 IGFLOG=MAX(KGFLOG-1272,1)
  816 IELION=366
C     GAMMAS=0.
      IGS=1
C     LOG GAMMAW=-7
      IGW=9384
      WLVAC=EXP(IWL*RATIOLOG)
      IXWL=DLOG(WLVAC)/RATIOLG+.5D0
      NBUFF=IXWL-IXWLBEG+1
      IWL=NBUFF
      CALL PACK(IIIIIII)
      NLINES=NLINES+1
    5 CONTINUE
    8 PRINT 1,NLINES
    1 FORMAT(I10,' LINES FROM TIOLINES')
      WRITE(12)PACK8000
      CALL EXIT
      END
      SUBROUTINE PACK(IIIIIII)
      INTEGER*4 PACK8000,IIIIIII(4)
      COMMON /PACK8000/PACK8000(4,2000)
      DATA IREC/0/
      IREC=IREC+1
      PACK8000(1,IREC)=IIIIIII(1)
      PACK8000(2,IREC)=IIIIIII(2)
      PACK8000(3,IREC)=IIIIIII(3)
      PACK8000(4,IREC)=IIIIIII(4)
      IF(IREC.EQ.2000)THEN
      WRITE(12)PACK8000
      IREC=0
      ENDIF
      RETURN
      END