--- rpl/lapack/lapack/zlahr2.f 2012/12/14 12:30:31 1.12 +++ rpl/lapack/lapack/zlahr2.f 2023/08/07 08:39:29 1.19 @@ -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 ZLAHR2 + dependencies -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download ZLAHR2 + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * * SUBROUTINE ZLAHR2( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY ) -* +* * .. Scalar Arguments .. * INTEGER K, LDA, LDT, LDY, N, NB * .. @@ -27,7 +27,7 @@ * COMPLEX*16 A( LDA, * ), T( LDT, NB ), TAU( NB ), * $ Y( LDY, NB ) * .. -* +* * *> \par Purpose: * ============= @@ -118,12 +118,10 @@ * Authors: * ======== * -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. -* -*> \date September 2012 +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. * *> \ingroup complex16OTHERauxiliary * @@ -164,11 +162,11 @@ *> modified element of the upper Hessenberg matrix H, and vi denotes an *> element of the vector defining H(i). *> -*> This subroutine is a slight modification of LAPACK-3.0's DLAHRD +*> This subroutine is a slight modification of LAPACK-3.0's ZLAHRD *> incorporating improvements proposed by Quintana-Orti and Van de *> Gejin. Note that the entries of A(1:K,2:NB) differ from those -*> returned by the original LAPACK-3.0's DLAHRD routine. (This -*> subroutine is not backward compatible with LAPACK-3.0's DLAHRD.) +*> returned by the original LAPACK-3.0's ZLAHRD routine. (This +*> subroutine is not backward compatible with LAPACK-3.0's ZLAHRD.) *> \endverbatim * *> \par References: @@ -181,10 +179,9 @@ * ===================================================================== SUBROUTINE ZLAHR2( N, K, NB, A, LDA, TAU, T, LDT, Y, LDY ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 * * .. Scalar Arguments .. INTEGER K, LDA, LDT, LDY, N, NB @@ -198,7 +195,7 @@ * * .. Parameters .. COMPLEX*16 ZERO, ONE - PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ), + PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ), $ ONE = ( 1.0D+0, 0.0D+0 ) ) * .. * .. Local Scalars .. @@ -226,10 +223,10 @@ * * Update I-th column of A - Y * V**H * - CALL ZLACGV( I-1, A( K+I-1, 1 ), LDA ) + CALL ZLACGV( I-1, A( K+I-1, 1 ), LDA ) CALL ZGEMV( 'NO TRANSPOSE', N-K, I-1, -ONE, Y(K+1,1), LDY, $ A( K+I-1, 1 ), LDA, ONE, A( K+1, I ), 1 ) - CALL ZLACGV( I-1, A( K+I-1, 1 ), LDA ) + CALL ZLACGV( I-1, A( K+I-1, 1 ), LDA ) * * Apply I - V * T**H * V**H to this column (call it b) from the * left, using the last column of T as workspace @@ -242,31 +239,31 @@ * w := V1**H * b1 * CALL ZCOPY( I-1, A( K+1, I ), 1, T( 1, NB ), 1 ) - CALL ZTRMV( 'Lower', 'Conjugate transpose', 'UNIT', + CALL ZTRMV( 'Lower', 'Conjugate transpose', 'UNIT', $ I-1, A( K+1, 1 ), $ LDA, T( 1, NB ), 1 ) * * w := w + V2**H * b2 * - CALL ZGEMV( 'Conjugate transpose', N-K-I+1, I-1, + CALL ZGEMV( 'Conjugate transpose', N-K-I+1, I-1, $ ONE, A( K+I, 1 ), $ LDA, A( K+I, I ), 1, ONE, T( 1, NB ), 1 ) * * w := T**H * w * - CALL ZTRMV( 'Upper', 'Conjugate transpose', 'NON-UNIT', + 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, + 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 * - CALL ZTRMV( 'Lower', 'NO TRANSPOSE', + CALL ZTRMV( 'Lower', 'NO TRANSPOSE', $ 'UNIT', I-1, $ A( K+1, 1 ), LDA, T( 1, NB ), 1 ) CALL ZAXPY( I-1, -ONE, T( 1, NB ), 1, A( K+1, I ), 1 ) @@ -284,13 +281,13 @@ * * Compute Y(K+1:N,I) * - CALL ZGEMV( 'NO TRANSPOSE', N-K, N-K-I+1, + CALL ZGEMV( 'NO TRANSPOSE', N-K, N-K-I+1, $ ONE, A( K+1, I+1 ), $ LDA, A( K+I, I ), 1, ZERO, Y( K+1, I ), 1 ) - CALL ZGEMV( 'Conjugate transpose', N-K-I+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-K, I-1, -ONE, + CALL ZGEMV( 'NO TRANSPOSE', N-K, I-1, -ONE, $ Y( K+1, 1 ), LDY, $ T( 1, I ), 1, ONE, Y( K+1, I ), 1 ) CALL ZSCAL( N-K, TAU( I ), Y( K+1, I ), 1 ) @@ -298,7 +295,7 @@ * Compute T(1:I,I) * CALL ZSCAL( I-1, -TAU( I ), T( 1, I ), 1 ) - CALL ZTRMV( 'Upper', 'No Transpose', 'NON-UNIT', + CALL ZTRMV( 'Upper', 'No Transpose', 'NON-UNIT', $ I-1, T, LDT, $ T( 1, I ), 1 ) T( I, I ) = TAU( I ) @@ -309,15 +306,15 @@ * Compute Y(1:K,1:NB) * CALL ZLACPY( 'ALL', K, NB, A( 1, 2 ), LDA, Y, LDY ) - CALL ZTRMM( 'RIGHT', 'Lower', 'NO TRANSPOSE', + CALL ZTRMM( 'RIGHT', 'Lower', 'NO TRANSPOSE', $ 'UNIT', K, NB, $ ONE, A( K+1, 1 ), LDA, Y, LDY ) IF( N.GT.K+NB ) - $ CALL ZGEMM( 'NO TRANSPOSE', 'NO TRANSPOSE', K, + $ CALL ZGEMM( 'NO TRANSPOSE', 'NO TRANSPOSE', K, $ NB, N-K-NB, ONE, $ A( 1, 2+NB ), LDA, A( K+1+NB, 1 ), LDA, ONE, Y, $ LDY ) - CALL ZTRMM( 'RIGHT', 'Upper', 'NO TRANSPOSE', + CALL ZTRMM( 'RIGHT', 'Upper', 'NO TRANSPOSE', $ 'NON-UNIT', K, NB, $ ONE, T, LDT, Y, LDY ) *