Doxygen Source Code Documentation
eis_elmbak.c File Reference
#include "f2c.h"
Go to the source code of this file.
Functions | |
int | elmbak_ (integer *nm, integer *low, integer *igh, doublereal *a, integer *int__, integer *m, doublereal *z__) |
Function Documentation
|
Definition at line 8 of file eis_elmbak.c.
00010 { 00011 /* System generated locals */ 00012 integer a_dim1, a_offset, z_dim1, z_offset, i__1, i__2, i__3; 00013 00014 /* Local variables */ 00015 static integer i__, j; 00016 static doublereal x; 00017 static integer la, mm, mp, kp1, mp1; 00018 00019 00020 00021 /* THIS SUBROUTINE IS A TRANSLATION OF THE ALGOL PROCEDURE ELMBAK, */ 00022 /* NUM. MATH. 12, 349-368(1968) BY MARTIN AND WILKINSON. */ 00023 /* HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 339-358(1971). */ 00024 00025 /* THIS SUBROUTINE FORMS THE EIGENVECTORS OF A REAL GENERAL */ 00026 /* MATRIX BY BACK TRANSFORMING THOSE OF THE CORRESPONDING */ 00027 /* UPPER HESSENBERG MATRIX DETERMINED BY ELMHES. */ 00028 00029 /* ON INPUT */ 00030 00031 /* NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL */ 00032 /* ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM */ 00033 /* DIMENSION STATEMENT. */ 00034 00035 /* LOW AND IGH ARE INTEGERS DETERMINED BY THE BALANCING */ 00036 /* SUBROUTINE BALANC. IF BALANC HAS NOT BEEN USED, */ 00037 /* SET LOW=1 AND IGH EQUAL TO THE ORDER OF THE MATRIX. */ 00038 00039 /* A CONTAINS THE MULTIPLIERS WHICH WERE USED IN THE */ 00040 /* REDUCTION BY ELMHES IN ITS LOWER TRIANGLE */ 00041 /* BELOW THE SUBDIAGONAL. */ 00042 00043 /* INT CONTAINS INFORMATION ON THE ROWS AND COLUMNS */ 00044 /* INTERCHANGED IN THE REDUCTION BY ELMHES. */ 00045 /* ONLY ELEMENTS LOW THROUGH IGH ARE USED. */ 00046 00047 /* M IS THE NUMBER OF COLUMNS OF Z TO BE BACK TRANSFORMED. */ 00048 00049 /* Z CONTAINS THE REAL AND IMAGINARY PARTS OF THE EIGEN- */ 00050 /* VECTORS TO BE BACK TRANSFORMED IN ITS FIRST M COLUMNS. */ 00051 00052 /* ON OUTPUT */ 00053 00054 /* Z CONTAINS THE REAL AND IMAGINARY PARTS OF THE */ 00055 /* TRANSFORMED EIGENVECTORS IN ITS FIRST M COLUMNS. */ 00056 00057 /* QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, */ 00058 /* MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY 00059 */ 00060 00061 /* THIS VERSION DATED AUGUST 1983. */ 00062 00063 /* ------------------------------------------------------------------ 00064 */ 00065 00066 /* Parameter adjustments */ 00067 --int__; 00068 a_dim1 = *nm; 00069 a_offset = a_dim1 + 1; 00070 a -= a_offset; 00071 z_dim1 = *nm; 00072 z_offset = z_dim1 + 1; 00073 z__ -= z_offset; 00074 00075 /* Function Body */ 00076 if (*m == 0) { 00077 goto L200; 00078 } 00079 la = *igh - 1; 00080 kp1 = *low + 1; 00081 if (la < kp1) { 00082 goto L200; 00083 } 00084 /* .......... FOR MP=IGH-1 STEP -1 UNTIL LOW+1 DO -- .......... */ 00085 i__1 = la; 00086 for (mm = kp1; mm <= i__1; ++mm) { 00087 mp = *low + *igh - mm; 00088 mp1 = mp + 1; 00089 00090 i__2 = *igh; 00091 for (i__ = mp1; i__ <= i__2; ++i__) { 00092 x = a[i__ + (mp - 1) * a_dim1]; 00093 if (x == 0.) { 00094 goto L110; 00095 } 00096 00097 i__3 = *m; 00098 for (j = 1; j <= i__3; ++j) { 00099 /* L100: */ 00100 z__[i__ + j * z_dim1] += x * z__[mp + j * z_dim1]; 00101 } 00102 00103 L110: 00104 ; 00105 } 00106 00107 i__ = int__[mp]; 00108 if (i__ == mp) { 00109 goto L140; 00110 } 00111 00112 i__2 = *m; 00113 for (j = 1; j <= i__2; ++j) { 00114 x = z__[i__ + j * z_dim1]; 00115 z__[i__ + j * z_dim1] = z__[mp + j * z_dim1]; 00116 z__[mp + j * z_dim1] = x; 00117 /* L130: */ 00118 } 00119 00120 L140: 00121 ; 00122 } 00123 00124 L200: 00125 return 0; 00126 } /* elmbak_ */ |