258 SUBROUTINE ztgsy2( 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 DOUBLE PRECISION rdscal, rdsum, scale
273 COMPLEX*16 a( lda, * ),
b( ldb, * ), c( ldc, * ),
274 $ d( ldd, * ), e(
lde, * ), f( ldf, * )
280 DOUBLE PRECISION zero, one
282 parameter( zero = 0.0d+0, one = 1.0d+0, ldz = 2 )
286 INTEGER i, ierr,
j, k
287 DOUBLE PRECISION scaloc
291 INTEGER ipiv( ldz ), jpiv( ldz )
292 COMPLEX*16 rhs( ldz ), z( ldz, ldz )
302 INTRINSIC dcmplx, dconjg, 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(
'ZTGSY2', -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
zgetc2( ldz, z, ldz, ipiv, jpiv, ierr )
372 CALL
zgesc2( ldz, z, ldz, rhs, ipiv, jpiv, scaloc )
373 IF( scaloc.NE.one )
THEN
375 CALL
zscal( m, dcmplx( scaloc, zero ),
377 CALL
zscal( m, dcmplx( scaloc, zero ),
383 CALL
zlatdf( ijob, ldz, z, ldz, rhs, rdsum, rdscal,
396 CALL
zaxpy( i-1, alpha, a( 1, i ), 1, c( 1,
j ), 1 )
397 CALL
zaxpy( i-1, alpha, d( 1, i ), 1, f( 1,
j ), 1 )
400 CALL
zaxpy( n-
j, rhs( 2 ),
b(
j,
j+1 ), ldb,
422 z( 1, 1 ) = dconjg( a( i, i ) )
423 z( 2, 1 ) = -dconjg(
b(
j,
j ) )
424 z( 1, 2 ) = dconjg( d( i, i ) )
425 z( 2, 2 ) = -dconjg( e(
j,
j ) )
435 CALL
zgetc2( ldz, z, ldz, ipiv, jpiv, ierr )
438 CALL
zgesc2( ldz, z, ldz, rhs, ipiv, jpiv, scaloc )
439 IF( scaloc.NE.one )
THEN
441 CALL
zscal( m, dcmplx( scaloc, zero ), c( 1, k ),
443 CALL
zscal( m, dcmplx( scaloc, zero ), f( 1, k ),
457 f( i, k ) = f( i, k ) + rhs( 1 )*dconjg(
b( k,
j ) ) +
458 $ rhs( 2 )*dconjg( e( k,
j ) )
461 c( k,
j ) = c( k,
j ) - dconjg( a( i, k ) )*rhs( 1 ) -
462 $ dconjg( d( i, k ) )*rhs( 2 )
LOGICAL function lsame(CA, CB)
LSAME
subroutine zgetc2(N, A, LDA, IPIV, JPIV, INFO)
ZGETC2 computes the LU factorization with complete pivoting of the general n-by-n matrix...
subroutine zgesc2(N, A, LDA, RHS, IPIV, JPIV, SCALE)
ZGESC2 solves a system of linear equations using the LU factorization with complete pivoting computed...
LOGICAL function lde(RI, RJ, LR)
subroutine xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine zlatdf(IJOB, N, Z, LDZ, RHS, RDSUM, RDSCAL, IPIV, JPIV)
ZLATDF uses the LU factorization of the n-by-n matrix computed by sgetc2 and computes a contribution ...
subroutine zaxpy(N, ZA, ZX, INCX, ZY, INCY)
ZAXPY
subroutine ztgsy2(TRANS, IJOB, M, N, A, LDA, B, LDB, C, LDC, D, LDD, E, LDE, F, LDF, SCALE, RDSUM, RDSCAL, INFO)
ZTGSY2 solves the generalized Sylvester equation (unblocked algorithm).
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL