DragonFly On-Line Manual Pages
PDSYNTRD(l) ) PDSYNTRD(l)
NAME
SYNOPSIS
SUBROUTINE PDSYNTRD( UPLO, N, A, IA, JA, DESCA, D, E, TAU, WORK, LWORK,
INFO )
CHARACTER UPLO
INTEGER IA, INFO, JA, LWORK, N
INTEGER DESCA( * )
DOUBLE PRECISION A( * ), D( * ), E( * ), TAU( * ), WORK( * )
INTEGER BLOCK_CYCLIC_2D, DLEN_, DTYPE_, CTXT_, M_, N_, MB_, NB_,
RSRC_, CSRC_, LLD_
PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1, CTXT_ = 2,
M_ = 3, N_ = 4, MB_ = 5, NB_ = 6, RSRC_ = 7, CSRC_ = 8, LLD_ = 9 )
DOUBLE PRECISION ONE
PARAMETER ( ONE = 1.0D+0 )
LOGICAL LQUERY, UPPER
CHARACTER COLCTOP, ROWCTOP
INTEGER ANB, CTXTB, I, IACOL, IAROW, ICOFFA, ICTXT, IINFO, INDB,
INDD, INDE, INDTAU, INDW, IPW, IROFFA, J, JB, JX, K, KK, LLWORK, LWMIN,
MINSZ, MYCOL, MYCOLB, MYROW, MYROWB, NB, NP, NPCOL, NPCOLB, NPROW,
NPROWB, NPS, NQ, ONEPMIN, SQNPC, TTLWMIN
INTEGER DESCB( DLEN_ ), DESCW( DLEN_ ), IDUM1( 2 ), IDUM2( 2 )
EXTERNAL BLACS_GET, BLACS_GRIDEXIT, BLACS_GRIDINFO, BLACS_GRIDINIT,
CHK1MAT, DESCSET, DSYTRD, IGAMN2D, PCHK1MAT, PDELSET, PDLAMR1D,
PDLATRD, PDSYR2K, PDSYTD2, PDSYTTRD, PDTRMR2D, PB_TOPGET, PB_TOPSET,
PXERBLA
LOGICAL LSAME
INTEGER INDXG2L, INDXG2P, NUMROC, PJLAENV
EXTERNAL LSAME, INDXG2L, INDXG2P, NUMROC, PJLAENV
INTRINSIC DBLE, ICHAR, INT, MAX, MIN, MOD, SQRT
IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_*
RSRC_.LT.0 )RETURN
ICTXT = DESCA( CTXT_ )
CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL )
INFO = 0
IF( NPROW.EQ.-1 ) THEN
INFO = -( 600+CTXT_ )
ELSE
CALL CHK1MAT( N, 2, N, 2, IA, JA, DESCA, 6, INFO )
UPPER = LSAME( UPLO, 'U' )
IF( INFO.EQ.0 ) THEN
NB = DESCA( NB_ )
IROFFA = MOD( IA-1, DESCA( MB_ ) )
ICOFFA = MOD( JA-1, DESCA( NB_ ) )
IAROW = INDXG2P( IA, NB, MYROW, DESCA( RSRC_ ), NPROW )
IACOL = INDXG2P( JA, NB, MYCOL, DESCA( CSRC_ ), NPCOL )
NP = NUMROC( N, NB, MYROW, IAROW, NPROW )
NQ = MAX( 1, NUMROC( N+JA-1, NB, MYCOL, DESCA( CSRC_ ), NPCOL ) )
LWMIN = MAX( ( NP+1 )*NB, 3*NB )
ANB = PJLAENV( ICTXT, 3, 'PDSYTTRD', 'L', 0, 0, 0, 0 )
MINSZ = PJLAENV( ICTXT, 5, 'PDSYTTRD', 'L', 0, 0, 0, 0 )
SQNPC = INT( SQRT( DBLE( NPROW*NPCOL ) ) )
NPS = MAX( NUMROC( N, 1, 0, 0, SQNPC ), 2*ANB )
TTLWMIN = 2*( ANB+1 )*( 4*NPS+2 ) + ( NPS+4 )*NPS
WORK( 1 ) = DBLE( TTLWMIN )
LQUERY = ( LWORK.EQ.-1 )
IF(
INFO = -1
ELSE IF( IROFFA.NE.ICOFFA .OR. ICOFFA.NE.0 ) THEN
INFO = -5
ELSE IF( DESCA( MB_ ).NE.DESCA( NB_ ) ) THEN
INFO = -( 600+NB_ )
ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
INFO = -11
END IF
END IF
IF( UPPER ) THEN
IDUM1( 1 ) = ICHAR( 'U' )
ELSE
IDUM1( 1 ) = ICHAR( 'L' )
END IF
IDUM2( 1 ) = 1
IF( LWORK.EQ.-1 ) THEN
IDUM1( 2 ) = -1
ELSE
IDUM1( 2 ) = 1
END IF
IDUM2( 2 ) = 11
CALL PCHK1MAT( N, 2, N, 2, IA, JA, DESCA, 6, 2, IDUM1, IDUM2, INFO
)
END IF
IF( INFO.NE.0 ) THEN
CALL PXERBLA( ICTXT, 'PDSYNTRD', -INFO )
RETURN
ELSE IF( LQUERY ) THEN
RETURN
END IF
IF( N.EQ.0 ) RETURN
ONEPMIN = N*N + 3*N + 1
LLWORK = LWORK
CALL IGAMN2D( ICTXT, 'A', ' ', 1, 1, LLWORK, 1, 1, -1, -1, -1, -1 )
NPROWB = 0
IF( ( N.LT.MINSZ .OR. SQNPC.EQ.1 ) .AND. LLWORK.GE.ONEPMIN .AND.
NPROWB = 1
NPS = N
ELSE
IF( LLWORK.GE.TTLWMIN .AND. .NOT.UPPER ) THEN
NPROWB = SQNPC
END IF
END IF
IF( NPROWB.GE.1 ) THEN
NPCOLB = NPROWB
SQNPC = NPROWB
INDB = 1
INDD = INDB + NPS*NPS
INDE = INDD + NPS
INDTAU = INDE + NPS
INDW = INDTAU + NPS
LLWORK = LLWORK - INDW + 1
CALL BLACS_GET( ICTXT, 10, CTXTB )
CALL BLACS_GRIDINIT( CTXTB, 'Row major', SQNPC, SQNPC )
CALL BLACS_GRIDINFO( CTXTB, NPROWB, NPCOLB, MYROWB, MYCOLB )
CALL DESCSET( DESCB, N, N, 1, 1, 0, 0, CTXTB, NPS )
CALL PDTRMR2D( UPLO, 'N', N, N, A, IA, JA, DESCA, WORK( INDB ), 1,
1, DESCB, ICTXT )
IF( NPROWB.GT.0 ) THEN
IF( NPROWB.EQ.1 ) THEN
CALL DSYTRD( UPLO, N, WORK( INDB ), NPS, WORK( INDD ), WORK( INDE
), WORK( INDTAU ), WORK( INDW ), LLWORK, INFO )
ELSE
CALL PDSYTTRD( 'L', N, WORK( INDB ), 1, 1, DESCB, WORK( INDD ),
WORK( INDE ), WORK( INDTAU ), WORK( INDW ), LLWORK, INFO )
END IF
END IF
CALL PDLAMR1D( N-1, WORK( INDE ), 1, 1, DESCB, E, 1, JA, DESCA )
CALL PDLAMR1D( N, WORK( INDD ), 1, 1, DESCB, D, 1, JA, DESCA )
CALL PDLAMR1D( N, WORK( INDTAU ), 1, 1, DESCB, TAU, 1, JA, DESCA )
CALL PDTRMR2D( UPLO, 'N', N, N, WORK( INDB ), 1, 1, DESCB, A, IA,
JA, DESCA, ICTXT )
IF( MYROWB.GE.0 ) CALL BLACS_GRIDEXIT( CTXTB )
ELSE
CALL PB_TOPGET( ICTXT, 'Combine', 'Columnwise', COLCTOP )
CALL PB_TOPGET( ICTXT, 'Combine', 'Rowwise', ROWCTOP )
CALL PB_TOPSET( ICTXT, 'Combine', 'Columnwise', '1-tree' )
CALL PB_TOPSET( ICTXT, 'Combine', 'Rowwise', '1-tree' )
IPW = NP*NB + 1
IF( UPPER ) THEN
KK = MOD( JA+N-1, NB )
IF( KK.EQ.0 ) KK = NB
CALL DESCSET( DESCW, N, NB, NB, NB, IAROW, INDXG2P( JA+N-KK, NB,
MYCOL, DESCA( CSRC_ ), NPCOL ), ICTXT, MAX( 1, NP ) )
DO 10 K = N - KK + 1, NB + 1, -NB
JB = MIN( N-K+1, NB )
I = IA + K - 1
J = JA + K - 1
CALL PDLATRD( UPLO, K+JB-1, JB, A, IA, JA, DESCA, D, E, TAU, WORK,
1, 1, DESCW, WORK( IPW ) )
CALL PDSYR2K( UPLO, 'No transpose', K-1, JB, -ONE, A, IA, J, DESCA,
WORK, 1, 1, DESCW, ONE, A, IA, JA, DESCA )
JX = MIN( INDXG2L( J, NB, 0, IACOL, NPCOL ), NQ )
CALL PDELSET( A, I-1, J, DESCA, E( JX ) )
DESCW( CSRC_ ) = MOD( DESCW( CSRC_ )+NPCOL-1, NPCOL )
10 CONTINUE
CALL PDSYTD2( UPLO, MIN( N, NB ), A, IA, JA, DESCA, D, E, TAU,
WORK, LWORK, IINFO )
ELSE
KK = MOD( JA+N-1, NB )
IF( KK.EQ.0 ) KK = NB
CALL DESCSET( DESCW, N, NB, NB, NB, IAROW, IACOL, ICTXT, MAX( 1, NP
) )
DO 20 K = 1, N - NB, NB
I = IA + K - 1
J = JA + K - 1
CALL PDLATRD( UPLO, N-K+1, NB, A, I, J, DESCA, D, E, TAU, WORK, K,
1, DESCW, WORK( IPW ) )
CALL PDSYR2K( UPLO, 'No transpose', N-K-NB+1, NB, -ONE, A, I+NB, J,
DESCA, WORK, K+NB, 1, DESCW, ONE, A, I+NB, J+NB, DESCA )
JX = MIN( INDXG2L( J+NB-1, NB, 0, IACOL, NPCOL ), NQ )
CALL PDELSET( A, I+NB, J+NB-1, DESCA, E( JX ) )
DESCW( CSRC_ ) = MOD( DESCW( CSRC_ )+1, NPCOL )
20 CONTINUE
CALL PDSYTD2( UPLO, KK, A, IA+K-1, JA+K-1, DESCA, D, E, TAU, WORK,
LWORK, IINFO )
END IF
CALL PB_TOPSET( ICTXT, 'Combine', 'Columnwise', COLCTOP )
CALL PB_TOPSET( ICTXT, 'Combine', 'Rowwise', ROWCTOP )
END IF
WORK( 1 ) = DBLE( TTLWMIN )
RETURN
END
PURPOSE
ScaLAPACK version 1.7 13 August 2001 PDSYNTRD(l)