--- rpl/lapack/lapack/zhfrk.f 2010/12/21 13:53:47 1.5
+++ rpl/lapack/lapack/zhfrk.f 2023/08/07 08:39:25 1.18
@@ -1,15 +1,175 @@
- SUBROUTINE ZHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA,
- + C )
+*> \brief \b ZHFRK performs a Hermitian rank-k operation for matrix in RFP format.
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZHFRK + dependencies
+*>
+*> [TGZ]
+*>
+*> [ZIP]
+*>
+*> [TXT]
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA,
+* C )
+*
+* .. Scalar Arguments ..
+* DOUBLE PRECISION ALPHA, BETA
+* INTEGER K, LDA, N
+* CHARACTER TRANS, TRANSR, UPLO
+* ..
+* .. Array Arguments ..
+* COMPLEX*16 A( LDA, * ), C( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> Level 3 BLAS like routine for C in RFP Format.
+*>
+*> ZHFRK performs one of the Hermitian rank--k operations
+*>
+*> C := alpha*A*A**H + beta*C,
+*>
+*> or
+*>
+*> C := alpha*A**H*A + beta*C,
+*>
+*> where alpha and beta are real scalars, C is an n--by--n Hermitian
+*> matrix and A is an n--by--k matrix in the first case and a k--by--n
+*> matrix in the second case.
+*> \endverbatim
+*
+* Arguments:
+* ==========
*
-* -- LAPACK routine (version 3.3.0) --
+*> \param[in] TRANSR
+*> \verbatim
+*> TRANSR is CHARACTER*1
+*> = 'N': The Normal Form of RFP A is stored;
+*> = 'C': The Conjugate-transpose Form of RFP A is stored.
+*> \endverbatim
+*>
+*> \param[in] UPLO
+*> \verbatim
+*> UPLO is CHARACTER*1
+*> On entry, UPLO specifies whether the upper or lower
+*> triangular part of the array C is to be referenced as
+*> follows:
+*>
+*> UPLO = 'U' or 'u' Only the upper triangular part of C
+*> is to be referenced.
+*>
+*> UPLO = 'L' or 'l' Only the lower triangular part of C
+*> is to be referenced.
+*>
+*> Unchanged on exit.
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*> TRANS is CHARACTER*1
+*> On entry, TRANS specifies the operation to be performed as
+*> follows:
+*>
+*> TRANS = 'N' or 'n' C := alpha*A*A**H + beta*C.
+*>
+*> TRANS = 'C' or 'c' C := alpha*A**H*A + beta*C.
+*>
+*> Unchanged on exit.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> On entry, N specifies the order of the matrix C. N must be
+*> at least zero.
+*> Unchanged on exit.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*> K is INTEGER
+*> On entry with TRANS = 'N' or 'n', K specifies the number
+*> of columns of the matrix A, and on entry with
+*> TRANS = 'C' or 'c', K specifies the number of rows of the
+*> matrix A. K must be at least zero.
+*> Unchanged on exit.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*> ALPHA is DOUBLE PRECISION
+*> On entry, ALPHA specifies the scalar alpha.
+*> Unchanged on exit.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*> A is COMPLEX*16 array, dimension (LDA,ka)
+*> where KA
+*> is K when TRANS = 'N' or 'n', and is N otherwise. Before
+*> entry with TRANS = 'N' or 'n', the leading N--by--K part of
+*> the array A must contain the matrix A, otherwise the leading
+*> K--by--N part of the array A must contain the matrix A.
+*> Unchanged on exit.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> On entry, LDA specifies the first dimension of A as declared
+*> in the calling (sub) program. When TRANS = 'N' or 'n'
+*> then LDA must be at least max( 1, n ), otherwise LDA must
+*> be at least max( 1, k ).
+*> Unchanged on exit.
+*> \endverbatim
+*>
+*> \param[in] BETA
+*> \verbatim
+*> BETA is DOUBLE PRECISION
+*> On entry, BETA specifies the scalar beta.
+*> Unchanged on exit.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*> C is COMPLEX*16 array, dimension (N*(N+1)/2)
+*> On entry, the matrix A in RFP Format. RFP Format is
+*> described by TRANSR, UPLO and N. Note that the imaginary
+*> parts of the diagonal elements need not be set, they are
+*> assumed to be zero, and on exit they are set to zero.
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
*
-* -- Contributed by Julien Langou of the Univ. of Colorado Denver --
-* November 2010
+*> \ingroup complex16OTHERcomputational
*
+* =====================================================================
+ SUBROUTINE ZHFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA,
+ $ C )
+*
+* -- LAPACK computational routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
-* ..
* .. Scalar Arguments ..
DOUBLE PRECISION ALPHA, BETA
INTEGER K, LDA, N
@@ -19,98 +179,8 @@
COMPLEX*16 A( LDA, * ), C( * )
* ..
*
-* Purpose
-* =======
-*
-* Level 3 BLAS like routine for C in RFP Format.
-*
-* ZHFRK performs one of the Hermitian rank--k operations
+* =====================================================================
*
-* C := alpha*A*conjg( A' ) + beta*C,
-*
-* or
-*
-* C := alpha*conjg( A' )*A + beta*C,
-*
-* where alpha and beta are real scalars, C is an n--by--n Hermitian
-* matrix and A is an n--by--k matrix in the first case and a k--by--n
-* matrix in the second case.
-*
-* Arguments
-* ==========
-*
-* TRANSR (input) CHARACTER*1
-* = 'N': The Normal Form of RFP A is stored;
-* = 'C': The Conjugate-transpose Form of RFP A is stored.
-*
-* UPLO (input) CHARACTER*1
-* On entry, UPLO specifies whether the upper or lower
-* triangular part of the array C is to be referenced as
-* follows:
-*
-* UPLO = 'U' or 'u' Only the upper triangular part of C
-* is to be referenced.
-*
-* UPLO = 'L' or 'l' Only the lower triangular part of C
-* is to be referenced.
-*
-* Unchanged on exit.
-*
-* TRANS (input) CHARACTER*1
-* On entry, TRANS specifies the operation to be performed as
-* follows:
-*
-* TRANS = 'N' or 'n' C := alpha*A*conjg( A' ) + beta*C.
-*
-* TRANS = 'C' or 'c' C := alpha*conjg( A' )*A + beta*C.
-*
-* Unchanged on exit.
-*
-* N (input) INTEGER
-* On entry, N specifies the order of the matrix C. N must be
-* at least zero.
-* Unchanged on exit.
-*
-* K (input) INTEGER
-* On entry with TRANS = 'N' or 'n', K specifies the number
-* of columns of the matrix A, and on entry with
-* TRANS = 'C' or 'c', K specifies the number of rows of the
-* matrix A. K must be at least zero.
-* Unchanged on exit.
-*
-* ALPHA (input) DOUBLE PRECISION
-* On entry, ALPHA specifies the scalar alpha.
-* Unchanged on exit.
-*
-* A (input) COMPLEX*16 array of DIMENSION (LDA,ka)
-* where KA
-* is K when TRANS = 'N' or 'n', and is N otherwise. Before
-* entry with TRANS = 'N' or 'n', the leading N--by--K part of
-* the array A must contain the matrix A, otherwise the leading
-* K--by--N part of the array A must contain the matrix A.
-* Unchanged on exit.
-*
-* LDA (input) INTEGER
-* On entry, LDA specifies the first dimension of A as declared
-* in the calling (sub) program. When TRANS = 'N' or 'n'
-* then LDA must be at least max( 1, n ), otherwise LDA must
-* be at least max( 1, k ).
-* Unchanged on exit.
-*
-* BETA (input) DOUBLE PRECISION
-* On entry, BETA specifies the scalar beta.
-* Unchanged on exit.
-*
-* C (input/output) COMPLEX*16 array, dimension (N*(N+1)/2)
-* On entry, the matrix A in RFP Format. RFP Format is
-* described by TRANSR, UPLO and N. Note that the imaginary
-* parts of the diagonal elements need not be set, they are
-* assumed to be zero, and on exit they are set to zero.
-*
-* Arguments
-* ==========
-*
-* ..
* .. Parameters ..
DOUBLE PRECISION ONE, ZERO
COMPLEX*16 CZERO
@@ -172,7 +242,7 @@
* done (it is in ZHERK for example) and left in the general case.
*
IF( ( N.EQ.0 ) .OR. ( ( ( ALPHA.EQ.ZERO ) .OR. ( K.EQ.0 ) ) .AND.
- + ( BETA.EQ.ONE ) ) )RETURN
+ $ ( BETA.EQ.ONE ) ) )RETURN
*
IF( ( ALPHA.EQ.ZERO ) .AND. ( BETA.EQ.ZERO ) ) THEN
DO J = 1, ( ( N*( N+1 ) ) / 2 )
@@ -219,22 +289,22 @@
* N is odd, TRANSR = 'N', UPLO = 'L', and TRANS = 'N'
*
CALL ZHERK( 'L', 'N', N1, K, ALPHA, A( 1, 1 ), LDA,
- + BETA, C( 1 ), N )
+ $ BETA, C( 1 ), N )
CALL ZHERK( 'U', 'N', N2, K, ALPHA, A( N1+1, 1 ), LDA,
- + BETA, C( N+1 ), N )
+ $ BETA, C( N+1 ), N )
CALL ZGEMM( 'N', 'C', N2, N1, K, CALPHA, A( N1+1, 1 ),
- + LDA, A( 1, 1 ), LDA, CBETA, C( N1+1 ), N )
+ $ LDA, A( 1, 1 ), LDA, CBETA, C( N1+1 ), N )
*
ELSE
*
* N is odd, TRANSR = 'N', UPLO = 'L', and TRANS = 'C'
*
CALL ZHERK( 'L', 'C', N1, K, ALPHA, A( 1, 1 ), LDA,
- + BETA, C( 1 ), N )
+ $ BETA, C( 1 ), N )
CALL ZHERK( 'U', 'C', N2, K, ALPHA, A( 1, N1+1 ), LDA,
- + BETA, C( N+1 ), N )
+ $ BETA, C( N+1 ), N )
CALL ZGEMM( 'C', 'N', N2, N1, K, CALPHA, A( 1, N1+1 ),
- + LDA, A( 1, 1 ), LDA, CBETA, C( N1+1 ), N )
+ $ LDA, A( 1, 1 ), LDA, CBETA, C( N1+1 ), N )
*
END IF
*
@@ -247,22 +317,22 @@
* N is odd, TRANSR = 'N', UPLO = 'U', and TRANS = 'N'
*
CALL ZHERK( 'L', 'N', N1, K, ALPHA, A( 1, 1 ), LDA,
- + BETA, C( N2+1 ), N )
+ $ BETA, C( N2+1 ), N )
CALL ZHERK( 'U', 'N', N2, K, ALPHA, A( N2, 1 ), LDA,
- + BETA, C( N1+1 ), N )
+ $ BETA, C( N1+1 ), N )
CALL ZGEMM( 'N', 'C', N1, N2, K, CALPHA, A( 1, 1 ),
- + LDA, A( N2, 1 ), LDA, CBETA, C( 1 ), N )
+ $ LDA, A( N2, 1 ), LDA, CBETA, C( 1 ), N )
*
ELSE
*
* N is odd, TRANSR = 'N', UPLO = 'U', and TRANS = 'C'
*
CALL ZHERK( 'L', 'C', N1, K, ALPHA, A( 1, 1 ), LDA,
- + BETA, C( N2+1 ), N )
+ $ BETA, C( N2+1 ), N )
CALL ZHERK( 'U', 'C', N2, K, ALPHA, A( 1, N2 ), LDA,
- + BETA, C( N1+1 ), N )
+ $ BETA, C( N1+1 ), N )
CALL ZGEMM( 'C', 'N', N1, N2, K, CALPHA, A( 1, 1 ),
- + LDA, A( 1, N2 ), LDA, CBETA, C( 1 ), N )
+ $ LDA, A( 1, N2 ), LDA, CBETA, C( 1 ), N )
*
END IF
*
@@ -281,24 +351,24 @@
* N is odd, TRANSR = 'C', UPLO = 'L', and TRANS = 'N'
*
CALL ZHERK( 'U', 'N', N1, K, ALPHA, A( 1, 1 ), LDA,
- + BETA, C( 1 ), N1 )
+ $ BETA, C( 1 ), N1 )
CALL ZHERK( 'L', 'N', N2, K, ALPHA, A( N1+1, 1 ), LDA,
- + BETA, C( 2 ), N1 )
+ $ BETA, C( 2 ), N1 )
CALL ZGEMM( 'N', 'C', N1, N2, K, CALPHA, A( 1, 1 ),
- + LDA, A( N1+1, 1 ), LDA, CBETA,
- + C( N1*N1+1 ), N1 )
+ $ LDA, A( N1+1, 1 ), LDA, CBETA,
+ $ C( N1*N1+1 ), N1 )
*
ELSE
*
* N is odd, TRANSR = 'C', UPLO = 'L', and TRANS = 'C'
*
CALL ZHERK( 'U', 'C', N1, K, ALPHA, A( 1, 1 ), LDA,
- + BETA, C( 1 ), N1 )
+ $ BETA, C( 1 ), N1 )
CALL ZHERK( 'L', 'C', N2, K, ALPHA, A( 1, N1+1 ), LDA,
- + BETA, C( 2 ), N1 )
+ $ BETA, C( 2 ), N1 )
CALL ZGEMM( 'C', 'N', N1, N2, K, CALPHA, A( 1, 1 ),
- + LDA, A( 1, N1+1 ), LDA, CBETA,
- + C( N1*N1+1 ), N1 )
+ $ LDA, A( 1, N1+1 ), LDA, CBETA,
+ $ C( N1*N1+1 ), N1 )
*
END IF
*
@@ -311,22 +381,22 @@
* N is odd, TRANSR = 'C', UPLO = 'U', and TRANS = 'N'
*
CALL ZHERK( 'U', 'N', N1, K, ALPHA, A( 1, 1 ), LDA,
- + BETA, C( N2*N2+1 ), N2 )
+ $ BETA, C( N2*N2+1 ), N2 )
CALL ZHERK( 'L', 'N', N2, K, ALPHA, A( N1+1, 1 ), LDA,
- + BETA, C( N1*N2+1 ), N2 )
+ $ BETA, C( N1*N2+1 ), N2 )
CALL ZGEMM( 'N', 'C', N2, N1, K, CALPHA, A( N1+1, 1 ),
- + LDA, A( 1, 1 ), LDA, CBETA, C( 1 ), N2 )
+ $ LDA, A( 1, 1 ), LDA, CBETA, C( 1 ), N2 )
*
ELSE
*
* N is odd, TRANSR = 'C', UPLO = 'U', and TRANS = 'C'
*
CALL ZHERK( 'U', 'C', N1, K, ALPHA, A( 1, 1 ), LDA,
- + BETA, C( N2*N2+1 ), N2 )
+ $ BETA, C( N2*N2+1 ), N2 )
CALL ZHERK( 'L', 'C', N2, K, ALPHA, A( 1, N1+1 ), LDA,
- + BETA, C( N1*N2+1 ), N2 )
+ $ BETA, C( N1*N2+1 ), N2 )
CALL ZGEMM( 'C', 'N', N2, N1, K, CALPHA, A( 1, N1+1 ),
- + LDA, A( 1, 1 ), LDA, CBETA, C( 1 ), N2 )
+ $ LDA, A( 1, 1 ), LDA, CBETA, C( 1 ), N2 )
*
END IF
*
@@ -351,24 +421,24 @@
* N is even, TRANSR = 'N', UPLO = 'L', and TRANS = 'N'
*
CALL ZHERK( 'L', 'N', NK, K, ALPHA, A( 1, 1 ), LDA,
- + BETA, C( 2 ), N+1 )
+ $ BETA, C( 2 ), N+1 )
CALL ZHERK( 'U', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA,
- + BETA, C( 1 ), N+1 )
+ $ BETA, C( 1 ), N+1 )
CALL ZGEMM( 'N', 'C', NK, NK, K, CALPHA, A( NK+1, 1 ),
- + LDA, A( 1, 1 ), LDA, CBETA, C( NK+2 ),
- + N+1 )
+ $ LDA, A( 1, 1 ), LDA, CBETA, C( NK+2 ),
+ $ N+1 )
*
ELSE
*
* N is even, TRANSR = 'N', UPLO = 'L', and TRANS = 'C'
*
CALL ZHERK( 'L', 'C', NK, K, ALPHA, A( 1, 1 ), LDA,
- + BETA, C( 2 ), N+1 )
+ $ BETA, C( 2 ), N+1 )
CALL ZHERK( 'U', 'C', NK, K, ALPHA, A( 1, NK+1 ), LDA,
- + BETA, C( 1 ), N+1 )
+ $ BETA, C( 1 ), N+1 )
CALL ZGEMM( 'C', 'N', NK, NK, K, CALPHA, A( 1, NK+1 ),
- + LDA, A( 1, 1 ), LDA, CBETA, C( NK+2 ),
- + N+1 )
+ $ LDA, A( 1, 1 ), LDA, CBETA, C( NK+2 ),
+ $ N+1 )
*
END IF
*
@@ -381,24 +451,24 @@
* N is even, TRANSR = 'N', UPLO = 'U', and TRANS = 'N'
*
CALL ZHERK( 'L', 'N', NK, K, ALPHA, A( 1, 1 ), LDA,
- + BETA, C( NK+2 ), N+1 )
+ $ BETA, C( NK+2 ), N+1 )
CALL ZHERK( 'U', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA,
- + BETA, C( NK+1 ), N+1 )
+ $ BETA, C( NK+1 ), N+1 )
CALL ZGEMM( 'N', 'C', NK, NK, K, CALPHA, A( 1, 1 ),
- + LDA, A( NK+1, 1 ), LDA, CBETA, C( 1 ),
- + N+1 )
+ $ LDA, A( NK+1, 1 ), LDA, CBETA, C( 1 ),
+ $ N+1 )
*
ELSE
*
* N is even, TRANSR = 'N', UPLO = 'U', and TRANS = 'C'
*
CALL ZHERK( 'L', 'C', NK, K, ALPHA, A( 1, 1 ), LDA,
- + BETA, C( NK+2 ), N+1 )
+ $ BETA, C( NK+2 ), N+1 )
CALL ZHERK( 'U', 'C', NK, K, ALPHA, A( 1, NK+1 ), LDA,
- + BETA, C( NK+1 ), N+1 )
+ $ BETA, C( NK+1 ), N+1 )
CALL ZGEMM( 'C', 'N', NK, NK, K, CALPHA, A( 1, 1 ),
- + LDA, A( 1, NK+1 ), LDA, CBETA, C( 1 ),
- + N+1 )
+ $ LDA, A( 1, NK+1 ), LDA, CBETA, C( 1 ),
+ $ N+1 )
*
END IF
*
@@ -417,24 +487,24 @@
* N is even, TRANSR = 'C', UPLO = 'L', and TRANS = 'N'
*
CALL ZHERK( 'U', 'N', NK, K, ALPHA, A( 1, 1 ), LDA,
- + BETA, C( NK+1 ), NK )
+ $ BETA, C( NK+1 ), NK )
CALL ZHERK( 'L', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA,
- + BETA, C( 1 ), NK )
+ $ BETA, C( 1 ), NK )
CALL ZGEMM( 'N', 'C', NK, NK, K, CALPHA, A( 1, 1 ),
- + LDA, A( NK+1, 1 ), LDA, CBETA,
- + C( ( ( NK+1 )*NK )+1 ), NK )
+ $ LDA, A( NK+1, 1 ), LDA, CBETA,
+ $ C( ( ( NK+1 )*NK )+1 ), NK )
*
ELSE
*
* N is even, TRANSR = 'C', UPLO = 'L', and TRANS = 'C'
*
CALL ZHERK( 'U', 'C', NK, K, ALPHA, A( 1, 1 ), LDA,
- + BETA, C( NK+1 ), NK )
+ $ BETA, C( NK+1 ), NK )
CALL ZHERK( 'L', 'C', NK, K, ALPHA, A( 1, NK+1 ), LDA,
- + BETA, C( 1 ), NK )
+ $ BETA, C( 1 ), NK )
CALL ZGEMM( 'C', 'N', NK, NK, K, CALPHA, A( 1, 1 ),
- + LDA, A( 1, NK+1 ), LDA, CBETA,
- + C( ( ( NK+1 )*NK )+1 ), NK )
+ $ LDA, A( 1, NK+1 ), LDA, CBETA,
+ $ C( ( ( NK+1 )*NK )+1 ), NK )
*
END IF
*
@@ -447,22 +517,22 @@
* N is even, TRANSR = 'C', UPLO = 'U', and TRANS = 'N'
*
CALL ZHERK( 'U', 'N', NK, K, ALPHA, A( 1, 1 ), LDA,
- + BETA, C( NK*( NK+1 )+1 ), NK )
+ $ BETA, C( NK*( NK+1 )+1 ), NK )
CALL ZHERK( 'L', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA,
- + BETA, C( NK*NK+1 ), NK )
+ $ BETA, C( NK*NK+1 ), NK )
CALL ZGEMM( 'N', 'C', NK, NK, K, CALPHA, A( NK+1, 1 ),
- + LDA, A( 1, 1 ), LDA, CBETA, C( 1 ), NK )
+ $ LDA, A( 1, 1 ), LDA, CBETA, C( 1 ), NK )
*
ELSE
*
* N is even, TRANSR = 'C', UPLO = 'U', and TRANS = 'C'
*
CALL ZHERK( 'U', 'C', NK, K, ALPHA, A( 1, 1 ), LDA,
- + BETA, C( NK*( NK+1 )+1 ), NK )
+ $ BETA, C( NK*( NK+1 )+1 ), NK )
CALL ZHERK( 'L', 'C', NK, K, ALPHA, A( 1, NK+1 ), LDA,
- + BETA, C( NK*NK+1 ), NK )
+ $ BETA, C( NK*NK+1 ), NK )
CALL ZGEMM( 'C', 'N', NK, NK, K, CALPHA, A( 1, NK+1 ),
- + LDA, A( 1, 1 ), LDA, CBETA, C( 1 ), NK )
+ $ LDA, A( 1, 1 ), LDA, CBETA, C( 1 ), NK )
*
END IF
*