153 SUBROUTINE ctrsyl( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
161 CHARACTER TRANA, TRANB
162 INTEGER INFO, ISGN, LDA, LDB, LDC, M, N
166 COMPLEX A( LDA, * ), B( LDB, * ), C( LDC, * )
173 parameter( one = 1.0e+0 )
176 LOGICAL NOTRNA, NOTRNB
178 REAL BIGNUM, DA11, DB, EPS, SCALOC, SGN, SMIN,
180 COMPLEX A11, SUML, SUMR, VEC, X11
188 COMPLEX CDOTC, CDOTU, CLADIV
189 EXTERNAL lsame, clange, slamch, cdotc, cdotu,
196 INTRINSIC abs, aimag, cmplx, conjg, max, min, real
202 notrna = lsame( trana,
'N' )
203 notrnb = lsame( tranb,
'N' )
206 IF( .NOT.notrna .AND. .NOT.lsame( trana,
'C' ) )
THEN
208 ELSE IF( .NOT.notrnb .AND. .NOT.lsame( tranb,
'C' ) )
THEN
210 ELSE IF( isgn.NE.1 .AND. isgn.NE.-1 )
THEN
212 ELSE IF( m.LT.0 )
THEN
214 ELSE IF( n.LT.0 )
THEN
216 ELSE IF( lda.LT.max( 1, m ) )
THEN
218 ELSE IF( ldb.LT.max( 1, n ) )
THEN
220 ELSE IF( ldc.LT.max( 1, m ) )
THEN
224 CALL xerbla(
'CTRSYL', -info )
231 IF( m.EQ.0 .OR. n.EQ.0 )
237 smlnum = slamch(
'S' )
238 bignum = one / smlnum
239 smlnum = smlnum*real( m*n ) / eps
240 bignum = one / smlnum
241 smin = max( smlnum, eps*clange(
'M', m, m, a, lda, dum ),
242 $ eps*clange(
'M', n, n, b, ldb, dum ) )
245 IF( notrna .AND. notrnb )
THEN
262 suml = cdotu( m-k, a( k, min( k+1, m ) ), lda,
263 $ c( min( k+1, m ), l ), 1 )
264 sumr = cdotu( l-1, c( k, 1 ), ldc, b( 1, l ), 1 )
265 vec = c( k, l ) - ( suml+sgn*sumr )
268 a11 = a( k, k ) + sgn*b( l, l )
269 da11 = abs( real( a11 ) ) + abs( aimag( a11 ) )
270 IF( da11.LE.smin )
THEN
275 db = abs( real( vec ) ) + abs( aimag( vec ) )
276 IF( da11.LT.one .AND. db.GT.one )
THEN
277 IF( db.GT.bignum*da11 )
280 x11 = cladiv( vec*cmplx( scaloc ), a11 )
282 IF( scaloc.NE.one )
THEN
284 CALL csscal( m, scaloc, c( 1, j ), 1 )
293 ELSE IF( .NOT.notrna .AND. notrnb )
THEN
310 suml = cdotc( k-1, a( 1, k ), 1, c( 1, l ), 1 )
311 sumr = cdotu( l-1, c( k, 1 ), ldc, b( 1, l ), 1 )
312 vec = c( k, l ) - ( suml+sgn*sumr )
315 a11 = conjg( a( k, k ) ) + sgn*b( l, l )
316 da11 = abs( real( a11 ) ) + abs( aimag( a11 ) )
317 IF( da11.LE.smin )
THEN
322 db = abs( real( vec ) ) + abs( aimag( vec ) )
323 IF( da11.LT.one .AND. db.GT.one )
THEN
324 IF( db.GT.bignum*da11 )
328 x11 = cladiv( vec*cmplx( scaloc ), a11 )
330 IF( scaloc.NE.one )
THEN
332 CALL csscal( m, scaloc, c( 1, j ), 1 )
341 ELSE IF( .NOT.notrna .AND. .NOT.notrnb )
THEN
361 suml = cdotc( k-1, a( 1, k ), 1, c( 1, l ), 1 )
362 sumr = cdotc( n-l, c( k, min( l+1, n ) ), ldc,
363 $ b( l, min( l+1, n ) ), ldb )
364 vec = c( k, l ) - ( suml+sgn*conjg( sumr ) )
367 a11 = conjg( a( k, k )+sgn*b( l, l ) )
368 da11 = abs( real( a11 ) ) + abs( aimag( a11 ) )
369 IF( da11.LE.smin )
THEN
374 db = abs( real( vec ) ) + abs( aimag( vec ) )
375 IF( da11.LT.one .AND. db.GT.one )
THEN
376 IF( db.GT.bignum*da11 )
380 x11 = cladiv( vec*cmplx( scaloc ), a11 )
382 IF( scaloc.NE.one )
THEN
384 CALL csscal( m, scaloc, c( 1, j ), 1 )
393 ELSE IF( notrna .AND. .NOT.notrnb )
THEN
410 suml = cdotu( m-k, a( k, min( k+1, m ) ), lda,
411 $ c( min( k+1, m ), l ), 1 )
412 sumr = cdotc( n-l, c( k, min( l+1, n ) ), ldc,
413 $ b( l, min( l+1, n ) ), ldb )
414 vec = c( k, l ) - ( suml+sgn*conjg( sumr ) )
417 a11 = a( k, k ) + sgn*conjg( b( l, l ) )
418 da11 = abs( real( a11 ) ) + abs( aimag( a11 ) )
419 IF( da11.LE.smin )
THEN
424 db = abs( real( vec ) ) + abs( aimag( vec ) )
425 IF( da11.LT.one .AND. db.GT.one )
THEN
426 IF( db.GT.bignum*da11 )
430 x11 = cladiv( vec*cmplx( scaloc ), a11 )
432 IF( scaloc.NE.one )
THEN
434 CALL csscal( m, scaloc, c( 1, j ), 1 )