DragonFly On-Line Manual Pages
PZHENGST(l) ) PZHENGST(l)
NAME
SYNOPSIS
SUBROUTINE PZHENGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB,
DESCB, SCALE, WORK, LWORK, INFO )
CHARACTER UPLO
INTEGER IA, IB, IBTYPE, INFO, JA, JB, LWORK, N
DOUBLE PRECISION SCALE
INTEGER DESCA( * ), DESCB( * )
COMPLEX*16 A( * ), B( * ), WORK( * )
COMPLEX*16 ONEHALF, ONE, MONE
DOUBLE PRECISION RONE
PARAMETER ( ONEHALF = ( 0.5D0, 0.0D0 ), ONE = ( 1.0D0, 0.0D0 ),
MONE = ( -1.0D0, 0.0D0 ), RONE = 1.0D0 )
INTEGER DLEN_, CTXT_, MB_, NB_, RSRC_, CSRC_, LLD_
PARAMETER ( DLEN_ = 9, CTXT_ = 2, MB_ = 5, NB_ = 6, RSRC_ = 7,
CSRC_ = 8, LLD_ = 9 )
LOGICAL LQUERY, UPPER
INTEGER I, IACOL, IAROW, IBCOL, IBROW, ICOFFA, ICOFFB, ICTXT,
INDAA, INDG, INDR, INDRT, IROFFA, IROFFB, J, K, KB, LWMIN, LWOPT,
MYCOL, MYROW, NB, NP0, NPCOL, NPK, NPROW, NQ0, POSTK
INTEGER DESCAA( DLEN_ ), DESCG( DLEN_ ), DESCR( DLEN_ ), DESCRT(
DLEN_ ), IDUM1( 2 ), IDUM2( 2 )
LOGICAL LSAME
INTEGER INDXG2P, NUMROC
EXTERNAL LSAME, INDXG2P, NUMROC
EXTERNAL BLACS_GRIDINFO, CHK1MAT, DESCSET, PCHK2MAT, PXERBLA,
PZGEMM, PZHEGST, PZHEMM, PZHER2K, PZLACPY, PZTRSM
INTRINSIC DBLE, DCMPLX, DCONJG, ICHAR, MAX, MIN, MOD
ICTXT = DESCA( CTXT_ )
CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL )
SCALE = 1.0D0
NB = DESCA( MB_ )
INFO = 0
IF( NPROW.EQ.-1 ) THEN
INFO = -( 700+CTXT_ )
ELSE
UPPER = LSAME( UPLO, 'U' )
CALL CHK1MAT( N, 3, N, 3, IA, JA, DESCA, 7, INFO )
CALL CHK1MAT( N, 3, N, 3, IB, JB, DESCB, 11, INFO )
IF( INFO.EQ.0 ) THEN
IAROW = INDXG2P( IA, DESCA( MB_ ), MYROW, DESCA( RSRC_ ), NPROW )
IBROW = INDXG2P( IB, DESCB( MB_ ), MYROW, DESCB( RSRC_ ), NPROW )
IACOL = INDXG2P( JA, DESCA( NB_ ), MYCOL, DESCA( CSRC_ ), NPCOL )
IBCOL = INDXG2P( JB, DESCB( NB_ ), MYCOL, DESCB( CSRC_ ), NPCOL )
IROFFA = MOD( IA-1, DESCA( MB_ ) )
ICOFFA = MOD( JA-1, DESCA( NB_ ) )
IROFFB = MOD( IB-1, DESCB( MB_ ) )
ICOFFB = MOD( JB-1, DESCB( NB_ ) )
NP0 = NUMROC( N, NB, 0, 0, NPROW )
NQ0 = NUMROC( N, NB, 0, 0, NPCOL )
LWMIN = MAX( NB*( NP0+1 ), 3*NB )
IF( IBTYPE.EQ.1 .AND. .NOT.UPPER ) THEN
LWOPT = 2*NP0*NB + NQ0*NB + NB*NB
ELSE
LWOPT = LWMIN
END IF
WORK( 1 ) = DCMPLX( DBLE( LWOPT ) )
LQUERY = ( LWORK.EQ.-1 )
IF( IBTYPE.LT.1 .OR. IBTYPE.GT.3 ) THEN
INFO = -1
ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
INFO = -2
ELSE IF( N.LT.0 ) THEN
INFO = -3
ELSE IF( IROFFA.NE.0 ) THEN
INFO = -5
ELSE IF( ICOFFA.NE.0 ) THEN
INFO = -6
ELSE IF( DESCA( MB_ ).NE.DESCA( NB_ ) ) THEN
INFO = -( 700+NB_ )
ELSE IF( IROFFB.NE.0 .OR. IBROW.NE.IAROW ) THEN
INFO = -9
ELSE IF( ICOFFB.NE.0 .OR. IBCOL.NE.IACOL ) THEN
INFO = -10
ELSE IF( DESCB( MB_ ).NE.DESCA( MB_ ) ) THEN
INFO = -( 1100+MB_ )
ELSE IF( DESCB( NB_ ).NE.DESCA( NB_ ) ) THEN
INFO = -( 1100+NB_ )
ELSE IF( ICTXT.NE.DESCB( CTXT_ ) ) THEN
INFO = -( 1100+CTXT_ )
ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
INFO = -13
END IF
END IF
IDUM1( 1 ) = IBTYPE
IDUM2( 1 ) = 1
IF( UPPER ) THEN
IDUM1( 2 ) = ICHAR( 'U' )
ELSE
IDUM1( 2 ) = ICHAR( 'L' )
END IF
IDUM2( 2 ) = 2
CALL PCHK2MAT( N, 3, N, 3, IA, JA, DESCA, 7, N, 3, N, 3, IB, JB,
DESCB, 11, 2, IDUM1, IDUM2, INFO )
END IF
IF( INFO.NE.0 ) THEN
CALL PXERBLA( ICTXT, 'PZHENGST', -INFO )
RETURN
ELSE IF( LQUERY ) THEN
RETURN
END IF
IF( N.EQ.0 ) RETURN
IF( IBTYPE.NE.1 .OR. UPPER .OR. LWORK.LT.LWOPT ) THEN
CALL PZHEGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB, JB, DESCB,
SCALE, INFO )
RETURN
END IF
CALL DESCSET( DESCG, N, NB, NB, NB, IAROW, IACOL, ICTXT, NP0 )
CALL DESCSET( DESCR, N, NB, NB, NB, IAROW, IACOL, ICTXT, NP0 )
CALL DESCSET( DESCRT, NB, N, NB, NB, IAROW, IACOL, ICTXT, NB )
CALL DESCSET( DESCAA, NB, NB, NB, NB, IAROW, IACOL, ICTXT, NB )
INDG = 1
INDR = INDG + DESCG( LLD_ )*NB
INDAA = INDR + DESCR( LLD_ )*NB
INDRT = INDAA + DESCAA( LLD_ )*NB
DO 30 K = 1, N, NB
KB = MIN( N-K+1, NB )
POSTK = K + KB
NPK = N - POSTK + 1
CALL PZLACPY( 'A', N-POSTK+1, KB, B, POSTK+IB-1, K+JB-1, DESCB,
WORK( INDG ), POSTK, 1, DESCG )
CALL PZLACPY( 'A', N-POSTK+1, KB, A, POSTK+IA-1, K+JA-1, DESCA,
WORK( INDR ), POSTK, 1, DESCR )
CALL PZLACPY( 'A', KB, K-1, A, K+IA-1, JA, DESCA, WORK( INDRT ), 1,
1, DESCRT )
CALL PZLACPY( 'L', KB, KB, A, K+IA-1, K+JA-1, DESCA, WORK( INDR ),
K, 1, DESCR )
CALL PZTRSM( 'Right', 'L', 'N', 'N', NPK, KB, MONE, B, K+IB-1,
K+JB-1, DESCB, WORK( INDG ), POSTK, 1, DESCG )
CALL PZHEMM( 'Right', 'L', NPK, KB, ONEHALF, A, K+IA-1, K+JA-1,
DESCA, WORK( INDG ), POSTK, 1, DESCG, ONE, WORK( INDR ), POSTK, 1,
DESCR )
CALL PZHER2K( 'Lower', 'No T', NPK, KB, ONE, WORK( INDG ), POSTK,
1, DESCG, WORK( INDR ), POSTK, 1, DESCR, RONE, A, POSTK+IA-1,
POSTK+JA-1, DESCA )
CALL PZGEMM( 'No T', 'No Conj', NPK, K-1, KB, ONE, WORK( INDG ),
POSTK, 1, DESCG, WORK( INDRT ), 1, 1, DESCRT, ONE, A, POSTK+IA-1, JA,
DESCA )
CALL PZHEMM( 'Right', 'L', NPK, KB, ONE, WORK( INDR ), K, 1, DESCR,
WORK( INDG ), POSTK, 1, DESCG, ONE, A, POSTK+IA-1, K+JA-1, DESCA )
CALL PZTRSM( 'Left', 'Lower', 'No Conj', 'Non-unit', KB, K-1, ONE,
B, K+IB-1, K+JB-1, DESCB, A, K+IA-1, JA, DESCA )
CALL PZLACPY( 'L', KB, KB, A, K+IA-1, K+JA-1, DESCA, WORK( INDAA ),
1, 1, DESCAA )
IF( MYROW.EQ.DESCAA( RSRC_ ) .AND. MYCOL.EQ.DESCAA( CSRC_ ) ) THEN
DO 20 I = 1, KB
DO 10 J = 1, I
WORK( INDAA+J-1+( I-1 )*DESCAA( LLD_ ) ) = DCONJG( WORK(
INDAA+I-1+( J-1 )* DESCAA( LLD_ ) ) )
10 CONTINUE
20 CONTINUE
END IF
CALL PZTRSM( 'Left', 'Lower', 'No Conj', 'Non-unit', KB, KB, ONE,
B, K+IB-1, K+JB-1, DESCB, WORK( INDAA ), 1, 1, DESCAA )
CALL PZTRSM( 'Right', 'Lower', 'Conj', 'Non-unit', KB, KB, ONE, B,
K+IB-1, K+JB-1, DESCB, WORK( INDAA ), 1, 1, DESCAA )
CALL PZLACPY( 'L', KB, KB, WORK( INDAA ), 1, 1, DESCAA, A, K+IA-1,
K+JA-1, DESCA )
CALL PZTRSM( 'Right', 'Lower', 'Conj', 'Non-unit', NPK, KB, ONE, B,
K+IB-1, K+JB-1, DESCB, A, POSTK+IA-1, K+JA-1, DESCA )
DESCR( CSRC_ ) = MOD( DESCR( CSRC_ )+1, NPCOL )
DESCG( CSRC_ ) = MOD( DESCG( CSRC_ )+1, NPCOL )
DESCRT( RSRC_ ) = MOD( DESCRT( RSRC_ )+1, NPROW )
DESCAA( RSRC_ ) = MOD( DESCAA( RSRC_ )+1, NPROW )
DESCAA( CSRC_ ) = MOD( DESCAA( CSRC_ )+1, NPCOL )
30 CONTINUE
WORK( 1 ) = DCMPLX( DBLE( LWOPT ) )
RETURN
END
PURPOSE
ScaLAPACK version 1.7 13 August 2001 PZHENGST(l)