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

Diff for /rpl/lapack/lapack/dsb2st_kernels.f between versions 1.2 and 1.5

version 1.2, 2017/06/17 11:06:32 version 1.5, 2020/05/21 21:46:01
Line 1 Line 1
 *> \brief \b DSB2ST_KERNELS  *> \brief \b DSB2ST_KERNELS
 *  *
 *  @generated from zhb2st_kernels.f, fortran z -> d, Wed Dec  7 08:22:39 2016  *  @generated from zhb2st_kernels.f, fortran z -> d, Wed Dec  7 08:22:39 2016
 *        *
 *  =========== 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 DSB2ST_KERNELS + dependencies   *> Download DSB2ST_KERNELS + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsb2st_kernels.f">   *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsb2st_kernels.f">
 *> [TGZ]</a>   *> [TGZ]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsb2st_kernels.f">   *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsb2st_kernels.f">
 *> [ZIP]</a>   *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsb2st_kernels.f">   *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsb2st_kernels.f">
 *> [TXT]</a>  *> [TXT]</a>
 *> \endhtmlonly   *> \endhtmlonly
 *  *
 *  Definition:  *  Definition:
 *  ===========  *  ===========
 *  *
 *       SUBROUTINE  DSB2ST_KERNELS( UPLO, WANTZ, TTYPE,   *       SUBROUTINE  DSB2ST_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 ..
 *       DOUBLE PRECISION   A( LDA, * ), V( * ),   *       DOUBLE PRECISION   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
 *>          DOUBLE PRECISION 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
 *>          DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION array, dimension 2*n if eigenvalues only are
   *>          requested or to be queried for vectors.
   *> \endverbatim
   *>
   *> \param[out] TAU
   *> \verbatim
   *>          TAU is DOUBLE PRECISION 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 DOUBLE PRECISION 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  DSB2ST_KERNELS( UPLO, WANTZ, TTYPE,         SUBROUTINE  DSB2ST_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 (version 3.7.1) --
 *  -- 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  *     June 2017
 *  *
 *     .. Scalar Arguments ..  *     .. Scalar Arguments ..
       CHARACTER          UPLO        CHARACTER          UPLO
Line 139 Line 181
       INTEGER            TTYPE, ST, ED, SWEEP, N, NB, IB, LDA, LDVT        INTEGER            TTYPE, ST, ED, SWEEP, N, NB, IB, LDA, LDVT
 *     ..  *     ..
 *     .. Array Arguments ..  *     .. Array Arguments ..
       DOUBLE PRECISION   A( LDA, * ), V( * ),         DOUBLE PRECISION   A( LDA, * ), V( * ),
      $                   TAU( * ), WORK( * )       $                   TAU( * ), WORK( * )
 *     ..  *     ..
 *  *
Line 153 Line 195
 *     .. 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
       DOUBLE PRECISION   CTMP         DOUBLE PRECISION   CTMP
 *     ..  *     ..
 *     .. External Subroutines ..  *     .. External Subroutines ..
       EXTERNAL           DLARFG, DLARFX, DLARFY        EXTERNAL           DLARFG, DLARFX, DLARFY
Line 167 Line 209
 *     ..  *     ..
 *     ..  *     ..
 *     .. Executable Statements ..  *     .. Executable Statements ..
 *        *
       AJETER = IB + LDVT        AJETER = IB + LDVT
       UPPER = LSAME( UPLO, 'U' )        UPPER = LSAME( UPLO, 'U' )
   
Line 198 Line 240
               V( VPOS ) = ONE                V( VPOS ) = ONE
               DO 10 I = 1, LM-1                DO 10 I = 1, LM-1
                   V( VPOS+I )         = ( A( OFDPOS-I, ST+I ) )                    V( VPOS+I )         = ( A( OFDPOS-I, ST+I ) )
                   A( OFDPOS-I, ST+I ) = ZERO                      A( OFDPOS-I, ST+I ) = ZERO
    10         CONTINUE     10         CONTINUE
               CTMP = ( A( OFDPOS, ST ) )                CTMP = ( A( OFDPOS, ST ) )
               CALL DLARFG( LM, CTMP, V( VPOS+1 ), 1,                 CALL DLARFG( LM, CTMP, V( VPOS+1 ), 1,
      $                                       TAU( TAUPOS ) )       $                                       TAU( TAUPOS ) )
               A( OFDPOS, ST ) = CTMP                A( OFDPOS, ST ) = CTMP
 *  *
Line 239 Line 281
 *  *
                   V( VPOS ) = ONE                    V( VPOS ) = ONE
                   DO 30 I = 1, LM-1                    DO 30 I = 1, LM-1
                       V( VPOS+I )          =                         V( VPOS+I )          =
      $                                    ( A( DPOS-NB-I, J1+I ) )       $                                    ( 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 = ( A( DPOS-NB, J1 ) )                    CTMP = ( A( DPOS-NB, J1 ) )
                   CALL DLARFG( LM, CTMP, V( VPOS+1 ), 1, TAU( TAUPOS ) )                    CALL DLARFG( LM, CTMP, V( VPOS+1 ), 1, TAU( TAUPOS ) )
                   A( DPOS-NB, J1 ) = CTMP                    A( DPOS-NB, J1 ) = CTMP
 *                   *
                   CALL DLARFX( 'Right', LN-1, LM, V( VPOS ),                    CALL DLARFX( '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 296
           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 313
               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 DLARFG( LM, A( OFDPOS, ST-1 ), V( VPOS+1 ), 1,                 CALL DLARFG( LM, A( OFDPOS, ST-1 ), V( VPOS+1 ), 1,
      $                                       TAU( TAUPOS ) )       $                                       TAU( TAUPOS ) )
 *  *
               LM = ED - ST + 1                LM = ED - ST + 1
Line 300 Line 342
               LM = J2-J1+1                LM = J2-J1+1
 *  *
               IF( LM.GT.0) THEN                IF( LM.GT.0) THEN
                   CALL DLARFX( 'Right', LM, LN, V( VPOS ),                     CALL DLARFX( '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 359
                       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 DLARFG( LM, A( DPOS+NB, ST ), V( VPOS+1 ), 1,                     CALL DLARFG( LM, A( DPOS+NB, ST ), V( VPOS+1 ), 1,
      $                                        TAU( TAUPOS ) )       $                                        TAU( TAUPOS ) )
 *  *
                   CALL DLARFX( 'Left', LM, LN-1, V( VPOS ),                     CALL DLARFX( 'Left', LM, LN-1, V( VPOS ),
      $                         ( TAU( TAUPOS ) ),       $                         ( 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
Line 332 Line 374
 *  *
 *     END OF DSB2ST_KERNELS  *     END OF DSB2ST_KERNELS
 *  *
       END              END
Removed from v.1.2  
changed lines
  Added in v.1.5

CVSweb interface <joel.bertrand@systella.fr>