      SUBROUTINE DIJKL1 (C,N,NATI,W,CIJ,WCIJ,CKL)
      implicit double precision (A-H,O-Z)
      include 'SIZES'
      include 'MOP6FILE'
      dimension C(N,*), W(*)
      dimension CIJ(10*MAXORB), WCIJ(10*MAXORB), CKL(10*MAXORB)
************************************************************************
*
*   DIJKL1 IS SIMILAR TO IJKL.  THE MAIN DIFFERENCES ARE THAT
*   THE ARRAY W CONTAINS THE TWO ELECTRON INTEGRALS BETWEEN
*   ONE ATOM (NATI) AND ALL THE OTHER ATOMS IN THE SYSTEM.
*
*           ON EXIT
*
*   THE ARRAY XY IS FILLED WITH THE DIFFERENTIALS OF THE
*   TWO-ELECTRON INTEGRALS OVER ACTIVE-SPACE M.O.S W.R.T. MOTION
*   OF THE ATOM NATI.
************************************************************************
      common /MOLKST/ NUMAT,NAT(NUMATM),NFIRST(NUMATM),NMIDLE(NUMATM),
     1                NLAST(NUMATM), NORBS, NELECS,NALPHA,NBETA,
     2                NCLOSE,NOPEN,NDUMY,FRACT
      common /CIBITS/ NMOS,LAB,NELEC, NBO(3)
      common /XYIJKL/ XY(NMECI,NMECI,NMECI,NMECI)
      dimension NB(0:8)
      data NB /1,0,0,10,0,0,0,0,45/
      NA=NMOS
      do 110 I=1,NA
         do 110 J=1,I
            IPQ=0
            do 20 II=1,NUMAT
               if (II.EQ.NATI) go to 20
               do 10 IP=NFIRST(II),NLAST(II)
                  do 10 IQ=NFIRST(II),IP
                     IPQ=IPQ+1
                     CIJ(IPQ)=C(IP,I)*C(IQ,J)+C(IP,J)*C(IQ,I)
   10          continue
   20       continue
            I77=IPQ+1
            do 30 IP=NFIRST(NATI),NLAST(NATI)
               do 30 IQ=NFIRST(NATI),IP
                  IPQ=IPQ+1
                  CIJ(IPQ)=C(IP,I)*C(IQ,J)+C(IP,J)*C(IQ,I)
   30       continue
            do 40 II=1,IPQ
   40       WCIJ(II)=0.D0
            KR=1
            JS=1
            NBJ=NB(NLAST(NATI)-NFIRST(NATI))
            do 50 II=1,NUMAT
               if (II.EQ.NATI) go to 50
               NBI=NB(NLAST(II)-NFIRST(II))
               call FORMXY
     1(W(KR), KR, WCIJ(I77), WCIJ(JS), CIJ(I77), NBJ, CIJ(JS), NBI)
               JS=JS+NBI
   50       continue
            do 100 K=1,I
               if (K.EQ.I) then
                  LL=J
               else
                  LL=K
               end if
               do 100 L=1,LL
                  IPQ=0
                  do 70 II=1,NUMAT
                     if (II.EQ.NATI) go to 70
                     do 60 IP=NFIRST(II),NLAST(II)
                        do 60 IQ=NFIRST(II),IP
                           IPQ=IPQ+1
                           CKL(IPQ)=C(IP,K)*C(IQ,L)+C(IP,L)*C(IQ,K)
   60                continue
   70             continue
                  do 80 IP=NFIRST(NATI),NLAST(NATI)
                     do 80 IQ=NFIRST(NATI),IP
                        IPQ=IPQ+1
                        CKL(IPQ)=C(IP,K)*C(IQ,L)+C(IP,L)*C(IQ,K)
   80             continue
                  SUM=0.D0
                  do 90 II=1,IPQ
   90             SUM=SUM+CKL(II)*WCIJ(II)
                  XY(I,J,K,L)=SUM
                  XY(I,J,L,K)=SUM
                  XY(J,I,K,L)=SUM
                  XY(J,I,L,K)=SUM
                  XY(K,L,I,J)=SUM
                  XY(K,L,J,I)=SUM
                  XY(L,K,I,J)=SUM
                  XY(L,K,J,I)=SUM
  100       continue
  110 continue
      return
      end
