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

42 lines
1.3 KiB
Fortran

FUNCTION VOIGTK(A,V)
C ====================
C
C Voigt function after Kurucz (in Computational Astrophysics)
C
INCLUDE 'PARAMS.FOR'
PARAMETER (MVOI=2001)
PARAMETER (ONE=1., THREE=3., TEN=10., FIFTN=15., TWOH=200.,
* C14142=1.4142, C11283=1.12838, C15=1.5,C32=3.2,
* C05642=0.5642,C79788=0.79788,C02=0.2,C14=1.4,
* C37613=0.37613,C23=2./3.,
* CV1=-.122727278,CV2=.532770573,CV3=-.96284325,
* CV4=.979895032)
COMMON/VOITAB/H0TAB(MVOI),H1TAB(MVOI),H2TAB(MVOI)
IV=int(V*TWOH+C15)
IF(A.LT.C02) THEN
IF(V.LE.TEN) THEN
VOIGTK=(H2TAB(IV)*A+H1TAB(IV))*A+H0TAB(IV)
ELSE
VOIGTK=C05642*A/(V*V)
END IF
RETURN
END IF
IF(A.GT.C14) GO TO 10
IF(A+V.GT.C32) GO TO 10
VV=V*V
HH1=H1TAB(IV)+H0TAB(IV)*C11283
HH2=H2TAB(IV)+HH1*C11283-H0TAB(IV)
HH3=(ONE-H2TAB(IV))*C37613-HH1*C23*VV+HH2*C11283
HH4=(THREE*HH3-HH1)*C37613+H0TAB(IV)*C23*VV*VV
VOIGTK=((((HH4*A+HH3)*A+HH2)*A+HH1)*A+H0TAB(IV))*
* (((CV1*A+CV2)*A+CV3)*A+CV4)
RETURN
10 AA=A*A
VV=V*V
U=(AA+VV)*C14142
UU=U*U
VOIGTK=((((AA-TEN*VV)*AA*THREE+FIFTN*VV*VV)/UU+THREE*VV-AA)/UU+
* ONE)*A*C79788/U
RETURN
END