home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
fortran
/
library
/
ssp
/
matops
/
rsrt.for
< prev
next >
Wrap
Text File
|
1985-11-29
|
3KB
|
106 lines
C
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
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