File: RSRT.FT of Tape: Various/ETH/eth11-1
(Source file text) 

C     ..................................................................
C
C        SUBROUTINE RSRT
C
C        PURPOSE
C           SORT ROWS OF A MATRIX
C
C        USAGE
C           CALL RSRT(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 AND LENGTH OF B
C           M - NUMBER OF COLUMNS IN A AND R
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           N MUST BE GREATER THAN ONE.
C	    M ALSO MUST BE AT LEAST TWO
C
C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
C           LOC
C
C        METHOD
C           ROWS OF INPUT MATRIX A ARE SORTED TO FORM OUTPUT MATRIX R.
C           THE SORTED ROW SEQUENCE IS DETERMINED BY THE VALUES OF
C           ELEMENTS IN COLUMN VECTOR B. THE LOWEST VALUED ELEMENT IN
C           B WILL CAUSE THE CORRESPONDING ROW OF A TO BE PLACED IN THE
C           FIRST ROW OF R. THE HIGHEST VALUED ELEMENT OF B WILL CAUSE
C           THE CORRESPONDING ROW OF A TO BE PLACED IN THE LAST ROW OF
C           R. IF DUPLICATE VALUES EXIST IN B, THE CORRESPONDING ROWS
C           OF A ARE MOVED TO R IN THE SAME ORDER AS IN A.
C
C     ..................................................................
C
      SUBROUTINE RSRT(A,B,R,N,M,MS)
      DIMENSION A(1),B(1),R(1)
C
C        MOVE SORTING KEY VECTOR TO FIRST COLUMN OF OUTPUT MATRIX
C        AND BUILD ORIGINAL SEQUENCE LIST IN SECOND COLUMN
C
      DO 10 I=1,N
      R(I)=B(I)
      I2=I+N
   10 R(I2)=I
C
C        SORT ELEMENTS IN SORTING KEY VECTOR (ORIGINAL SEQUENCE LIST
C        IS RESEQUENCED ACCORDINGLY)
C
      L=N+1
   20 ISORT=0
      L=L-1
      DO 40 I=2,L
      IF(R(I)-R(I-1)) 30,40,40
   30 ISORT=1
      RSAVE=R(I)
      R(I)=R(I-1)
      R(I-1)=RSAVE
      I2=I+N
      SAVER=R(I2)
      R(I2)=R(I2-1)
      R(I2-1)=SAVER
   40 CONTINUE
      IF(ISORT) 20,50,20
C
C        MOVE ROWS FROM MATRIX A TO MATRIX R (NUMBER IN SECOND COLUMN
C        OF R REPRESENTS ROW NUMBER OF MATRIX A TO BE MOVED)
C
   50 DO 80 I=1,N
C
C        GET ROW NUMBER IN MATRIX A
C
      I2=I+N
      IN=R(I2)
C
      IR=I-N
      DO 80 J=1,M
C
C        LOCATE ELEMENT IN OUTPUT MATRIX
C
      IR=IR+N
C
C        LOCATE ELEMENT IN INPUT MATRIX
C
      CALL LOC(IN,J,IA,N,M,MS)
C
C        TEST FOR ZERO ELEMENT IN DIAGONAL MATRIX
C
      IF(IA) 60,70,60
C
C        MOVE ELEMENT TO OUTPUT MATRIX
C
   60 R(IR)=A(IA)
      GO TO 80
   70 R(IR)=0
   80 CONTINUE
      RETURN
      END
C