197 lines
5.8 KiB
Fortran
197 lines
5.8 KiB
Fortran
SUBROUTINE HE2LIW(ID,ABSOH,EMISH)
|
|
C =================================
|
|
C
|
|
C opacity and emissivity of He II lines (these which are not considered
|
|
C explicitly)
|
|
C
|
|
INCLUDE 'PARAMS.FOR'
|
|
INCLUDE 'MODELP.FOR'
|
|
INCLUDE 'SYNTHP.FOR'
|
|
INCLUDE 'WINCOM.FOR'
|
|
PARAMETER (UN=1.,SIXTH=1./6.)
|
|
PARAMETER (CPP=4.1412E-16,CPJ=631479.)
|
|
PARAMETER (C00=1.25E-9,CDOP=1.284523E12,CID=0.02654,TWO=2.)
|
|
PARAMETER (CPJ4=CPJ/4.,AL10=2.3025851,CINV=UN/2.997925E18)
|
|
PARAMETER (CID1=0.01497)
|
|
DIMENSION PJ(80),FRHE(12),OSCHE2(19),PRF0(36),
|
|
* ABSO(MFREQ),EMIS(MFREQ),ABSOH(MFREQ),EMISH(MFREQ)
|
|
COMMON/HE2PRF/PRFHE2(19,MDEPTH,36),WLHE2(19,36),NWLHE2(19),
|
|
* ILHE2(19),IUHE2(19)
|
|
common/lasers/lasdel
|
|
DATA FRHE /1.3158153D+16, 3.2895381D+15, 1.4624854D+15,
|
|
* 8.2261878D+14, 5.2647201D+14, 3.6560459D+14,
|
|
* 2.6860713D+14, 2.0565220D+14, 1.6249055D+14,
|
|
* 1.3161730D+14, 1.0877460D+14, 9.1400851D+13/
|
|
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
|
|
I=ILWHE2
|
|
izz=2
|
|
DO IJ=1,NFREQ
|
|
ABSO(IJ)=0.
|
|
EMIS(IJ)=0.
|
|
ABSOH(IJ)=0.
|
|
EMISH(IJ)=0.
|
|
END DO
|
|
IF(IFHE2.LE.0) RETURN
|
|
T=TEMP(ID)
|
|
T1=UN/T
|
|
SQT=SQRT(T)
|
|
ANE=ELEC(ID)
|
|
ANES=EXP(SIXTH*LOG(ANE))
|
|
C
|
|
C He III populations (either LTE or NLTE, depending on input model)
|
|
C
|
|
IF(IELHE2.GT.0) THEN
|
|
ANP=POPUL(NNEXT(IELHE2),ID)
|
|
NLHE2=NLAST(IELHE2)-NFIRST(IELHE2)+1
|
|
ELSE
|
|
ANP=RRR(ID,3,2)
|
|
NLHE2=0
|
|
END IF
|
|
C
|
|
C populations of the first 60 levels of He II
|
|
C
|
|
PP=CPP*ANE*ANP*T1/SQT
|
|
DO IL=1,60
|
|
X=IL*IL
|
|
IIL=NFIRST(IELHE2)+IL-1
|
|
IF(IL.LE.NLHE2) PJ(IL)=POPUL(IIL,ID)
|
|
IF(IL.GT.NLHE2) PJ(IL)=PP*EXP(CPJ/X*T1)*X*wnhe2(il,id)
|
|
END DO
|
|
C
|
|
C Frequency- and line-independent parameters for evaluating the
|
|
C asymptotic Stark profile
|
|
C
|
|
F00=3.906e-11*ANES*ANES*ANES*ANES
|
|
DOP0=1.E8*SQRT(4.12E7*T+VTURB(ID))
|
|
C
|
|
C -------------------------------------------------------------------
|
|
C overall loop over spectral series (only in the infrared region)
|
|
C -------------------------------------------------------------------
|
|
C
|
|
DO 300 IJ=1,NFREQ
|
|
ABSO(IJ)=0.
|
|
EMIS(IJ)=0.
|
|
IF(IHE2LW(IJ).le.0) GO TO 300
|
|
I=ILWHEW(IJ)
|
|
FR=FREQ(IJ)
|
|
ISERU=ILWHEW(IJ)
|
|
IF(ILWHEW(IJ).LE.3) THEN
|
|
ISERL=ILWHEW(IJ)
|
|
ELSE IF(ILWHEW(IJ).LE.5) THEN
|
|
ISERL=ILWHEW(IJ)-1
|
|
ELSE IF(ILWHEW(IJ).LE.7) THEN
|
|
ISERL=ILWHEW(IJ)-2
|
|
ELSE IF(ILWHEW(IJ).LE.9) THEN
|
|
ISERL=ILWHEW(IJ)-3
|
|
ELSE
|
|
ISERL=ILWHEW(IJ)-4
|
|
END IF
|
|
C
|
|
C
|
|
DO 200 I=ISERL,ISERU
|
|
II=I*I
|
|
XII=UN/II
|
|
PLTEI=PP*EXP(CPJ*T1*XII)*II
|
|
POPI=PJ(I)
|
|
C
|
|
C determination of which He II lines contribute in a current
|
|
C frequency region
|
|
C
|
|
M1=MHE10W(IJ)
|
|
IF(I.LT.ILWHEW(IJ).AND.FRHE(I).GT.FR) THEN
|
|
M1=int(SQRT(FRHE(I)*II/(FRHE(I)-FR)))
|
|
END IF
|
|
M2=M1+1
|
|
IF(M1.LT.I+1) M1=I+1
|
|
IF(grav.lt.6..and.M1.LE.6.AND.I.EQ.2) GO TO 10
|
|
IF(grav.lt.6..and.M1.LE.4.AND.I.EQ.1) GO TO 10
|
|
M1=M1-1
|
|
M2=MHE20W(IJ)+3
|
|
IF(M2.GT.60) M2=60
|
|
10 CONTINUE
|
|
if(grav.gt.6.) then
|
|
m2=m2+5
|
|
m1=m1-3
|
|
if(m1.gt.i+6) m1=m1-3
|
|
end if
|
|
IF(M1.LT.I+1) M1=I+1
|
|
IF(M2.GT.60) M2=60
|
|
C
|
|
C loop over lines which contribute at given wavelength region
|
|
C
|
|
DO 100 J=M1,M2
|
|
ILINE=0
|
|
JJ=J*J
|
|
XJJ=UN/JJ
|
|
ABTRA=PJ(I)*WNHE2(J,ID)
|
|
EMTRA=PJ(J)*WNHE2(I,ID)*II*XJJ*EXP(CPJ*(XII-XJJ)*T1)
|
|
IF(I.LE.2) THEN
|
|
WLIN=227.838/(XII-1./JJ)
|
|
ELSE
|
|
WLIN=227.7776/(XII-1./JJ)
|
|
END IF
|
|
IF(I.EQ.2) THEN
|
|
IF(J.EQ.3.AND.IHE2PR.GT.0) ILINE=1
|
|
ELSE IF(I.EQ.3) THEN
|
|
IF(J.EQ.4.AND.IHE2PR.GT.0) ILINE=8
|
|
IF(J.GT.5.AND.J.LE.10.AND.IHE2PR.GT.0) ILINE=J-3
|
|
ELSE IF(I.EQ.4) THEN
|
|
IF(J.LE.7.AND.IHE2PR.GT.0) ILINE=J+12
|
|
IF(J.GE.8.AND.J.LE.15.AND.IHE2PR.GT.0) ILINE=J+1
|
|
END IF
|
|
IF(ILINE.GT.0) THEN
|
|
NWL=NWLHE2(ILINE)
|
|
DO IWL=1,NWL
|
|
PRF0(IWL)=PRFHE2(ILINE,ID,IWL)
|
|
END DO
|
|
FID=CID*OSCHE2(ILINE)
|
|
AL=ABS(WLAM(IJ)-WLIN)
|
|
IF(AL.LT.1.E-4) AL=1.E-4
|
|
AL=LOG10(AL)
|
|
DO IWL=1,NWL-1
|
|
IW0=IWL
|
|
IF(AL.LE.WLHE2(ILINE,IWL+1)) GO TO 40
|
|
END DO
|
|
40 IW1=IW0+1
|
|
PRFF=(PRF0(IW0)*(WLHE2(ILINE,IW1)-AL)+PRF0(IW1)*
|
|
* (AL-WLHE2(ILINE,IW0)))/
|
|
* (WLHE2(ILINE,IW1)-WLHE2(ILINE,IW0))
|
|
SG=EXP(PRFF*AL10)*FID
|
|
ABSO(IJ)=ABSO(IJ)+SG*ABTRA
|
|
EMIS(IJ)=EMIS(IJ)+SG*EMTRA
|
|
ELSE
|
|
CALL STARK0(I,J,izz,XKIJ,WL0,FIJ,FIJ0)
|
|
FXK=F00*XKIJ
|
|
FXK1=UN/FXK
|
|
DOP=DOP0/WL0
|
|
DBETA=WL0*WL0*CINV*FXK1
|
|
BETAD=DOP*DBETA
|
|
FID=CID*FIJ*DBETA
|
|
CALL DIVHE2(AD,DIV)
|
|
BETA=ABS(WLAM(IJ)-WL0)*FXK1
|
|
SG=STARKA(BETA,AD,DIV,UN)*FID
|
|
ABSO(IJ)=ABSO(IJ)+SG*ABTRA
|
|
EMIS(IJ)=EMIS(IJ)+SG*EMTRA
|
|
END IF
|
|
100 CONTINUE
|
|
200 CONTINUE
|
|
C
|
|
C ----------------------------
|
|
C total opacity and emissivity
|
|
C ----------------------------
|
|
C
|
|
F=FREQ(IJ)
|
|
F15=F*1.E-15
|
|
XKF=EXP(-4.79928e-11*F*T1)
|
|
XKFB=XKF*1.4743E-2*F15*F15*F15
|
|
ABSOH(IJ)=ABSO(IJ)-XKF*EMIS(IJ)
|
|
EMISH(IJ)=XKFB*EMIS(IJ)
|
|
300 CONTINUE
|
|
RETURN
|
|
END
|