home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / fortran / library / ssp / permut / perm.for next >
Encoding:
Text File  |  1985-11-29  |  4.4 KB  |  129 lines
  1. C
  2. C     ..................................................................
  3. C
  4. C        SUBROUTINE PERM
  5. C
  6. C        PURPOSE
  7. C           TO COMPUTE THE PERMUTATION VECTOR THAT IS INVERSE TO A GIVEN
  8. C           PERMUTATION VECTOR, THE PERMUTATION VECTOR THAT IS EQUIVA-
  9. C           LENT TO A GIVEN TRANSPOSITION VECTOR AND A TRANSPOSITION
  10. C           VECTOR THAT IS EQUIVALENT TO A GIVEN PERMUTATION VECTOR.
  11. C           (SEE THE GENERAL DISCUSSION FOR DEFINITIONS AND NOTATION.)
  12. C
  13. C        USAGE
  14. C           CALL PERM(IP1,IP2,N,IPAR,IER)
  15. C
  16. C        DESCRIPTION OF PARAMETERS
  17. C           IP1  - GIVEN PERMUTATION OR TRANSPOSITION VECTOR
  18. C                  (DIMENSION N)
  19. C           IP2  - RESULTING PERMUTATION OR TRANSPOSITION VECTOR
  20. C                  (DIMENSION N)
  21. C           N    - DIMENSION OF VECTORS IP1 AND IP2
  22. C           IPAR - INPUT PARAMETER
  23. C                  IPAR NEGATIVE - COMPUTE THE PERMUTATION VECTOR IP2
  24. C                                  THAT IS THE INVERSE OF THE PERMUTA-
  25. C                                  TION VECTOR IP1
  26. C                  IPAR  =  ZERO - COMPUTE THE PERMUTATION VECTOR IP2
  27. C                                  THAT IS EQUIVALENT TO THE TRANSPOSI-
  28. C                                  TION VECTOR IP1
  29. C                  IPAR POSITIVE - COMPUTE A TRANSPOSITION VECTOR IP2
  30. C                                  THAT IS EQUIVALENT TO THE PERMUTATION
  31. C                                  VECTOR IP1
  32. C           IER  - RESULTING ERROR PARAMETER
  33. C                  IER=-1  -  N IS NOT POSITIVE
  34. C                  IER= 0  -  NO ERROR
  35. C                  IER= 1  -  IP1 IS EITHER NOT A PERMUTATION VECTOR OR
  36. C                             NOT A TRANSPOSITION VECTOR ON 1,...,N,
  37. C                             DEPENDING ON WHETHER IPAR IS NON-ZERO OR
  38. C                             ZERO, RESPECTIVELY
  39. C
  40. C        REMARKS
  41. C           (1)  IF IER=-1 THERE HAS BEEN NO COMPUTATION.
  42. C           (2)  IF IER=1, THEN COMPUTATION HAS BEEN UNSUCCESSFUL DUE TO
  43. C                ERROR AND THE PARTIAL RESULTS FOUND IN IP2 ARE USELESS.
  44. C           (3)  IP2 CANNOT HAVE THE SAME STORAGE ALLOCATION AS IP1.
  45. C
  46. C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
  47. C           NONE
  48. C
  49. C        METHOD
  50. C           (1)  IPAR NEGATIVE - FOR EACH I, I=1,...,N, IP2(IP1(I)) IS
  51. C                                SET TO I.
  52. C           (2)  IPAR  =  ZERO - INITIALLY IP2(I) IS SET TO I FOR
  53. C                                I=1,...,N.  THEN, FOR I=1,...,N IN THAT
  54. C                                ORDER, IP2(I) AND IP2(IP1(I)) ARE
  55. C                                INTERCHANGED.
  56. C           (3)  IPAR POSITIVE - INITIALLY IP1 IS MOVED TO IP2.  THEN
  57. C                                THE FOLLOWING TWO STEPS ARE REPEATED
  58. C                                FOR I SUCCESSIVELY EQUAL TO 1,...,N.
  59. C                                (A) FIND THE SMALLEST J GREATER THAN OR
  60. C                                    EQUAL TO I SUCH THAT IP2(J)=I.
  61. C                                (B) SET IP2(J) TO IP2(I).
  62. C
  63. C     ..................................................................
  64. C
  65.       SUBROUTINE PERM(IP1,IP2,N,IPAR,IER)
  66. C
  67. C
  68.       DIMENSION IP1(1),IP2(1)
  69. C
  70. C        TEST DIMENSION
  71.       IF(N)19,19,1
  72. C
  73. C        TEST IPAR TO DETERMINE WHETHER IP1 IS TO BE INTERPRETED AS
  74. C        A PERMUTATION VECTOR OR AS A TRANSPOSITION VECTOR
  75.     1 IF(IPAR)2,13,2
  76. C
  77. C        CHECK THAT IP1 IS A PERMUTATION VECTOR AND COMPUTE IP1 INVERSE
  78.     2 DO 3 I=1,N
  79.     3 IP2(I)=0
  80.       DO 6 I=1,N
  81.       K=IP1(I)
  82.       IF(K-N)4,5,20
  83.     4 IF(K)20,20,5
  84.     5 IF(IP2(K))20,6,20
  85.     6 IP2(K)=I
  86. C
  87. C        TEST IPAR FOR THE DESIRED OPERATION
  88.       IF(IPAR)12,7,7
  89. C
  90. C        COMPUTE TRANSPOSITION VECTOR IP2 FOR PERMUTATION VECTOR IP1
  91.     7 DO 8 I=1,N
  92.     8 IP2(I)=IP1(I)
  93.       NN=N-1
  94.       IF(NN)12,12,9
  95.     9 DO 11 I=1,NN
  96.       DO 10 J=1,NN
  97.       IF(IP2(J)-I)10,11,10
  98.    10 CONTINUE
  99.       J=N
  100.    11 IP2(J)=IP2(I)
  101. C
  102. C        NORMAL RETURN - NO ERROR
  103.    12 IER=0
  104.       RETURN
  105. C
  106. C        COMPUTE PERMUTATION VECTOR IP2 FOR TRANSPOSITION VECTOR IP1
  107.    13 DO 14 I=1,N
  108.    14 IP2(I)=I
  109.       DO 18 I=1,N
  110.       K=IP1(I)
  111.       IF(K-I)15,18,16
  112.    15 IF(K)20,20,17
  113.    16 IF(N-K)20,17,17
  114.    17 J=IP2(I)
  115.       IP2(I)=IP2(K)
  116.       IP2(K)=J
  117.    18 CONTINUE
  118.       GO TO 12
  119. C
  120. C        ERROR RETURN - N IS NOT POSITIVE
  121.    19 IER=-1
  122.       RETURN
  123. C
  124. C        ERROR RETURN - IP1 IS EITHER NOT A PERMUTATION VECTOR
  125. C                       OR NOT A TRANSPOSITION VECTOR
  126.    20 IER=1
  127.       RETURN
  128.       END
  129.