C
C $Id: fshift.F,v 1.3 1998/07/16 16:39:49 jjv5 Exp arjan $
C
C------------------------------------------------------------------------
      SUBROUTINE FSHIFT(IDIAG,ESHIFT)
C
C     ROUTINE TO CARRY OUT DYNAMIC OR STATIC LEVEL SHIFT TO PREVENT
C     AUTO-POLARIZATION OF CHARGE DISTRIBUTION.
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
#include "divcon.dim"
#include "divcon.h"
C
C
C     LOCAL:
C
      LOGICAL FIRST
      DATA FIRST /.TRUE./
      SAVE FIRST
      SAVE OLDSHF
C
      IF(FIRST)THEN
        FIRST = .FALSE.
      ENDIF
C
C     NO SHIFTING IF DENSITY MATRIX HAS DIAGONAL FORM.
C
      IF(IDIAG.EQ.1)THEN
        OLDSHF = ESHIFT
        RETURN
      ENDIF
C
      IF(STAND)THEN
        ESHIFT = 0.5D0*(ESHIFT + OLDSHF)
        OLDSHF = ESHIFT
      ENDIF
      ESHFT2 = ESHIFT*2.0D0
      IIMAX = IIMAT(NATOMS+1)-1
      IJMAX = IJMAT(IP1(NATOMS+1))-1
      DO 300 II=1,IIMAX
        FDIAG(II) = FDIAG(II) + ESHIFT*PDIAG(II)
 300  CONTINUE
      II = 0
      DO 400 I=1,NATOMS
        NORBSI = NATORB(IATNUM(I))
        IF(NORBSI.EQ.0) GO TO 400
        DO 350 IORB=1,NORBSI
          II = II + IORB
          FDIAG(II) = FDIAG(II) - ESHFT2
 350    CONTINUE
 400  CONTINUE
      DO 500 IJ=1,IJMAX
        FDIAT(IJ) = FDIAT(IJ) + ESHIFT*PDIAT(IJ)
 500  CONTINUE
      RETURN
      END