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