diff --git a/SRC/DEPRECATED/cgegs.f b/SRC/DEPRECATED/cgegs.f index b6adf91118..62fdcb145e 100644 --- a/SRC/DEPRECATED/cgegs.f +++ b/SRC/DEPRECATED/cgegs.f @@ -219,9 +219,9 @@ *> \ingroup complexGEeigen * * ===================================================================== - SUBROUTINE CGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHA, BETA, - $ VSL, LDVSL, VSR, LDVSR, WORK, LWORK, RWORK, - $ INFO ) + SUBROUTINE CGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHA, + $ BETA, VSL, LDVSL, VSR, LDVSR, WORK, LWORK, + $ RWORK, INFO ) * * -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -360,7 +360,8 @@ SUBROUTINE CGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHA, BETA, END IF * IF( ILASCL ) THEN - CALL CLASCL( 'G', -1, -1, ANRM, ANRMTO, N, N, A, LDA, IINFO ) + CALL CLASCL( 'G', -1, -1, ANRM, ANRMTO, N, N, A, LDA, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN @@ -380,7 +381,8 @@ SUBROUTINE CGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHA, BETA, END IF * IF( ILBSCL ) THEN - CALL CLASCL( 'G', -1, -1, BNRM, BNRMTO, N, N, B, LDB, IINFO ) + CALL CLASCL( 'G', -1, -1, BNRM, BNRMTO, N, N, B, LDB, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN @@ -493,12 +495,14 @@ SUBROUTINE CGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHA, BETA, * Undo scaling * IF( ILASCL ) THEN - CALL CLASCL( 'U', -1, -1, ANRMTO, ANRM, N, N, A, LDA, IINFO ) + CALL CLASCL( 'U', -1, -1, ANRMTO, ANRM, N, N, A, LDA, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN END IF - CALL CLASCL( 'G', -1, -1, ANRMTO, ANRM, N, 1, ALPHA, N, IINFO ) + CALL CLASCL( 'G', -1, -1, ANRMTO, ANRM, N, 1, ALPHA, N, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN @@ -506,12 +510,14 @@ SUBROUTINE CGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHA, BETA, END IF * IF( ILBSCL ) THEN - CALL CLASCL( 'U', -1, -1, BNRMTO, BNRM, N, N, B, LDB, IINFO ) + CALL CLASCL( 'U', -1, -1, BNRMTO, BNRM, N, N, B, LDB, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN END IF - CALL CLASCL( 'G', -1, -1, BNRMTO, BNRM, N, 1, BETA, N, IINFO ) + CALL CLASCL( 'G', -1, -1, BNRMTO, BNRM, N, 1, BETA, N, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN diff --git a/SRC/DEPRECATED/cgelsx.f b/SRC/DEPRECATED/cgelsx.f index 54c7f58b7d..b55fe1565b 100644 --- a/SRC/DEPRECATED/cgelsx.f +++ b/SRC/DEPRECATED/cgelsx.f @@ -179,8 +179,8 @@ *> \ingroup complexGEsolve * * ===================================================================== - SUBROUTINE CGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, - $ WORK, RWORK, INFO ) + SUBROUTINE CGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, + $ RANK, WORK, RWORK, INFO ) * * -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -294,13 +294,15 @@ SUBROUTINE CGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * * Scale matrix norm up to SMLNUM * - CALL CLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, INFO ) + CALL CLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 1 ELSE IF( BNRM.GT.BIGNUM ) THEN * * Scale matrix norm down to BIGNUM * - CALL CLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, INFO ) + CALL CLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 2 END IF * @@ -420,18 +422,22 @@ SUBROUTINE CGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * Undo scaling * IF( IASCL.EQ.1 ) THEN - CALL CLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO ) + CALL CLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, + $ INFO ) CALL CLASCL( 'U', 0, 0, SMLNUM, ANRM, RANK, RANK, A, LDA, $ INFO ) ELSE IF( IASCL.EQ.2 ) THEN - CALL CLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO ) + CALL CLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, + $ INFO ) CALL CLASCL( 'U', 0, 0, BIGNUM, ANRM, RANK, RANK, A, LDA, $ INFO ) END IF IF( IBSCL.EQ.1 ) THEN - CALL CLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL CLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) ELSE IF( IBSCL.EQ.2 ) THEN - CALL CLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL CLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) END IF * 100 CONTINUE diff --git a/SRC/DEPRECATED/cggsvp.f b/SRC/DEPRECATED/cggsvp.f index f919a55114..d5c855c5b5 100644 --- a/SRC/DEPRECATED/cggsvp.f +++ b/SRC/DEPRECATED/cggsvp.f @@ -382,7 +382,8 @@ SUBROUTINE CGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, 30 CONTINUE 40 CONTINUE IF( P.GT.L ) - $ CALL CLASET( 'Full', P-L, N, CZERO, CZERO, B( L+1, 1 ), LDB ) + $ CALL CLASET( 'Full', P-L, N, CZERO, CZERO, B( L+1, 1 ), + $ LDB ) * IF( WANTQ ) THEN * @@ -400,8 +401,8 @@ SUBROUTINE CGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update A := A*Z**H * - CALL CUNMR2( 'Right', 'Conjugate transpose', M, N, L, B, LDB, - $ TAU, A, LDA, WORK, INFO ) + CALL CUNMR2( 'Right', 'Conjugate transpose', M, N, L, B, + $ LDB, TAU, A, LDA, WORK, INFO ) IF( WANTQ ) THEN * * Update Q := Q*Z**H @@ -444,8 +445,9 @@ SUBROUTINE CGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update A12 := U**H*A12, where A12 = A( 1:M, N-L+1:N ) * - CALL CUNM2R( 'Left', 'Conjugate transpose', M, L, MIN( M, N-L ), - $ A, LDA, TAU, A( 1, N-L+1 ), LDA, WORK, INFO ) + CALL CUNM2R( 'Left', 'Conjugate transpose', M, L, + $ MIN( M, N-L ), A, LDA, TAU, A( 1, N-L+1 ), LDA, WORK, + $ INFO ) * IF( WANTU ) THEN * @@ -453,8 +455,8 @@ SUBROUTINE CGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * CALL CLASET( 'Full', M, M, CZERO, CZERO, U, LDU ) IF( M.GT.1 ) - $ CALL CLACPY( 'Lower', M-1, N-L, A( 2, 1 ), LDA, U( 2, 1 ), - $ LDU ) + $ CALL CLACPY( 'Lower', M-1, N-L, A( 2, 1 ), LDA, + $ U( 2, 1 ), LDU ) CALL CUNG2R( M, M, MIN( M, N-L ), U, LDU, TAU, WORK, INFO ) END IF * @@ -474,7 +476,8 @@ SUBROUTINE CGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, 90 CONTINUE 100 CONTINUE IF( M.GT.K ) - $ CALL CLASET( 'Full', M-K, N-L, CZERO, CZERO, A( K+1, 1 ), LDA ) + $ CALL CLASET( 'Full', M-K, N-L, CZERO, CZERO, A( K+1, 1 ), + $ LDA ) * IF( N-L.GT.K ) THEN * @@ -486,8 +489,8 @@ SUBROUTINE CGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update Q( 1:N,1:N-L ) = Q( 1:N,1:N-L )*Z1**H * - CALL CUNMR2( 'Right', 'Conjugate transpose', N, N-L, K, A, - $ LDA, TAU, Q, LDQ, WORK, INFO ) + CALL CUNMR2( 'Right', 'Conjugate transpose', N, N-L, K, + $ A, LDA, TAU, Q, LDQ, WORK, INFO ) END IF * * Clean up A @@ -511,9 +514,9 @@ SUBROUTINE CGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update U(:,K+1:M) := U(:,K+1:M)*U1 * - CALL CUNM2R( 'Right', 'No transpose', M, M-K, MIN( M-K, L ), - $ A( K+1, N-L+1 ), LDA, TAU, U( 1, K+1 ), LDU, - $ WORK, INFO ) + CALL CUNM2R( 'Right', 'No transpose', M, M-K, + $ MIN( M-K, L ), A( K+1, N-L+1 ), LDA, TAU, + $ U( 1, K+1 ), LDU, WORK, INFO ) END IF * * Clean up diff --git a/SRC/DEPRECATED/clahrd.f b/SRC/DEPRECATED/clahrd.f index a9445f3641..6d0e02eb92 100644 --- a/SRC/DEPRECATED/clahrd.f +++ b/SRC/DEPRECATED/clahrd.f @@ -236,13 +236,14 @@ SUBROUTINE CLAHRD( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY ) * * w := T**H *w * - CALL CTRMV( 'Upper', 'Conjugate transpose', 'Non-unit', I-1, - $ T, LDT, T( 1, NB ), 1 ) + CALL CTRMV( 'Upper', 'Conjugate transpose', 'Non-unit', + $ I-1, T, LDT, T( 1, NB ), 1 ) * * b2 := b2 - V2*w * - CALL CGEMV( 'No transpose', N-K-I+1, I-1, -ONE, A( K+I, 1 ), - $ LDA, T( 1, NB ), 1, ONE, A( K+I, I ), 1 ) + CALL CGEMV( 'No transpose', N-K-I+1, I-1, -ONE, + $ A( K+I, 1 ), LDA, T( 1, NB ), 1, ONE, + $ A( K+I, I ), 1 ) * * b1 := b1 - V1*w * @@ -263,20 +264,20 @@ SUBROUTINE CLAHRD( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY ) * * Compute Y(1:n,i) * - CALL CGEMV( 'No transpose', N, N-K-I+1, ONE, A( 1, I+1 ), LDA, - $ A( K+I, I ), 1, ZERO, Y( 1, I ), 1 ) + CALL CGEMV( 'No transpose', N, N-K-I+1, ONE, A( 1, I+1 ), + $ LDA, A( K+I, I ), 1, ZERO, Y( 1, I ), 1 ) CALL CGEMV( 'Conjugate transpose', N-K-I+1, I-1, ONE, $ A( K+I, 1 ), LDA, A( K+I, I ), 1, ZERO, T( 1, I ), $ 1 ) - CALL CGEMV( 'No transpose', N, I-1, -ONE, Y, LDY, T( 1, I ), 1, - $ ONE, Y( 1, I ), 1 ) + CALL CGEMV( 'No transpose', N, I-1, -ONE, Y, LDY, + $ T( 1, I ), 1, ONE, Y( 1, I ), 1 ) CALL CSCAL( N, TAU( I ), Y( 1, I ), 1 ) * * Compute T(1:i,i) * CALL CSCAL( I-1, -TAU( I ), T( 1, I ), 1 ) - CALL CTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T, LDT, - $ T( 1, I ), 1 ) + CALL CTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T, + $ LDT, T( 1, I ), 1 ) T( I, I ) = TAU( I ) * 10 CONTINUE diff --git a/SRC/DEPRECATED/clatzm.f b/SRC/DEPRECATED/clatzm.f index 160b58a082..ffad13e477 100644 --- a/SRC/DEPRECATED/clatzm.f +++ b/SRC/DEPRECATED/clatzm.f @@ -148,7 +148,8 @@ *> \ingroup latzm * * ===================================================================== - SUBROUTINE CLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK ) + SUBROUTINE CLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, + $ WORK ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -206,8 +207,8 @@ SUBROUTINE CLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK ) * w := C1 + C2 * v * CALL CCOPY( M, C1, 1, WORK, 1 ) - CALL CGEMV( 'No transpose', M, N-1, ONE, C2, LDC, V, INCV, ONE, - $ WORK, 1 ) + CALL CGEMV( 'No transpose', M, N-1, ONE, C2, LDC, V, INCV, + $ ONE, WORK, 1 ) * * [ C1, C2 ] := [ C1, C2 ] - tau* w * [ 1 , v**H] * diff --git a/SRC/DEPRECATED/ctzrqf.f b/SRC/DEPRECATED/ctzrqf.f index 0f83dd6dc0..5da7c3c903 100644 --- a/SRC/DEPRECATED/ctzrqf.f +++ b/SRC/DEPRECATED/ctzrqf.f @@ -217,14 +217,15 @@ SUBROUTINE CTZRQF( M, N, A, LDA, TAU, INFO ) * * Form w = a( k ) + B*z( k ) in TAU. * - CALL CGEMV( 'No transpose', K-1, N-M, CONE, A( 1, M1 ), - $ LDA, A( K, M1 ), LDA, CONE, TAU, 1 ) + CALL CGEMV( 'No transpose', K-1, N-M, CONE, + $ A( 1, M1 ), LDA, A( K, M1 ), LDA, CONE, + $ TAU, 1 ) * * Now form a( k ) := a( k ) - conjg(tau)*w * and B := B - conjg(tau)*w*z( k )**H. * - CALL CAXPY( K-1, -CONJG( TAU( K ) ), TAU, 1, A( 1, K ), - $ 1 ) + CALL CAXPY( K-1, -CONJG( TAU( K ) ), TAU, 1, + $ A( 1, K ), 1 ) CALL CGERC( K-1, N-M, -CONJG( TAU( K ) ), TAU, 1, $ A( K, M1 ), LDA, A( 1, M1 ), LDA ) END IF diff --git a/SRC/DEPRECATED/dgegs.f b/SRC/DEPRECATED/dgegs.f index 02e9fdcb21..9e4df7e10b 100644 --- a/SRC/DEPRECATED/dgegs.f +++ b/SRC/DEPRECATED/dgegs.f @@ -358,7 +358,8 @@ SUBROUTINE DGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHAR, END IF * IF( ILASCL ) THEN - CALL DLASCL( 'G', -1, -1, ANRM, ANRMTO, N, N, A, LDA, IINFO ) + CALL DLASCL( 'G', -1, -1, ANRM, ANRMTO, N, N, A, LDA, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN @@ -378,7 +379,8 @@ SUBROUTINE DGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHAR, END IF * IF( ILBSCL ) THEN - CALL DLASCL( 'G', -1, -1, BNRM, BNRMTO, N, N, B, LDB, IINFO ) + CALL DLASCL( 'G', -1, -1, BNRM, BNRMTO, N, N, B, LDB, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN @@ -496,7 +498,8 @@ SUBROUTINE DGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHAR, * Undo scaling * IF( ILASCL ) THEN - CALL DLASCL( 'H', -1, -1, ANRMTO, ANRM, N, N, A, LDA, IINFO ) + CALL DLASCL( 'H', -1, -1, ANRMTO, ANRM, N, N, A, LDA, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN @@ -516,12 +519,14 @@ SUBROUTINE DGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHAR, END IF * IF( ILBSCL ) THEN - CALL DLASCL( 'U', -1, -1, BNRMTO, BNRM, N, N, B, LDB, IINFO ) + CALL DLASCL( 'U', -1, -1, BNRMTO, BNRM, N, N, B, LDB, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN END IF - CALL DLASCL( 'G', -1, -1, BNRMTO, BNRM, N, 1, BETA, N, IINFO ) + CALL DLASCL( 'G', -1, -1, BNRMTO, BNRM, N, 1, BETA, N, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN diff --git a/SRC/DEPRECATED/dgegv.f b/SRC/DEPRECATED/dgegv.f index 0b5c489222..0bbb8ca820 100644 --- a/SRC/DEPRECATED/dgegv.f +++ b/SRC/DEPRECATED/dgegv.f @@ -301,8 +301,9 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DGEGV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI, - $ BETA, VL, LDVL, VR, LDVR, WORK, LWORK, INFO ) + SUBROUTINE DGEGV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, + $ ALPHAI, BETA, VL, LDVL, VR, LDVR, WORK, LWORK, + $ INFO ) * * -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/DEPRECATED/dgelqs.f b/SRC/DEPRECATED/dgelqs.f index ecbb5893c3..dc08f2398b 100644 --- a/SRC/DEPRECATED/dgelqs.f +++ b/SRC/DEPRECATED/dgelqs.f @@ -174,18 +174,19 @@ SUBROUTINE DGELQS( M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, * * Solve L*X = B(1:m,:) * - CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Non-unit', M, NRHS, - $ ONE, A, LDA, B, LDB ) + CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Non-unit', M, + $ NRHS, ONE, A, LDA, B, LDB ) * * Set B(m+1:n,:) to zero * IF( M.LT.N ) - $ CALL DLASET( 'Full', N-M, NRHS, ZERO, ZERO, B( M+1, 1 ), LDB ) + $ CALL DLASET( 'Full', N-M, NRHS, ZERO, ZERO, B( M+1, 1 ), + $ LDB ) * * B := Q' * B * - CALL DORMLQ( 'Left', 'Transpose', N, NRHS, M, A, LDA, TAU, B, LDB, - $ WORK, LWORK, INFO ) + CALL DORMLQ( 'Left', 'Transpose', N, NRHS, M, A, LDA, TAU, B, + $ LDB, WORK, LWORK, INFO ) * RETURN * diff --git a/SRC/DEPRECATED/dgelsx.f b/SRC/DEPRECATED/dgelsx.f index 548cf67123..8dfcbc698a 100644 --- a/SRC/DEPRECATED/dgelsx.f +++ b/SRC/DEPRECATED/dgelsx.f @@ -173,8 +173,8 @@ *> \ingroup doubleGEsolve * * ===================================================================== - SUBROUTINE DGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, - $ WORK, INFO ) + SUBROUTINE DGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, + $ RANK, WORK, INFO ) * * -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -283,20 +283,23 @@ SUBROUTINE DGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * * Scale matrix norm up to SMLNUM * - CALL DLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, INFO ) + CALL DLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 1 ELSE IF( BNRM.GT.BIGNUM ) THEN * * Scale matrix norm down to BIGNUM * - CALL DLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, INFO ) + CALL DLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 2 END IF * * Compute QR factorization with column pivoting of A: * A * P = Q * R * - CALL DGEQPF( M, N, A, LDA, JPVT, WORK( 1 ), WORK( MN+1 ), INFO ) + CALL DGEQPF( M, N, A, LDA, JPVT, WORK( 1 ), WORK( MN+1 ), + $ INFO ) * * workspace 3*N. Details of Householder rotations stored * in WORK(1:MN). @@ -350,8 +353,8 @@ SUBROUTINE DGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * * B(1:M,1:NRHS) := Q**T * B(1:M,1:NRHS) * - CALL DORM2R( 'Left', 'Transpose', M, NRHS, MN, A, LDA, WORK( 1 ), - $ B, LDB, WORK( 2*MN+1 ), INFO ) + CALL DORM2R( 'Left', 'Transpose', M, NRHS, MN, A, LDA, + $ WORK( 1 ), B, LDB, WORK( 2*MN+1 ), INFO ) * * workspace NRHS * @@ -408,18 +411,22 @@ SUBROUTINE DGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * Undo scaling * IF( IASCL.EQ.1 ) THEN - CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO ) + CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, + $ INFO ) CALL DLASCL( 'U', 0, 0, SMLNUM, ANRM, RANK, RANK, A, LDA, $ INFO ) ELSE IF( IASCL.EQ.2 ) THEN - CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO ) + CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, + $ INFO ) CALL DLASCL( 'U', 0, 0, BIGNUM, ANRM, RANK, RANK, A, LDA, $ INFO ) END IF IF( IBSCL.EQ.1 ) THEN - CALL DLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL DLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) ELSE IF( IBSCL.EQ.2 ) THEN - CALL DLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL DLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) END IF * 100 CONTINUE diff --git a/SRC/DEPRECATED/dgeqpf.f b/SRC/DEPRECATED/dgeqpf.f index 69f9542acb..36f6fb50e9 100644 --- a/SRC/DEPRECATED/dgeqpf.f +++ b/SRC/DEPRECATED/dgeqpf.f @@ -253,7 +253,8 @@ SUBROUTINE DGEQPF( M, N, A, LDA, JPVT, TAU, WORK, INFO ) * Generate elementary reflector H(i) * IF( I.LT.M ) THEN - CALL DLARFG( M-I+1, A( I, I ), A( I+1, I ), 1, TAU( I ) ) + CALL DLARFG( M-I+1, A( I, I ), A( I+1, I ), 1, + $ TAU( I ) ) ELSE CALL DLARFG( 1, A( M, M ), A( M, M ), 1, TAU( M ) ) END IF @@ -264,8 +265,8 @@ SUBROUTINE DGEQPF( M, N, A, LDA, JPVT, TAU, WORK, INFO ) * AII = A( I, I ) A( I, I ) = ONE - CALL DLARF( 'LEFT', M-I+1, N-I, A( I, I ), 1, TAU( I ), - $ A( I, I+1 ), LDA, WORK( 2*N+1 ) ) + CALL DLARF( 'LEFT', M-I+1, N-I, A( I, I ), 1, + $ TAU( I ), A( I, I+1 ), LDA, WORK( 2*N+1 ) ) A( I, I ) = AII END IF * diff --git a/SRC/DEPRECATED/dggsvp.f b/SRC/DEPRECATED/dggsvp.f index 87a2fd670c..cef3b47524 100644 --- a/SRC/DEPRECATED/dggsvp.f +++ b/SRC/DEPRECATED/dggsvp.f @@ -392,8 +392,8 @@ SUBROUTINE DGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update Q := Q*Z**T * - CALL DORMR2( 'Right', 'Transpose', N, N, L, B, LDB, TAU, Q, - $ LDQ, WORK, INFO ) + CALL DORMR2( 'Right', 'Transpose', N, N, L, B, LDB, TAU, + $ Q, LDQ, WORK, INFO ) END IF * * Clean up B @@ -439,9 +439,10 @@ SUBROUTINE DGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * CALL DLASET( 'Full', M, M, ZERO, ZERO, U, LDU ) IF( M.GT.1 ) - $ CALL DLACPY( 'Lower', M-1, N-L, A( 2, 1 ), LDA, U( 2, 1 ), - $ LDU ) - CALL DORG2R( M, M, MIN( M, N-L ), U, LDU, TAU, WORK, INFO ) + $ CALL DLACPY( 'Lower', M-1, N-L, A( 2, 1 ), LDA, + $ U( 2, 1 ), LDU ) + CALL DORG2R( M, M, MIN( M, N-L ), U, LDU, TAU, WORK, + $ INFO ) END IF * IF( WANTQ ) THEN @@ -460,7 +461,8 @@ SUBROUTINE DGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, 90 CONTINUE 100 CONTINUE IF( M.GT.K ) - $ CALL DLASET( 'Full', M-K, N-L, ZERO, ZERO, A( K+1, 1 ), LDA ) + $ CALL DLASET( 'Full', M-K, N-L, ZERO, ZERO, A( K+1, 1 ), + $ LDA ) * IF( N-L.GT.K ) THEN * @@ -472,8 +474,8 @@ SUBROUTINE DGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update Q( 1:N,1:N-L ) = Q( 1:N,1:N-L )*Z1**T * - CALL DORMR2( 'Right', 'Transpose', N, N-L, K, A, LDA, TAU, - $ Q, LDQ, WORK, INFO ) + CALL DORMR2( 'Right', 'Transpose', N, N-L, K, A, LDA, + $ TAU, Q, LDQ, WORK, INFO ) END IF * * Clean up A @@ -497,9 +499,9 @@ SUBROUTINE DGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update U(:,K+1:M) := U(:,K+1:M)*U1 * - CALL DORM2R( 'Right', 'No transpose', M, M-K, MIN( M-K, L ), - $ A( K+1, N-L+1 ), LDA, TAU, U( 1, K+1 ), LDU, - $ WORK, INFO ) + CALL DORM2R( 'Right', 'No transpose', M, M-K, + $ MIN( M-K, L ), A( K+1, N-L+1 ), LDA, TAU, + $ U( 1, K+1 ), LDU, WORK, INFO ) END IF * * Clean up diff --git a/SRC/DEPRECATED/dlahrd.f b/SRC/DEPRECATED/dlahrd.f index 59406b7de7..2f86da73c0 100644 --- a/SRC/DEPRECATED/dlahrd.f +++ b/SRC/DEPRECATED/dlahrd.f @@ -221,8 +221,8 @@ SUBROUTINE DLAHRD( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY ) * w := V1**T * b1 * CALL DCOPY( I-1, A( K+1, I ), 1, T( 1, NB ), 1 ) - CALL DTRMV( 'Lower', 'Transpose', 'Unit', I-1, A( K+1, 1 ), - $ LDA, T( 1, NB ), 1 ) + CALL DTRMV( 'Lower', 'Transpose', 'Unit', I-1, + $ A( K+1, 1 ), LDA, T( 1, NB ), 1 ) * * w := w + V2**T *b2 * @@ -236,8 +236,9 @@ SUBROUTINE DLAHRD( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY ) * * b2 := b2 - V2*w * - CALL DGEMV( 'No transpose', N-K-I+1, I-1, -ONE, A( K+I, 1 ), - $ LDA, T( 1, NB ), 1, ONE, A( K+I, I ), 1 ) + CALL DGEMV( 'No transpose', N-K-I+1, I-1, -ONE, + $ A( K+I, 1 ), LDA, T( 1, NB ), 1, ONE, + $ A( K+I, I ), 1 ) * * b1 := b1 - V1*w * @@ -258,12 +259,12 @@ SUBROUTINE DLAHRD( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY ) * * Compute Y(1:n,i) * - CALL DGEMV( 'No transpose', N, N-K-I+1, ONE, A( 1, I+1 ), LDA, - $ A( K+I, I ), 1, ZERO, Y( 1, I ), 1 ) - CALL DGEMV( 'Transpose', N-K-I+1, I-1, ONE, A( K+I, 1 ), LDA, - $ A( K+I, I ), 1, ZERO, T( 1, I ), 1 ) - CALL DGEMV( 'No transpose', N, I-1, -ONE, Y, LDY, T( 1, I ), 1, - $ ONE, Y( 1, I ), 1 ) + CALL DGEMV( 'No transpose', N, N-K-I+1, ONE, A( 1, I+1 ), + $ LDA, A( K+I, I ), 1, ZERO, Y( 1, I ), 1 ) + CALL DGEMV( 'Transpose', N-K-I+1, I-1, ONE, A( K+I, 1 ), + $ LDA, A( K+I, I ), 1, ZERO, T( 1, I ), 1 ) + CALL DGEMV( 'No transpose', N, I-1, -ONE, Y, LDY, T( 1, I ), + $ 1, ONE, Y( 1, I ), 1 ) CALL DSCAL( N, TAU( I ), Y( 1, I ), 1 ) * * Compute T(1:i,i) diff --git a/SRC/DEPRECATED/dlatzm.f b/SRC/DEPRECATED/dlatzm.f index 1e8cc9f57f..5cb985d654 100644 --- a/SRC/DEPRECATED/dlatzm.f +++ b/SRC/DEPRECATED/dlatzm.f @@ -147,7 +147,8 @@ *> \ingroup doubleOTHERcomputational * * ===================================================================== - SUBROUTINE DLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK ) + SUBROUTINE DLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, + $ WORK ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -202,8 +203,8 @@ SUBROUTINE DLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK ) * w := C1 + C2 * v * CALL DCOPY( M, C1, 1, WORK, 1 ) - CALL DGEMV( 'No transpose', M, N-1, ONE, C2, LDC, V, INCV, ONE, - $ WORK, 1 ) + CALL DGEMV( 'No transpose', M, N-1, ONE, C2, LDC, V, INCV, + $ ONE, WORK, 1 ) * * [ C1, C2 ] := [ C1, C2 ] - tau* w * [ 1 , v**T] * diff --git a/SRC/DEPRECATED/dtzrqf.f b/SRC/DEPRECATED/dtzrqf.f index efd7c2497a..75f30d4804 100644 --- a/SRC/DEPRECATED/dtzrqf.f +++ b/SRC/DEPRECATED/dtzrqf.f @@ -194,7 +194,8 @@ SUBROUTINE DTZRQF( M, N, A, LDA, TAU, INFO ) * Use a Householder reflection to zero the kth row of A. * First set up the reflection. * - CALL DLARFG( N-M+1, A( K, K ), A( K, M1 ), LDA, TAU( K ) ) + CALL DLARFG( N-M+1, A( K, K ), A( K, M1 ), LDA, + $ TAU( K ) ) * IF( ( TAU( K ).NE.ZERO ) .AND. ( K.GT.1 ) ) THEN * @@ -216,8 +217,8 @@ SUBROUTINE DTZRQF( M, N, A, LDA, TAU, INFO ) * and B := B - tau*w*z( k )**T. * CALL DAXPY( K-1, -TAU( K ), TAU, 1, A( 1, K ), 1 ) - CALL DGER( K-1, N-M, -TAU( K ), TAU, 1, A( K, M1 ), LDA, - $ A( 1, M1 ), LDA ) + CALL DGER( K-1, N-M, -TAU( K ), TAU, 1, A( K, M1 ), + $ LDA, A( 1, M1 ), LDA ) END IF 20 CONTINUE END IF diff --git a/SRC/DEPRECATED/sgegs.f b/SRC/DEPRECATED/sgegs.f index 11ecc67acb..c45ddca1d8 100644 --- a/SRC/DEPRECATED/sgegs.f +++ b/SRC/DEPRECATED/sgegs.f @@ -358,7 +358,8 @@ SUBROUTINE SGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHAR, END IF * IF( ILASCL ) THEN - CALL SLASCL( 'G', -1, -1, ANRM, ANRMTO, N, N, A, LDA, IINFO ) + CALL SLASCL( 'G', -1, -1, ANRM, ANRMTO, N, N, A, LDA, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN @@ -378,7 +379,8 @@ SUBROUTINE SGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHAR, END IF * IF( ILBSCL ) THEN - CALL SLASCL( 'G', -1, -1, BNRM, BNRMTO, N, N, B, LDB, IINFO ) + CALL SLASCL( 'G', -1, -1, BNRM, BNRMTO, N, N, B, LDB, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN @@ -496,7 +498,8 @@ SUBROUTINE SGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHAR, * Undo scaling * IF( ILASCL ) THEN - CALL SLASCL( 'H', -1, -1, ANRMTO, ANRM, N, N, A, LDA, IINFO ) + CALL SLASCL( 'H', -1, -1, ANRMTO, ANRM, N, N, A, LDA, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN @@ -516,12 +519,14 @@ SUBROUTINE SGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHAR, END IF * IF( ILBSCL ) THEN - CALL SLASCL( 'U', -1, -1, BNRMTO, BNRM, N, N, B, LDB, IINFO ) + CALL SLASCL( 'U', -1, -1, BNRMTO, BNRM, N, N, B, LDB, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN END IF - CALL SLASCL( 'G', -1, -1, BNRMTO, BNRM, N, 1, BETA, N, IINFO ) + CALL SLASCL( 'G', -1, -1, BNRMTO, BNRM, N, 1, BETA, N, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN diff --git a/SRC/DEPRECATED/sgegv.f b/SRC/DEPRECATED/sgegv.f index 97556e3711..005af7589d 100644 --- a/SRC/DEPRECATED/sgegv.f +++ b/SRC/DEPRECATED/sgegv.f @@ -301,8 +301,9 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE SGEGV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI, - $ BETA, VL, LDVL, VR, LDVR, WORK, LWORK, INFO ) + SUBROUTINE SGEGV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, + $ ALPHAI, BETA, VL, LDVL, VR, LDVR, WORK, LWORK, + $ INFO ) * * -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/DEPRECATED/sgelqs.f b/SRC/DEPRECATED/sgelqs.f index 83afb4690b..330d4d5850 100644 --- a/SRC/DEPRECATED/sgelqs.f +++ b/SRC/DEPRECATED/sgelqs.f @@ -174,18 +174,19 @@ SUBROUTINE SGELQS( M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, * * Solve L*X = B(1:m,:) * - CALL STRSM( 'Left', 'Lower', 'No transpose', 'Non-unit', M, NRHS, - $ ONE, A, LDA, B, LDB ) + CALL STRSM( 'Left', 'Lower', 'No transpose', 'Non-unit', M, + $ NRHS, ONE, A, LDA, B, LDB ) * * Set B(m+1:n,:) to zero * IF( M.LT.N ) - $ CALL SLASET( 'Full', N-M, NRHS, ZERO, ZERO, B( M+1, 1 ), LDB ) + $ CALL SLASET( 'Full', N-M, NRHS, ZERO, ZERO, B( M+1, 1 ), + $ LDB ) * * B := Q' * B * - CALL SORMLQ( 'Left', 'Transpose', N, NRHS, M, A, LDA, TAU, B, LDB, - $ WORK, LWORK, INFO ) + CALL SORMLQ( 'Left', 'Transpose', N, NRHS, M, A, LDA, TAU, B, + $ LDB, WORK, LWORK, INFO ) * RETURN * diff --git a/SRC/DEPRECATED/sgelsx.f b/SRC/DEPRECATED/sgelsx.f index 2f132399b9..b3920d523c 100644 --- a/SRC/DEPRECATED/sgelsx.f +++ b/SRC/DEPRECATED/sgelsx.f @@ -173,8 +173,8 @@ *> \ingroup realGEsolve * * ===================================================================== - SUBROUTINE SGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, - $ WORK, INFO ) + SUBROUTINE SGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, + $ RANK, WORK, INFO ) * * -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -283,20 +283,23 @@ SUBROUTINE SGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * * Scale matrix norm up to SMLNUM * - CALL SLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, INFO ) + CALL SLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 1 ELSE IF( BNRM.GT.BIGNUM ) THEN * * Scale matrix norm down to BIGNUM * - CALL SLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, INFO ) + CALL SLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 2 END IF * * Compute QR factorization with column pivoting of A: * A * P = Q * R * - CALL SGEQPF( M, N, A, LDA, JPVT, WORK( 1 ), WORK( MN+1 ), INFO ) + CALL SGEQPF( M, N, A, LDA, JPVT, WORK( 1 ), WORK( MN+1 ), + $ INFO ) * * workspace 3*N. Details of Householder rotations stored * in WORK(1:MN). @@ -350,15 +353,15 @@ SUBROUTINE SGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * * B(1:M,1:NRHS) := Q**T * B(1:M,1:NRHS) * - CALL SORM2R( 'Left', 'Transpose', M, NRHS, MN, A, LDA, WORK( 1 ), - $ B, LDB, WORK( 2*MN+1 ), INFO ) + CALL SORM2R( 'Left', 'Transpose', M, NRHS, MN, A, LDA, + $ WORK( 1 ), B, LDB, WORK( 2*MN+1 ), INFO ) * * workspace NRHS * * B(1:RANK,1:NRHS) := inv(T11) * B(1:RANK,1:NRHS) * - CALL STRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', RANK, - $ NRHS, ONE, A, LDA, B, LDB ) + CALL STRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', + $ RANK, NRHS, ONE, A, LDA, B, LDB ) * DO 40 I = RANK + 1, N DO 30 J = 1, NRHS @@ -408,18 +411,22 @@ SUBROUTINE SGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * Undo scaling * IF( IASCL.EQ.1 ) THEN - CALL SLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO ) + CALL SLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, + $ INFO ) CALL SLASCL( 'U', 0, 0, SMLNUM, ANRM, RANK, RANK, A, LDA, $ INFO ) ELSE IF( IASCL.EQ.2 ) THEN - CALL SLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO ) + CALL SLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, + $ INFO ) CALL SLASCL( 'U', 0, 0, BIGNUM, ANRM, RANK, RANK, A, LDA, $ INFO ) END IF IF( IBSCL.EQ.1 ) THEN - CALL SLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL SLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) ELSE IF( IBSCL.EQ.2 ) THEN - CALL SLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL SLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) END IF * 100 CONTINUE diff --git a/SRC/DEPRECATED/sgeqpf.f b/SRC/DEPRECATED/sgeqpf.f index f5a2494691..7963bd8e7e 100644 --- a/SRC/DEPRECATED/sgeqpf.f +++ b/SRC/DEPRECATED/sgeqpf.f @@ -253,7 +253,8 @@ SUBROUTINE SGEQPF( M, N, A, LDA, JPVT, TAU, WORK, INFO ) * Generate elementary reflector H(i) * IF( I.LT.M ) THEN - CALL SLARFG( M-I+1, A( I, I ), A( I+1, I ), 1, TAU( I ) ) + CALL SLARFG( M-I+1, A( I, I ), A( I+1, I ), 1, + $ TAU( I ) ) ELSE CALL SLARFG( 1, A( M, M ), A( M, M ), 1, TAU( M ) ) END IF @@ -264,8 +265,8 @@ SUBROUTINE SGEQPF( M, N, A, LDA, JPVT, TAU, WORK, INFO ) * AII = A( I, I ) A( I, I ) = ONE - CALL SLARF( 'LEFT', M-I+1, N-I, A( I, I ), 1, TAU( I ), - $ A( I, I+1 ), LDA, WORK( 2*N+1 ) ) + CALL SLARF( 'LEFT', M-I+1, N-I, A( I, I ), 1, + $ TAU( I ), A( I, I+1 ), LDA, WORK( 2*N+1 ) ) A( I, I ) = AII END IF * diff --git a/SRC/DEPRECATED/sggsvp.f b/SRC/DEPRECATED/sggsvp.f index 4ecebdf14e..33fe6edb4f 100644 --- a/SRC/DEPRECATED/sggsvp.f +++ b/SRC/DEPRECATED/sggsvp.f @@ -392,8 +392,8 @@ SUBROUTINE SGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update Q := Q*Z**T * - CALL SORMR2( 'Right', 'Transpose', N, N, L, B, LDB, TAU, Q, - $ LDQ, WORK, INFO ) + CALL SORMR2( 'Right', 'Transpose', N, N, L, B, LDB, TAU, + $ Q, LDQ, WORK, INFO ) END IF * * Clean up B @@ -439,8 +439,8 @@ SUBROUTINE SGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * CALL SLASET( 'Full', M, M, ZERO, ZERO, U, LDU ) IF( M.GT.1 ) - $ CALL SLACPY( 'Lower', M-1, N-L, A( 2, 1 ), LDA, U( 2, 1 ), - $ LDU ) + $ CALL SLACPY( 'Lower', M-1, N-L, A( 2, 1 ), LDA, + $ U( 2, 1 ), LDU ) CALL SORG2R( M, M, MIN( M, N-L ), U, LDU, TAU, WORK, INFO ) END IF * @@ -460,7 +460,8 @@ SUBROUTINE SGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, 90 CONTINUE 100 CONTINUE IF( M.GT.K ) - $ CALL SLASET( 'Full', M-K, N-L, ZERO, ZERO, A( K+1, 1 ), LDA ) + $ CALL SLASET( 'Full', M-K, N-L, ZERO, ZERO, A( K+1, 1 ), + $ LDA ) * IF( N-L.GT.K ) THEN * @@ -472,8 +473,8 @@ SUBROUTINE SGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update Q( 1:N,1:N-L ) = Q( 1:N,1:N-L )*Z1**T * - CALL SORMR2( 'Right', 'Transpose', N, N-L, K, A, LDA, TAU, - $ Q, LDQ, WORK, INFO ) + CALL SORMR2( 'Right', 'Transpose', N, N-L, K, A, LDA, + $ TAU, Q, LDQ, WORK, INFO ) END IF * * Clean up A @@ -497,9 +498,9 @@ SUBROUTINE SGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update U(:,K+1:M) := U(:,K+1:M)*U1 * - CALL SORM2R( 'Right', 'No transpose', M, M-K, MIN( M-K, L ), - $ A( K+1, N-L+1 ), LDA, TAU, U( 1, K+1 ), LDU, - $ WORK, INFO ) + CALL SORM2R( 'Right', 'No transpose', M, M-K, + $ MIN( M-K, L ), A( K+1, N-L+1 ), LDA, TAU, + $ U( 1, K+1 ), LDU, WORK, INFO ) END IF * * Clean up diff --git a/SRC/DEPRECATED/slahrd.f b/SRC/DEPRECATED/slahrd.f index e7989b8eb8..63cf160b3a 100644 --- a/SRC/DEPRECATED/slahrd.f +++ b/SRC/DEPRECATED/slahrd.f @@ -221,8 +221,8 @@ SUBROUTINE SLAHRD( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY ) * w := V1**T * b1 * CALL SCOPY( I-1, A( K+1, I ), 1, T( 1, NB ), 1 ) - CALL STRMV( 'Lower', 'Transpose', 'Unit', I-1, A( K+1, 1 ), - $ LDA, T( 1, NB ), 1 ) + CALL STRMV( 'Lower', 'Transpose', 'Unit', I-1, + $ A( K+1, 1 ), LDA, T( 1, NB ), 1 ) * * w := w + V2**T *b2 * @@ -231,13 +231,14 @@ SUBROUTINE SLAHRD( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY ) * * w := T**T *w * - CALL STRMV( 'Upper', 'Transpose', 'Non-unit', I-1, T, LDT, - $ T( 1, NB ), 1 ) + CALL STRMV( 'Upper', 'Transpose', 'Non-unit', I-1, T, + $ LDT, T( 1, NB ), 1 ) * * b2 := b2 - V2*w * - CALL SGEMV( 'No transpose', N-K-I+1, I-1, -ONE, A( K+I, 1 ), - $ LDA, T( 1, NB ), 1, ONE, A( K+I, I ), 1 ) + CALL SGEMV( 'No transpose', N-K-I+1, I-1, -ONE, + $ A( K+I, 1 ), LDA, T( 1, NB ), 1, ONE, + $ A( K+I, I ), 1 ) * * b1 := b1 - V1*w * @@ -251,26 +252,26 @@ SUBROUTINE SLAHRD( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY ) * Generate the elementary reflector H(i) to annihilate * A(k+i+1:n,i) * - CALL SLARFG( N-K-I+1, A( K+I, I ), A( MIN( K+I+1, N ), I ), 1, - $ TAU( I ) ) + CALL SLARFG( N-K-I+1, A( K+I, I ), A( MIN( K+I+1, N ), I ), + $ 1, TAU( I ) ) EI = A( K+I, I ) A( K+I, I ) = ONE * * Compute Y(1:n,i) * - CALL SGEMV( 'No transpose', N, N-K-I+1, ONE, A( 1, I+1 ), LDA, - $ A( K+I, I ), 1, ZERO, Y( 1, I ), 1 ) - CALL SGEMV( 'Transpose', N-K-I+1, I-1, ONE, A( K+I, 1 ), LDA, - $ A( K+I, I ), 1, ZERO, T( 1, I ), 1 ) - CALL SGEMV( 'No transpose', N, I-1, -ONE, Y, LDY, T( 1, I ), 1, - $ ONE, Y( 1, I ), 1 ) + CALL SGEMV( 'No transpose', N, N-K-I+1, ONE, A( 1, I+1 ), + $ LDA, A( K+I, I ), 1, ZERO, Y( 1, I ), 1 ) + CALL SGEMV( 'Transpose', N-K-I+1, I-1, ONE, A( K+I, 1 ), + $ LDA, A( K+I, I ), 1, ZERO, T( 1, I ), 1 ) + CALL SGEMV( 'No transpose', N, I-1, -ONE, Y, LDY, T( 1, I ), + $ 1, ONE, Y( 1, I ), 1 ) CALL SSCAL( N, TAU( I ), Y( 1, I ), 1 ) * * Compute T(1:i,i) * CALL SSCAL( I-1, -TAU( I ), T( 1, I ), 1 ) - CALL STRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T, LDT, - $ T( 1, I ), 1 ) + CALL STRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T, + $ LDT, T( 1, I ), 1 ) T( I, I ) = TAU( I ) * 10 CONTINUE diff --git a/SRC/DEPRECATED/slatzm.f b/SRC/DEPRECATED/slatzm.f index bb24c281ba..4e3088427f 100644 --- a/SRC/DEPRECATED/slatzm.f +++ b/SRC/DEPRECATED/slatzm.f @@ -147,7 +147,8 @@ *> \ingroup realOTHERcomputational * * ===================================================================== - SUBROUTINE SLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK ) + SUBROUTINE SLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, + $ WORK ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -202,8 +203,8 @@ SUBROUTINE SLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK ) * w := C1 + C2 * v * CALL SCOPY( M, C1, 1, WORK, 1 ) - CALL SGEMV( 'No transpose', M, N-1, ONE, C2, LDC, V, INCV, ONE, - $ WORK, 1 ) + CALL SGEMV( 'No transpose', M, N-1, ONE, C2, LDC, V, INCV, + $ ONE, WORK, 1 ) * * [ C1, C2 ] := [ C1, C2 ] - tau* w * [ 1 , v**T] * diff --git a/SRC/DEPRECATED/stzrqf.f b/SRC/DEPRECATED/stzrqf.f index c2f55f367c..170798c777 100644 --- a/SRC/DEPRECATED/stzrqf.f +++ b/SRC/DEPRECATED/stzrqf.f @@ -194,7 +194,8 @@ SUBROUTINE STZRQF( M, N, A, LDA, TAU, INFO ) * Use a Householder reflection to zero the kth row of A. * First set up the reflection. * - CALL SLARFG( N-M+1, A( K, K ), A( K, M1 ), LDA, TAU( K ) ) + CALL SLARFG( N-M+1, A( K, K ), A( K, M1 ), LDA, + $ TAU( K ) ) * IF( ( TAU( K ).NE.ZERO ) .AND. ( K.GT.1 ) ) THEN * @@ -216,8 +217,8 @@ SUBROUTINE STZRQF( M, N, A, LDA, TAU, INFO ) * and B := B - tau*w*z( k )**T. * CALL SAXPY( K-1, -TAU( K ), TAU, 1, A( 1, K ), 1 ) - CALL SGER( K-1, N-M, -TAU( K ), TAU, 1, A( K, M1 ), LDA, - $ A( 1, M1 ), LDA ) + CALL SGER( K-1, N-M, -TAU( K ), TAU, 1, A( K, M1 ), + $ LDA, A( 1, M1 ), LDA ) END IF 20 CONTINUE END IF diff --git a/SRC/DEPRECATED/zgegs.f b/SRC/DEPRECATED/zgegs.f index 23f8d43d18..9ee4dac035 100644 --- a/SRC/DEPRECATED/zgegs.f +++ b/SRC/DEPRECATED/zgegs.f @@ -219,9 +219,9 @@ *> \ingroup complex16GEeigen * * ===================================================================== - SUBROUTINE ZGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHA, BETA, - $ VSL, LDVSL, VSR, LDVSR, WORK, LWORK, RWORK, - $ INFO ) + SUBROUTINE ZGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHA, + $ BETA, VSL, LDVSL, VSR, LDVSR, WORK, LWORK, + $ RWORK, INFO ) * * -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -360,7 +360,8 @@ SUBROUTINE ZGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHA, BETA, END IF * IF( ILASCL ) THEN - CALL ZLASCL( 'G', -1, -1, ANRM, ANRMTO, N, N, A, LDA, IINFO ) + CALL ZLASCL( 'G', -1, -1, ANRM, ANRMTO, N, N, A, LDA, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN @@ -380,7 +381,8 @@ SUBROUTINE ZGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHA, BETA, END IF * IF( ILBSCL ) THEN - CALL ZLASCL( 'G', -1, -1, BNRM, BNRMTO, N, N, B, LDB, IINFO ) + CALL ZLASCL( 'G', -1, -1, BNRM, BNRMTO, N, N, B, LDB, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN @@ -493,12 +495,14 @@ SUBROUTINE ZGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHA, BETA, * Undo scaling * IF( ILASCL ) THEN - CALL ZLASCL( 'U', -1, -1, ANRMTO, ANRM, N, N, A, LDA, IINFO ) + CALL ZLASCL( 'U', -1, -1, ANRMTO, ANRM, N, N, A, LDA, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN END IF - CALL ZLASCL( 'G', -1, -1, ANRMTO, ANRM, N, 1, ALPHA, N, IINFO ) + CALL ZLASCL( 'G', -1, -1, ANRMTO, ANRM, N, 1, ALPHA, N, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN @@ -506,12 +510,14 @@ SUBROUTINE ZGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHA, BETA, END IF * IF( ILBSCL ) THEN - CALL ZLASCL( 'U', -1, -1, BNRMTO, BNRM, N, N, B, LDB, IINFO ) + CALL ZLASCL( 'U', -1, -1, BNRMTO, BNRM, N, N, B, LDB, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN END IF - CALL ZLASCL( 'G', -1, -1, BNRMTO, BNRM, N, 1, BETA, N, IINFO ) + CALL ZLASCL( 'G', -1, -1, BNRMTO, BNRM, N, 1, BETA, N, + $ IINFO ) IF( IINFO.NE.0 ) THEN INFO = N + 9 RETURN diff --git a/SRC/DEPRECATED/zgelsx.f b/SRC/DEPRECATED/zgelsx.f index a879381968..e82fdb9bb0 100644 --- a/SRC/DEPRECATED/zgelsx.f +++ b/SRC/DEPRECATED/zgelsx.f @@ -179,8 +179,8 @@ *> \ingroup complex16GEsolve * * ===================================================================== - SUBROUTINE ZGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, - $ WORK, RWORK, INFO ) + SUBROUTINE ZGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, + $ RANK, WORK, RWORK, INFO ) * * -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -294,21 +294,23 @@ SUBROUTINE ZGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * * Scale matrix norm up to SMLNUM * - CALL ZLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, INFO ) + CALL ZLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 1 ELSE IF( BNRM.GT.BIGNUM ) THEN * * Scale matrix norm down to BIGNUM * - CALL ZLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, INFO ) + CALL ZLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, + $ INFO ) IBSCL = 2 END IF * * Compute QR factorization with column pivoting of A: * A * P = Q * R * - CALL ZGEQPF( M, N, A, LDA, JPVT, WORK( 1 ), WORK( MN+1 ), RWORK, - $ INFO ) + CALL ZGEQPF( M, N, A, LDA, JPVT, WORK( 1 ), WORK( MN+1 ), + $ RWORK, INFO ) * * complex workspace MN+N. Real workspace 2*N. Details of Householder * rotations stored in WORK(1:MN). @@ -362,8 +364,8 @@ SUBROUTINE ZGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * * B(1:M,1:NRHS) := Q**H * B(1:M,1:NRHS) * - CALL ZUNM2R( 'Left', 'Conjugate transpose', M, NRHS, MN, A, LDA, - $ WORK( 1 ), B, LDB, WORK( 2*MN+1 ), INFO ) + CALL ZUNM2R( 'Left', 'Conjugate transpose', M, NRHS, MN, A, + $ LDA, WORK( 1 ), B, LDB, WORK( 2*MN+1 ), INFO ) * * workspace NRHS * @@ -382,8 +384,8 @@ SUBROUTINE ZGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * IF( RANK.LT.N ) THEN DO 50 I = 1, RANK - CALL ZLATZM( 'Left', N-RANK+1, NRHS, A( I, RANK+1 ), LDA, - $ DCONJG( WORK( MN+I ) ), B( I, 1 ), + CALL ZLATZM( 'Left', N-RANK+1, NRHS, A( I, RANK+1 ), + $ LDA, DCONJG( WORK( MN+I ) ), B( I, 1 ), $ B( RANK+1, 1 ), LDB, WORK( 2*MN+1 ) ) 50 CONTINUE END IF @@ -420,18 +422,22 @@ SUBROUTINE ZGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK, * Undo scaling * IF( IASCL.EQ.1 ) THEN - CALL ZLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO ) + CALL ZLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, + $ INFO ) CALL ZLASCL( 'U', 0, 0, SMLNUM, ANRM, RANK, RANK, A, LDA, $ INFO ) ELSE IF( IASCL.EQ.2 ) THEN - CALL ZLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO ) + CALL ZLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, + $ INFO ) CALL ZLASCL( 'U', 0, 0, BIGNUM, ANRM, RANK, RANK, A, LDA, $ INFO ) END IF IF( IBSCL.EQ.1 ) THEN - CALL ZLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL ZLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) ELSE IF( IBSCL.EQ.2 ) THEN - CALL ZLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO ) + CALL ZLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, + $ INFO ) END IF * 100 CONTINUE diff --git a/SRC/DEPRECATED/zggsvp.f b/SRC/DEPRECATED/zggsvp.f index 6c37ec1089..eb582f0d40 100644 --- a/SRC/DEPRECATED/zggsvp.f +++ b/SRC/DEPRECATED/zggsvp.f @@ -385,7 +385,8 @@ SUBROUTINE ZGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, 30 CONTINUE 40 CONTINUE IF( P.GT.L ) - $ CALL ZLASET( 'Full', P-L, N, CZERO, CZERO, B( L+1, 1 ), LDB ) + $ CALL ZLASET( 'Full', P-L, N, CZERO, CZERO, B( L+1, 1 ), + $ LDB ) * IF( WANTQ ) THEN * @@ -403,8 +404,8 @@ SUBROUTINE ZGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update A := A*Z**H * - CALL ZUNMR2( 'Right', 'Conjugate transpose', M, N, L, B, LDB, - $ TAU, A, LDA, WORK, INFO ) + CALL ZUNMR2( 'Right', 'Conjugate transpose', M, N, L, B, + $ LDB, TAU, A, LDA, WORK, INFO ) IF( WANTQ ) THEN * * Update Q := Q*Z**H @@ -447,8 +448,9 @@ SUBROUTINE ZGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update A12 := U**H*A12, where A12 = A( 1:M, N-L+1:N ) * - CALL ZUNM2R( 'Left', 'Conjugate transpose', M, L, MIN( M, N-L ), - $ A, LDA, TAU, A( 1, N-L+1 ), LDA, WORK, INFO ) + CALL ZUNM2R( 'Left', 'Conjugate transpose', M, L, + $ MIN( M, N-L ), A, LDA, TAU, A( 1, N-L+1 ), LDA, + $ WORK, INFO ) * IF( WANTU ) THEN * @@ -456,9 +458,10 @@ SUBROUTINE ZGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * CALL ZLASET( 'Full', M, M, CZERO, CZERO, U, LDU ) IF( M.GT.1 ) - $ CALL ZLACPY( 'Lower', M-1, N-L, A( 2, 1 ), LDA, U( 2, 1 ), - $ LDU ) - CALL ZUNG2R( M, M, MIN( M, N-L ), U, LDU, TAU, WORK, INFO ) + $ CALL ZLACPY( 'Lower', M-1, N-L, A( 2, 1 ), LDA, + $ U( 2, 1 ), LDU ) + CALL ZUNG2R( M, M, MIN( M, N-L ), U, LDU, TAU, WORK, + $ INFO ) END IF * IF( WANTQ ) THEN @@ -477,7 +480,8 @@ SUBROUTINE ZGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, 90 CONTINUE 100 CONTINUE IF( M.GT.K ) - $ CALL ZLASET( 'Full', M-K, N-L, CZERO, CZERO, A( K+1, 1 ), LDA ) + $ CALL ZLASET( 'Full', M-K, N-L, CZERO, CZERO, A( K+1, 1 ), + $ LDA ) * IF( N-L.GT.K ) THEN * @@ -489,8 +493,8 @@ SUBROUTINE ZGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update Q( 1:N,1:N-L ) = Q( 1:N,1:N-L )*Z1**H * - CALL ZUNMR2( 'Right', 'Conjugate transpose', N, N-L, K, A, - $ LDA, TAU, Q, LDQ, WORK, INFO ) + CALL ZUNMR2( 'Right', 'Conjugate transpose', N, N-L, K, + $ A, LDA, TAU, Q, LDQ, WORK, INFO ) END IF * * Clean up A @@ -514,9 +518,9 @@ SUBROUTINE ZGGSVP( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB, * * Update U(:,K+1:M) := U(:,K+1:M)*U1 * - CALL ZUNM2R( 'Right', 'No transpose', M, M-K, MIN( M-K, L ), - $ A( K+1, N-L+1 ), LDA, TAU, U( 1, K+1 ), LDU, - $ WORK, INFO ) + CALL ZUNM2R( 'Right', 'No transpose', M, M-K, + $ MIN( M-K, L ), A( K+1, N-L+1 ), LDA, TAU, + $ U( 1, K+1 ), LDU, WORK, INFO ) END IF * * Clean up diff --git a/SRC/DEPRECATED/zlahrd.f b/SRC/DEPRECATED/zlahrd.f index 6cb3d2a3f3..3b23b3db60 100644 --- a/SRC/DEPRECATED/zlahrd.f +++ b/SRC/DEPRECATED/zlahrd.f @@ -236,13 +236,14 @@ SUBROUTINE ZLAHRD( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY ) * * w := T**H *w * - CALL ZTRMV( 'Upper', 'Conjugate transpose', 'Non-unit', I-1, - $ T, LDT, T( 1, NB ), 1 ) + CALL ZTRMV( 'Upper', 'Conjugate transpose', 'Non-unit', + $ I-1, T, LDT, T( 1, NB ), 1 ) * * b2 := b2 - V2*w * - CALL ZGEMV( 'No transpose', N-K-I+1, I-1, -ONE, A( K+I, 1 ), - $ LDA, T( 1, NB ), 1, ONE, A( K+I, I ), 1 ) + CALL ZGEMV( 'No transpose', N-K-I+1, I-1, -ONE, + $ A( K+I, 1 ), LDA, T( 1, NB ), 1, ONE, + $ A( K+I, I ), 1 ) * * b1 := b1 - V1*w * @@ -263,20 +264,20 @@ SUBROUTINE ZLAHRD( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY ) * * Compute Y(1:n,i) * - CALL ZGEMV( 'No transpose', N, N-K-I+1, ONE, A( 1, I+1 ), LDA, - $ A( K+I, I ), 1, ZERO, Y( 1, I ), 1 ) + CALL ZGEMV( 'No transpose', N, N-K-I+1, ONE, A( 1, I+1 ), + $ LDA, A( K+I, I ), 1, ZERO, Y( 1, I ), 1 ) CALL ZGEMV( 'Conjugate transpose', N-K-I+1, I-1, ONE, $ A( K+I, 1 ), LDA, A( K+I, I ), 1, ZERO, T( 1, I ), $ 1 ) - CALL ZGEMV( 'No transpose', N, I-1, -ONE, Y, LDY, T( 1, I ), 1, - $ ONE, Y( 1, I ), 1 ) + CALL ZGEMV( 'No transpose', N, I-1, -ONE, Y, LDY, T( 1, I ), + $ 1, ONE, Y( 1, I ), 1 ) CALL ZSCAL( N, TAU( I ), Y( 1, I ), 1 ) * * Compute T(1:i,i) * CALL ZSCAL( I-1, -TAU( I ), T( 1, I ), 1 ) - CALL ZTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T, LDT, - $ T( 1, I ), 1 ) + CALL ZTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T, + $ LDT, T( 1, I ), 1 ) T( I, I ) = TAU( I ) * 10 CONTINUE diff --git a/SRC/DEPRECATED/zlatzm.f b/SRC/DEPRECATED/zlatzm.f index c0986e1b8c..a9d0fd346c 100644 --- a/SRC/DEPRECATED/zlatzm.f +++ b/SRC/DEPRECATED/zlatzm.f @@ -148,7 +148,8 @@ *> \ingroup latzm * * ===================================================================== - SUBROUTINE ZLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK ) + SUBROUTINE ZLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, + $ WORK ) * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -206,8 +207,8 @@ SUBROUTINE ZLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK ) * w := C1 + C2 * v * CALL ZCOPY( M, C1, 1, WORK, 1 ) - CALL ZGEMV( 'No transpose', M, N-1, ONE, C2, LDC, V, INCV, ONE, - $ WORK, 1 ) + CALL ZGEMV( 'No transpose', M, N-1, ONE, C2, LDC, V, INCV, + $ ONE, WORK, 1 ) * * [ C1, C2 ] := [ C1, C2 ] - tau* w * [ 1 , v**H] * diff --git a/SRC/DEPRECATED/ztzrqf.f b/SRC/DEPRECATED/ztzrqf.f index dcd7cf45bf..9e0136e304 100644 --- a/SRC/DEPRECATED/ztzrqf.f +++ b/SRC/DEPRECATED/ztzrqf.f @@ -217,14 +217,15 @@ SUBROUTINE ZTZRQF( M, N, A, LDA, TAU, INFO ) * * Form w = a( k ) + B*z( k ) in TAU. * - CALL ZGEMV( 'No transpose', K-1, N-M, CONE, A( 1, M1 ), - $ LDA, A( K, M1 ), LDA, CONE, TAU, 1 ) + CALL ZGEMV( 'No transpose', K-1, N-M, CONE, + $ A( 1, M1 ), LDA, A( K, M1 ), LDA, CONE, TAU, + $ 1 ) * * Now form a( k ) := a( k ) - conjg(tau)*w * and B := B - conjg(tau)*w*z( k )**H. * - CALL ZAXPY( K-1, -DCONJG( TAU( K ) ), TAU, 1, A( 1, K ), - $ 1 ) + CALL ZAXPY( K-1, -DCONJG( TAU( K ) ), TAU, 1, + $ A( 1, K ), 1 ) CALL ZGERC( K-1, N-M, -DCONJG( TAU( K ) ), TAU, 1, $ A( K, M1 ), LDA, A( 1, M1 ), LDA ) END IF diff --git a/SRC/lapack_64.h b/SRC/lapack_64.h index 4d7318d978..e8000bf2c4 100644 --- a/SRC/lapack_64.h +++ b/SRC/lapack_64.h @@ -56,8 +56,10 @@ #define CGELQ CGELQ_64 #define CGELQ2 CGELQ2_64 #define CGELQF CGELQF_64 +#define CGELQS CGELQS_64 #define CGELQT CGELQT_64 #define CGELQT3 CGELQT3_64 +#define CGELRS CGELRS_64 #define CGELS CGELS_64 #define CGELSD CGELSD_64 #define CGELSS CGELSS_64 @@ -81,6 +83,7 @@ #define CGEQRF CGEQRF_64 #define CGEQRF CGEQRF_64 #define CGEQRFP CGEQRFP_64 +#define CGEQRS CGEQRS_64 #define CGEQRT CGEQRT_64 #define CGEQRT2 CGEQRT2_64 #define CGEQRT3 CGEQRT3_64 @@ -612,8 +615,10 @@ #define DGELQ DGELQ_64 #define DGELQ2 DGELQ2_64 #define DGELQF DGELQF_64 +#define DGELQS DGELQS_64 #define DGELQT DGELQT_64 #define DGELQT3 DGELQT3_64 +#define DGELRS DGELRS_64 #define DGELS DGELS_64 #define DGELSD DGELSD_64 #define DGELSS DGELSS_64 @@ -637,6 +642,7 @@ #define DGEQRF DGEQRF_64 #define DGEQRF DGEQRF_64 #define DGEQRFP DGEQRFP_64 +#define DGEQRS DGEQRS_64 #define DGEQRT DGEQRT_64 #define DGEQRT2 DGEQRT2_64 #define DGEQRT3 DGEQRT3_64 @@ -1205,8 +1211,10 @@ #define SGELQ2 SGELQ2_64 #define SGELQF SGELQF_64 #define SGELQT SGELQT_64 +#define SGELQS SGELQS_64 #define SGELQT3 SGELQT3_64 #define SGELS SGELS_64 +#define SGELRS SGELRS_64 #define SGELSD SGELSD_64 #define SGELSS SGELSS_64 #define SGELST SGELST_64 @@ -1229,6 +1237,7 @@ #define SGEQRF SGEQRF_64 #define SGEQRF SGEQRF_64 #define SGEQRFP SGEQRFP_64 +#define SGEQRS SGEQRS_64 #define SGEQRT SGEQRT_64 #define SGEQRT2 SGEQRT2_64 #define SGEQRT3 SGEQRT3_64 @@ -1763,9 +1772,11 @@ #define ZGELQ ZGELQ_64 #define ZGELQ2 ZGELQ2_64 #define ZGELQF ZGELQF_64 +#define ZGELQS ZGELQS_64 #define ZGELQT ZGELQT_64 #define ZGELQT3 ZGELQT3_64 #define ZGELS ZGELS_64 +#define ZGELRS ZGELRS_64 #define ZGELSD ZGELSD_64 #define ZGELSS ZGELSS_64 #define ZGELST ZGELST_64 @@ -1788,6 +1799,7 @@ #define ZGEQRF ZGEQRF_64 #define ZGEQRF ZGEQRF_64 #define ZGEQRFP ZGEQRFP_64 +#define ZGEQRS ZGEQRS_64 #define ZGEQRT ZGEQRT_64 #define ZGEQRT2 ZGEQRT2_64 #define ZGEQRT3 ZGEQRT3_64