159 lines
4.2 KiB
Fortran
159 lines
4.2 KiB
Fortran
SUBROUTINE LINOP(ID,ABLIN,EMLIN,AVAB)
|
|
C =====================================
|
|
C
|
|
C TOTAL LINE OPACITY (ABLIN) AND EMISSIVITY (EMLIN)
|
|
C
|
|
INCLUDE 'PARAMS.FOR'
|
|
INCLUDE 'MODELP.FOR'
|
|
INCLUDE 'SYNTHP.FOR'
|
|
INCLUDE 'LINDAT.FOR'
|
|
PARAMETER (UN = 1.,
|
|
* EXT0 = 3.17,
|
|
* TEN = 10.,
|
|
* C3 = 1.4387886,
|
|
* XET = 8067.6,
|
|
* XET3 = XET*C3)
|
|
DIMENSION ABLIN(MFREQ),EMLIN(MFREQ),ABLINN(MFREQ)
|
|
COMMON/PRFQUA/DOPA1(MATOM,MDEPTH),VDWC(MDEPTH)
|
|
COMMON/NLTPOP/PNLT(MATOM,MION,MDEPTH)
|
|
common/lasers/lasdel
|
|
C
|
|
DO 10 IJ=1,NFREQ
|
|
ABLIN(IJ)=0.
|
|
ABLINN(IJ)=0.
|
|
EMLIN(IJ)=0.
|
|
10 CONTINUE
|
|
C
|
|
IF(NLIN.EQ.0) RETURN
|
|
C
|
|
C overall loop over contributing lines
|
|
C
|
|
TEM1=UN/TEMP(ID)
|
|
DO 100 I=1,NLIN
|
|
IL=INDLIN(I)
|
|
INNLT=INDNLT(IL)
|
|
IAT=INDAT(IL)/100
|
|
ION=MOD(INDAT(IL),100)
|
|
LPR=.TRUE.
|
|
ISP=ISPRF(IL)
|
|
IF(ISP.GT.1.AND.ISP.LE.5) LPR=.FALSE.
|
|
IF (ISP.GE.6) GO TO 100
|
|
CALL PROFIL(IL,IAT,ID,AGAM)
|
|
DOP1=DOPA1(IAT,ID)
|
|
FR0=FREQ0(IL)
|
|
IF(INNLT.EQ.0) THEN
|
|
AB0=EXP(GF0(IL)-EXCL0(IL)*TEM1)*RRR(ID,ION,IAT)*
|
|
* DOP1*STIM(ID)
|
|
ELSE IF(INNLT.GT.0) THEN
|
|
AB0=ABCENT(INNLT,ID)
|
|
SL0=SLIN(INNLT,ID)
|
|
ELSE
|
|
ILW=ILOWN(IL)
|
|
IUN=IUPN(IL)
|
|
COR=1.
|
|
PP=PNLT(IAT,ION,ID)
|
|
IF(ILW.GT.0) THEN
|
|
PI=POPUL(ILW,ID)/G(ILW)
|
|
ELSE
|
|
PI=PP*EXP((ENEV(IAT,ION)*XET3-EXCL0(IL))*TEM1)
|
|
END IF
|
|
IF(IUN.GT.0) THEN
|
|
PJ=POPUL(IUN,ID)/G(IUN)
|
|
cor=(excu0(il)-excl0(il)+
|
|
* (enion(iun)-enion(ilw))/1.38054e-16)*tem1
|
|
cor=exp(cor)
|
|
ELSE
|
|
PJ=PP*EXP((ENEV(IAT,ION)*XET3-EXCU0(IL))*TEM1)
|
|
END IF
|
|
if(pj.gt.0.) then
|
|
X=PI/PJ*cor
|
|
else
|
|
x=un
|
|
end if
|
|
IF(X.EQ.UN) X=EXP(4.79928E-11*FREQ0(IL)*TEM1)
|
|
SL0=BNUL(IL)/(X-UN)
|
|
ab0=0.
|
|
if(pi.gt.0.) AB0=PI*(UN-UN/X)*EXP(GF0(IL))*DOP1
|
|
END IF
|
|
if(ab0.le.0.and.lasdel) go to 100
|
|
C
|
|
C set up limiting frequencies where the line I is supposed to
|
|
C contribute to the opacity
|
|
C
|
|
EX0=AB0/AVAB*AGAM
|
|
EXT=EXT0
|
|
IF(EX0.GT.TEN) EXT=SQRT(EX0)
|
|
EXT=EXT/DOP1
|
|
XIJEXT=DFRCON*EXT+1.5
|
|
c IJ1=MAX(IJCNTR(I)-IJEXT,3)
|
|
c IJ2=MIN(IJCNTR(I)+IJEXT,NFREQS)
|
|
IJ1=int(MAX(float(IJCNTR(I))-XIJEXT,3.))
|
|
IJ2=int(MIN(float(IJCNTR(I))+XIJEXT,float(NFREQS)))
|
|
IF(IJ1.GE.NFREQ.OR.IJ2.LE.2) GO TO 100
|
|
C
|
|
IF(INNLT.EQ.0) THEN
|
|
C
|
|
C *********
|
|
C LTE lines
|
|
C *********
|
|
C
|
|
IF(LPR) THEN
|
|
C
|
|
DO 40 IJ=IJ1,IJ2
|
|
XF=ABS(FREQ(IJ)-FR0)*DOP1
|
|
ABLIN(IJ)=ABLIN(IJ)+AB0*VOIGTK(AGAM,XF)
|
|
40 CONTINUE
|
|
C
|
|
C special expressions for 4 selected He I lines
|
|
C
|
|
ELSE
|
|
DO 60 IJ=3,NFREQ
|
|
FR=FREQ(IJ)
|
|
ABL=AB0*PHE1(ID,FR,ISP-1)
|
|
ABLIN(IJ)=ABLIN(IJ)+ABL
|
|
60 CONTINUE
|
|
END IF
|
|
C
|
|
C **********
|
|
C NLTE LINES
|
|
C **********
|
|
C
|
|
ELSE
|
|
IF(LPR) THEN
|
|
C
|
|
DO 80 IJ=IJ1,IJ2
|
|
XF=ABS(FREQ(IJ)-FR0)*DOP1
|
|
ABL=AB0*VOIGTK(AGAM,XF)
|
|
ABLINN(IJ)=ABLINN(IJ)+ABL
|
|
EMLIN(IJ)=EMLIN(IJ)+ABL*SL0
|
|
80 CONTINUE
|
|
C
|
|
C again, special expressions for 4 selected He I lines
|
|
C
|
|
ELSE
|
|
DO 90 IJ=3,NFREQ
|
|
FR=FREQ(IJ)
|
|
ABL=AB0*PHE1(ID,FR,ISP-1)
|
|
ABLINN(IJ)=ABLINN(IJ)+ABL
|
|
EMLIN(IJ)=EMLIN(IJ)+ABL*SL0
|
|
90 CONTINUE
|
|
END IF
|
|
END IF
|
|
100 CONTINUE
|
|
C
|
|
DO 110 IJ=3,NFREQ
|
|
EMLIN(IJ)=EMLIN(IJ)+ABLIN(IJ)*PLAN(ID)
|
|
ABLIN(IJ)=ABLIN(IJ)+ABLINN(IJ)
|
|
110 CONTINUE
|
|
C
|
|
C special routine for selected He II lines
|
|
C
|
|
IF(NSP.EQ.0) RETURN
|
|
DO 120 IS=1,NSP
|
|
ISP=ISP0(IS)
|
|
IF(ISP.GE.6.AND.ISP.LE.24) CALL PHE2(ISP,ID,ABLIN,EMLIN)
|
|
120 CONTINUE
|
|
C
|
|
RETURN
|
|
END
|