      SUBROUTINE SYMTR3(IRREP,NUM1,NUM2,DIS,NUM,A,SCR1,SCR2,ISCR)
C
C THIS ROUTINE TRNSPOSES THE FIRT TWO INDICES OF A GIVEN MATRIX A
C
C  A(I,J,K,L) ----> A(J,I,K,L) 
C
C NOTE THAT THIS TRANSPOSITION IS CARRIED OUT HERE IN PLACE AND
C ONLY THREE ADDITIONAL ARRAYS OF SIZE NUM ARE REQUIRED
C
C INPUT : IRREP .......... IRREP OF THE GIVEN PAR OF A
C         NUM1 ........... POPULATION VECTOR OF I
C         NUM2 ........... POPULATION VECTOR OF J
C         DIS ............ DISTRIBUTION SIZE OF A
C         NUM ............ NUMBER OF DISTRIBUTIONS IN A
C         A .............. INPUT MATRIX A
C         SCR1,SCR2 ...... TWO SCRATCH ARRAYS OF DIMENSION NUM
C         ISCR ........... INTEGER SCRATCH ARRAY OF DIMENSION DIS
C
C  OUTPUT : A ............ TRANSPOSED MATRIX A
C 
CEND
C
C CODED JULY/90  JG
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      LOGICAL ICONT
      INTEGER DIS,DIRPRD
      DIMENSION A(DIS,NUM),SCR1(1),SCR2(1),ISCR(2),NUM1(8),NUM2(8)
      COMMON /SYMINF/NSTART,NIRREP,IRREPA(255),IRREPB(255),
     &DIRPRD(8,8)
      DIMENSION IPI(8),IPJ(8)
C
      IPI(1)=0
      IPJ(1)=0          
      DO 10 IRREPJ=1,NIRREP-1
       IRREPI=DIRPRD(IRREP,IRREPJ)
       IPJ(IRREPJ+1)=IPJ(IRREPJ)+NUM2(IRREPJ)*NUM1(IRREPI)
       IPI(IRREPJ+1)=IPI(IRREPJ)+NUM1(IRREPJ)*NUM2(IRREPI)
10    CONTINUE
       
C
C  GET FIRST THE NEW ADDRESSES AND STORE THEM IN ISCR
C
      NTOTAL=0
      DO 20  IRREPJ=1,NIRREP
       NUMJ=NUM2(IRREPJ)
       IRREPI=DIRPRD(IRREP,IRREPJ)
       NUMI=NUM1(IRREPI)
        NTOTAL=NTOTAL+NUMI*NUMJ
        DO 15 J=1,NUMJ
        DO 15 I=1,NUMI
         IND1=IPJ(IRREPJ)+(J-1)*NUMI+I
         IND2=IPI(IRREPI)+(I-1)*NUMJ+J
         ISCR(IND1)=IND2
15      CONTINUE
20      CONTINUE
C
C  NOW TRANSPOSE
C
      DO 100 IJ=1,NTOTAL
       IF(ISCR(IJ).EQ.0) GO TO 100
       INDNEW2=IJ
       DO 2 L=1,NUM
        SCR1(L)=A(IJ,L)    
2      CONTINUE
1      CONTINUE
       INDOLD1=INDNEW2
       INDNEW1=ISCR(INDOLD1) 
       ISCR(INDOLD1)=0
       ICONT=.FALSE.  
       IF(ISCR(INDNEW1).NE.0) THEN
        DO 3 L=1,NUM
         SCR2(L)=A(INDNEW1,L)
3       CONTINUE
        ICONT=.TRUE.
       ENDIF
       DO 4 L=1,NUM
        A(INDNEW1,L)=SCR1(L)
4      CONTINUE
       IF(.NOT.ICONT) GO TO 100
       INDOLD2=INDNEW1
       INDNEW2=ISCR(INDOLD2)
       ISCR(INDOLD2)=0
       ICONT=.FALSE. 
       IF(ISCR(INDNEW2).NE.0) THEN
        DO 5 L=1,NUM
         SCR1(L)=A(INDNEW2,L)
5       CONTINUE
        ICONT=.TRUE.
       ENDIF
       DO 6 L=1,NUM
        A(INDNEW2,L)=SCR2(L)
6      CONTINUE
       IF(ICONT) GO TO 1
100   CONTINUE
      RETURN
      END
