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