153 SUBROUTINE ztrsyl( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
161 CHARACTER TRANA, TRANB
162 INTEGER INFO, ISGN, LDA, LDB, LDC, M, N
163 DOUBLE PRECISION SCALE
166 COMPLEX*16 A( LDA, * ), B( LDB, * ), C( LDC, * )
173 parameter( one = 1.0d+0 )
176 LOGICAL NOTRNA, NOTRNB
178 DOUBLE PRECISION BIGNUM, DA11, DB, EPS, SCALOC, SGN, SMIN,
180 COMPLEX*16 A11, SUML, SUMR, VEC, X11
183 DOUBLE PRECISION DUM( 1 )
187 DOUBLE PRECISION DLAMCH, ZLANGE
188 COMPLEX*16 ZDOTC, ZDOTU, ZLADIV
189 EXTERNAL lsame, dlamch, zlange, zdotc, zdotu,
196 INTRINSIC abs, dble, dcmplx, dconjg, dimag, max, min
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(
'ZTRSYL', -info )
231 IF( m.EQ.0 .OR. n.EQ.0 )
237 smlnum = dlamch(
'S' )
238 bignum = one / smlnum
239 smlnum = smlnum*dble( m*n ) / eps
240 bignum = one / smlnum
241 smin = max( smlnum, eps*zlange(
'M', m, m, a, lda, dum ),
242 $ eps*zlange(
'M', n, n, b, ldb, dum ) )
245 IF( notrna .AND. notrnb )
THEN
262 suml = zdotu( m-k, a( k, min( k+1, m ) ), lda,
263 $ c( min( k+1, m ), l ), 1 )
264 sumr = zdotu( 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( dble( a11 ) ) + abs( dimag( a11 ) )
270 IF( da11.LE.smin )
THEN
275 db = abs( dble( vec ) ) + abs( dimag( vec ) )
276 IF( da11.LT.one .AND. db.GT.one )
THEN
277 IF( db.GT.bignum*da11 )
280 x11 = zladiv( vec*dcmplx( scaloc ), a11 )
282 IF( scaloc.NE.one )
THEN
284 CALL zdscal( m, scaloc, c( 1, j ), 1 )
293 ELSE IF( .NOT.notrna .AND. notrnb )
THEN
310 suml = zdotc( k-1, a( 1, k ), 1, c( 1, l ), 1 )
311 sumr = zdotu( l-1, c( k, 1 ), ldc, b( 1, l ), 1 )
312 vec = c( k, l ) - ( suml+sgn*sumr )
315 a11 = dconjg( a( k, k ) ) + sgn*b( l, l )
316 da11 = abs( dble( a11 ) ) + abs( dimag( a11 ) )
317 IF( da11.LE.smin )
THEN
322 db = abs( dble( vec ) ) + abs( dimag( vec ) )
323 IF( da11.LT.one .AND. db.GT.one )
THEN
324 IF( db.GT.bignum*da11 )
328 x11 = zladiv( vec*dcmplx( scaloc ), a11 )
330 IF( scaloc.NE.one )
THEN
332 CALL zdscal( m, scaloc, c( 1, j ), 1 )
341 ELSE IF( .NOT.notrna .AND. .NOT.notrnb )
THEN
361 suml = zdotc( k-1, a( 1, k ), 1, c( 1, l ), 1 )
362 sumr = zdotc( n-l, c( k, min( l+1, n ) ), ldc,
363 $ b( l, min( l+1, n ) ), ldb )
364 vec = c( k, l ) - ( suml+sgn*dconjg( sumr ) )
367 a11 = dconjg( a( k, k )+sgn*b( l, l ) )
368 da11 = abs( dble( a11 ) ) + abs( dimag( a11 ) )
369 IF( da11.LE.smin )
THEN
374 db = abs( dble( vec ) ) + abs( dimag( vec ) )
375 IF( da11.LT.one .AND. db.GT.one )
THEN
376 IF( db.GT.bignum*da11 )
380 x11 = zladiv( vec*dcmplx( scaloc ), a11 )
382 IF( scaloc.NE.one )
THEN
384 CALL zdscal( m, scaloc, c( 1, j ), 1 )
393 ELSE IF( notrna .AND. .NOT.notrnb )
THEN
410 suml = zdotu( m-k, a( k, min( k+1, m ) ), lda,
411 $ c( min( k+1, m ), l ), 1 )
412 sumr = zdotc( n-l, c( k, min( l+1, n ) ), ldc,
413 $ b( l, min( l+1, n ) ), ldb )
414 vec = c( k, l ) - ( suml+sgn*dconjg( sumr ) )
417 a11 = a( k, k ) + sgn*dconjg( b( l, l ) )
418 da11 = abs( dble( a11 ) ) + abs( dimag( a11 ) )
419 IF( da11.LE.smin )
THEN
424 db = abs( dble( vec ) ) + abs( dimag( vec ) )
425 IF( da11.LT.one .AND. db.GT.one )
THEN
426 IF( db.GT.bignum*da11 )
430 x11 = zladiv( vec*dcmplx( scaloc ), a11 )
432 IF( scaloc.NE.one )
THEN
434 CALL zdscal( m, scaloc, c( 1, j ), 1 )