maxovl.f

      SUBROUTINE MAXOVL(IORDER,EVEC1,EVEC2,OVLP,NBAS,N2BAS,NVEC,QNWORD)
      IMPLICIT REAL*8(A-H,O,P,R-Z),LOGICAL*1(Q)
C-----------------------------------------------------------------------
C
C     MAXOVL...
C
C        THIS ROUTINE RETURNS AN ORDERING ARRAY FOR ORDERING THE COLUMN
C     VECTORS IN A SECOND MATRIX IN SUCH A WAY AS TO GIVE MAXIMUM
C     OVERLAP WITH THE COLUMN VECTORS IN A FIRST MATRIX.
C
C        <EVEC1(*,I)!EVEC2(*,IORDER(I))> = MAXIMUM
C
C     DEFINITIONS:
C
C        IORDER(*).... THE ORDERING ARRAY.
C        EVEC1(*,*)... THE FIRST MATRIX CONTAINING COLUMN VECTORS WHICH
C                      WILL DETERMINE THE ORDER.
C        EVEC2(*,*)... THE SECOND MATRIX CONTAINING THE COLUMN VECTORS
C                      TO BE ORDERED.  (THE MATRIX IS NOT CHANGED.)
C        OVLP(*)...... OVERLAP MATRIX FOR THE BASIS WITH RESPECT TO
C                      WHICH THESE VECTORS ARE GIVEN. (PACKED).
C        NBAS......... ORDER OF THE BASIS, COLUMN DIMENSION OF VECTORS.
C        N2BAS........ =NBAS*(NBAS+1)/2, DIMENSION OF OVLP(*).
C        NVEC......... NUMBER OF COLUMN VECTORS PRESENT.
C        QNWORD....... =T --> THE ORDER OF THE VECTORS ARE DIFFERENT.
C                      =F --> IORDER(*)=1,2,3,...,NVEC. (SAME ORDER).
C
C     ROUTINES CALLED:  IERASE
C
C-----------------------------------------------------------------------
      DIMENSION IORDER(NVEC),EVEC1(NBAS,NVEC),EVEC2(NBAS,NVEC),
     X          OVLP(N2BAS)
      DATA ZERO/0.0D0/,HALF/0.5D0/,ONE/1.0D0/
      CALL IERASE(IORDER,NVEC)
      QNWORD=.FALSE.
      DO 100 I=1,NVEC
      SII=ZERO
      IF (IORDER(I).NE.0) GO TO 30
      DO 20 K=1,NBAS
      KK=(K*(K-1))/2
      DO 10 L=1,NBAS
      KL=KK+L
      IF (L.GT.K) KL=(L*(L-1))/2+K
      SII=SII+EVEC1(K,I)*EVEC2(L,I)*OVLP(KL)
   10 CONTINUE
   20 CONTINUE
      SII=SII*SII
      JMAX=I
      IF (SII.LT.HALF) GO TO 30
      IORDER(I)=I
      GO TO 100
   30 CONTINUE
      QNWORD=.TRUE.
      SMAX=SII
      REMAIN=ONE-SII
      DO 80 J=1,NVEC
      IF ((IORDER(J).NE.0).OR.(J.EQ.I)) GO TO 80
      SIJ=ZERO
      DO 50 K=1,NBAS
      KK=(K*(K-1))/2
      DO 40 L=1,NBAS
      KL=KK+L
      IF (L.GT.K) KL=(L*(L-1))/2+K
      SIJ=SIJ+EVEC1(K,I)*EVEC2(L,J)*OVLP(KL)
   40 CONTINUE
   50 CONTINUE
      SIJ=SIJ*SIJ
      REMAIN=REMAIN-SIJ
      IF (SIJ.LT.HALF) GO TO 60
      IORDER(J)=I
      GO TO 100
   60 CONTINUE
      IF (SIJ.LT.SMAX) GO TO 70
      SMAX=SIJ
      JMAX=J
   70 IF (REMAIN.LT.SMAX) GO TO 90
   80 CONTINUE
   90 IORDER(JMAX)=I
  100 CONTINUE
      RETURN
      END