134 SUBROUTINE clahilb( N, NRHS, A, LDA, X, LDX, B, LDB, WORK,
143 INTEGER N, NRHS, LDA, LDX, LDB, INFO
146 COMPLEX 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 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)/
189 IF (n .LT. 0 .OR. n .GT. nmax_approx)
THEN
191 ELSE IF (nrhs .LT. 0)
THEN
193 ELSE IF (lda .LT. n)
THEN
195 ELSE IF (ldx .LT. n)
THEN
197 ELSE IF (ldb .LT. n)
THEN
200 IF (info .LT. 0)
THEN
201 CALL xerbla(
'CLAHILB', -info)
204 IF (n .GT. nmax_exact)
THEN
226 IF ( lsamen( 2, c2,
'SY' ) )
THEN
229 a(i, j) = d1(mod(j,size_d)+1) * (
REAL(M) / (i + j - 1))
230 $ * d1(mod(i,size_d)+1)
236 a(i, j) = d1(mod(j,size_d)+1) * (
REAL(M) / (i + j - 1))
237 $ * d2(mod(i,size_d)+1)
245 CALL claset(
'Full', n, nrhs, (0.0,0.0), tmp, b, ldb)
252 work(j) = ( ( (work(j-1)/(j-1)) * (j-1 - n) ) /(j-1) )
258 IF ( lsamen( 2, c2,
'SY' ) )
THEN
262 $ invd1(mod(j,size_d)+1) *
263 $ ((work(i)*work(j)) / (i + j - 1))
264 $ * invd1(mod(i,size_d)+1)
271 $ invd2(mod(j,size_d)+1) *
272 $ ((work(i)*work(j)) / (i + j - 1))
273 $ * invd1(mod(i,size_d)+1)
subroutine clahilb(N, NRHS, A, LDA, X, LDX, B, LDB, WORK, INFO, PATH)
CLAHILB
logical function lsamen(N, CA, CB)
LSAMEN
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...