99 lines
2.9 KiB
Fortran
99 lines
2.9 KiB
Fortran
SUBROUTINE PHE2(ISPEC,ID,ABLIN,EMLIN)
|
|
C =====================================
|
|
C
|
|
C Evaluation of the opacity and emissivity in a given He II line,
|
|
C using profile coefficients calculated by Schoening and Butler.
|
|
C
|
|
C Input: ISPEC - line index, defined in HE2INI
|
|
C ID - depth index
|
|
C Output: ABLIN - absorption coefficient
|
|
C EMLIN - emission coefficient
|
|
C
|
|
INCLUDE 'PARAMS.FOR'
|
|
INCLUDE 'MODELP.FOR'
|
|
INCLUDE 'SYNTHP.FOR'
|
|
DIMENSION ABLIN(1),EMLIN(1),OSCHE2(19),PRF0(40),WLL(40)
|
|
COMMON/HE2PRF/PRFHE2(19,MDEPTH,36),WLHE2(19,36),NWLHE2(19),
|
|
* ILHE2(19),IUHE2(19)
|
|
common/lasers/lasdel
|
|
DATA OSCHE2/6.407E-1, 1.506E-1, 5.584E-2, 2.768E-2,
|
|
* 1.604E-2, 1.023E-2, 6.980E-3,
|
|
* 8.421E-1, 3.230E-2, 1.870E-2, 1.196E-2, 8.187E-3,
|
|
* 5.886E-3, 4.393E-3, 3.375E-3, 2.656E-3,
|
|
* 1.038, 1.793E-1, 6.549E-2/
|
|
C
|
|
C ILINE - line index
|
|
C
|
|
ILINE=ISPEC-5
|
|
C
|
|
DO 10 IWL=1,NWLHE2(ILINE)
|
|
PRF0(IWL)=PRFHE2(ILINE,ID,IWL)
|
|
WLL(IWL)=WLHE2(ILINE,IWL)
|
|
10 CONTINUE
|
|
C
|
|
I=ILHE2(ILINE)
|
|
J=IUHE2(ILINE)
|
|
II=I*I
|
|
JJ=J*J
|
|
IF(I.LE.2) THEN
|
|
WLIN=227.838/(1./II-1./JJ)
|
|
ELSE
|
|
WLIN=227.7776/(1./II-1./JJ)
|
|
END IF
|
|
T=TEMP(ID)
|
|
C
|
|
C He III population (either LTE or NLTE, depending on input model)
|
|
C
|
|
IF(IELHE2.GT.0.and.inlte.gt.0) THEN
|
|
PP=POPUL(NNEXT(IELHE2),ID)
|
|
NLHE2=NLAST(IELHE2)-NFIRST(IELHE2)+1
|
|
ELSE
|
|
PP=RRR(ID,3,2)
|
|
NLHE2=0
|
|
END IF
|
|
C
|
|
C population of the lower level of the given transition
|
|
C (again either LTE or NLTE)
|
|
C
|
|
PP=PP*ELEC(ID)*4.1412E-16/T/SQRT(T)*II
|
|
IF(I.LE.NLHE2.and.inlte.gt.0) THEN
|
|
POPI=POPUL(NFIRST(IELHE2)+I-1,ID)
|
|
ELSE
|
|
POPI=PP*EXP(631479./T/II)
|
|
END IF
|
|
C
|
|
C population of the upper level of the given transition
|
|
C (again either LTE or NLTE)
|
|
C
|
|
IF(J.LE.NLHE2) THEN
|
|
POPJ=POPUL(NFIRST(IELHE2)+J-1,ID)*II/JJ
|
|
ELSE
|
|
POPJ=PP*EXP(631479./T/JJ)
|
|
END IF
|
|
|
|
C
|
|
C loop over frequency points - opacity and emissivity in the given line
|
|
C absorption coefficent is found by interpolating in previously
|
|
C calculated tables, based on calculations of Schoening and Butler
|
|
C (see procedure HE2INI)
|
|
C
|
|
FID=0.02654*OSCHE2(ILINE)
|
|
DO 50 IJ=3,NFREQ
|
|
AL=ABS(WLAM(IJ)-WLIN)
|
|
IF(AL.LT.1.E-4) AL=1.E-4
|
|
AL=LOG10(AL)
|
|
DO 20 IWL=1,NWLHE2(ILINE)-1
|
|
IW0=IWL
|
|
IF(AL.LE.WLL(IWL+1)) GO TO 30
|
|
20 CONTINUE
|
|
30 IW1=IW0+1
|
|
PRH=(PRF0(IW0)*(WLL(IW1)-AL)+PRF0(IW1)*(AL-WLL(IW0)))/
|
|
* (WLL(IW1)-WLL(IW0))
|
|
SG=EXP(PRH*2.3025851)*FID
|
|
if((popi-popj).le.0. .and. lasdel) goto 50
|
|
ABLIN(IJ)=ABLIN(IJ)+SG*(POPI-POPJ)
|
|
EMLIN(IJ)=EMLIN(IJ)+SG*POPJ*1.4747E-2*(FREQ(IJ)*1.E-15)**3
|
|
50 CONTINUE
|
|
RETURN
|
|
END
|