DragonFly On-Line Manual Pages
PDSYNGST(l) ) PDSYNGST(l)
NAME
SYNOPSIS
SUBROUTINE PDSYNGST( 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( * )
DOUBLE PRECISION A( * ), B( * ), WORK( * )
DOUBLE PRECISION ONEHALF, ONE, MONE
PARAMETER ( ONEHALF = 0.5D0, ONE = 1.0D0, MONE = -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, PDGEMM,
PDLACPY, PDSYGST, PDSYMM, PDSYR2K, PDTRSM, PXERBLA
INTRINSIC DBLE, 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 ) = 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, 'PDSYNGST', -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 PDSYGST( 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 PDLACPY( 'A', N-POSTK+1, KB, B, POSTK+IB-1, K+JB-1, DESCB,
WORK( INDG ), POSTK, 1, DESCG )
CALL PDLACPY( 'A', N-POSTK+1, KB, A, POSTK+IA-1, K+JA-1, DESCA,
WORK( INDR ), POSTK, 1, DESCR )
CALL PDLACPY( 'A', KB, K-1, A, K+IA-1, JA, DESCA, WORK( INDRT ), 1,
1, DESCRT )
CALL PDLACPY( 'L', KB, KB, A, K+IA-1, K+JA-1, DESCA, WORK( INDR ),
K, 1, DESCR )
CALL PDTRSM( 'Right', 'L', 'N', 'N', NPK, KB, MONE, B, K+IB-1,
K+JB-1, DESCB, WORK( INDG ), POSTK, 1, DESCG )
CALL PDSYMM( '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 PDSYR2K( 'Lower', 'No T', NPK, KB, ONE, WORK( INDG ), POSTK,
1, DESCG, WORK( INDR ), POSTK, 1, DESCR, ONE, A, POSTK+IA-1,
POSTK+JA-1, DESCA )
CALL PDGEMM( '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 PDSYMM( '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 PDTRSM( '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 PDLACPY( '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_ ) ) = WORK( INDAA+I-1+( J-1
)*DESCAA( LLD_ ) )
10 CONTINUE
20 CONTINUE
END IF
CALL PDTRSM( 'Left', 'Lower', 'No Conj', 'Non-unit', KB, KB, ONE,
B, K+IB-1, K+JB-1, DESCB, WORK( INDAA ), 1, 1, DESCAA )
CALL PDTRSM( 'Right', 'Lower', 'Conj', 'Non-unit', KB, KB, ONE, B,
K+IB-1, K+JB-1, DESCB, WORK( INDAA ), 1, 1, DESCAA )
CALL PDLACPY( 'L', KB, KB, WORK( INDAA ), 1, 1, DESCAA, A, K+IA-1,
K+JA-1, DESCA )
CALL PDTRSM( '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 ) = DBLE( LWOPT )
RETURN
END
PURPOSE
ScaLAPACK version 1.7 13 August 2001 PDSYNGST(l)