39 lines
880 B
Fortran
39 lines
880 B
Fortran
SUBROUTINE MEANOPT(T,ID,RHO,OPROS,OPPLA)
|
|
C ========================================
|
|
C
|
|
C Rosseland and Planck mean opacities
|
|
C
|
|
C Input parameters:
|
|
C T - temperature
|
|
C RHO - density
|
|
C Output:
|
|
C OPROS - Rosseland opacity (per gram)
|
|
C OPPLA - Planck mean opacity (per gram)
|
|
C
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'MODELQ.FOR'
|
|
C
|
|
ABR=0.
|
|
SUMDB=0.
|
|
ABP=0.
|
|
SUMB=0.
|
|
HKT=HK/T
|
|
C
|
|
DO IJ=1,NFREQ
|
|
FR=FREQ(IJ)
|
|
EX=EXP(HKT*FR)
|
|
E1=UN/(EX-UN)
|
|
PLAN=BNUE(IJ)*E1*W(IJ)
|
|
DPLAN=PLAN*HKT*FR*EX*E1
|
|
CALL OPCTAB(FR,IJ,ID,T,RHO,AB,SC,SCT,1)
|
|
ABR=ABR+DPLAN/(AB+SCT)
|
|
ABP=ABP+PLAN*AB
|
|
SUMDB=SUMDB+DPLAN
|
|
SUMB=SUMB+PLAN
|
|
END DO
|
|
OPROS=SUMDB/ABR
|
|
OPPLA=ABP/SUMB
|
|
RETURN
|
|
END
|