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