157 SUBROUTINE ctrsyl( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
166 CHARACTER TRANA, TRANB
167 INTEGER INFO, ISGN, LDA, LDB, LDC, M, N
171 COMPLEX A( lda, * ), B( ldb, * ), C( ldc, * )
178 parameter ( one = 1.0e+0 )
181 LOGICAL NOTRNA, NOTRNB
183 REAL BIGNUM, DA11, DB, EPS, SCALOC, SGN, SMIN,
185 COMPLEX A11, SUML, SUMR, VEC, X11
193 COMPLEX CDOTC, CDOTU, CLADIV
194 EXTERNAL lsame, clange, slamch, cdotc, cdotu, cladiv
200 INTRINSIC abs, aimag, cmplx, conjg, max, min, real
206 notrna = lsame( trana,
'N' )
207 notrnb = lsame( tranb,
'N' )
210 IF( .NOT.notrna .AND. .NOT.lsame( trana,
'C' ) )
THEN
212 ELSE IF( .NOT.notrnb .AND. .NOT.lsame( tranb,
'C' ) )
THEN
214 ELSE IF( isgn.NE.1 .AND. isgn.NE.-1 )
THEN
216 ELSE IF( m.LT.0 )
THEN
218 ELSE IF( n.LT.0 )
THEN
220 ELSE IF( lda.LT.max( 1, m ) )
THEN
222 ELSE IF( ldb.LT.max( 1, n ) )
THEN
224 ELSE IF( ldc.LT.max( 1, m ) )
THEN
228 CALL xerbla(
'CTRSYL', -info )
235 IF( m.EQ.0 .OR. n.EQ.0 )
241 smlnum = slamch(
'S' )
242 bignum = one / smlnum
243 CALL slabad( smlnum, bignum )
244 smlnum = smlnum*
REAL( M*N ) / EPS
245 bignum = one / smlnum
246 smin = max( smlnum, eps*clange(
'M', m, m, a, lda, dum ),
247 $ eps*clange(
'M', n, n, b, ldb, dum ) )
250 IF( notrna .AND. notrnb )
THEN
267 suml = cdotu( m-k, a( k, min( k+1, m ) ), lda,
268 $ c( min( k+1, m ), l ), 1 )
269 sumr = cdotu( l-1, c( k, 1 ), ldc, b( 1, l ), 1 )
270 vec = c( k, l ) - ( suml+sgn*sumr )
273 a11 = a( k, k ) + sgn*b( l, l )
274 da11 = abs(
REAL( A11 ) ) + abs( AIMAG( a11 ) )
275 IF( da11.LE.smin )
THEN
280 db = abs(
REAL( VEC ) ) + abs( AIMAG( vec ) )
281 IF( da11.LT.one .AND. db.GT.one )
THEN
282 IF( db.GT.bignum*da11 )
285 x11 = cladiv( vec*cmplx( scaloc ), a11 )
287 IF( scaloc.NE.one )
THEN
289 CALL csscal( m, scaloc, c( 1, j ), 1 )
298 ELSE IF( .NOT.notrna .AND. notrnb )
THEN
315 suml = cdotc( k-1, a( 1, k ), 1, c( 1, l ), 1 )
316 sumr = cdotu( l-1, c( k, 1 ), ldc, b( 1, l ), 1 )
317 vec = c( k, l ) - ( suml+sgn*sumr )
320 a11 = conjg( a( k, k ) ) + sgn*b( l, l )
321 da11 = abs(
REAL( A11 ) ) + abs( AIMAG( a11 ) )
322 IF( da11.LE.smin )
THEN
327 db = abs(
REAL( VEC ) ) + abs( AIMAG( vec ) )
328 IF( da11.LT.one .AND. db.GT.one )
THEN
329 IF( db.GT.bignum*da11 )
333 x11 = cladiv( vec*cmplx( scaloc ), a11 )
335 IF( scaloc.NE.one )
THEN
337 CALL csscal( m, scaloc, c( 1, j ), 1 )
346 ELSE IF( .NOT.notrna .AND. .NOT.notrnb )
THEN
366 suml = cdotc( k-1, a( 1, k ), 1, c( 1, l ), 1 )
367 sumr = cdotc( n-l, c( k, min( l+1, n ) ), ldc,
368 $ b( l, min( l+1, n ) ), ldb )
369 vec = c( k, l ) - ( suml+sgn*conjg( sumr ) )
372 a11 = conjg( a( k, k )+sgn*b( l, l ) )
373 da11 = abs(
REAL( A11 ) ) + abs( AIMAG( a11 ) )
374 IF( da11.LE.smin )
THEN
379 db = abs(
REAL( VEC ) ) + abs( AIMAG( vec ) )
380 IF( da11.LT.one .AND. db.GT.one )
THEN
381 IF( db.GT.bignum*da11 )
385 x11 = cladiv( vec*cmplx( scaloc ), a11 )
387 IF( scaloc.NE.one )
THEN
389 CALL csscal( m, scaloc, c( 1, j ), 1 )
398 ELSE IF( notrna .AND. .NOT.notrnb )
THEN
415 suml = cdotu( m-k, a( k, min( k+1, m ) ), lda,
416 $ c( min( k+1, m ), l ), 1 )
417 sumr = cdotc( n-l, c( k, min( l+1, n ) ), ldc,
418 $ b( l, min( l+1, n ) ), ldb )
419 vec = c( k, l ) - ( suml+sgn*conjg( sumr ) )
422 a11 = a( k, k ) + sgn*conjg( b( l, l ) )
423 da11 = abs(
REAL( A11 ) ) + abs( AIMAG( a11 ) )
424 IF( da11.LE.smin )
THEN
429 db = abs(
REAL( VEC ) ) + abs( AIMAG( vec ) )
430 IF( da11.LT.one .AND. db.GT.one )
THEN
431 IF( db.GT.bignum*da11 )
435 x11 = cladiv( vec*cmplx( scaloc ), a11 )
437 IF( scaloc.NE.one )
THEN
439 CALL csscal( m, scaloc, c( 1, j ), 1 )
subroutine ctrsyl(TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, LDC, SCALE, INFO)
CTRSYL
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine slabad(SMALL, LARGE)
SLABAD
subroutine csscal(N, SA, CX, INCX)
CSSCAL