98 lines
2.5 KiB
Fortran
98 lines
2.5 KiB
Fortran
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
|