134 SUBROUTINE clahilb(N, NRHS, A, LDA, X, LDX, B, LDB, WORK,
143 INTEGER t, 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)/
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(
'CLAHILB', -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) * (
REAL(M) / (i +
j - 1))
228 $ * d1(mod(i,size_d)+1)
234 a(i,
j) = d1(mod(
j,size_d)+1) * (
REAL(M) / (i +
j - 1))
235 $ * d2(mod(i,size_d)+1)
243 CALL
claset(
'Full', n, nrhs, (0.0,0.0), tmp,
b, ldb)
250 work(
j) = ( ( (work(
j-1)/(
j-1)) * (
j-1 - n) ) /(
j-1) )
255 IF (
lsamen( 2, c2,
'SY' ) )
THEN
259 $ invd1(mod(
j,size_d)+1) *
260 $ ((work(i)*work(
j)) / (i +
j - 1))
261 $ * invd1(mod(i,size_d)+1)
268 $ invd2(mod(
j,size_d)+1) *
269 $ ((work(i)*work(
j)) / (i +
j - 1))
270 $ * 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