home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / fortran / library / ssp / permut / pprcn.for < prev   
Encoding:
Text File  |  1985-11-29  |  2.7 KB  |  81 lines
  1. C
  2. C     ..................................................................
  3. C
  4. C        SUBROUTINE PPRCN
  5. C
  6. C        PURPOSE
  7. C           TO COMPUTE, GIVEN TWO PERMUTATION VECTORS IP1 AND IP2, THE
  8. C           COMPOSITION IP2(IP1) AND THE CONJUGATE IP1(IP2(IP1 INVERSE))
  9. C           OF IP2 BY IP1.  (SEE THE GENERAL DISCUSSION FOR DEFINITIONS
  10. C           AND NOTATION.)
  11. C
  12. C        USAGE
  13. C           CALL PPRCN(IP1,IP2,IP3,N,IPAR,IER)
  14. C
  15. C        DESCRIPTION OF PARAMETERS
  16. C           IP1  - GIVEN PERMUTATION VECTOR (DIMENSION N)
  17. C           IP2  - GIVEN PERMUTATION VECTOR (DIMENSION N)
  18. C           IP3  - RESULTING PERMUTATION VECTOR (DIMENSION N)
  19. C           N    - DIMENSION OF VECTORS IP1, IP2 AND IP3
  20. C           IPAR - INPUT PARAMETER
  21. C                  IPAR NON-NEGATIVE - COMPUTE IP2(IP1)
  22. C                  IPAR NEGATIVE     - COMPUTE IP1(IP2(IP1 INVERSE))
  23. C           IER  - RESULTING ERROR PARAMETER
  24. C                  IER=-1  -  N IS NOT POSITIVE
  25. C                  IER= 0  -  NO ERROR
  26. C                  IER= 1  -  IP1 AND IP2 ARE NOT BOTH PERMUTATION
  27. C                             VECTORS ON 1,...,N
  28. C
  29. C        REMARKS
  30. C           (1)  IF IER=-1 THERE HAS BEEN NO COMPUTATION.
  31. C           (2)  IF IER=1, THEN COMPUTATION HAS BEEN UNSUCCESSFUL DUE TO
  32. C                ERROR AND THE PARTIAL RESULTS FOUND IN IP2 ARE USELESS.
  33. C           (3)  IP3 CANNOT HAVE THE SAME STORAGE ALLOCATION AS IP1 OR
  34. C                IP2.
  35. C
  36. C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
  37. C           PERM
  38. C
  39. C        METHOD
  40. C           SUBROUTINE PERM IS USED TO CHECK THAT IP1 AND IP2 ARE PERMU-
  41. C           TATION VECTORS.  IF IP2(IP1) IS COMPUTED, IP3(I) IS SET TO
  42. C           IP2(IP1(I)) FOR I=1,...,N.  IF IP1(IP2(IP1 INVERSE)) IS
  43. C           COMPUTED, FIRST IP3 IS SET TO IP1 INVERSE BY SUBROUTINE PERM
  44. C           AND THEN IP3(I) IS SET TO IP1(IP2(IP3(I))) FOR I=1,...,N.
  45. C
  46. C     ..................................................................
  47. C
  48.       SUBROUTINE PPRCN(IP1,IP2,IP3,N,IPAR,IER)
  49. C
  50. C
  51.       DIMENSION IP1(1),IP2(1),IP3(1)
  52. C
  53. C        CHECK THAT N IS POSITIVE AND THAT IP2 IS A PERMUTATION VECTOR
  54.       CALL PERM(IP2,IP3,N,-1,IER)
  55. C
  56. C        TEST IER TO SEE IF THERE IS AN ERROR
  57.       IF(IER)7,1,7
  58. C
  59. C        CHECK THAT IP1 IS A PERMUTATION VECTOR AND COMPUTE IP1 INVERSE
  60.     1 CALL PERM(IP1,IP3,N,-1,IER)
  61. C
  62. C        TEST IER TO SEE IF THERE IS AN ERROR
  63.       IF(IER)7,2,7
  64. C
  65. C        TEST IPAR FOR THE DESIRED OPERATION
  66.     2 IF(IPAR)3,5,5
  67. C
  68. C        COMPUTE IP1(IP2(IP1 INVERSE))
  69.     3 DO 4 I=1,N
  70.       K=IP3(I)
  71.       J=IP2(K)
  72.     4 IP3(I)=IP1(J)
  73.       RETURN
  74. C
  75. C        COMPUTE IP2(IP1)
  76.     5 DO 6 I=1,N
  77.       K=IP1(I)
  78.     6 IP3(I)=IP2(K)
  79.     7 RETURN
  80.       END
  81.