DragonFly On-Line Manual Pages
PSSYNGST(l) ) PSSYNGST(l)
NAME
SYNOPSIS
SUBROUTINE PSSYNGST( 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
REAL SCALE
INTEGER DESCA( * ), DESCB( * )
REAL A( * ), B( * ), WORK( * )
REAL ONEHALF, ONE, MONE
PARAMETER ( ONEHALF = 0.5E0, ONE = 1.0E0, MONE = -1.0E0 )
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, PSGEMM,
PSLACPY, PSSYGST, PSSYMM, PSSYR2K, PSTRSM, PXERBLA
INTRINSIC ICHAR, MAX, MIN, MOD, REAL
ICTXT = DESCA( CTXT_ )
CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL )
SCALE = 1.0E0
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 ) = REAL( 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, 'PSSYNGST', -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 PSSYGST( 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 PSLACPY( 'A', N-POSTK+1, KB, B, POSTK+IB-1, K+JB-1, DESCB,
WORK( INDG ), POSTK, 1, DESCG )
CALL PSLACPY( 'A', N-POSTK+1, KB, A, POSTK+IA-1, K+JA-1, DESCA,
WORK( INDR ), POSTK, 1, DESCR )
CALL PSLACPY( 'A', KB, K-1, A, K+IA-1, JA, DESCA, WORK( INDRT ), 1,
1, DESCRT )
CALL PSLACPY( 'L', KB, KB, A, K+IA-1, K+JA-1, DESCA, WORK( INDR ),
K, 1, DESCR )
CALL PSTRSM( 'Right', 'L', 'N', 'N', NPK, KB, MONE, B, K+IB-1,
K+JB-1, DESCB, WORK( INDG ), POSTK, 1, DESCG )
CALL PSSYMM( '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 PSSYR2K( '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 PSGEMM( '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 PSSYMM( '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 PSTRSM( '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 PSLACPY( '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 PSTRSM( 'Left', 'Lower', 'No Conj', 'Non-unit', KB, KB, ONE,
B, K+IB-1, K+JB-1, DESCB, WORK( INDAA ), 1, 1, DESCAA )
CALL PSTRSM( 'Right', 'Lower', 'Conj', 'Non-unit', KB, KB, ONE, B,
K+IB-1, K+JB-1, DESCB, WORK( INDAA ), 1, 1, DESCAA )
CALL PSLACPY( 'L', KB, KB, WORK( INDAA ), 1, 1, DESCAA, A, K+IA-1,
K+JA-1, DESCA )
CALL PSTRSM( '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 ) = REAL( LWOPT )
RETURN
END
PURPOSE
ScaLAPACK version 1.7 13 August 2001 PSSYNGST(l)