home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Frostbyte's 1980s DOS Shareware Collection
/
floppyshareware.zip
/
floppyshareware
/
DOOG
/
PCSSP2.ZIP
/
MATOPS.ZIP
/
CSRT.FOR
< prev
next >
Wrap
Text File
|
1985-11-29
|
3KB
|
98 lines
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