258 SUBROUTINE ctgsy2( TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D,
259 $ ldd, e, lde, f, ldf, scale, rdsum, rdscal,
269 INTEGER IJOB, INFO, LDA, LDB, LDC, LDD, LDE, LDF, M, N
270 REAL RDSCAL, RDSUM, SCALE
273 COMPLEX A( lda, * ), B( ldb, * ), C( ldc, * ),
274 $ d( ldd, * ), e( lde, * ), f( ldf, * )
282 parameter( zero = 0.0e+0, one = 1.0e+0, ldz = 2 )
286 INTEGER I, IERR, J, K
291 INTEGER IPIV( ldz ), JPIV( ldz )
292 COMPLEX RHS( ldz ), Z( ldz, ldz )
302 INTRINSIC cmplx, conjg, max
310 notran = lsame( trans,
'N' )
311 IF( .NOT.notran .AND. .NOT.lsame( trans,
'C' ) )
THEN
313 ELSE IF( notran )
THEN
314 IF( ( ijob.LT.0 ) .OR. ( ijob.GT.2 ) )
THEN
321 ELSE IF( n.LE.0 )
THEN
323 ELSE IF( lda.LT.max( 1, m ) )
THEN
325 ELSE IF( ldb.LT.max( 1, n ) )
THEN
327 ELSE IF( ldc.LT.max( 1, m ) )
THEN
329 ELSE IF( ldd.LT.max( 1, m ) )
THEN
331 ELSE IF( lde.LT.max( 1, n ) )
THEN
333 ELSE IF( ldf.LT.max( 1, m ) )
THEN
338 CALL
xerbla(
'CTGSY2', -info )
356 z( 1, 1 ) = a( i, i )
357 z( 2, 1 ) = d( i, i )
358 z( 1, 2 ) = -b( j, j )
359 z( 2, 2 ) = -e( j, j )
368 CALL
cgetc2( ldz, z, ldz, ipiv, jpiv, ierr )
372 CALL
cgesc2( ldz, z, ldz, rhs, ipiv, jpiv, scaloc )
373 IF( scaloc.NE.one )
THEN
375 CALL
cscal( m, cmplx( scaloc, zero ), c( 1, k ),
377 CALL
cscal( m, cmplx( scaloc, zero ), f( 1, k ),
383 CALL
clatdf( ijob, ldz, z, ldz, rhs, rdsum, rdscal,
396 CALL
caxpy( i-1, alpha, a( 1, i ), 1, c( 1, j ), 1 )
397 CALL
caxpy( i-1, alpha, d( 1, i ), 1, f( 1, j ), 1 )
400 CALL
caxpy( n-j, rhs( 2 ), b( j, j+1 ), ldb,
402 CALL
caxpy( n-j, rhs( 2 ), e( j, j+1 ), lde,
422 z( 1, 1 ) = conjg( a( i, i ) )
423 z( 2, 1 ) = -conjg( b( j, j ) )
424 z( 1, 2 ) = conjg( d( i, i ) )
425 z( 2, 2 ) = -conjg( e( j, j ) )
435 CALL
cgetc2( ldz, z, ldz, ipiv, jpiv, ierr )
438 CALL
cgesc2( ldz, z, ldz, rhs, ipiv, jpiv, scaloc )
439 IF( scaloc.NE.one )
THEN
441 CALL
cscal( m, cmplx( scaloc, zero ), c( 1, k ),
443 CALL
cscal( m, cmplx( scaloc, zero ), f( 1, k ),
457 f( i, k ) = f( i, k ) + rhs( 1 )*conjg( b( k, j ) ) +
458 $ rhs( 2 )*conjg( e( k, j ) )
461 c( k, j ) = c( k, j ) - conjg( a( i, k ) )*rhs( 1 ) -
462 $ conjg( d( i, k ) )*rhs( 2 )
subroutine cscal(N, CA, CX, INCX)
CSCAL
subroutine caxpy(N, CA, CX, INCX, CY, INCY)
CAXPY
subroutine cgetc2(N, A, LDA, IPIV, JPIV, INFO)
CGETC2 computes the LU factorization with complete pivoting of the general n-by-n matrix...
subroutine xerbla(SRNAME, INFO)
XERBLA
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).
subroutine cgesc2(N, A, LDA, RHS, IPIV, JPIV, SCALE)
CGESC2 solves a system of linear equations using the LU factorization with complete pivoting computed...
subroutine clatdf(IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV, JPIV)
CLATDF uses the LU factorization of the n-by-n matrix computed by sgetc2 and computes a contribution ...