SUBROUTINE BPOPE(ID)
C     ====================
C
C     the part of B-matrix corresponding to the population rows and
C     the explicit frequency columns
C     -- a variant for the full overlap case
C
      INCLUDE 'IMPLIC.FOR'
      INCLUDE 'BASICS.FOR'
      INCLUDE 'ATOMIC.FOR'
      INCLUDE 'MODELQ.FOR'
      INCLUDE 'ODFPAR.FOR'
      INCLUDE 'ALIPAR.FOR'
      INCLUDE 'ITERAT.FOR'
      INCLUDE 'ARRAY1.FOR'
      DIMENSION AJIJ(MFREX,MLVEXP),EHKE(MFREX)
C
      IF(NFREQE.LE.0) RETURN
      NSE=NFREQE+INSE-1
      DO I=1,NLVEXP
         DO IJE=1,NFREQE
            AJIJ(IJE,I)=0.
         END DO
      END DO
      HKT=HK/TEMP(ID)
      DO IJE=1,NFREQE
         EHKE(IJE)=EXP(-HKT1(ID)*FREQ(IJFR(IJE)))
      END DO
C
      DO 100 IJ=1,NFREQ
         IF(IJEX(IJ).LE.0) GO TO 100
         IF(IJX(IJ).EQ.-1) GOTO 100
         IJE=IJEX(IJ)
         FR=FREQ(IJ)
         FRINV=UN/FR
         FR3INV=FRINV*FRINV*FRINV
C
C        ---------------------
C        Continuum transitions
C        ---------------------
C
         DO 10 IBFT=1,NTRANC
            ITR=ITRBF(IBFT)
            SG=CROSS(IBFT,IJ)
            IF(SG.LE.0.) GO TO 10
            I=ILOW(ITR)
            IF(ILTION(IEL(I)).GE.1.OR.IIFIX(IATM(I)).EQ.1) GO TO 10
            ICDW=MCDW(ITR)
            IMER=IMRG(I)
            II=IABS(IIEXP(I))
            J=IUP(ITR)
            IF(IPZERO(I,ID).NE.0.OR.IPZERO(J,ID).NE.0) GO TO 10
            JJ=IABS(IIEXP(J))
            NREFI=NREFS(IATM(I),ID)
            IF(IFWOP(I).GE.0) THEN
              IF(ICDW.GE.1) THEN
                 IZZ=IZ(IEL(I))
                 CALL DWNFR1(FR,FR0(ITR),ID,IZZ,DW1)
                 SG=SG*DW1
              END IF
            ELSE
              CALL SGMER1(FRINV,FR3INV,IMER,ID,SGME1)
              SG=SGME1
            ENDIF
            W0=W0E(IJ)
            SGW0=SG*W0
            APFR=(ABTRA(ITR,ID)-EMTRA(ITR,ID)*EHKE(IJE))*SGW0 
            IF(II.GT.0.AND.I.NE.NREFI.AND.ILTLEV(I).LE.0) 
     *         AJIJ(IJE,II)=AJIJ(IJE,II)+APFR  
            IF(JJ.GT.0.AND.J.NE.NREFI.AND.ILTLEV(J).LE.0.
     *         and.iabs(imodl(i)).ne.4) 
     *         AJIJ(IJE,JJ)=AJIJ(IJE,JJ)-APFR  
   10    CONTINUE
C            
C        ----------------
C        Line transitions 
C        ----------------
C             
         IF(ISPODF.EQ.0) THEN
         IF(IJLIN(IJ).GT.0) THEN
C
C        the "primary" line at the given frequency
C
            ITR=IJLIN(IJ)
            IF(LINEXP(ITR)) GO TO 20
            IF(.NOT.LEXP(ITR)) GO TO 20
            I=ILOW(ITR)
            IF(ILTION(IEL(I)).GE.1.OR.IIFIX(IATM(I)).EQ.1) GO TO 20
            J=IUP(ITR)
            IF(IPZERO(I,ID).NE.0.OR.IPZERO(J,ID).NE.0) GO TO 20
            II=IABS(IIEXP(I))
            JJ=IABS(IIEXP(J))
            IF(II.LE.0.AND.JJ.LE.0) GO TO 20
            NREFI=NREFS(IATM(I),ID)
            SGW=PRFLIN(ID,IJ)*W0E(IJ)
            APFR=(ABTRA(ITR,ID)-EMTRA(ITR,ID)*EHKE(IJE))*SGW
            IF(II.GT.0.AND.I.NE.NREFI.AND.ILTLEV(I).LE.0) 
     *         AJIJ(IJE,II)=AJIJ(IJE,II)+APFR  
            IF(JJ.GT.0.AND.J.NE.NREFI.AND.ILTLEV(J).LE.0. 
     *         and.iabs(imodl(i)).ne.4)
     *         AJIJ(IJE,JJ)=AJIJ(IJE,JJ)-APFR  
         END IF
C
C        the "overlapping" lines at the given frequency
C
   20    IF(NLINES(IJ).LE.0) GO TO 100
         DO 50 ILINT=1,NLINES(IJ)
            ITR=ITRLIN(ILINT,IJ)
            IF(LINEXP(ITR)) GO TO 50
            I=ILOW(ITR)
            IF(ILTION(IEL(I)).GE.1.OR.IIFIX(IATM(I)).EQ.1) GO TO 50
            J=IUP(ITR)
            IF(IPZERO(I,ID).NE.0.OR.IPZERO(J,ID).NE.0) GO TO 50
            II=IABS(IIEXP(I))
            JJ=IABS(IIEXP(J))
            IF(II.LE.0.AND.JJ.LE.0) GO TO 50
            NREFI=NREFS(IATM(I),ID)
            IJ0=IFR0(ITR)
            DO IJT=IJ0,IFR1(ITR)
               IF(FREQ(IJT).LE.FR) THEN
                  IJ0=IJT
                  GO TO 40
               END IF
            END DO
   40       IJ1=IJ0-1
            X=W0E(IJ)/(FREQ(IJ1)-FREQ(IJ0))
            A1=(FR-FREQ(IJ0))*X
            A2=(FREQ(IJ1)-FR)*X
            SGW=A1*PRFLIN(ID,IJ1)+A2*PRFLIN(ID,IJ0)
            APFR=(ABTRA(ITR,ID)-EMTRA(ITR,ID)*EHKE(IJE))*SGW
            IF(II.GT.0.AND.I.NE.NREFI.AND.ILTLEV(I).LE.0) 
     *         AJIJ(IJE,II)=AJIJ(IJE,II)+APFR  
            IF(JJ.GT.0.AND.J.NE.NREFI.AND.ILTLEV(J).LE.0. 
     *         and.iabs(imodl(i)).ne.4)
     *         AJIJ(IJE,JJ)=AJIJ(IJE,JJ)-APFR  
   50    CONTINUE
C
C     Opacity sampling option
C
         ELSE
         IF(NLINES(IJ).LE.0) GO TO 100
          DO 150 ILINT=1,NLINES(IJ)
            ITR=ITRLIN(ILINT,IJ)
            I=ILOW(ITR)
            IF(ILTION(IEL(I)).GE.1.OR.IIFIX(IATM(I)).EQ.1) GO TO 150
            J=IUP(ITR)
            IF(IPZERO(I,ID).NE.0.OR.IPZERO(J,ID).NE.0) GO TO 150
            KJ=IJ-IFR0(ITR)+KFR0(ITR)
            II=IABS(IIEXP(I))
            JJ=IABS(IIEXP(J))
            IF(II.LE.0.AND.JJ.LE.0) GO TO 150
            NREFI=NREFS(IATM(I),ID)
            INDXPA=IABS(INDEXP(ITR))
            IF(INDXPA.NE.3 .AND. INDXPA.NE.4) THEN
              SG=PRFLIN(ID,KJ)
             ELSE
              KJD=JIDI(ID)
              SG=EXP(XJID(ID)*SIGFE(KJD,KJ)+
     *           (UN-XJID(ID))*SIGFE(KJD+1,KJ))
            END IF
            APFR=(ABTRA(ITR,ID)-EMTRA(ITR,ID)*EHKE(IJE))*SG*W0E(IJ)
            IF(II.GT.0.AND.I.NE.NREFI.AND.ILTLEV(I).LE.0) 
     *         AJIJ(IJE,II)=AJIJ(IJE,II)+APFR  
            IF(JJ.GT.0.AND.J.NE.NREFI.AND.ILTLEV(J).LE.0. 
     *         and.iabs(imodl(i)).ne.4)
     *         AJIJ(IJE,JJ)=AJIJ(IJE,JJ)-APFR  
  150    CONTINUE
         END IF
  100 CONTINUE
C
C     elements of the B-matrix
C
      DO I=1,NLVEXP
         DO IJE=1,NFREQE
            IF(IFPOPR.LE.3) THEN
               SUM=0.
               DO J=1,NLVEXP
                  SUM=SUM-ESEMAT(I,J)*AJIJ(IJE,J)
               END DO    
             ELSE
               SUM=AJIJ(IJE,I)
            END IF
            B(NSE+I,IJE)=SUM*CRSW(ID)
         END DO
      END DO
      RETURN
      END