40 lines
1.1 KiB
Fortran
40 lines
1.1 KiB
Fortran
SUBROUTINE OPACT1(IJ)
|
|
C =====================
|
|
C
|
|
C Absorption, emission, and scattering coefficients
|
|
C at frequency IJ and for all depths
|
|
C
|
|
C Input: IJ opacity and emissivity is calculated for the
|
|
C frequency points with index IJ
|
|
C Output: ABSO1 - array of absorption coefficient
|
|
C EMIS1 - array of emission coefficient
|
|
C SCAT1 - array of scattering coefficient
|
|
C
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'MODELQ.FOR'
|
|
INCLUDE 'ALIPAR.FOR'
|
|
common/hmolab/anh2(mdepth),anhm(mdepth)
|
|
C
|
|
FR=FREQ(IJ)
|
|
DO ID=1,ND
|
|
T=TEMP(ID)
|
|
RHO=DENS(ID)
|
|
HKT1(ID)=HK/T
|
|
XKF(ID)=EXP(-HKT1(ID)*FR)
|
|
XKF1(ID)=UN-XKF(ID)
|
|
XKFB(ID)=XKF(ID)*BNUE(IJ)
|
|
PLAN=XKFB(ID)/XKF1(ID)
|
|
CALL OPCTAB(FR,IJ,ID,T,RHO,AB,SC,SCT,0)
|
|
if(ioptab.lt.0) then
|
|
ABSO1(ID)=AB+sct
|
|
SCAT1(ID)=SCT
|
|
ABSOT(ID)=ABSOT(ID)+ABSO1(ID)/DENS(ID)
|
|
else if(ioptab.gt.0) then
|
|
ABSO1(ID)=ABSO1(ID)+AB
|
|
end if
|
|
EMIS1(ID)=EMIS1(ID)+AB*PLAN
|
|
END DO
|
|
RETURN
|
|
END
|