SUBROUTINE HE2LIN(ID,I0,I1,ABSOH,EMISH)
C
C     opacity and emissivity of He II lines  (these which are not considered
C     explicitly)
C
      INCLUDE 'PARAMS.FOR'
      INCLUDE 'MODELP.FOR'
      INCLUDE 'SYNTHP.FOR'
      PARAMETER (UN=1.,SIXTH=1./6.)
      PARAMETER (CPP=4.1412E-16,CPJ=631479.) 
      PARAMETER (C00=1.25E-9,CDOP=1.284523E12,CID=0.02654,TWO=2.)
      PARAMETER (CPJ4=CPJ/4.,AL10=2.3025851,CINV=UN/2.997925E18)
      PARAMETER (CID1=0.01497)
      DIMENSION PJ(80),FRHE(12),OSCHE2(19),PRF0(36),
     *          ABSO(MFREQ),EMIS(MFREQ),ABSOH(MFREQ),EMISH(MFREQ)
      COMMON/HE2PRF/PRFHE2(19,MDEPTH,36),WLHE2(19,36),NWLHE2(19),
     *              ILHE2(19),IUHE2(19)
      DATA FRHE /1.3158153D+16, 3.2895381D+15, 1.4624854D+15,
     *           8.2261878D+14, 5.2647201D+14, 3.6560459D+14,
     *           2.6860713D+14, 2.0565220D+14, 1.6249055D+14,
     *           1.3161730D+14, 1.0877460D+14, 9.1400851D+13/
      DATA OSCHE2/6.407E-1, 1.506E-1, 5.584E-2, 2.768E-2,
     *        1.604E-2, 1.023E-2, 6.980E-3,
     *        8.421E-1, 3.230E-2, 1.870E-2, 1.196E-2, 8.187E-3,
     *        5.886E-3, 4.393E-3, 3.375E-3, 2.656E-3,
     *        1.038,    1.793E-1, 6.549E-2/
C
      I=ILWHE2
      izz=2
      DO IJ=I0,I1
         ABSO(IJ)=0.
         EMIS(IJ)=0.
         ABSOH(IJ)=0.
         EMISH(IJ)=0.
      END DO
      T=TEMP(ID)
      T1=UN/T
      SQT=SQRT(T)
      ANE=ELEC(ID)
      ANES=EXP(SIXTH*LOG(ANE))
C
C     He III populations (either LTE or NLTE, depending on input model)
C
      IF(IELHE2.GT.0) THEN
         ANP=POPUL(NNEXT(IELHE2),ID)
         NLHE2=NLAST(IELHE2)-NFIRST(IELHE2)+1
       ELSE
         ANP=RRR(ID,3,2)
         NLHE2=0
      END IF
C
C     populations of the first 60 levels of He II
C
      PP=CPP*ANE*ANP*T1/SQT
      DO IL=1,60
         X=IL*IL
         IIL=NFIRST(IELHE2)+IL-1
         IF(IL.LE.NLHE2) PJ(IL)=POPUL(IIL,ID)
         IF(IL.GT.NLHE2) PJ(IL)=PP*EXP(CPJ/X*T1)*X*wnhe2(il,id)
      END DO
C
C     Frequency- and line-independent parameters for evaluating the
C     asymptotic Stark profile
C
      F00=3.906e-11*ANES*ANES*ANES*ANES
      DOP0=1.E8*SQRT(4.12E7*T+VTURB(ID))
C
C -------------------------------------------------------------------
C     overall loop over spectral series (only in the infrared region)
C -------------------------------------------------------------------
C
      ISERU=ILWHE2
      IF(ILWHE2.LE.3) THEN
         ISERL=ILWHE2
       ELSE IF(ILWHE2.LE.5) THEN
         ISERL=ILWHE2-1
       ELSE IF(ILWHE2.LE.7) THEN
         ISERL=ILWHE2-2
       ELSE IF(ILWHE2.LE.9) THEN
         ISERL=ILWHE2-3
       ELSE
         ISERL=ILWHE2-4
      END IF
C
      DO IJ=I0,I1
         ABSO(IJ)=0.
         EMIS(IJ)=0.
      END DO
C
      DO 200 I=ISERL,ISERU
      II=I*I
      XII=UN/II
      POPI=PJ(I)
C
C     determination of which He II lines contribute in a current 
C     frequency region
C
      M1=MHE10
      IF(I.LT.ILWHE2.AND.FRHE(I).GT.FREQ(2)) THEN
         M1=int(SQRT(FRHE(I)*II/(FRHE(I)-FREQ(2))))
      END IF
      M2=M1+1
      IF(M1.LT.I+1) M1=I+1
      IF(grav.lt.6..and.M1.LE.6.AND.I.EQ.2) GO TO 10
      IF(grav.lt.6..and.M1.LE.4.AND.I.EQ.1) GO TO 10
      M1=M1-1
      M2=MHE20+3
      IF(M2.GT.60) M2=60
   10 CONTINUE
      if(grav.gt.6.) then
         m2=m2+5
         m1=m1-3
         if(m1.gt.i+6) m1=m1-3 
      end if
      IF(M1.LT.I+1) M1=I+1
      IF(M2.GT.60) M2=60
c     A=0.
c     E=0.
C
C     loop over lines which contribute at given wavelength region
C
      DO 100 J=M1,M2
         ILINE=0   
         JJ=J*J
         XJJ=UN/JJ
         ABTRA=PJ(I)*WNHE2(J,ID)
         EMTRA=PJ(J)*WNHE2(I,ID)*II*XJJ*EXP(CPJ*(XII-XJJ)*T1)
         IF(I.LE.2) THEN
            WLIN=227.838/(XII-1./JJ)
          ELSE 
            WLIN=227.7776/(XII-1./JJ)
         END IF
         IF(I.EQ.2) THEN
            IF(J.EQ.3.AND.IHE2PR.GT.0) ILINE=1
          ELSE IF(I.EQ.3) THEN
            IF(J.EQ.4.AND.IHE2PR.GT.0) ILINE=8
            IF(J.GT.5.AND.J.LE.10.AND.IHE2PR.GT.0) ILINE=J-3
          ELSE IF(I.EQ.4) THEN
            IF(J.LE.7.AND.IHE2PR.GT.0) ILINE=J+12
            IF(J.GE.8.AND.J.LE.15.AND.IHE2PR.GT.0) ILINE=J+1
         END IF
         IF(ILINE.GT.0) THEN
            NWL=NWLHE2(ILINE)
            DO IWL=1,NWL
               PRF0(IWL)=PRFHE2(ILINE,ID,IWL)
            END DO
            FID=CID*OSCHE2(ILINE)
            DO 50 IJ=I0,I1
               AL=ABS(WLAM(IJ)-WLIN)
               IF(AL.LT.1.E-4) AL=1.E-4
               AL=LOG10(AL)
               DO IWL=1,NWL-1
                  IW0=IWL
                  IF(AL.LE.WLHE2(ILINE,IWL+1)) GO TO 40
               END DO
   40          IW1=IW0+1
               PRFF=(PRF0(IW0)*(WLHE2(ILINE,IW1)-AL)+PRF0(IW1)*
     *             (AL-WLHE2(ILINE,IW0)))/
     *             (WLHE2(ILINE,IW1)-WLHE2(ILINE,IW0))
               SG=EXP(PRFF*AL10)*FID
               ABSO(IJ)=ABSO(IJ)+SG*ABTRA
               EMIS(IJ)=EMIS(IJ)+SG*EMTRA
   50       CONTINUE
          ELSE
            CALL STARK0(I,J,izz,XKIJ,WL0,FIJ,FIJ0)
            FXK=F00*XKIJ
            FXK1=UN/FXK
            DOP=DOP0/WL0
            DBETA=WL0*WL0*CINV*FXK1
            BETAD=DOP*DBETA
            FID=CID*FIJ*DBETA
c           FID0=CID1*FIJ0/DOP
            CALL DIVHE2(AD,DIV)
            DO IJ=I0,I1
               BETA=ABS(WLAM(IJ)-WL0)*FXK1
               SG=STARKA(BETA,AD,DIV,UN)*FID
c              if(fid0.gt.0.) then
c                 xd=beta/betad
c                 if(xd.lt.5.) sg=sg+exp(-xd*xd)*fid0
c              end if
               ABSO(IJ)=ABSO(IJ)+SG*ABTRA
               EMIS(IJ)=EMIS(IJ)+SG*EMTRA
            END DO
         END IF
  100 CONTINUE
  200 CONTINUE
C
C     ----------------------------
C     total opacity and emissivity
C     ----------------------------
C
      DO IJ=I0,I1
         F=FREQ(IJ)
         F15=F*1.E-15
         XKF=EXP(-4.79928e-11*F*T1)
         XKFB=XKF*1.4743E-2*F15*F15*F15
         ABSOH(IJ)=ABSO(IJ)-XKF*EMIS(IJ)
         EMISH(IJ)=XKFB*EMIS(IJ)
      END DO
      RETURN
      END