C
C ITERATIVE SOLUTION OF EIGENVALUES USING THE DAVIDSON METHOD.
C THIS VERSION IS FOR CASES WHERE THE MATRIX TO BE DIAGONALIZED
C EASILY FITS INTO CORE.
C
C INPUT:
C
C  ALARGE - THE MATRIX TO BE DIAGONALIZED [DOUBLE PRECISION]
C  NDIMA  - THE DIMENSION OF ALARGE [INTEGER]
C  MAXIT  - THE MAXIMUM NUMBER OF ITERATIONS ALLOWED [INTEGER]
C  NROOT  - THE NUMBER OF ROOTS OBTAINED [INTEGER]
C  TOL    - TOLERANCE FOR CONVERGENCE [NORM OR RESIDUAL] [DOUBLE PREC]
C  NSCAN  - THE NUMBER OF DIAGONAL ELEMENTS OF ALARGE WHICH SHOULD
C           BE INSPECTED FOR INITIAL GUESSES.  THIS IS ALMOST ALWAYS
C           EQUAL TO NDIMA.
C
C OUTPUT:
C
C  ROOT   - THE EIGENVALUES [DOUBLE PRECISION]
C  IROOT  - THE NUMBER OF GOOD ROOTS OBTAINED
C  EVEC   - A VECTOR OF DIMENSION (NDIMA,NROOT) HOLDING THE
C           EIGENVECTORS  [DOUBLE PRECISION]
C  IERR   - RETURNS THE NUMBER OF BAD EIGENVALUES (UNSUCCESSFUL
C           ROOT SEARCHES)
C
C SCRATCH VECTORS:
C
C  ASMALL - LENGTH MAXIT*MAXIT
C  VSPACE - LENGTH NDIMA*(MAXIT+NROOT)
C  TMP1   - LENGTH NDIMA
C  TMP2   - LENGTH NDIMA
C  TMP3   - LENGTH MAXIT*MAX(MAXIT,NDIMA)
C  TMP4   - LENGTH NDIMA
C
      SUBROUTINE DAVID1(ALARGE,ASMALL,ROOT,EVEC,VSPACE,TMP,
     &                  TMP2,TMP3,TMP4,MAXIT,NROOT,IROOT,
     &                  NDIMA,NSCAN,TOL,IERR)
      IMPLICIT INTEGER (A-Z)
      LOGICAL DOMORE,PRINT
      DOUBLE PRECISION ALARGE,ASMALL,TMP,TMP2,TMP3,TMP4,ROOT
      DOUBLE PRECISION EVEC,VSPACE,RESID,TOL,ONE,ZILCH,X,THRESH
      DOUBLE PRECISION SNRM2,SDOT,XMAX,EVAL,LARGE
      PARAMETER (LARGE=1.D+30)
      DIMENSION ALARGE(NDIMA,NDIMA),ASMALL(*),VSPACE(NDIMA,MAXIT+NROOT)
      DIMENSION TMP(NDIMA),TMP2(NDIMA),TMP3(*)
      DIMENSION TMP4(NDIMA)
      DIMENSION ROOT(NROOT),EVEC(NDIMA,NROOT)
C
      COMMON/MACHSP/IINTLN,IFLTLN,IINTFP,IALONE,IBITWD
      COMMON/FLAGS/IFLAGS(100)
C
      DATA ONE,ZILCH /1.0D0,0.0D0/
      DATA THRESH /1.D-10/
C
      INDXF(I,J,N)=I+(J-1)*N
C
      PRINT=IFLAGS(1).GE.2
      IERR=0
C
      IF(PRINT)THEN
       WRITE(6,1000)NROOT
1000   FORMAT(T3,'@DAVID1-I, Beginning search for lowest ',I5,
     &           ' solutions.')
      ENDIF
C
C COLLECT DIAGONAL ELEMENTS OF ALARGE INTO TMP VECTOR
C
      CALL DCOPY(NDIMA,ALARGE,NDIMA+1,TMP,1)
C
C COUNTER FOR SUCCESSFUL ROOT SEARCHES
C
      IROOT=0
C
C LOOP OVER NUMBER OF DESIRED ROOTS
C
      DO 5 NPASS=1,NROOT
C
C GENERATE INITIAL GUESS BASED ON DIAGONAL ELEMENTS OF ALARGE
C
       NSPACE=1
       IF(PRINT)WRITE(6,1003)NPASS
       IF(PRINT)WRITE(6,1001)
       ILOC=IMINPOS(NSCAN,TMP,1)
       TMP(ILOC)=LARGE
       ICOL=MAXIT
       CALL ZERO(VSPACE(1,ICOL),NDIMA)
       VSPACE(ILOC,ICOL)=ONE
       CALL DCOPY(NDIMA,VSPACE(1,ICOL),1,TMP2,1)
C
C ORTHOGONALIZE GUESS TO ALL PRECEDING SOLUTION VECTORS
C
       IF(IROOT.GT.0)THEN
        CALL GSCHMIDT(VSPACE(1,ICOL),VSPACE(1,MAXIT+1),NDIMA,IROOT,
     &                TMP2,RESID,THRESH)
       ENDIF
C
C FORM ASMALL
C
1      CONTINUE
       CALL XGEMM('N','N',NDIMA,NSPACE,NDIMA,ONE,ALARGE,NDIMA,
     &            VSPACE(1,ICOL),NDIMA,ZILCH,TMP3,NDIMA)
       CALL XGEMM('T','N',NSPACE,NSPACE,NDIMA,ONE,VSPACE(1,ICOL),
     &            NDIMA,TMP3,NDIMA,ZILCH,ASMALL,NSPACE)
C
C DIAGONALIZE ASMALL
C
       CALL EIG(ASMALL,TMP3,NSPACE,NSPACE,0)
C
C OBTAIN NEW EIGENVECTORS AND FIND ONE HAVING BEST OVERLAP 
C WITH PRECEDING APPROXIMATION
C
       XMAX=ZILCH
       IPOS=1
       DO 12 I=1,NSPACE
        CALL XGEMM('N','N',NDIMA,1,NSPACE,ONE,VSPACE(1,ICOL),
     &             NDIMA,TMP3(INDXF(1,I,NSPACE)),NSPACE,ZILCH,
     &             TMP4,NDIMA)
        X=ABS(SDOT(NDIMA,TMP4,1,TMP2,1))
        IF(X.GT.XMAX)THEN
         XMAX=X
         IPOS=I
         CALL DCOPY(NDIMA,TMP4,1,EVEC(1,IROOT+1),1)
        ENDIF
12     CONTINUE
       EVAL=ASMALL(IPOS+(IPOS-1)*NSPACE)
       CALL DCOPY(NDIMA,EVEC(1,IROOT+1),1,TMP2,1)
C
C CALCULATE RESIDUAL [W-E(n)]C AND APPLY DAVIDSON CORRECTION 
C
       CALL XGEMM('N','N',NDIMA,1,NDIMA,ONE,ALARGE,
     &            NDIMA,EVEC(1,IROOT+1),NDIMA,ZILCH,TMP4,NDIMA)
       CALL SAXPY(NDIMA,-EVAL,EVEC(1,IROOT+1),1,TMP4,1)
       IF(NSPACE.NE.1)THEN
        DO 11 I=1,NDIMA
         X=EVAL-ALARGE(I,I)
         TMP4(I)=TMP4(I)/X
11      CONTINUE
       ENDIF
C
C ORTHOGONALIZE RESIDUAL TO EXISTING SPACE
C
       CALL GSCHMIDT(TMP4,VSPACE(1,ICOL),NDIMA,NSPACE+IROOT,
     &               TMP2,RESID,THRESH)
       IF(PRINT)WRITE(6,1002)NSPACE,EVAL,XMAX,RESID
       IF(RESID.GT.TOL)THEN
        NSPACE=NSPACE+1
        ICOL=ICOL-1
        CALL DCOPY(NDIMA,TMP4,1,VSPACE(1,ICOL),1)
        CALL DCOPY(NDIMA,EVEC(1,IROOT+1),1,TMP2,1)
        IF(NSPACE+1.EQ.MAXIT)THEN
         IERR=IERR+1
         WRITE(6,1005)MAXIT
         DOMORE=.FALSE.
        ELSE
         DOMORE=.TRUE.
        ENDIF
       ELSE
        DOMORE=.FALSE.
        IROOT=IROOT+1
        ROOT(IROOT)=EVAL
        IF(PRINT)WRITE(6,1004)NSPACE
        CALL DCOPY(NDIMA,EVEC(1,IROOT),1,VSPACE(1,MAXIT+IROOT),1)
       ENDIF 
C
       IF(DOMORE)GOTO 1
C
5     CONTINUE
      RETURN
1001  FORMAT(T5,'Iteration',T23,'Eigenvalue',T40,'Overlap',
     &       T58,'Residual')
1002  FORMAT(T7,I4,T18,F15.8,T39,F8.6,T52,E15.10)
1003  FORMAT(T3,'Beginning root search ',I5,'.')
1004  FORMAT(T3,'Convergence achieved in ',I5,' iterations.')
1005  FORMAT(T3,'Convergence fails after ',I5,' iterations.')
      END
