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

55 lines
1.2 KiB
Fortran

SUBROUTINE PROFIL(IL,IAT,ID,AGAM)
C =================================
C
INCLUDE 'PARAMS.FOR'
INCLUDE 'MODELP.FOR'
INCLUDE 'SYNTHP.FOR'
INCLUDE 'LINDAT.FOR'
COMMON/PRFQUA/DOPA1(MATOM,MDEPTH),VDWC(MDEPTH)
DIMENSION WGR(4)
PARAMETER (PI4=7.95774715E-2)
C
IPRF=IPRF0(IL)
T=TEMP(ID)
ANE=ELEC(ID)
C
C radiative broadening (classical)
C
AGAM=GAMR0(IL)
C
C Stark broadening - standard (given in the line list or classical)
C
IF(IPRF.EQ.0) THEN
AGAM=AGAM+GS0(IL)*ANE
C
C Stark broadening - special expressions for He I
C
ELSE IF(IPRF.GT.0) THEN
ANP=POPUL(NKH,ID)
CALL GAMHE(IPRF,T,ANE,ANP,ID,GAM)
AGAM=AGAM+GAM
C
C Stark broadening - Griem
C
ELSE
DO 10 I=1,4
10 WGR(I)=WGR0(I,IGRIEM(IL))
FR=FREQ0(IL)
ION=MOD(INDAT(IL),100)
CALL GRIEM(ID,T,ANE,ION,FR,WGR,GAM)
AGAM=AGAM+GAM
END IF
C
C Van Der Waals broadening
C
AGAM=AGAM+GW0(IL)*VDWC(ID)
C
C final Voigt parameter a
C
DOP1=DOPA1(IAT,ID)
if(ifwin.gt.0) DOP1=DOP1/FREQ0(IL)
AGAM=AGAM*DOP1*PI4
C
RETURN
END