Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-02 - decus/20-0026/mprc.ssp
There are 2 other files named mprc.ssp in the archive. Click here to see a list.
C                                                                       MPRC  10
C     ..................................................................MPRC  20
C                                                                       MPRC  30
C        SUBROUTINE MPRC                                                MPRC  40
C                                                                       MPRC  50
C        PURPOSE                                                        MPRC  60
C           TO PERMUTE THE ROWS OR COLUMNS OF A GIVEN MATRIX ACCORDING  MPRC  70
C           TO A GIVEN TRANSPOSITION VECTOR OR ITS INVERSE.  (SEE THE   MPRC  80
C           DISCUSSION ON PERMUTATIONS FOR DEFINITIONS AND NOTATION.)   MPRC  90
C                                                                       MPRC 100
C        USAGE                                                          MPRC 110
C           CALL MPRC(A,M,N,ITRA,INV,IROCO,IER)                         MPRC 120
C                                                                       MPRC 130
C        DESCRIPTION OF PARAMETERS                                      MPRC 140
C           A     - GIVEN M BY N MATRIX AND RESULTING PERMUTED MATRIX   MPRC 150
C           M     - NUMBER OF ROWS OF A                                 MPRC 160
C           N     - NUMBER OF COLUMNS OF A                              MPRC 170
C           ITRA  - GIVEN TRANSPOSITION VECTOR (DIMENSION M IF ROWS ARE MPRC 180
C                   PERMUTED, N IF COLUMNS ARE PERMUTED)                MPRC 190
C           INV   - INPUT PARAMETER                                     MPRC 200
C                   INV NON-ZERO  -  PERMUTE ACCORDING TO ITRA          MPRC 210
C                   INV    =   0  -  PERMUTE ACCORDING TO ITRA INVERSE  MPRC 220
C           IROCO - INPUT PARAMETER                                     MPRC 230
C                   IROCO NON-ZERO  -  PERMUTE THE COLUMNS OF A         MPRC 240
C                   IROCO    =   0  -  PERMUTE THE ROWS OF A            MPRC 250
C           IER   - RESULTING ERROR PARAMETER                           MPRC 260
C                   IER = -1  -  M AND N ARE NOT BOTH POSITIVE          MPRC 270
C                   IER =  0  -  NO ERROR                               MPRC 280
C                   IER =  1  -  ITRA IS NOT A TRANSPOSITION VECTOR ON  MPRC 290
C                                1,...,M IF ROWS ARE PERMUTED, 1,...,N  MPRC 300
C                                IF COLUMNS ARE PERMUTED                MPRC 310
C                                                                       MPRC 320
C        REMARKS                                                        MPRC 330
C           (1)  IF IER=-1 THERE IS NO COMPUTATION.                     MPRC 340
C           (2)  IF IER= 1, THEN COMPUTATION HAS BEEN UNSUCCESSFUL DUE  MPRC 350
C                TO ERROR, BUT THE MATRIX A WILL REFLECT THE ROW OR     MPRC 360
C                COLUMN INTERCHANGES PERFORMED BEFORE THE ERROR WAS     MPRC 370
C                DETECTED.                                              MPRC 380
C           (3)  THE MATRIX A IS ASSUMED TO BE STORED COLUMNWISE.       MPRC 390
C                                                                       MPRC 400
C        SUBROUTINES AND SUBPROGRAMS REQUIRED                           MPRC 410
C           NONE                                                        MPRC 420
C                                                                       MPRC 430
C        METHOD                                                         MPRC 440
C           THE ROWS OR COLUMNS ARE PERMUTED ELEMENTWISE, INTERCHANGING MPRC 450
C           ROW OR COLUMN 1 AND ITRA(1),...,ROW OR COLUMN K AND ITRA(K) MPRC 460
C           IN THAT ORDER IF INV=0, AND OTHERWISE INTERCHANGING ROW OR  MPRC 470
C           COLUMN K AND ITRA(K),...,ROW OR COLUMN 1 AND ITRA(1), WHERE MPRC 480
C           K IS M OR N DEPENDING ON WHETHER WE PERMUTE ROWS OR COLUMNS.MPRC 490
C                                                                       MPRC 500
C     ..................................................................MPRC 510
C                                                                       MPRC 520
      SUBROUTINE MPRC(A,M,N,ITRA,INV,IROCO,IER)                         MPRC 530
C                                                                       MPRC 540
C                                                                       MPRC 550
      DIMENSION A(1),ITRA(1)                                            MPRC 560
C                                                                       MPRC 570
C        TEST OF DIMENSIONS                                             MPRC 580
      IF(M)14,14,1                                                      MPRC 590
    1 IF(N)14,14,2                                                      MPRC 600
C                                                                       MPRC 610
C        DETERMINE WHICH ARE TO BE PERMUTED-THE ROWS OR THE COLUMNS     MPRC 620
    2 IF(IROCO)3,4,3                                                    MPRC 630
C                                                                       MPRC 640
C        INITIALIZE FOR COLUMN INTERCHANGES                             MPRC 650
    3 MM=M                                                              MPRC 660
      MMM=-1                                                            MPRC 670
      L=M                                                               MPRC 680
      LL=N                                                              MPRC 690
      GO TO 5                                                           MPRC 700
C                                                                       MPRC 710
C        INITIALIZE FOR ROW INTERCHANGES                                MPRC 720
    4 MM=1                                                              MPRC 730
      MMM=M                                                             MPRC 740
      L=N                                                               MPRC 750
      LL=M                                                              MPRC 760
C                                                                       MPRC 770
C        INITIALIZE LOOP OVER ALL ROWS OR COLUMNS                       MPRC 780
    5 IA=1                                                              MPRC 790
      ID=1                                                              MPRC 800
C                                                                       MPRC 810
C        TEST FOR INVERSE OPERATION                                     MPRC 820
      IF(INV)6,7,6                                                      MPRC 830
    6 IA=LL                                                             MPRC 840
      ID=-1                                                             MPRC 850
    7 DO 12 I=1,LL                                                      MPRC 860
      K=ITRA(IA)                                                        MPRC 870
      IF(K-IA)8,12,9                                                    MPRC 880
    8 IF(K)13,13,10                                                     MPRC 890
    9 IF(LL-K)13,10,10                                                  MPRC 900
C                                                                       MPRC 910
C        INITIALIZE ROW OR COLUMN INTERCHANGE                           MPRC 920
   10 IL=IA*MM                                                          MPRC 930
      K=K*MM                                                            MPRC 940
C                                                                       MPRC 950
C        PERFORM ROW OR COLUMN INTERCHANGE                              MPRC 960
      DO 11 J=1,L                                                       MPRC 970
      SAVE=A(IL)                                                        MPRC 980
      A(IL)=A(K)                                                        MPRC 990
      A(K)=SAVE                                                         MPRC1000
      K=K+MMM                                                           MPRC1010
   11 IL=IL+MMM                                                         MPRC1020
C                                                                       MPRC1030
C        ADDRESS NEXT INTERCHANGE STEP                                  MPRC1040
   12 IA=IA+ID                                                          MPRC1050
C                                                                       MPRC1060
C        NORMAL EXIT                                                    MPRC1070
      IER=0                                                             MPRC1080
      RETURN                                                            MPRC1090
C                                                                       MPRC1100
C        ERROR RETURN IN CASE ITRA IS NOT A TRANSPOSITION VECTOR        MPRC1110
   13 IER=1                                                             MPRC1120
      RETURN                                                            MPRC1130
C                                                                       MPRC1140
C        ERROR RETURN IN CASE OF ILLEGAL DIMENSIONS                     MPRC1150
   14 IER=-1                                                            MPRC1160
      RETURN                                                            MPRC1170
      END                                                               MPRC1180