SpectraRust/synspec/extracted/molop.f
2026-03-19 14:05:33 +08:00

62 lines
1.7 KiB
Fortran

SUBROUTINE MOLOP(ID,ABLIN,EMLIN,AVAB,ILIST)
C ===========================================
C
C Total molecular 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.)
DIMENSION ABLIN(MFREQ),EMLIN(MFREQ)
C
DO IJ=1,NFREQ
ABLIN(IJ)=0.
EMLIN(IJ)=0.
END DO
C
if(temp(id).gt.tmolim) return
IF(NLINML(ILIST).EQ.0) RETURN
if(inactm(ilist).ne.0) return
C
C overall loop over contributing lines
C
TEM1=UN/TEMP(ID)
ANE=ELEC(ID)
DO I=1,NLINML(ILIST)
IL=INMLIN(I,ILIST)
IMOL=INDATM(IL,ILIST)
DOP1=DOPMOL(IMOL,ID)
AGAM=(GRM(IL,ILIST)+GSM(IL,ILIST)*ANE+
* GVDW(IL,ILIST,ID))*DOP1
FR0=FREQM(IL,ILIST)
AB0=EXP(GFM(IL,ILIST)-EXCLM(IL,ILIST)*TEM1)*RRMOL(IMOL,ID)*
* DOP1*STIM(ID)
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
IJ1=int(MAX(float(IJCMTR(I,ILIST))-XIJEXT,3.))
IJ2=int(MIN(float(IJCMTR(I,ILIST))+XIJEXT,float(NFREQS)))
IF(IJ1.LT.NFREQ.AND.IJ2.GT.2) THEN
DO IJ=IJ1,IJ2
XF=ABS(FREQ(IJ)-FR0)*DOP1
ABLIN(IJ)=ABLIN(IJ)+AB0*VOIGTK(AGAM,XF)
END DO
END IF
END DO
C
DO IJ=3,NFREQ
EMLIN(IJ)=EMLIN(IJ)+ABLIN(IJ)*PLAN(ID)
END DO
C
RETURN
END