Moving lapack to right place

1 files changed, 0 insertions, 501 deletions

diff --git a/src/lib/lapack/dlahqr.f b/src/lib/lapack/dlahqr.f
deleted file mode 100644
index 449a3770..00000000
--- a/src/lib/lapack/dlahqr.f
+++ /dev/null
@@ -1,501 +0,0 @@
-      SUBROUTINE DLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, WR, WI,
-     $                   ILOZ, IHIZ, Z, LDZ, INFO )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      INTEGER            IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, N
-      LOGICAL            WANTT, WANTZ
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   H( LDH, * ), WI( * ), WR( * ), Z( LDZ, * )
-*     ..
-*
-*     Purpose
-*     =======
-*
-*     DLAHQR is an auxiliary routine called by DHSEQR to update the
-*     eigenvalues and Schur decomposition already computed by DHSEQR, by
-*     dealing with the Hessenberg submatrix in rows and columns ILO to
-*     IHI.
-*
-*     Arguments
-*     =========
-*
-*     WANTT   (input) LOGICAL
-*          = .TRUE. : the full Schur form T is required;
-*          = .FALSE.: only eigenvalues are required.
-*
-*     WANTZ   (input) LOGICAL
-*          = .TRUE. : the matrix of Schur vectors Z is required;
-*          = .FALSE.: Schur vectors are not required.
-*
-*     N       (input) INTEGER
-*          The order of the matrix H.  N >= 0.
-*
-*     ILO     (input) INTEGER
-*     IHI     (input) INTEGER
-*          It is assumed that H is already upper quasi-triangular in
-*          rows and columns IHI+1:N, and that H(ILO,ILO-1) = 0 (unless
-*          ILO = 1). DLAHQR works primarily with the Hessenberg
-*          submatrix in rows and columns ILO to IHI, but applies
-*          transformations to all of H if WANTT is .TRUE..
-*          1 <= ILO <= max(1,IHI); IHI <= N.
-*
-*     H       (input/output) DOUBLE PRECISION array, dimension (LDH,N)
-*          On entry, the upper Hessenberg matrix H.
-*          On exit, if INFO is zero and if WANTT is .TRUE., H is upper
-*          quasi-triangular in rows and columns ILO:IHI, with any
-*          2-by-2 diagonal blocks in standard form. If INFO is zero
-*          and WANTT is .FALSE., the contents of H are unspecified on
-*          exit.  The output state of H if INFO is nonzero is given
-*          below under the description of INFO.
-*
-*     LDH     (input) INTEGER
-*          The leading dimension of the array H. LDH >= max(1,N).
-*
-*     WR      (output) DOUBLE PRECISION array, dimension (N)
-*     WI      (output) DOUBLE PRECISION array, dimension (N)
-*          The real and imaginary parts, respectively, of the computed
-*          eigenvalues ILO to IHI are stored in the corresponding
-*          elements of WR and WI. If two eigenvalues are computed as a
-*          complex conjugate pair, they are stored in consecutive
-*          elements of WR and WI, say the i-th and (i+1)th, with
-*          WI(i) > 0 and WI(i+1) < 0. If WANTT is .TRUE., the
-*          eigenvalues are stored in the same order as on the diagonal
-*          of the Schur form returned in H, with WR(i) = H(i,i), and, if
-*          H(i:i+1,i:i+1) is a 2-by-2 diagonal block,
-*          WI(i) = sqrt(H(i+1,i)*H(i,i+1)) and WI(i+1) = -WI(i).
-*
-*     ILOZ    (input) INTEGER
-*     IHIZ    (input) INTEGER
-*          Specify the rows of Z to which transformations must be
-*          applied if WANTZ is .TRUE..
-*          1 <= ILOZ <= ILO; IHI <= IHIZ <= N.
-*
-*     Z       (input/output) DOUBLE PRECISION array, dimension (LDZ,N)
-*          If WANTZ is .TRUE., on entry Z must contain the current
-*          matrix Z of transformations accumulated by DHSEQR, and on
-*          exit Z has been updated; transformations are applied only to
-*          the submatrix Z(ILOZ:IHIZ,ILO:IHI).
-*          If WANTZ is .FALSE., Z is not referenced.
-*
-*     LDZ     (input) INTEGER
-*          The leading dimension of the array Z. LDZ >= max(1,N).
-*
-*     INFO    (output) INTEGER
-*           =   0: successful exit
-*          .GT. 0: If INFO = i, DLAHQR failed to compute all the
-*                  eigenvalues ILO to IHI in a total of 30 iterations
-*                  per eigenvalue; elements i+1:ihi of WR and WI
-*                  contain those eigenvalues which have been
-*                  successfully computed.
-*
-*                  If INFO .GT. 0 and WANTT is .FALSE., then on exit,
-*                  the remaining unconverged eigenvalues are the
-*                  eigenvalues of the upper Hessenberg matrix rows
-*                  and columns ILO thorugh INFO of the final, output
-*                  value of H.
-*
-*                  If INFO .GT. 0 and WANTT is .TRUE., then on exit
-*          (*)       (initial value of H)*U  = U*(final value of H)
-*                  where U is an orthognal matrix.    The final
-*                  value of H is upper Hessenberg and triangular in
-*                  rows and columns INFO+1 through IHI.
-*
-*                  If INFO .GT. 0 and WANTZ is .TRUE., then on exit
-*                      (final value of Z)  = (initial value of Z)*U
-*                  where U is the orthogonal matrix in (*)
-*                  (regardless of the value of WANTT.)
-*
-*     Further Details
-*     ===============
-*
-*     02-96 Based on modifications by
-*     David Day, Sandia National Laboratory, USA
-*
-*     12-04 Further modifications by
-*     Ralph Byers, University of Kansas, USA
-*
-*       This is a modified version of DLAHQR from LAPACK version 3.0.
-*       It is (1) more robust against overflow and underflow and
-*       (2) adopts the more conservative Ahues & Tisseur stopping
-*       criterion (LAWN 122, 1997).
-*
-*     =========================================================
-*
-*     .. Parameters ..
-      INTEGER            ITMAX
-      PARAMETER          ( ITMAX = 30 )
-      DOUBLE PRECISION   ZERO, ONE, TWO
-      PARAMETER          ( ZERO = 0.0d0, ONE = 1.0d0, TWO = 2.0d0 )
-      DOUBLE PRECISION   DAT1, DAT2
-      PARAMETER          ( DAT1 = 3.0d0 / 4.0d0, DAT2 = -0.4375d0 )
-*     ..
-*     .. Local Scalars ..
-      DOUBLE PRECISION   AA, AB, BA, BB, CS, DET, H11, H12, H21, H21S,
-     $                   H22, RT1I, RT1R, RT2I, RT2R, RTDISC, S, SAFMAX,
-     $                   SAFMIN, SMLNUM, SN, SUM, T1, T2, T3, TR, TST,
-     $                   ULP, V2, V3
-      INTEGER            I, I1, I2, ITS, J, K, L, M, NH, NR, NZ
-*     ..
-*     .. Local Arrays ..
-      DOUBLE PRECISION   V( 3 )
-*     ..
-*     .. External Functions ..
-      DOUBLE PRECISION   DLAMCH
-      EXTERNAL           DLAMCH
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DCOPY, DLABAD, DLANV2, DLARFG, DROT
-*     ..
-*     .. Intrinsic Functions ..
-      INTRINSIC          ABS, DBLE, MAX, MIN, SQRT
-*     ..
-*     .. Executable Statements ..
-*
-      INFO = 0
-*
-*     Quick return if possible
-*
-      IF( N.EQ.0 )
-     $   RETURN
-      IF( ILO.EQ.IHI ) THEN
-         WR( ILO ) = H( ILO, ILO )
-         WI( ILO ) = ZERO
-         RETURN
-      END IF
-*
-*     ==== clear out the trash ====
-      DO 10 J = ILO, IHI - 3
-         H( J+2, J ) = ZERO
-         H( J+3, J ) = ZERO
-   10 CONTINUE
-      IF( ILO.LE.IHI-2 )
-     $   H( IHI, IHI-2 ) = ZERO
-*
-      NH = IHI - ILO + 1
-      NZ = IHIZ - ILOZ + 1
-*
-*     Set machine-dependent constants for the stopping criterion.
-*
-      SAFMIN = DLAMCH( 'SAFE MINIMUM' )
-      SAFMAX = ONE / SAFMIN
-      CALL DLABAD( SAFMIN, SAFMAX )
-      ULP = DLAMCH( 'PRECISION' )
-      SMLNUM = SAFMIN*( DBLE( NH ) / ULP )
-*
-*     I1 and I2 are the indices of the first row and last column of H
-*     to which transformations must be applied. If eigenvalues only are
-*     being computed, I1 and I2 are set inside the main loop.
-*
-      IF( WANTT ) THEN
-         I1 = 1
-         I2 = N
-      END IF
-*
-*     The main loop begins here. I is the loop index and decreases from
-*     IHI to ILO in steps of 1 or 2. Each iteration of the loop works
-*     with the active submatrix in rows and columns L to I.
-*     Eigenvalues I+1 to IHI have already converged. Either L = ILO or
-*     H(L,L-1) is negligible so that the matrix splits.
-*
-      I = IHI
-   20 CONTINUE
-      L = ILO
-      IF( I.LT.ILO )
-     $   GO TO 160
-*
-*     Perform QR iterations on rows and columns ILO to I until a
-*     submatrix of order 1 or 2 splits off at the bottom because a
-*     subdiagonal element has become negligible.
-*
-      DO 140 ITS = 0, ITMAX
-*
-*        Look for a single small subdiagonal element.
-*
-         DO 30 K = I, L + 1, -1
-            IF( ABS( H( K, K-1 ) ).LE.SMLNUM )
-     $         GO TO 40
-            TST = ABS( H( K-1, K-1 ) ) + ABS( H( K, K ) )
-            IF( TST.EQ.ZERO ) THEN
-               IF( K-2.GE.ILO )
-     $            TST = TST + ABS( H( K-1, K-2 ) )
-               IF( K+1.LE.IHI )
-     $            TST = TST + ABS( H( K+1, K ) )
-            END IF
-*           ==== The following is a conservative small subdiagonal
-*           .    deflation  criterion due to Ahues & Tisseur (LAWN 122,
-*           .    1997). It has better mathematical foundation and
-*           .    improves accuracy in some cases.  ====
-            IF( ABS( H( K, K-1 ) ).LE.ULP*TST ) THEN
-               AB = MAX( ABS( H( K, K-1 ) ), ABS( H( K-1, K ) ) )
-               BA = MIN( ABS( H( K, K-1 ) ), ABS( H( K-1, K ) ) )
-               AA = MAX( ABS( H( K, K ) ),
-     $              ABS( H( K-1, K-1 )-H( K, K ) ) )
-               BB = MIN( ABS( H( K, K ) ),
-     $              ABS( H( K-1, K-1 )-H( K, K ) ) )
-               S = AA + AB
-               IF( BA*( AB / S ).LE.MAX( SMLNUM,
-     $             ULP*( BB*( AA / S ) ) ) )GO TO 40
-            END IF
-   30    CONTINUE
-   40    CONTINUE
-         L = K
-         IF( L.GT.ILO ) THEN
-*
-*           H(L,L-1) is negligible
-*
-            H( L, L-1 ) = ZERO
-         END IF
-*
-*        Exit from loop if a submatrix of order 1 or 2 has split off.
-*
-         IF( L.GE.I-1 )
-     $      GO TO 150
-*
-*        Now the active submatrix is in rows and columns L to I. If
-*        eigenvalues only are being computed, only the active submatrix
-*        need be transformed.
-*
-         IF( .NOT.WANTT ) THEN
-            I1 = L
-            I2 = I
-         END IF
-*
-         IF( ITS.EQ.10 .OR. ITS.EQ.20 ) THEN
-*
-*           Exceptional shift.
-*
-            H11 = DAT1*S + H( I, I )
-            H12 = DAT2*S
-            H21 = S
-            H22 = H11
-         ELSE
-*
-*           Prepare to use Francis' double shift
-*           (i.e. 2nd degree generalized Rayleigh quotient)
-*
-            H11 = H( I-1, I-1 )
-            H21 = H( I, I-1 )
-            H12 = H( I-1, I )
-            H22 = H( I, I )
-         END IF
-         S = ABS( H11 ) + ABS( H12 ) + ABS( H21 ) + ABS( H22 )
-         IF( S.EQ.ZERO ) THEN
-            RT1R = ZERO
-            RT1I = ZERO
-            RT2R = ZERO
-            RT2I = ZERO
-         ELSE
-            H11 = H11 / S
-            H21 = H21 / S
-            H12 = H12 / S
-            H22 = H22 / S
-            TR = ( H11+H22 ) / TWO
-            DET = ( H11-TR )*( H22-TR ) - H12*H21
-            RTDISC = SQRT( ABS( DET ) )
-            IF( DET.GE.ZERO ) THEN
-*
-*              ==== complex conjugate shifts ====
-*
-               RT1R = TR*S
-               RT2R = RT1R
-               RT1I = RTDISC*S
-               RT2I = -RT1I
-            ELSE
-*
-*              ==== real shifts (use only one of them)  ====
-*
-               RT1R = TR + RTDISC
-               RT2R = TR - RTDISC
-               IF( ABS( RT1R-H22 ).LE.ABS( RT2R-H22 ) ) THEN
-                  RT1R = RT1R*S
-                  RT2R = RT1R
-               ELSE
-                  RT2R = RT2R*S
-                  RT1R = RT2R
-               END IF
-               RT1I = ZERO
-               RT2I = ZERO
-            END IF
-         END IF
-*
-*        Look for two consecutive small subdiagonal elements.
-*
-         DO 50 M = I - 2, L, -1
-*           Determine the effect of starting the double-shift QR
-*           iteration at row M, and see if this would make H(M,M-1)
-*           negligible.  (The following uses scaling to avoid
-*           overflows and most underflows.)
-*
-            H21S = H( M+1, M )
-            S = ABS( H( M, M )-RT2R ) + ABS( RT2I ) + ABS( H21S )
-            H21S = H( M+1, M ) / S
-            V( 1 ) = H21S*H( M, M+1 ) + ( H( M, M )-RT1R )*
-     $               ( ( H( M, M )-RT2R ) / S ) - RT1I*( RT2I / S )
-            V( 2 ) = H21S*( H( M, M )+H( M+1, M+1 )-RT1R-RT2R )
-            V( 3 ) = H21S*H( M+2, M+1 )
-            S = ABS( V( 1 ) ) + ABS( V( 2 ) ) + ABS( V( 3 ) )
-            V( 1 ) = V( 1 ) / S
-            V( 2 ) = V( 2 ) / S
-            V( 3 ) = V( 3 ) / S
-            IF( M.EQ.L )
-     $         GO TO 60
-            IF( ABS( H( M, M-1 ) )*( ABS( V( 2 ) )+ABS( V( 3 ) ) ).LE.
-     $          ULP*ABS( V( 1 ) )*( ABS( H( M-1, M-1 ) )+ABS( H( M,
-     $          M ) )+ABS( H( M+1, M+1 ) ) ) )GO TO 60
-   50    CONTINUE
-   60    CONTINUE
-*
-*        Double-shift QR step
-*
-         DO 130 K = M, I - 1
-*
-*           The first iteration of this loop determines a reflection G
-*           from the vector V and applies it from left and right to H,
-*           thus creating a nonzero bulge below the subdiagonal.
-*
-*           Each subsequent iteration determines a reflection G to
-*           restore the Hessenberg form in the (K-1)th column, and thus
-*           chases the bulge one step toward the bottom of the active
-*           submatrix. NR is the order of G.
-*
-            NR = MIN( 3, I-K+1 )
-            IF( K.GT.M )
-     $         CALL DCOPY( NR, H( K, K-1 ), 1, V, 1 )
-            CALL DLARFG( NR, V( 1 ), V( 2 ), 1, T1 )
-            IF( K.GT.M ) THEN
-               H( K, K-1 ) = V( 1 )
-               H( K+1, K-1 ) = ZERO
-               IF( K.LT.I-1 )
-     $            H( K+2, K-1 ) = ZERO
-            ELSE IF( M.GT.L ) THEN
-               H( K, K-1 ) = -H( K, K-1 )
-            END IF
-            V2 = V( 2 )
-            T2 = T1*V2
-            IF( NR.EQ.3 ) THEN
-               V3 = V( 3 )
-               T3 = T1*V3
-*
-*              Apply G from the left to transform the rows of the matrix
-*              in columns K to I2.
-*
-               DO 70 J = K, I2
-                  SUM = H( K, J ) + V2*H( K+1, J ) + V3*H( K+2, J )
-                  H( K, J ) = H( K, J ) - SUM*T1
-                  H( K+1, J ) = H( K+1, J ) - SUM*T2
-                  H( K+2, J ) = H( K+2, J ) - SUM*T3
-   70          CONTINUE
-*
-*              Apply G from the right to transform the columns of the
-*              matrix in rows I1 to min(K+3,I).
-*
-               DO 80 J = I1, MIN( K+3, I )
-                  SUM = H( J, K ) + V2*H( J, K+1 ) + V3*H( J, K+2 )
-                  H( J, K ) = H( J, K ) - SUM*T1
-                  H( J, K+1 ) = H( J, K+1 ) - SUM*T2
-                  H( J, K+2 ) = H( J, K+2 ) - SUM*T3
-   80          CONTINUE
-*
-               IF( WANTZ ) THEN
-*
-*                 Accumulate transformations in the matrix Z
-*
-                  DO 90 J = ILOZ, IHIZ
-                     SUM = Z( J, K ) + V2*Z( J, K+1 ) + V3*Z( J, K+2 )
-                     Z( J, K ) = Z( J, K ) - SUM*T1
-                     Z( J, K+1 ) = Z( J, K+1 ) - SUM*T2
-                     Z( J, K+2 ) = Z( J, K+2 ) - SUM*T3
-   90             CONTINUE
-               END IF
-            ELSE IF( NR.EQ.2 ) THEN
-*
-*              Apply G from the left to transform the rows of the matrix
-*              in columns K to I2.
-*
-               DO 100 J = K, I2
-                  SUM = H( K, J ) + V2*H( K+1, J )
-                  H( K, J ) = H( K, J ) - SUM*T1
-                  H( K+1, J ) = H( K+1, J ) - SUM*T2
-  100          CONTINUE
-*
-*              Apply G from the right to transform the columns of the
-*              matrix in rows I1 to min(K+3,I).
-*
-               DO 110 J = I1, I
-                  SUM = H( J, K ) + V2*H( J, K+1 )
-                  H( J, K ) = H( J, K ) - SUM*T1
-                  H( J, K+1 ) = H( J, K+1 ) - SUM*T2
-  110          CONTINUE
-*
-               IF( WANTZ ) THEN
-*
-*                 Accumulate transformations in the matrix Z
-*
-                  DO 120 J = ILOZ, IHIZ
-                     SUM = Z( J, K ) + V2*Z( J, K+1 )
-                     Z( J, K ) = Z( J, K ) - SUM*T1
-                     Z( J, K+1 ) = Z( J, K+1 ) - SUM*T2
-  120             CONTINUE
-               END IF
-            END IF
-  130    CONTINUE
-*
-  140 CONTINUE
-*
-*     Failure to converge in remaining number of iterations
-*
-      INFO = I
-      RETURN
-*
-  150 CONTINUE
-*
-      IF( L.EQ.I ) THEN
-*
-*        H(I,I-1) is negligible: one eigenvalue has converged.
-*
-         WR( I ) = H( I, I )
-         WI( I ) = ZERO
-      ELSE IF( L.EQ.I-1 ) THEN
-*
-*        H(I-1,I-2) is negligible: a pair of eigenvalues have converged.
-*
-*        Transform the 2-by-2 submatrix to standard Schur form,
-*        and compute and store the eigenvalues.
-*
-         CALL DLANV2( H( I-1, I-1 ), H( I-1, I ), H( I, I-1 ),
-     $                H( I, I ), WR( I-1 ), WI( I-1 ), WR( I ), WI( I ),
-     $                CS, SN )
-*
-         IF( WANTT ) THEN
-*
-*           Apply the transformation to the rest of H.
-*
-            IF( I2.GT.I )
-     $         CALL DROT( I2-I, H( I-1, I+1 ), LDH, H( I, I+1 ), LDH,
-     $                    CS, SN )
-            CALL DROT( I-I1-1, H( I1, I-1 ), 1, H( I1, I ), 1, CS, SN )
-         END IF
-         IF( WANTZ ) THEN
-*
-*           Apply the transformation to Z.
-*
-            CALL DROT( NZ, Z( ILOZ, I-1 ), 1, Z( ILOZ, I ), 1, CS, SN )
-         END IF
-      END IF
-*
-*     return to start of the main loop with new value of I.
-*
-      I = L - 1
-      GO TO 20
-*
-  160 CONTINUE
-      RETURN
-*
-*     End of DLAHQR
-*
-      END