C
C $Id: esqr.F,v 1.3 1998/07/16 16:39:45 jjv5 Exp arjan $
C
C------------------------------------------------------------------------
      SUBROUTINE ESQR(K,NORBSK,EVEC1)
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"
      DIMENSION EVEC1(NORBSK,*)
C
      L0 = IORBPT(K)-1
      DO 100 L=1,NORBSK
        SUML = 0.0D0
        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
          SUMI = 0.0D0
          DO 60 IORB=1,NORBSI
            SUMI = SUMI + EVEC1(I0+IORB,L)**2
 60       CONTINUE
          SUML = SUML + DII*SUMI
 80     CONTINUE
        EVECSQ(L0+L) = SUML
 100  CONTINUE
      RETURN
      END