      SUBROUTINE DTAU(IRREPAB,IRREPIJ,IRREPX,IRREPY,Z,XA,XB,
     &                YA,YB,ISPIN,FACT)
C
C THIS ROUTINE FORMS THE MODIFIED DOUBLES AMPLITUDE:
C
C  Z(ab,ij) = Z(ab,ij) + FACT * [X(ai)*Y(bj)+X(bj)*Y(ai)]
C
C SPIN CASES:
C
C  Z(Ab,Ij) = Z(Ab,Ij) + FACT * [X(AI)*Y(bj)+X(bj)*Y(AI)]
C
C  Z(AB,IJ) = Z(AB,IJ) + FACT * [X(AI)*Y(BJ)+X(BJ)*Y(AI)]
C                      - FACT * [X(BI)*Y(AJ)+X(AJ)*Y(BI)]
C
C WHERE THE OVERALL SYMMETRIES OF X, Y AND Z NEED NOT BE
C TOTALLY SYMMETRIC.  THIS ROUTINE WORKS ON ONE SYMMETRY
C BLOCK OF IJ AT A TIME.
C
CEND
      IMPLICIT INTEGER (A-Z)
      DOUBLE PRECISION XA,XB,YA,YB,Z,FACT
      DIMENSION XA(*),YA(*),XB(*),YB(*),Z(*)
      COMMON/SYMLOC/ISYMOFF(8,8,25)
      COMMON/MACHSP/IINTLN,IFLTLN,IINTFP,IALONE,IBITWD
      COMMON/SYM/POP(8,2),VRT(8,2),NT(2),NFMI(2),NFEA(2)
      COMMON/SYMINF/NSTART,NIRREP,IRREPYY(255,2),DIRPRD(8,8)
      COMMON/SYMPOP/IRPDPD(8,22),ISYTYP(2,500),ID(18)
C
      INDX(I,J,N)=I+(J-1)*N
C
      IF(ISPIN.LE.2)THEN
       ISP1=ISPIN
       ISP2=ISPIN
       IOFFZ0=1
       DO 10 IRREPJ=1,NIRREP
        IRREPI=DIRPRD(IRREPJ,IRREPIJ)
        IF(IRREPI.GT.IRREPJ)GOTO 10
        NUMJ=POP(IRREPJ,ISP2)
        NUMI=POP(IRREPI,ISP1)
        DO 11 J=1,NUMJ
         ITOP=NUMI
         IF(IRREPI.EQ.IRREPJ)ITOP=J-1
         DO 12 I=1,ITOP
          DO 13 IRREPB=1,NIRREP
           IRREPA=DIRPRD(IRREPB,IRREPAB)
           IF(IRREPA.GT.IRREPB)GOTO 13
           NUMB=VRT(IRREPB,ISP2)
           NUMA=VRT(IRREPA,ISP1)
           IF(IRREPA.NE.IRREPB)THEN
            NUMAB=NUMA*NUMB
           ELSE
            NUMAB=(NUMA*(NUMA-1))/2
           ENDIF
           IRREPAI=DIRPRD(IRREPA,IRREPI)
           IRREPBJ=DIRPRD(IRREPB,IRREPJ)
           IRREPAJ=DIRPRD(IRREPA,IRREPJ)
           IRREPBI=DIRPRD(IRREPB,IRREPI)
           IF(IRREPAI.EQ.IRREPX)THEN
            IOFFZ=IOFFZ0
            DO 21 B=1,NUMB
             ATOP=NUMA
             IF(IRREPA.EQ.IRREPB)ATOP=B-1
             DO 22 A=1,ATOP
              IOFFX=ISYMOFF(IRREPI,IRREPX,8+ISP1)+INDX(A,I,NUMA)-1
              IOFFY=ISYMOFF(IRREPJ,IRREPY,8+ISP1)+INDX(B,J,NUMB)-1
              Z(IOFFZ)=Z(IOFFZ)+FACT*XA(IOFFX)*YA(IOFFY)
              IOFFZ=IOFFZ+1
22           CONTINUE
21          CONTINUE
           ENDIF
           IF(IRREPBJ.EQ.IRREPX)THEN
            IOFFZ=IOFFZ0
            DO 23 B=1,NUMB
             ATOP=NUMA
             IF(IRREPA.EQ.IRREPB)ATOP=B-1
             DO 24 A=1,ATOP
              IOFFX=ISYMOFF(IRREPJ,IRREPX,8+ISP1)+INDX(B,J,NUMB)-1
              IOFFY=ISYMOFF(IRREPI,IRREPY,8+ISP1)+INDX(A,I,NUMA)-1
              Z(IOFFZ)=Z(IOFFZ)+FACT*XA(IOFFX)*YA(IOFFY)
              IOFFZ=IOFFZ+1
24           CONTINUE
23          CONTINUE
           ENDIF
           IF(IRREPBI.EQ.IRREPX)THEN
            IOFFZ=IOFFZ0
            DO 25 B=1,NUMB
             ATOP=NUMA
             IF(IRREPA.EQ.IRREPB)ATOP=B-1
             DO 26 A=1,ATOP
              IOFFX=ISYMOFF(IRREPI,IRREPX,8+ISP1)+INDX(B,I,NUMB)-1
              IOFFY=ISYMOFF(IRREPJ,IRREPY,8+ISP1)+INDX(A,J,NUMA)-1
              Z(IOFFZ)=Z(IOFFZ)-FACT*XA(IOFFX)*YA(IOFFY)
              IOFFZ=IOFFZ+1
26           CONTINUE
25          CONTINUE
           ENDIF
           IF(IRREPAJ.EQ.IRREPX)THEN
            IOFFZ=IOFFZ0
            DO 27 B=1,NUMB
             ATOP=NUMA
             IF(IRREPA.EQ.IRREPB)ATOP=B-1
             DO 28 A=1,ATOP
              IOFFX=ISYMOFF(IRREPJ,IRREPX,8+ISP1)+INDX(A,J,NUMA)-1
              IOFFY=ISYMOFF(IRREPI,IRREPY,8+ISP1)+INDX(B,I,NUMB)-1
              Z(IOFFZ)=Z(IOFFZ)-FACT*XA(IOFFX)*YA(IOFFY)
              IOFFZ=IOFFZ+1
28           CONTINUE
27          CONTINUE
           ENDIF
           IOFFZ0=IOFFZ0+NUMAB
13        CONTINUE
12       CONTINUE
11      CONTINUE
10     CONTINUE
      ELSEIF(ISPIN.EQ.3)THEN
       ISP1=1
       ISP2=2
       IOFFZ0=1
       DO 30 IRREPJ=1,NIRREP
        IRREPI=DIRPRD(IRREPJ,IRREPIJ)
        NUMJ=POP(IRREPJ,ISP2)
        NUMI=POP(IRREPI,ISP1)
        DO 31 J=1,NUMJ
         DO 32 I=1,NUMI
          DO 33 IRREPB=1,NIRREP
           IRREPA=DIRPRD(IRREPB,IRREPAB)
           NUMB=VRT(IRREPB,ISP2)
           NUMA=VRT(IRREPA,ISP1)
           IRREPAI=DIRPRD(IRREPA,IRREPI)
           IRREPBJ=DIRPRD(IRREPB,IRREPJ)
           IF(IRREPAI.EQ.IRREPX)THEN
            IOFFZ=IOFFZ0
            DO 41 B=1,NUMB
             DO 42 A=1,NUMA
              IOFFX=ISYMOFF(IRREPI,IRREPX,8+ISP1)+INDX(A,I,NUMA)-1
              IOFFY=ISYMOFF(IRREPJ,IRREPY,8+ISP2)+INDX(B,J,NUMB)-1
              Z(IOFFZ)=Z(IOFFZ)+FACT*XA(IOFFX)*YB(IOFFY)
              IOFFZ=IOFFZ+1
42           CONTINUE
41          CONTINUE
           ENDIF
           IF(IRREPBJ.EQ.IRREPX)THEN
            IOFFZ=IOFFZ0
            DO 43 B=1,NUMB
             DO 44 A=1,NUMA
              IOFFX=ISYMOFF(IRREPJ,IRREPX,8+ISP2)+INDX(B,J,NUMB)-1
              IOFFY=ISYMOFF(IRREPI,IRREPY,8+ISP1)+INDX(A,I,NUMA)-1
              Z(IOFFZ)=Z(IOFFZ)+FACT*XB(IOFFX)*YA(IOFFY)
              IOFFZ=IOFFZ+1
44           CONTINUE
43          CONTINUE
           ENDIF
           IOFFZ0=IOFFZ0+NUMA*NUMB
33        CONTINUE
32       CONTINUE
31      CONTINUE
30     CONTINUE
C
      ENDIF 
C
      RETURN
      END
