pclasizeheevx.f

Go to the documentation of this file.

*
*
      SUBROUTINE pclasizeheevx( WKNOWN, RANGE, N, DESCA, VL, VU, IL, IU,
     $                          ISEED, WIN, MAXSIZE, VECSIZE, VALSIZE )
*
*
*  -- ScaLAPACK routine (version 1.7) --
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
*     and University of California, Berkeley.
*     May 1, 1997
*
*     .. Scalar Arguments ..
      LOGICAL            WKNOWN
      CHARACTER          RANGE
      INTEGER            IL, IU, MAXSIZE, N, VALSIZE, VECSIZE
      REAL               VL, VU
*     ..
*     .. Array Arguments ..
      INTEGER            DESCA( * ), ISEED( 4 )
      REAL               WIN( * )
*     ..
*
*  Purpose
*  =======
*
*  PCLASIZEHEEVX computes the amount of memory needed by PCHEEVX
*  to ensure:
*    1)  Orthogonal Eigenvectors
*    2)  Eigenvectors
*    3)  Eigenvalues
*
*  Arguments
*  =========
*
*  WKNOWN  (global input) INTEGER
*          .FALSE.:  WIN does not contain the eigenvalues
*          .TRUE.:   WIN does contain the eigenvalues
*
*  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.
*
*  N       (global input) INTEGER
*          Size of the matrix to be tested.  (global size)
*
*  DESCA   (global input) INTEGER array dimension ( DLEN_ )
*
*  VL      (global input/output ) REAL
*          If RANGE='V', the lower bound of the interval to be searched
*          for eigenvalues.  Not referenced if RANGE = 'A' or 'I'.
*          If VL > VU, RANGE='V' and WKNOWN = .TRUE., VL is set
*          to a random value near an entry in WIN
*
*  VU      (global input/output ) REAL
*          If RANGE='V', the upper bound of the interval to be searched
*          for eigenvalues.  Not referenced if RANGE = 'A' or 'I'.
*          If VL > VU, RANGE='V' and WKNOWN = .TRUE., VU is set
*          to a random value near an entry in WIN
*
*  IL      (global input/output ) 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'.
*          If IL < 0, RANGE='I' and WKNOWN = .TRUE., IL is set
*          to a random value from 1 to N
*
*  IU      (global input/output ) 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'.
*          If IU < 0, RANGE='I' and WKNOWN = .TRUE., IU is set
*          to a random value from IL to N
*
*  ISEED   (global input/output) INTEGER array, dimension (4)
*          On entry, the seed of the random number generator; the array
*          elements must be between 0 and 4095, and ISEED(4) must be
*          odd.
*          On exit, the seed is updated.
*          ISEED is not touched unless IL, IU, VL or VU are modified.
*
*  WIN     (global input) REAL array, dimension (N)
*          If WKNOWN=1, WIN contains the eigenvalues of the matrix.
*
*  MAXSIZE (global output) INTEGER
*          Workspace required to guarantee that PCHEEVX will return
*          orthogonal eigenvectors.  IF WKNOWN=0, MAXSIZE is set to a
*          a value which guarantees orthogonality no matter what the
*          spectrum is.  If WKNOWN=1, MAXSIZE is set to a value which
*          guarantees orthogonality on a matrix with eigenvalues given
*          by WIN.
*
*  VECSIZE (global output) INTEGER
*          Workspace required to guarantee that PCHEEVX
*          will compute eigenvectors.
*
*  VALSIZE (global output) INTEGER
*          Workspace required to guarantee that PCHEEVX
*          will compute eigenvalues.
*
*
*     .. Parameters ..
      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               TWENTY
      parameter( twenty = 20.0e0 )
*     ..
*     .. Local Scalars ..
*
      INTEGER            CLUSTERSIZE, I, ILMIN, IUMAX, MAXCLUSTERSIZE,
     $                   mq0, mycol, myil, myiu, myrow, nb, neig, nn,
     $                   np0, npcol, nprow
      REAL               ANORM, EPS, ORFAC, SAFMIN, VLMIN, VUMAX
*     ..
*     .. External Functions ..
*
*
      LOGICAL            LSAME
      INTEGER            ICEIL, NUMROC
      REAL               PSLAMCH, SLARAN
      EXTERNAL           lsame, iceil, numroc, pslamch, slaran
*     ..
*     .. External Subroutines ..
      EXTERNAL           blacs_gridinfo
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          abs, int, max, real
*     ..
*     .. Executable Statements ..
*       This is just to keep ftnchek happy
      IF( block_cyclic_2d*csrc_*ctxt_*dlen_*dtype_*lld_*mb_*m_*nb_*n_*
     $    rsrc_.LT.0 )RETURN
*
      orfac = 1.0e-3
*
*
      CALL blacs_gridinfo( desca( ctxt_ ), nprow, npcol, myrow, mycol )
      eps = pslamch( desca( ctxt_ ), 'Precision' )
      safmin = pslamch( desca( ctxt_ ), 'Safe Minimum' )
      nb = desca( mb_ )
      nn = max( n, nb, 2 )
      np0 = numroc( nn, nb, 0, 0, nprow )
*
      valsize = 5*nn + 4*n
*
      IF( wknown ) THEN
         anorm = safmin / eps
         IF( n.GE.1 )
     $      anorm = max( abs( win( 1 ) ), abs( win( n ) ), anorm )
*
         IF( lsame( range, 'I' ) ) THEN
            IF( il.LT.0 )
     $         il = int( slaran( iseed )*real( n ) ) + 1
            IF( iu.LT.0 )
     $         iu = int( slaran( iseed )*real( n-il ) ) + il
            IF( n.EQ.0 )
     $         iu = 0
         ELSE IF( lsame( range, 'V' ) ) THEN
            IF( vl.GT.vu ) THEN
               myil = int( slaran( iseed )*real( n ) ) + 1
               myiu = int( slaran( iseed )*real( n-myil ) ) + myil
               vl = win( myil ) + twenty*eps*abs( win( myil ) )
               vu = win( myiu ) + twenty*eps*abs( win( myiu ) )
               vu = max( vu, vl+eps*twenty*abs( vl )+safmin )
            END IF
         END IF
*
      END IF
      IF( lsame( range, 'V' ) ) THEN
*
*     Compute ILMIN, IUMAX (based on VL, VU and WIN)
*
         IF( wknown ) THEN
            vlmin = vl - twenty*eps*anorm
            vumax = vu + twenty*eps*anorm
            ilmin = 1
            iumax = 0
            DO 10 i = 1, n
               IF( win( i ).LT.vlmin )
     $            ilmin = ilmin + 1
               IF( win( i ).LT.vumax )
     $            iumax = iumax + 1
   10       CONTINUE
         ELSE
            ilmin = 1
            iumax = n
         END IF
      ELSE IF( lsame( range, 'I' ) ) THEN
         ilmin = il
         iumax = iu
      ELSE IF( lsame( range, 'A' ) ) THEN
         ilmin = 1
         iumax = n
      END IF
*
      neig = iumax - ilmin + 1
*
      mq0 = numroc( max( neig, nb, 2 ), nb, 0, 0, npcol )
      vecsize = 4*n + max( 5*nn, np0*mq0 ) +
     $          iceil( neig, nprow*npcol )*nn
*
      IF( wknown ) THEN
         clustersize = 1
         maxclustersize = 1
         DO 20 i = ilmin + 1, iumax
            IF( ( win( i )-win( i-1 ) ).LT.orfac*2*anorm ) THEN
               clustersize = clustersize + 1
               IF( clustersize.GT.maxclustersize )
     $            maxclustersize = clustersize
            ELSE
               clustersize = 1
            END IF
   20    CONTINUE
         IF( clustersize.GT.maxclustersize )
     $      maxclustersize = clustersize
      ELSE
         maxclustersize = n
      END IF
*
      maxsize = vecsize + max( ( maxclustersize-1 ), 0 )*n
*
*
      RETURN
*
*     End of PCLASIZEHEEVX
*
      END