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