75 lines
2.2 KiB
Fortran
75 lines
2.2 KiB
Fortran
FUNCTION PROFIL(FR,A,DOP,ITR,IP,ID)
|
|
C ===================================
|
|
C
|
|
C Standard absorption profile - normalized to unity
|
|
C
|
|
C Input:
|
|
C FR - frequency
|
|
C A - Voigt damping parameter
|
|
C DOP - Doppler width
|
|
C ITR - transition index
|
|
C ID - depth index
|
|
C
|
|
C Profile is evaluated differently for different IP=IPROF(ITR):
|
|
C IP = 0 - Doppler profile
|
|
C IP = 1 - Voigt profile
|
|
C IP = 2 - approximate Stark (+ Doppler) profile for hydrogen lines;
|
|
C however, the routine is called with IP=2 only from
|
|
C START, i.e. for the initialization
|
|
C IP > 9 - non-standard profile, given by a user-supplied
|
|
C procedure PROFSP
|
|
C IP = 12 - approximate Stark profile for hydrogen lines
|
|
C (Klaus Wener's routines)
|
|
C
|
|
C V - frequency displacement from the line center in units of
|
|
C Doppler width
|
|
C
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'ATOMIC.FOR'
|
|
INCLUDE 'MODELQ.FOR'
|
|
common/quasun/tqmprf,iquasi,nunalp,nunbet,nungam,nunbal
|
|
PARAMETER (PISQ=1.77245385090551D0,PISQ1=UN/PISQ)
|
|
C
|
|
PROFIL=0.
|
|
V=(FR-FR0(ITR))/DOP
|
|
IPA=IABS(IP)
|
|
IF(IPA.EQ.0) THEN
|
|
IF(V.LE.13.) PROFIL=EXP(-V*V)*PISQ1
|
|
ELSE IF(IPA.EQ.1) THEN
|
|
PROFIL=VOIGT(V,A)*PISQ1
|
|
ELSE IF(IPA.EQ.2) THEN
|
|
IF(ID.GT.0) THEN
|
|
ANE=ELEC(ID)
|
|
ELSE
|
|
ANE=1.e9*grav
|
|
END IF
|
|
if(ane.le.0.) ane=1.e14
|
|
F000=EXP(0.666666667*LOG(ANE))
|
|
II=NQUANT(ILOW(ITR))
|
|
JJ=NQUANT(IUP(ITR))
|
|
IZZ=IZ(IEL(ILOW(ITR)))
|
|
FAC=TWO
|
|
if(iquasi.gt.0.and.ii.eq.1) then
|
|
if(jj.eq.2) fac=un
|
|
if(jj.eq.3.and.iquasi.gt.1) fac=un
|
|
end if
|
|
F00=1.25D-9*F000
|
|
IF(IZZ.EQ.2) THEN
|
|
FAC=UN
|
|
F00=3.906D-11*F000
|
|
END IF
|
|
CALL STARK0(II,JJ,IZZ,XKIJ,WL0,FIJ)
|
|
FXK=F00*XKIJ
|
|
DBETA=WL0*WL0/2.997925D18/FXK
|
|
BETAD=DOP*DBETA
|
|
CALL DIVSTR(IZZ)
|
|
BETA=DBETA*ABS(FR-FR0(ITR))
|
|
SG=STARKA(BETA,fac)*BETAD
|
|
PROFIL=SG
|
|
ELSE IF(IPA.GT.10) THEN
|
|
PROFIL=PROFSP(FR,DOP,ITR,ID)
|
|
END IF
|
|
RETURN
|
|
END
|