SUBROUTINE PZERT
C     ================
C
C     driving routine for super-zeroing, i.e. detecting that
C     a given population is small throughout the whole
C     atmosphere, so it is removed completely from linearization
C
      INCLUDE 'IMPLIC.FOR'
      INCLUDE 'BASICS.FOR'
      INCLUDE 'ATOMIC.FOR'
      INCLUDE 'MODELQ.FOR'
      DIMENSION POPMA(MLEVEL),INDLEZ(MLEVEL),GZR(MLEVEL)
c
      if(ioptab.lt.0) return
C
C     super-zeroing of the individual levels
C
      POPZRL=1.E5*POPZER
      NLNZX=0
      DO IAT=1,NATOM
         N1=N0A(IAT)
         NK=NKA(IAT)
         DO II=N1,NK
            POPMA(II)=0.
         END DO
c
c        set-up quantity POPMA(II), which is the maximum
C        (over depths) of the relative population of given
C        level II to the total population of the atom.
C
         DO ID=1,ND
            POPM=0.
            DO II=N1,NK
               IF(POPUL(II,ID).GT.POPM) POPM=POPUL(II,ID)
            END DO
            DO II=N1,NK
               POPREL=POPUL(II,ID)/POPM
               IF(POPREL.GT.POPMA(II)) POPMA(II)=POPREL
            END DO
         END DO
C
C        if POPMA(II) is small, level II is super-zeroed
C
         DO II=N1,NK
            IPZERT(II)=0 
            IF(POPMA(II).LT.POPZRL) THEN
               IPZERT(II)=1
               DO ID=1,ND
                  IPZERO(II,ID)=1
                  POPUL(II,ID)=0.
               END DO
             ELSE
               IF(IIEXP(II).GT.0) THEN
                  NLNZX=NLNZX+1
                  INDLEZ(NLNZX)=II
               END IF
            END IF
         END DO
      END DO
c
c     now, check whether all populations within a group were
C     super-zeroed. If so, super-zero the whole group
C
      DO II=1,NLVEXP
         GZR(II)=1.
      END DO
      DO I=1,NLEVEL
         II=IABS(IIEXP(I))
         IF(II.NE.0) GZR(II)=GZR(II)*IPZERT(I)
      END DO
      NLVEXZ=0
      DO II=1,NLVEXP
         IF(GZR(II).EQ.0) THEN
            IGZERT(II)=0
            NLVEXZ=NLVEXZ+1 
            INDLGZ(NLVEXZ)=II
            IINONZ(II)=NLVEXZ
          ELSE
            IGZERT(II)=1
            IINONZ(II)=0
         END IF
      END DO
      NN=NN0-NLVEXP+NLVEXZ
c     
      RETURN
      END