44 lines
1.1 KiB
Fortran
44 lines
1.1 KiB
Fortran
SUBROUTINE MEANOP(T,ABSO,SCAT,OPROS,OPPLA)
|
|
C ==========================================
|
|
C
|
|
C Rosseland and Planck mean opacities
|
|
C
|
|
C Input parameters:
|
|
C T - temperature
|
|
C ABSO - array of absorption coefficients in all explicit
|
|
C frequency points
|
|
C SCAT - array of scttering coefficients
|
|
C Output:
|
|
C OPROS - Rosseland opacity (per 1 cm**3)
|
|
C OPPLA - Planck mean opacity (per 1 cm**3)
|
|
C
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'MODELQ.FOR'
|
|
INCLUDE 'ATOMIC.FOR'
|
|
DIMENSION ABSO(MFREQ),SCAT(MFREQ)
|
|
C
|
|
ABR=0.
|
|
SUMDB=0.
|
|
ABP=0.
|
|
SUMB=0.
|
|
HKT=HK/T
|
|
C
|
|
DO IJ=1,NFREQC
|
|
FR=FREQ(IJ)
|
|
X=HKT*FR
|
|
IF(X.GT.150.) X=150.
|
|
EX=EXP(X)
|
|
E1=UN/(EX-UN)
|
|
PLAN=BNUE(IJ)*E1*W(IJ)
|
|
DPLAN=PLAN*HKT*FR*EX*E1
|
|
ABR=ABR+DPLAN/ABSO(IJ)
|
|
ABP=ABP+PLAN*(ABSO(IJ)-SCAT(IJ))
|
|
SUMDB=SUMDB+DPLAN
|
|
SUMB=SUMB+PLAN
|
|
END DO
|
|
OPROS=SUMDB/ABR
|
|
OPPLA=ABP/SUMB
|
|
RETURN
|
|
END
|