--- rpl/lapack/lapack/zhetri2x.f	2011/11/21 22:19:48	1.3
+++ rpl/lapack/lapack/zhetri2x.f	2023/08/07 08:39:25	1.13
@@ -2,24 +2,24 @@
 *
 *  =========== DOCUMENTATION ===========
 *
-* Online html documentation available at 
-*            http://www.netlib.org/lapack/explore-html/ 
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
 *
 *> \htmlonly
-*> Download ZHETRI2X + dependencies 
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhetri2x.f"> 
-*> [TGZ]</a> 
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhetri2x.f"> 
-*> [ZIP]</a> 
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhetri2x.f"> 
+*> Download ZHETRI2X + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhetri2x.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhetri2x.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhetri2x.f">
 *> [TXT]</a>
-*> \endhtmlonly 
+*> \endhtmlonly
 *
 *  Definition:
 *  ===========
 *
 *       SUBROUTINE ZHETRI2X( UPLO, N, A, LDA, IPIV, WORK, NB, INFO )
-* 
+*
 *       .. Scalar Arguments ..
 *       CHARACTER          UPLO
 *       INTEGER            INFO, LDA, N, NB
@@ -28,7 +28,7 @@
 *       INTEGER            IPIV( * )
 *       COMPLEX*16            A( LDA, * ), WORK( N+NB+1,* )
 *       ..
-*  
+*
 *
 *> \par Purpose:
 *  =============
@@ -87,7 +87,7 @@
 *>
 *> \param[out] WORK
 *> \verbatim
-*>          WORK is COMPLEX*16 array, dimension (N+NNB+1,NNB+3)
+*>          WORK is COMPLEX*16 array, dimension (N+NB+1,NB+3)
 *> \endverbatim
 *>
 *> \param[in] NB
@@ -108,22 +108,19 @@
 *  Authors:
 *  ========
 *
-*> \author Univ. of Tennessee 
-*> \author Univ. of California Berkeley 
-*> \author Univ. of Colorado Denver 
-*> \author NAG Ltd. 
-*
-*> \date November 2011
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
 *
 *> \ingroup complex16HEcomputational
 *
 *  =====================================================================
       SUBROUTINE ZHETRI2X( UPLO, N, A, LDA, IPIV, WORK, NB, INFO )
 *
-*  -- LAPACK computational routine (version 3.4.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..--
-*     November 2011
 *
 *     .. Scalar Arguments ..
       CHARACTER          UPLO
@@ -137,7 +134,7 @@
 *  =====================================================================
 *
 *     .. Parameters ..
-      REAL               ONE
+      DOUBLE PRECISION   ONE
       COMPLEX*16            CONE, ZERO
       PARAMETER          ( ONE = 1.0D+0,
      $                   CONE = ( 1.0D+0, 0.0D+0 ),
@@ -215,7 +212,7 @@
       INFO = 0
 *
 *  Splitting Workspace
-*     U01 is a block (N,NB+1) 
+*     U01 is a block (N,NB+1)
 *     The first element of U01 is in WORK(1,1)
 *     U11 is a block (NB+1,NB+1)
 *     The first element of U11 is in WORK(N+1,1)
@@ -231,7 +228,7 @@
         CALL ZTRTRI( UPLO, 'U', N, A, LDA, INFO )
 *
 *       inv(D) and inv(D)*inv(U)
-* 
+*
         K=1
         DO WHILE ( K .LE. N )
          IF( IPIV( K ).GT.0 ) THEN
@@ -242,13 +239,13 @@
          ELSE
 *           2 x 2 diagonal NNB
              T = ABS ( WORK(K+1,1) )
-             AK = REAL ( A( K, K ) ) / T
-             AKP1 = REAL ( A( K+1, K+1 ) ) / T
+             AK = DBLE ( A( K, K ) ) / T
+             AKP1 = DBLE ( A( K+1, K+1 ) ) / T
              AKKP1 = WORK(K+1,1)  / T
              D = T*( AK*AKP1-ONE )
              WORK(K,INVD) = AKP1 / D
              WORK(K+1,INVD+1) = AK / D
-             WORK(K,INVD+1) = -AKKP1 / D  
+             WORK(K,INVD+1) = -AKKP1 / D
              WORK(K+1,INVD) = DCONJG (WORK(K,INVD+1) )
             K=K+2
          END IF
@@ -265,7 +262,7 @@
               NNB=CUT
            ELSE
               COUNT = 0
-*             count negative elements, 
+*             count negative elements,
               DO I=CUT+1-NNB,CUT
                   IF (IPIV(I) .LT. 0) COUNT=COUNT+1
               END DO
@@ -275,7 +272,7 @@
 
            CUT=CUT-NNB
 *
-*          U01 Block 
+*          U01 Block
 *
            DO I=1,CUT
              DO J=1,NNB
@@ -338,7 +335,7 @@
                 I=I+2
              END IF
            END DO
-*    
+*
 *       U11**H*invD1*U11->U11
 *
         CALL ZTRMM('L','U','C','U',NNB, NNB,
@@ -382,7 +379,7 @@
        END DO
 *
 *        Apply PERMUTATIONS P and P**H: P * inv(U**H)*inv(D)*inv(U) *P**H
-*  
+*
             I=1
             DO WHILE ( I .LE. N )
                IF( IPIV(I) .GT. 0 ) THEN
@@ -392,9 +389,9 @@
                ELSE
                  IP=-IPIV(I)
                  I=I+1
-                 IF ( (I-1) .LT. IP) 
+                 IF ( (I-1) .LT. IP)
      $                  CALL ZHESWAPR( UPLO, N, A, LDA, I-1 ,IP )
-                 IF ( (I-1) .GT. IP) 
+                 IF ( (I-1) .GT. IP)
      $                  CALL ZHESWAPR( UPLO, N, A, LDA, IP ,I-1 )
               ENDIF
                I=I+1
@@ -408,7 +405,7 @@
          CALL ZTRTRI( UPLO, 'U', N, A, LDA, INFO )
 *
 *       inv(D) and inv(D)*inv(U)
-* 
+*
         K=N
         DO WHILE ( K .GE. 1 )
          IF( IPIV( K ).GT.0 ) THEN
@@ -419,13 +416,13 @@
          ELSE
 *           2 x 2 diagonal NNB
              T = ABS ( WORK(K-1,1) )
-             AK = REAL ( A( K-1, K-1 ) ) / T
-             AKP1 = REAL ( A( K, K ) ) / T
+             AK = DBLE ( A( K-1, K-1 ) ) / T
+             AKP1 = DBLE ( A( K, K ) ) / T
              AKKP1 = WORK(K-1,1) / T
              D = T*( AK*AKP1-ONE )
              WORK(K-1,INVD) = AKP1 / D
              WORK(K,INVD) = AK / D
-             WORK(K,INVD+1) = -AKKP1 / D  
+             WORK(K,INVD+1) = -AKKP1 / D
              WORK(K-1,INVD+1) = DCONJG (WORK(K,INVD+1) )
             K=K-2
          END IF
@@ -442,7 +439,7 @@
               NNB=N-CUT
            ELSE
               COUNT = 0
-*             count negative elements, 
+*             count negative elements,
               DO I=CUT+1,CUT+NNB
                   IF (IPIV(I) .LT. 0) COUNT=COUNT+1
               END DO
@@ -509,7 +506,7 @@
                 I=I-2
              END IF
            END DO
-*    
+*
 *       L11**H*invD1*L11->L11
 *
         CALL ZTRMM('L',UPLO,'C','U',NNB, NNB,
@@ -527,7 +524,7 @@
 *
          CALL ZGEMM('C','N',NNB,NNB,N-NNB-CUT,CONE,A(CUT+NNB+1,CUT+1)
      $             ,LDA,WORK,N+NB+1, ZERO, WORK(U11+1,1), N+NB+1)
-       
+
 *
 *        L11 =  L11**H*invD1*L11 + U01**H*invD*U01
 *
@@ -565,7 +562,7 @@
        END DO
 *
 *        Apply PERMUTATIONS P and P**H: P * inv(U**H)*inv(D)*inv(U) *P**H
-* 
+*
             I=N
             DO WHILE ( I .GE. 1 )
                IF( IPIV(I) .GT. 0 ) THEN