.TH PDSYEV l "12 May 1997" "LAPACK version 1.3" "LAPACK routine (version 1.3)"
.SH NAME

.SH SYNOPSIS
.TP 19
SUBROUTINE PDSYEV(
JOBZ, UPLO, N, A, IA, JA, DESCA, W, Z, IZ, JZ,
DESCZ, WORK, LWORK, INFO )
.TP 19
.ti +4
CHARACTER
JOBZ, UPLO
.TP 19
.ti +4
INTEGER
IA, INFO, IZ, JA, JZ, LWORK, N
.TP 19
.ti +4
INTEGER
DESCA( * ), DESCZ( * )
.TP 19
.ti +4
DOUBLE
PRECISION A( * ), W( * ), WORK( * ), Z( * )
.TP 19
.ti +4
INTEGER
BLOCK_CYCLIC_2D, DLEN_, DTYPE_, CTXT_, M_, N_,
MB_, NB_, RSRC_, CSRC_, LLD_
.TP 19
.ti +4
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 )
.TP 19
.ti +4
DOUBLE
PRECISION ZERO, ONE
.TP 19
.ti +4
PARAMETER
( ZERO = 0.0D+0, ONE = 1.0D+0 )
.TP 19
.ti +4
INTEGER
ITHVAL
.TP 19
.ti +4
PARAMETER
( ITHVAL = 10 )
.TP 19
.ti +4
LOGICAL
LOWER, WANTZ
.TP 19
.ti +4
INTEGER
CONTEXTC, CSRC_A, I, IACOL, IAROW, ICOFFA,
IINFO, INDD, INDD2, INDE, INDE2, INDTAU,
INDWORK, INDWORK2, IROFFA, IROFFZ, ISCALE,
IZROW, J, K, LCM, LCMQ, LDC, LLWORK, LWMIN,
MB_A, MB_Z, MYCOL, MYPCOLC, MYPROWC, MYROW,
NB, NB_A, NB_Z, NN, NP, NPCOL, NPCOLC, NPROCS,
NPROW, NPROWC, NQ, NRC, QRMEM, RSRC_A, RSRC_Z,
SIZEMQRLEFT, SIZEMQRRIGHT
.TP 19
.ti +4
DOUBLE
PRECISION ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
SMLNUM
.TP 19
.ti +4
INTEGER
DESCQR( 10 ), IDUM1( 3 ), IDUM2( 3 )
.TP 19
.ti +4
LOGICAL
LSAME
.TP 19
.ti +4
INTEGER
ILCM, INDXG2P, NUMROC, SL_GRIDRESHAPE
.TP 19
.ti +4
DOUBLE
PRECISION PDLAMCH, PDLANSY
.TP 19
.ti +4
EXTERNAL
LSAME, ILCM, INDXG2P, NUMROC, SL_GRIDRESHAPE,
PDLAMCH, PDLANSY
.TP 19
.ti +4
EXTERNAL
BLACS_GRIDEXIT, BLACS_GRIDINFO, CHK1MAT,
DCOPY, DESCINIT, DGAMN2D, DGAMX2D, DSCAL,
DSTEQR2, PCHK2MAT, PDELGET, PDGEMR2D, PDLASCL,
PDLASET, PDORMTR, PDSYTRD, PXERBLA
.TP 19
.ti +4
INTRINSIC
DBLE, ICHAR, MAX, MIN, MOD, SQRT
.TP 19
.ti +4
IF(
BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_*
RSRC_.LT.0 )RETURN
.TP 19
.ti +4
IF(
N.EQ.0 )
RETURN
.TP 19
.ti +4
CALL
BLACS_GRIDINFO( DESCA( CTXT_ ), NPROW, NPCOL, MYROW, MYCOL )
.TP 19
.ti +4
INFO
= 0
.TP 19
.ti +4
IF(
NPROW.EQ.-1 ) THEN
.TP 19
.ti +4
INFO
= -( 700+CTXT_ )
.TP 19
.ti +4
ELSE
IF( DESCA( CTXT_ ).NE.DESCZ( CTXT_ ) ) THEN
.TP 19
.ti +4
INFO
= -( 1200+CTXT_ )
.TP 19
.ti +4
ELSE
.TP 19
.ti +4
CALL
CHK1MAT( N, 3, N, 3, IA, JA, DESCA, 7, INFO )
.TP 19
.ti +4
CALL
CHK1MAT( N, 3, N, 3, IZ, JZ, DESCZ, 12, INFO )
.TP 19
.ti +4
IF(
INFO.EQ.0 ) THEN
.TP 19
.ti +4
SAFMIN
= PDLAMCH( DESCA( CTXT_ ), 'Safe minimum' )
.TP 19
.ti +4
EPS
= PDLAMCH( DESCA( CTXT_ ), 'Precision' )
.TP 19
.ti +4
SMLNUM
= SAFMIN / EPS
.TP 19
.ti +4
BIGNUM
= ONE / SMLNUM
.TP 19
.ti +4
RMIN
= SQRT( SMLNUM )
.TP 19
.ti +4
RMAX
= MIN( SQRT( BIGNUM ), ONE / SQRT( SQRT( SAFMIN ) ) )
.TP 19
.ti +4
NPROCS
= NPROW*NPCOL
.TP 19
.ti +4
NB_A
= DESCA( NB_ )
.TP 19
.ti +4
MB_A
= DESCA( MB_ )
.TP 19
.ti +4
NB_Z
= DESCZ( NB_ )
.TP 19
.ti +4
MB_Z
= DESCZ( MB_ )
.TP 19
.ti +4
NB
= NB_A
.TP 19
.ti +4
LOWER
= LSAME( UPLO, 'L' )
.TP 19
.ti +4
WANTZ
= LSAME( JOBZ, 'V' )
.TP 19
.ti +4
RSRC_A
= DESCA( RSRC_ )
.TP 19
.ti +4
CSRC_A
= DESCA( CSRC_ )
.TP 19
.ti +4
RSRC_Z
= DESCZ( RSRC_ )
.TP 19
.ti +4
LCM
= ILCM( NPROW, NPCOL )
.TP 19
.ti +4
LCMQ
= LCM / NPCOL
.TP 19
.ti +4
IROFFA
= MOD( IA-1, MB_A )
.TP 19
.ti +4
ICOFFA
= MOD( JA-1, NB_A )
.TP 19
.ti +4
IROFFZ
= MOD( IZ-1, MB_A )
.TP 19
.ti +4
IAROW
= INDXG2P( 1, NB_A, MYROW, RSRC_A, NPROW )
.TP 19
.ti +4
IACOL
= INDXG2P( 1, MB_A, MYCOL, CSRC_A, NPCOL )
.TP 19
.ti +4
IZROW
= INDXG2P( 1, NB_A, MYROW, RSRC_Z, NPROW )
.TP 19
.ti +4
NP
= NUMROC( N+IROFFA, NB_Z, MYROW, IAROW, NPROW )
.TP 19
.ti +4
NQ
= NUMROC( N+ICOFFA, NB_Z, MYCOL, IACOL, NPCOL )
.TP 19
.ti +4
SIZEMQRLEFT
= MAX( ( NB_A*( NB_A-1 ) ) / 2,
( NP+NQ )*NB_A ) + NB_A*NB_A
.TP 19
.ti +4
SIZEMQRRIGHT
= MAX( ( NB_A*( NB_A-1 ) ) / 2,
( NQ+MAX( NP+NUMROC( NUMROC( N+ICOFFA, NB_A,
0, 0, NPCOL ), NB, 0, 0, LCMQ ), NP ) )*
NB_A ) + NB_A*NB_A
.TP 19
.ti +4
LDC
= 0
.TP 19
.ti +4
IF(
WANTZ ) THEN
.TP 19
.ti +4
CONTEXTC
= SL_GRIDRESHAPE( DESCA( CTXT_ ), 0, 1, 1,
NPROCS, 1 )
.TP 19
.ti +4
CALL
BLACS_GRIDINFO( CONTEXTC, NPROWC, NPCOLC, MYPROWC,
MYPCOLC )
.TP 19
.ti +4
NRC
= NUMROC( N, NB_A, MYPROWC, 0, NPROCS )
.TP 19
.ti +4
LDC
= MAX( 1, NRC )
.TP 19
.ti +4
CALL
DESCINIT( DESCQR, N, N, NB, NB, 0, 0, CONTEXTC,
LDC, INFO )
.TP 19
.ti +4
END
IF
.TP 19
.ti +4
INDTAU
= 1
.TP 19
.ti +4
INDE
= INDTAU + N
.TP 19
.ti +4
INDD
= INDE + N
.TP 19
.ti +4
INDD2
= INDD + N
.TP 19
.ti +4
INDE2
= INDD2 + N
.TP 19
.ti +4
INDWORK
= INDE2 + N
.TP 19
.ti +4
INDWORK2
= INDWORK + N*LDC
.TP 19
.ti +4
LLWORK
= LWORK - INDWORK + 1
.TP 19
.ti +4
NN
= MAX( N, NB, 2 )
.TP 19
.ti +4
IF(
WANTZ ) THEN
.TP 19
.ti +4
QRMEM
= 5*N + MAX( 2*NP+NQ+NB*NN, 2*NN-2 ) + N*LDC
.TP 19
.ti +4
LWMIN
= MAX( SIZEMQRLEFT, SIZEMQRRIGHT, QRMEM )
.TP 19
.ti +4
ELSE
.TP 19
.ti +4
LWMIN
= 5*N + 2*NP + NQ + NB*NN
.TP 19
.ti +4
END
IF
.TP 19
.ti +4
END
IF
.TP 19
.ti +4
IF(
INFO.EQ.0 ) THEN
.TP 19
.ti +4
IF(
.NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
.TP 19
.ti +4
INFO
= -1
.TP 19
.ti +4
ELSE
IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
.TP 19
.ti +4
INFO
= -2
.TP 19
.ti +4
ELSE
IF( LWORK.LT.LWMIN .AND. LWORK.NE.-1 ) THEN
.TP 19
.ti +4
INFO
= -14
.TP 19
.ti +4
ELSE
IF( IROFFA.NE.IROFFZ ) THEN
.TP 19
.ti +4
INFO
= -10
.TP 19
.ti +4
ELSE
IF( IROFFA.NE.0 ) THEN
.TP 19
.ti +4
INFO
= -5
.TP 19
.ti +4
ELSE
IF( IAROW.NE.IZROW ) THEN
.TP 19
.ti +4
INFO
= -10
.TP 19
.ti +4
ELSE
IF( DESCA( MB_ ).NE.DESCA( NB_ ) ) THEN
.TP 19
.ti +4
INFO
= -( 700+NB_ )
.TP 19
.ti +4
ELSE
IF( DESCA( M_ ).NE.DESCZ( M_ ) ) THEN
.TP 19
.ti +4
INFO
= -( 1200+M_ )
.TP 19
.ti +4
ELSE
IF( DESCA( N_ ).NE.DESCZ( N_ ) ) THEN
.TP 19
.ti +4
INFO
= -( 1200+N_ )
.TP 19
.ti +4
ELSE
IF( DESCA( MB_ ).NE.DESCZ( MB_ ) ) THEN
.TP 19
.ti +4
INFO
= -( 1200+MB_ )
.TP 19
.ti +4
ELSE
IF( DESCA( NB_ ).NE.DESCZ( NB_ ) ) THEN
.TP 19
.ti +4
INFO
= -( 1200+NB_ )
.TP 19
.ti +4
ELSE
IF( DESCA( RSRC_ ).NE.DESCZ( RSRC_ ) ) THEN
.TP 19
.ti +4
INFO
= -( 1200+RSRC_ )
.TP 19
.ti +4
ELSE
IF( DESCA( CTXT_ ).NE.DESCZ( CTXT_ ) ) THEN
.TP 19
.ti +4
INFO
= -( 1200+CTXT_ )
.TP 19
.ti +4
END
IF
.TP 19
.ti +4
END
IF
.TP 19
.ti +4
IF(
WANTZ ) THEN
.TP 19
.ti +4
IDUM1(
1 ) = ICHAR( 'V' )
.TP 19
.ti +4
ELSE
.TP 19
.ti +4
IDUM1(
1 ) = ICHAR( 'N' )
.TP 19
.ti +4
END
IF
.TP 19
.ti +4
IDUM2(
1 ) = 1
.TP 19
.ti +4
IF(
LOWER ) THEN
.TP 19
.ti +4
IDUM1(
2 ) = ICHAR( 'L' )
.TP 19
.ti +4
ELSE
.TP 19
.ti +4
IDUM1(
2 ) = ICHAR( 'U' )
.TP 19
.ti +4
END
IF
.TP 19
.ti +4
IDUM2(
2 ) = 2
.TP 19
.ti +4
IF(
LWORK.EQ.-1 ) THEN
.TP 19
.ti +4
IDUM1(
3 ) = -1
.TP 19
.ti +4
ELSE
.TP 19
.ti +4
IDUM1(
3 ) = 1
.TP 19
.ti +4
END
IF
.TP 19
.ti +4
IDUM2(
3 ) = 3
.TP 19
.ti +4
CALL
PCHK2MAT( N, 3, N, 3, IA, JA, DESCA, 7, N, 3, N, 3, IZ,
JZ, DESCZ, 12, 3, IDUM1, IDUM2, INFO )
.TP 19
.ti +4
WORK(
1 ) = DBLE( LWMIN )
.TP 19
.ti +4
END
IF
.TP 19
.ti +4
IF(
INFO.NE.0 ) THEN
.TP 19
.ti +4
CALL
PXERBLA( DESCA( CTXT_ ), 'PDSYEV', -INFO )
.TP 19
.ti +4
IF(
WANTZ )
CALL BLACS_GRIDEXIT( CONTEXTC )
.TP 19
.ti +4
RETURN
.TP 19
.ti +4
ELSE
IF( LWORK.EQ.-1 ) THEN
.TP 19
.ti +4
IF(
WANTZ )
CALL BLACS_GRIDEXIT( CONTEXTC )
.TP 19
.ti +4
RETURN
.TP 19
.ti +4
END
IF
.TP 19
.ti +4
ISCALE
= 0
.TP 19
.ti +4
ANRM
= PDLANSY( '1', UPLO, N, A, IA, JA, DESCA, WORK( INDWORK ) )
.TP 19
.ti +4
IF(
ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
.TP 19
.ti +4
ISCALE
= 1
.TP 19
.ti +4
SIGMA
= RMIN / ANRM
.TP 19
.ti +4
ELSE
IF( ANRM.GT.RMAX ) THEN
.TP 19
.ti +4
ISCALE
= 1
.TP 19
.ti +4
SIGMA
= RMAX / ANRM
.TP 19
.ti +4
END
IF
.TP 19
.ti +4
IF(
ISCALE.EQ.1 ) THEN
.TP 19
.ti +4
CALL
PDLASCL( UPLO, ONE, SIGMA, N, N, A, IA, JA, DESCA,
IINFO )
.TP 19
.ti +4
END
IF
.TP 19
.ti +4
CALL
PDSYTRD( UPLO, N, A, IA, JA, DESCA, WORK( INDD ),
WORK( INDE ), WORK( INDTAU ), WORK( INDWORK ),
LLWORK, IINFO )
.TP 19
.ti +4
DO
10 I = 1, N
.TP 19
.ti +4
CALL
PDELGET( 'A', ' ', WORK( INDD2+I-1 ), A, I+IA-1, I+JA-1,
DESCA )
.TP 19
.ti +4
10
CONTINUE
.TP 19
.ti +4
IF(
LSAME( UPLO, 'U' ) ) THEN
.TP 19
.ti +4
DO
20 I = 1, N - 1
.TP 19
.ti +4
CALL
PDELGET( 'A', ' ', WORK( INDE2+I-1 ), A, I+IA-1, I+JA,
DESCA )
.TP 19
.ti +4
20
CONTINUE
.TP 19
.ti +4
ELSE
.TP 19
.ti +4
DO
30 I = 1, N - 1
.TP 19
.ti +4
CALL
PDELGET( 'A', ' ', WORK( INDE2+I-1 ), A, I+IA, I+JA-1,
DESCA )
.TP 19
.ti +4
30
CONTINUE
.TP 19
.ti +4
END
IF
.TP 19
.ti +4
IF(
WANTZ ) THEN
.TP 19
.ti +4
CALL
PDLASET( 'Full', N, N, ZERO, ONE, WORK( INDWORK ), 1, 1,
DESCQR )
.TP 19
.ti +4
CALL
DSTEQR2( 'I', N, WORK( INDD2 ), WORK( INDE2 ),
WORK( INDWORK ), LDC, NRC, WORK( INDWORK2 ),
INFO )
.TP 19
.ti +4
CALL
PDGEMR2D( N, N, WORK( INDWORK ), 1, 1, DESCQR, Z, 1, 1,
DESCZ, CONTEXTC )
.TP 19
.ti +4
CALL
PDORMTR( 'L', UPLO, 'N', N, N, A, IA, JA, DESCA,
WORK( INDTAU ), Z, IZ, JZ, DESCZ,
WORK( INDWORK ), LLWORK, IINFO )
.TP 19
.ti +4
ELSE
.TP 19
.ti +4
CALL
DSTEQR2( 'N', N, WORK( INDD2 ), WORK( INDE2 ),
WORK( INDWORK ), 1, 1, WORK( INDWORK2 ), INFO )
.TP 19
.ti +4
END
IF
.TP 19
.ti +4
CALL
DCOPY( N, WORK( INDD2 ), 1, W, 1 )
.TP 19
.ti +4
IF(
ISCALE.EQ.1 ) THEN
.TP 19
.ti +4
CALL
DSCAL( N, ONE / SIGMA, W, 1 )
.TP 19
.ti +4
END
IF
.TP 19
.ti +4
WORK(
1 ) = DBLE( LWMIN )
.TP 19
.ti +4
IF(
WANTZ ) THEN
.TP 19
.ti +4
CALL
BLACS_GRIDEXIT( CONTEXTC )
.TP 19
.ti +4
END
IF
.TP 19
.ti +4
IF(
N.LE.ITHVAL ) THEN
.TP 19
.ti +4
J
= N
.TP 19
.ti +4
K
= 1
.TP 19
.ti +4
ELSE
.TP 19
.ti +4
J
= N / ITHVAL
.TP 19
.ti +4
K
= ITHVAL
.TP 19
.ti +4
END
IF
.TP 19
.ti +4
DO
40 I = 1, J
.TP 19
.ti +4
WORK(
I+INDTAU ) = W( ( I-1 )*K+1 )
.TP 19
.ti +4
WORK(
I+INDE ) = W( ( I-1 )*K+1 )
.TP 19
.ti +4
40
CONTINUE
.TP 19
.ti +4
CALL
DGAMN2D( DESCA( CTXT_ ), 'a', ' ', J, 1, WORK( 1+INDTAU ),
J, 1, 1, -1, -1, 0 )
.TP 19
.ti +4
CALL
DGAMX2D( DESCA( CTXT_ ), 'a', ' ', J, 1, WORK( 1+INDE ), J,
1, 1, -1, -1, 0 )
.TP 19
.ti +4
DO
50 I = 1, J
.TP 19
.ti +4
IF(
INFO.EQ.0 .AND. ( WORK( I+INDTAU )-WORK( I+INDE ).NE.
ZERO ) ) THEN
.TP 19
.ti +4
INFO
= N + 1
.TP 19
.ti +4
END
IF
.TP 19
.ti +4
50
CONTINUE
.TP 19
.ti +4
RETURN
.TP 19
.ti +4
END
.SH PURPOSE
