      SUBROUTINE TRNLST(IRREP,LISTG,DISSYG,SCR,MAXSIZE)
C
C   THIS ROUTINE TRANSPOSES A SQUARE LIST A(N,N)
C
C       A(I,J) --> A(J,I)
C
C   AND WRITES IT BACK TO DISK IN PLACE.  THIS VERSION HANDLES
C   BOTH IN-CORE AND OUT-OF-CORE TRANSPOSITIONS, AND IS JUST
C   A HACKED-UP SYMMET3.
C
CEND
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      INTEGER DISSYG,DISLEFT,DISREAD
      DIMENSION SCR(MAXSIZE)
C
      DATA HALF /0.5D0/
C
C  CHECK IF THE LIST FITS INTO THE AVAILABLE CORE MEMORY
C
      IF(MAXSIZE.GE.DISSYG*DISSYG) THEN
C
C   DO IT IN CORE BY USING MTRAN2
C
       CALL GETLST(SCR,1,DISSYG,1,IRREP,LISTG)
       CALL MTRAN2(SCR,DISSYG) 
       CALL PUTLST(SCR,1,DISSYG,1,IRREP,LISTG)
C
      ELSE
C
C  WE HAVE TO DO IT OUT OF CORE
C
C  DETERMINE MAXIMUM NUMBER OF DISTRIBUTIONS WHICH CAN BE HELD IN
C  CORE
C
       MAXDIS=MAXSIZE/DISSYG
C
C  HOWEVER, ONE DISTRIBUTION IS REQUIRED AS BUFFER, SO SUBTRACT ONE
C
       MAXDIS=MAXDIS-1
       IF(MAXDIS.LE.0)THEN
        WRITE(6,1000)2*DISSYG
1000    FORMAT(T3,'@TRNLST-F, Less than ',I10,' words available for ',
     &        'transposition')
        CALL ERREX
       ENDIF
C
C  COMPUTE OFFSET FOR BUFFER
C
       IBUF=1+MAXDIS*DISSYG
C
C  SET THE NUMBER OF DISTRIBUTIONS WHICH MUST BE TREATED
C
       DISREAD=DISSYG
C
C  SET THE NUMBER oF DISTRIBUTIONS LEFT ON DISK
C
       DISLEFT=DISSYG
C
C  SET OFFSET FOR LIST LISTG 
C 
       IOFFSET=1
       IPASS=0
       IREAD=0
C
10     CONTINUE
       IPASS=IPASS+1
       IREAD=IREAD+DISSYG-IOFFSET+1
C
C  DETERMINE THE NUMBER OF DISTRIBUTIONS PROCESSED DURING THIS
C  PATH
C
        DISREAD=MIN(DISLEFT,MAXDIS)
        DISLEFT=DISLEFT-DISREAD
C 
C READ IN THE DISTRIBUTIONS WHICH ARE UPDATED
C
        CALL GETLST(SCR,IOFFSET,DISREAD,1,IRREP,LISTG)
C
C SET IFIRST (FIRST DISTRIBUTION IN CORE)
C
        IFIRST=IOFFSET
C
C UPDATE IOFFSET
C
        IOFFSET=IOFFSET+DISREAD
C
C SET ILAST (LAST DISTRIBUTION IN CORE)
C
        ILAST=IOFFSET-1
C
C  WE HAVE NOW THREE DIFFERENT CATEGORIES OF DISTRIBUTIONS
C
C   1)  THE DISTRIBUTIONS IN MEMORY
C   2)  THE DISTRIBUTIONS ON DISK WHICH ARE ALREADY THE TRANSPOSE OF THE
C       ORIGINAL MATRIX
C   3)  THE DISTRBIBUTIONS ON DISK WHICH ARE STILL NOT THE TRANSPOSE OF
C       THE ORIGINAL MATRIX
C
C
C  DO THE FOLLOWING TWO-STEP PROCEDURE.  FIRST DO AN IN-PLACE TRANSPOSITION 
C   OF THE ELEMENTS FOR WHICH BOTH A(I,J) AND A(J,I) ARE CURRENTLY
C   IN MEMORY.
C
        CALL MTRAN3(SCR(IFIRST),DISSYG,DISREAD)
C
C   NOW LOOP OVER THE REMAINING DISTRIBUTIONS.
C
        DO 100 IDIS=IOFFSET,DISSYG
         CALL GETLST(SCR(IBUF),IDIS,1,1,IRREP,LISTG)
C
C  NOW PUT A(I,J) [I<J] [IN MAIN CORE VECTOR] INTO A(J,I) [IN BUFFER]
C
CDIR$ IVDEP
*VOCL LOOP,NOVREC
         DO 150 IPOS=IFIRST,ILAST
          X=SCR(IBUF+IPOS-1)
          SCR(IBUF+IPOS-1)=SCR(IDIS+(IPOS-IFIRST)*DISSYG)
          SCR(IDIS+(IPOS-IFIRST)*DISSYG)=X
150      CONTINUE
C
C  WRITE THE DISTRIBUTION IN THE BUFFER BACK TO DISK
C
         CALL PUTLST(SCR(IBUF),IDIS,1,1,IRREP,LISTG)
C
100     CONTINUE
C
C SAVE THE TRANSPOSED MAIN CORE AREA ON DISK
C
        CALL PUTLST(SCR,IFIRST,DISREAD,1,IRREP,LISTG)
C
C  IF NOT ALL DISTRIBUTIONS HAVE BEEN PROCESSED, GO BACK TO 10 
C
       IF(DISLEFT.NE.0) GO TO 10
C
C  ALL DONE, RETURN
C
      WRITE(6,2000)IPASS,IREAD
2000  FORMAT(T3,'@TRNLST-I, Transpostion required ',I5,' passes and ',
     &       I10,' reads.')
      ENDIF
      RETURN
      END
