      SUBROUTINE F2TAU(T2,T1A,T1B,DISSYT,NUMSYT,POP1,POP2,
     &               VRT1,VRT2,IRREP,FACT,ITYPE)
C
C THIS SUBROUTINE FORMS THE SYMMETRY PACKED TAU(AB,IJ) 
C AMPLITUDES FOR CCSD GIVEN THE SYMMETRY PACKED T2(AB,IJ)
C AND T1(A,I) AMPLITUDES. TAU(AB,IJ) IS DEFINED AS
C
C  TAU(AB,IJ) = T2(AB,IJ) + T1(A,I)*T1(B,J)*FACT
C
C NOTE THAT SYMMETRY PACKING IS USED AND THAT THE
C SYMMETRY INFORMATION IS ALSO USED IN ORDER TO
C DECIDE IF THERE ARE ANY SINGLE CONTRIBUTION OR NOT.
C FOR THE ABAB SPIN CASE, THERE ARE ONLY CONTRIBUTIONS
C WHEN THE IRREP OF A IS EQUAL TO THE IRREP OF I (AND
C IRREPB EQUAL TO IRREPJ, WHICH IS FORCED BY THE REQUIREMENT
C THAT THE T2 AMPLITUDES ARE TOTAL SYMMETRIC) IN THE AAAA
C AND BBBB SPIN CASES, THERE ARE CONTRIBUTIONS IF EITHERE
C IRREPA EQUALS IRREPI (FIRST TERM) OR IRREPA EQUALS IRREPJ 
C (SECOND TERM)
C
C INPUT :
C       T2 ............... T2 LIST
C       T1A .............. FIRST T1 LIST
C       T1B .............. SECOND T1 LIST
C       DISSYT, NUMSYT ... DIMENSIONING OF T2
C       POP1,VRT1 ........ POPULATION VECTORS FOR T1A
C       POP2, VRT2 ....... POPULATION VECTOR FOR T1B
C       IRREP ............ IRREP OF T2 LIST
C       FACT ............. MULTIPLICATION FACTOR FOR T1**2 CONTRIBUTION
C
C OUTPUT :
C       T2 ............... TAU ARRAY
CEND 
C
C CODED JULY/90 JG
C
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      LOGICAL LINCC,CICALC
      CHARACTER*4 ITYPE
      INTEGER POP1,POP2,VRT1,VRT2,DIRPRD,DISSYT
      DIMENSION T2(DISSYT,NUMSYT),T1A(1),T1B(1)
      DIMENSION POP1(8),POP2(8),VRT1(8),VRT2(8)
      DIMENSION IOFFTOV(8),IOFFT1A(8),
     &          IOFFT1B(8)
C
      COMMON /SYMINF/ NSTART,NIRREP,IRREPA(255),IRREPB(255),
     &                DIRPRD(8,8)
      COMMON /LINEAR/ LINCC,CICALC
C
      IF(LINCC)RETURN
C
      IF(ITYPE.EQ.'AAAA'.OR.ITYPE.EQ.'BBBB') THEN
C
C  GET FIRST OFFSETS OF T1 AND T2
C
       IOFFTOV(1)=0
       IOFFT1A(1)=0
       DO 101 IRREPI=1,NIRREP-1
        IRREPJ=DIRPRD(IRREPI,IRREP)
        IOFFTOV(IRREPI+1)=IOFFTOV(IRREPI)+POP1(IRREPI)*VRT1(IRREPJ)
        IOFFT1A(IRREPI+1)=IOFFT1A(IRREPI)+POP1(IRREPI)*VRT1(IRREPI)
101    CONTINUE
C
       INDBI=0
       DO 200 IRREPI=1,NIRREP

        NUMI=POP1(IRREPI)
        NUMA=VRT1(IRREPI)
C
        IRREPJ=DIRPRD(IRREP,IRREPI)
        NUMB=VRT1(IRREPJ)
        NUMJ=POP1(IRREPJ)
C
        IOFFT1=IOFFT1A(IRREPI)
        IOFFT2=IOFFT1A(IRREPJ)
        DO 210 I=1,NUMI
        DO 210 IB=1,NUMB
         INDBI=INDBI+1
         INDAJ=IOFFTOV(IRREPJ)
         DO 220 J=1,NUMJ
         INDBJ=IOFFT2+IB+(J-1)*NUMB 
         DO 220 IA=1,NUMA
          INDAI=IOFFT1+IA+(I-1)*NUMA
          INDAJ=INDAJ+1
          T2(INDAJ,INDBI)=T2(INDAJ,INDBI)+FACT*T1A(INDAI)*T1A(INDBJ)
220      CONTINUE
210     CONTINUE
200    CONTINUE
      ELSE IF(ITYPE.EQ.'AABB'.OR.ITYPE.EQ.'BBAA') THEN
C
       IF(IRREP.NE.1) RETURN
C
C  GET FIRST OFFSETS OF T1 AND T2
C
       IOFFTOV(1)=0
       IOFFT1A(1)=0
       IOFFT1B(1)=0
       DO 1101 IRREPJ=1,NIRREP-1
        IRREPI=DIRPRD(IRREPJ,IRREP)
        IOFFTOV(IRREPJ+1)=IOFFTOV(IRREPJ)+POP1(IRREPJ)*VRT1(IRREPI)
        IOFFT1A(IRREPJ+1)=IOFFT1A(IRREPJ)+POP1(IRREPJ)*VRT1(IRREPJ)
        IOFFT1B(IRREPJ+1)=IOFFT1B(IRREPJ)+POP2(IRREPJ)*VRT2(IRREPJ)
1101    CONTINUE
C
       INDBJ=0
       DO 1200 IRREPJ=1,NIRREP

        NUMJ=POP2(IRREPJ)
        NUMB=VRT2(IRREPJ)
C
        IOFFT2=IOFFT1B(IRREPJ)
C
        DO 1210 J=1,NUMJ
        DO 1210 IB=1,NUMB
         INDBJ=INDBJ+1
         IND1BJ=IOFFT2+IB+(J-1)*NUMB
         INDAI=0
         DO 1215 IRREPI=1,NIRREP 
         NUMA=VRT1(IRREPI)
         NUMI=POP1(IRREPI)
         IOFFT1=IOFFT1A(IRREPI)
         DO 1220 I=1,NUMI
         DO 1220 IA=1,NUMA
          IND1AI=IOFFT1+IA+(I-1)*NUMA
          INDAI=INDAI+1
          T2(INDAI,INDBJ)=T2(INDAI,INDBJ)+FACT*T1A(IND1AI)*T1B(IND1BJ)
1220      CONTINUE
1215     CONTINUE
1210     CONTINUE
1200    CONTINUE
       ELSE IF(ITYPE.EQ.'ABAB'.OR.ITYPE.EQ.'BABA') THEN
C
C  GET FIRST OFFSETS OF T1 AND T2
C
       IOFFTOV(1)=0
       IOFFT1A(1)=0
       IOFFT1B(1)=0
       DO 2101 IRREPJ=1,NIRREP-1
        IRREPI=DIRPRD(IRREPJ,IRREP)
        IOFFTOV(IRREPJ+1)=IOFFTOV(IRREPJ)+POP2(IRREPJ)*VRT1(IRREPI)
        IOFFT1A(IRREPJ+1)=IOFFT1A(IRREPJ)+POP1(IRREPJ)*VRT1(IRREPJ)
        IOFFT1B(IRREPJ+1)=IOFFT1B(IRREPJ)+POP2(IRREPJ)*VRT2(IRREPJ)
2101    CONTINUE
C
       INDBI=0
       DO 2200 IRREPI=1,NIRREP

        NUMI=POP1(IRREPI)
        NUMA=VRT1(IRREPI)
C
        IOFFT1=IOFFT1A(IRREPI)
        IRREPJ=DIRPRD(IRREP,IRREPI)
        IOFFT2=IOFFT1B(IRREPJ)
        NUMJ=POP2(IRREPJ)
        NUMB=VRT2(IRREPJ)
C
        DO 2210 I=1,NUMI
        DO 2210 IB=1,NUMB
         INDBI=INDBI+1
         INDAJ=IOFFTOV(IRREPJ)
         DO 2220 J=1,NUMJ
         INDBJ=IOFFT2+IB+(J-1)*NUMB
         DO 2220 IA=1,NUMA
          INDAI=IOFFT1+IA+(I-1)*NUMA
          INDAJ=INDAJ+1
          T2(INDAJ,INDBI)=T2(INDAJ,INDBI)+FACT*T1A(INDAI)*T1B(INDBJ)
2220      CONTINUE
2210     CONTINUE
2200    CONTINUE
       ENDIF
      RETURN
      END
