Doxygen Source Code Documentation
eis_ch.c File Reference
#include "f2c.h"
Go to the source code of this file.
Functions | |
int | ch_ (integer *nm, integer *n, doublereal *ar, doublereal *ai, doublereal *w, integer *matz, doublereal *zr, doublereal *zi, doublereal *fv1, doublereal *fv2, doublereal *fm1, integer *ierr) |
Function Documentation
|
Definition at line 8 of file eis_ch.c. References htribk_(), htridi_(), tql2_(), and tqlrat_().
00011 { 00012 /* System generated locals */ 00013 integer ar_dim1, ar_offset, ai_dim1, ai_offset, zr_dim1, zr_offset, 00014 zi_dim1, zi_offset, i__1, i__2; 00015 00016 /* Local variables */ 00017 static integer i__, j; 00018 extern /* Subroutine */ int htridi_(integer *, integer *, doublereal *, 00019 doublereal *, doublereal *, doublereal *, doublereal *, 00020 doublereal *), htribk_(integer *, integer *, doublereal *, 00021 doublereal *, doublereal *, integer *, doublereal *, doublereal *) 00022 , tqlrat_(integer *, doublereal *, doublereal *, integer *), 00023 tql2_(integer *, integer *, doublereal *, doublereal *, 00024 doublereal *, integer *); 00025 00026 00027 00028 /* THIS SUBROUTINE CALLS THE RECOMMENDED SEQUENCE OF */ 00029 /* SUBROUTINES FROM THE EIGENSYSTEM SUBROUTINE PACKAGE (EISPACK) */ 00030 /* TO FIND THE EIGENVALUES AND EIGENVECTORS (IF DESIRED) */ 00031 /* OF A COMPLEX HERMITIAN MATRIX. */ 00032 00033 /* ON INPUT */ 00034 00035 /* NM MUST BE SET TO THE ROW DIMENSION OF THE TWO-DIMENSIONAL */ 00036 /* ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM */ 00037 /* DIMENSION STATEMENT. */ 00038 00039 /* N IS THE ORDER OF THE MATRIX A=(AR,AI). */ 00040 00041 /* AR AND AI CONTAIN THE REAL AND IMAGINARY PARTS, */ 00042 /* RESPECTIVELY, OF THE COMPLEX HERMITIAN MATRIX. */ 00043 00044 /* MATZ IS AN INTEGER VARIABLE SET EQUAL TO ZERO IF */ 00045 /* ONLY EIGENVALUES ARE DESIRED. OTHERWISE IT IS SET TO */ 00046 /* ANY NON-ZERO INTEGER FOR BOTH EIGENVALUES AND EIGENVECTORS. */ 00047 00048 /* ON OUTPUT */ 00049 00050 /* W CONTAINS THE EIGENVALUES IN ASCENDING ORDER. */ 00051 00052 /* ZR AND ZI CONTAIN THE REAL AND IMAGINARY PARTS, */ 00053 /* RESPECTIVELY, OF THE EIGENVECTORS IF MATZ IS NOT ZERO. */ 00054 00055 /* IERR IS AN INTEGER OUTPUT VARIABLE SET EQUAL TO AN ERROR */ 00056 /* COMPLETION CODE DESCRIBED IN THE DOCUMENTATION FOR TQLRAT */ 00057 /* AND TQL2. THE NORMAL COMPLETION CODE IS ZERO. */ 00058 00059 /* FV1, FV2, AND FM1 ARE TEMPORARY STORAGE ARRAYS. */ 00060 00061 /* QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, */ 00062 /* MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY 00063 */ 00064 00065 /* THIS VERSION DATED AUGUST 1983. */ 00066 00067 /* ------------------------------------------------------------------ 00068 */ 00069 00070 /* Parameter adjustments */ 00071 fm1 -= 3; 00072 --fv2; 00073 --fv1; 00074 zi_dim1 = *nm; 00075 zi_offset = zi_dim1 + 1; 00076 zi -= zi_offset; 00077 zr_dim1 = *nm; 00078 zr_offset = zr_dim1 + 1; 00079 zr -= zr_offset; 00080 --w; 00081 ai_dim1 = *nm; 00082 ai_offset = ai_dim1 + 1; 00083 ai -= ai_offset; 00084 ar_dim1 = *nm; 00085 ar_offset = ar_dim1 + 1; 00086 ar -= ar_offset; 00087 00088 /* Function Body */ 00089 if (*n <= *nm) { 00090 goto L10; 00091 } 00092 *ierr = *n * 10; 00093 goto L50; 00094 00095 L10: 00096 htridi_(nm, n, &ar[ar_offset], &ai[ai_offset], &w[1], &fv1[1], &fv2[1], & 00097 fm1[3]); 00098 if (*matz != 0) { 00099 goto L20; 00100 } 00101 /* .......... FIND EIGENVALUES ONLY .......... */ 00102 tqlrat_(n, &w[1], &fv2[1], ierr); 00103 goto L50; 00104 /* .......... FIND BOTH EIGENVALUES AND EIGENVECTORS .......... */ 00105 L20: 00106 i__1 = *n; 00107 for (i__ = 1; i__ <= i__1; ++i__) { 00108 00109 i__2 = *n; 00110 for (j = 1; j <= i__2; ++j) { 00111 zr[j + i__ * zr_dim1] = 0.; 00112 /* L30: */ 00113 } 00114 00115 zr[i__ + i__ * zr_dim1] = 1.; 00116 /* L40: */ 00117 } 00118 00119 tql2_(nm, n, &w[1], &fv1[1], &zr[zr_offset], ierr); 00120 if (*ierr != 0) { 00121 goto L50; 00122 } 00123 htribk_(nm, n, &ar[ar_offset], &ai[ai_offset], &fm1[3], n, &zr[zr_offset], 00124 &zi[zi_offset]); 00125 L50: 00126 return 0; 00127 } /* ch_ */ |