PROGRAM REPACKH2O
      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
      OPEN(UNIT=11,TYPE='OLD',FORM='UNFORMATTED',
     1RECORDTYPE='FIXED',BLOCKSIZE=8000,RECL=2)
      OPEN(UNIT=12,TYPE='NEW',FORM='UNFORMATTED',
     1RECORDTYPE='FIXED',BLOCKSIZE=32000,RECL=8000)
      DO 5 LINE=1,65912356
      READ(11)IWL,IELO,IGFLOG
      IF(IWL.LT.IWLSTART)GO TO 5
      IF(IWL.GT.IWLSTOP)GO TO 5
      KGFLOG=ABS(IGFLOG)
 1871 ISO=1
      IF(IELO.GT.0.AND.IGFLOG.GT.0)GO TO 1819
      ISO=2
      IF(IELO.GT.0)GO TO 1819
      ISO=3
      IF(IGFLOG.GT.0)GO TO 1819
      ISO=4
 1819 GO TO (1811,1812,1813,1814),ISO
C     1H1H16O
 1811 IGFLOG=MAX(KGFLOG-001,1)
      GO TO 1816
C     1H1H17O
 1812 IGFLOG=MAX(KGFLOG-3398,1)
      GO TO 1816
C     1H1H18O
 1813 IGFLOG=MAX(KGFLOG-2690,1)
      GO TO 1816
C     1H2H16O
 1814 IGFLOG=MAX(KGFLOG-5000,1)
 1816 IELION=534
      IELO=ABS(IELO)
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
      GAMMAR=2.223E13/WLVAC**2*.001
      GR=LOG10(GAMMAR)
      IGR=GR*1000.+16384.5
      CALL PACK(IIIIIII)
      NLINES=NLINES+1
    5 CONTINUE
    8 PRINT 1,NLINES
    1 FORMAT(I10,' LINES FROM H2OFAST')
      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