home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / fortran / library / ssp / matops / mprc.for < prev    next >
Encoding:
Text File  |  1985-11-29  |  3.5 KB  |  119 lines
  1. C
  2. C     ..................................................................
  3. C
  4. C        SUBROUTINE MPRC
  5. C
  6. C        PURPOSE
  7. C           TO PERMUTE THE ROWS OR COLUMNS OF A GIVEN MATRIX ACCORDING
  8. C           TO A GIVEN TRANSPOSITION VECTOR OR ITS INVERSE.  (SEE THE
  9. C           DISCUSSION ON PERMUTATIONS FOR DEFINITIONS AND NOTATION.)
  10. C
  11. C        USAGE
  12. C           CALL MPRC(A,M,N,ITRA,INV,IROCO,IER)
  13. C
  14. C        DESCRIPTION OF PARAMETERS
  15. C           A     - GIVEN M BY N MATRIX AND RESULTING PERMUTED MATRIX
  16. C           M     - NUMBER OF ROWS OF A
  17. C           N     - NUMBER OF COLUMNS OF A
  18. C           ITRA  - GIVEN TRANSPOSITION VECTOR (DIMENSION M IF ROWS ARE
  19. C                   PERMUTED, N IF COLUMNS ARE PERMUTED)
  20. C           INV   - INPUT PARAMETER
  21. C                   INV NON-ZERO  -  PERMUTE ACCORDING TO ITRA
  22. C                   INV    =   0  -  PERMUTE ACCORDING TO ITRA INVERSE
  23. C           IROCO - INPUT PARAMETER
  24. C                   IROCO NON-ZERO  -  PERMUTE THE COLUMNS OF A
  25. C                   IROCO    =   0  -  PERMUTE THE ROWS OF A
  26. C           IER   - RESULTING ERROR PARAMETER
  27. C                   IER = -1  -  M AND N ARE NOT BOTH POSITIVE
  28. C                   IER =  0  -  NO ERROR
  29. C                   IER =  1  -  ITRA IS NOT A TRANSPOSITION VECTOR ON
  30. C                                1,...,M IF ROWS ARE PERMUTED, 1,...,N
  31. C                                IF COLUMNS ARE PERMUTED
  32. C
  33. C        REMARKS
  34. C           (1)  IF IER=-1 THERE IS NO COMPUTATION.
  35. C           (2)  IF IER= 1, THEN COMPUTATION HAS BEEN UNSUCCESSFUL DUE
  36. C                TO ERROR, BUT THE MATRIX A WILL REFLECT THE ROW OR
  37. C                COLUMN INTERCHANGES PERFORMED BEFORE THE ERROR WAS
  38. C                DETECTED.
  39. C           (3)  THE MATRIX A IS ASSUMED TO BE STORED COLUMNWISE.
  40. C
  41. C        SUBROUTINES AND SUBPROGRAMS REQUIRED
  42. C           NONE
  43. C
  44. C        METHOD
  45. C           THE ROWS OR COLUMNS ARE PERMUTED ELEMENTWISE, INTERCHANGING
  46. C           ROW OR COLUMN 1 AND ITRA(1),...,ROW OR COLUMN K AND ITRA(K)
  47. C           IN THAT ORDER IF INV=0, AND OTHERWISE INTERCHANGING ROW OR
  48. C           COLUMN K AND ITRA(K),...,ROW OR COLUMN 1 AND ITRA(1), WHERE
  49. C           K IS M OR N DEPENDING ON WHETHER WE PERMUTE ROWS OR COLUMNS.
  50. C
  51. C     ..................................................................
  52. C
  53.       SUBROUTINE MPRC(A,M,N,ITRA,INV,IROCO,IER)
  54. C
  55. C
  56.       DIMENSION A(1),ITRA(1)
  57. C
  58. C        TEST OF DIMENSIONS
  59.       IF(M)14,14,1
  60.     1 IF(N)14,14,2
  61. C
  62. C        DETERMINE WHICH ARE TO BE PERMUTED-THE ROWS OR THE COLUMNS
  63.     2 IF(IROCO)3,4,3
  64. C
  65. C        INITIALIZE FOR COLUMN INTERCHANGES
  66.     3 MM=M
  67.       MMM=-1
  68.       L=M
  69.       LL=N
  70.       GO TO 5
  71. C
  72. C        INITIALIZE FOR ROW INTERCHANGES
  73.     4 MM=1
  74.       MMM=M
  75.       L=N
  76.       LL=M
  77. C
  78. C        INITIALIZE LOOP OVER ALL ROWS OR COLUMNS
  79.     5 IA=1
  80.       ID=1
  81. C
  82. C        TEST FOR INVERSE OPERATION
  83.       IF(INV)6,7,6
  84.     6 IA=LL
  85.       ID=-1
  86.     7 DO 12 I=1,LL
  87.       K=ITRA(IA)
  88.       IF(K-IA)8,12,9
  89.     8 IF(K)13,13,10
  90.     9 IF(LL-K)13,10,10
  91. C
  92. C        INITIALIZE ROW OR COLUMN INTERCHANGE
  93.    10 IL=IA*MM
  94.       K=K*MM
  95. C
  96. C        PERFORM ROW OR COLUMN INTERCHANGE
  97.       DO 11 J=1,L
  98.       SAVE=A(IL)
  99.       A(IL)=A(K)
  100.       A(K)=SAVE
  101.       K=K+MMM
  102.    11 IL=IL+MMM
  103. C
  104. C        ADDRESS NEXT INTERCHANGE STEP
  105.    12 IA=IA+ID
  106. C
  107. C        NORMAL EXIT
  108.       IER=0
  109.       RETURN
  110. C
  111. C        ERROR RETURN IN CASE ITRA IS NOT A TRANSPOSITION VECTOR
  112.    13 IER=1
  113.       RETURN
  114. C
  115. C        ERROR RETURN IN CASE OF ILLEGAL DIMENSIONS
  116.    14 IER=-1
  117.       RETURN
  118.       END
  119.