PZHEGVX(3) MathKeisan ScaLAPACK routine PZHEGVX(3)
NAME
SYNOPSIS
SUBROUTINE PZHEGVX( 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, RWORK,
LRWORK, IWORK, LIWORK, IFAIL, ICLUSTR, GAP, INFO )
CHARACTER JOBZ, RANGE, UPLO
INTEGER IA, IB, IBTYPE, IL, INFO, IU, IZ, JA, JB, JZ,
LIWORK, LRWORK, LWORK, M, N, NZ
DOUBLE PRECISION ABSTOL, ORFAC, VL, VU
INTEGER DESCA( * ), DESCB( * ), DESCZ( * ), ICLUSTR( * ),
IFAIL( * ), IWORK( * )
DOUBLE PRECISION GAP( * ), RWORK( * ), W( * )
COMPLEX*16 A( * ), B( * ), 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 )
COMPLEX*16 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, LRWMIN, LRWOPT,
LWMIN, LWOPT, MQ0, MYCOL, MYROW, NB, NEIG,
NHEGST_LWOPT, NHETRD_LWOPT, NN, NP0, NPCOL, NPROW,
NPS, NQ0, 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, PXERBLA, PZHEEVX, PZHENGST,
PZPOTRF, PZTRMM, PZTRSM
INTRINSIC ABS, DBLE, DCMPLX, 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
RWORK( 1 ) = ABSTOL
IF( VALEIG ) THEN
RWORK( 2 ) = VL
RWORK( 3 ) = VU
ELSE
RWORK( 2 ) = ZERO
RWORK( 3 ) = ZERO
END IF
CALL DGEBS2D( DESCA( CTXT_ ), 'ALL', ' ', 3, 1, RWORK, 3
)
ELSE
CALL DGEBR2D( DESCA( CTXT_ ), 'ALL', ' ', 3, 1, RWORK,
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 .OR. LRWORK.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 = N + MAX( NB*( NP0+1 ), 3 )
LWOPT = LWMIN
LRWMIN = 5*NN + 4*N
IF( WANTZ ) THEN
MQ0 = NUMROC( MAX( N, NB, 2 ), NB, 0, 0, NPCOL )
LRWOPT = 4*N + MAX( 5*NN, NP0*MQ0 )
ELSE
LRWOPT = LRWMIN
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 = N + ( NP0+MQ0+NB )*NB
LWOPT = LWMIN
LRWMIN = 4*N + MAX( 5*NN, NP0*MQ0 ) + ICEIL( NEIG,
NPROW*NPCOL )*NN
LRWOPT = LRWMIN
END IF
ANB = PJLAENV( ICTXT, 3, 'PZHETTRD', 'L', 0, 0, 0, 0 )
SQNPC = INT( SQRT( DBLE( NPROW*NPCOL ) ) )
NPS = MAX( NUMROC( N, 1, 0, 0, SQNPC ), 2*ANB )
NHETRD_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 )
NHEGST_LWOPT = 2*NP0*NB + NQ0*NB + NB*NB
LWOPT = MAX( LWOPT, N+NHETRD_LWOPT, NHEGST_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( RWORK( 2 )-VL
).GT.FIVE*EPS* ABS( VL ) ) ) THEN
INFO = -14
ELSE IF( VALEIG .AND. ( ABS( RWORK( 3 )-VU
).GT.FIVE*EPS* ABS( VU ) ) ) THEN
INFO = -15
ELSE IF( ABS( RWORK( 1 )-ABSTOL ).GT.FIVE*EPS* ABS(
ABSTOL ) ) THEN
INFO = -18
ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
INFO = -28
ELSE IF( LRWORK.LT.LRWMIN .AND. .NOT.LQUERY ) THEN
INFO = -30
ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
INFO = -32
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 ) = DCMPLX( DBLE( LWOPT ) )
RWORK( 1 ) = DBLE( LRWOPT )
IF( INFO.NE.0 ) THEN
CALL PXERBLA( ICTXT, 'PZHEGVX ', -INFO )
RETURN
ELSE IF( LQUERY ) THEN
RETURN
END IF
CALL PZPOTRF( UPLO, N, B, IB, JB, DESCB, INFO )
IF( INFO.NE.0 ) THEN
IWORK( 1 ) = LIWMIN
WORK( 1 ) = DCMPLX( DBLE( LWOPT ) )
RWORK( 1 ) = DBLE( LRWOPT )
IFAIL( 1 ) = INFO
INFO = IERRNPD
RETURN
END IF
CALL PZHENGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB,
JB, DESCB, SCALE, WORK, LWORK, INFO )
CALL PZHEEVX( JOBZ, RANGE, UPLO, N, A, IA, JA, DESCA,
VL, VU, IL, IU, ABSTOL, M, NZ, W, ORFAC, Z, IZ, JZ,
DESCZ, WORK, LWORK, RWORK, LRWORK, 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 = 'C'
END IF
CALL PZTRSM( '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 = 'C'
ELSE
TRANS = 'N'
END IF
CALL PZTRMM( '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 ) = DCMPLX( DBLE( LWOPT ) )
RWORK( 1 ) = DBLE( LRWOPT )
RETURN
END
PURPOSE
ScaLAPACK version 1.7 13 August 2001 PZHEGVX(3)