Back to home page

sPhenix code displayed by LXR

 
 

    


File indexing completed on 2025-08-05 08:21:09

0001  
0002 C*********************************************************************
0003  
0004 C...PYCBA2
0005 C...Auxiliary to PYEICG.
0006 C
0007 C     THIS SUBROUTINE IS A TRANSLATION OF THE ALGOL PROCEDURE
0008 C     CBABK2, WHICH IS A COMPLEX VERSION OF BALBAK,
0009 C     NUM. MATH. 13, 293-304(1969) BY PARLETT AND REINSCH.
0010 C     HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 315-326(1971).
0011 C
0012 C     THIS SUBROUTINE FORMS THE EIGENVECTORS OF A COMPLEX GENERAL
0013 C     MATRIX BY BACK TRANSFORMING THOSE OF THE CORRESPONDING
0014 C     BALANCED MATRIX DETERMINED BY  CBAL.
0015 C
0016 C     ON INPUT
0017 C
0018 C        NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL
0019 C          ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM
0020 C          DIMENSION STATEMENT.
0021 C
0022 C        N IS THE ORDER OF THE MATRIX.
0023 C
0024 C        LOW AND IGH ARE INTEGERS DETERMINED BY  CBAL.
0025 C
0026 C        SCALE CONTAINS INFORMATION DETERMINING THE PERMUTATIONS
0027 C          AND SCALING FACTORS USED BY  CBAL.
0028 C
0029 C        M IS THE NUMBER OF EIGENVECTORS TO BE BACK TRANSFORMED.
0030 C
0031 C        ZR AND ZI CONTAIN THE REAL AND IMAGINARY PARTS,
0032 C          RESPECTIVELY, OF THE EIGENVECTORS TO BE
0033 C          BACK TRANSFORMED IN THEIR FIRST M COLUMNS.
0034 C
0035 C     ON OUTPUT
0036 C
0037 C        ZR AND ZI CONTAIN THE REAL AND IMAGINARY PARTS,
0038 C          RESPECTIVELY, OF THE TRANSFORMED EIGENVECTORS
0039 C          IN THEIR FIRST M COLUMNS.
0040 C
0041 C     QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW,
0042 C     MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY
0043 C
0044 C     THIS VERSION DATED AUGUST 1983.
0045 C
0046  
0047       SUBROUTINE PYCBA2(NM,N,LOW,IGH,SCALE,M,ZR,ZI)
0048  
0049       INTEGER I,J,K,M,N,II,NM,IGH,LOW
0050       DOUBLE PRECISION SCALE(4),ZR(4,4),ZI(4,4)
0051       DOUBLE PRECISION S
0052  
0053       IF (M .EQ. 0) GOTO 150
0054       IF (IGH .EQ. LOW) GOTO 120
0055 C
0056       DO 110 I = LOW, IGH
0057          S = SCALE(I)
0058 C     .......... LEFT HAND EIGENVECTORS ARE BACK TRANSFORMED
0059 C                IF THE FOREGOING STATEMENT IS REPLACED BY
0060 C                S=1.0D0/SCALE(I). ..........
0061          DO 100 J = 1, M
0062             ZR(I,J) = ZR(I,J) * S
0063             ZI(I,J) = ZI(I,J) * S
0064   100    CONTINUE
0065 C
0066   110 CONTINUE
0067 C     .......... FOR I=LOW-1 STEP -1 UNTIL 1,
0068 C                IGH+1 STEP 1 UNTIL N DO -- ..........
0069   120 DO 140 II = 1, N
0070          I = II
0071          IF (I .GE. LOW .AND. I .LE. IGH) GOTO 140
0072          IF (I .LT. LOW) I = LOW - II
0073          K = SCALE(I)
0074          IF (K .EQ. I) GOTO 140
0075 C
0076          DO 130 J = 1, M
0077             S = ZR(I,J)
0078             ZR(I,J) = ZR(K,J)
0079             ZR(K,J) = S
0080             S = ZI(I,J)
0081             ZI(I,J) = ZI(K,J)
0082             ZI(K,J) = S
0083   130    CONTINUE
0084 C
0085   140 CONTINUE
0086 C
0087   150 RETURN
0088       END