SUBROUTINE ROSSOP(ID,P,TAUR,HOPF,T4,T,ANE,ABROSS)
C     =================================================
C
C     Auxiliary procedure for LTEGR
C     Evaluation of temperature, electron density, and Rosseland
C     opacity for a given TAUR (Rosseland optical depth) and P (total
C     pressure)
C
C     Input parameters:
C     ID     - depth index
C     P      - total pressure
C     TAUR   - Rosseland optical depth
C     HOPF   - mode of evaluating Hopf function;
C            = 0  -  exact Hopf function
C            > 0  -  constant Hopf function to HOPF
C     T4     = effective temperature ** 4
C
C     Output:
C     T      - temperature
C     ANE    - electron density
C     ABROSS - Rosseland opacity (per gram)
C
      INCLUDE 'IMPLIC.FOR'
      INCLUDE 'BASICS.FOR'
      INCLUDE 'ATOMIC.FOR'
      INCLUDE 'MODELQ.FOR'
      INCLUDE 'ALIPAR.FOR'
      DIMENSION A(5)
C
      DATA A/0.71044609D0,-0.2830385D0,0.57975839D0,-0.75751038D0,
     *       0.45026781D0/
      SAVE A
C
C     Hopf function
C
      X=HOPF
      IF(X.GT.0.) GO TO 10
      X=A(1)
      IF(TAUR.GT.160.) GO TO 10
      EX=EXP(-TAUR)
      E1=EXPINT(TAUR)
      E=E1
      DO I=1,4
         E=(EX-TAUR*E)/I
         X=X+E*A(I+1)
      END DO
C
C     Temperature
C
   10 T=(0.75*T4*(TAUR+X)+EXTOT)**0.25
C
C     Determination of electron density from the total pressure
C
      if(ioptab.ge.-1) then
         AN=P/T/BOLK
         CALL ELDENS(ID,T,AN,ANE,ENRG,ENTT,WM,1)
         RHO=WMM(ID)*(AN-ANE)
         DENS(ID)=RHO
C
C     temperature and electron density are transmitted to SABOLF
C     and RATMAT through arrays TEMP and ELEC
C
         TEMP(ID)=T
         ELEC(ID)=ANE
C
C     Corresponding LTE populations
C
         if(ioptab.ge.0) then
            CALL WNSTOR(ID)
            CALL STEQEQ(ID,POP,1)
C
C     Finally, evaluation of the Rosseland opacity for the new values
C     of temperature, electron density, and populations
C     (ROSS - Rosseland opacity per 1 cm**3)
C
            CALL OPACF0(ID,NFREQ)
            CALL MEANOP(T,ABSO,SCAT,OPROS,OPPLA)
            ABROSS=OPROS/RHO
            ABROSD(ID)=ABROSS
            ABPLAD(ID)=OPPLA/RHO
           else
            call meanopt(t,id,rho,opros,oppla)
            abrosd(id)=opros
            abplad(id)=oppla
            abross=opros
         end if
       else
         temp(id)=t
         rho=rhoeos(t,p)
         dens(id)=rho
         call meanopt(t,id,rho,opros,oppla)
         abrosd(id)=opros
         abplad(id)=oppla
         abross=opros
      end if
      RETURN
      END