diff options
Diffstat (limited to 'SRC/ztprfb.f')
| -rw-r--r-- | SRC/ztprfb.f | 182 |
1 files changed, 91 insertions, 91 deletions
diff --git a/SRC/ztprfb.f b/SRC/ztprfb.f index c46c2ef2..de6acdba 100644 --- a/SRC/ztprfb.f +++ b/SRC/ztprfb.f @@ -2,44 +2,44 @@ * * =========== 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 ZTPRFB + dependencies -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ztprfb.f"> -*> [TGZ]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ztprfb.f"> -*> [ZIP]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ztprfb.f"> +*> Download ZTPRFB + dependencies +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ztprfb.f"> +*> [TGZ]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ztprfb.f"> +*> [ZIP]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ztprfb.f"> *> [TXT]</a> -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * -* SUBROUTINE ZTPRFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, +* SUBROUTINE ZTPRFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, * V, LDV, T, LDT, A, LDA, B, LDB, WORK, LDWORK ) -* +* * .. Scalar Arguments .. * CHARACTER DIRECT, SIDE, STOREV, TRANS * INTEGER K, L, LDA, LDB, LDT, LDV, LDWORK, M, N * .. * .. Array Arguments .. -* COMPLEX*16 A( LDA, * ), B( LDB, * ), T( LDT, * ), +* COMPLEX*16 A( LDA, * ), B( LDB, * ), T( LDT, * ), * $ V( LDV, * ), WORK( LDWORK, * ) * .. -* +* * *> \par Purpose: * ============= *> *> \verbatim *> -*> ZTPRFB applies a complex "triangular-pentagonal" block reflector H or its -*> conjugate transpose H**H to a complex matrix C, which is composed of two +*> ZTPRFB applies a complex "triangular-pentagonal" block reflector H or its +*> conjugate transpose H**H to a complex matrix C, which is composed of two *> blocks A and B, either from the left or right. -*> +*> *> \endverbatim * * Arguments: @@ -80,14 +80,14 @@ *> \param[in] M *> \verbatim *> M is INTEGER -*> The number of rows of the matrix B. +*> The number of rows of the matrix B. *> M >= 0. *> \endverbatim *> *> \param[in] N *> \verbatim *> N is INTEGER -*> The number of columns of the matrix B. +*> The number of columns of the matrix B. *> N >= 0. *> \endverbatim *> @@ -95,14 +95,14 @@ *> \verbatim *> K is INTEGER *> The order of the matrix T, i.e. the number of elementary -*> reflectors whose product defines the block reflector. +*> reflectors whose product defines the block reflector. *> K >= 0. *> \endverbatim *> *> \param[in] L *> \verbatim *> L is INTEGER -*> The order of the trapezoidal part of V. +*> The order of the trapezoidal part of V. *> K >= L >= 0. See Further Details. *> \endverbatim *> @@ -129,13 +129,13 @@ *> \verbatim *> T is COMPLEX*16 array, dimension (LDT,K) *> The triangular K-by-K matrix T in the representation of the -*> block reflector. +*> block reflector. *> \endverbatim *> *> \param[in] LDT *> \verbatim *> LDT is INTEGER -*> The leading dimension of the array T. +*> The leading dimension of the array T. *> LDT >= K. *> \endverbatim *> @@ -144,16 +144,16 @@ *> A is COMPLEX*16 array, dimension *> (LDA,N) if SIDE = 'L' or (LDA,K) if SIDE = 'R' *> On entry, the K-by-N or M-by-K matrix A. -*> On exit, A is overwritten by the corresponding block of +*> On exit, A is overwritten by the corresponding block of *> H*C or H**H*C or C*H or C*H**H. See Further Details. *> \endverbatim *> *> \param[in] LDA *> \verbatim *> LDA is INTEGER -*> The leading dimension of the array A. +*> The leading dimension of the array A. *> If SIDE = 'L', LDC >= max(1,K); -*> If SIDE = 'R', LDC >= max(1,M). +*> If SIDE = 'R', LDC >= max(1,M). *> \endverbatim *> *> \param[in,out] B @@ -167,7 +167,7 @@ *> \param[in] LDB *> \verbatim *> LDB is INTEGER -*> The leading dimension of the array B. +*> The leading dimension of the array B. *> LDB >= max(1,M). *> \endverbatim *> @@ -182,17 +182,17 @@ *> \verbatim *> LDWORK is INTEGER *> The leading dimension of the array WORK. -*> If SIDE = 'L', LDWORK >= K; +*> If SIDE = 'L', LDWORK >= K; *> if SIDE = 'R', LDWORK >= M. *> \endverbatim * * Authors: * ======== * -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. * *> \date September 2012 * @@ -204,21 +204,21 @@ *> \verbatim *> *> The matrix C is a composite matrix formed from blocks A and B. -*> The block B is of size M-by-N; if SIDE = 'R', A is of size M-by-K, +*> The block B is of size M-by-N; if SIDE = 'R', A is of size M-by-K, *> and if SIDE = 'L', A is of size K-by-N. *> *> If SIDE = 'R' and DIRECT = 'F', C = [A B]. *> -*> If SIDE = 'L' and DIRECT = 'F', C = [A] +*> If SIDE = 'L' and DIRECT = 'F', C = [A] *> [B]. *> *> If SIDE = 'R' and DIRECT = 'B', C = [B A]. *> *> If SIDE = 'L' and DIRECT = 'B', C = [B] -*> [A]. +*> [A]. *> -*> The pentagonal matrix V is composed of a rectangular block V1 and a -*> trapezoidal block V2. The size of the trapezoidal block is determined by +*> The pentagonal matrix V is composed of a rectangular block V1 and a +*> trapezoidal block V2. The size of the trapezoidal block is determined by *> the parameter L, where 0<=L<=K. If L=K, the V2 block of V is triangular; *> if L=0, there is no trapezoidal block, thus V = V1 is rectangular. *> @@ -235,7 +235,7 @@ *> - V2 is lower trapezoidal (last L rows of K-by-K lower triangular) *> *> If DIRECT = 'B' and STOREV = 'R': V = [V2 V1] -*> +*> *> - V2 is upper trapezoidal (last L columns of K-by-K upper triangular) *> *> If STOREV = 'C' and SIDE = 'L', V is M-by-K with V2 L-by-K. @@ -248,7 +248,7 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZTPRFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, + SUBROUTINE ZTPRFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, $ V, LDV, T, LDT, A, LDA, B, LDB, WORK, LDWORK ) * * -- LAPACK auxiliary routine (version 3.4.2) -- @@ -261,7 +261,7 @@ INTEGER K, L, LDA, LDB, LDT, LDV, LDWORK, M, N * .. * .. Array Arguments .. - COMPLEX*16 A( LDA, * ), B( LDB, * ), T( LDT, * ), + COMPLEX*16 A( LDA, * ), B( LDB, * ), T( LDT, * ), $ V( LDV, * ), WORK( LDWORK, * ) * .. * @@ -325,7 +325,7 @@ END IF * * --------------------------------------------------------------------------- -* +* IF( COLUMN .AND. FORWARD .AND. LEFT ) THEN * * --------------------------------------------------------------------------- @@ -339,34 +339,34 @@ * H = I - W T W**H or H**H = I - W T**H W**H * * A = A - T (A + V**H B) or A = A - T**H (A + V**H B) -* B = B - V T (A + V**H B) or B = B - V T**H (A + V**H B) +* B = B - V T (A + V**H B) or B = B - V T**H (A + V**H B) * * --------------------------------------------------------------------------- * MP = MIN( M-L+1, M ) KP = MIN( L+1, K ) -* +* DO J = 1, N DO I = 1, L WORK( I, J ) = B( M-L+I, J ) END DO END DO CALL ZTRMM( 'L', 'U', 'C', 'N', L, N, ONE, V( MP, 1 ), LDV, - $ WORK, LDWORK ) - CALL ZGEMM( 'C', 'N', L, N, M-L, ONE, V, LDV, B, LDB, + $ WORK, LDWORK ) + CALL ZGEMM( 'C', 'N', L, N, M-L, ONE, V, LDV, B, LDB, $ ONE, WORK, LDWORK ) - CALL ZGEMM( 'C', 'N', K-L, N, M, ONE, V( 1, KP ), LDV, + CALL ZGEMM( 'C', 'N', K-L, N, M, ONE, V( 1, KP ), LDV, $ B, LDB, ZERO, WORK( KP, 1 ), LDWORK ) -* +* DO J = 1, N DO I = 1, K WORK( I, J ) = WORK( I, J ) + A( I, J ) END DO END DO * - CALL ZTRMM( 'L', 'U', TRANS, 'N', K, N, ONE, T, LDT, + CALL ZTRMM( 'L', 'U', TRANS, 'N', K, N, ONE, T, LDT, $ WORK, LDWORK ) -* +* DO J = 1, N DO I = 1, K A( I, J ) = A( I, J ) - WORK( I, J ) @@ -376,7 +376,7 @@ CALL ZGEMM( 'N', 'N', M-L, N, K, -ONE, V, LDV, WORK, LDWORK, $ ONE, B, LDB ) CALL ZGEMM( 'N', 'N', L, N, K-L, -ONE, V( MP, KP ), LDV, - $ WORK( KP, 1 ), LDWORK, ONE, B( MP, 1 ), LDB ) + $ WORK( KP, 1 ), LDWORK, ONE, B( MP, 1 ), LDB ) CALL ZTRMM( 'L', 'U', 'N', 'N', L, N, ONE, V( MP, 1 ), LDV, $ WORK, LDWORK ) DO J = 1, N @@ -386,7 +386,7 @@ END DO * * --------------------------------------------------------------------------- -* +* ELSE IF( COLUMN .AND. FORWARD .AND. RIGHT ) THEN * * --------------------------------------------------------------------------- @@ -405,7 +405,7 @@ * NP = MIN( N-L+1, N ) KP = MIN( L+1, K ) -* +* DO J = 1, L DO I = 1, M WORK( I, J ) = B( I, N-L+J ) @@ -413,20 +413,20 @@ END DO CALL ZTRMM( 'R', 'U', 'N', 'N', M, L, ONE, V( NP, 1 ), LDV, $ WORK, LDWORK ) - CALL ZGEMM( 'N', 'N', M, L, N-L, ONE, B, LDB, + CALL ZGEMM( 'N', 'N', M, L, N-L, ONE, B, LDB, $ V, LDV, ONE, WORK, LDWORK ) - CALL ZGEMM( 'N', 'N', M, K-L, N, ONE, B, LDB, + CALL ZGEMM( 'N', 'N', M, K-L, N, ONE, B, LDB, $ V( 1, KP ), LDV, ZERO, WORK( 1, KP ), LDWORK ) -* +* DO J = 1, K DO I = 1, M WORK( I, J ) = WORK( I, J ) + A( I, J ) END DO END DO * - CALL ZTRMM( 'R', 'U', TRANS, 'N', M, K, ONE, T, LDT, + CALL ZTRMM( 'R', 'U', TRANS, 'N', M, K, ONE, T, LDT, $ WORK, LDWORK ) -* +* DO J = 1, K DO I = 1, M A( I, J ) = A( I, J ) - WORK( I, J ) @@ -446,7 +446,7 @@ END DO * * --------------------------------------------------------------------------- -* +* ELSE IF( COLUMN .AND. BACKWARD .AND. LEFT ) THEN * * --------------------------------------------------------------------------- @@ -460,7 +460,7 @@ * H = I - W T W**H or H**H = I - W T**H W**H * * A = A - T (A + V**H B) or A = A - T**H (A + V**H B) -* B = B - V T (A + V**H B) or B = B - V T**H (A + V**H B) +* B = B - V T (A + V**H B) or B = B - V T**H (A + V**H B) * * --------------------------------------------------------------------------- * @@ -475,10 +475,10 @@ * CALL ZTRMM( 'L', 'L', 'C', 'N', L, N, ONE, V( 1, KP ), LDV, $ WORK( KP, 1 ), LDWORK ) - CALL ZGEMM( 'C', 'N', L, N, M-L, ONE, V( MP, KP ), LDV, + CALL ZGEMM( 'C', 'N', L, N, M-L, ONE, V( MP, KP ), LDV, $ B( MP, 1 ), LDB, ONE, WORK( KP, 1 ), LDWORK ) CALL ZGEMM( 'C', 'N', K-L, N, M, ONE, V, LDV, - $ B, LDB, ZERO, WORK, LDWORK ) + $ B, LDB, ZERO, WORK, LDWORK ) * DO J = 1, N DO I = 1, K @@ -486,16 +486,16 @@ END DO END DO * - CALL ZTRMM( 'L', 'L', TRANS, 'N', K, N, ONE, T, LDT, + CALL ZTRMM( 'L', 'L', TRANS, 'N', K, N, ONE, T, LDT, $ WORK, LDWORK ) -* +* DO J = 1, N DO I = 1, K A( I, J ) = A( I, J ) - WORK( I, J ) END DO END DO * - CALL ZGEMM( 'N', 'N', M-L, N, K, -ONE, V( MP, 1 ), LDV, + CALL ZGEMM( 'N', 'N', M-L, N, K, -ONE, V( MP, 1 ), LDV, $ WORK, LDWORK, ONE, B( MP, 1 ), LDB ) CALL ZGEMM( 'N', 'N', L, N, K-L, -ONE, V, LDV, $ WORK, LDWORK, ONE, B, LDB ) @@ -508,7 +508,7 @@ END DO * * --------------------------------------------------------------------------- -* +* ELSE IF( COLUMN .AND. BACKWARD .AND. RIGHT ) THEN * * --------------------------------------------------------------------------- @@ -527,7 +527,7 @@ * NP = MIN( L+1, N ) KP = MIN( K-L+1, K ) -* +* DO J = 1, L DO I = 1, M WORK( I, K-L+J ) = B( I, J ) @@ -535,20 +535,20 @@ END DO CALL ZTRMM( 'R', 'L', 'N', 'N', M, L, ONE, V( 1, KP ), LDV, $ WORK( 1, KP ), LDWORK ) - CALL ZGEMM( 'N', 'N', M, L, N-L, ONE, B( 1, NP ), LDB, + CALL ZGEMM( 'N', 'N', M, L, N-L, ONE, B( 1, NP ), LDB, $ V( NP, KP ), LDV, ONE, WORK( 1, KP ), LDWORK ) - CALL ZGEMM( 'N', 'N', M, K-L, N, ONE, B, LDB, + CALL ZGEMM( 'N', 'N', M, K-L, N, ONE, B, LDB, $ V, LDV, ZERO, WORK, LDWORK ) -* +* DO J = 1, K DO I = 1, M WORK( I, J ) = WORK( I, J ) + A( I, J ) END DO END DO * - CALL ZTRMM( 'R', 'L', TRANS, 'N', M, K, ONE, T, LDT, + CALL ZTRMM( 'R', 'L', TRANS, 'N', M, K, ONE, T, LDT, $ WORK, LDWORK ) -* +* DO J = 1, K DO I = 1, M A( I, J ) = A( I, J ) - WORK( I, J ) @@ -568,7 +568,7 @@ END DO * * --------------------------------------------------------------------------- -* +* ELSE IF( ROW .AND. FORWARD .AND. LEFT ) THEN * * --------------------------------------------------------------------------- @@ -581,7 +581,7 @@ * H = I - W**H T W or H**H = I - W**H T**H W * * A = A - T (A + V B) or A = A - T**H (A + V B) -* B = B - V**H T (A + V B) or B = B - V**H T**H (A + V B) +* B = B - V**H T (A + V B) or B = B - V**H T**H (A + V B) * * --------------------------------------------------------------------------- * @@ -592,12 +592,12 @@ DO I = 1, L WORK( I, J ) = B( M-L+I, J ) END DO - END DO + END DO CALL ZTRMM( 'L', 'L', 'N', 'N', L, N, ONE, V( 1, MP ), LDV, $ WORK, LDB ) - CALL ZGEMM( 'N', 'N', L, N, M-L, ONE, V, LDV,B, LDB, + CALL ZGEMM( 'N', 'N', L, N, M-L, ONE, V, LDV,B, LDB, $ ONE, WORK, LDWORK ) - CALL ZGEMM( 'N', 'N', K-L, N, M, ONE, V( KP, 1 ), LDV, + CALL ZGEMM( 'N', 'N', K-L, N, M, ONE, V( KP, 1 ), LDV, $ B, LDB, ZERO, WORK( KP, 1 ), LDWORK ) * DO J = 1, N @@ -606,7 +606,7 @@ END DO END DO * - CALL ZTRMM( 'L', 'U', TRANS, 'N', K, N, ONE, T, LDT, + CALL ZTRMM( 'L', 'U', TRANS, 'N', K, N, ONE, T, LDT, $ WORK, LDWORK ) * DO J = 1, N @@ -617,7 +617,7 @@ * CALL ZGEMM( 'C', 'N', M-L, N, K, -ONE, V, LDV, WORK, LDWORK, $ ONE, B, LDB ) - CALL ZGEMM( 'C', 'N', L, N, K-L, -ONE, V( KP, MP ), LDV, + CALL ZGEMM( 'C', 'N', L, N, K-L, -ONE, V( KP, MP ), LDV, $ WORK( KP, 1 ), LDWORK, ONE, B( MP, 1 ), LDB ) CALL ZTRMM( 'L', 'L', 'C', 'N', L, N, ONE, V( 1, MP ), LDV, $ WORK, LDWORK ) @@ -628,7 +628,7 @@ END DO * * --------------------------------------------------------------------------- -* +* ELSE IF( ROW .AND. FORWARD .AND. RIGHT ) THEN * * --------------------------------------------------------------------------- @@ -656,7 +656,7 @@ $ WORK, LDWORK ) CALL ZGEMM( 'N', 'C', M, L, N-L, ONE, B, LDB, V, LDV, $ ONE, WORK, LDWORK ) - CALL ZGEMM( 'N', 'C', M, K-L, N, ONE, B, LDB, + CALL ZGEMM( 'N', 'C', M, K-L, N, ONE, B, LDB, $ V( KP, 1 ), LDV, ZERO, WORK( 1, KP ), LDWORK ) * DO J = 1, K @@ -665,7 +665,7 @@ END DO END DO * - CALL ZTRMM( 'R', 'U', TRANS, 'N', M, K, ONE, T, LDT, + CALL ZTRMM( 'R', 'U', TRANS, 'N', M, K, ONE, T, LDT, $ WORK, LDWORK ) * DO J = 1, K @@ -674,10 +674,10 @@ END DO END DO * - CALL ZGEMM( 'N', 'N', M, N-L, K, -ONE, WORK, LDWORK, + CALL ZGEMM( 'N', 'N', M, N-L, K, -ONE, WORK, LDWORK, $ V, LDV, ONE, B, LDB ) CALL ZGEMM( 'N', 'N', M, L, K-L, -ONE, WORK( 1, KP ), LDWORK, - $ V( KP, NP ), LDV, ONE, B( 1, NP ), LDB ) + $ V( KP, NP ), LDV, ONE, B( 1, NP ), LDB ) CALL ZTRMM( 'R', 'L', 'N', 'N', M, L, ONE, V( 1, NP ), LDV, $ WORK, LDWORK ) DO J = 1, L @@ -687,7 +687,7 @@ END DO * * --------------------------------------------------------------------------- -* +* ELSE IF( ROW .AND. BACKWARD .AND. LEFT ) THEN * * --------------------------------------------------------------------------- @@ -700,7 +700,7 @@ * H = I - W**H T W or H**H = I - W**H T**H W * * A = A - T (A + V B) or A = A - T**H (A + V B) -* B = B - V**H T (A + V B) or B = B - V**H T**H (A + V B) +* B = B - V**H T (A + V B) or B = B - V**H T**H (A + V B) * * --------------------------------------------------------------------------- * @@ -736,10 +736,10 @@ * CALL ZGEMM( 'C', 'N', M-L, N, K, -ONE, V( 1, MP ), LDV, $ WORK, LDWORK, ONE, B( MP, 1 ), LDB ) - CALL ZGEMM( 'C', 'N', L, N, K-L, -ONE, V, LDV, + CALL ZGEMM( 'C', 'N', L, N, K-L, -ONE, V, LDV, $ WORK, LDWORK, ONE, B, LDB ) CALL ZTRMM( 'L', 'U', 'C', 'N', L, N, ONE, V( KP, 1 ), LDV, - $ WORK( KP, 1 ), LDWORK ) + $ WORK( KP, 1 ), LDWORK ) DO J = 1, N DO I = 1, L B( I, J ) = B( I, J ) - WORK( K-L+I, J ) @@ -747,7 +747,7 @@ END DO * * --------------------------------------------------------------------------- -* +* ELSE IF( ROW .AND. BACKWARD .AND. RIGHT ) THEN * * --------------------------------------------------------------------------- @@ -776,7 +776,7 @@ CALL ZGEMM( 'N', 'C', M, L, N-L, ONE, B( 1, NP ), LDB, $ V( KP, NP ), LDV, ONE, WORK( 1, KP ), LDWORK ) CALL ZGEMM( 'N', 'C', M, K-L, N, ONE, B, LDB, V, LDV, - $ ZERO, WORK, LDWORK ) + $ ZERO, WORK, LDWORK ) * DO J = 1, K DO I = 1, M @@ -784,7 +784,7 @@ END DO END DO * - CALL ZTRMM( 'R', 'L', TRANS, 'N', M, K, ONE, T, LDT, + CALL ZTRMM( 'R', 'L', TRANS, 'N', M, K, ONE, T, LDT, $ WORK, LDWORK ) * DO J = 1, K @@ -793,9 +793,9 @@ END DO END DO * - CALL ZGEMM( 'N', 'N', M, N-L, K, -ONE, WORK, LDWORK, + CALL ZGEMM( 'N', 'N', M, N-L, K, -ONE, WORK, LDWORK, $ V( 1, NP ), LDV, ONE, B( 1, NP ), LDB ) - CALL ZGEMM( 'N', 'N', M, L, K-L , -ONE, WORK, LDWORK, + CALL ZGEMM( 'N', 'N', M, L, K-L , -ONE, WORK, LDWORK, $ V, LDV, ONE, B, LDB ) CALL ZTRMM( 'R', 'U', 'N', 'N', M, L, ONE, V( KP, 1 ), LDV, $ WORK( 1, KP ), LDWORK ) |