250 lines
7.2 KiB
Fortran
250 lines
7.2 KiB
Fortran
SUBROUTINE LEVCD(ION,IOBS)
|
|
C ==========================
|
|
C
|
|
C Mean energy and statistical weights of superlevels.
|
|
C Read atomic data from Kurucz CD-ROM file (gf*.gam)
|
|
C
|
|
C Setup collisional strengths between superlevels, using
|
|
C Eissner-Seaton formula for each possible individual
|
|
C transition. Assumes Gamma(T)=0.05, and T=Teff
|
|
C Contributions from allowed transitions will be superseded
|
|
C in routine INKUL.
|
|
C
|
|
INCLUDE 'IMPLIC.FOR'
|
|
INCLUDE 'BASICS.FOR'
|
|
INCLUDE 'ATOMIC.FOR'
|
|
INCLUDE 'MODELQ.FOR'
|
|
INCLUDE 'ODFPAR.FOR'
|
|
C
|
|
PARAMETER (BOLCM=1.D8/HK/CAS,CCOR=0.09,SIXTH=UN/6.,GES=0.05)
|
|
DIMENSION GWE(MDEPTH,MLEVEL,2),GWB(MDEPTH,MLEVEL,2),AA(MDEPTH)
|
|
DIMENSION E0FE(10),E0NI(10),E0CR(10)
|
|
COMMON/COLKUR/OMES(100,100),EKU(15000),GKU(15000),GST,
|
|
& KKU(15000)
|
|
|
|
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
|
|
C Initialization
|
|
C
|
|
IF(IOBS.NE.1 .AND. IOBS.NE.2) IOBS=0
|
|
DO I=1,NEVKU(ION)
|
|
YMKU(I,1)=0.
|
|
EMKU(I,1)=0.
|
|
DO ID=1,ND
|
|
GWE(ID,I,1)=0.
|
|
GWB(ID,I,1)=0.
|
|
END DO
|
|
END DO
|
|
DO I=1,NODKU(ION)
|
|
YMKU(I,2)=0.
|
|
EMKU(I,2)=0.
|
|
DO ID=1,ND
|
|
GWE(ID,I,2)=0.
|
|
GWB(ID,I,2)=0.
|
|
END DO
|
|
END DO
|
|
NEVOD=NEVKU(ION)+NODKU(ION)
|
|
IF(NEVOD.GT.100)
|
|
& CALL QUIT(' Too many superlevels in a single Fe ion',
|
|
& NEVKU(ION),NODKU(ION))
|
|
DO I=1,NEVOD
|
|
DO J=1,NEVOD
|
|
OMES(I,J)=0.
|
|
END DO
|
|
END DO
|
|
IWSUP=IFWOP(NFIRST(ION))
|
|
IF(IWSUP.GE.2) THEN
|
|
DO ID=1,ND
|
|
TEMP1(ID)=UN/TEMP(ID)
|
|
AA(ID)=CCOR*EXP(SIXTH*LOG(ELEC(ID)))/SQRT(TEMP(ID))
|
|
END DO
|
|
ZZ=IZ(ION)
|
|
IF(IZ(ION).GT.10)
|
|
* CALL QUIT(' Too high Fe, Ni or Cr ion: ion,iz',ion,iz(ion))
|
|
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))
|
|
END IF
|
|
C
|
|
C CD-ROM format: Read energy levels
|
|
C
|
|
IUN1=31
|
|
OPEN(IUN1,FILE=FIODF1(ION),STATUS='OLD')
|
|
READ(IUN1,170) NLINKU,KEVE,KODD
|
|
IF(KEVE+KODD.GT.15000)
|
|
& CALL QUIT(' Too many levels in Kurucz file',keve,kodd)
|
|
C
|
|
C Even parity
|
|
C
|
|
DO K=1,KEVE
|
|
KSL=0
|
|
READ(IUN1,171) YJ,E,AR,SR,WR
|
|
GEV=(TWO*YJ+UN)
|
|
IF(E.LT.0.) THEN
|
|
E=-E
|
|
IF(IOBS.EQ.0) GO TO 10
|
|
END IF
|
|
IF(E.LE.XEV(1,ION)) KSL=1
|
|
DO I=2,NEVKU(ION)
|
|
IF(E.LE.XEV(I,ION) .AND. E.GT.XEV(I-1,ION)) KSL=I
|
|
END DO
|
|
IF(KSL.EQ.0) WRITE(10,*) ' Error with even levels',E,YJ
|
|
KKU(K)=KSL
|
|
GKU(K)=GEV
|
|
EKU(K)=E
|
|
YMKU(KSL,1)=YMKU(KSL,1)+GEV
|
|
EMKU(KSL,1)=EMKU(KSL,1)+GEV*E
|
|
IF(IWSUP.EQ.2) THEN
|
|
EBCM=E/BOLCM
|
|
DO ID=1,ND
|
|
GWX=GEV*EXP(-EBCM*TEMP1(ID))
|
|
GWB(ID,KSL,1)=GWB(ID,KSL,1)+GWX
|
|
GWE(ID,KSL,1)=GWE(ID,KSL,1)+GWX*E
|
|
END DO
|
|
ELSE IF(IWSUP.EQ.3) THEN
|
|
EBCM=E/BOLCM
|
|
IF(E.LT.E0) THEN
|
|
XN=SQRT(E0/(E0-E))
|
|
DO ID=1,ND
|
|
WID=WN(XN,AA(ID),ELEC(ID),ZZ)
|
|
GWX=GEV*WID*EXP(-EBCM*TEMP1(ID))
|
|
GWB(ID,KSL,1)=GWB(ID,KSL,1)+GWX
|
|
GWE(ID,KSL,1)=GWE(ID,KSL,1)+GWX*E
|
|
END DO
|
|
ELSE
|
|
DO ID=1,ND
|
|
WID=UN
|
|
GWX=GEV*WID*EXP(-EBCM*TEMP1(ID))
|
|
GWB(ID,KSL,1)=GWB(ID,KSL,1)+GWX
|
|
GWE(ID,KSL,1)=GWE(ID,KSL,1)+GWX*E
|
|
END DO
|
|
END IF
|
|
END IF
|
|
10 EEV(K)=E
|
|
AEV(K)=AR
|
|
SEV(K)=SR
|
|
WEV(K)=WR
|
|
KSEV(K)=KSL
|
|
END DO
|
|
DO I=1,NEVKU(ION)
|
|
IF(YMKU(I,1).EQ.0.)
|
|
* call quit(' No levels in even superlevel',i,i)
|
|
EMKU(I,1)=EMKU(I,1)/YMKU(I,1)
|
|
END DO
|
|
C
|
|
C Odd parity
|
|
C
|
|
DO K=1,KODD
|
|
KSL=0
|
|
READ(IUN1,171) YJ,E,AR,SR,WR
|
|
GOD=(TWO*YJ+UN)
|
|
IF(E.LT.0.) THEN
|
|
E=-E
|
|
IF(IOBS.EQ.0) GO TO 20
|
|
END IF
|
|
IF(E.LE.XOD(1,ION)) KSL=1
|
|
DO I=2,NODKU(ION)
|
|
IF(E.LE.XOD(I,ION) .AND. E.GT.XOD(I-1,ION)) KSL=I
|
|
END DO
|
|
IF(KSL.EQ.0) WRITE(10,*) ' Error with odd levels',E,YJ
|
|
KKU(K+KEVE)=KSL+NEVKU(ION)
|
|
GKU(K+KEVE)=GOD
|
|
EKU(K+KEVE)=E
|
|
YMKU(KSL,2)=YMKU(KSL,2)+GOD
|
|
EMKU(KSL,2)=EMKU(KSL,2)+GOD*E
|
|
IF(IWSUP.EQ.2) THEN
|
|
EBCM=E/BOLCM
|
|
DO ID=1,ND
|
|
GWX=GOD*EXP(-EBCM*TEMP1(ID))
|
|
GWB(ID,KSL,2)=GWB(ID,KSL,2)+GWX
|
|
GWE(ID,KSL,2)=GWE(ID,KSL,2)+GWX*E
|
|
END DO
|
|
ELSE IF(IWSUP.EQ.3) THEN
|
|
EBCM=E/BOLCM
|
|
IF(E.LT.E0) THEN
|
|
XN=SQRT(E0/(E0-E))
|
|
DO ID=1,ND
|
|
WID=WN(XN,AA(ID),ELEC(ID),ZZ)
|
|
GWX=GOD*WID*EXP(-EBCM*TEMP1(ID))
|
|
GWB(ID,KSL,2)=GWB(ID,KSL,2)+GWX
|
|
GWE(ID,KSL,2)=GWE(ID,KSL,2)+GWX*E
|
|
END DO
|
|
ELSE
|
|
DO ID=1,ND
|
|
WID=UN
|
|
GWX=GOD*WID*EXP(-EBCM*TEMP1(ID))
|
|
GWB(ID,KSL,2)=GWB(ID,KSL,2)+GWX
|
|
GWE(ID,KSL,2)=GWE(ID,KSL,2)+GWX*E
|
|
END DO
|
|
END IF
|
|
END IF
|
|
20 EOD(K)=E
|
|
AOD(K)=AR
|
|
SOD(K)=SR
|
|
WOD(K)=WR
|
|
KSOD(K)=KSL
|
|
END DO
|
|
DO I=1,NODKU(ION)
|
|
IF(YMKU(I,2).EQ.0.)
|
|
* call quit(' No levels in odd superlevel',I,I)
|
|
EMKU(I,2)=EMKU(I,2)/YMKU(I,2)
|
|
END DO
|
|
CLOSE(IUN1)
|
|
C
|
|
C Collisional strengths of transitions between super-levels
|
|
C Eissner-Seaton formula (Gamma=0.05)
|
|
C
|
|
GST=8.63E-6*GES/SQRT(TEFF)
|
|
TK0=UN/BOLCM/TEFF
|
|
DO I=1,KEVE+KODD-1
|
|
KI=KKU(I)
|
|
DO J=I+1,KEVE+KODD
|
|
KJ=KKU(J)
|
|
U0=ABS(EKU(I)-EKU(J))*TK0
|
|
OMES(KI,KJ)=OMES(KI,KJ)+GST*EXP(-U0)
|
|
OMES(KJ,KI)=OMES(KI,KJ)
|
|
END DO
|
|
END DO
|
|
C
|
|
C Sort superlevel energies
|
|
C
|
|
NLEVKU=NEVKU(ION)+NODKU(ION)
|
|
DO I=1,NEVKU(ION)
|
|
EU(I)=EMKU(I,1)
|
|
END DO
|
|
DO I=1,NODKU(ION)
|
|
EU(I+NEVKU(ION))=EMKU(I,2)
|
|
END DO
|
|
CALL INDEXX(NLEVKU,EU,JEN)
|
|
C
|
|
C Superlevel generalized occupation probabilities
|
|
C
|
|
IF(IWSUP.GE.2) THEN
|
|
DO I=1,NLEVKU
|
|
II=NFIRST(ION)+I-1
|
|
JJ=JEN(I)
|
|
JK=1
|
|
IF(JJ.GT.NEVKU(ION)) THEN
|
|
JJ=JEN(I)-NEVKU(ION)
|
|
JK=2
|
|
END IF
|
|
DO ID=1,ND
|
|
ESUP=GWE(ID,JJ,JK)/GWB(ID,JJ,JK)
|
|
WSUP=EXP(ESUP/BOLCM*TEMP1(ID))/YMKU(JJ,JK)
|
|
WOP(II,ID)=WSUP*GWB(ID,JJ,JK)
|
|
END DO
|
|
END DO
|
|
END IF
|
|
C
|
|
170 FORMAT(I7,13X,I6,12X,I6)
|
|
171 FORMAT(8X,F4.1,4X,F13.3,18X,3E9.2)
|
|
C
|
|
RETURN
|
|
END
|