Doxygen Source Code Documentation
eis_rsm.c File Reference
#include "f2c.h"
Go to the source code of this file.
Functions | |
int | rsm_ (integer *nm, integer *n, doublereal *a, doublereal *w, integer *m, doublereal *z__, doublereal *fwork, integer *iwork, integer *ierr) |
Function Documentation
|
Definition at line 8 of file eis_rsm.c. References a, imtqlv_(), tinvit_(), tqlrat_(), trbak1_(), and tred1_().
00011 { 00012 /* System generated locals */ 00013 integer a_dim1, a_offset, z_dim1, z_offset; 00014 00015 /* Local variables */ 00016 extern /* Subroutine */ int tred1_(integer *, integer *, doublereal *, 00017 doublereal *, doublereal *, doublereal *); 00018 static integer k1, k2, k3, k4, k5, k6, k7, k8; 00019 extern /* Subroutine */ int trbak1_(integer *, integer *, doublereal *, 00020 doublereal *, integer *, doublereal *), tqlrat_(integer *, 00021 doublereal *, doublereal *, integer *), imtqlv_(integer *, 00022 doublereal *, doublereal *, doublereal *, doublereal *, integer *, 00023 integer *, doublereal *), tinvit_(integer *, integer *, 00024 doublereal *, doublereal *, doublereal *, integer *, doublereal *, 00025 integer *, doublereal *, integer *, doublereal *, doublereal *, 00026 doublereal *, doublereal *, doublereal *); 00027 00028 00029 00030 /* THIS SUBROUTINE CALLS THE RECOMMENDED SEQUENCE OF */ 00031 /* SUBROUTINES FROM THE EIGENSYSTEM SUBROUTINE PACKAGE (EISPACK) */ 00032 /* TO FIND ALL OF THE EIGENVALUES AND SOME OF THE EIGENVECTORS */ 00033 /* OF A REAL SYMMETRIC MATRIX. */ 00034 00035 /* ON INPUT */ 00036 00037 /* NM MUST BE SET TO THE ROW DIMENSION OF THE TWO-DIMENSIONAL */ 00038 /* ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM */ 00039 /* DIMENSION STATEMENT. */ 00040 00041 /* N IS THE ORDER OF THE MATRIX A. */ 00042 00043 /* A CONTAINS THE REAL SYMMETRIC MATRIX. */ 00044 00045 /* M THE EIGENVECTORS CORRESPONDING TO THE FIRST M EIGENVALUES */ 00046 /* ARE TO BE COMPUTED. */ 00047 /* IF M = 0 THEN NO EIGENVECTORS ARE COMPUTED. */ 00048 /* IF M = N THEN ALL OF THE EIGENVECTORS ARE COMPUTED. */ 00049 00050 /* ON OUTPUT */ 00051 00052 /* W CONTAINS ALL N EIGENVALUES IN ASCENDING ORDER. */ 00053 00054 /* Z CONTAINS THE ORTHONORMAL EIGENVECTORS ASSOCIATED WITH */ 00055 /* THE FIRST M EIGENVALUES. */ 00056 00057 /* IERR IS AN INTEGER OUTPUT VARIABLE SET EQUAL TO AN ERROR */ 00058 /* COMPLETION CODE DESCRIBED IN THE DOCUMENTATION FOR TQLRAT, */ 00059 /* IMTQLV AND TINVIT. THE NORMAL COMPLETION CODE IS ZERO. */ 00060 00061 /* FWORK IS A TEMPORARY STORAGE ARRAY OF DIMENSION 8*N. */ 00062 00063 /* IWORK IS AN INTEGER TEMPORARY STORAGE ARRAY OF DIMENSION N. */ 00064 00065 /* QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, */ 00066 /* MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY 00067 */ 00068 00069 /* THIS VERSION DATED AUGUST 1983. */ 00070 00071 /* ------------------------------------------------------------------ 00072 */ 00073 00074 /* Parameter adjustments */ 00075 --iwork; 00076 --w; 00077 a_dim1 = *nm; 00078 a_offset = a_dim1 + 1; 00079 a -= a_offset; 00080 z_dim1 = *nm; 00081 z_offset = z_dim1 + 1; 00082 z__ -= z_offset; 00083 --fwork; 00084 00085 /* Function Body */ 00086 *ierr = *n * 10; 00087 if (*n > *nm || *m > *nm) { 00088 goto L50; 00089 } 00090 k1 = 1; 00091 k2 = k1 + *n; 00092 k3 = k2 + *n; 00093 k4 = k3 + *n; 00094 k5 = k4 + *n; 00095 k6 = k5 + *n; 00096 k7 = k6 + *n; 00097 k8 = k7 + *n; 00098 if (*m > 0) { 00099 goto L10; 00100 } 00101 /* .......... FIND EIGENVALUES ONLY .......... */ 00102 tred1_(nm, n, &a[a_offset], &w[1], &fwork[k1], &fwork[k2]); 00103 tqlrat_(n, &w[1], &fwork[k2], ierr); 00104 goto L50; 00105 /* .......... FIND ALL EIGENVALUES AND M EIGENVECTORS .......... */ 00106 L10: 00107 tred1_(nm, n, &a[a_offset], &fwork[k1], &fwork[k2], &fwork[k3]); 00108 imtqlv_(n, &fwork[k1], &fwork[k2], &fwork[k3], &w[1], &iwork[1], ierr, & 00109 fwork[k4]); 00110 tinvit_(nm, n, &fwork[k1], &fwork[k2], &fwork[k3], m, &w[1], &iwork[1], & 00111 z__[z_offset], ierr, &fwork[k4], &fwork[k5], &fwork[k6], &fwork[ 00112 k7], &fwork[k8]); 00113 trbak1_(nm, n, &a[a_offset], &fwork[k2], m, &z__[z_offset]); 00114 L50: 00115 return 0; 00116 } /* rsm_ */ |