![]() |
|
|||
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
[ Source navigation ] | [ Diff markup ] | [ Identifier search ] | [ general search ] |
This page was automatically generated by the 2.3.7 LXR engine. The LXR team |
![]() ![]() |