--- rpl/lapack/lapack/zhegs2.f	2020/05/21 21:46:05	1.19
+++ rpl/lapack/lapack/zhegs2.f	2023/08/07 08:39:23	1.20
@@ -121,17 +121,14 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \date December 2016
-*
 *> \ingroup complex16HEcomputational
 *
 *  =====================================================================
       SUBROUTINE ZHEGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
 *
-*  -- LAPACK computational routine (version 3.7.0) --
+*  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     December 2016
 *
 *     .. Scalar Arguments ..
       CHARACTER          UPLO
@@ -197,8 +194,8 @@
 *
 *              Update the upper triangle of A(k:n,k:n)
 *
-               AKK = A( K, K )
-               BKK = B( K, K )
+               AKK = DBLE( A( K, K ) )
+               BKK = DBLE( B( K, K ) )
                AKK = AKK / BKK**2
                A( K, K ) = AKK
                IF( K.LT.N ) THEN
@@ -227,8 +224,8 @@
 *
 *              Update the lower triangle of A(k:n,k:n)
 *
-               AKK = A( K, K )
-               BKK = B( K, K )
+               AKK = DBLE( A( K, K ) )
+               BKK = DBLE( B( K, K ) )
                AKK = AKK / BKK**2
                A( K, K ) = AKK
                IF( K.LT.N ) THEN
@@ -252,8 +249,8 @@
 *
 *              Update the upper triangle of A(1:k,1:k)
 *
-               AKK = A( K, K )
-               BKK = B( K, K )
+               AKK = DBLE( A( K, K ) )
+               BKK = DBLE( B( K, K ) )
                CALL ZTRMV( UPLO, 'No transpose', 'Non-unit', K-1, B,
      $                     LDB, A( 1, K ), 1 )
                CT = HALF*AKK
@@ -272,8 +269,8 @@
 *
 *              Update the lower triangle of A(1:k,1:k)
 *
-               AKK = A( K, K )
-               BKK = B( K, K )
+               AKK = DBLE( A( K, K ) )
+               BKK = DBLE( B( K, K ) )
                CALL ZLACGV( K-1, A( K, 1 ), LDA )
                CALL ZTRMV( UPLO, 'Conjugate transpose', 'Non-unit', K-1,
      $                     B, LDB, A( K, 1 ), LDA )