C
C $Id: esqr.F,v 1.3 1998/07/16 16:39:45 jjv5 Exp $
C
C------------------------------------------------------------------------
      SUBROUTINE ESQRfdm
C
C     DETERMINES THE COEFFICIENTS EVECSQ FOR SUBSYSTEM K:
C
C     EVECSQ(L0+L) = D11*EVEC1(1,L)**2 + D22*EVEC1(2,L)**2 + . . .
C
C     HERE L0 IS JUST A GLOBAL POINTER FOR SUBSYSTEM K, AND DII IS
C     THE NORMALIZATION FACTOR THAT ACCOUNTS FOR SUBSYSTEM OVERLAP.
C
C     ONCE ALL OF THE ENTRIES OF EVECSQ HAVE BEEN DETERMINED, THEN
C     THE NUMBER OF ELECTRONS CAN BE COMPUTED FOR ANY SET OF FERMI
C     OCCUPATION NUMBERS:
C
C     NO. OF ELECTRONS = FERMI(1)*EVECSQ(1) + FERMI(2)*EVECSQ(2) + . . .
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
#include "divcon.dim"
#include "divcon.h"

C
      k0 = 0
      do k=1,nsub
         NORBSK = IORBPT(K+1)-IORBPT(K)
         L0 = IORBPT(K)-1
         DO 100 L=1,NORBSK
            SUML = 0.0D0
            ll0 = (l-1)*norbsk+k0
            DO 80 I=IATOM1(K),IATOM1(K+1)-1
               IATM = IATOMS(I)
C
C     SKIP CONTRIBUTION IF THIS IS A BUFFER ATOM.
C
               IF(IABUFF(I).NE.0) GO TO 80
C
               NORBSI = NATORB(IATNUM(IATM))
               NSUBSI = ISUB1(IATM+1) - ISUB1(IATM)
               DII = 2.0D0/NSUBSI
               I0 = IORB1(I)-1+ll0
               SUMI = 0.0D0
               DO 60 IORB=1,NORBSI
                  SUMI = SUMI + EVEC(I0+IORB)**2
 60            CONTINUE
               SUML = SUML + DII*SUMI
 80         CONTINUE
            EVECSQ(L0+L) = SUML
 100     CONTINUE
         k0 = k0 + norbsk*norbsk
      enddo
      RETURN
      END