File:  [local] / rpl / lapack / lapack / dsytrd_2stage.f
Revision 1.5: download - view: text, annotated - select for diffs - revision graph
Thu May 21 21:46:02 2020 UTC (3 years, 11 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_33, rpl-4_1_32, HEAD
Mise à jour de Lapack.

    1: *> \brief \b DSYTRD_2STAGE
    2: *
    3: *  @generated from zhetrd_2stage.f, fortran z -> d, Sun Nov  6 19:34:06 2016
    4: *
    5: *  =========== DOCUMENTATION ===========
    6: *
    7: * Online html documentation available at 
    8: *            http://www.netlib.org/lapack/explore-html/ 
    9: *
   10: *> \htmlonly
   11: *> Download DSYTRD_2STAGE + dependencies 
   12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsytrd_2stage.f"> 
   13: *> [TGZ]</a> 
   14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsytrd_2stage.f"> 
   15: *> [ZIP]</a> 
   16: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsytrd_2stage.f"> 
   17: *> [TXT]</a>
   18: *> \endhtmlonly 
   19: *
   20: *  Definition:
   21: *  ===========
   22: *
   23: *       SUBROUTINE DSYTRD_2STAGE( VECT, UPLO, N, A, LDA, D, E, TAU, 
   24: *                                 HOUS2, LHOUS2, WORK, LWORK, INFO )
   25: *
   26: *       IMPLICIT NONE
   27: *
   28: *      .. Scalar Arguments ..
   29: *       CHARACTER          VECT, UPLO
   30: *       INTEGER            N, LDA, LWORK, LHOUS2, INFO
   31: *      ..
   32: *      .. Array Arguments ..
   33: *       DOUBLE PRECISION   D( * ), E( * )
   34: *       DOUBLE PRECISION   A( LDA, * ), TAU( * ),
   35: *                          HOUS2( * ), WORK( * )
   36: *       ..
   37: *  
   38: *
   39: *> \par Purpose:
   40: *  =============
   41: *>
   42: *> \verbatim
   43: *>
   44: *> DSYTRD_2STAGE reduces a real symmetric matrix A to real symmetric
   45: *> tridiagonal form T by a orthogonal similarity transformation:
   46: *> Q1**T Q2**T* A * Q2 * Q1 = T.
   47: *> \endverbatim
   48: *
   49: *  Arguments:
   50: *  ==========
   51: *
   52: *> \param[in] VECT
   53: *> \verbatim
   54: *>          VECT is CHARACTER*1
   55: *>          = 'N':  No need for the Housholder representation, 
   56: *>                  in particular for the second stage (Band to
   57: *>                  tridiagonal) and thus LHOUS2 is of size max(1, 4*N);
   58: *>          = 'V':  the Householder representation is needed to 
   59: *>                  either generate Q1 Q2 or to apply Q1 Q2, 
   60: *>                  then LHOUS2 is to be queried and computed.
   61: *>                  (NOT AVAILABLE IN THIS RELEASE).
   62: *> \endverbatim
   63: *>
   64: *> \param[in] UPLO
   65: *> \verbatim
   66: *>          UPLO is CHARACTER*1
   67: *>          = 'U':  Upper triangle of A is stored;
   68: *>          = 'L':  Lower triangle of A is stored.
   69: *> \endverbatim
   70: *>
   71: *> \param[in] N
   72: *> \verbatim
   73: *>          N is INTEGER
   74: *>          The order of the matrix A.  N >= 0.
   75: *> \endverbatim
   76: *>
   77: *> \param[in,out] A
   78: *> \verbatim
   79: *>          A is DOUBLE PRECISION array, dimension (LDA,N)
   80: *>          On entry, the symmetric matrix A.  If UPLO = 'U', the leading
   81: *>          N-by-N upper triangular part of A contains the upper
   82: *>          triangular part of the matrix A, and the strictly lower
   83: *>          triangular part of A is not referenced.  If UPLO = 'L', the
   84: *>          leading N-by-N lower triangular part of A contains the lower
   85: *>          triangular part of the matrix A, and the strictly upper
   86: *>          triangular part of A is not referenced.
   87: *>          On exit, if UPLO = 'U', the band superdiagonal
   88: *>          of A are overwritten by the corresponding elements of the
   89: *>          internal band-diagonal matrix AB, and the elements above 
   90: *>          the KD superdiagonal, with the array TAU, represent the orthogonal
   91: *>          matrix Q1 as a product of elementary reflectors; if UPLO
   92: *>          = 'L', the diagonal and band subdiagonal of A are over-
   93: *>          written by the corresponding elements of the internal band-diagonal
   94: *>          matrix AB, and the elements below the KD subdiagonal, with
   95: *>          the array TAU, represent the orthogonal matrix Q1 as a product
   96: *>          of elementary reflectors. See Further Details.
   97: *> \endverbatim
   98: *>
   99: *> \param[in] LDA
  100: *> \verbatim
  101: *>          LDA is INTEGER
  102: *>          The leading dimension of the array A.  LDA >= max(1,N).
  103: *> \endverbatim
  104: *>
  105: *> \param[out] D
  106: *> \verbatim
  107: *>          D is DOUBLE PRECISION array, dimension (N)
  108: *>          The diagonal elements of the tridiagonal matrix T.
  109: *> \endverbatim
  110: *>
  111: *> \param[out] E
  112: *> \verbatim
  113: *>          E is DOUBLE PRECISION array, dimension (N-1)
  114: *>          The off-diagonal elements of the tridiagonal matrix T.
  115: *> \endverbatim
  116: *>
  117: *> \param[out] TAU
  118: *> \verbatim
  119: *>          TAU is DOUBLE PRECISION array, dimension (N-KD)
  120: *>          The scalar factors of the elementary reflectors of 
  121: *>          the first stage (see Further Details).
  122: *> \endverbatim
  123: *>
  124: *> \param[out] HOUS2
  125: *> \verbatim
  126: *>          HOUS2 is DOUBLE PRECISION array, dimension (LHOUS2)
  127: *>          Stores the Householder representation of the stage2
  128: *>          band to tridiagonal.
  129: *> \endverbatim
  130: *>
  131: *> \param[in] LHOUS2
  132: *> \verbatim
  133: *>          LHOUS2 is INTEGER
  134: *>          The dimension of the array HOUS2.
  135: *>          If LWORK = -1, or LHOUS2 = -1,
  136: *>          then a query is assumed; the routine
  137: *>          only calculates the optimal size of the HOUS2 array, returns
  138: *>          this value as the first entry of the HOUS2 array, and no error
  139: *>          message related to LHOUS2 is issued by XERBLA.
  140: *>          If VECT='N', LHOUS2 = max(1, 4*n);
  141: *>          if VECT='V', option not yet available.
  142: *> \endverbatim
  143: *>
  144: *> \param[out] WORK
  145: *> \verbatim
  146: *>          WORK is DOUBLE PRECISION array, dimension (LWORK)
  147: *> \endverbatim
  148: *>
  149: *> \param[in] LWORK
  150: *> \verbatim
  151: *>          LWORK is INTEGER
  152: *>          The dimension of the array WORK. LWORK = MAX(1, dimension)
  153: *>          If LWORK = -1, or LHOUS2=-1,
  154: *>          then a workspace query is assumed; the routine
  155: *>          only calculates the optimal size of the WORK array, returns
  156: *>          this value as the first entry of the WORK array, and no error
  157: *>          message related to LWORK is issued by XERBLA.
  158: *>          LWORK = MAX(1, dimension) where
  159: *>          dimension   = max(stage1,stage2) + (KD+1)*N
  160: *>                      = N*KD + N*max(KD+1,FACTOPTNB) 
  161: *>                        + max(2*KD*KD, KD*NTHREADS) 
  162: *>                        + (KD+1)*N 
  163: *>          where KD is the blocking size of the reduction,
  164: *>          FACTOPTNB is the blocking used by the QR or LQ
  165: *>          algorithm, usually FACTOPTNB=128 is a good choice
  166: *>          NTHREADS is the number of threads used when
  167: *>          openMP compilation is enabled, otherwise =1.
  168: *> \endverbatim
  169: *>
  170: *> \param[out] INFO
  171: *> \verbatim
  172: *>          INFO is INTEGER
  173: *>          = 0:  successful exit
  174: *>          < 0:  if INFO = -i, the i-th argument had an illegal value
  175: *> \endverbatim
  176: *
  177: *  Authors:
  178: *  ========
  179: *
  180: *> \author Univ. of Tennessee 
  181: *> \author Univ. of California Berkeley 
  182: *> \author Univ. of Colorado Denver 
  183: *> \author NAG Ltd. 
  184: *
  185: *> \date November 2017
  186: *
  187: *> \ingroup doubleSYcomputational
  188: *
  189: *> \par Further Details:
  190: *  =====================
  191: *>
  192: *> \verbatim
  193: *>
  194: *>  Implemented by Azzam Haidar.
  195: *>
  196: *>  All details are available on technical report, SC11, SC13 papers.
  197: *>
  198: *>  Azzam Haidar, Hatem Ltaief, and Jack Dongarra.
  199: *>  Parallel reduction to condensed forms for symmetric eigenvalue problems
  200: *>  using aggregated fine-grained and memory-aware kernels. In Proceedings
  201: *>  of 2011 International Conference for High Performance Computing,
  202: *>  Networking, Storage and Analysis (SC '11), New York, NY, USA,
  203: *>  Article 8 , 11 pages.
  204: *>  http://doi.acm.org/10.1145/2063384.2063394
  205: *>
  206: *>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
  207: *>  An improved parallel singular value algorithm and its implementation 
  208: *>  for multicore hardware, In Proceedings of 2013 International Conference
  209: *>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
  210: *>  Denver, Colorado, USA, 2013.
  211: *>  Article 90, 12 pages.
  212: *>  http://doi.acm.org/10.1145/2503210.2503292
  213: *>
  214: *>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
  215: *>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure 
  216: *>  calculations based on fine-grained memory aware tasks.
  217: *>  International Journal of High Performance Computing Applications.
  218: *>  Volume 28 Issue 2, Pages 196-209, May 2014.
  219: *>  http://hpc.sagepub.com/content/28/2/196 
  220: *>
  221: *> \endverbatim
  222: *>
  223: *  =====================================================================
  224:       SUBROUTINE DSYTRD_2STAGE( VECT, UPLO, N, A, LDA, D, E, TAU, 
  225:      $                          HOUS2, LHOUS2, WORK, LWORK, INFO )
  226: *
  227:       IMPLICIT NONE
  228: *
  229: *  -- LAPACK computational routine (version 3.8.0) --
  230: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  231: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  232: *     November 2017
  233: *
  234: *     .. Scalar Arguments ..
  235:       CHARACTER          VECT, UPLO
  236:       INTEGER            N, LDA, LWORK, LHOUS2, INFO
  237: *     ..
  238: *     .. Array Arguments ..
  239:       DOUBLE PRECISION   D( * ), E( * )
  240:       DOUBLE PRECISION   A( LDA, * ), TAU( * ),
  241:      $                   HOUS2( * ), WORK( * )
  242: *     ..
  243: *
  244: *  =====================================================================
  245: *     ..
  246: *     .. Local Scalars ..
  247:       LOGICAL            LQUERY, UPPER, WANTQ
  248:       INTEGER            KD, IB, LWMIN, LHMIN, LWRK, LDAB, WPOS, ABPOS
  249: *     ..
  250: *     .. External Subroutines ..
  251:       EXTERNAL           XERBLA, DSYTRD_SY2SB, DSYTRD_SB2ST
  252: *     ..
  253: *     .. External Functions ..
  254:       LOGICAL            LSAME
  255:       INTEGER            ILAENV2STAGE
  256:       EXTERNAL           LSAME, ILAENV2STAGE
  257: *     ..
  258: *     .. Executable Statements ..
  259: *
  260: *     Test the input parameters
  261: *
  262:       INFO   = 0
  263:       WANTQ  = LSAME( VECT, 'V' )
  264:       UPPER  = LSAME( UPLO, 'U' )
  265:       LQUERY = ( LWORK.EQ.-1 ) .OR. ( LHOUS2.EQ.-1 )
  266: *
  267: *     Determine the block size, the workspace size and the hous size.
  268: *
  269:       KD     = ILAENV2STAGE( 1, 'DSYTRD_2STAGE', VECT, N, -1, -1, -1 )
  270:       IB     = ILAENV2STAGE( 2, 'DSYTRD_2STAGE', VECT, N, KD, -1, -1 )
  271:       LHMIN  = ILAENV2STAGE( 3, 'DSYTRD_2STAGE', VECT, N, KD, IB, -1 )
  272:       LWMIN  = ILAENV2STAGE( 4, 'DSYTRD_2STAGE', VECT, N, KD, IB, -1 )
  273: *      WRITE(*,*),'DSYTRD_2STAGE N KD UPLO LHMIN LWMIN ',N, KD, UPLO,
  274: *     $            LHMIN, LWMIN
  275: *
  276:       IF( .NOT.LSAME( VECT, 'N' ) ) THEN
  277:          INFO = -1
  278:       ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
  279:          INFO = -2
  280:       ELSE IF( N.LT.0 ) THEN
  281:          INFO = -3
  282:       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
  283:          INFO = -5
  284:       ELSE IF( LHOUS2.LT.LHMIN .AND. .NOT.LQUERY ) THEN
  285:          INFO = -10
  286:       ELSE IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
  287:          INFO = -12
  288:       END IF
  289: *
  290:       IF( INFO.EQ.0 ) THEN
  291:          HOUS2( 1 ) = LHMIN
  292:          WORK( 1 )  = LWMIN
  293:       END IF
  294: *
  295:       IF( INFO.NE.0 ) THEN
  296:          CALL XERBLA( 'DSYTRD_2STAGE', -INFO )
  297:          RETURN
  298:       ELSE IF( LQUERY ) THEN
  299:          RETURN
  300:       END IF
  301: *
  302: *     Quick return if possible
  303: *
  304:       IF( N.EQ.0 ) THEN
  305:          WORK( 1 ) = 1
  306:          RETURN
  307:       END IF
  308: *
  309: *     Determine pointer position
  310: *
  311:       LDAB  = KD+1
  312:       LWRK  = LWORK-LDAB*N
  313:       ABPOS = 1
  314:       WPOS  = ABPOS + LDAB*N
  315:       CALL DSYTRD_SY2SB( UPLO, N, KD, A, LDA, WORK( ABPOS ), LDAB, 
  316:      $                   TAU, WORK( WPOS ), LWRK, INFO )
  317:       IF( INFO.NE.0 ) THEN
  318:          CALL XERBLA( 'DSYTRD_SY2SB', -INFO )
  319:          RETURN
  320:       END IF
  321:       CALL DSYTRD_SB2ST( 'Y', VECT, UPLO, N, KD, 
  322:      $                   WORK( ABPOS ), LDAB, D, E, 
  323:      $                   HOUS2, LHOUS2, WORK( WPOS ), LWRK, INFO )
  324:       IF( INFO.NE.0 ) THEN
  325:          CALL XERBLA( 'DSYTRD_SB2ST', -INFO )
  326:          RETURN
  327:       END IF
  328: *
  329: *
  330:       HOUS2( 1 ) = LHMIN
  331:       WORK( 1 )  = LWMIN
  332:       RETURN
  333: *
  334: *     End of DSYTRD_2STAGE
  335: *
  336:       END

CVSweb interface <joel.bertrand@systella.fr>