[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.4 and 1.6

version 1.4, 2018/05/29 07:18:05 version 1.6, 2023/08/07 08:39:05
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 124 Line 124
 *>          LDVT is INTEGER.  *>          LDVT is INTEGER.
 *> \endverbatim  *> \endverbatim
 *>  *>
 *> \param[in] WORK  *> \param[out] WORK
 *> \verbatim  *> \verbatim
 *>          WORK is DOUBLE PRECISION array. Workspace of size nb.  *>          WORK is DOUBLE PRECISION array. Workspace of size nb.
 *> \endverbatim  *> \endverbatim
Line 147 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 155 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.1) --  *  -- 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..--
 *     June 2017  
 *  *
 *     .. Scalar Arguments ..  *     .. Scalar Arguments ..
       CHARACTER          UPLO        CHARACTER          UPLO
Line 181 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 ..
       DOUBLE PRECISION   A( LDA, * ), V( * ),         DOUBLE PRECISION   A( LDA, * ), V( * ),
      $                   TAU( * ), WORK( * )       $                   TAU( * ), WORK( * )
 *     ..  *     ..
 *  *
Line 195 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
       DOUBLE PRECISION   CTMP         DOUBLE PRECISION   CTMP
 *     ..  *     ..
 *     .. External Subroutines ..  *     .. External Subroutines ..
       EXTERNAL           DLARFG, DLARFX, DLARFY        EXTERNAL           DLARFG, DLARFX, DLARFY
Line 209 Line 208
 *     ..  *     ..
 *     ..  *     ..
 *     .. Executable Statements ..  *     .. Executable Statements ..
 *        *
       AJETER = IB + LDVT        AJETER = IB + LDVT
       UPPER = LSAME( UPLO, 'U' )        UPPER = LSAME( UPLO, 'U' )
   
Line 240 Line 239
               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 281 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 )          =
      $                                    ( 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 296 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 313 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 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 342 Line 341
               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 359 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 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
 *  *
       RETURN        RETURN
 *  *
 *     END OF DSB2ST_KERNELS  *     End of DSB2ST_KERNELS
 *  *
       END              END
Removed from v.1.4  
changed lines
  Added in v.1.6

CVSweb interface <joel.bertrand@systella.fr>