Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-02 - decus/20-0026/perm.ssp
There are 2 other files named perm.ssp in the archive. Click here to see a list.
C                                                                       PERM  10
C     ..................................................................PERM  20
C                                                                       PERM  30
C        SUBROUTINE PERM                                                PERM  40
C                                                                       PERM  50
C        PURPOSE                                                        PERM  60
C           TO COMPUTE THE PERMUTATION VECTOR THAT IS INVERSE TO A GIVENPERM  70
C           PERMUTATION VECTOR, THE PERMUTATION VECTOR THAT IS EQUIVA-  PERM  80
C           LENT TO A GIVEN TRANSPOSITION VECTOR AND A TRANSPOSITION    PERM  90
C           VECTOR THAT IS EQUIVALENT TO A GIVEN PERMUTATION VECTOR.    PERM 100
C           (SEE THE GENERAL DISCUSSION FOR DEFINITIONS AND NOTATION.)  PERM 110
C                                                                       PERM 120
C        USAGE                                                          PERM 130
C           CALL PERM(IP1,IP2,N,IPAR,IER)                               PERM 140
C                                                                       PERM 150
C        DESCRIPTION OF PARAMETERS                                      PERM 160
C           IP1  - GIVEN PERMUTATION OR TRANSPOSITION VECTOR            PERM 170
C                  (DIMENSION N)                                        PERM 180
C           IP2  - RESULTING PERMUTATION OR TRANSPOSITION VECTOR        PERM 190
C                  (DIMENSION N)                                        PERM 200
C           N    - DIMENSION OF VECTORS IP1 AND IP2                     PERM 210
C           IPAR - INPUT PARAMETER                                      PERM 220
C                  IPAR NEGATIVE - COMPUTE THE PERMUTATION VECTOR IP2   PERM 230
C                                  THAT IS THE INVERSE OF THE PERMUTA-  PERM 240
C                                  TION VECTOR IP1                      PERM 250
C                  IPAR  =  ZERO - COMPUTE THE PERMUTATION VECTOR IP2   PERM 260
C                                  THAT IS EQUIVALENT TO THE TRANSPOSI- PERM 270
C                                  TION VECTOR IP1                      PERM 280
C                  IPAR POSITIVE - COMPUTE A TRANSPOSITION VECTOR IP2   PERM 290
C                                  THAT IS EQUIVALENT TO THE PERMUTATIONPERM 300
C                                  VECTOR IP1                           PERM 310
C           IER  - RESULTING ERROR PARAMETER                            PERM 320
C                  IER=-1  -  N IS NOT POSITIVE                         PERM 330
C                  IER= 0  -  NO ERROR                                  PERM 340
C                  IER= 1  -  IP1 IS EITHER NOT A PERMUTATION VECTOR OR PERM 350
C                             NOT A TRANSPOSITION VECTOR ON 1,...,N,    PERM 360
C                             DEPENDING ON WHETHER IPAR IS NON-ZERO OR  PERM 370
C                             ZERO, RESPECTIVELY                        PERM 380
C                                                                       PERM 390
C        REMARKS                                                        PERM 400
C           (1)  IF IER=-1 THERE HAS BEEN NO COMPUTATION.               PERM 410
C           (2)  IF IER=1, THEN COMPUTATION HAS BEEN UNSUCCESSFUL DUE TOPERM 420
C                ERROR AND THE PARTIAL RESULTS FOUND IN IP2 ARE USELESS.PERM 430
C           (3)  IP2 CANNOT HAVE THE SAME STORAGE ALLOCATION AS IP1.    PERM 440
C                                                                       PERM 450
C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED                  PERM 460
C           NONE                                                        PERM 470
C                                                                       PERM 480
C        METHOD                                                         PERM 490
C           (1)  IPAR NEGATIVE - FOR EACH I, I=1,...,N, IP2(IP1(I)) IS  PERM 500
C                                SET TO I.                              PERM 510
C           (2)  IPAR  =  ZERO - INITIALLY IP2(I) IS SET TO I FOR       PERM 520
C                                I=1,...,N.  THEN, FOR I=1,...,N IN THATPERM 530
C                                ORDER, IP2(I) AND IP2(IP1(I)) ARE      PERM 540
C                                INTERCHANGED.                          PERM 550
C           (3)  IPAR POSITIVE - INITIALLY IP1 IS MOVED TO IP2.  THEN   PERM 560
C                                THE FOLLOWING TWO STEPS ARE REPEATED   PERM 570
C                                FOR I SUCCESSIVELY EQUAL TO 1,...,N.   PERM 580
C                                (A) FIND THE SMALLEST J GREATER THAN ORPERM 590
C                                    EQUAL TO I SUCH THAT IP2(J)=I.     PERM 600
C                                (B) SET IP2(J) TO IP2(I).              PERM 610
C                                                                       PERM 620
C     ..................................................................PERM 630
C                                                                       PERM 640
      SUBROUTINE PERM(IP1,IP2,N,IPAR,IER)                               PERM 650
C                                                                       PERM 660
C                                                                       PERM 670
      DIMENSION IP1(1),IP2(1)                                           PERM 680
C                                                                       PERM 690
C        TEST DIMENSION                                                 PERM 700
      IF(N)19,19,1                                                      PERM 710
C                                                                       PERM 720
C        TEST IPAR TO DETERMINE WHETHER IP1 IS TO BE INTERPRETED AS     PERM 730
C        A PERMUTATION VECTOR OR AS A TRANSPOSITION VECTOR              PERM 740
    1 IF(IPAR)2,13,2                                                    PERM 750
C                                                                       PERM 760
C        CHECK THAT IP1 IS A PERMUTATION VECTOR AND COMPUTE IP1 INVERSE PERM 770
    2 DO 3 I=1,N                                                        PERM 780
    3 IP2(I)=0                                                          PERM 790
      DO 6 I=1,N                                                        PERM 800
      K=IP1(I)                                                          PERM 810
      IF(K-N)4,5,20                                                     PERM 820
    4 IF(K)20,20,5                                                      PERM 830
    5 IF(IP2(K))20,6,20                                                 PERM 840
    6 IP2(K)=I                                                          PERM 850
C                                                                       PERM 860
C        TEST IPAR FOR THE DESIRED OPERATION                            PERM 870
      IF(IPAR)12,7,7                                                    PERM 880
C                                                                       PERM 890
C        COMPUTE TRANSPOSITION VECTOR IP2 FOR PERMUTATION VECTOR IP1    PERM 900
    7 DO 8 I=1,N                                                        PERM 910
    8 IP2(I)=IP1(I)                                                     PERM 920
      NN=N-1                                                            PERM 930
      IF(NN)12,12,9                                                     PERM 940
    9 DO 11 I=1,NN                                                      PERM 950
      DO 10 J=1,NN                                                      PERM 960
      IF(IP2(J)-I)10,11,10                                              PERM 970
   10 CONTINUE                                                          PERM 980
      J=N                                                               PERM 990
   11 IP2(J)=IP2(I)                                                     PERM1000
C                                                                       PERM1010
C        NORMAL RETURN - NO ERROR                                       PERM1020
   12 IER=0                                                             PERM1030
      RETURN                                                            PERM1040
C                                                                       PERM1050
C        COMPUTE PERMUTATION VECTOR IP2 FOR TRANSPOSITION VECTOR IP1    PERM1060
   13 DO 14 I=1,N                                                       PERM1070
   14 IP2(I)=I                                                          PERM1080
      DO 18 I=1,N                                                       PERM1090
      K=IP1(I)                                                          PERM1100
      IF(K-I)15,18,16                                                   PERM1110
   15 IF(K)20,20,17                                                     PERM1120
   16 IF(N-K)20,17,17                                                   PERM1130
   17 J=IP2(I)                                                          PERM1140
      IP2(I)=IP2(K)                                                     PERM1150
      IP2(K)=J                                                          PERM1160
   18 CONTINUE                                                          PERM1170
      GO TO 12                                                          PERM1180
C                                                                       PERM1190
C        ERROR RETURN - N IS NOT POSITIVE                               PERM1200
   19 IER=-1                                                            PERM1210
      RETURN                                                            PERM1220
C                                                                       PERM1230
C        ERROR RETURN - IP1 IS EITHER NOT A PERMUTATION VECTOR          PERM1240
C                       OR NOT A TRANSPOSITION VECTOR                   PERM1250
   20 IER=1                                                             PERM1260
      RETURN                                                            PERM1270
      END                                                               PERM1280