SUBROUTINE BPOPC(ID)
C     ====================
C
      INCLUDE 'IMPLIC.FOR'
      INCLUDE 'BASICS.FOR'
      INCLUDE 'ATOMIC.FOR'
      INCLUDE 'MODELQ.FOR'
      INCLUDE 'ARRAY1.FOR'
      INCLUDE 'ALIPAR.FOR'
      INCLUDE 'ODFPAR.FOR'
      COMMON/ADCHAR/QADD(MDEPTH)
      DIMENSION AJ(MLEVEL)
C
      NSE=NFREQE+INSE-1
      NPC=NFREQE+INPC
      IF(IELH.GT.0) N0HN=NFIRST(IELH)
      NKH=NREFS(IATREF,ID)
      NKH=IABS(IIEXP(NKH))
      T=TEMP(ID)
      ANE=ELEC(ID)
      HKT=HK/T
      TK=HKT/H
      ANMNE1=WMM(ID)*DENS1(ID)
      DO I=1,NLEVEL
         AJ(I)=0.
      END DO
C
C *************************
C     remaining equation - (NFREQE+INPC)-th row
C     linearized charge conservation equation 
C *************************
C
C     This part is very similar to procedure ELCOR (obviously);
C     array AJ has the meaning of coefficients of the charge conserv.
C     ie. charge conservation is written
C           AJ   * (vector of populations) = electron density
C     then
C           APTT = (vector of populations) * (derivative AJ wrt temp)
C           APNN = (vector of populations) * (derivative AJ wrt n(el))
C           APM  = (vector of populations) * (derivative AJ wrt N)
C
      IF(INPC.EQ.0) RETURN
      QQ=0.
      if(ifmol.eq.0.or.t.gt.tmolim) then
         CALL STATE(3,ID,T,ANE)
         QQ=Q*ABUND(IATREF,ID)/YTOT(ID)
         if(ioptab.gt.0) QQ=Q/YTOT(ID)
       else
         qq=qadd(id)*anmne1
         dqt=0.
         dqn=0.
      end if
C
      APTT=0.
      APNN=0.
      APM=0.
      VPC=QFIX(ID)+QQ/ANMNE1
      DO IAT=1,NATOM
         IF(IIFIX(IAT).NE.1) THEN
         DO I=N0A(IAT),NKA(IAT)
            IF(IPZERO(I,ID).EQ.0) THEN
            IL=ILK(I)
            II=IIEXP(I)
            IF(IL.EQ.0) THEN
               CH=IZ(IEL(I))-1
               DCHT=0.
               DCHN=0.
             ELSE
               CH=IZ(IL)+(IZ(IL)-1)*USUM(IL)*ANE
               DCHT=(IZ(IL)-1)*ANE*DUSUMT(IL)*POPUL(I,ID)
               DCHN=(IZ(IL)-1)*(ANE*DUSUMN(IL)+USUM(IL))*POPUL(I,ID)
            END IF
            IF(IMODL(I).GE.0) VPC=VPC+CH*POPUL(I,ID)
            IF(II.GT.0) THEN
               AJ(II)=AJ(II)+CH
               APTT=APTT+DCHT
               APNN=APNN+DCHN
             ELSE IF(II.LT.0) THEN
               AJ(-II)=AJ(-II)+CH*SBPSI(I,ID)
               APTT=APTT+DCHT*SBPSI(I,ID)
               APNN=APNN+DCHN*SBPSI(I,ID)
             ELSE
               III=IIEXP(ILTREF(I,ID))
               AJ(III)=AJ(III)+CH*SBPSI(I,ID)
               APTT=APTT+CH*POPUL(I,ID)*DSBPST(I,ID)
               APNN=APNN+CH*POPUL(I,ID)*DSBPSN(I,ID)
            END IF
            END IF
         END DO
         END IF
      END DO
C
C     (NFREQE+INPC)-th row of matrix B
C
      NPC=NFREQE+INPC
      QQQ=ABUND(IATREF,ID)/YTOT(ID)/ANMNE1
      if(ioptab.gt.0) QQQ=UN/YTOT(ID)/ANMNE1
      IF(INHE.NE.0) B(NPC,NFREQE+INHE)=APM+QQ
      IF(INRE.NE.0) B(NPC,NFREQE+INRE)=APTT+QQQ*DQT
      B(NPC,NPC)=APNN-QQ-UN+QQQ*DQN
      DO II=1,NLVEXP
         B(NPC,NSE+II)=AJ(II)
      END DO
C
C     (NFREQE+INPC)-th element of the rhs vector VECL
C
      VECL(NPC)=ANE-VPC
      RETURN
      END