From 8a10f2d6092179bccc0060f03a614130aba46ce0 Mon Sep 17 00:00:00 2001
From: sh-zheng <2294474733@qq.com>
Date: Wed, 9 Apr 2025 19:51:24 +0800
Subject: [PATCH] Call *rot to perform eigenvector update of *steqr

---
 LAPACKE/src/lapacke_dsteqr.c | 17 +--------------
 LAPACKE/src/lapacke_dstev.c  | 15 +-------------
 LAPACKE/src/lapacke_ssteqr.c | 17 +--------------
 LAPACKE/src/lapacke_sstev.c  | 15 +-------------
 SRC/dsteqr.f                 | 40 +++++++-----------------------------
 SRC/dstev.f                  |  4 ++--
 SRC/ssteqr.f                 | 40 +++++++-----------------------------
 SRC/sstev.f                  |  4 ++--
 8 files changed, 22 insertions(+), 130 deletions(-)

diff --git a/LAPACKE/src/lapacke_dsteqr.c b/LAPACKE/src/lapacke_dsteqr.c
index e0b4abf921..bd4eb5fef0 100644
--- a/LAPACKE/src/lapacke_dsteqr.c
+++ b/LAPACKE/src/lapacke_dsteqr.c
@@ -59,23 +59,8 @@ lapack_int API_SUFFIX(LAPACKE_dsteqr)( int matrix_layout, char compz, lapack_int
         }
     }
 #endif
-    /* Additional scalars initializations for work arrays */
-    if( API_SUFFIX(LAPACKE_lsame)( compz, 'n' ) ) {
-        lwork = 1;
-    } else {
-        lwork = MAX(1,2*n-2);
-    }
-    /* Allocate memory for working array(s) */
-    work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
-    if( work == NULL ) {
-        info = LAPACK_WORK_MEMORY_ERROR;
-        goto exit_level_0;
-    }
     /* Call middle-level interface */
-    info = API_SUFFIX(LAPACKE_dsteqr_work)( matrix_layout, compz, n, d, e, z, ldz, work );
-    /* Release memory and exit */
-    LAPACKE_free( work );
-exit_level_0:
+    info = API_SUFFIX(LAPACKE_dsteqr_work)( matrix_layout, compz, n, d, e, z, ldz, NULL );
     if( info == LAPACK_WORK_MEMORY_ERROR ) {
         API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dsteqr", info );
     }
diff --git a/LAPACKE/src/lapacke_dstev.c b/LAPACKE/src/lapacke_dstev.c
index d1af4cf8ca..3763bff884 100644
--- a/LAPACKE/src/lapacke_dstev.c
+++ b/LAPACKE/src/lapacke_dstev.c
@@ -52,21 +52,8 @@ lapack_int API_SUFFIX(LAPACKE_dstev)( int matrix_layout, char jobz, lapack_int n
         }
     }
 #endif
-    /* Allocate memory for working array(s) */
-    if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) {
-        work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,2*n-2) );
-        if( work == NULL ) {
-            info = LAPACK_WORK_MEMORY_ERROR;
-            goto exit_level_0;
-        }
-    }
     /* Call middle-level interface */
-    info = API_SUFFIX(LAPACKE_dstev_work)( matrix_layout, jobz, n, d, e, z, ldz, work );
-    /* Release memory and exit */
-    if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) {
-        LAPACKE_free( work );
-    }
-exit_level_0:
+    info = API_SUFFIX(LAPACKE_dstev_work)( matrix_layout, jobz, n, d, e, z, ldz, NULL );
     if( info == LAPACK_WORK_MEMORY_ERROR ) {
         API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dstev", info );
     }
diff --git a/LAPACKE/src/lapacke_ssteqr.c b/LAPACKE/src/lapacke_ssteqr.c
index caba20e8f7..48681e9fe8 100644
--- a/LAPACKE/src/lapacke_ssteqr.c
+++ b/LAPACKE/src/lapacke_ssteqr.c
@@ -59,23 +59,8 @@ lapack_int API_SUFFIX(LAPACKE_ssteqr)( int matrix_layout, char compz, lapack_int
         }
     }
 #endif
-    /* Additional scalars initializations for work arrays */
-    if( API_SUFFIX(LAPACKE_lsame)( compz, 'n' ) ) {
-        lwork = 1;
-    } else {
-        lwork = MAX(1,2*n-2);
-    }
-    /* Allocate memory for working array(s) */
-    work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
-    if( work == NULL ) {
-        info = LAPACK_WORK_MEMORY_ERROR;
-        goto exit_level_0;
-    }
     /* Call middle-level interface */
-    info = API_SUFFIX(LAPACKE_ssteqr_work)( matrix_layout, compz, n, d, e, z, ldz, work );
-    /* Release memory and exit */
-    LAPACKE_free( work );
-exit_level_0:
+    info = API_SUFFIX(LAPACKE_ssteqr_work)( matrix_layout, compz, n, d, e, z, ldz, NULL );
     if( info == LAPACK_WORK_MEMORY_ERROR ) {
         API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ssteqr", info );
     }
diff --git a/LAPACKE/src/lapacke_sstev.c b/LAPACKE/src/lapacke_sstev.c
index 12138ad7ea..30502c7656 100644
--- a/LAPACKE/src/lapacke_sstev.c
+++ b/LAPACKE/src/lapacke_sstev.c
@@ -52,21 +52,8 @@ lapack_int API_SUFFIX(LAPACKE_sstev)( int matrix_layout, char jobz, lapack_int n
         }
     }
 #endif
-    /* Allocate memory for working array(s) */
-    if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) {
-        work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,2*n-2) );
-        if( work == NULL ) {
-            info = LAPACK_WORK_MEMORY_ERROR;
-            goto exit_level_0;
-        }
-    }
     /* Call middle-level interface */
-    info = API_SUFFIX(LAPACKE_sstev_work)( matrix_layout, jobz, n, d, e, z, ldz, work );
-    /* Release memory and exit */
-    if( API_SUFFIX(LAPACKE_lsame)( jobz, 'v' ) ) {
-        LAPACKE_free( work );
-    }
-exit_level_0:
+    info = API_SUFFIX(LAPACKE_sstev_work)( matrix_layout, jobz, n, d, e, z, ldz, NULL );
     if( info == LAPACK_WORK_MEMORY_ERROR ) {
         API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sstev", info );
     }
diff --git a/SRC/dsteqr.f b/SRC/dsteqr.f
index b2931f9887..c93f456b8e 100644
--- a/SRC/dsteqr.f
+++ b/SRC/dsteqr.f
@@ -97,8 +97,8 @@
 *>
 *> \param[out] WORK
 *> \verbatim
-*>          WORK is DOUBLE PRECISION array, dimension (max(1,2*N-2))
-*>          If COMPZ = 'N', then WORK is not referenced.
+*>          WORK is DOUBLE PRECISION array.
+*>          WORK is not referenced.
 *> \endverbatim
 *>
 *> \param[out] INFO
@@ -162,7 +162,7 @@ SUBROUTINE DSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           DLAE2, DLAEV2, DLARTG, DLASCL, DLASET,
-     $                   DLASR,
+     $                   DROT,
      $                   DLASRT, DSWAP, XERBLA
 *     ..
 *     .. Intrinsic Functions ..
@@ -321,10 +321,7 @@ SUBROUTINE DSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
             IF( ICOMPZ.GT.0 ) THEN
                CALL DLAEV2( D( L ), E( L ), D( L+1 ), RT1, RT2, C,
      $                      S )
-               WORK( L ) = C
-               WORK( N-1+L ) = S
-               CALL DLASR( 'R', 'V', 'B', N, 2, WORK( L ),
-     $                     WORK( N-1+L ), Z( 1, L ), LDZ )
+               CALL DROT(N, Z( 1, L ), 1, Z( 1, L+1 ), 1, C, S)
             ELSE
                CALL DLAE2( D( L ), E( L ), D( L+1 ), RT1, RT2 )
             END IF
@@ -369,20 +366,10 @@ SUBROUTINE DSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
 *           If eigenvectors are desired, then save rotations.
 *
             IF( ICOMPZ.GT.0 ) THEN
-               WORK( I ) = C
-               WORK( N-1+I ) = -S
+               CALL DROT(N, Z( 1, I ), 1, Z( 1, I+1 ), 1, C, -S)
             END IF
 *
    70    CONTINUE
-*
-*        If eigenvectors are desired, then apply saved rotations.
-*
-         IF( ICOMPZ.GT.0 ) THEN
-            MM = M - L + 1
-            CALL DLASR( 'R', 'V', 'B', N, MM, WORK( L ),
-     $                  WORK( N-1+L ),
-     $                  Z( 1, L ), LDZ )
-         END IF
 *
          D( L ) = D( L ) - P
          E( L ) = G
@@ -430,10 +417,7 @@ SUBROUTINE DSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
             IF( ICOMPZ.GT.0 ) THEN
                CALL DLAEV2( D( L-1 ), E( L-1 ), D( L ), RT1, RT2, C,
      $                      S )
-               WORK( M ) = C
-               WORK( N-1+M ) = S
-               CALL DLASR( 'R', 'V', 'F', N, 2, WORK( M ),
-     $                     WORK( N-1+M ), Z( 1, L-1 ), LDZ )
+               CALL DROT(N, Z( 1, L-1 ), 1, Z( 1, L ), 1, C, S)
             ELSE
                CALL DLAE2( D( L-1 ), E( L-1 ), D( L ), RT1, RT2 )
             END IF
@@ -478,20 +462,10 @@ SUBROUTINE DSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
 *           If eigenvectors are desired, then save rotations.
 *
             IF( ICOMPZ.GT.0 ) THEN
-               WORK( I ) = C
-               WORK( N-1+I ) = S
+               CALL DROT(N, Z( 1, I ), 1, Z( 1, I+1 ), 1, C, S)
             END IF
 *
   120    CONTINUE
-*
-*        If eigenvectors are desired, then apply saved rotations.
-*
-         IF( ICOMPZ.GT.0 ) THEN
-            MM = L - M + 1
-            CALL DLASR( 'R', 'V', 'F', N, MM, WORK( M ),
-     $                  WORK( N-1+M ),
-     $                  Z( 1, M ), LDZ )
-         END IF
 *
          D( L ) = D( L ) - P
          E( LM1 ) = G
diff --git a/SRC/dstev.f b/SRC/dstev.f
index 7ccd23e165..5463508103 100644
--- a/SRC/dstev.f
+++ b/SRC/dstev.f
@@ -86,8 +86,8 @@
 *>
 *> \param[out] WORK
 *> \verbatim
-*>          WORK is DOUBLE PRECISION array, dimension (max(1,2*N-2))
-*>          If JOBZ = 'N', WORK is not referenced.
+*>          WORK is DOUBLE PRECISION array
+*>          WORK is not referenced.
 *> \endverbatim
 *>
 *> \param[out] INFO
diff --git a/SRC/ssteqr.f b/SRC/ssteqr.f
index 16d5e1b1f5..d67302ae25 100644
--- a/SRC/ssteqr.f
+++ b/SRC/ssteqr.f
@@ -97,8 +97,8 @@
 *>
 *> \param[out] WORK
 *> \verbatim
-*>          WORK is REAL array, dimension (max(1,2*N-2))
-*>          If COMPZ = 'N', then WORK is not referenced.
+*>          WORK is REAL array.
+*>          WORK is not referenced.
 *> \endverbatim
 *>
 *> \param[out] INFO
@@ -162,7 +162,7 @@ SUBROUTINE SSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
 *     ..
 *     .. External Subroutines ..
       EXTERNAL           SLAE2, SLAEV2, SLARTG, SLASCL, SLASET,
-     $                   SLASR,
+     $                   SROT,
      $                   SLASRT, SSWAP, XERBLA
 *     ..
 *     .. Intrinsic Functions ..
@@ -321,10 +321,7 @@ SUBROUTINE SSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
             IF( ICOMPZ.GT.0 ) THEN
                CALL SLAEV2( D( L ), E( L ), D( L+1 ), RT1, RT2, C,
      $                      S )
-               WORK( L ) = C
-               WORK( N-1+L ) = S
-               CALL SLASR( 'R', 'V', 'B', N, 2, WORK( L ),
-     $                     WORK( N-1+L ), Z( 1, L ), LDZ )
+               CALL SROT(N, Z( 1, L ), 1, Z( 1, L+1 ), 1, C, S)
             ELSE
                CALL SLAE2( D( L ), E( L ), D( L+1 ), RT1, RT2 )
             END IF
@@ -369,20 +366,10 @@ SUBROUTINE SSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
 *           If eigenvectors are desired, then save rotations.
 *
             IF( ICOMPZ.GT.0 ) THEN
-               WORK( I ) = C
-               WORK( N-1+I ) = -S
+               CALL SROT(N, Z( 1, I ), 1, Z( 1, I+1 ), 1, C, -S)
             END IF
 *
    70    CONTINUE
-*
-*        If eigenvectors are desired, then apply saved rotations.
-*
-         IF( ICOMPZ.GT.0 ) THEN
-            MM = M - L + 1
-            CALL SLASR( 'R', 'V', 'B', N, MM, WORK( L ),
-     $                  WORK( N-1+L ),
-     $                  Z( 1, L ), LDZ )
-         END IF
 *
          D( L ) = D( L ) - P
          E( L ) = G
@@ -430,10 +417,7 @@ SUBROUTINE SSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
             IF( ICOMPZ.GT.0 ) THEN
                CALL SLAEV2( D( L-1 ), E( L-1 ), D( L ), RT1, RT2, C,
      $                      S )
-               WORK( M ) = C
-               WORK( N-1+M ) = S
-               CALL SLASR( 'R', 'V', 'F', N, 2, WORK( M ),
-     $                     WORK( N-1+M ), Z( 1, L-1 ), LDZ )
+               CALL SROT(N, Z( 1, L-1 ), 1, Z( 1, L ), 1, C, S)
             ELSE
                CALL SLAE2( D( L-1 ), E( L-1 ), D( L ), RT1, RT2 )
             END IF
@@ -478,20 +462,10 @@ SUBROUTINE SSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO )
 *           If eigenvectors are desired, then save rotations.
 *
             IF( ICOMPZ.GT.0 ) THEN
-               WORK( I ) = C
-               WORK( N-1+I ) = S
+               CALL SROT(N, Z( 1, I ), 1, Z( 1, I+1 ), 1, C, S)
             END IF
 *
   120    CONTINUE
-*
-*        If eigenvectors are desired, then apply saved rotations.
-*
-         IF( ICOMPZ.GT.0 ) THEN
-            MM = L - M + 1
-            CALL SLASR( 'R', 'V', 'F', N, MM, WORK( M ),
-     $                  WORK( N-1+M ),
-     $                  Z( 1, M ), LDZ )
-         END IF
 *
          D( L ) = D( L ) - P
          E( LM1 ) = G
diff --git a/SRC/sstev.f b/SRC/sstev.f
index e8b1a4f621..82c6b84083 100644
--- a/SRC/sstev.f
+++ b/SRC/sstev.f
@@ -86,8 +86,8 @@
 *>
 *> \param[out] WORK
 *> \verbatim
-*>          WORK is REAL array, dimension (max(1,2*N-2))
-*>          If JOBZ = 'N', WORK is not referenced.
+*>          WORK is REAL array.
+*>          WORK is not referenced.
 *> \endverbatim
 *>
 *> \param[out] INFO