Routine: PZHEEVX()  File: SRC\pzheevx.f

 
 
# lines: 1001
  # code: 1001
  # comment: 0
  # blank:0
# Variables:127
# Callers:1
# Callings:9
# Words:534
# Keywords:327
 

 

..
     .. Array Arguments ..
     ..
  Purpose
  =======
  PZHEEVX computes selected eigenvalues and, optionally, eigenvectors
  of a complex hermitian matrix A by calling the recommended sequence
  of ScaLAPACK routines.  Eigenvalues/vectors can be selected by
  specifying a range of values or a range of indices for the desired
  eigenvalues.
  Notes
  =====
  Each global data object is described by an associated description
  vector.  This vector stores the information required to establish
  the mapping between an object element and its corresponding process
  and memory location.
  Let A be a generic term for any 2D block cyclicly distributed array.
  Such a global array has an associated description vector DESCA.
  In the following comments, the character _ should be read as
  "of the global array".
  NOTATION        STORED IN      EXPLANATION
  --------------- -------------- --------------------------------------
  DTYPE_A(global) DESCA( DTYPE_ )The descriptor type.  In this case,
                                 DTYPE_A = 1.
  CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating
                                 the BLACS process grid A is distribu-
                                 ted over. The context itself is glo-
                                 bal, but the handle (the integer
                                 value) may vary.
  M_A    (global) DESCA( M_ )    The number of rows in the global
                                 array A.
  N_A    (global) DESCA( N_ )    The number of columns in the global
                                 array A.
  MB_A   (global) DESCA( MB_ )   The blocking factor used to distribute
                                 the rows of the array.
  NB_A   (global) DESCA( NB_ )   The blocking factor used to distribute
                                 the columns of the array.
  RSRC_A (global) DESCA( RSRC_ ) The process row over which the first
                                 row of the array A is distributed.
  CSRC_A (global) DESCA( CSRC_ ) The process column over which the
                                 first column of the array A is
                                 distributed.
  LLD_A  (local)  DESCA( LLD_ )  The leading dimension of the local
                                 array.  LLD_A >= MAX(1,LOCr(M_A)).
  Let K be the number of rows or columns of a distributed matrix,
  and assume that its process grid has dimension p x q.
  LOCr( K ) denotes the number of elements of K that a process
  would receive if K were distributed over the p processes of its
  process column.
  Similarly, LOCc( K ) denotes the number of elements of K that a
  process would receive if K were distributed over the q processes of
  its process row.
  The values of LOCr() and LOCc() may be determined via a call to the
  ScaLAPACK tool function, NUMROC:
          LOCr( M ) = NUMROC( M, MB_A, MYROW, RSRC_A, NPROW ),
          LOCc( N ) = NUMROC( N, NB_A, MYCOL, CSRC_A, NPCOL ).
  An upper bound for these quantities may be computed by:
          LOCr( M ) <= ceil( ceil(M/MB_A)/NPROW )*MB_A
          LOCc( N ) <= ceil( ceil(N/NB_A)/NPCOL )*NB_A
  PZHEEVX assumes IEEE 754 standard compliant arithmetic.  To port
  to a system which does not have IEEE 754 arithmetic, modify
  the appropriate SLmake.inc file to include the compiler switch
  -DNO_IEEE.  This switch only affects the compilation of pdlaiect.c.
  Arguments
  =========
     NP = the number of rows local to a given process.
     NQ = the number of columns local to a given process.
  JOBZ    (global input) CHARACTER*1
          Specifies whether or not to compute the eigenvectors:
          = 'N':  Compute eigenvalues only.
          = 'V':  Compute eigenvalues and eigenvectors.
  RANGE   (global input) CHARACTER*1
          = 'A': all eigenvalues will be found.
          = 'V': all eigenvalues in the interval [VL,VU] will be found.
          = 'I': the IL-th through IU-th eigenvalues will be found.
  UPLO    (global input) CHARACTER*1
          Specifies whether the upper or lower triangular part of the
          Hermitian matrix A is stored:
          = 'U':  Upper triangular
          = 'L':  Lower triangular
  N       (global input) INTEGER
          The number of rows and columns of the matrix A.  N >= 0.
  A       (local input/workspace) block cyclic COMPLEX*16 array,
          global dimension (N, N),
          local dimension ( LLD_A, LOCc(JA+N-1) )
          On entry, the Hermitian matrix A.  If UPLO = 'U', only the
          upper triangular part of A is used to define the elements of
          the Hermitian matrix.  If UPLO = 'L', only the lower
          triangular part of A is used to define the elements of the
          Hermitian matrix.
          On exit, the lower triangle (if UPLO='L') or the upper
          triangle (if UPLO='U') of A, including the diagonal, is
          destroyed.
  IA      (global input) INTEGER
          A's global row index, which points to the beginning of the
          submatrix which is to be operated on.
  JA      (global input) INTEGER
          A's global column index, which points to the beginning of
          the submatrix which is to be operated on.
  DESCA   (global and local input) INTEGER array of dimension DLEN_.
          The array descriptor for the distributed matrix A.
          If DESCA( CTXT_ ) is incorrect, PZHEEVX cannot guarantee
          correct error reporting.
  VL      (global input) DOUBLE PRECISION
          If RANGE='V', the lower bound of the interval to be searched
          for eigenvalues.  Not referenced if RANGE = 'A' or 'I'.
  VU      (global input) DOUBLE PRECISION
          If RANGE='V', the upper bound of the interval to be searched
          for eigenvalues.  Not referenced if RANGE = 'A' or 'I'.
  IL      (global input) INTEGER
          If RANGE='I', the index (from smallest to largest) of the
          smallest eigenvalue to be returned.  IL >= 1.
          Not referenced if RANGE = 'A' or 'V'.
  IU      (global input) INTEGER
          If RANGE='I', the index (from smallest to largest) of the
          largest eigenvalue to be returned.  min(IL,N) <= IU <= N.
          Not referenced if RANGE = 'A' or 'V'.
  ABSTOL  (global input) DOUBLE PRECISION
          If JOBZ='V', setting ABSTOL to PDLAMCH( CONTEXT, 'U') yields
          the most orthogonal eigenvectors.
          The absolute error tolerance for the eigenvalues.
          An approximate eigenvalue is accepted as converged
          when it is determined to lie in an interval [a,b]
          of width less than or equal to
                  ABSTOL + EPS *   max( |a|,|b| ) ,
          where EPS is the machine precision.  If ABSTOL is less than
          or equal to zero, then EPS*norm(T) will be used in its place,
          where norm(T) is the 1-norm of the tridiagonal matrix
          obtained by reducing A to tridiagonal form.
          Eigenvalues will be computed most accurately when ABSTOL is
          set to twice the underflow threshold 2*PDLAMCH('S') not zero.
          If this routine returns with ((MOD(INFO,2).NE.0) .OR.
          (MOD(INFO/8,2).NE.0)), indicating that some eigenvalues or
          eigenvectors did not converge, try setting ABSTOL to
          2*PDLAMCH('S').
          See "Computing Small Singular Values of Bidiagonal Matrices
          with Guaranteed High Relative Accuracy," by Demmel and
          Kahan, LAPACK Working Note #3.
          See "On the correctness of Parallel Bisection in Floating
          Point" by Demmel, Dhillon and Ren, LAPACK Working Note #70
  M       (global output) INTEGER
          Total number of eigenvalues found.  0 <= M <= N.
  NZ      (global output) INTEGER
          Total number of eigenvectors computed.  0 <= NZ <= M.
          The number of columns of Z that are filled.
          If JOBZ .NE. 'V', NZ is not referenced.
          If JOBZ .EQ. 'V', NZ = M unless the user supplies
          insufficient space and PZHEEVX is not able to detect this
          before beginning computation.  To get all the eigenvectors
          requested, the user must supply both sufficient
          space to hold the eigenvectors in Z (M .LE. DESCZ(N_))
          and sufficient workspace to compute them.  (See LWORK below.)
          PZHEEVX is always able to detect insufficient space without
          computation unless RANGE .EQ. 'V'.
  W       (global output) DOUBLE PRECISION array, dimension (N)
          On normal exit, the first M entries contain the selected
          eigenvalues in ascending order.
  ORFAC   (global input) DOUBLE PRECISION
          Specifies which eigenvectors should be reorthogonalized.
          Eigenvectors that correspond to eigenvalues which are within
          tol=ORFAC*norm(A) of each other are to be reorthogonalized.
          However, if the workspace is insufficient (see LWORK),
          tol may be decreased until all eigenvectors to be
          reorthogonalized can be stored in one process.
          No reorthogonalization will be done if ORFAC equals zero.
          A default value of 10^-3 is used if ORFAC is negative.
          ORFAC should be identical on all processes.
  Z       (local output) COMPLEX*16 array,
          global dimension (N, N),
          local dimension ( LLD_Z, LOCc(JZ+N-1) )
          If JOBZ = 'V', then on normal exit the first M columns of Z
          contain the orthonormal eigenvectors of the matrix
          corresponding to the selected eigenvalues.  If an eigenvector
          fails to converge, then that column of Z contains the latest
          approximation to the eigenvector, and the index of the
          eigenvector is returned in IFAIL.
          If JOBZ = 'N', then Z is not referenced.
  IZ      (global input) INTEGER
          Z's global row index, which points to the beginning of the
          submatrix which is to be operated on.
  JZ      (global input) INTEGER
          Z's global column index, which points to the beginning of
          the submatrix which is to be operated on.
  DESCZ   (global and local input) INTEGER array of dimension DLEN_.
          The array descriptor for the distributed matrix Z.
          DESCZ( CTXT_ ) must equal DESCA( CTXT_ )
  WORK    (local workspace/output) COMPLEX*16 array,
          dimension (LWORK)
          WORK(1) returns workspace adequate workspace to allow
          optimal performance.
  LWORK   (local input) INTEGER
          Size of WORK array.  If only eigenvalues are requested:
            LWORK >= N + MAX( NB * ( NP0 + 1 ), 3 )
          If eigenvectors are requested:
            LWORK >= N + ( NP0 + MQ0 + NB ) * NB
          with NQ0 = NUMROC( NN, NB, 0, 0, NPCOL ).
          For optimal performance, greater workspace is needed, i.e.
            LWORK >= MAX( LWORK, NHETRD_LWORK )
          Where LWORK is as defined above, and
          NHETRD_LWORK = N + 2*( ANB+1 )*( 4*NPS+2 ) +
            ( NPS + 1 ) * NPS
          ICTXT = DESCA( CTXT_ )
          ANB = PJLAENV( ICTXT, 3, 'PZHETTRD', 'L', 0, 0, 0, 0 )
          SQNPC = SQRT( DBLE( NPROW * NPCOL ) )
          NPS = MAX( NUMROC( N, 1, 0, 0, SQNPC ), 2*ANB )
          NUMROC is a ScaLAPACK tool functions;
          PJLAENV is a ScaLAPACK envionmental inquiry function
          MYROW, MYCOL, NPROW and NPCOL can be determined by calling
          the subroutine BLACS_GRIDINFO.
          If LWORK = -1, then LWORK is global input and a workspace
          query is assumed; the routine only calculates the
          optimal size for all work arrays. Each of these
          values is returned in the first entry of the corresponding
          work array, and no error message is issued by PXERBLA.
  RWORK   (local workspace/output) DOUBLE PRECISION array,
             dimension max(3,LRWORK)
          On return, WORK(1) contains the optimal amount of
          workspace required for efficient execution.
          if JOBZ='N' RWORK(1) = optimal amount of workspace
             required to compute eigenvalues efficiently
          if JOBZ='V' RWORK(1) = optimal amount of workspace
             required to compute eigenvalues and eigenvectors
             efficiently with no guarantee on orthogonality.
             If RANGE='V', it is assumed that all eigenvectors
             may be required.
  LRWORK   (local input) INTEGER
          Size of RWORK
          See below for definitions of variables used to define LRWORK.
          If no eigenvectors are requested (JOBZ = 'N') then
             LRWORK >= 5 * NN + 4 * N
          If eigenvectors are requested (JOBZ = 'V' ) then
             the amount of workspace required to guarantee that all
             eigenvectors are computed is:
             LRWORK >= 4*N + MAX( 5*NN, NP0 * MQ0 ) +
               ICEIL( NEIG, NPROW*NPCOL)*NN
             The computed eigenvectors may not be orthogonal if the
             minimal workspace is supplied and ORFAC is too small.
             If you want to guarantee orthogonality (at the cost
             of potentially poor performance) you should add
             the following to LRWORK:
                (CLUSTERSIZE-1)*N
             where CLUSTERSIZE is the number of eigenvalues in the
             largest cluster, where a cluster is defined as a set of
             close eigenvalues: { W(K),...,W(K+CLUSTERSIZE-1) |
                                  W(J+1) <= W(J) + ORFAC*2*norm(A) }
          Variable definitions:
             NEIG = number of eigenvectors requested
             NB = DESCA( MB_ ) = DESCA( NB_ ) =
                  DESCZ( MB_ ) = DESCZ( NB_ )
             NN = MAX( N, NB, 2 )
             DESCA( RSRC_ ) = DESCA( NB_ ) = DESCZ( RSRC_ ) =
                              DESCZ( CSRC_ ) = 0
             NP0 = NUMROC( NN, NB, 0, 0, NPROW )
             MQ0 = NUMROC( MAX( NEIG, NB, 2 ), NB, 0, 0, NPCOL )
             ICEIL( X, Y ) is a ScaLAPACK function returning
             ceiling(X/Y)
          When LRWORK is too small:
             If LRWORK is too small to guarantee orthogonality,
             PZHEEVX attempts to maintain orthogonality in
             the clusters with the smallest
             spacing between the eigenvalues.
             If LRWORK is too small to compute all the eigenvectors
             requested, no computation is performed and INFO=-25
             is returned.  Note that when RANGE='V', PZHEEVX does
             not know how many eigenvectors are requested until
             the eigenvalues are computed.  Therefore, when RANGE='V'
             and as long as LRWORK is large enough to allow PZHEEVX to
             compute the eigenvalues, PZHEEVX will compute the
             eigenvalues and as many eigenvectors as it can.
          Relationship between workspace, orthogonality & performance:
             If CLUSTERSIZE >= N/SQRT(NPROW*NPCOL), then providing
             enough space to compute all the eigenvectors
             orthogonally will cause serious degradation in
             performance. In the limit (i.e. CLUSTERSIZE = N-1)
             PZSTEIN will perform no better than ZSTEIN on 1
             processor.
             For CLUSTERSIZE = N/SQRT(NPROW*NPCOL) reorthogonalizing
             all eigenvectors will increase the total execution time
             by a factor of 2 or more.
             For CLUSTERSIZE > N/SQRT(NPROW*NPCOL) execution time will
             grow as the square of the cluster size, all other factors
             remaining equal and assuming enough workspace.  Less
             workspace means less reorthogonalization but faster
             execution.
          If LRWORK = -1, then LRWORK is global input and a workspace
          query is assumed; the routine only calculates the size
          required for optimal performance for all work arrays. Each of
          these values is returned in the first entry of the
          corresponding work arrays, and no error message is issued by
          PXERBLA.
  IWORK   (local workspace) INTEGER array
          On return, IWORK(1) contains the amount of integer workspace
          required.
  LIWORK  (local input) INTEGER
          size of IWORK
          LIWORK >= 6 * NNP
          Where:
            NNP = MAX( N, NPROW*NPCOL + 1, 4 )
          If LIWORK = -1, then LIWORK is global input and a workspace
          query is assumed; the routine only calculates the minimum
          and optimal size for all work arrays. Each of these
          values is returned in the first entry of the corresponding
          work array, and no error message is issued by PXERBLA.
  IFAIL   (global output) INTEGER array, dimension (N)
          If JOBZ = 'V', then on normal exit, the first M elements of
          IFAIL are zero.  If (MOD(INFO,2).NE.0) on exit, then
          IFAIL contains the
          indices of the eigenvectors that failed to converge.
          If JOBZ = 'N', then IFAIL is not referenced.
  ICLUSTR (global output) integer array, dimension (2*NPROW*NPCOL)
          This array contains indices of eigenvectors corresponding to
          a cluster of eigenvalues that could not be reorthogonalized
          due to insufficient workspace (see LWORK, ORFAC and INFO).
          Eigenvectors corresponding to clusters of eigenvalues indexed
          ICLUSTR(2*I-1) to ICLUSTR(2*I), could not be
          reorthogonalized due to lack of workspace. Hence the
          eigenvectors corresponding to these clusters may not be
          orthogonal.  ICLUSTR() is a zero terminated array.
          (ICLUSTR(2*K).NE.0 .AND. ICLUSTR(2*K+1).EQ.0) if and only if
          K is the number of clusters
          ICLUSTR is not referenced if JOBZ = 'N'
  GAP     (global output) DOUBLE PRECISION array,
             dimension (NPROW*NPCOL)
          This array contains the gap between eigenvalues whose
          eigenvectors could not be reorthogonalized. The output
          values in this array correspond to the clusters indicated
          by the array ICLUSTR. As a result, the dot product between
          eigenvectors correspoding to the I^th cluster may be as high
          as ( C * n ) / GAP(I) where C is a small constant.
  INFO    (global output) INTEGER
          = 0:  successful exit
          < 0:  If the i-th argument is an array and the j-entry had
                an illegal value, then INFO = -(i*100+j), if the i-th
                argument is a scalar and had an illegal value, then
                INFO = -i.
          > 0:  if (MOD(INFO,2).NE.0), then one or more eigenvectors
                  failed to converge.  Their indices are stored
                  in IFAIL.  Ensure ABSTOL=2.0*PDLAMCH( 'U' )
                  Send e-mail to scalapack@cs.utk.edu
                if (MOD(INFO/2,2).NE.0),then eigenvectors corresponding
                  to one or more clusters of eigenvalues could not be
                  reorthogonalized because of insufficient workspace.
                  The indices of the clusters are stored in the array
                  ICLUSTR.
                if (MOD(INFO/4,2).NE.0), then space limit prevented
                  PZHEEVX from computing all of the eigenvectors
                  between VL and VU.  The number of eigenvectors
                  computed is returned in NZ.
                if (MOD(INFO/8,2).NE.0), then PZSTEBZ failed to compute
                  eigenvalues.  Ensure ABSTOL=2.0*PDLAMCH( 'U' )
                  Send e-mail to scalapack@cs.utk.edu
  Alignment requirements
  ======================
  The distributed submatrices A(IA:*, JA:*) and C(IC:IC+M-1,JC:JC+N-1)
  must verify some alignment properties, namely the following
  expressions should be true:
  ( MB_A.EQ.NB_A.EQ.MB_Z .AND. IROFFA.EQ.IROFFZ .AND. IROFFA.EQ.0 .AND.
    IAROW.EQ.IZROW )
  where
  IROFFA = MOD( IA-1, MB_A ) and ICOFFA = MOD( JA-1, NB_A ).
  =====================================================================
  Differences between PZHEEVX and ZHEEVX
  ======================================
  A, LDA -> A, IA, JA, DESCA
  Z, LDZ -> Z, IZ, JZ, DESCZ
  WORKSPACE needs are larger for PZHEEVX.
  LIWORK parameter added
  ORFAC, ICLUSTER() and GAP() parameters added
  meaning of INFO is changed
  Functional differences:
  PZHEEVX does not promise orthogonality for eigenvectors associated
  with tighly clustered eigenvalues.
  PZHEEVX does not reorthogonalize eigenvectors
  that are on different processes. The extent of reorthogonalization
  is controlled by the input parameter LWORK.
  Version 1.4 limitations:
     DESCA(MB_) = DESCA(NB_)
     DESCA(M_) = DESCZ(M_)
     DESCA(N_) = DESCZ(N_)
     DESCA(MB_) = DESCZ(MB_)
     DESCA(NB_) = DESCZ(NB_)
     DESCA(RSRC_) = DESCZ(RSRC_)
     .. Parameters ..

 
Display dynamic version Find AutoScroll Reload FontSize: - + Hide Comments Hide Blanks Frame FullScreen MailPrint

 
001        SUBROUTINE PZHEEVX( JOBZ , RANGE , UPLO , N , A , IA , JA , DESCA , VL ,
002       $VU , IL , IU , ABSTOL , M , NZ , W , ORFAC , Z , IZ ,
003       $JZ , DESCZ , WORK , LWORK , RWORK , LRWORK , IWORK ,
004       $LIWORK , IFAIL , ICLUSTR , GAP , INFO )
005  
006  *     -- ScaLAPACK routine(version 1.7) --
007  *     University of Tennessee , Knoxville , Oak Ridge National Laboratory ,
008  *     and University of California , Berkeley.
009  *     May 25 , 2001
010  
011  *     .. Scalar Arguments ..
012        CHARACTER JOBZ , RANGE , UPLO
013        INTEGER IA , IL , INFO , IU , IZ , JA , JZ , LIWORK , LRWORK ,
014       $LWORK , M , N , NZ
015        DOUBLE PRECISION ABSTOL , ORFAC , VL , VU
016        INTEGER BLOCK_CYCLIC_2D , DLEN_ , DTYPE_ , CTXT_ , M_ , N_ ,
017       $MB_ , NB_ , RSRC_ , CSRC_ , LLD_
018        PARAMETER( BLOCK_CYCLIC_2D = 1 , DLEN_ = 9 , DTYPE_ = 1 ,
019       $CTXT_ = 2 , M_ = 3 , N_ = 4 , MB_ = 5 , NB_ = 6 ,
020       $RSRC_ = 7 , CSRC_ = 8 , LLD_ = 9 )
021        DOUBLE PRECISION ZERO , ONE , TEN , FIVE
022        PARAMETER( ZERO = 0.0D + 0 , ONE = 1.0D + 0 , TEN = 10.0D + 0 ,
023       $FIVE = 5.0D + 0 )
024        INTEGER IERREIN , IERRCLS , IERRSPC , IERREBZ
025        PARAMETER( IERREIN = 1 , IERRCLS = 2 , IERRSPC = 4 ,
026       $IERREBZ = 8 )
027  *     ..
028  *     .. Local Scalars ..
029        LOGICAL ALLEIG , INDEIG , LOWER , LQUERY , QUICKRETURN ,
030       $VALEIG , WANTZ
031        CHARACTER ORDER
032        INTEGER ANB , CSRC_A , I , IAROW , ICOFFA , ICTXT , IINFO ,
033       $INDD , INDD2 , INDE , INDE2 , INDIBL , INDISP ,
034       $INDRWORK , INDTAU , INDWORK , IROFFA , IROFFZ ,
035       $ISCALE , ISIZESTEBZ , ISIZESTEIN , IZROW ,
036       $LALLWORK , LIWMIN , LLRWORK , LLWORK , LRWMIN ,
037       $LRWOPT , LWMIN , LWOPT , MAXEIGS , MB_A , MQ0 ,
038       $MYCOL , MYROW , NB , NB_A , NEIG , NHETRD_LWOPT , NN ,
039       $NNP , NP0 , NPCOL , NPROCS , NPROW , NPS , NQ0 ,
040       $NSPLIT , NZZ , OFFSET , RSRC_A , RSRC_Z , SIZEHEEVX ,
041       $SIZESTEIN , SQNPC
042        DOUBLE PRECISION ABSTLL , ANRM , BIGNUM , EPS , RMAX , RMIN , SAFMIN ,
043       $SIGMA , SMLNUM , VLL , VUU
044  *     ..
045  *     .. Local Arrays ..
046        INTEGER IDUM1( 4 ) , IDUM2( 4 )
047  *     ..
048  *     .. External Functions ..
049        LOGICAL LSAME
050        INTEGER ICEIL , INDXG2P , NUMROC , PJLAENV
051        DOUBLE PRECISION PDLAMCH , PZLANHE
052        EXTERNAL LSAME , ICEIL , INDXG2P , NUMROC , PJLAENV ,
053       $PDLAMCH , PZLANHE
054  *     ..
055  *     .. External Subroutines ..
056        EXTERNAL BLACS_GRIDINFO , CHK1MAT , DGEBR2D , DGEBS2D ,
057       $DLASRT , DSCAL , IGAMN2D , PCHK1MAT , PCHK2MAT ,
058       $PDLARED1D , PDSTEBZ , PXERBLA , PZELGET , PZHENTRD ,
059       $PZLASCL , PZSTEIN , PZUNMTR  
060  *     ..
061  *     .. Intrinsic Functions ..
062        INTRINSIC ABS , DBLE , DCMPLX , ICHAR , INT , MAX , MIN , MOD ,
063       $SQRT
064  *     ..
065  *     .. Executable Statements ..
066  *     This is just to keep ftnchek and toolpack / 1 happy
067        IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_*
068       $    RSRC_.LT.0 )RETURN
069  
070            QUICKRETURN =( N.EQ.0 )
071  
072  *         Test the input arguments.
073  
074            ICTXT = DESCA( CTXT_ )
075            CALL BLACS_GRIDINFO( ICTXT , NPROW , NPCOL , MYROW , MYCOL )
076            INFO = 0
077  
078            WANTZ = LSAME( JOBZ , 'V' )
079            IF( NPROW.EQ. - 1 ) THEN
080                INFO = - ( 800 + CTXT_ )
081            ELSE IF( WANTZ ) THEN
082                IF( ICTXT.NE.DESCZ( CTXT_ ) ) THEN
083                    INFO = - ( 2100 + CTXT_ )
084                END IF
085            END IF
086            IF( INFO.EQ.0 ) THEN
087                CALL CHK1MAT( N , 4 , N , 4 , IA , JA , DESCA , 8 , INFO )
088                IF( WANTZ )
089       $            CALL CHK1MAT( N , 4 , N , 4 , IZ , JZ , DESCZ , 21 , INFO )
090  
091                    IF( INFO.EQ.0 ) THEN
092  
093  *                     Get machine constants.
094  
095                        SAFMIN = PDLAMCH( ICTXT , 'Safe minimum' )
096                        EPS = PDLAMCH( ICTXT , 'Precision' )
097                        SMLNUM = SAFMIN / EPS
098                        BIGNUM = ONE / SMLNUM
099                        RMIN = SQRT( SMLNUM )
100                        RMAX = MIN( SQRT( BIGNUM ) , ONE / SQRT( SQRT( SAFMIN ) ) )
101  
102                        NPROCS = NPROW*NPCOL
103                        LOWER = LSAME( UPLO , 'L' )
104                        ALLEIG = LSAME( RANGE , 'A' )
105                        VALEIG = LSAME( RANGE , 'V' )
106                        INDEIG = LSAME( RANGE , 'I' )
107  
108  *                     Set up pointers into the WORK array
109  
110                        INDTAU = 1
111                        INDWORK = INDTAU + N
112                        LLWORK = LWORK - INDWORK + 1
113  
114  *                     Set up pointers into the RWORK array
115  
116                        INDE = 1
117                        INDD = INDE + N
118                        INDD2 = INDD + N
119                        INDE2 = INDD2 + N
120                        INDRWORK = INDE2 + N
121                        LLRWORK = LRWORK - INDRWORK + 1
122  
123  *                     Set up pointers into the IWORK array
124  
125                        ISIZESTEIN = 3*N + NPROCS + 1
126                        ISIZESTEBZ = MAX( 4*N , 14 , NPROCS )
127                        INDIBL =( MAX( ISIZESTEIN , ISIZESTEBZ ) ) + 1
128                        INDISP = INDIBL + N
129  
130  *                     Compute the total amount of space needed
131  
132                        LQUERY = .FALSE.
133                        IF( LWORK.EQ. - 1 .OR. LIWORK.EQ. - 1 .OR. LRWORK.EQ. - 1 )
134       $                    LQUERY = .TRUE.
135  
136                            NNP = MAX( N , NPROCS + 1 , 4 )
137                            LIWMIN = 6*NNP
138  
139                            NPROCS = NPROW*NPCOL
140                            NB_A = DESCA( NB_ )
141                            MB_A = DESCA( MB_ )
142                            NB = NB_A
143                            NN = MAX( N , NB , 2 )
144  
145                            RSRC_A = DESCA( RSRC_ )
146                            CSRC_A = DESCA( CSRC_ )
147                            IROFFA = MOD( IA - 1 , MB_A )
148                            ICOFFA = MOD( JA - 1 , NB_A )
149                            IAROW = INDXG2P( 1 , NB_A , MYROW , RSRC_A , NPROW )
150                            NP0 = NUMROC( N + IROFFA , NB , 0 , 0 , NPROW )
151                            MQ0 = NUMROC( N + ICOFFA , NB , 0 , 0 , NPCOL )
152                            IF( WANTZ ) THEN
153                                RSRC_Z = DESCZ( RSRC_ )
154                                IROFFZ = MOD( IZ - 1 , MB_A )
155                                IZROW = INDXG2P( 1 , NB_A , MYROW , RSRC_Z , NPROW )
156                            END IF
157  
158                            IF(( .NOT.WANTZ ) .OR.( VALEIG .AND.( .NOT.LQUERY ) ) )
159       $                        THEN
160                                LWMIN = N + MAX( NB*( NP0 + 1 ) , 3 )
161                                LWOPT = LWMIN
162                                LRWMIN = 5*NN + 4*N
163                                IF( WANTZ ) THEN
164                                    MQ0 = NUMROC( MAX( N , NB , 2 ) , NB , 0 , 0 , NPCOL )
165                                    LRWOPT = 4*N + MAX( 5*NN , NP0*MQ0 ) +
166       $                            ICEIL( N , NPROW*NPCOL )*NN
167                                ELSE
168                                    LRWOPT = LRWMIN
169                                END IF
170                                NEIG = 0
171                            ELSE
172                                IF( ALLEIG .OR. VALEIG ) THEN
173                                    NEIG = N
174                                ELSE IF( INDEIG ) THEN
175                                    NEIG = IU - IL + 1
176                                END IF
177                                MQ0 = NUMROC( MAX( NEIG , NB , 2 ) , NB , 0 , 0 , NPCOL )
178                                NQ0 = NUMROC( NN , NB , 0 , 0 , NPCOL )
179                                LWMIN = N + ( NP0 + NQ0 + NB )*NB
180                                LRWMIN = 4*N + MAX( 5*NN , NP0*MQ0 ) +
181       $                        ICEIL( NEIG , NPROW*NPCOL )*NN
182                                LRWOPT = LRWMIN
183                                LWOPT = LWMIN
184  
185                            END IF
186  
187  *                         Compute how much workspace is needed to use the
188  *                         new TRD code
189  
190                            ANB = PJLAENV( ICTXT , 3 , 'PZHETTRD' , 'L' , 0 , 0 , 0 , 0 )
191                            SQNPC = INT( SQRT( DBLE( NPROW*NPCOL ) ) )
192                            NPS = MAX( NUMROC( N , 1 , 0 , 0 , SQNPC ) , 2*ANB )
193                            NHETRD_LWOPT = 2*( ANB + 1 )*( 4*NPS + 2 ) + ( NPS + 2 )*NPS
194                            LWOPT = MAX( LWOPT , N + NHETRD_LWOPT )
195  
196                        END IF
197                        IF( INFO.EQ.0 ) THEN
198                            IF( MYROW.EQ.0 .AND. MYCOL.EQ.0 ) THEN
199                                RWORK( 1 ) = ABSTOL
200                                IF( VALEIG ) THEN
201                                    RWORK( 2 ) = VL
202                                    RWORK( 3 ) = VU
203                                ELSE
204                                    RWORK( 2 ) = ZERO
205                                    RWORK( 3 ) = ZERO
206                                END IF
207                                CALL DGEBS2D( ICTXT , 'ALL' , ' ' , 3 , 1 , RWORK , 3 )
208                            ELSE
209                                CALL DGEBR2D( ICTXT , 'ALL' , ' ' , 3 , 1 , RWORK , 3 , 0 , 0 )
210                            END IF
211                            IF( .NOT.( WANTZ .OR. LSAME( JOBZ , 'N' ) ) ) THEN
212                                INFO = - 1
213                            ELSE IF( .NOT.( ALLEIG .OR. VALEIG .OR. INDEIG ) ) THEN
214                                INFO = - 2
215                            ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO , 'U' ) ) ) THEN
216                                INFO = - 3
217                            ELSE IF( VALEIG .AND. N.GT.0 .AND. VU.LE.VL ) THEN
218                                INFO = - 10
219                            ELSE IF( INDEIG .AND.( IL.LT.1 .OR. IL.GT.MAX( 1 , N ) ) )
220       $                        THEN
221                                INFO = - 11
222                            ELSE IF( INDEIG .AND.( IU.LT.MIN( N , IL ) .OR. IU.GT.N ) )
223       $                        THEN
224                                INFO = - 12
225                            ELSE IF( LWORK.LT.LWMIN .AND. LWORK.NE. - 1 ) THEN
226                                INFO = - 23
227                            ELSE IF( LRWORK.LT.LRWMIN .AND. LRWORK.NE. - 1 ) THEN
228                                INFO = - 25
229                            ELSE IF( LIWORK.LT.LIWMIN .AND. LIWORK.NE. - 1 ) THEN
230                                INFO = - 27
231                            ELSE IF( VALEIG .AND.( ABS( RWORK( 2 ) - VL ).GT.FIVE*EPS*
232       $                        ABS( VL ) ) ) THEN
233                                INFO = - 9
234                            ELSE IF( VALEIG .AND.( ABS( RWORK( 3 ) - VU ).GT.FIVE*EPS*
235       $                        ABS( VU ) ) ) THEN
236                                INFO = - 10
237                            ELSE IF( ABS( RWORK( 1 ) - ABSTOL ).GT.FIVE*EPS*
238       $                        ABS( ABSTOL ) ) THEN
239                                INFO = - 13
240                            ELSE IF( IROFFA.NE.0 ) THEN
241                                INFO = - 6
242                            ELSE IF( DESCA( MB_ ).NE.DESCA( NB_ ) ) THEN
243                                INFO = - ( 800 + NB_ )
244                            END IF
245                            IF( WANTZ ) THEN
246                                IF( IROFFA.NE.IROFFZ ) THEN
247                                    INFO = - 19
248                                ELSE IF( IAROW.NE.IZROW ) THEN
249                                    INFO = - 19
250                                ELSE IF( DESCA( M_ ).NE.DESCZ( M_ ) ) THEN
251                                    INFO = - ( 2100 + M_ )
252                                ELSE IF( DESCA( N_ ).NE.DESCZ( N_ ) ) THEN
253                                    INFO = - ( 2100 + N_ )
254                                ELSE IF( DESCA( MB_ ).NE.DESCZ( MB_ ) ) THEN
255                                    INFO = - ( 2100 + MB_ )
256                                ELSE IF( DESCA( NB_ ).NE.DESCZ( NB_ ) ) THEN
257                                    INFO = - ( 2100 + NB_ )
258                                ELSE IF( DESCA( RSRC_ ).NE.DESCZ( RSRC_ ) ) THEN
259                                    INFO = - ( 2100 + RSRC_ )
260                                ELSE IF( DESCA( CSRC_ ).NE.DESCZ( CSRC_ ) ) THEN
261                                    INFO = - ( 2100 + CSRC_ )
262                                ELSE IF( ICTXT.NE.DESCZ( CTXT_ ) ) THEN
263                                    INFO = - ( 2100 + CTXT_ )
264                                END IF
265                            END IF
266                        END IF
267                        IF( WANTZ ) THEN
268                            IDUM1( 1 ) = ICHAR( 'V' )
269                        ELSE
270                            IDUM1( 1 ) = ICHAR( 'N' )
271                        END IF
272                        IDUM2( 1 ) = 1
273                        IF( LOWER ) THEN
274                            IDUM1( 2 ) = ICHAR( 'L' )
275                        ELSE
276                            IDUM1( 2 ) = ICHAR( 'U' )
277                        END IF
278                        IDUM2( 2 ) = 2
279                        IF( ALLEIG ) THEN
280                            IDUM1( 3 ) = ICHAR( 'A' )
281                        ELSE IF( INDEIG ) THEN
282                            IDUM1( 3 ) = ICHAR( 'I' )
283                        ELSE
284                            IDUM1( 3 ) = ICHAR( 'V' )
285                        END IF
286                        IDUM2( 3 ) = 3
287                        IF( LQUERY ) THEN
288                            IDUM1( 4 ) = - 1
289                        ELSE
290                            IDUM1( 4 ) = 1
291                        END IF
292                        IDUM2( 4 ) = 4
293                        IF( WANTZ ) THEN
294                            CALL PCHK2MAT( N , 4 , N , 4 , IA , JA , DESCA , 8 , N , 4 , N , 4 , IZ ,
295       $                    JZ , DESCZ , 21 , 4 , IDUM1 , IDUM2 , INFO )
296                        ELSE
297                            CALL PCHK1MAT( N , 4 , N , 4 , IA , JA , DESCA , 8 , 4 , IDUM1 ,
298       $                    IDUM2 , INFO )
299                        END IF
300                        WORK( 1 ) = DCMPLX( LWOPT )
301                        RWORK( 1 ) = DBLE( LRWOPT )
302                        IWORK( 1 ) = LIWMIN
303                    END IF
304  
305                    IF( INFO.NE.0 ) THEN
306                        CALL PXERBLA( ICTXT , 'PZHEEVX' , - INFO )
307                        RETURN
308                    ELSE IF( LQUERY ) THEN
309                        RETURN
310                    END IF
311  
312  *                 Quick return if possible
313  
314                    IF( QUICKRETURN ) THEN
315                        IF( WANTZ ) THEN
316                            NZ = 0
317                            ICLUSTR( 1 ) = 0
318                        END IF
319                        M = 0
320                        WORK( 1 ) = DCMPLX( LWOPT )
321                        RWORK( 1 ) = DBLE( LRWMIN )
322                        IWORK( 1 ) = LIWMIN
323                        RETURN
324                    END IF
325  
326  *                 Scale matrix to allowable range , if necessary.
327  
328                    ABSTLL = ABSTOL
329                    ISCALE = 0
330                    IF( VALEIG ) THEN
331                        VLL = VL
332                        VUU = VU
333                    ELSE
334                        VLL = ZERO
335                        VUU = ZERO
336                    END IF
337  
338                    ANRM = PZLANHE( 'M' , UPLO , N , A , IA , JA , DESCA ,
339       $            RWORK( INDRWORK ) )
340  
341                    IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
342                        ISCALE = 1
343                        SIGMA = RMIN / ANRM
344                        ANRM = ANRM*SIGMA
345                    ELSE IF( ANRM.GT.RMAX ) THEN
346                        ISCALE = 1
347                        SIGMA = RMAX / ANRM
348                        ANRM = ANRM*SIGMA
349                    END IF
350  
351                    IF( ISCALE.EQ.1 ) THEN
352                        CALL PZLASCL ( UPLO , ONE , SIGMA , N , N , A , IA , JA , DESCA , IINFO )
353                        IF( ABSTOL.GT.0 )
354       $                    ABSTLL = ABSTOL*SIGMA
355                            IF( VALEIG ) THEN
356                                VLL = VL*SIGMA
357                                VUU = VU*SIGMA
358                                IF( VUU.EQ.VLL ) THEN
359                                    VUU = VUU + 2*MAX( ABS( VUU )*EPS , SAFMIN )
360                                END IF
361                            END IF
362                        END IF
363  
364  *                     Call PZHENTRD to reduce Hermitian matrix to tridiagonal form.
365  
366                        LALLWORK = LLRWORK
367  
368                        CALL PZHENTRD ( UPLO , N , A , IA , JA , DESCA , RWORK( INDD ) ,
369       $                RWORK( INDE ) , WORK( INDTAU ) , WORK( INDWORK ) ,
370       $                LLWORK , RWORK( INDRWORK ) , LLRWORK , IINFO )
371  
372  *                     Copy the values of D , E to all processes
373  
374  *                     Here PxLARED1D is used to redistribute the tridiagonal matrix.
375  *                     PxLARED1D , however , doesn't yet work with arbritary matrix
376  *                     distributions so we have PxELGET as a backup.
377  
378                        OFFSET = 0
379                        IF( IA.EQ.1 .AND. JA.EQ.1 .AND. RSRC_A.EQ.0 .AND. CSRC_A.EQ.0 )
380       $                    THEN
381                            CALL PDLARED1D ( N , IA , JA , DESCA , RWORK( INDD ) ,
382       $                    RWORK( INDD2 ) , RWORK( INDRWORK ) , LLRWORK )
383  
384                            CALL PDLARED1D ( N , IA , JA , DESCA , RWORK( INDE ) ,
385       $                    RWORK( INDE2 ) , RWORK( INDRWORK ) , LLRWORK )
386                            IF( .NOT.LOWER )
387       $                        OFFSET = 1
388                            ELSE
389                                DO 10 I = 1 , N
390                                    CALL PZELGET( 'A' , ' ' , WORK( INDD2 + I - 1 ) , A , I + IA - 1 ,
391       $                            I + JA - 1 , DESCA )
392                                    RWORK( INDD2 + I - 1 ) = DBLE( WORK( INDD2 + I - 1 ) )
393     10                         CONTINUE
394                                IF( LSAME( UPLO , 'U' ) ) THEN
395                                    DO 20 I = 1 , N - 1
396                                        CALL PZELGET( 'A' , ' ' , WORK( INDE2 + I - 1 ) , A , I + IA - 1 ,
397       $                                I + JA , DESCA )
398                                        RWORK( INDE2 + I - 1 ) = DBLE( WORK( INDE2 + I - 1 ) )
399     20                             CONTINUE
400                                ELSE
401                                    DO 30 I = 1 , N - 1
402                                        CALL PZELGET( 'A' , ' ' , WORK( INDE2 + I - 1 ) , A , I + IA ,
403       $                                I + JA - 1 , DESCA )
404                                        RWORK( INDE2 + I - 1 ) = DBLE( WORK( INDE2 + I - 1 ) )
405     30                             CONTINUE
406                                END IF
407                            END IF
408  
409  *                         Call PDSTEBZ and , if eigenvectors are desired , PZSTEIN.
410  
411                            IF( WANTZ ) THEN
412                                ORDER = 'B'
413                            ELSE
414                                ORDER = 'E'
415                            END IF
416  
417                            CALL PDSTEBZ ( ICTXT , RANGE , ORDER , N , VLL , VUU , IL , IU , ABSTLL ,
418       $                    RWORK( INDD2 ) , RWORK( INDE2 + OFFSET ) , M , NSPLIT , W ,
419       $                    IWORK( INDIBL ) , IWORK( INDISP ) , RWORK( INDRWORK ) ,
420       $                    LLRWORK , IWORK( 1 ) , ISIZESTEBZ , IINFO )
421  
422  *                         IF PDSTEBZ fails , the error propogates to INFO , but
423  *                         we do not propogate the eigenvalue(s) which failed because :
424  *                         1) This should never happen if the user specifies
425  *                         ABSTOL = 2 * PDLAMCH( 'U' )
426  *                         2) PDSTEIN will confirm / deny whether the eigenvalues are
427  *                         close enough.
428  
429                            IF( IINFO.NE.0 ) THEN
430                                INFO = INFO + IERREBZ
431                                DO 40 I = 1 , M
432                                    IWORK( INDIBL + I - 1 ) = ABS( IWORK( INDIBL + I - 1 ) )
433     40                         CONTINUE
434                            END IF
435                            IF( WANTZ ) THEN
436  
437                                IF( VALEIG ) THEN
438  
439  *                                 Compute the maximum number of eigenvalues that we can
440  *                                 compute in the
441  *                                 workspace that we have , and that we can store in Z.
442  
443  *                                 Loop through the possibilities looking for the largest
444  *                                 NZ that we can feed to PZSTEIN and PZUNMTR
445  
446  *                                 Since all processes must end up with the same value
447  *                                 of NZ , we first compute the minimum of LALLWORK
448  
449                                    CALL IGAMN2D( ICTXT , 'A' , ' ' , 1 , 1 , LALLWORK , 1 , 1 , 1 , - 1 ,
450       $                            - 1 , - 1 )
451  
452                                    MAXEIGS = DESCZ( N_ )
453  
454                                    DO 50 NZ = MIN( MAXEIGS , M ) , 0 , - 1
455                                        MQ0 = NUMROC( NZ , NB , 0 , 0 , NPCOL )
456                                        SIZESTEIN = ICEIL( NZ , NPROCS )*N + MAX( 5*N , NP0*MQ0 )
457                                        SIZEHEEVX = SIZESTEIN
458                                        IF( SIZEHEEVX.LE.LALLWORK )
459       $                                    GO TO 60
460     50                             CONTINUE
461     60 CONTINUE
462        ELSE
463            NZ = M
464        END IF
465        NZ = MAX( NZ , 0 )
466        IF( NZ.NE.M ) THEN
467            INFO = INFO + IERRSPC
468  
469            DO 70 I = 1 , M
470                IFAIL( I ) = 0
471     70     CONTINUE
472  
473  *         The following code handles a rare special case
474  *         - NZ .NE. M means that we don't have enough room to store
475  *         all the vectors.
476  *         - NSPLIT .GT. 1 means that the matrix split
477  *         In this case , we cannot simply take the first NZ eigenvalues
478  *         because PDSTEBZ sorts the eigenvalues by block when
479  *         a split occurs. So , we have to make another call to
480  *         PDSTEBZ with a new upper limit - VUU.
481  
482            IF( NSPLIT.GT.1 ) THEN
483                CALL DLASRT( 'I' , M , W , IINFO )
484                NZZ = 0
485                IF( NZ.GT.0 ) THEN
486  
487                    VUU = W( NZ ) - TEN*( EPS*ANRM + SAFMIN )
488                    IF( VLL.GE.VUU ) THEN
489                        NZZ = 0
490                    ELSE
491                        CALL PDSTEBZ ( ICTXT , RANGE , ORDER , N , VLL , VUU , IL ,
492       $                IU , ABSTLL , RWORK( INDD2 ) ,
493       $                RWORK( INDE2 + OFFSET ) , NZZ , NSPLIT ,
494       $                W , IWORK( INDIBL ) , IWORK( INDISP ) ,
495       $                RWORK( INDRWORK ) , LLRWORK ,
496       $                IWORK( 1 ) , ISIZESTEBZ , IINFO )
497                    END IF
498  
499                    IF( MOD( INFO / IERREBZ , 1 ).EQ.0 ) THEN
500                        IF( NZZ.GT.NZ .OR. IINFO.NE.0 ) THEN
501                            INFO = INFO + IERREBZ
502                        END IF
503                    END IF
504                END IF
505                NZ = MIN( NZ , NZZ )
506  
507            END IF
508        END IF
509        CALL PZSTEIN ( N , RWORK( INDD2 ) , RWORK( INDE2 + OFFSET ) , NZ , W ,
510       $IWORK( INDIBL ) , IWORK( INDISP ) , ORFAC , Z , IZ ,
511       $JZ , DESCZ , RWORK( INDRWORK ) , LALLWORK ,
512       $IWORK( 1 ) , ISIZESTEIN , IFAIL , ICLUSTR , GAP ,
513       $IINFO )
514  
515        IF( IINFO.GE.NZ + 1 )
516       $    INFO = INFO + IERRCLS
517            IF( MOD( IINFO , NZ + 1 ).NE.0 )
518       $        INFO = INFO + IERREIN
519  
520  *             Z = Q * Z
521  
522                IF( NZ.GT.0 ) THEN
523                    CALL PZUNMTR ( 'L' , UPLO , 'N' , N , NZ , A , IA , JA , DESCA ,
524       $            WORK( INDTAU ) , Z , IZ , JZ , DESCZ ,
525       $            WORK( INDWORK ) , LLWORK , IINFO )
526                END IF
527  
528            END IF
529  
530  *         If matrix was scaled , then rescale eigenvalues appropriately.
531  
532            IF( ISCALE.EQ.1 ) THEN
533                CALL DSCAL( M , ONE / SIGMA , W , 1 )
534            END IF
535  
536            WORK( 1 ) = DCMPLX( LWOPT )
537            RWORK( 1 ) = DBLE( LRWOPT )
538            IWORK( 1 ) = LIWMIN
539  
540            RETURN
541  
542  *         End of PZHEEVX
543  
544        END