1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
|
/* eispack/rg.f -- translated by f2c (version 20050501).
You must link the resulting object file with libf2c:
on Microsoft Windows system, link with libf2c.lib;
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
or, if you install libf2c.a in a standard place, with -lf2c -lm
-- in that order, at the end of the command line, as in
cc *.o -lf2c -lm
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
http://www.netlib.org/f2c/libf2c.zip
*/
#ifdef __cplusplus
extern "C" {
#endif
#include "v3p_netlib.h"
/*< subroutine rg(nm,n,a,wr,wi,matz,z,iv1,fv1,ierr) >*/
/* Subroutine */ int rg_(integer *nm, integer *n, doublereal *a, doublereal *
wr, doublereal *wi, integer *matz, doublereal *z__, integer *iv1,
doublereal *fv1, integer *ierr)
{
/* System generated locals */
integer a_dim1, a_offset, z_dim1, z_offset;
/* Local variables */
integer is1, is2;
extern /* Subroutine */ int hqr_(integer *, integer *, integer *, integer
*, doublereal *, doublereal *, doublereal *, integer *), hqr2_(
integer *, integer *, integer *, integer *, doublereal *,
doublereal *, doublereal *, doublereal *, integer *), balbak_(
integer *, integer *, integer *, integer *, doublereal *, integer
*, doublereal *), balanc_(integer *, integer *, doublereal *,
integer *, integer *, doublereal *), elmhes_(integer *, integer *,
integer *, integer *, doublereal *, integer *), eltran_(integer *
, integer *, integer *, integer *, doublereal *, integer *,
doublereal *);
/*< integer n,nm,is1,is2,ierr,matz >*/
/*< double precision a(nm,n),wr(n),wi(n),z(nm,n),fv1(n) >*/
/*< integer iv1(n) >*/
/* this subroutine calls the recommended sequence of */
/* subroutines from the eigensystem subroutine package (eispack) */
/* to find the eigenvalues and eigenvectors (if desired) */
/* of a real general matrix. */
/* on input */
/* nm must be set to the row dimension of the two-dimensional */
/* array parameters as declared in the calling program */
/* dimension statement. */
/* n is the order of the matrix a. */
/* a contains the real general matrix. */
/* matz is an integer variable set equal to zero if */
/* only eigenvalues are desired. otherwise it is set to */
/* any non-zero integer for both eigenvalues and eigenvectors. */
/* on output */
/* wr and wi contain the real and imaginary parts, */
/* respectively, of the eigenvalues. complex conjugate */
/* pairs of eigenvalues appear consecutively with the */
/* eigenvalue having the positive imaginary part first. */
/* z contains the real and imaginary parts of the eigenvectors */
/* if matz is not zero. if the j-th eigenvalue is real, the */
/* j-th column of z contains its eigenvector. if the j-th */
/* eigenvalue is complex with positive imaginary part, the */
/* j-th and (j+1)-th columns of z contain the real and */
/* imaginary parts of its eigenvector. the conjugate of this */
/* vector is the eigenvector for the conjugate eigenvalue. */
/* ierr is an integer output variable set equal to an error */
/* completion code described in the documentation for hqr */
/* and hqr2. the normal completion code is zero. */
/* iv1 and fv1 are temporary storage arrays. */
/* questions and comments should be directed to burton s. garbow, */
/* mathematics and computer science div, argonne national laboratory */
/* this version dated august 1983. */
/* ------------------------------------------------------------------ */
/*< if (n .le. nm) go to 10 >*/
/* Parameter adjustments */
--fv1;
--iv1;
z_dim1 = *nm;
z_offset = 1 + z_dim1;
z__ -= z_offset;
--wi;
--wr;
a_dim1 = *nm;
a_offset = 1 + a_dim1;
a -= a_offset;
/* Function Body */
if (*n <= *nm) {
goto L10;
}
/*< ierr = 10 * n >*/
*ierr = *n * 10;
/*< go to 50 >*/
goto L50;
/*< 10 call balanc(nm,n,a,is1,is2,fv1) >*/
L10:
balanc_(nm, n, &a[a_offset], &is1, &is2, &fv1[1]);
/*< call elmhes(nm,n,is1,is2,a,iv1) >*/
elmhes_(nm, n, &is1, &is2, &a[a_offset], &iv1[1]);
/*< if (matz .ne. 0) go to 20 >*/
if (*matz != 0) {
goto L20;
}
/* .......... find eigenvalues only .......... */
/*< call hqr(nm,n,is1,is2,a,wr,wi,ierr) >*/
hqr_(nm, n, &is1, &is2, &a[a_offset], &wr[1], &wi[1], ierr);
/*< go to 50 >*/
goto L50;
/* .......... find both eigenvalues and eigenvectors .......... */
/*< 20 call eltran(nm,n,is1,is2,a,iv1,z) >*/
L20:
eltran_(nm, n, &is1, &is2, &a[a_offset], &iv1[1], &z__[z_offset]);
/*< call hqr2(nm,n,is1,is2,a,wr,wi,z,ierr) >*/
hqr2_(nm, n, &is1, &is2, &a[a_offset], &wr[1], &wi[1], &z__[z_offset],
ierr);
/*< if (ierr .ne. 0) go to 50 >*/
if (*ierr != 0) {
goto L50;
}
/*< call balbak(nm,n,is1,is2,fv1,n,z) >*/
balbak_(nm, n, &is1, &is2, &fv1[1], n, &z__[z_offset]);
/*< 50 return >*/
L50:
return 0;
/*< end >*/
} /* rg_ */
#ifdef __cplusplus
}
#endif
|
