Moving lapack to right place

1 files changed, 0 insertions, 587 deletions

diff --git a/src/lib/lapack/dlarfb.f b/src/lib/lapack/dlarfb.f
deleted file mode 100644
index d4422473..00000000
--- a/src/lib/lapack/dlarfb.f
+++ /dev/null
@@ -1,587 +0,0 @@
-      SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
-     $                   T, LDT, C, LDC, WORK, LDWORK )
-*
-*  -- LAPACK auxiliary routine (version 3.1) --
-*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-*     November 2006
-*
-*     .. Scalar Arguments ..
-      CHARACTER          DIRECT, SIDE, STOREV, TRANS
-      INTEGER            K, LDC, LDT, LDV, LDWORK, M, N
-*     ..
-*     .. Array Arguments ..
-      DOUBLE PRECISION   C( LDC, * ), T( LDT, * ), V( LDV, * ),
-     $                   WORK( LDWORK, * )
-*     ..
-*
-*  Purpose
-*  =======
-*
-*  DLARFB applies a real block reflector H or its transpose H' to a
-*  real m by n matrix C, from either the left or the right.
-*
-*  Arguments
-*  =========
-*
-*  SIDE    (input) CHARACTER*1
-*          = 'L': apply H or H' from the Left
-*          = 'R': apply H or H' from the Right
-*
-*  TRANS   (input) CHARACTER*1
-*          = 'N': apply H (No transpose)
-*          = 'T': apply H' (Transpose)
-*
-*  DIRECT  (input) CHARACTER*1
-*          Indicates how H is formed from a product of elementary
-*          reflectors
-*          = 'F': H = H(1) H(2) . . . H(k) (Forward)
-*          = 'B': H = H(k) . . . H(2) H(1) (Backward)
-*
-*  STOREV  (input) CHARACTER*1
-*          Indicates how the vectors which define the elementary
-*          reflectors are stored:
-*          = 'C': Columnwise
-*          = 'R': Rowwise
-*
-*  M       (input) INTEGER
-*          The number of rows of the matrix C.
-*
-*  N       (input) INTEGER
-*          The number of columns of the matrix C.
-*
-*  K       (input) INTEGER
-*          The order of the matrix T (= the number of elementary
-*          reflectors whose product defines the block reflector).
-*
-*  V       (input) DOUBLE PRECISION array, dimension
-*                                (LDV,K) if STOREV = 'C'
-*                                (LDV,M) if STOREV = 'R' and SIDE = 'L'
-*                                (LDV,N) if STOREV = 'R' and SIDE = 'R'
-*          The matrix V. See further details.
-*
-*  LDV     (input) INTEGER
-*          The leading dimension of the array V.
-*          If STOREV = 'C' and SIDE = 'L', LDV >= max(1,M);
-*          if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N);
-*          if STOREV = 'R', LDV >= K.
-*
-*  T       (input) DOUBLE PRECISION array, dimension (LDT,K)
-*          The triangular k by k matrix T in the representation of the
-*          block reflector.
-*
-*  LDT     (input) INTEGER
-*          The leading dimension of the array T. LDT >= K.
-*
-*  C       (input/output) DOUBLE PRECISION array, dimension (LDC,N)
-*          On entry, the m by n matrix C.
-*          On exit, C is overwritten by H*C or H'*C or C*H or C*H'.
-*
-*  LDC     (input) INTEGER
-*          The leading dimension of the array C. LDA >= max(1,M).
-*
-*  WORK    (workspace) DOUBLE PRECISION array, dimension (LDWORK,K)
-*
-*  LDWORK  (input) INTEGER
-*          The leading dimension of the array WORK.
-*          If SIDE = 'L', LDWORK >= max(1,N);
-*          if SIDE = 'R', LDWORK >= max(1,M).
-*
-*  =====================================================================
-*
-*     .. Parameters ..
-      DOUBLE PRECISION   ONE
-      PARAMETER          ( ONE = 1.0D+0 )
-*     ..
-*     .. Local Scalars ..
-      CHARACTER          TRANST
-      INTEGER            I, J
-*     ..
-*     .. External Functions ..
-      LOGICAL            LSAME
-      EXTERNAL           LSAME
-*     ..
-*     .. External Subroutines ..
-      EXTERNAL           DCOPY, DGEMM, DTRMM
-*     ..
-*     .. Executable Statements ..
-*
-*     Quick return if possible
-*
-      IF( M.LE.0 .OR. N.LE.0 )
-     $   RETURN
-*
-      IF( LSAME( TRANS, 'N' ) ) THEN
-         TRANST = 'T'
-      ELSE
-         TRANST = 'N'
-      END IF
-*
-      IF( LSAME( STOREV, 'C' ) ) THEN
-*
-         IF( LSAME( DIRECT, 'F' ) ) THEN
-*
-*           Let  V =  ( V1 )    (first K rows)
-*                     ( V2 )
-*           where  V1  is unit lower triangular.
-*
-            IF( LSAME( SIDE, 'L' ) ) THEN
-*
-*              Form  H * C  or  H' * C  where  C = ( C1 )
-*                                                  ( C2 )
-*
-*              W := C' * V  =  (C1'*V1 + C2'*V2)  (stored in WORK)
-*
-*              W := C1'
-*
-               DO 10 J = 1, K
-                  CALL DCOPY( N, C( J, 1 ), LDC, WORK( 1, J ), 1 )
-   10          CONTINUE
-*
-*              W := W * V1
-*
-               CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', N,
-     $                     K, ONE, V, LDV, WORK, LDWORK )
-               IF( M.GT.K ) THEN
-*
-*                 W := W + C2'*V2
-*
-                  CALL DGEMM( 'Transpose', 'No transpose', N, K, M-K,
-     $                        ONE, C( K+1, 1 ), LDC, V( K+1, 1 ), LDV,
-     $                        ONE, WORK, LDWORK )
-               END IF
-*
-*              W := W * T'  or  W * T
-*
-               CALL DTRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, K,
-     $                     ONE, T, LDT, WORK, LDWORK )
-*
-*              C := C - V * W'
-*
-               IF( M.GT.K ) THEN
-*
-*                 C2 := C2 - V2 * W'
-*
-                  CALL DGEMM( 'No transpose', 'Transpose', M-K, N, K,
-     $                        -ONE, V( K+1, 1 ), LDV, WORK, LDWORK, ONE,
-     $                        C( K+1, 1 ), LDC )
-               END IF
-*
-*              W := W * V1'
-*
-               CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', N, K,
-     $                     ONE, V, LDV, WORK, LDWORK )
-*
-*              C1 := C1 - W'
-*
-               DO 30 J = 1, K
-                  DO 20 I = 1, N
-                     C( J, I ) = C( J, I ) - WORK( I, J )
-   20             CONTINUE
-   30          CONTINUE
-*
-            ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-*              Form  C * H  or  C * H'  where  C = ( C1  C2 )
-*
-*              W := C * V  =  (C1*V1 + C2*V2)  (stored in WORK)
-*
-*              W := C1
-*
-               DO 40 J = 1, K
-                  CALL DCOPY( M, C( 1, J ), 1, WORK( 1, J ), 1 )
-   40          CONTINUE
-*
-*              W := W * V1
-*
-               CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', M,
-     $                     K, ONE, V, LDV, WORK, LDWORK )
-               IF( N.GT.K ) THEN
-*
-*                 W := W + C2 * V2
-*
-                  CALL DGEMM( 'No transpose', 'No transpose', M, K, N-K,
-     $                        ONE, C( 1, K+1 ), LDC, V( K+1, 1 ), LDV,
-     $                        ONE, WORK, LDWORK )
-               END IF
-*
-*              W := W * T  or  W * T'
-*
-               CALL DTRMM( 'Right', 'Upper', TRANS, 'Non-unit', M, K,
-     $                     ONE, T, LDT, WORK, LDWORK )
-*
-*              C := C - W * V'
-*
-               IF( N.GT.K ) THEN
-*
-*                 C2 := C2 - W * V2'
-*
-                  CALL DGEMM( 'No transpose', 'Transpose', M, N-K, K,
-     $                        -ONE, WORK, LDWORK, V( K+1, 1 ), LDV, ONE,
-     $                        C( 1, K+1 ), LDC )
-               END IF
-*
-*              W := W * V1'
-*
-               CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', M, K,
-     $                     ONE, V, LDV, WORK, LDWORK )
-*
-*              C1 := C1 - W
-*
-               DO 60 J = 1, K
-                  DO 50 I = 1, M
-                     C( I, J ) = C( I, J ) - WORK( I, J )
-   50             CONTINUE
-   60          CONTINUE
-            END IF
-*
-         ELSE
-*
-*           Let  V =  ( V1 )
-*                     ( V2 )    (last K rows)
-*           where  V2  is unit upper triangular.
-*
-            IF( LSAME( SIDE, 'L' ) ) THEN
-*
-*              Form  H * C  or  H' * C  where  C = ( C1 )
-*                                                  ( C2 )
-*
-*              W := C' * V  =  (C1'*V1 + C2'*V2)  (stored in WORK)
-*
-*              W := C2'
-*
-               DO 70 J = 1, K
-                  CALL DCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), 1 )
-   70          CONTINUE
-*
-*              W := W * V2
-*
-               CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', N,
-     $                     K, ONE, V( M-K+1, 1 ), LDV, WORK, LDWORK )
-               IF( M.GT.K ) THEN
-*
-*                 W := W + C1'*V1
-*
-                  CALL DGEMM( 'Transpose', 'No transpose', N, K, M-K,
-     $                        ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
-               END IF
-*
-*              W := W * T'  or  W * T
-*
-               CALL DTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K,
-     $                     ONE, T, LDT, WORK, LDWORK )
-*
-*              C := C - V * W'
-*
-               IF( M.GT.K ) THEN
-*
-*                 C1 := C1 - V1 * W'
-*
-                  CALL DGEMM( 'No transpose', 'Transpose', M-K, N, K,
-     $                        -ONE, V, LDV, WORK, LDWORK, ONE, C, LDC )
-               END IF
-*
-*              W := W * V2'
-*
-               CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', N, K,
-     $                     ONE, V( M-K+1, 1 ), LDV, WORK, LDWORK )
-*
-*              C2 := C2 - W'
-*
-               DO 90 J = 1, K
-                  DO 80 I = 1, N
-                     C( M-K+J, I ) = C( M-K+J, I ) - WORK( I, J )
-   80             CONTINUE
-   90          CONTINUE
-*
-            ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-*              Form  C * H  or  C * H'  where  C = ( C1  C2 )
-*
-*              W := C * V  =  (C1*V1 + C2*V2)  (stored in WORK)
-*
-*              W := C2
-*
-               DO 100 J = 1, K
-                  CALL DCOPY( M, C( 1, N-K+J ), 1, WORK( 1, J ), 1 )
-  100          CONTINUE
-*
-*              W := W * V2
-*
-               CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', M,
-     $                     K, ONE, V( N-K+1, 1 ), LDV, WORK, LDWORK )
-               IF( N.GT.K ) THEN
-*
-*                 W := W + C1 * V1
-*
-                  CALL DGEMM( 'No transpose', 'No transpose', M, K, N-K,
-     $                        ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
-               END IF
-*
-*              W := W * T  or  W * T'
-*
-               CALL DTRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K,
-     $                     ONE, T, LDT, WORK, LDWORK )
-*
-*              C := C - W * V'
-*
-               IF( N.GT.K ) THEN
-*
-*                 C1 := C1 - W * V1'
-*
-                  CALL DGEMM( 'No transpose', 'Transpose', M, N-K, K,
-     $                        -ONE, WORK, LDWORK, V, LDV, ONE, C, LDC )
-               END IF
-*
-*              W := W * V2'
-*
-               CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', M, K,
-     $                     ONE, V( N-K+1, 1 ), LDV, WORK, LDWORK )
-*
-*              C2 := C2 - W
-*
-               DO 120 J = 1, K
-                  DO 110 I = 1, M
-                     C( I, N-K+J ) = C( I, N-K+J ) - WORK( I, J )
-  110             CONTINUE
-  120          CONTINUE
-            END IF
-         END IF
-*
-      ELSE IF( LSAME( STOREV, 'R' ) ) THEN
-*
-         IF( LSAME( DIRECT, 'F' ) ) THEN
-*
-*           Let  V =  ( V1  V2 )    (V1: first K columns)
-*           where  V1  is unit upper triangular.
-*
-            IF( LSAME( SIDE, 'L' ) ) THEN
-*
-*              Form  H * C  or  H' * C  where  C = ( C1 )
-*                                                  ( C2 )
-*
-*              W := C' * V'  =  (C1'*V1' + C2'*V2') (stored in WORK)
-*
-*              W := C1'
-*
-               DO 130 J = 1, K
-                  CALL DCOPY( N, C( J, 1 ), LDC, WORK( 1, J ), 1 )
-  130          CONTINUE
-*
-*              W := W * V1'
-*
-               CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', N, K,
-     $                     ONE, V, LDV, WORK, LDWORK )
-               IF( M.GT.K ) THEN
-*
-*                 W := W + C2'*V2'
-*
-                  CALL DGEMM( 'Transpose', 'Transpose', N, K, M-K, ONE,
-     $                        C( K+1, 1 ), LDC, V( 1, K+1 ), LDV, ONE,
-     $                        WORK, LDWORK )
-               END IF
-*
-*              W := W * T'  or  W * T
-*
-               CALL DTRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, K,
-     $                     ONE, T, LDT, WORK, LDWORK )
-*
-*              C := C - V' * W'
-*
-               IF( M.GT.K ) THEN
-*
-*                 C2 := C2 - V2' * W'
-*
-                  CALL DGEMM( 'Transpose', 'Transpose', M-K, N, K, -ONE,
-     $                        V( 1, K+1 ), LDV, WORK, LDWORK, ONE,
-     $                        C( K+1, 1 ), LDC )
-               END IF
-*
-*              W := W * V1
-*
-               CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', N,
-     $                     K, ONE, V, LDV, WORK, LDWORK )
-*
-*              C1 := C1 - W'
-*
-               DO 150 J = 1, K
-                  DO 140 I = 1, N
-                     C( J, I ) = C( J, I ) - WORK( I, J )
-  140             CONTINUE
-  150          CONTINUE
-*
-            ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-*              Form  C * H  or  C * H'  where  C = ( C1  C2 )
-*
-*              W := C * V'  =  (C1*V1' + C2*V2')  (stored in WORK)
-*
-*              W := C1
-*
-               DO 160 J = 1, K
-                  CALL DCOPY( M, C( 1, J ), 1, WORK( 1, J ), 1 )
-  160          CONTINUE
-*
-*              W := W * V1'
-*
-               CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', M, K,
-     $                     ONE, V, LDV, WORK, LDWORK )
-               IF( N.GT.K ) THEN
-*
-*                 W := W + C2 * V2'
-*
-                  CALL DGEMM( 'No transpose', 'Transpose', M, K, N-K,
-     $                        ONE, C( 1, K+1 ), LDC, V( 1, K+1 ), LDV,
-     $                        ONE, WORK, LDWORK )
-               END IF
-*
-*              W := W * T  or  W * T'
-*
-               CALL DTRMM( 'Right', 'Upper', TRANS, 'Non-unit', M, K,
-     $                     ONE, T, LDT, WORK, LDWORK )
-*
-*              C := C - W * V
-*
-               IF( N.GT.K ) THEN
-*
-*                 C2 := C2 - W * V2
-*
-                  CALL DGEMM( 'No transpose', 'No transpose', M, N-K, K,
-     $                        -ONE, WORK, LDWORK, V( 1, K+1 ), LDV, ONE,
-     $                        C( 1, K+1 ), LDC )
-               END IF
-*
-*              W := W * V1
-*
-               CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', M,
-     $                     K, ONE, V, LDV, WORK, LDWORK )
-*
-*              C1 := C1 - W
-*
-               DO 180 J = 1, K
-                  DO 170 I = 1, M
-                     C( I, J ) = C( I, J ) - WORK( I, J )
-  170             CONTINUE
-  180          CONTINUE
-*
-            END IF
-*
-         ELSE
-*
-*           Let  V =  ( V1  V2 )    (V2: last K columns)
-*           where  V2  is unit lower triangular.
-*
-            IF( LSAME( SIDE, 'L' ) ) THEN
-*
-*              Form  H * C  or  H' * C  where  C = ( C1 )
-*                                                  ( C2 )
-*
-*              W := C' * V'  =  (C1'*V1' + C2'*V2') (stored in WORK)
-*
-*              W := C2'
-*
-               DO 190 J = 1, K
-                  CALL DCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), 1 )
-  190          CONTINUE
-*
-*              W := W * V2'
-*
-               CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', N, K,
-     $                     ONE, V( 1, M-K+1 ), LDV, WORK, LDWORK )
-               IF( M.GT.K ) THEN
-*
-*                 W := W + C1'*V1'
-*
-                  CALL DGEMM( 'Transpose', 'Transpose', N, K, M-K, ONE,
-     $                        C, LDC, V, LDV, ONE, WORK, LDWORK )
-               END IF
-*
-*              W := W * T'  or  W * T
-*
-               CALL DTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K,
-     $                     ONE, T, LDT, WORK, LDWORK )
-*
-*              C := C - V' * W'
-*
-               IF( M.GT.K ) THEN
-*
-*                 C1 := C1 - V1' * W'
-*
-                  CALL DGEMM( 'Transpose', 'Transpose', M-K, N, K, -ONE,
-     $                        V, LDV, WORK, LDWORK, ONE, C, LDC )
-               END IF
-*
-*              W := W * V2
-*
-               CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', N,
-     $                     K, ONE, V( 1, M-K+1 ), LDV, WORK, LDWORK )
-*
-*              C2 := C2 - W'
-*
-               DO 210 J = 1, K
-                  DO 200 I = 1, N
-                     C( M-K+J, I ) = C( M-K+J, I ) - WORK( I, J )
-  200             CONTINUE
-  210          CONTINUE
-*
-            ELSE IF( LSAME( SIDE, 'R' ) ) THEN
-*
-*              Form  C * H  or  C * H'  where  C = ( C1  C2 )
-*
-*              W := C * V'  =  (C1*V1' + C2*V2')  (stored in WORK)
-*
-*              W := C2
-*
-               DO 220 J = 1, K
-                  CALL DCOPY( M, C( 1, N-K+J ), 1, WORK( 1, J ), 1 )
-  220          CONTINUE
-*
-*              W := W * V2'
-*
-               CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', M, K,
-     $                     ONE, V( 1, N-K+1 ), LDV, WORK, LDWORK )
-               IF( N.GT.K ) THEN
-*
-*                 W := W + C1 * V1'
-*
-                  CALL DGEMM( 'No transpose', 'Transpose', M, K, N-K,
-     $                        ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
-               END IF
-*
-*              W := W * T  or  W * T'
-*
-               CALL DTRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K,
-     $                     ONE, T, LDT, WORK, LDWORK )
-*
-*              C := C - W * V
-*
-               IF( N.GT.K ) THEN
-*
-*                 C1 := C1 - W * V1
-*
-                  CALL DGEMM( 'No transpose', 'No transpose', M, N-K, K,
-     $                        -ONE, WORK, LDWORK, V, LDV, ONE, C, LDC )
-               END IF
-*
-*              W := W * V2
-*
-               CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', M,
-     $                     K, ONE, V( 1, N-K+1 ), LDV, WORK, LDWORK )
-*
-*              C1 := C1 - W
-*
-               DO 240 J = 1, K
-                  DO 230 I = 1, M
-                     C( I, N-K+J ) = C( I, N-K+J ) - WORK( I, J )
-  230             CONTINUE
-  240          CONTINUE
-*
-            END IF
-*
-         END IF
-      END IF
-*
-      RETURN
-*
-*     End of DLARFB
-*
-      END