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

46 lines
1.1 KiB
Fortran

SUBROUTINE LINSPL(ITR,DOP,AGAM)
C ===============================
C
C Set up depth-independent profile for a line
C Analog to LINSET used in sampling mode
C
C Input:
C ITR - index of the transition
C DOP - Doppler width
C AGAM - damping parameter (for lines with Voigt or non-standard
C profile only)
C
C Output (to COMMON/FRQEXP)
C PROF - values of absorption profile
C
INCLUDE 'IMPLIC.FOR'
INCLUDE 'BASICS.FOR'
INCLUDE 'ATOMIC.FOR'
INCLUDE 'MODELQ.FOR'
PARAMETER (OS0=0.02654)
C
IJ0=IFR0(ITR)
IJ1=IFR1(ITR)
N=IJ1-IJ0+1
KJ0=KFR0(ITR)
KJ1=KFR1(ITR)
C
C For all types of integration:
C
S=OSC0(ITR)*OS0
IP0=IPROF(ITR)
IP=IABS(IP0)
DO I=1,N
PROF(KJ0+I-1)=PROFIL(FREQ(IJ0+I-1),AGAM,DOP,ITR,IP,0)*S/DOP
END DO
C
C for IPROF(ITR) ge 0 - endpoint(s) of the line profile are forced to
C have zero cross-section
C
IF(IP0.GE.0) THEN
PROF(KJ0)=0.
PROF(KJ1)=0.
END IF
RETURN
END