pzlasizesep.f

Go to the documentation of this file.

      SUBROUTINE pzlasizesep( DESCA, IPREPAD, IPOSTPAD, SIZEMQRLEFT,
     $                        SIZEMQRRIGHT, SIZEQRF, SIZETMS, RSIZEQTQ,
     $                        RSIZECHK, SIZEHEEVX, RSIZEHEEVX,
     $                        ISIZEHEEVX, SIZEHEEVD, RSIZEHEEVD,
     $                        ISIZEHEEVD, SIZESUBTST, RSIZESUBTST,
     $                        ISIZESUBTST, SIZETST, RSIZETST, ISIZETST )
*
*  -- ScaLAPACK routine (version 1.7) --
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
*     and University of California, Berkeley.
*     May 1, 1997
*
*     .. Scalar Arguments ..
      INTEGER            IPOSTPAD, IPREPAD, ISIZEHEEVD, ISIZEHEEVX,
     $                   ISIZESUBTST, ISIZETST, RSIZECHK, RSIZEHEEVD,
     $                   RSIZEHEEVX, RSIZEQTQ, RSIZESUBTST, RSIZETST,
     $                   SIZEHEEVD, SIZEHEEVX, SIZEMQRLEFT,
     $                   SIZEMQRRIGHT, SIZEQRF, SIZESUBTST, SIZETMS,
     $                   sizetst
*     ..
*     .. Array Arguments ..
      INTEGER            DESCA( * )
*     ..
*
*  Purpose
*  =======
*
*  PZLASIZESEP computes the amount of memory needed by
*    various SEP test routines, as well as HEEVX itself
*
*  Arguments
*  =========
*
*  DESCA        (global input) INTEGER array dimension ( DLEN_ )
*               Array descriptor as passed to PZHEEVX
*
*  SIZEMQRLEFT  LWORK for the 1st PZUNMQR call in PZLAGHE
*
*  SIZEMQRRIGHT LWORK for the 2nd PZUNMQR call in PZLAGHE
*
*  SIZEQRF      LWORK for PZGEQRF in PZLAGHE
*
*  SIZETMS      LWORK for PZLATMS
*
*  RSIZEQTQ      LWORK for PZSEPQTQ (nexer complex)
*
*  RSIZECHK      LWORK for PZSEPCHK
*
*  SIZEHEEVX    LWORK for PZHEEVX
*
*  RSIZEHEEVX   LRWORK for PZHEEVX
*
*  ISIZEHEEVX   LIWORK for PZHEEVX
*
*  SIZEHEEVD    LWORK for PCHEEVD
*
*  RSIZEHEEVD   LRWORK for PCHEEVD
*
*  ISIZEHEEVD   LIWORK for PCHEEVD
*
*  SIZESUBTST   LWORK for PZSUBTST
*
*  RSIZESUBTST  LRWORK for PZSUBTST
*
*  ISIZESUBTST  LIWORK for PZSUBTST
*
*  SIZETST      LWORK for PZTST
*
*  RSIZETST     LRWORK for PZTST
*
*  ISIZETST     LIWORK for PZTST
*
*     .. 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 )
*     ..
*     .. Local Scalars ..
      INTEGER            ANB, CSRC_A, IACOL, IAROW, ICOFFA, ICTXT,
     $                   IROFFA, LCM, LCMQ, LDA, MQ0, MYCOL, MYROW, N,
     $                   NB, NEIG, NHETRD_LWOPT, NN, NNP, NP, NP0,
     $                   NPCOL, NPROW, NPS, NQ, RSRC_A, SIZECHK,
     $                   SIZEQTQ, SQNPC
*     ..
*     .. External Functions ..
      INTEGER            ICEIL, ILCM, INDXG2P, NUMROC, PJLAENV
      EXTERNAL           ICEIL, ILCM, INDXG2P, NUMROC, PJLAENV
*     ..
**     .. Executable Statements ..
*       This is just to keep ftnchek happy
*     .. External Subroutines ..
      EXTERNAL           blacs_gridinfo
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          dble, int, max, sqrt
*     ..
*     .. Executable Statements ..
      IF( block_cyclic_2d*csrc_*ctxt_*dlen_*dtype_*lld_*mb_*m_*nb_*n_*
     $    rsrc_.LT.0 )RETURN
*
      n = desca( m_ )
      nb = desca( mb_ )
      rsrc_a = desca( rsrc_ )
      csrc_a = desca( csrc_ )
*
      lda = desca( lld_ )
      CALL blacs_gridinfo( desca( ctxt_ ), nprow, npcol, myrow, mycol )
*
      lcm = ilcm( nprow, npcol )
      lcmq = lcm / npcol
      iroffa = 0
      icoffa = 0
      iarow = indxg2p( 1, nb, myrow, rsrc_a, nprow )
      iacol = indxg2p( 1, nb, mycol, csrc_a, npcol )
      np = numroc( n+iroffa, nb, myrow, iarow, nprow )
      nq = numroc( n+icoffa, nb, mycol, iacol, npcol )
      sizemqrleft = max( ( nb*( nb-1 ) ) / 2, ( np+nq )*nb ) + nb*nb
      sizemqrright = max( ( nb*( nb-1 ) ) / 2,
     $               ( nq+max( np+numroc( numroc( n+icoffa, nb, 0, 0,
     $               npcol ), nb, 0, 0, lcmq ), np ) )*nb ) + nb*nb
      sizeqrf = nb*np + nb*nq + nb*nb
      sizetms = ( lda+1 )*max( 1, nq ) +
     $          max( sizemqrleft, sizemqrright, sizeqrf )
*
      np0 = numroc( n, desca( mb_ ), 0, 0, nprow )
      mq0 = numroc( n, desca( nb_ ), 0, 0, npcol )
      sizeqtq = 0
      sizechk = 0
      rsizeqtq = 2 + max( desca( mb_ ), 2 )*( 2*np0+mq0 )
      rsizechk = numroc( n, desca( nb_ ), mycol, 0, npcol )
*
      neig = n
      nn = max( n, nb, 2 )
      np0 = numroc( nn, nb, 0, 0, nprow )
      mq0 = numroc( max( neig, nb, 2 ), nb, 0, 0, npcol )
      sizeheevx = n + ( np0+mq0+nb )*nb
      rsizeheevx = 4*n + max( 5*nn, np0*mq0 ) +
     $             iceil( neig, nprow*npcol )*nn
      nnp = max( n, nprow*npcol+1, 4 )
      isizeheevx = 6*nnp
*
      ictxt = desca( ctxt_ )
      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+2 )*nps
*
      sizeheevx = max( sizeheevx, n+nhetrd_lwopt )
*
      sizeheevd = sizeheevx
      rsizeheevd = 7*n + 3*np0*mq0
      isizeheevd = 7*n + 8*npcol + 2
      sizesubtst = max( sizetms, sizeqtq, sizechk, sizeheevx,
     $             sizeheevd ) + iprepad + ipostpad
      rsizesubtst = max( rsizeheevx, rsizeheevd, rsizeqtq, rsizechk ) +
     $              iprepad + ipostpad
      isizesubtst = max( isizeheevx, isizeheevd ) + iprepad + ipostpad
*
*
*     Allow room for A, COPYA and Z and WORK
*
      sizetst = 3*( lda*np+iprepad+ipostpad ) + sizesubtst
*
*     Room for DIAG, WIN, WNEW, GAP and RWORK
*
      rsizetst = 4*( n+iprepad+ipostpad ) + rsizesubtst
*
*     Allow room for IFAIL, ICLUSTR, and IWORK (all in PZHEEVX)
*
      isizetst = n + 2*nprow*npcol + 2*( iprepad+ipostpad ) +
     $           isizesubtst
*
      RETURN
      END