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 >
Encoding:
Text File  |  1985-11-29  |  2.7 KB  |  98 lines
  1. C
  2. C     ..................................................................
  3. C
  4. C        SUBROUTINE CSRT
  5. C
  6. C        PURPOSE
  7. C           SORT COLUMNS OF A MATRIX
  8. C
  9. C        USAGE
  10. C           CALL CSRT(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
  17. C           M - NUMBER OF COLUMNS IN A AND R AND LENGTH OF B
  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           M MUST BE GREATER THAN ONE.
  27. C
  28. C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
  29. C           LOC
  30. C           CCPY
  31. C
  32. C        METHOD
  33. C           COLUMNS OF INPUT MATRIX A ARE SORTED TO FORM OUTPUT MATRIX
  34. C           R. THE SORTED COLUMN SEQUENCE IS DETERMINED BY THE VALUES OF
  35. C           ELEMENTS IN ROW VECTOR B. THE LOWEST VALUED ELEMENT IN
  36. C           B WILL CAUSE THE CORRESPONDING COLUMN OF A TO BE PLACED IN
  37. C           THE FIRST COLUMN OF R. THE HIGHEST VALUED ELEMENT OF B WILL
  38. C           CAUSE THE CORRESPONDING ROW OF A TO BE PLACED IN THE LAST
  39. C           COLUMN OF R. IF DUPLICATE VALUES EXIST IN B, THE
  40. C           CORRESPONDING COLUMNS OF A ARE MOVED TO R IN THE SAME ORDER
  41. C           AS IN A.
  42. C
  43. C     ..................................................................
  44. C
  45.       SUBROUTINE CSRT(A,B,R,N,M,MS)
  46.       DIMENSION A(1),B(1),R(1)
  47. C
  48. C        MOVE SORTING KEY VECTOR TO FIRST ROW OF OUTPUT MATRIX
  49. C        AND BUILD ORIGINAL SEQUENCE LIST IN SECOND ROW
  50. C
  51.       IK=1
  52.       DO 10 J=1,M
  53.       R(IK)=B(J)
  54.       R(IK+1)=J
  55.    10 IK=IK+N
  56. C
  57. C        SORT ELEMENTS IN SORTING KEY VECTOR (ORIGINAL SEQUENCE LIST
  58. C        IS RESEQUENCED ACCORDINGLY)
  59. C
  60.       L=M+1
  61.    20 ISORT=0
  62.       L=L-1
  63.       IP=1
  64.       IQ=N+1
  65.       DO 50 J=2,L
  66.       IF(R(IQ)-R(IP)) 30,40,40
  67.    30 ISORT=1
  68.       RSAVE=R(IQ)
  69.       R(IQ)=R(IP)
  70.       R(IP)=RSAVE
  71.       SAVER=R(IQ+1)
  72.       R(IQ+1)=R(IP+1)
  73.       R(IP+1)=SAVER
  74.    40 IP=IP+N
  75.       IQ=IQ+N
  76.    50 CONTINUE
  77.       IF(ISORT) 20,60,20
  78. C
  79. C        MOVE COLUMNS FROM MATRIX A TO MATRIX R (NUMBER IN SECOND ROW
  80. C        OF R REPRESENTS COLUMN NUMBER OF MATRIX A TO BE MOVED)
  81. C
  82.    60 IQ=-N
  83.       DO 70 J=1,M
  84.       IQ=IQ+N
  85. C
  86. C        GET COLUMN NUMBER IN MATRIX A
  87. C
  88.       I2=IQ+2
  89.       IN=R(I2)
  90. C
  91. C        MOVE COLUMN
  92. C
  93.       IR=IQ+1
  94.       CALL CCPY(A,IN,R(IR),N,M,MS)
  95.    70 CONTINUE
  96.       RETURN
  97.       END
  98.