254 SUBROUTINE ctgsy2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC,
256 $ LDD, E, LDE, F, LDF, SCALE, RDSUM, RDSCAL,
265 INTEGER IJOB, INFO, LDA, LDB, LDC, LDD, LDE, LDF, M, N
266 REAL RDSCAL, RDSUM, SCALE
269 COMPLEX A( LDA, * ), B( LDB, * ), C( LDC, * ),
270 $ D( LDD, * ), E( LDE, * ), F( LDF, * )
278 PARAMETER ( ZERO = 0.0e+0, one = 1.0e+0, ldz = 2 )
282 INTEGER I, IERR, J, K
287 INTEGER IPIV( LDZ ), JPIV( LDZ )
288 COMPLEX RHS( LDZ ), Z( LDZ, LDZ )
299 INTRINSIC cmplx, conjg, max
307 notran = lsame( trans,
'N' )
308 IF( .NOT.notran .AND. .NOT.lsame( trans,
'C' ) )
THEN
310 ELSE IF( notran )
THEN
311 IF( ( ijob.LT.0 ) .OR. ( ijob.GT.2 ) )
THEN
318 ELSE IF( n.LE.0 )
THEN
320 ELSE IF( lda.LT.max( 1, m ) )
THEN
322 ELSE IF( ldb.LT.max( 1, n ) )
THEN
324 ELSE IF( ldc.LT.max( 1, m ) )
THEN
326 ELSE IF( ldd.LT.max( 1, m ) )
THEN
328 ELSE IF( lde.LT.max( 1, n ) )
THEN
330 ELSE IF( ldf.LT.max( 1, m ) )
THEN
335 CALL xerbla(
'CTGSY2', -info )
353 z( 1, 1 ) = a( i, i )
354 z( 2, 1 ) = d( i, i )
355 z( 1, 2 ) = -b( j, j )
356 z( 2, 2 ) = -e( j, j )
365 CALL cgetc2( ldz, z, ldz, ipiv, jpiv, ierr )
369 CALL cgesc2( ldz, z, ldz, rhs, ipiv, jpiv, scaloc )
370 IF( scaloc.NE.one )
THEN
372 CALL cscal( m, cmplx( scaloc, zero ), c( 1,
375 CALL cscal( m, cmplx( scaloc, zero ), f( 1,
382 CALL clatdf( ijob, ldz, z, ldz, rhs, rdsum, rdscal,
395 CALL caxpy( i-1, alpha, a( 1, i ), 1, c( 1, j ),
397 CALL caxpy( i-1, alpha, d( 1, i ), 1, f( 1, j ),
401 CALL caxpy( n-j, rhs( 2 ), b( j, j+1 ), ldb,
403 CALL caxpy( n-j, rhs( 2 ), e( j, j+1 ), lde,
423 z( 1, 1 ) = conjg( a( i, i ) )
424 z( 2, 1 ) = -conjg( b( j, j ) )
425 z( 1, 2 ) = conjg( d( i, i ) )
426 z( 2, 2 ) = -conjg( e( j, j ) )
436 CALL cgetc2( ldz, z, ldz, ipiv, jpiv, ierr )
439 CALL cgesc2( ldz, z, ldz, rhs, ipiv, jpiv, scaloc )
440 IF( scaloc.NE.one )
THEN
442 CALL cscal( m, cmplx( scaloc, zero ), c( 1, k ),
444 CALL cscal( m, cmplx( scaloc, zero ), f( 1, k ),
458 f( i, k ) = f( i, k ) + rhs( 1 )*conjg( b( k, j ) ) +
459 $ rhs( 2 )*conjg( e( k, j ) )
462 c( k, j ) = c( k, j ) - conjg( a( i, k ) )*rhs( 1 ) -
463 $ conjg( d( i, k ) )*rhs( 2 )
subroutine ctgsy2(trans, ijob, m, n, a, lda, b, ldb, c, ldc, d, ldd, e, lde, f, ldf, scale, rdsum, rdscal, info)
CTGSY2 solves the generalized Sylvester equation (unblocked algorithm).