SUBROUTINE LEVSET
C     =================
C
C     sets up level parameters IIEXP and IIFOR which control the
C     treatment of levels
C
      INCLUDE 'IMPLIC.FOR'
      INCLUDE 'BASICS.FOR'
      INCLUDE 'ATOMIC.FOR'
      INCLUDE 'MODELQ.FOR'
      if(ioptab.lt.0) return
C
C     1. case - treatment of levels determined by IMODL
C
      IF(IFLEV.EQ.0) THEN
         DO I=1,NLEVEL
            IIEXP(I)=0
            IIFOR(I)=0
         END DO
         IIE=0
         IIF=0
         DO 20 IAT=1,NATOM
            IGRP=0
            IF(IIFIX(IAT).EQ.1) GO TO 20
            DO I=N0A(IAT),NKA(IAT)
               INEW=1
               IF(IMODL(I).EQ.0) THEN
                  IIE=IIE+1
                  IIF=IIF+1
                  IIEXP(I)=IIE
                  IIFOR(I)=IIF
                  INDLEV(IIEXP(I))=I
                ELSE IF(IMODL(I).GT.0) THEN
                  IIF=IIF+1
                  IIFOR(I)=IIF
                  IF(ILTLEV(I).GE.1) THEN
                     IIE=IIE+1
                     IIEXP(I)=IIE
                  END IF
                  IF(I.EQ.NFIRST(IEL(I)).OR.I.EQ.NNEXT(IEL(I))) THEN
                     IIE=IIE+1
                     IIEXP(I)=IIE
                  END IF
                ELSE IF(IMODL(I).LT.-100) THEN
                  IF(I.GT.1) THEN
                     IF(IMODL(I).EQ.IMODL(I-1)) INEW=0
                  END IF
                  IIEXP(I)=-IIE
                  IF(INEW.EQ.1) THEN
                     IIE=IIE+1
                     IIEXP(I)=-IIE
                     IM=NFIRST(IEL(I))
                     LML=.TRUE.
                     DO WHILE (IM.LT.I-1 .AND. LML)
                        IF(IMODL(I).EQ.IMODL(IM)) THEN
                           IIEXP(I)=IIEXP(IM)
                           IIE=IIE-1
                           LML=.FALSE.
                        END IF
                        IM=IM+1
                     END DO
                  END IF
                  IGRP=1
                  IIF=IIF+1
                  IIFOR(I)=IIF
                ELSE IF(IMODL(I).LT.-200) THEN
                  IF(I.GT.1) THEN
                     IF(IMODL(I).EQ.IMODL(I-1)) INEW=0
                  END IF
                  IF(INEW.EQ.1) IIE=IIE+1
                  IF(INEW.EQ.1) IIF=IIF+1
                  IIEXP(I)=-IIE
                  IIFOR(I)=-IIF
                  IGRP=1
               END IF
            END DO
            IF(IGRP.EQ.1) THEN
               DO I=N0A(IAT),NKA(IAT)
                  IF(IIEXP(I).GT.0) IIEXP(I)=-IIEXP(I)
                  IF(IMODL(I).EQ.0) IMODL(I)=7
               END DO
            END IF
   20    CONTINUE
         NLVEXP=IABS(IIE)
         if(nlvexp.gt.mlvexp) 
     *   CALL QUIT('nlvexp.gt.mlvexp',nlvexp,mlvexp)
         NLVFOR=IABS(IIF)
         DO 30 I=1,NLEVEL
            IF(IMODL(I).EQ.1.OR.IMODL(I).EQ.3) THEN
               IIEXP(I)=0
             ELSE IF(IMODL(I).EQ.4.OR.IMODL(I).EQ.5) THEN
               IIEXP(I)=0
             ELSE IF(IMODL(I).EQ.-1.OR.IMODL(I).EQ.-3) THEN
               IIEXP(I)=0
               IIFOR(I)=0
             ELSE IF(IMODL(I).EQ.6) THEN
               IIEXP(I)=0
             ELSE IF(IMODL(I).EQ.-5.OR.IMODL(I).EQ.-6) THEN
               IIEXP(I)=0
               IIFOR(I)=0
             ELSE IF(IMODL(I).LT.-100) THEN
               IMODL(I)=7
             ELSE IF(IMODL(I).LT.-200) THEN
                IMODL(I)=-7
            END IF
            DO ID=1,ND
               ILTREF(I,ID)=NNEXT(IEL(I))
            END DO      
   30    CONTINUE
         IF(IGRP.EQ.1) THEN
            DO I=N0A(IAT),NKA(IAT)
               IMODL(I)=7
            END DO
         END IF
C
C     2. case - treatment of levels automatic - all levels with ILK=0
C               in updated LTE mode
C
       ELSE
         IIF=0
         DO 110 I=1,NLEVEL
            IF(IIFIX(IATM(I)).EQ.1) GO TO 110
            IMODL(I)=5
            IF(I.EQ.NFIRST(IEL(I)).OR.I.EQ.NNEXT(IEL(I))) THEN
               IIF=IIF+1
               IIFOR(I)=IIF
            END IF
  110    CONTINUE
         NLVEXP=IIF
         if(nlvexp.gt.mlvexp) 
     *   CALL QUIT('nlvexp.gt.mlvexp',nlvexp,mlvexp)
         NLVFOR=IIF
         DO I=1,NLEVEL
            IF(I.NE.NFIRST(IEL(I)).AND.I.NE.NNEXT(IEL(I)))
     *      IIFOR(I)=0
         END DO
         DO I=1,NLEVEL
            IIEXP(I)=IIFOR(I)
            IF(IIEXP(I).GT.0) INDLEV(IIEXP(I))=I
            DO ID=1,ND
               ILTREF(I,ID)=NNEXT(IEL(I))
            END DO
         END DO
         if(.not.lte) then
            do i=1,nlevel
               iifor(i)=i
            end do
           nlvfor=nlevel
         end if
c      
      END IF
C     
C     initialize b-factors
C
      DO I=1,NLEVEL
         DO ID=1,ND
            BFAC(I,ID)=UN
         END DO
      END DO
C     
      do ii=1,nlvexp
         indlev(ii)=0
         do id=1,nd
            igzero(ii,id)=0
         end do
      end do
      do i=1,nlevel
         do id=1,nd
            ipzero(i,id)=0
         end do
         if(iabs(imodl(i)).le.6) then
            IF(IIEXP(I).GT.0) INDLEV(IIEXP(I))=I
         end if
      end do
C 
      RETURN
      END