PSSYGVX(3) MathKeisan ScaLAPACK routine PSSYGVX(3)
NAME
SYNOPSIS
SUBROUTINE PSSYGVX( 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
REAL ABSTOL, ORFAC, VL, VU
INTEGER DESCA( * ), DESCB( * ), DESCZ( * ), ICLUSTR( * ),
IFAIL( * ), IWORK( * )
REAL 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 )
REAL ONE
PARAMETER ( ONE = 1.0E+0 )
REAL FIVE, ZERO
PARAMETER ( FIVE = 5.0E+0, ZERO = 0.0E+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
REAL EPS, SCALE
INTEGER IDUM1( 5 ), IDUM2( 5 )
LOGICAL LSAME
INTEGER ICEIL, INDXG2P, NUMROC, PJLAENV
REAL PSLAMCH
EXTERNAL LSAME, ICEIL, INDXG2P, NUMROC, PJLAENV, PSLAMCH
EXTERNAL BLACS_GRIDINFO, CHK1MAT, PCHK1MAT, PCHK2MAT,
PSPOTRF, PSSYEVX, PSSYNGST, PSTRMM, PSTRSM,
PXERBLA, SGEBR2D, SGEBS2D, SSCAL
INTRINSIC ABS, DBLE, ICHAR, INT, MAX, MIN, MOD, REAL, 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 = PSLAMCH( 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 SGEBS2D( DESCA( CTXT_ ), 'ALL', ' ', 3, 1, WORK, 3
)
ELSE
CALL SGEBR2D( 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, 'PSSYTTRD', '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 ) = REAL( LWOPT )
IF( INFO.NE.0 ) THEN
CALL PXERBLA( ICTXT, 'PSSYGVX ', -INFO )
RETURN
ELSE IF( LQUERY ) THEN
RETURN
END IF
CALL PSPOTRF( UPLO, N, B, IB, JB, DESCB, INFO )
IF( INFO.NE.0 ) THEN
IWORK( 1 ) = LIWMIN
WORK( 1 ) = REAL( LWOPT )
IFAIL( 1 ) = INFO
INFO = IERRNPD
RETURN
END IF
CALL PSSYNGST( IBTYPE, UPLO, N, A, IA, JA, DESCA, B, IB,
JB, DESCB, SCALE, WORK, LWORK, INFO )
CALL PSSYEVX( 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 PSTRSM( '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 PSTRMM( '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 SSCAL( N, SCALE, W, 1 )
END IF
IWORK( 1 ) = LIWMIN
WORK( 1 ) = REAL( LWOPT )
RETURN
END
PURPOSE
ScaLAPACK version 1.7 13 August 2001 PSSYGVX(3)