169 lines
5.3 KiB
Fortran
169 lines
5.3 KiB
Fortran
SUBROUTINE INKUL(ION,IOBS)
|
|
C ==========================
|
|
C
|
|
C Read line list from Kurucz CD-ROM files (gf*.lin)
|
|
C
|
|
C INPUT: Unit 18
|
|
C WMIN : Min. wavelength (lines at smaller wave are NOT selected)
|
|
C WMAX : Max. wavelength (lines at larger wave are NOT selected)
|
|
C IOBS : Type of selected lines
|
|
C
|
|
C OUTPUT: fill up common/lined/
|
|
C *******
|
|
C - WAVE : wavelength in ANGSTROMS
|
|
C - SIG0 : 0.02654/sqrt(pi)*gf/VDOP (divided by g(super) later)
|
|
C - VDOP : Doppler width
|
|
C - AGAM : Damping parameter
|
|
C
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'ATOMIC.FOR'
|
|
INCLUDE 'MODELQ.FOR'
|
|
INCLUDE 'ODFPAR.FOR'
|
|
REAL*4 VDOP,AGAM,SIG0
|
|
C
|
|
PARAMETER (TEN=10.,TENLG=2.302585093,GES=0.05)
|
|
PARAMETER (BOL2=2.76108D-16,BOLCM=1.D8/HK/CAS)
|
|
PARAMETER (CSTK=3.54,PSTK=2./3.,TSTK=UN/6.)
|
|
PARAMETER (CVDW=3.74,PVDW=0.4,TVDW=0.3)
|
|
PARAMETER (PI4V=0.25/3.141592654,CSIG=0.0149736)
|
|
PARAMETER (EXPIA1=-0.57721566,EXPIA2=0.99999193,
|
|
* EXPIA3=-0.24991055,EXPIA4=0.05519968,
|
|
* EXPIA5=-0.00976004,EXPIA6=0.00107857,
|
|
* EXPIB1=0.2677734343,EXPIB2=8.6347608925,
|
|
* EXPIB3=18.059016973,EXPIB4=8.5733287401,
|
|
* EXPIC1=3.9584969228,EXPIC2=21.0996530827,
|
|
* EXPIC3=25.6329561486,EXPIC4=9.5733223454)
|
|
DIMENSION E0FE(10),E0NI(10),E0CR(10)
|
|
DIMENSION VT0(MDEPTH),GT0(MDEPTH)
|
|
COMMON/COLKUR/OMES(100,100),EKU(15000),GKU(15000),GST,
|
|
& KKU(15000)
|
|
COMMON/LINED/WAVE(MLINE),VDOP(MLINE,MDODF),
|
|
& AGAM(MLINE,MDODF),SIG0(MLINE,MDODF),
|
|
& JTR(MLINE,2)
|
|
|
|
DATA E0FE/63480.,130563.,247220.,442000.,605000.,799000.,
|
|
& 1008000.,1218380.,1884000.,2114000./
|
|
DATA E0NI/61590.,146560.,283700.,443000.,613500.,871000.,
|
|
& 1070000.,1310000.,1560000.,1812000./
|
|
DATA E0CR/54576.,132966.,249700.,396500.,560200.,731020.,
|
|
& 1291900.,1490000.,1688000.,1971000./
|
|
C
|
|
IAT=IATM(NFIRST(ION))
|
|
E0=E0FE(IZ(ION))
|
|
IF(NUMAT(IAT).EQ.28) E0=E0NI(IZ(ION))
|
|
IF(NUMAT(IAT).EQ.24) E0=E0CR(IZ(ION))
|
|
CDOP=BOL2/AMASS(IAT)
|
|
TK35=UN/BOLCM/TEMP(JIDR(2))
|
|
CVR=19.7363/TEMP(JIDR(2))/SQRT(TEMP(JIDR(2)))
|
|
if(jidn.gt.3) then
|
|
TK35=UN/BOLCM/TEFF
|
|
CVR=19.7363/TEFF/SQRT(TEFF)
|
|
end if
|
|
TK357=TK35*1.E7
|
|
|
|
XION=0.
|
|
DO K=1,JIDN
|
|
XIONI=0.
|
|
XIATI=0.
|
|
ID=JIDR(K)
|
|
DO I=NFIRST(ION),NLAST(ION)
|
|
XIONI=XIONI+POPUL(I,ID)
|
|
END DO
|
|
DO I=N0A(IAT),NKA(IAT)
|
|
XIATI=XIATI+POPUL(I,ID)
|
|
END DO
|
|
XIONK=XIONI/XIATI
|
|
IF(XIONK.GT.XION) XION=XIONK
|
|
VT0(ID)=1.E-8/SQRT(CDOP*TEMP(ID)+VTURBS(ID)*VTURBS(ID))
|
|
GT0(ID)=TSTK*DLOG10(TEMP(ID))
|
|
END DO
|
|
|
|
NLINKU=0
|
|
WMIN=CAS/FRS1/TEN
|
|
WMAX=CAS/FRS2/TEN
|
|
IUN2=32
|
|
OPEN(IUN2,FILE=FIODF2(ION),STATUS='OLD')
|
|
10 READ(IUN2,180,ERR=20,END=20) WA,GFR,JEVR,JODR,IFPLI
|
|
GF=EXP(TENLG*GFR)
|
|
IF(WA.GT.WMAX) GO TO 11
|
|
IF(WA.LT.WMIN) GO TO 11
|
|
IF(IOBS.EQ.0 .AND. IFPLI.EQ.1) GO TO 10
|
|
IF(IOBS.EQ.2 .AND. EOD(JODR).GT.E0) GO TO 10
|
|
IF(IOBS.EQ.2 .AND. EEV(JEVR).GT.E0) GO TO 10
|
|
E00=EEV(JEVR)
|
|
IF(EOD(JODR).LT.EEV(JEVR)) E00=EOD(JODR)
|
|
XLSTR=XION*GF*EXP(-E00*TK35)
|
|
if(jidn.gt.3) XLSTR=XION*GF*EXP(-E00*8./E0)
|
|
IF(XLSTR.LT.STRLX) GO TO 10
|
|
NLINKU=NLINKU+1
|
|
WAVE(NLINKU)=WA*TEN
|
|
JTR(NLINKU,1)=JEVR
|
|
JTR(NLINKU,2)=JODR
|
|
GR=AEV(JEVR)+AOD(JODR)
|
|
C4=SEV(JEVR)
|
|
C4P=SOD(JODR)
|
|
SMX=DMAX1(ABS(C4P-C4),DMIN1(ABS(C4),ABS(C4P)))
|
|
GSLOG0=CSTK+PSTK*DLOG10(SMX)
|
|
DO I=1,JIDN
|
|
ID=JIDR(I)
|
|
VDOP(NLINKU,I)=real(WAVE(NLINKU)*VT0(ID))
|
|
GS=EXP(TENLG*(GSLOG0+GT0(ID)))
|
|
AGAM(NLINKU,I)=real((GR+GS*ELEC(ID))*PI4V*VDOP(NLINKU,I))
|
|
SIG0(NLINKU,I)=real(CSIG*GF*VDOP(NLINKU,I))
|
|
END DO
|
|
|
|
11 KA=KKU(JEVR)
|
|
KB=KKU(JODR+KEVE)
|
|
IF(KA.LE.KB) THEN
|
|
K1=KA
|
|
K2=KB
|
|
ELSE
|
|
K1=KB
|
|
K2=KA
|
|
END IF
|
|
IF(K1.EQ.K2) GO TO 10
|
|
U0=TK357/WA
|
|
IF(U0.LE.UN) THEN
|
|
EXPIU0=-LOG(U0)+EXPIA1+U0*(EXPIA2+U0*(EXPIA3+U0*(EXPIA4+
|
|
* U0*(EXPIA5+U0*EXPIA6))))
|
|
ELSE
|
|
EXPIU0=EXP(-U0)*((EXPIB1+U0*(EXPIB2+U0*(EXPIB3+
|
|
* U0*(EXPIB4+U0))))/(EXPIC1+U0*(EXPIC2+
|
|
* U0*(EXPIC3+U0*(EXPIC4+U0)))))/U0
|
|
END IF
|
|
GB=0.276*EXP(U0)*EXPIU0
|
|
IF(GB.LT.0.25) GB=0.25
|
|
OMES(K1,K2)=OMES(K1,K2)+(CVR/U0*GF*GB-GST)*EXP(-U0)
|
|
|
|
GO TO 10
|
|
20 CLOSE(IUN2)
|
|
WRITE(10,600) NUMAT(IAT),IZ(ION),NLINKU
|
|
C
|
|
C Store collisional excitation strengths
|
|
C
|
|
NLEVKU=NEVKU(ION)+NODKU(ION)
|
|
DO I=1,NLEVKU-1
|
|
II=NFIRST(ION)+I-1
|
|
I1=JEN(I)
|
|
IF(I1.LE.NEVKU(ION)) THEN
|
|
GSUP=YMKU(I1,1)
|
|
ELSE
|
|
GSUP=YMKU(I1-NEVKU(ION),2)
|
|
END IF
|
|
DO J=I+1,NLEVKU
|
|
JJ=NFIRST(ION)+J-1
|
|
J1=JEN(J)
|
|
IT=ITRA(II,JJ)
|
|
C2=CPAR(IT)
|
|
OMECOL(II,JJ)=OMES(I1,J1)/GSUP*C2/GES
|
|
OMECOL(JJ,II)=OMECOL(II,JJ)
|
|
END DO
|
|
END DO
|
|
c
|
|
RETURN
|
|
C
|
|
180 FORMAT(F11.4,F7.3,2I4,I1)
|
|
600 FORMAT(' Ion',2I3,' : ',I9,' Lines included')
|
|
END
|