SUBROUTINE NEWPOP(ID,POP1)
C     ==========================
C
      INCLUDE 'IMPLIC.FOR'
      INCLUDE 'BASICS.FOR'
      INCLUDE 'ATOMIC.FOR'
      INCLUDE 'MODELQ.FOR'
      INCLUDE 'ITERAT.FOR'
      DIMENSION POP1(MLEVEL),DPOP(MLEVEL),DPMAX(MDEPTH),
     *          SBW(MLEVEL)
c
      if(ioptab.lt.0) return
C
      DPMAX(ID)=0.
      DO I=1,NLEVEL
         IF(POPUL(I,ID).GT.0.) 
     *      DPOP(I)=(POP1(I)-POPUL(I,ID))/POPUL(I,ID)
         IF(ABS(DPOP(I)).GT.DPMAX(ID)) THEN
            DPMAX(ID)=ABS(DPOP(I))
            IMAX=I
         END IF
         POPUL(I,ID)=POP1(I) 
      END DO   
c     WRITE(18,601) ITER,ILAM,ID,DPMAX(ID),IMAX
c 601 FORMAT(3I5,1PE10.2,I6)
C
C     array of b-factors
C
      DO I=1,NLEVEL
         BFAC(I,ID)=UN      
         SBW(I)=ELEC(ID)*SBF(I)*WOP(I,ID)
      END DO     
      IF(.NOT.LTE.AND.IPSLTE.EQ.0) THEN        
      DO ION=1,NION
         DO I=NFIRST(ION),NLAST(ION)
             IF(POPUL(NNEXT(ION),ID).GT.0.)
     *       BFAC(I,ID)=POPUL(I,ID)/(POPUL(NNEXT(ION),ID)*SBW(I))
         END DO
      END DO 
      END IF     
      RETURN
      END