[BACK]Return to zhb2st_kernels.f CVS log [TXT] [DIR] Up to [local] / rpl / lapack / lapack

Diff for /rpl/lapack/lapack/zhb2st_kernels.f between versions 1.2 and 1.6

version 1.2, 2017/06/17 11:06:46 version 1.6, 2023/08/07 08:39:22
Line 1 Line 1
 *> \brief \b ZHB2ST_KERNELS  *> \brief \b ZHB2ST_KERNELS
 *  *
 *  @precisions fortran z -> s d c  *  @precisions fortran z -> s d c
 *        *
 *  =========== DOCUMENTATION ===========  *  =========== DOCUMENTATION ===========
 *  *
 * Online html documentation available at   * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/   *            http://www.netlib.org/lapack/explore-html/
 *  *
 *> \htmlonly  *> \htmlonly
 *> Download ZHB2ST_KERNELS + dependencies   *> Download ZHB2ST_KERNELS + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhb2st_kernels.f">   *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhb2st_kernels.f">
 *> [TGZ]</a>   *> [TGZ]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhb2st_kernels.f">   *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhb2st_kernels.f">
 *> [ZIP]</a>   *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhb2st_kernels.f">   *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhb2st_kernels.f">
 *> [TXT]</a>  *> [TXT]</a>
 *> \endhtmlonly   *> \endhtmlonly
 *  *
 *  Definition:  *  Definition:
 *  ===========  *  ===========
 *  *
 *       SUBROUTINE  ZHB2ST_KERNELS( UPLO, WANTZ, TTYPE,   *       SUBROUTINE  ZHB2ST_KERNELS( UPLO, WANTZ, TTYPE,
 *                                   ST, ED, SWEEP, N, NB, IB,  *                                   ST, ED, SWEEP, N, NB, IB,
 *                                   A, LDA, V, TAU, LDVT, WORK)  *                                   A, LDA, V, TAU, LDVT, WORK)
 *  *
Line 32 Line 32
 *       INTEGER            TTYPE, ST, ED, SWEEP, N, NB, IB, LDA, LDVT  *       INTEGER            TTYPE, ST, ED, SWEEP, N, NB, IB, LDA, LDVT
 *       ..  *       ..
 *       .. Array Arguments ..  *       .. Array Arguments ..
 *       COMPLEX*16         A( LDA, * ), V( * ),   *       COMPLEX*16         A( LDA, * ), V( * ),
 *                          TAU( * ), WORK( * )  *                          TAU( * ), WORK( * )
 *    *
 *> \par Purpose:  *> \par Purpose:
 *  =============  *  =============
 *>  *>
Line 47 Line 47
 *  Arguments:  *  Arguments:
 *  ==========  *  ==========
 *  *
 *> @param[in] n  *> \param[in] UPLO
 *>          The order of the matrix A.  *> \verbatim
 *>  *>          UPLO is CHARACTER*1
 *> @param[in] nb  *> \endverbatim
 *>          The size of the band.  
 *>  
 *> @param[in, out] A  
 *>          A pointer to the matrix A.  
 *>  
 *> @param[in] lda  
 *>          The leading dimension of the matrix A.  
 *>  *>
 *> @param[out] V  *> \param[in] WANTZ
 *>          COMPLEX*16 array, dimension 2*n if eigenvalues only are  *> \verbatim
 *>          requested or to be queried for vectors.  *>          WANTZ is LOGICAL which indicate if Eigenvalue are requested or both
   *>          Eigenvalue/Eigenvectors.
   *> \endverbatim
 *>  *>
 *> @param[out] TAU  *> \param[in] TTYPE
 *>          COMPLEX*16 array, dimension (2*n).  *> \verbatim
 *>          The scalar factors of the Householder reflectors are stored  *>          TTYPE is INTEGER
 *>          in this array.  *> \endverbatim
 *>  *>
 *> @param[in] st  *> \param[in] ST
   *> \verbatim
   *>          ST is INTEGER
 *>          internal parameter for indices.  *>          internal parameter for indices.
   *> \endverbatim
 *>  *>
 *> @param[in] ed  *> \param[in] ED
   *> \verbatim
   *>          ED is INTEGER
 *>          internal parameter for indices.  *>          internal parameter for indices.
   *> \endverbatim
 *>  *>
 *> @param[in] sweep  *> \param[in] SWEEP
   *> \verbatim
   *>          SWEEP is INTEGER
 *>          internal parameter for indices.  *>          internal parameter for indices.
   *> \endverbatim
 *>  *>
 *> @param[in] Vblksiz  *> \param[in] N
 *>          internal parameter for indices.  *> \verbatim
   *>          N is INTEGER. The order of the matrix A.
   *> \endverbatim
 *>  *>
 *> @param[in] wantz  *> \param[in] NB
 *>          logical which indicate if Eigenvalue are requested or both  *> \verbatim
 *>          Eigenvalue/Eigenvectors.  *>          NB is INTEGER. The size of the band.
   *> \endverbatim
 *>  *>
 *> @param[in] work  *> \param[in] IB
 *>          Workspace of size nb.  *> \verbatim
   *>          IB is INTEGER.
   *> \endverbatim
   *>
   *> \param[in, out] A
   *> \verbatim
   *>          A is COMPLEX*16 array. A pointer to the matrix A.
   *> \endverbatim
   *>
   *> \param[in] LDA
   *> \verbatim
   *>          LDA is INTEGER. The leading dimension of the matrix A.
   *> \endverbatim
   *>
   *> \param[out] V
   *> \verbatim
   *>          V is COMPLEX*16 array, dimension 2*n if eigenvalues only are
   *>          requested or to be queried for vectors.
   *> \endverbatim
   *>
   *> \param[out] TAU
   *> \verbatim
   *>          TAU is COMPLEX*16 array, dimension (2*n).
   *>          The scalar factors of the Householder reflectors are stored
   *>          in this array.
   *> \endverbatim
   *>
   *> \param[in] LDVT
   *> \verbatim
   *>          LDVT is INTEGER.
   *> \endverbatim
   *>
   *> \param[out] WORK
   *> \verbatim
   *>          WORK is COMPLEX*16 array. Workspace of size nb.
   *> \endverbatim
 *>  *>
 *> \par Further Details:  *> \par Further Details:
 *  =====================  *  =====================
Line 105 Line 147
 *>  http://doi.acm.org/10.1145/2063384.2063394  *>  http://doi.acm.org/10.1145/2063384.2063394
 *>  *>
 *>  A. Haidar, J. Kurzak, P. Luszczek, 2013.  *>  A. Haidar, J. Kurzak, P. Luszczek, 2013.
 *>  An improved parallel singular value algorithm and its implementation   *>  An improved parallel singular value algorithm and its implementation
 *>  for multicore hardware, In Proceedings of 2013 International Conference  *>  for multicore hardware, In Proceedings of 2013 International Conference
 *>  for High Performance Computing, Networking, Storage and Analysis (SC '13).  *>  for High Performance Computing, Networking, Storage and Analysis (SC '13).
 *>  Denver, Colorado, USA, 2013.  *>  Denver, Colorado, USA, 2013.
Line 113 Line 155
 *>  http://doi.acm.org/10.1145/2503210.2503292  *>  http://doi.acm.org/10.1145/2503210.2503292
 *>  *>
 *>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.  *>  A. Haidar, R. Solca, S. Tomov, T. Schulthess and J. Dongarra.
 *>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure   *>  A novel hybrid CPU-GPU generalized eigensolver for electronic structure
 *>  calculations based on fine-grained memory aware tasks.  *>  calculations based on fine-grained memory aware tasks.
 *>  International Journal of High Performance Computing Applications.  *>  International Journal of High Performance Computing Applications.
 *>  Volume 28 Issue 2, Pages 196-209, May 2014.  *>  Volume 28 Issue 2, Pages 196-209, May 2014.
 *>  http://hpc.sagepub.com/content/28/2/196   *>  http://hpc.sagepub.com/content/28/2/196
 *>  *>
 *> \endverbatim  *> \endverbatim
 *>  *>
 *  =====================================================================  *  =====================================================================
       SUBROUTINE  ZHB2ST_KERNELS( UPLO, WANTZ, TTYPE,         SUBROUTINE  ZHB2ST_KERNELS( UPLO, WANTZ, TTYPE,
      $                            ST, ED, SWEEP, N, NB, IB,       $                            ST, ED, SWEEP, N, NB, IB,
      $                            A, LDA, V, TAU, LDVT, WORK)       $                            A, LDA, V, TAU, LDVT, WORK)
 *  *
       IMPLICIT NONE        IMPLICIT NONE
 *  *
 *  -- LAPACK computational routine (version 3.7.0) --  *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --  *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--  *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 *     December 2016  
 *  *
 *     .. Scalar Arguments ..  *     .. Scalar Arguments ..
       CHARACTER          UPLO        CHARACTER          UPLO
Line 139 Line 180
       INTEGER            TTYPE, ST, ED, SWEEP, N, NB, IB, LDA, LDVT        INTEGER            TTYPE, ST, ED, SWEEP, N, NB, IB, LDA, LDVT
 *     ..  *     ..
 *     .. Array Arguments ..  *     .. Array Arguments ..
       COMPLEX*16         A( LDA, * ), V( * ),         COMPLEX*16         A( LDA, * ), V( * ),
      $                   TAU( * ), WORK( * )       $                   TAU( * ), WORK( * )
 *     ..  *     ..
 *  *
Line 153 Line 194
 *     .. Local Scalars ..  *     .. Local Scalars ..
       LOGICAL            UPPER        LOGICAL            UPPER
       INTEGER            I, J1, J2, LM, LN, VPOS, TAUPOS,        INTEGER            I, J1, J2, LM, LN, VPOS, TAUPOS,
      $                   DPOS, OFDPOS, AJETER        $                   DPOS, OFDPOS, AJETER
       COMPLEX*16         CTMP         COMPLEX*16         CTMP
 *     ..  *     ..
 *     .. External Subroutines ..  *     .. External Subroutines ..
       EXTERNAL           ZLARFG, ZLARFX, ZLARFY        EXTERNAL           ZLARFG, ZLARFX, ZLARFY
Line 167 Line 208
 *     ..  *     ..
 *     ..  *     ..
 *     .. Executable Statements ..  *     .. Executable Statements ..
 *        *
       AJETER = IB + LDVT        AJETER = IB + LDVT
       UPPER = LSAME( UPLO, 'U' )        UPPER = LSAME( UPLO, 'U' )
   
Line 198 Line 239
               V( VPOS ) = ONE                V( VPOS ) = ONE
               DO 10 I = 1, LM-1                DO 10 I = 1, LM-1
                   V( VPOS+I )         = DCONJG( A( OFDPOS-I, ST+I ) )                    V( VPOS+I )         = DCONJG( A( OFDPOS-I, ST+I ) )
                   A( OFDPOS-I, ST+I ) = ZERO                      A( OFDPOS-I, ST+I ) = ZERO
    10         CONTINUE     10         CONTINUE
               CTMP = DCONJG( A( OFDPOS, ST ) )                CTMP = DCONJG( A( OFDPOS, ST ) )
               CALL ZLARFG( LM, CTMP, V( VPOS+1 ), 1,                 CALL ZLARFG( LM, CTMP, V( VPOS+1 ), 1,
      $                                       TAU( TAUPOS ) )       $                                       TAU( TAUPOS ) )
               A( OFDPOS, ST ) = CTMP                A( OFDPOS, ST ) = CTMP
 *  *
Line 239 Line 280
 *  *
                   V( VPOS ) = ONE                    V( VPOS ) = ONE
                   DO 30 I = 1, LM-1                    DO 30 I = 1, LM-1
                       V( VPOS+I )          =                         V( VPOS+I )          =
      $                                    DCONJG( A( DPOS-NB-I, J1+I ) )       $                                    DCONJG( A( DPOS-NB-I, J1+I ) )
                       A( DPOS-NB-I, J1+I ) = ZERO                        A( DPOS-NB-I, J1+I ) = ZERO
    30             CONTINUE     30             CONTINUE
                   CTMP = DCONJG( A( DPOS-NB, J1 ) )                    CTMP = DCONJG( A( DPOS-NB, J1 ) )
                   CALL ZLARFG( LM, CTMP, V( VPOS+1 ), 1, TAU( TAUPOS ) )                    CALL ZLARFG( LM, CTMP, V( VPOS+1 ), 1, TAU( TAUPOS ) )
                   A( DPOS-NB, J1 ) = CTMP                    A( DPOS-NB, J1 ) = CTMP
 *                   *
                   CALL ZLARFX( 'Right', LN-1, LM, V( VPOS ),                    CALL ZLARFX( 'Right', LN-1, LM, V( VPOS ),
      $                         TAU( TAUPOS ),       $                         TAU( TAUPOS ),
      $                         A( DPOS-NB+1, J1 ), LDA-1, WORK)       $                         A( DPOS-NB+1, J1 ), LDA-1, WORK)
Line 254 Line 295
           ENDIF            ENDIF
 *  *
 *     Lower case  *     Lower case
 *    *
       ELSE        ELSE
 *        *
           IF( WANTZ ) THEN            IF( WANTZ ) THEN
               VPOS   = MOD( SWEEP-1, 2 ) * N + ST                VPOS   = MOD( SWEEP-1, 2 ) * N + ST
               TAUPOS = MOD( SWEEP-1, 2 ) * N + ST                TAUPOS = MOD( SWEEP-1, 2 ) * N + ST
Line 271 Line 312
               V( VPOS ) = ONE                V( VPOS ) = ONE
               DO 20 I = 1, LM-1                DO 20 I = 1, LM-1
                   V( VPOS+I )         = A( OFDPOS+I, ST-1 )                    V( VPOS+I )         = A( OFDPOS+I, ST-1 )
                   A( OFDPOS+I, ST-1 ) = ZERO                      A( OFDPOS+I, ST-1 ) = ZERO
    20         CONTINUE     20         CONTINUE
               CALL ZLARFG( LM, A( OFDPOS, ST-1 ), V( VPOS+1 ), 1,                 CALL ZLARFG( LM, A( OFDPOS, ST-1 ), V( VPOS+1 ), 1,
      $                                       TAU( TAUPOS ) )       $                                       TAU( TAUPOS ) )
 *  *
               LM = ED - ST + 1                LM = ED - ST + 1
Line 300 Line 341
               LM = J2-J1+1                LM = J2-J1+1
 *  *
               IF( LM.GT.0) THEN                IF( LM.GT.0) THEN
                   CALL ZLARFX( 'Right', LM, LN, V( VPOS ),                     CALL ZLARFX( 'Right', LM, LN, V( VPOS ),
      $                         TAU( TAUPOS ), A( DPOS+NB, ST ),       $                         TAU( TAUPOS ), A( DPOS+NB, ST ),
      $                         LDA-1, WORK)       $                         LDA-1, WORK)
 *  *
Line 317 Line 358
                       V( VPOS+I )        = A( DPOS+NB+I, ST )                        V( VPOS+I )        = A( DPOS+NB+I, ST )
                       A( DPOS+NB+I, ST ) = ZERO                        A( DPOS+NB+I, ST ) = ZERO
    40             CONTINUE     40             CONTINUE
                   CALL ZLARFG( LM, A( DPOS+NB, ST ), V( VPOS+1 ), 1,                     CALL ZLARFG( LM, A( DPOS+NB, ST ), V( VPOS+1 ), 1,
      $                                        TAU( TAUPOS ) )       $                                        TAU( TAUPOS ) )
 *  *
                   CALL ZLARFX( 'Left', LM, LN-1, V( VPOS ),                     CALL ZLARFX( 'Left', LM, LN-1, V( VPOS ),
      $                         DCONJG( TAU( TAUPOS ) ),       $                         DCONJG( TAU( TAUPOS ) ),
      $                         A( DPOS+NB-1, ST+1 ), LDA-1, WORK)       $                         A( DPOS+NB-1, ST+1 ), LDA-1, WORK)
                
               ENDIF                ENDIF
           ENDIF            ENDIF
       ENDIF        ENDIF
 *  *
       RETURN        RETURN
 *  *
 *     END OF ZHB2ST_KERNELS  *     End of ZHB2ST_KERNELS
 *  *
       END              END
Removed from v.1.2  
changed lines
  Added in v.1.6

CVSweb interface <joel.bertrand@systella.fr>