Doxygen Source Code Documentation
eis_figi2.c File Reference
#include "f2c.h"
Go to the source code of this file.
Functions | |
int | figi2_ (integer *nm, integer *n, doublereal *t, doublereal *d__, doublereal *e, doublereal *z__, integer *ierr) |
Function Documentation
|
Definition at line 8 of file eis_figi2.c. Referenced by rt_().
00010 { 00011 /* System generated locals */ 00012 integer t_dim1, t_offset, z_dim1, z_offset, i__1, i__2; 00013 00014 /* Builtin functions */ 00015 double sqrt(doublereal); 00016 00017 /* Local variables */ 00018 static doublereal h__; 00019 static integer i__, j; 00020 00021 00022 00023 /* GIVEN A NONSYMMETRIC TRIDIAGONAL MATRIX SUCH THAT THE PRODUCTS */ 00024 /* OF CORRESPONDING PAIRS OF OFF-DIAGONAL ELEMENTS ARE ALL */ 00025 /* NON-NEGATIVE, AND ZERO ONLY WHEN BOTH FACTORS ARE ZERO, THIS */ 00026 /* SUBROUTINE REDUCES IT TO A SYMMETRIC TRIDIAGONAL MATRIX */ 00027 /* USING AND ACCUMULATING DIAGONAL SIMILARITY TRANSFORMATIONS. */ 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 /* N IS THE ORDER OF THE MATRIX. */ 00036 00037 /* T CONTAINS THE INPUT MATRIX. ITS SUBDIAGONAL IS */ 00038 /* STORED IN THE LAST N-1 POSITIONS OF THE FIRST COLUMN, */ 00039 /* ITS DIAGONAL IN THE N POSITIONS OF THE SECOND COLUMN, */ 00040 /* AND ITS SUPERDIAGONAL IN THE FIRST N-1 POSITIONS OF */ 00041 /* THE THIRD COLUMN. T(1,1) AND T(N,3) ARE ARBITRARY. */ 00042 00043 /* ON OUTPUT */ 00044 00045 /* T IS UNALTERED. */ 00046 00047 /* D CONTAINS THE DIAGONAL ELEMENTS OF THE SYMMETRIC MATRIX. */ 00048 00049 /* E CONTAINS THE SUBDIAGONAL ELEMENTS OF THE SYMMETRIC */ 00050 /* MATRIX IN ITS LAST N-1 POSITIONS. E(1) IS NOT SET. */ 00051 00052 /* Z CONTAINS THE TRANSFORMATION MATRIX PRODUCED IN */ 00053 /* THE REDUCTION. */ 00054 00055 /* IERR IS SET TO */ 00056 /* ZERO FOR NORMAL RETURN, */ 00057 /* N+I IF T(I,1)*T(I-1,3) IS NEGATIVE, */ 00058 /* 2*N+I IF T(I,1)*T(I-1,3) IS ZERO WITH */ 00059 /* ONE FACTOR NON-ZERO. */ 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 t_dim1 = *nm; 00072 t_offset = t_dim1 + 1; 00073 t -= t_offset; 00074 z_dim1 = *nm; 00075 z_offset = z_dim1 + 1; 00076 z__ -= z_offset; 00077 --e; 00078 --d__; 00079 00080 /* Function Body */ 00081 *ierr = 0; 00082 00083 i__1 = *n; 00084 for (i__ = 1; i__ <= i__1; ++i__) { 00085 00086 i__2 = *n; 00087 for (j = 1; j <= i__2; ++j) { 00088 /* L50: */ 00089 z__[i__ + j * z_dim1] = 0.; 00090 } 00091 00092 if (i__ == 1) { 00093 goto L70; 00094 } 00095 h__ = t[i__ + t_dim1] * t[i__ - 1 + t_dim1 * 3]; 00096 if (h__ < 0.) { 00097 goto L900; 00098 } else if (h__ == 0) { 00099 goto L60; 00100 } else { 00101 goto L80; 00102 } 00103 L60: 00104 if (t[i__ + t_dim1] != 0. || t[i__ - 1 + t_dim1 * 3] != 0.) { 00105 goto L1000; 00106 } 00107 e[i__] = 0.; 00108 L70: 00109 z__[i__ + i__ * z_dim1] = 1.; 00110 goto L90; 00111 L80: 00112 e[i__] = sqrt(h__); 00113 z__[i__ + i__ * z_dim1] = z__[i__ - 1 + (i__ - 1) * z_dim1] * e[i__] / 00114 t[i__ - 1 + t_dim1 * 3]; 00115 L90: 00116 d__[i__] = t[i__ + (t_dim1 << 1)]; 00117 /* L100: */ 00118 } 00119 00120 goto L1001; 00121 /* .......... SET ERROR -- PRODUCT OF SOME PAIR OF OFF-DIAGONAL */ 00122 /* ELEMENTS IS NEGATIVE .......... */ 00123 L900: 00124 *ierr = *n + i__; 00125 goto L1001; 00126 /* .......... SET ERROR -- PRODUCT OF SOME PAIR OF OFF-DIAGONAL */ 00127 /* ELEMENTS IS ZERO WITH ONE MEMBER NON-ZERO .......... */ 00128 L1000: 00129 *ierr = (*n << 1) + i__; 00130 L1001: 00131 return 0; 00132 } /* figi2_ */ |