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
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
|
subroutine rilac(n,nn,a,na,c,d,rcond,x,w,nnw,z,eps,iwrk,wrk1,wrk2,
& ierr)
C!purpose
C
C to solve the continuous time algebraic equation
C
C trans(a)*x + x*a + c - x*d*x = 0
C
C where trans(a) denotes the transpose of a .
C
C!method
C
C the method used is laub's variant of the hamiltonian -
C eigenvector approach (schur method).
C
C!reference
C
C a.j. laub
C a schur method for solving algebraic riccati equations
C ieee trans. automat. control, vol. ac-25, 1980.
C
C! auxiliary routines
C
C orthes,ortran,balanc,balbak (eispack)
C dgeco,dgesl (linpack)
C hqror2,inva,exchgn,qrstep
C
C! calling sequence
C subroutine rilac(n,nn,a,na,c,d,rcond,x,w,nnw,z,
C + iwrk,wrk1,wrk2,ierr)
C
C integer n,nn,na,nnw,iwrk(nn),ierr
C double precision a(na,n),c(na,n),d(na,n)
C double precision rcond,x(na,n),w(nnw,nn),z(nnw,nn)
C double precision wrk1(nn),wrk2(nn)
C
C arguments in
C
C n integer
C -the order of a,c,d and x
C
C na integer
C -the declared first dimension of a,c,d and x
C
C nn integer
C -the order of w and z
C nn = n + n
C
C nnw integer
C -the declared first dimension of w and z
C
C
C a double precision(n,n)
C
C c double precision(n,n)
C
C d double precision(n,n)
C
C arguments out
C
C x double precision(n,n)
C - x contains the solution matrix
C
C w double precision(nn,nn)
C - w contains the ordered real upper-triangular
C form of the hamiltonian matrix
C
C z double precision(nn,nn)
C - z contains the transformation matrix which
C reduces the hamiltonian matrix to the ordered
C real upper-triangular form
C
C rcond double precision
C - rcond contains an estimate of the reciprocal
C condition of the n-th order system of algebraic
C equations from which the solution matrix is obtained
C
C ierr integer
C -error indicator set on exit
C
C ierr = 0 successful return
C
C ierr = 1 the real upper triangular form of
C the hamiltonian matrix cannot be
C appropriately ordered
C
C ierr = 2 the hamiltonian matrix has less than n
C eigenvalues with negative real parts
C
C ierr = 3 the n-th order system of linear
C algebraic equations, from which the
C solution matrix would be obtained, is
C singular to working precision
C
C ierr = 4 the hamiltonian matrix cannot be
C reduced to upper-triangular form
C
C working space
C
C iwrk integer(nn)
C
C wrk1 double precision(nn)
C
C wrk2 double precision(nn)
C
C!originator
C
C control systems research group, dept. eecs, kingston
C polytechnic, penrhyn rd.,kingston-upon-thames, england.
C
C! comments
C if there is a shortage of storage space, then the
C matrices c and x can share the same locations,
C but this will, of course, result in the loss of c.
C
C*******************************************************************
C
integer n,nn,na,nnw,iwrk(nn),ierr
double precision a(na,n),c(na,n),d(na,n)
double precision rcond,x(na,n),w(nnw,nn),z(nnw,nn)
double precision wrk1(nn),wrk2(nn)
C
C local declarations:
C
integer i,j,low,igh,ni,nj
double precision eps,t(1)
integer folhp
external folhp
logical fail
C
C
C eps is a machine dependent parameter specifying
C the relative precision of realing point arithmetic.
C
C initialise the hamiltonian matrix associated with the problem
C
do 10 j = 1,n
nj = n + j
do 10 i = 1,n
ni = n + i
w(i,j) = a(i,j)
w(ni,j) = -c(i,j)
w(i,nj) = -d(i,j)
w(ni,nj) = -a(j,i)
10 continue
C
call balanc(nnw,nn,w,low,igh,wrk1)
C
call orthes(nn,nn,1,nn,w,wrk2)
call ortran(nn,nn,1,nn,w,wrk2,z)
call hqror2(nn,nn,1,nn,w,t,t,z,ierr,11)
if (ierr .ne. 0) goto 70
call inva(nn,nn,w,z,folhp,eps,ndim,fail,iwrk)
C
if (ierr .ne. 0) goto 40
if (ndim .ne. n) goto 50
C
call balbak(nnw,nn,low,igh,wrk1,nn,z)
C
C
call dgeco(z,nnw,n,iwrk,rcond,wrk1)
if (rcond .lt. eps) goto 60
C
do 30 j = 1,n
nj = n + j
do 20 i = 1,n
x(i,j) = z(nj,i)
20 continue
call dgesl(z,nnw,n,iwrk,x(1,j),1)
30 continue
goto 100
C
40 ierr = 1
goto 100
C
50 ierr = 2
goto 100
C
60 ierr = 3
goto 100
C
70 ierr = 4
goto 100
C
100 return
end
|