PDSYGVX(3) MathKeisan ScaLAPACK routine PDSYGVX(3)
NAME
SYNOPSIS
SUBROUTINE PDSYGVX( IBTYPE, JOBZ, RANGE, UPLO, N, A, IA, JA, DESCA, B,
IB, JB, DESCB, VL, VU, IL, IU, ABSTOL, M, NZ, W,
ORFAC, Z, IZ, JZ, DESCZ, WORK, LWORK, IWORK,
LIWORK, IFAIL, ICLUSTR, GAP, INFO )
CHARACTER JOBZ, RANGE, UPLO
INTEGER IA, IB, IBTYPE, IL, INFO, IU, IZ, JA, JB, JZ,
LIWORK, LWORK, M, N, NZ
DOUBLE PRECISION ABSTOL, ORFAC, VL, VU
INTEGER DESCA( * ), DESCB( * ), DESCZ( * ), ICLUSTR( * ),
IFAIL( * ), IWORK( * )
DOUBLE PRECISION A( * ), B( * ), GAP( * ), W( * ), WORK( *
), Z( * )
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 )
DOUBLE PRECISION FIVE, ZERO
PARAMETER ( FIVE = 5.0D+0, ZERO = 0.0D+0 )
INTEGER IERRNPD
PARAMETER ( IERRNPD = 16 )
LOGICAL ALLEIG, INDEIG, LQUERY, UPPER, VALEIG, WANTZ
CHARACTER TRANS
INTEGER ANB, IACOL, IAROW, IBCOL, IBROW, ICOFFA, ICOFFB,
ICTXT, IROFFA, IROFFB, LIWMIN, LWMIN, LWOPT, MQ0,
MYCOL, MYROW, NB, NEIG, NN, NP0, NPCOL, NPROW, NPS,
NQ0, NSYGST_LWOPT, NSYTRD_LWOPT, SQNPC
DOUBLE PRECISION EPS, SCALE
INTEGER IDUM1( 5 ), IDUM2( 5 )
LOGICAL LSAME
INTEGER ICEIL, INDXG2P, NUMROC, PJLAENV
DOUBLE PRECISION PDLAMCH
EXTERNAL LSAME, ICEIL, INDXG2P, NUMROC, PJLAENV, PDLAMCH
EXTERNAL BLACS_GRIDINFO, CHK1MAT, DGEBR2D, DGEBS2D, DSCAL,
PCHK1MAT, PCHK2MAT, PDPOTRF, PDSYEVX, PDSYNGST,
PDTRMM, PDTRSM, PXERBLA
INTRINSIC ABS, 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 = -( 900+CTXT_ )
ELSE IF( DESCA( CTXT_ ).NE.DESCB( CTXT_ ) ) THEN
INFO = -( 1300+CTXT_ )
ELSE IF( DESCA( CTXT_ ).NE.DESCZ( CTXT_ ) ) THEN
INFO = -( 2600+CTXT_ )
ELSE
EPS = PDLAMCH( DESCA( CTXT_ ), 'Precision' )
WANTZ = LSAME( JOBZ, 'V' )
UPPER = LSAME( UPLO, 'U' )
ALLEIG = LSAME( RANGE, 'A' )
VALEIG = LSAME( RANGE, 'V' )
INDEIG = LSAME( RANGE, 'I' )
CALL CHK1MAT( N, 4, N, 4, IA, JA, DESCA, 9, INFO )
CALL CHK1MAT( N, 4, N, 4, IB, JB, DESCB, 13, INFO )
CALL CHK1MAT( N, 4, N, 4, IZ, JZ, DESCZ, 26, INFO )
IF( INFO.EQ.0 ) THEN
IF( MYROW.EQ.0 .AND. MYCOL.EQ.0 ) THEN
WORK( 1 ) = ABSTOL
IF( VALEIG ) THEN
WORK( 2 ) = VL
WORK( 3 ) = VU
ELSE
WORK( 2 ) = ZERO
WORK( 3 ) = ZERO
END IF
CALL DGEBS2D( DESCA( CTXT_ ), 'ALL', ' ', 3, 1, WORK, 3
)
ELSE
CALL DGEBR2D( DESCA( CTXT_ ), 'ALL', ' ', 3, 1, WORK, 3,
0, 0 )
END IF
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_ ) )
LQUERY = .FALSE.
IF( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 ) LQUERY = .TRUE.
LIWMIN = 6*MAX( N, ( NPROW*NPCOL )+1, 4 )
NB = DESCA( MB_ )
NN = MAX( N, NB, 2 )
NP0 = NUMROC( NN, NB, 0, 0, NPROW )
IF( ( .NOT.WANTZ ) .OR. ( VALEIG .AND. ( .NOT.LQUERY )
) ) THEN
LWMIN = 5*N + MAX( 5*NN, NB*( NP0+1 ) )
IF( WANTZ ) THEN
MQ0 = NUMROC( MAX( N, NB, 2 ), NB, 0, 0, NPCOL )
LWOPT = 5*N + MAX( 5*NN, NP0*MQ0+2*NB*NB )
ELSE
LWOPT = LWMIN
END IF
NEIG = 0
ELSE
IF( ALLEIG .OR. VALEIG ) THEN
NEIG = N
ELSE IF( INDEIG ) THEN
NEIG = IU - IL + 1
END IF
MQ0 = NUMROC( MAX( NEIG, NB, 2 ), NB, 0, 0, NPCOL )
LWMIN = 5*N + MAX( 5*NN, NP0*MQ0+2*NB*NB ) + ICEIL( NEIG,
NPROW*NPCOL )*NN
LWOPT = LWMIN
END IF
ANB = PJLAENV( ICTXT, 3, 'PDSYTTRD', 'L', 0, 0, 0, 0 )
SQNPC = INT( SQRT( DBLE( NPROW*NPCOL ) ) )
NPS = MAX( NUMROC( N, 1, 0, 0, SQNPC ), 2*ANB )
NSYTRD_LWOPT = 2*( ANB+1 )*( 4*NPS+2 ) + ( NPS+4 )*NPS
NB = DESCA( MB_ )
NP0 = NUMROC( N, NB, 0, 0, NPROW )
NQ0 = NUMROC( N, NB, 0, 0, NPCOL )
NSYGST_LWOPT = 2*NP0*NB + NQ0*NB + NB*NB
LWOPT = MAX( LWOPT, N+NSYTRD_LWOPT, NSYGST_LWOPT )
IF( IBTYPE.LT.1 .OR. IBTYPE.GT.3 ) THEN
INFO = -1
ELSE IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
INFO = -2
ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
INFO = -3
ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
INFO = -4
ELSE IF( N.LT.0 ) THEN
INFO = -5
ELSE IF( IROFFA.NE.0 ) THEN
INFO = -7
ELSE IF( ICOFFA.NE.0 ) THEN
INFO = -8
ELSE IF( DESCA( MB_ ).NE.DESCA( NB_ ) ) THEN
INFO = -( 900+NB_ )
ELSE IF( DESCA( M_ ).NE.DESCB( M_ ) ) THEN
INFO = -( 1300+M_ )
ELSE IF( DESCA( N_ ).NE.DESCB( N_ ) ) THEN
INFO = -( 1300+N_ )
ELSE IF( DESCA( MB_ ).NE.DESCB( MB_ ) ) THEN
INFO = -( 1300+MB_ )
ELSE IF( DESCA( NB_ ).NE.DESCB( NB_ ) ) THEN
INFO = -( 1300+NB_ )
ELSE IF( DESCA( RSRC_ ).NE.DESCB( RSRC_ ) ) THEN
INFO = -( 1300+RSRC_ )
ELSE IF( DESCA( CSRC_ ).NE.DESCB( CSRC_ ) ) THEN
INFO = -( 1300+CSRC_ )
ELSE IF( DESCA( CTXT_ ).NE.DESCB( CTXT_ ) ) THEN
INFO = -( 1300+CTXT_ )
ELSE IF( DESCA( M_ ).NE.DESCZ( M_ ) ) THEN
INFO = -( 2200+M_ )
ELSE IF( DESCA( N_ ).NE.DESCZ( N_ ) ) THEN
INFO = -( 2200+N_ )
ELSE IF( DESCA( MB_ ).NE.DESCZ( MB_ ) ) THEN
INFO = -( 2200+MB_ )
ELSE IF( DESCA( NB_ ).NE.DESCZ( NB_ ) ) THEN
INFO = -( 2200+NB_ )
ELSE IF( DESCA( RSRC_ ).NE.DESCZ( RSRC_ ) ) THEN
INFO = -( 2200+RSRC_ )
ELSE IF( DESCA( CSRC_ ).NE.DESCZ( CSRC_ ) ) THEN
INFO = -( 2200+CSRC_ )
ELSE IF( DESCA( CTXT_ ).NE.DESCZ( CTXT_ ) ) THEN
INFO = -( 2200+CTXT_ )
ELSE IF( IROFFB.NE.0 .OR. IBROW.NE.IAROW ) THEN
INFO = -11
ELSE IF( ICOFFB.NE.0 .OR. IBCOL.NE.IACOL ) THEN
INFO = -12
ELSE IF( VALEIG .AND. N.GT.0 .AND. VU.LE.VL ) THEN
INFO = -15
ELSE IF( INDEIG .AND. ( IL.LT.1 .OR. IL.GT.MAX( 1, N ) )
) THEN
INFO = -16
ELSE IF( INDEIG .AND. ( IU.LT.MIN( N, IL ) .OR. IU.GT.N
) ) THEN
INFO = -17
ELSE IF( VALEIG .AND. ( ABS( WORK( 2 )-VL ).GT.FIVE*EPS*
ABS( VL ) ) ) THEN
INFO = -14
ELSE IF( VALEIG .AND. ( ABS( WORK( 3 )-VU ).GT.FIVE*EPS*
ABS( VU ) ) ) THEN
INFO = -15
ELSE IF( ABS( WORK( 1 )-ABSTOL ).GT.FIVE*EPS*ABS( ABSTOL
) ) THEN
INFO = -18
ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
INFO = -28
ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
INFO = -30
END IF
END IF
IDUM1( 1 ) = IBTYPE
IDUM2( 1 ) = 1
IF( WANTZ ) THEN
IDUM1( 2 ) = ICHAR( 'V' )
ELSE
IDUM1( 2 ) = ICHAR( 'N' )
END IF
IDUM2( 2 ) = 2
IF( UPPER ) THEN
IDUM1( 3 ) = ICHAR( 'U' )
ELSE
IDUM1( 3 ) = ICHAR( 'L' )
END IF
IDUM2( 3 ) = 3
IF( ALLEIG ) THEN
IDUM1( 4 ) = ICHAR( 'A' )
ELSE IF( INDEIG ) THEN
IDUM1( 4 ) = ICHAR( 'I' )
ELSE
IDUM1( 4 ) = ICHAR( 'V' )
END IF
IDUM2( 4 ) = 4
IF( LQUERY ) THEN
IDUM1( 5 ) = -1
ELSE
IDUM1( 5 ) = 1
END IF
IDUM2( 5 ) = 5
CALL PCHK2MAT( N, 4, N, 4, IA, JA, DESCA, 9, N, 4, N, 4,
IB, JB, DESCB, 13, 5, IDUM1, IDUM2, INFO )
CALL PCHK1MAT( N, 4, N, 4, IZ, JZ, DESCZ, 26, 0, IDUM1,
IDUM2, INFO )
END IF
IWORK( 1 ) = LIWMIN
WORK( 1 ) = DBLE( LWOPT )
IF( INFO.NE.0 ) THEN
CALL PXERBLA( ICTXT, 'PDSYGVX ', -INFO )
RETURN
ELSE IF( LQUERY ) THEN
RETURN
END IF
CALL PDPOTRF( UPLO, N, B, IB, JB, DESCB, INFO )
IF( INFO.NE.0 ) THEN
IWORK( 1 ) = LIWMIN
WORK( 1 ) = DBLE( LWOPT )
IFAIL( 1 ) = INFO
INFO = IERRNPD
RETURN
END IF
CALL PDSYNGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB,
JB, DESCB, SCALE, WORK, LWORK, INFO )
CALL PDSYEVX( JOBZ, RANGE, UPLO, N, A, IA, JA, DESCA,
VL, VU, IL, IU, ABSTOL, M, NZ, W, ORFAC, Z, IZ, JZ,
DESCZ, WORK, LWORK, IWORK, LIWORK, IFAIL, ICLUSTR,
GAP, INFO )
IF( WANTZ ) THEN
NEIG = M
IF( IBTYPE.EQ.1 .OR. IBTYPE.EQ.2 ) THEN
IF( UPPER ) THEN
TRANS = 'N'
ELSE
TRANS = 'T'
END IF
CALL PDTRSM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG,
ONE, B, IB, JB, DESCB, Z, IZ, JZ, DESCZ )
ELSE IF( IBTYPE.EQ.3 ) THEN
IF( UPPER ) THEN
TRANS = 'T'
ELSE
TRANS = 'N'
END IF
CALL PDTRMM( 'Left', UPLO, TRANS, 'Non-unit', N, NEIG,
ONE, B, IB, JB, DESCB, Z, IZ, JZ, DESCZ )
END IF
END IF
IF( SCALE.NE.ONE ) THEN
CALL DSCAL( N, SCALE, W, 1 )
END IF
IWORK( 1 ) = LIWMIN
WORK( 1 ) = DBLE( LWOPT )
RETURN
END
PURPOSE
ScaLAPACK version 1.7 13 August 2001 PDSYGVX(3)