134 SUBROUTINE zlahilb(N, NRHS, A, LDA, X, LDX, B, LDB, WORK,
143 INTEGER n, nrhs, lda, ldx, ldb, info
145 DOUBLE PRECISION work(n)
146 COMPLEX*16 a(lda,n), x(ldx, nrhs),
b(ldb, nrhs)
164 INTEGER nmax_exact, nmax_approx, size_d
165 parameter(nmax_exact = 6, nmax_approx = 11, size_d = 8)
168 COMPLEX*16 d1(8), d2(8), invd1(8), invd2(8)
169 DATA d1 /(-1,0),(0,1),(-1,-1),(0,-1),(1,0),(-1,1),(1,1),(1,-1)/
170 DATA d2 /(-1,0),(0,-1),(-1,1),(0,1),(1,0),(-1,-1),(1,-1),(1,1)/
172 DATA invd1 /(-1,0),(0,-1),(-.5,.5),(0,1),(1,0),
173 $ (-.5,-.5),(.5,-.5),(.5,.5)/
174 DATA invd2 /(-1,0),(0,1),(-.5,-.5),(0,-1),(1,0),
175 $ (-.5,.5),(.5,.5),(.5,-.5)/
188 IF (n .LT. 0 .OR. n .GT. nmax_approx)
THEN
190 ELSE IF (nrhs .LT. 0)
THEN
192 ELSE IF (lda .LT. n)
THEN
194 ELSE IF (ldx .LT. n)
THEN
196 ELSE IF (ldb .LT. n)
THEN
199 IF (info .LT. 0)
THEN
200 CALL
xerbla(
'ZLAHILB', -info)
203 IF (n .GT. nmax_exact)
THEN
224 IF (
lsamen( 2, c2,
'SY' ) )
THEN
227 a(i,
j) = d1(mod(
j,size_d)+1) * (dble(m) / (i +
j - 1))
228 $ * d1(mod(i,size_d)+1)
234 a(i,
j) = d1(mod(
j,size_d)+1) * (dble(m) / (i +
j - 1))
235 $ * d2(mod(i,size_d)+1)
243 CALL
zlaset(
'Full', n, nrhs, (0.0d+0,0.0d+0), tmp,
b, ldb)
250 work(
j) = ( ( (work(
j-1)/(
j-1)) * (
j-1 - n) ) /(
j-1) )
255 IF (
lsamen( 2, c2,
'SY' ) )
THEN
258 x(i,
j) = invd1(mod(
j,size_d)+1) *
259 $ ((work(i)*work(
j)) / (i +
j - 1))
260 $ * invd1(mod(i,size_d)+1)
266 x(i,
j) = invd2(mod(
j,size_d)+1) *
267 $ ((work(i)*work(
j)) / (i +
j - 1))
268 $ * invd1(mod(i,size_d)+1)
subroutine zlahilb(N, NRHS, A, LDA, X, LDX, B, LDB, WORK, INFO, PATH)
ZLAHILB
subroutine xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
logical function lsamen(N, CA, CB)
LSAMEN
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j