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

52 lines
1.8 KiB
Fortran

SUBROUTINE STARK0(I,J,IZZ,XKIJ,WL0,FIJ)
C =======================================
C
C Auxiliary procedure for evaluating the approximate Stark profile
C of hydrogen lines - sets up necessary frequency independent
C parameters
C
C Input: I - principal quantum number of the lower level
C J - principal quantum number of the upper level
C IZZ - ionic charge (IZZ=1 for hydrogen, etc.)
C Output: XKIJ - coefficients K(i,j) for the Hotzmark profile;
C exact up to j=6, asymptotic for higher j
C WL0 - wavelength of the line i-j
C FIJ - Stark f-value for the line i-j
C
INCLUDE 'IMPLIC.FOR'
PARAMETER (RYD1=911.763811,RYD2=911.495745/4.,CXKIJ=5.5E-5)
PARAMETER (WI1=911.753578, WI2=227.837832)
PARAMETER (UN=1.,TEN=10.,TWEN=20.,HUND=100.)
DIMENSION FSTARK(10,4),XKIJT(5,4)
DATA XKIJT/3.56D-4,5.23D-4,1.09D-3,1.49D-3,2.25D-3,.0125,.0177,
* .028,.0348,.0493,.124,.171,.223,.261,.342,.683,.866,1.02,1.19,
* 1.46/
DATA FSTARK/.1387,.0791,.02126,.01394,.00642,4.814D-3,2.779D-3,
* 2.216D-3,1.443D-3,1.201D-3,.3921,.1193,.03766,.02209,.01139,
* 8.036D-3,5.007D-3,3.85D-3,2.658D-3,2.151D-3,.6103,.1506,.04931,
* .02768,.01485,.01023,6.588D-3,4.996D-3,3.524D-3,2.838D-3,.8163,
* .1788,.05985,.03189,.01762,.01196,7.825D-3,5.882D-3,4.233D-3,
* 3.375D-3/
SAVE XKIJT,FSTARK
C
II=I*I
JJ=J*J
JMIN=J-I
IF(JMIN.LE.5) THEN
XKIJ=XKIJT(JMIN,I)
ELSE
XKIJ=CXKIJ*(II*JJ)*(II*JJ)/(JJ-II)
END IF
IF(JMIN.LE.10) THEN
FIJ=FSTARK(JMIN,I)
ELSE
CFIJ=((TWEN*I+HUND)*J/(I+TEN)/(JJ-II))
FIJ=FSTARK(10,I)*CFIJ*CFIJ*CFIJ
END IF
WL0=WI1
IF(IZZ.EQ.2) WL0=WI2
WL0=WL0/(UN/II-UN/JJ)
RETURN
END