87 lines
1.9 KiB
Fortran
87 lines
1.9 KiB
Fortran
FUNCTION PROFSP(FR,DOP,ITR,ID)
|
|
C ================================
|
|
C
|
|
C Non-standard absorption profile - normalized to unity;
|
|
C a user supplied procedure
|
|
C
|
|
C Input:
|
|
C FR - frequency
|
|
C A - Voigt damping parameter
|
|
C DOP - Doppler width
|
|
C ITR - transition index
|
|
C ID - depth index
|
|
C
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'ATOMIC.FOR'
|
|
INCLUDE 'MODELQ.FOR'
|
|
C
|
|
PROFSP=0.
|
|
IP=IPROF(ITR)
|
|
C
|
|
C Klaus Werner's Voigt+Stark wing profile (formula A.3.4)
|
|
C
|
|
IF(ABS(IP).NE.12) RETURN
|
|
|
|
C 1- Stark wings
|
|
|
|
II=NQUANT(ILOW(ITR))
|
|
JJ=NQUANT(IUP(ITR))
|
|
SIJ=JJ*(JJ-1)+II*(II-1)
|
|
C
|
|
C Micro-field
|
|
C
|
|
ZMIKRO=0.
|
|
DO IAT=1,NATOM
|
|
N0I=N0A(IAT)
|
|
NKI=NKA(IAT)
|
|
DO I=N0I,NKI-1
|
|
IE=IEL(I)
|
|
CH=IZ(IE)-1
|
|
CH32=CH*SQRT(CH)
|
|
ZMIKRO=ZMIKRO+CH32*POPUL(I,ID)
|
|
END DO
|
|
CH=CH+UN
|
|
CH32=CH*SQRT(CH)
|
|
ZMIKRO=ZMIKRO+CH32*POPUL(NKI,ID)
|
|
END DO
|
|
CALL SABOLF(ID)
|
|
DO ION=1,NION
|
|
CH=IZ(ION)-1
|
|
CH32=CH*SQRT(CH)
|
|
ZMIKRO=ZMIKRO+CH32*USUM(ION)
|
|
END DO
|
|
ZMIKRO=ZMIKRO**0.6666667
|
|
C
|
|
IAT=IATM(ILOW(ITR))
|
|
IE=IEL(ILOW(ITR))
|
|
CH=IZ(IE)
|
|
DBETA=1.385*CH/SIJ/ZMIKRO
|
|
C
|
|
C empirical correction in PRO2
|
|
C
|
|
CORRE=UN
|
|
IF(IE.EQ.IELHE2 .AND.ILOW(ITR).GT.(NFIRST(IE)+1))
|
|
* CORRE=HALF
|
|
IF(IAT.NE.IATH .AND. IAT.NE.IATHE) THEN
|
|
CORRE=UN/(CH-UN)
|
|
END IF
|
|
DBETA=DBETA/CORRE
|
|
C
|
|
BETAD=DOP*DBETA
|
|
BETA=DBETA*ABS(FR-FR0(ITR))
|
|
SIGST=UBETA(BETA)*BETAD
|
|
|
|
C 2- Voigt profile
|
|
|
|
AGAMS=5.E-5*ELEC(ID)/SQRT(TEMP(ID))*JJ*JJ/CH/CH
|
|
AGAM=2.47342D-22*FR*FR+AGAMS
|
|
AA=AGAM/12.56637/DOP
|
|
V=(FR-FR0(ITR))/DOP
|
|
SIGVT=VOIGT(V,AA)/1.77245385090551D0
|
|
SGA=SIGVT
|
|
IF(SIGST.GT.SIGVT) SGA=SIGST
|
|
PROFSP=SGA
|
|
RETURN
|
|
END
|