home *** CD-ROM | disk | FTP | other *** search
/ Frostbyte's 1980s DOS Shareware Collection / floppyshareware.zip / floppyshareware / DOOG / PCSSP2.ZIP / MATOPS.ZIP / RSRT.FOR < prev    next >
Text File  |  1985-11-29  |  3KB  |  106 lines
  1. C
  2. C     ..................................................................
  3. C
  4. C        SUBROUTINE RSRT
  5. C
  6. C        PURPOSE
  7. C           SORT ROWS OF A MATRIX
  8. C
  9. C        USAGE
  10. C           CALL RSRT(A,B,R,N,M,MS)
  11. C
  12. C        DESCRIPTION OF PARAMETERS
  13. C           A - NAME OF INPUT MATRIX TO BE SORTED
  14. C           B - NAME OF INPUT VECTOR WHICH CONTAINS SORTING KEY
  15. C           R - NAME OF SORTED OUTPUT MATRIX
  16. C           N - NUMBER OF ROWS IN A AND R AND LENGTH OF B
  17. C           M - NUMBER OF COLUMNS IN A AND R
  18. C           MS  - ONE DIGIT NUMBER FOR STORAGE MODE OF MATRIX A
  19. C                  0 - GENERAL
  20. C                  1 - SYMMETRIC
  21. C                  2 - DIAGONAL
  22. C
  23. C        REMARKS
  24. C           MATRIX R CANNOT BE IN THE SAME LOCATION AS MATRIX A
  25. C           MATRIX R IS ALWAYS A GENERAL MATRIX
  26. C           N MUST BE GREATER THAN ONE.
  27. C
  28. C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
  29. C           LOC
  30. C
  31. C        METHOD
  32. C           ROWS OF INPUT MATRIX A ARE SORTED TO FORM OUTPUT MATRIX R.
  33. C           THE SORTED ROW SEQUENCE IS DETERMINED BY THE VALUES OF
  34. C           ELEMENTS IN COLUMN VECTOR B. THE LOWEST VALUED ELEMENT IN
  35. C           B WILL CAUSE THE CORRESPONDING ROW OF A TO BE PLACED IN THE
  36. C           FIRST ROW OF R. THE HIGHEST VALUED ELEMENT OF B WILL CAUSE
  37. C           THE CORRESPONDING ROW OF A TO BE PLACED IN THE LAST ROW OF
  38. C           R. IF DUPLICATE VALUES EXIST IN B, THE CORRESPONDING ROWS
  39. C           OF A ARE MOVED TO R IN THE SAME ORDER AS IN A.
  40. C
  41. C     ..................................................................
  42. C
  43.       SUBROUTINE RSRT(A,B,R,N,M,MS)
  44.       DIMENSION A(1),B(1),R(1)
  45. C
  46. C        MOVE SORTING KEY VECTOR TO FIRST COLUMN OF OUTPUT MATRIX
  47. C        AND BUILD ORIGINAL SEQUENCE LIST IN SECOND COLUMN
  48. C
  49.       DO 10 I=1,N
  50.       R(I)=B(I)
  51.       I2=I+N
  52.    10 R(I2)=I
  53. C
  54. C        SORT ELEMENTS IN SORTING KEY VECTOR (ORIGINAL SEQUENCE LIST
  55. C        IS RESEQUENCED ACCORDINGLY)
  56. C
  57.       L=N+1
  58.    20 ISORT=0
  59.       L=L-1
  60.       DO 40 I=2,L
  61.       IF(R(I)-R(I-1)) 30,40,40
  62.    30 ISORT=1
  63.       RSAVE=R(I)
  64.       R(I)=R(I-1)
  65.       R(I-1)=RSAVE
  66.       I2=I+N
  67.       SAVER=R(I2)
  68.       R(I2)=R(I2-1)
  69.       R(I2-1)=SAVER
  70.    40 CONTINUE
  71.       IF(ISORT) 20,50,20
  72. C
  73. C        MOVE ROWS FROM MATRIX A TO MATRIX R (NUMBER IN SECOND COLUMN
  74. C        OF R REPRESENTS ROW NUMBER OF MATRIX A TO BE MOVED)
  75. C
  76.    50 DO 80 I=1,N
  77. C
  78. C        GET ROW NUMBER IN MATRIX A
  79. C
  80.       I2=I+N
  81.       IN=R(I2)
  82. C
  83.       IR=I-N
  84.       DO 80 J=1,M
  85. C
  86. C        LOCATE ELEMENT IN OUTPUT MATRIX
  87. C
  88.       IR=IR+N
  89. C
  90. C        LOCATE ELEMENT IN INPUT MATRIX
  91. C
  92.       CALL LOC(IN,J,IA,N,M,MS)
  93. C
  94. C        TEST FOR ZERO ELEMENT IN DIAGONAL MATRIX
  95. C
  96.       IF(IA) 60,70,60
  97. C
  98. C        MOVE ELEMENT TO OUTPUT MATRIX
  99. C
  100.    60 R(IR)=A(IA)
  101.       GO TO 80
  102.    70 R(IR)=0
  103.    80 CONTINUE
  104.       RETURN
  105.       END
  106.