SUBROUTINE BPOPF(ID)
C     =====================
C
C     the part of B-matrix corresponding to the population rows and
C     populations - i.e. derivatives of the ALI points intensities
C                   wrt. populations
C
      INCLUDE 'IMPLIC.FOR'
      INCLUDE 'BASICS.FOR'
      INCLUDE 'ATOMIC.FOR'
      INCLUDE 'MODELQ.FOR'
      INCLUDE 'ARRAY1.FOR'
      INCLUDE 'ALIPAR.FOR'
      INCLUDE 'ODFPAR.FOR'
C
      NSE=NFREQE+INSE-1
      NRE=NFREQE+INRE
      NPC=NFREQE+INPC
C
C     matrix B of complete linearization
C
      DO I=1,NLVEXP
         SUMT=0.
         SUMN=0.
         DO II=1,NLVEXP
            IF(IFPOPR.LE.3) THEN
            SUMT=SUMT-ESEMAT(I,II)*APT(II,ID)
            SUMN=SUMN-ESEMAT(I,II)*APN(II,ID)
            SUM=0.
            DO J=1,NLVEXP
               SUM=SUM-ESEMAT(I,J)*APP(II,J,ID)
            END DO
            ELSE
                SUM=APP(II,I,ID)
            END IF
            B(NSE+I,NSE+II)=B(NSE+I,NSE+II)+SUM
         END DO
         IF(IFPOPR.GT.3) THEN
            SUMT=APT(I,ID)
            SUMN=APN(I,ID)
         END IF
         IF(INRE.NE.0) B(NSE+I,NRE)=B(NSE+I,NRE)+SUMT
         IF(INPC.NE.0) B(NSE+I,NPC)=B(NSE+I,NPC)+SUMN
      END DO
      IF(CRSW(ID).NE.UN) THEN
         DO I=1,NLVEXP
            DO II=1,NLVEXP
               B(NSE+I,NSE+II)=B(NSE+I,NSE+II)*CRSW(ID)
            END DO
         END DO
      END IF
C
C     matrix A and C of complete linearization
C
      IF(IFALI.GE.6) THEN
      DO I=1,NLVEXP
         ASUMT=0.
         ASUMN=0.
         CSUMT=0.
         CSUMN=0.
         DO II=1,NLVEXP
            IF(IFPOPR.LE.3) THEN
            ASUMT=ASUMT-ESEMAT(I,II)*AAPT(II,ID)
            ASUMN=ASUMN-ESEMAT(I,II)*AAPN(II,ID)
            CSUMT=CSUMT-ESEMAT(I,II)*CAPT(II,ID)
            CSUMN=CSUMN-ESEMAT(I,II)*CAPN(II,ID)
            ASUM=0.
            CSUM=0.
            DO J=1,NLVEXP
               ASUM=ASUM-ESEMAT(I,J)*AAPP(II,J,ID)
               CSUM=CSUM-ESEMAT(I,J)*CAPP(II,J,ID)
            END DO
            ELSE
                ASUM=AAPP(II,I,ID)
                CSUM=CAPP(II,I,ID)
            END IF
            A(NSE+I,NSE+II)=ASUM
            C(NSE+I,NSE+II)=CSUM
         END DO
         IF(IFPOPR.GT.3) THEN
            ASUMT=AAPT(I,ID)
            ASUMN=AAPN(I,ID)
            CSUMT=CAPT(I,ID)
            CSUMN=CAPN(I,ID)
         END IF
         IF(INRE.NE.0) THEN
            A(NSE+I,NRE)=A(NSE+I,NRE)+ASUMT
            C(NSE+I,NRE)=C(NSE+I,NRE)+CSUMT
         END IF
         IF(INPC.NE.0) THEN
            A(NSE+I,NPC)=A(NSE+I,NPC)+ASUMN
            C(NSE+I,NPC)=C(NSE+I,NPC)+CSUMN
         END IF
      END DO
C
      IF(CRSW(ID).NE.UN) THEN
         DO I=1,NLVEXP
            DO II=1,NLVEXP
               A(NSE+I,NSE+II)=A(NSE+I,NSE+II)*CRSW(ID)
               C(NSE+I,NSE+II)=C(NSE+I,NSE+II)*CRSW(ID)
            END DO
         END DO
      END IF
      END IF
      RETURN
      END