242 lines
6.4 KiB
Fortran
242 lines
6.4 KiB
Fortran
SUBROUTINE LINOPW(ID,ABLIN,EMLIN)
|
|
C =================================
|
|
C
|
|
C TOTAL LINE OPACITY (ABLIN) AND EMISSIVITY (EMLIN)
|
|
C (a variant for winds)
|
|
C
|
|
INCLUDE 'PARAMS.FOR'
|
|
INCLUDE 'MODELP.FOR'
|
|
INCLUDE 'SYNTHP.FOR'
|
|
INCLUDE 'LINDAT.FOR'
|
|
INCLUDE 'WINCOM.FOR'
|
|
COMMON/BLAPAR/RELOP,SPACE0,CUTOF0,TSTD,DSTD,ALAMC
|
|
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/IPOTLS/IPOTL(mlin0)
|
|
common/lasers/lasdel
|
|
common/linrej/ilne(mdepth),ilvi(mdepth)
|
|
common/velaux/velmax,iemoff,nltoff,itrad
|
|
C
|
|
DO 10 IJ=1,NFREQ
|
|
ABLIN(IJ)=0.
|
|
ABLINN(IJ)=0.
|
|
EMLIN(IJ)=0.
|
|
10 CONTINUE
|
|
wdil(id)=1.
|
|
plw=plan(id)*wdil(id)
|
|
c plw=xjcon(id)
|
|
C
|
|
IF(NLIN.EQ.0) RETURN
|
|
C
|
|
C overall loop over contributing lines
|
|
C
|
|
TEM1=UN/TEMP(ID)
|
|
HKT=HK*TEM1
|
|
xx=freq(nopac)-freq(1)
|
|
DFRCON=NOPAC-1
|
|
DFRCON=-DFRCON/XX
|
|
IFRCON=int(DFRCON)
|
|
DO 100 I=1,NLIN
|
|
IL=INDLIN(I)
|
|
INNLT=INDNLT(IL)
|
|
c
|
|
c rejecting lines for v > velmax
|
|
c
|
|
if(ilvi(id).gt.0) then
|
|
if(innlt.eq.0) then
|
|
go to 100
|
|
else
|
|
if(nltoff.ne.0) go to 100
|
|
end if
|
|
end if
|
|
c
|
|
c
|
|
c frequency indices of the line centers
|
|
c
|
|
if (id.eq.1) then
|
|
|
|
fr0=freq0(il)
|
|
XJC=3.+DFRCON*(FREQ(1)-FR0)
|
|
IJC=int(XJC)
|
|
IJCNTR(I)=IJC
|
|
if(ijc.le.1.or.ijc.ge.nopac) go to 255
|
|
if(fr0.lt.freq(ijc)) then
|
|
ijc0=ijc
|
|
dfr0=freq(ijc0)-fr0
|
|
252 ijc0=ijc0+1
|
|
dfr=abs(freq(ijc0)-fr0)
|
|
if(dfr.lt.dfr0) then
|
|
ijc=ijc0
|
|
ijc0=ijc0+1
|
|
dfr0=dfr
|
|
go to 252
|
|
end if
|
|
else if(fr0.gt.freq(ijc)) then
|
|
ijc0=ijc
|
|
dfr0=fr0-freq(ijc0)
|
|
254 ijc0=ijc0-1
|
|
dfr=abs(freq(ijc0)-fr0)
|
|
if(dfr.lt.dfr0) then
|
|
ijc=ijc0
|
|
ijc0=ijc0-1
|
|
dfr0=dfr
|
|
go to 254
|
|
end if
|
|
end if
|
|
IJCNTR(I)=IJC
|
|
255 continue
|
|
c write(80,*) i,ijcntr(i),2.997925e18/freq0(il)
|
|
endif
|
|
c
|
|
IAT=INDAT(IL)/100
|
|
ION=MOD(INDAT(IL),100)
|
|
FR0=FREQ0(IL)
|
|
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
|
|
FR0=FREQ0(IL)
|
|
IF(INNLT.EQ.0) THEN
|
|
if(itrad.le.0) then
|
|
AB0=EXP(GF0(IL)-EXCL0(IL)*TEM1)*RRR(ID,ION,IAT)*
|
|
* DOP1*(1.-exp(-hkt*fr0))
|
|
else
|
|
trl=trad(ipotl(il),id)
|
|
xx=exp(-hkt*fr0)
|
|
AB0=EXP(GF0(IL)-EXCL0(IL)/trl)*RRR(ID,ION,IAT)*
|
|
* DOP1*(1.-xx)
|
|
if(excl0(il).gt.2000.) ab0=ab0*wdil(id)
|
|
pla=1.4743e-2*(fr0*1.e-15)**3*xx/(1.-xx)
|
|
sl0=pla*wdil(id)
|
|
end if
|
|
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
|
|
c if(ifwin.le.0) then
|
|
avabw=abstdw(ijcont(il),id)*relop
|
|
EX0=AB0/AVABw*AGAM
|
|
EXT=EXT0
|
|
IF(EX0.GT.TEN) EXT=SQRT(EX0)
|
|
EXT=EXT/DOP1
|
|
IJEXT=int((DFRCON*EXT)+1.5)
|
|
IJ1=MAX(IJCNTR(I)-IJEXT,1)
|
|
IJ2=MIN(IJCNTR(I)+IJEXT,NFREQ)
|
|
IF(IJ1.GE.NFREQ.OR.IJ2.LE.2) GO TO 100
|
|
c else
|
|
c ij1=3
|
|
c ij2=nfreq
|
|
c end if
|
|
C
|
|
IF(INNLT.EQ.0.and.itrad.le.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=1,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
|
|
if(ilne(id).gt.0) go to 80
|
|
EMLIN(IJ)=EMLIN(IJ)+ABL*SL0
|
|
80 CONTINUE
|
|
C
|
|
C again, special expressions for 4 selected He I lines
|
|
C
|
|
ELSE
|
|
DO 90 IJ=1,NFREQ
|
|
FR=FREQ(IJ)
|
|
ABL=AB0*PHE1(ID,FR,ISP-1)
|
|
ABLINN(IJ)=ABLINN(IJ)+ABL
|
|
if(ilne(id).gt.0) go to 90
|
|
EMLIN(IJ)=EMLIN(IJ)+ABL*SL0
|
|
90 CONTINUE
|
|
END IF
|
|
END IF
|
|
100 CONTINUE
|
|
C
|
|
if(vel(id).le.velmax) then
|
|
DO 110 IJ=1,NFREQ
|
|
PLA=BNUE(IJ)/(EXP(HKT*FREQ(IJ))-1.)
|
|
EMLIN(IJ)=EMLIN(IJ)+ABLIN(IJ)*pla*wdil(id)
|
|
ABLIN(IJ)=ABLIN(IJ)+ABLINN(IJ)
|
|
110 CONTINUE
|
|
end if
|
|
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
|