PROGRAM RH3PLUS
c     revised  1feb2015
      IMPLICIT REAL*4 (A-H,O-Z)
      PARAMETER (kw=99)
      COMMON /LINDAT/WL,E,EP,LABEL(2),LABELP(2),OTHER1(2),OTHER2(2),
     1        WLVAC,CENTER,CONCEN, NELION,GAMMAR,GAMMAS,GAMMAW,REF,
     2      NBLO,NBUP,ISO1,X1,ISO2,X2,GFLOG,XJ,XJP,CODE,ELO,GF,GS,GR,GW,
     3        DWL,DGFLOG,DGAMMAR,DGAMMAS,DGAMMAW,EXTRA1,EXTRA2,EXTRA3
      REAL*8 LINDAT8(14)
      REAL*4 LINDAT4(28)
      EQUIVALENCE (LINDAT8(1),WL),(LINDAT4(1),NELION)
      REAL*8 RESOLU,RATIO,RATIOLG,SIGMA2,WLBEG,WLEND
      REAL*8 WL,E,EP,WLVAC,CENTER,CONCEN
      REAL*8 LABEL,LABELP,OTHER1,OTHER2
      CHARACTER*8 CLABELP
      EQUIVALENCE (CLABELP,LABELP(1))
      CHARACTER*4 CREF
      EQUIVALENCE (CREF,REF)
      DIMENSION DECKJ(7,kw)
      REAL*8 START,STOP
C      OPEN(UNIT=11,TYPE='OLD',FORM='UNFORMATTED',RECORDTYPE='FIXED',
C     1ACCESS='DIRECT',RECL=8,READONLY,SHARED)
      OPEN(UNIT=12,STATUS='OLD',FORM='UNFORMATTED',ACCESS='APPEND')
      OPEN(UNIT=14,STATUS='OLD',FORM='UNFORMATTED',ACCESS='APPEND')
      READ(93)NLINES,LENGTH,IFVAC,IFNLTE,N19,TURBV,DECKJ,IFPRED,
     1WLBEG,WLEND,RESOLU,RATIO,RATIOLG,CUTOFF,LINOUT
      IXWLBEG=DLOG(WLBEG)/RATIOLG
      IF(DEXP(IXWLBEG*RATIOLG).LT.WLBEG)IXWLBEG=IXWLBEG+1
      NBLO=0
      NBUP=0
      OTHER1(1)=(8H        )
      OTHER1(2)=(2H  )
      OTHER2(1)=(8H        )
      OTHER2(2)=(2H  )
      LABEL(1)=(8H        )
      LABEL(2)=(2H  )
      LABELP(1)=(8H        )
      LABELP(2)=(2H  )
      REF=(4HTENN)
      ION=1
      ZEFF=ION
      ISO=1
      CODE=10101.01
      NELION=504
      IS01=1
      IS02=1
      X1=0.
      X2=0.
C     STATISTICAL WEIGHT INCLUDED IN GFLOG
C     GFWEIGHT(IG)
C     GWEIGHT(2)=2.
C     GWEIGHT(3)=8./3.
C     GWEIGHT(4)=4.
      START=WLBEG-.1
      STOP=WLEND+1.
      STOP1=STOP+1.
      N=0
      DO 20 ILINE=1,2329127
C     READ(11,1111)WL,GFLOG,XJ,E,XJP,EP
      READ(11,1111)WL,GFLOG,XJ,E,XJP,EP,IG,CODE,WAVENO
 1111 FORMAT(F10.4,F7.3,F5.1,F11.3,F5.1,F11.3,I4,F8.2,F10.4)
      IF(ABS(WL).GT.STOP1)GO TO 21
C     PREDICTED LEVELS ARE NOT INDICATED
C     IF(IFPRED.EQ.0.AND.E.LT.0.)GO TO 20
C     IF(IFPRED.EQ.0.AND.EP.LT.0.)GO TO 20
      IF(WL.LT.START)GO TO 20
      WLVAC=1.D7/WAVENO
      IF(WLVAC.LT.START)GO TO 20
C     GUESS
      GAMMAR=2.223D13/WLVAC**2*.001
      IF(N.EQ.0)THEN
      WRITE(6,6)ILINE
    6 FORMAT(I10,19H IS FIRST LINE READ)
      PRINT 3,ILINE,WL,GFLOG,XJ,E,XJP,EP
      ENDIF
      IF(WLVAC.GT.STOP)GO TO 21
      GF=10.**GFLOG
      ELO=E
      IXWL=DLOG(WLVAC)/RATIOLG+.5D0
      NBUFF=IXWL-IXWLBEG+1
      FREQ=2.99792458D17/WLVAC
      CONGF=.01502*GF/FREQ
      FRQ4PI=FREQ*12.5664
C     GUESSES
      GAMMAS=3.E-8
      GAMMAW=1.E-8
      GR=LOG10(GAMMAR)
      GS=LOG10(GAMMAS)
      GW=LOG10(GAMMAW)
      GAMRF=GAMMAR/FRQ4PI
      GAMSF=GAMMAS/FRQ4PI
      GAMWF=GAMMAW/FRQ4PI
      WRITE(12)NBUFF,CONGF,NELION,ELO,GAMRF,GAMSF,GAMWF
   17 FORMAT(I10)
      IF(LINOUT.GE.0)WRITE(14)LINDAT8,LINDAT4
      N=N+1
      NLINES=NLINES+1
   20 CONTINUE
   21 WRITE(6,22)ILINE
   22 FORMAT(I10,18H IS LAST LINE READ)
   25 WRITE(6,26)N
   26 FORMAT(I10,' LINES ADDED TO TAPE 12')
      WRITE(6,27)NLINES
   27 FORMAT(I10,' LINES TOTAL ON TAPE 12')
      REWIND 93
      WRITE(93)NLINES,LENGTH,IFVAC,IFNLTE,N19,TURBV,DECKJ,IFPRED,
     1WLBEG,WLEND,RESOLU,RATIO,RATIOLG,CUTOFF,LINOUT
   99 PRINT 3,ILINE,WL,GFLOG,XJ,E,XJP,EP,CODE,LABEL(1),LABELP(1),ISO
    3 FORMAT(I10,1X,F10.4,F7.3,F5.1,F12.3,F5.1,F12.3,F9.2,A8,2X,A8,I2)
      CALL EXIT
      END