git push -u origin main
This commit is contained in:
@@ -0,0 +1,158 @@
|
||||
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
|
||||
Reference in New Issue
Block a user