      SUBROUTINE DOT24(IRREP,Z,Z1,W,BUF,DISSIZ,POPP,POPQ,
     &                 POP1,POP2,POP3,POP4,TYPE)
C
C THIS ROUTINE PERFORMS UNCOMPLICATED BUT MESSY CONTRACTIONS OF
C  THE GENERIC FORM
C
C      Z(P,Q) = Z1(M,N) * I(MP,NQ)  [TYPE='STST']
C      
C      Z(P,Q) = Z1(M,N) * I(PM,NQ)  [TYPE='TSST']
C
C      Z(P,Q) = Z1(M,N) * I(PM,QN)  [TYPE='TSTS']
C
C      Z(P,Q) = Z1(M,N) * I(MP,QN)  [TYPE='STTS']
C
C WHERE I IS ASSUMED TO BE ONE IRREP OF A SYMMETRY PACKED 
C  [GAMMA(MP)=GAMMA(NQ)] FOUR-INDEX QUANTITY AND Z1 AND Z
C  ARE TWO INDEX ARRAYS WHICH ARE SYMMETRY PACKED IN THE USUAL
C  MANNER.  THIS ROUTINE SHOULD BE USED FOR THESE CASES SINCE
C  THEY HAVE ONLY AN N**4 COMPUTATIONAL DEPENDENCE AND ALTERNATIVES
C  SUCH AS FANCYGET/FANCYPUT CALLS CANNOT BE JUSTIFIED.
C
C INPUT:
C       IRREP - THE IRREDUCIBLE REPRESENTATION TO WHICH THE FOUR-INDEX
C               LIST BELONGS.
C       Z     - THE TARGET VECTOR 
C       Z1    - THE TWO-INDEX QUANTITY WHICH WILL BE CONTRACTED WITH
C               THE FOUR-INDEX LIST.
C       W     - THE FOUR-INDEX QUANTITY
C       BUF   - A SCRATCH ARRAY WHICH HAS THE SAME LENGTH AS Z1.
C       DISSIZ- THE DISTRIBUTION SIZE OF THE FOUR-INDEX QUANTITY
C       POPP  - POPULATION VECTOR FOR P.
C       POPQ  - POPULATION VECTOR FOR Q.
C       POP1  - POPULATION VECTOR FOR FASTEST INDEX IN W.
C       POP2  - POPULATION VECTOR FOR SECOND FASTEST INDEX IN W.
C       POP3  - POPULATION VECTOR FOR THIRD FASTEST INDEX IN W.
C       POP4  - POPULATION VECTOR FOR SLOWEST INDEX IN W.
C       TYPE  - SPECIFIES THE ORDERING OF THE FOUR-INDEX INDICES
C               ON INPUT (CHARACTER*4).
C
CEND
      IMPLICIT INTEGER (A-Z)
      DOUBLE PRECISION W,Z,Z1,BUF,X,SDOT
      CHARACTER*4 TYPE
      DIMENSION W(1),Z(1),Z1(1),IOFFX(8),IOFFDS(8),IOFFDZ(8)
      DIMENSION POPP(NIRREP),POPQ(NIRREP),POP1(NIRREP),POP2(NIRREP)
      DIMENSION POP3(NIRREP),POP4(NIRREP),BUF(1)
      DIMENSION POPM(8),POPN(8),IOFFX1(8)
      COMMON /SYMINF/ NSTART,NIRREP,IRREPS(255,2),DIRPRD(8,8)
      COMMON /SYM/ POP(8,2),VRT(8,2),NT(2),NFMI(2),NFEA(2)
C
C COMPUTE OFFSETS INTO Z AND Z1 AND OFFSETS FOR INTEGRAL DISTRIBUTION
C  NUMBER AND DISTRIBUTION ELEMENTS
C
      IOFFX1(1)=1
      IOFFX(1)=1
      IOFFDS(1)=0
      IOFFDZ(1)=0
      DO 10 IRREPDO=1,NIRREP-1
       IOFFX(IRREPDO+1)=IOFFX(IRREPDO)+POPP(IRREPDO)*POPQ(IRREPDO)
C 
       IRREPX=DIRPRD(IRREPDO,IRREP)
       IOFFDS(IRREPDO+1)=IOFFDS(IRREPDO)+POP3(IRREPX)*POP4(IRREPDO)
       IOFFDZ(IRREPDO+1)=IOFFDZ(IRREPDO)+POP1(IRREPX)*POP2(IRREPDO)
10    CONTINUE
      IF(TYPE.EQ.'STST')THEN
       CALL ICOPY(NIRREP,POP1,1,POPM,1)
       CALL ICOPY(NIRREP,POP3,1,POPN,1)
       DO 301 IRRP=1,NIRREP-1
        IOFFX1(IRRP+1)=IOFFX1(IRRP)+POPM(IRRP)*POPN(IRRP)
301    CONTINUE
       DO 100 IRREPPQ=1,NIRREP
        IRREPMN=DIRPRD(IRREPPQ,IRREP)
        NUMM  =POPM(IRREPMN)
        NUMP  =POPP(IRREPPQ)
        NUMN  =POPN(IRREPMN)
        NUMQ  =POPQ(IRREPPQ)
        IOFFZ1=IOFFX1(IRREPMN)
        IOFFZ =IOFFX(IRREPPQ)-1
        ITHRU =0
        DO 110 Q=1,NUMQ
         IOFFR=IOFFDS(IRREPPQ)+1+(Q-1)*NUMN
         DO 120 P=1,NUMP
          IOFFL=IOFFDZ(IRREPPQ)+1+(P-1)*NUMM
          IOFFW=IOFFL+(IOFFR-1)*DISSIZ
          IOFFB =1
          ITHRU=ITHRU+1
C
C COLLECT ALL MN FROM THE I(MP,NQ) MATRIX INTO A SCRATCH VECTOR
C
          DO 130 N=1,NUMN
           CALL SCOPY(NUMM,W(IOFFW),1,BUF(IOFFB),1)
           IOFFW=IOFFW+DISSIZ
           IOFFB=IOFFB+NUMM
130       CONTINUE
          X=SDOT(NUMM*NUMN,BUF,1,Z1(IOFFZ1),1)
          Z(IOFFZ+ITHRU)=Z(IOFFZ+ITHRU)+X
120      CONTINUE
110     CONTINUE
100    CONTINUE
      ELSEIF(TYPE.EQ.'TSST')THEN
       CALL ICOPY(NIRREP,POP2,1,POPM,1)
       CALL ICOPY(NIRREP,POP3,1,POPN,1)
       DO 302 IRRP=1,NIRREP-1
        IOFFX1(IRRP+1)=IOFFX1(IRRP)+POPM(IRRP)*POPN(IRRP)
302    CONTINUE
       DO 200 IRREPPQ=1,NIRREP
        IRREPMN=DIRPRD(IRREPPQ,IRREP)
        NUMM  =POPM(IRREPMN)
        NUMP  =POPP(IRREPPQ)
        NUMN  =POPN(IRREPMN)
        NUMQ  =POPQ(IRREPPQ)
        IOFFZ1=IOFFX1(IRREPMN)
        IOFFZ =IOFFX(IRREPPQ)-1
        ITHRU =0
        DO 210 Q=1,NUMQ
         IOFFR=IOFFDS(IRREPPQ)+1+(Q-1)*NUMN
         DO 220 P=1,NUMP
          IOFFL=IOFFDZ(IRREPMN)+P
          IOFFW=IOFFL+(IOFFR-1)*DISSIZ
          IOFFB =1
          ITHRU=ITHRU+1
C
C COLLECT ALL MN FROM THE I(PM,NQ) MATRIX INTO A SCRATCH VECTOR
C
          DO 230 N=1,NUMN
           CALL SCOPY(NUMM,W(IOFFW),NUMP,BUF(IOFFB),1)
           IOFFW=IOFFW+DISSIZ
           IOFFB=IOFFB+NUMM
230       CONTINUE
          X=SDOT(NUMM*NUMN,BUF,1,Z1(IOFFZ1),1)
          Z(IOFFZ+ITHRU)=Z(IOFFZ+ITHRU)+X
220      CONTINUE
210     CONTINUE
200    CONTINUE
      ELSEIF(TYPE.EQ.'TSTS')THEN
       CALL ICOPY(NIRREP,POP2,1,POPM,1)
       CALL ICOPY(NIRREP,POP4,1,POPN,1)
       DO 303 IRRP=1,NIRREP-1
        IOFFX1(IRRP+1)=IOFFX1(IRRP)+POPM(IRRP)*POPN(IRRP)
303    CONTINUE
       DO 300 IRREPPQ=1,NIRREP
        IRREPMN=DIRPRD(IRREPPQ,IRREP)
        NUMM  =POPM(IRREPMN)
        NUMP  =POPP(IRREPPQ)
        NUMN  =POPN(IRREPMN)
        NUMQ  =POPQ(IRREPPQ)
        IOFFZ1=IOFFX1(IRREPMN)
        IOFFZ =IOFFX(IRREPPQ)-1
        ITHRU =0
        DO 310 Q=1,NUMQ
         IOFFR=IOFFDS(IRREPMN)+Q
         DO 320 P=1,NUMP
          IOFFL=IOFFDZ(IRREPMN)+P
          IOFFW=IOFFL+(IOFFR-1)*DISSIZ
          IOFFB =1
          ITHRU=ITHRU+1
C
C COLLECT ALL MN FROM THE I(PM,QN) MATRIX INTO A SCRATCH VECTOR
C
          DO 330 N=1,NUMN
           CALL SCOPY(NUMM,W(IOFFW),NUMP,BUF(IOFFB),1)
           IOFFW=IOFFW+DISSIZ*NUMQ
           IOFFB=IOFFB+NUMM
330       CONTINUE
          X=SDOT(NUMM*NUMN,BUF,1,Z1(IOFFZ1),1)
          Z(IOFFZ+ITHRU)=Z(IOFFZ+ITHRU)+X
320      CONTINUE
310     CONTINUE
300    CONTINUE
      ELSEIF(TYPE.EQ.'STTS')THEN
       CALL ICOPY(NIRREP,POP1,1,POPM,1)
       CALL ICOPY(NIRREP,POP4,1,POPN,1)
       DO 304 IRRP=1,NIRREP-1
        IOFFX1(IRRP+1)=IOFFX1(IRRP)+POPM(IRRP)*POPN(IRRP)
304    CONTINUE
       DO 400 IRREPPQ=1,NIRREP
        IRREPMN=DIRPRD(IRREPPQ,IRREP)
        NUMM  =POPM(IRREPMN)
        NUMP  =POPP(IRREPPQ)
        NUMN  =POPN(IRREPMN)
        NUMQ  =POPQ(IRREPPQ)
        IOFFZ1=IOFFX1(IRREPMN)
        IOFFZ =IOFFX(IRREPPQ)-1
        ITHRU =0
        IOFFB =1
        DO 410 Q=1,NUMQ
         IOFFR=IOFFDS(IRREPMN)+Q
         DO 420 P=1,NUMP
          IOFFL=IOFFDZ(IRREPPQ)+1+(P-1)*NUMM
          IOFFW=IOFFL+(IOFFR-1)*DISSIZ
          IOFFB =1
          ITHRU=ITHRU+1
C
C COLLECT ALL MN FROM THE I(MP,QN) MATRIX INTO A SCRATCH VECTOR
C
          DO 430 N=1,NUMN
           CALL SCOPY(NUMM,W(IOFFW),1,BUF(IOFFB),1)
           IOFFW=IOFFW+DISSIZ*NUMQ
           IOFFB=IOFFB+NUMM
430       CONTINUE
          X=SDOT(NUMM*NUMN,BUF,1,Z1(IOFFZ1),1)
          Z(IOFFZ+ITHRU)=Z(IOFFZ+ITHRU)+X
420      CONTINUE
410     CONTINUE
400    CONTINUE
      ENDIF
      RETURN
      END
