C
C     ..................................................................
C
C        SUBROUTINE CSRT
C
C        PURPOSE
C           SORT COLUMNS OF A MATRIX
C
C        USAGE
C           CALL CSRT(A,B,R,N,M,MS)
C
C        DESCRIPTION OF PARAMETERS
C           A - NAME OF INPUT MATRIX TO BE SORTED
C           B - NAME OF INPUT VECTOR WHICH CONTAINS SORTING KEY
C           R - NAME OF SORTED OUTPUT MATRIX
C           N - NUMBER OF ROWS IN A AND R
C           M - NUMBER OF COLUMNS IN A AND R AND LENGTH OF B
C           MS  - ONE DIGIT NUMBER FOR STORAGE MODE OF MATRIX A
C                  0 - GENERAL
C                  1 - SYMMETRIC
C                  2 - DIAGONAL
C
C        REMARKS
C           MATRIX R CANNOT BE IN THE SAME LOCATION AS MATRIX A
C           MATRIX R IS ALWAYS A GENERAL MATRIX
C           M MUST BE GREATER THAN ONE.
C
C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
C           LOC
C           CCPY
C
C        METHOD
C           COLUMNS OF INPUT MATRIX A ARE SORTED TO FORM OUTPUT MATRIX
C           R. THE SORTED COLUMN SEQUENCE IS DETERMINED BY THE VALUES OF
C           ELEMENTS IN ROW VECTOR B. THE LOWEST VALUED ELEMENT IN
C           B WILL CAUSE THE CORRESPONDING COLUMN OF A TO BE PLACED IN
C           THE FIRST COLUMN OF R. THE HIGHEST VALUED ELEMENT OF B WILL
C           CAUSE THE CORRESPONDING ROW OF A TO BE PLACED IN THE LAST
C           COLUMN OF R. IF DUPLICATE VALUES EXIST IN B, THE
C           CORRESPONDING COLUMNS OF A ARE MOVED TO R IN THE SAME ORDER
C           AS IN A.
C
C     ..................................................................
C
      SUBROUTINE CSRT(A,B,R,N,M,MS)
      DIMENSION A(1),B(1),R(1)
C
C        MOVE SORTING KEY VECTOR TO FIRST ROW OF OUTPUT MATRIX
C        AND BUILD ORIGINAL SEQUENCE LIST IN SECOND ROW
C
      IK=1
      DO 10 J=1,M
      R(IK)=B(J)
      R(IK+1)=J
   10 IK=IK+N
C
C        SORT ELEMENTS IN SORTING KEY VECTOR (ORIGINAL SEQUENCE LIST
C        IS RESEQUENCED ACCORDINGLY)
C
      L=M+1
   20 ISORT=0
      L=L-1
      IP=1
      IQ=N+1
      DO 50 J=2,L
      IF(R(IQ)-R(IP)) 30,40,40
   30 ISORT=1
      RSAVE=R(IQ)
      R(IQ)=R(IP)
      R(IP)=RSAVE
      SAVER=R(IQ+1)
      R(IQ+1)=R(IP+1)
      R(IP+1)=SAVER
   40 IP=IP+N
      IQ=IQ+N
   50 CONTINUE
      IF(ISORT) 20,60,20
C
C        MOVE COLUMNS FROM MATRIX A TO MATRIX R (NUMBER IN SECOND ROW
C        OF R REPRESENTS COLUMN NUMBER OF MATRIX A TO BE MOVED)
C
   60 IQ=-N
      DO 70 J=1,M
      IQ=IQ+N
C
C        GET COLUMN NUMBER IN MATRIX A
C
      I2=IQ+2
      IN=R(I2)
C
C        MOVE COLUMN
C
      IR=IQ+1
      CALL CCPY(A,IN,R(IR),N,M,MS)
   70 CONTINUE
      RETURN
      END