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 claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine clahilb(N, NRHS, A, LDA, X, LDX, B, LDB, WORK, INFO, PATH)
CLAHILB
LOGICAL function lsamen(N, CA, CB)
LSAMEN