132 SUBROUTINE zlahilb( N, NRHS, A, LDA, X, LDX, B, LDB, WORK,
140 INTEGER N, NRHS, LDA, LDX, LDB, INFO
142 DOUBLE PRECISION WORK(N)
143 COMPLEX*16 A(LDA,N), X(LDX, NRHS), B(LDB, NRHS)
161 INTEGER NMAX_EXACT, NMAX_APPROX, SIZE_D
162 parameter(nmax_exact = 6, nmax_approx = 11, size_d = 8)
165 COMPLEX*16 d1(8), d2(8), invd1(8), invd2(8)
166 DATA d1 /(-1,0),(0,1),(-1,-1),(0,-1),(1,0),(-1,1),(1,1),(1,-1)/
167 DATA d2 /(-1,0),(0,-1),(-1,1),(0,1),(1,0),(-1,-1),(1,-1),(1,1)/
169 DATA invd1 /(-1,0),(0,-1),(-.5,.5),(0,1),(1,0),
170 $ (-.5,-.5),(.5,-.5),(.5,.5)/
171 DATA invd2 /(-1,0),(0,1),(-.5,-.5),(0,-1),(1,0),
172 $ (-.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
225 IF ( lsamen( 2, c2,
'SY' ) )
THEN
228 a(i, j) = d1(mod(j,size_d)+1) * (dble(m) / (i + j - 1))
229 $ * d1(mod(i,size_d)+1)
235 a(i, j) = d1(mod(j,size_d)+1) * (dble(m) / (i + j - 1))
236 $ * d2(mod(i,size_d)+1)
244 CALL zlaset(
'Full', n, nrhs, (0.0d+0,0.0d+0), tmp, b, ldb)
251 work(j) = ( ( (work(j-1)/(j-1)) * (j-1 - n) ) /(j-1) )
257 IF ( lsamen( 2, c2,
'SY' ) )
THEN
260 x(i, j) = invd1(mod(j,size_d)+1) *
261 $ ((work(i)*work(j)) / (i + j - 1))
262 $ * invd1(mod(i,size_d)+1)
268 x(i, j) = invd2(mod(j,size_d)+1) *
269 $ ((work(i)*work(j)) / (i + j - 1))
270 $ * invd1(mod(i,size_d)+1)
logical function lsamen(N, CA, CB)
LSAMEN
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zlahilb(N, NRHS, A, LDA, X, LDX, B, LDB, WORK, INFO, PATH)
ZLAHILB
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.