Trailing-Edge
-
PDP-10 Archives
-
decuslib20-02
-
decus/20-0026/pprcn.ssp
There are 2 other files named pprcn.ssp in the archive. Click here to see a list.
C PPRC 10
C ..................................................................PPRC 20
C PPRC 30
C SUBROUTINE PPRCN PPRC 40
C PPRC 50
C PURPOSE PPRC 60
C TO COMPUTE, GIVEN TWO PERMUTATION VECTORS IP1 AND IP2, THE PPRC 70
C COMPOSITION IP2(IP1) AND THE CONJUGATE IP1(IP2(IP1 INVERSE))PPRC 80
C OF IP2 BY IP1. (SEE THE GENERAL DISCUSSION FOR DEFINITIONS PPRC 90
C AND NOTATION.) PPRC 100
C PPRC 110
C USAGE PPRC 120
C CALL PPRCN(IP1,IP2,IP3,N,IPAR,IER) PPRC 130
C PPRC 140
C DESCRIPTION OF PARAMETERS PPRC 150
C IP1 - GIVEN PERMUTATION VECTOR (DIMENSION N) PPRC 160
C IP2 - GIVEN PERMUTATION VECTOR (DIMENSION N) PPRC 170
C IP3 - RESULTING PERMUTATION VECTOR (DIMENSION N) PPRC 180
C N - DIMENSION OF VECTORS IP1, IP2 AND IP3 PPRC 190
C IPAR - INPUT PARAMETER PPRC 200
C IPAR NON-NEGATIVE - COMPUTE IP2(IP1) PPRC 210
C IPAR NEGATIVE - COMPUTE IP1(IP2(IP1 INVERSE)) PPRC 220
C IER - RESULTING ERROR PARAMETER PPRC 230
C IER=-1 - N IS NOT POSITIVE PPRC 240
C IER= 0 - NO ERROR PPRC 250
C IER= 1 - IP1 AND IP2 ARE NOT BOTH PERMUTATION PPRC 260
C VECTORS ON 1,...,N PPRC 270
C PPRC 280
C REMARKS PPRC 290
C (1) IF IER=-1 THERE HAS BEEN NO COMPUTATION. PPRC 300
C (2) IF IER=1, THEN COMPUTATION HAS BEEN UNSUCCESSFUL DUE TOPPRC 310
C ERROR AND THE PARTIAL RESULTS FOUND IN IP2 ARE USELESS.PPRC 320
C (3) IP3 CANNOT HAVE THE SAME STORAGE ALLOCATION AS IP1 OR PPRC 330
C IP2. PPRC 340
C PPRC 350
C SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED PPRC 360
C PERM PPRC 370
C PPRC 380
C METHOD PPRC 390
C SUBROUTINE PERM IS USED TO CHECK THAT IP1 AND IP2 ARE PERMU-PPRC 400
C TATION VECTORS. IF IP2(IP1) IS COMPUTED, IP3(I) IS SET TO PPRC 410
C IP2(IP1(I)) FOR I=1,...,N. IF IP1(IP2(IP1 INVERSE)) IS PPRC 420
C COMPUTED, FIRST IP3 IS SET TO IP1 INVERSE BY SUBROUTINE PERMPPRC 430
C AND THEN IP3(I) IS SET TO IP1(IP2(IP3(I))) FOR I=1,...,N. PPRC 440
C PPRC 450
C ..................................................................PPRC 460
C PPRC 470
SUBROUTINE PPRCN(IP1,IP2,IP3,N,IPAR,IER) PPRC 480
C PPRC 490
C PPRC 500
DIMENSION IP1(1),IP2(1),IP3(1) PPRC 510
C PPRC 520
C CHECK THAT N IS POSITIVE AND THAT IP2 IS A PERMUTATION VECTOR PPRC 530
CALL PERM(IP2,IP3,N,-1,IER) PPRC 540
C PPRC 550
C TEST IER TO SEE IF THERE IS AN ERROR PPRC 560
IF(IER)7,1,7 PPRC 570
C PPRC 580
C CHECK THAT IP1 IS A PERMUTATION VECTOR AND COMPUTE IP1 INVERSE PPRC 590
1 CALL PERM(IP1,IP3,N,-1,IER) PPRC 600
C PPRC 610
C TEST IER TO SEE IF THERE IS AN ERROR PPRC 620
IF(IER)7,2,7 PPRC 630
C PPRC 640
C TEST IPAR FOR THE DESIRED OPERATION PPRC 650
2 IF(IPAR)3,5,5 PPRC 660
C PPRC 670
C COMPUTE IP1(IP2(IP1 INVERSE)) PPRC 680
3 DO 4 I=1,N PPRC 690
K=IP3(I) PPRC 700
J=IP2(K) PPRC 710
4 IP3(I)=IP1(J) PPRC 720
RETURN PPRC 730
C PPRC 740
C COMPUTE IP2(IP1) PPRC 750
5 DO 6 I=1,N PPRC 760
K=IP1(I) PPRC 770
6 IP3(I)=IP2(K) PPRC 780
7 RETURN PPRC 790
END PPRC 800