
      SUBROUTINE MO2AO3(ZMO,ZAO,EVEC,SCR,NAO,NMO,ISPIN,ITYPE)
C
C TRANSFORMS A TWO-INDEX QUANTITY (I.E. DENSITY) FROM THE MO TO
C  THE AO BASIS.
C
C INPUT:
C       ZMO  - TWO-INDEX QUANTITY IN MO BASIS (LENGTH: NBAS*NBAS)
C       NMO  - NUMBER OF MOLECULAR ORBITALS
C       NAO  - NUMBER OF ATOMIC ORBITALS
C       
C       ISPIN- 1 FOR ALPHA, 2 FOR BETA
C
C OUTPUT:
C       ZAO  - TWO-INDEX QUANTITY IN AO BASIS (LENGTH: NAO*NAO)
C       
C SCRATCH:
C       EVEC - HOLDS EIGENVECTOR MATRIX (LENGTH: NAO*NMO)
C       SCR  - HOLDS INTERMEDIATE QUANTITY (LENGTH: NBAS*NBAS) 
C
CEND
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      CHARACTER*8 LABEL
      DIMENSION EVEC(NAO,NMO),ZMO(NMO,NMO),ZAO(NAO,NAO)
      DIMENSION SCR(NAO*NAO)
      COMMON /MACHSP/ IINTLN,IFLTLN,IINTFP,IALONE,IBITWD
      COMMON /FLAGS/  IFLAGS(100)
      DATA ONE,ZILCH /1.0D0,0.0D0/
      IF(ITYPE.EQ.1) THEN
      IF(ISPIN.EQ.1)LABEL='SCFEVECA'
      IF(ISPIN.EQ.2)LABEL='SCFEVECB'
      ELSE
      IF(ISPIN.EQ.1)LABEL='SCFEVCA0'
      IF(ISPIN.EQ.2)LABEL='SCFEVCB0'
      ENDIF
C
CJDW 3/18/96. See comments in main program.
C
      CALL GETREC(20,'JOBARC','NUMDROPA',1,NDROP)
      IF(NDROP.GT.0.AND.IFLAGS(2).GT.0)THEN
        IF(ISPIN.EQ.1)LABEL='SCFEVCA0'
        IF(ISPIN.EQ.2)LABEL='SCFEVCB0'
      ENDIF
C
      CALL GETREC(20,'JOBARC',LABEL,IINTFP*NAO*NMO,EVEC)
      CALL XGEMM('N','T',NMO,NAO,NMO,ONE,ZMO,NMO,EVEC,NAO,
     &           ZILCH,SCR,NMO)
      CALL XGEMM('N','N',NAO,NAO,NMO,ONE,EVEC,NAO,SCR,NMO,
     &           ZILCH,ZAO,NAO)
      RETURN
      END
