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

47 lines
1.3 KiB
Fortran

SUBROUTINE INIBLA
C =================
C
C driving procedure for treating a partial line list for the
C current wavelength region
C
INCLUDE 'PARAMS.FOR'
INCLUDE 'MODELP.FOR'
INCLUDE 'SYNTHP.FOR'
INCLUDE 'LINDAT.FOR'
COMMON/PRFQUA/DOPA1(MATOM,MDEPTH),VDWC(MDEPTH)
C
PARAMETER (DP0=3.33564E-11, DP1=1.651E8,
c * VW1=0.42, VW2=0.3, TENM4=1.E-4)
* VW1=0.42, VW2=0.45,TENM4=1.E-4)
PARAMETER (UN=1.)
C
IF(NLIN.EQ.0) RETURN
XX=FREQ(1)
IF(NFREQ.GE.2) XX=0.5*(FREQ(1)+FREQ(2))
if(ifwin.gt.0) XX=0.5*(FREQC(1)+FREQC(NFREQC))
BNU=BN*(XX*1.E-15)**3
HKF=HK*XX
if(ifwin.gt.0) XX=un
DO 20 ID=1,ND
T=TEMP(ID)
ANE=ELEC(ID)
EXH=EXP(HKF/T)
EXHK(ID)=UN/EXH
PLAN(ID)=BNU/(EXH-UN)
STIM(ID)=UN-EXHK(ID)
if(iath.gt.0) then
ANP=POPUL(NKH,ID)
AH=DENS(ID)/WMM(ID)/YTOT(ID)-ANP
else
ah=rrr(id,1,1)
end if
AHE=RRR(ID,1,2)
VDWC(ID)=(AH+VW1*AHE+0.85*ANH2(ID))*(T*TENM4)**VW2
DO 10 IAT=1,MATOM
IF(AMAS(IAT).GT.0.)
* DOPA1(IAT,ID)=UN/(XX*DP0*SQRT(DP1*T/AMAS(IAT)+VTURB(ID)))
10 CONTINUE
20 CONTINUE
RETURN
END