--- rpl/lapack/lapack/dsfrk.f 2010/08/13 21:03:57 1.3
+++ rpl/lapack/lapack/dsfrk.f 2012/12/14 12:30:27 1.10
@@ -1,15 +1,176 @@
- SUBROUTINE DSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA,
- + C )
+*> \brief \b DSFRK performs a symmetric rank-k operation for matrix in RFP format.
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DSFRK + dependencies
+*>
+*> [TGZ]
+*>
+*> [ZIP]
+*>
+*> [TXT]
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE DSFRK( 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 ..
+* DOUBLE PRECISION A( LDA, * ), C( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> Level 3 BLAS like routine for C in RFP Format.
+*>
+*> DSFRK performs one of the symmetric rank--k operations
+*>
+*> C := alpha*A*A**T + beta*C,
+*>
+*> or
+*>
+*> C := alpha*A**T*A + beta*C,
+*>
+*> where alpha and beta are real scalars, C is an n--by--n symmetric
+*> 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.2.2) --
+*> \param[in] TRANSR
+*> \verbatim
+*> TRANSR is CHARACTER*1
+*> = 'N': The Normal Form of RFP A is stored;
+*> = 'T': The 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**T + beta*C.
+*>
+*> TRANS = 'T' or 't' C := alpha*A**T*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 = 'T'
+*> or 't', 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 DOUBLE PRECISION 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 DOUBLE PRECISION array, dimension (NT)
+*> NT = N*(N+1)/2. On entry, the symmetric matrix C in RFP
+*> Format. RFP Format is described by TRANSR, UPLO and N.
+*> \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 --
-* -- June 2010 --
+*> \date September 2012
*
+*> \ingroup doubleOTHERcomputational
+*
+* =====================================================================
+ SUBROUTINE DSFRK( TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA,
+ $ C )
+*
+* -- LAPACK computational routine (version 3.4.2) --
* -- 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 ..
DOUBLE PRECISION ALPHA, BETA
INTEGER K, LDA, N
@@ -19,95 +180,7 @@
DOUBLE PRECISION A( LDA, * ), C( * )
* ..
*
-* Purpose
-* =======
-*
-* Level 3 BLAS like routine for C in RFP Format.
-*
-* DSFRK performs one of the symmetric rank--k operations
-*
-* C := alpha*A*A' + beta*C,
-*
-* or
-*
-* C := alpha*A'*A + beta*C,
-*
-* where alpha and beta are real scalars, C is an n--by--n symmetric
-* 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
-* = 'N': The Normal Form of RFP A is stored;
-* = 'T': The Transpose Form of RFP A is stored.
-*
-* UPLO (input) CHARACTER
-* 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
-* On entry, TRANS specifies the operation to be performed as
-* follows:
-*
-* TRANS = 'N' or 'n' C := alpha*A*A' + beta*C.
-*
-* TRANS = 'T' or 't' C := alpha*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 = 'T'
-* or 't', 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) DOUBLE PRECISION 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.
-*
-* 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) DOUBLE PRECISION array, dimension (NT)
-* NT = N*(N+1)/2. On entry, the symmetric matrix C in RFP
-* Format. RFP Format is described by TRANSR, UPLO and N.
-*
-* Arguments
-* ==========
+* =====================================================================
*
* ..
* .. Parameters ..
@@ -167,7 +240,7 @@
* done (it is in DSYRK 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 )
@@ -211,22 +284,22 @@
* N is odd, TRANSR = 'N', UPLO = 'L', and TRANS = 'N'
*
CALL DSYRK( 'L', 'N', N1, K, ALPHA, A( 1, 1 ), LDA,
- + BETA, C( 1 ), N )
+ $ BETA, C( 1 ), N )
CALL DSYRK( 'U', 'N', N2, K, ALPHA, A( N1+1, 1 ), LDA,
- + BETA, C( N+1 ), N )
+ $ BETA, C( N+1 ), N )
CALL DGEMM( 'N', 'T', N2, N1, K, ALPHA, A( N1+1, 1 ),
- + LDA, A( 1, 1 ), LDA, BETA, C( N1+1 ), N )
+ $ LDA, A( 1, 1 ), LDA, BETA, C( N1+1 ), N )
*
ELSE
*
* N is odd, TRANSR = 'N', UPLO = 'L', and TRANS = 'T'
*
CALL DSYRK( 'L', 'T', N1, K, ALPHA, A( 1, 1 ), LDA,
- + BETA, C( 1 ), N )
+ $ BETA, C( 1 ), N )
CALL DSYRK( 'U', 'T', N2, K, ALPHA, A( 1, N1+1 ), LDA,
- + BETA, C( N+1 ), N )
+ $ BETA, C( N+1 ), N )
CALL DGEMM( 'T', 'N', N2, N1, K, ALPHA, A( 1, N1+1 ),
- + LDA, A( 1, 1 ), LDA, BETA, C( N1+1 ), N )
+ $ LDA, A( 1, 1 ), LDA, BETA, C( N1+1 ), N )
*
END IF
*
@@ -239,22 +312,22 @@
* N is odd, TRANSR = 'N', UPLO = 'U', and TRANS = 'N'
*
CALL DSYRK( 'L', 'N', N1, K, ALPHA, A( 1, 1 ), LDA,
- + BETA, C( N2+1 ), N )
+ $ BETA, C( N2+1 ), N )
CALL DSYRK( 'U', 'N', N2, K, ALPHA, A( N2, 1 ), LDA,
- + BETA, C( N1+1 ), N )
+ $ BETA, C( N1+1 ), N )
CALL DGEMM( 'N', 'T', N1, N2, K, ALPHA, A( 1, 1 ),
- + LDA, A( N2, 1 ), LDA, BETA, C( 1 ), N )
+ $ LDA, A( N2, 1 ), LDA, BETA, C( 1 ), N )
*
ELSE
*
* N is odd, TRANSR = 'N', UPLO = 'U', and TRANS = 'T'
*
CALL DSYRK( 'L', 'T', N1, K, ALPHA, A( 1, 1 ), LDA,
- + BETA, C( N2+1 ), N )
+ $ BETA, C( N2+1 ), N )
CALL DSYRK( 'U', 'T', N2, K, ALPHA, A( 1, N2 ), LDA,
- + BETA, C( N1+1 ), N )
+ $ BETA, C( N1+1 ), N )
CALL DGEMM( 'T', 'N', N1, N2, K, ALPHA, A( 1, 1 ),
- + LDA, A( 1, N2 ), LDA, BETA, C( 1 ), N )
+ $ LDA, A( 1, N2 ), LDA, BETA, C( 1 ), N )
*
END IF
*
@@ -273,24 +346,24 @@
* N is odd, TRANSR = 'T', UPLO = 'L', and TRANS = 'N'
*
CALL DSYRK( 'U', 'N', N1, K, ALPHA, A( 1, 1 ), LDA,
- + BETA, C( 1 ), N1 )
+ $ BETA, C( 1 ), N1 )
CALL DSYRK( 'L', 'N', N2, K, ALPHA, A( N1+1, 1 ), LDA,
- + BETA, C( 2 ), N1 )
+ $ BETA, C( 2 ), N1 )
CALL DGEMM( 'N', 'T', N1, N2, K, ALPHA, A( 1, 1 ),
- + LDA, A( N1+1, 1 ), LDA, BETA,
- + C( N1*N1+1 ), N1 )
+ $ LDA, A( N1+1, 1 ), LDA, BETA,
+ $ C( N1*N1+1 ), N1 )
*
ELSE
*
* N is odd, TRANSR = 'T', UPLO = 'L', and TRANS = 'T'
*
CALL DSYRK( 'U', 'T', N1, K, ALPHA, A( 1, 1 ), LDA,
- + BETA, C( 1 ), N1 )
+ $ BETA, C( 1 ), N1 )
CALL DSYRK( 'L', 'T', N2, K, ALPHA, A( 1, N1+1 ), LDA,
- + BETA, C( 2 ), N1 )
+ $ BETA, C( 2 ), N1 )
CALL DGEMM( 'T', 'N', N1, N2, K, ALPHA, A( 1, 1 ),
- + LDA, A( 1, N1+1 ), LDA, BETA,
- + C( N1*N1+1 ), N1 )
+ $ LDA, A( 1, N1+1 ), LDA, BETA,
+ $ C( N1*N1+1 ), N1 )
*
END IF
*
@@ -303,22 +376,22 @@
* N is odd, TRANSR = 'T', UPLO = 'U', and TRANS = 'N'
*
CALL DSYRK( 'U', 'N', N1, K, ALPHA, A( 1, 1 ), LDA,
- + BETA, C( N2*N2+1 ), N2 )
+ $ BETA, C( N2*N2+1 ), N2 )
CALL DSYRK( 'L', 'N', N2, K, ALPHA, A( N1+1, 1 ), LDA,
- + BETA, C( N1*N2+1 ), N2 )
+ $ BETA, C( N1*N2+1 ), N2 )
CALL DGEMM( 'N', 'T', N2, N1, K, ALPHA, A( N1+1, 1 ),
- + LDA, A( 1, 1 ), LDA, BETA, C( 1 ), N2 )
+ $ LDA, A( 1, 1 ), LDA, BETA, C( 1 ), N2 )
*
ELSE
*
* N is odd, TRANSR = 'T', UPLO = 'U', and TRANS = 'T'
*
CALL DSYRK( 'U', 'T', N1, K, ALPHA, A( 1, 1 ), LDA,
- + BETA, C( N2*N2+1 ), N2 )
+ $ BETA, C( N2*N2+1 ), N2 )
CALL DSYRK( 'L', 'T', N2, K, ALPHA, A( 1, N1+1 ), LDA,
- + BETA, C( N1*N2+1 ), N2 )
+ $ BETA, C( N1*N2+1 ), N2 )
CALL DGEMM( 'T', 'N', N2, N1, K, ALPHA, A( 1, N1+1 ),
- + LDA, A( 1, 1 ), LDA, BETA, C( 1 ), N2 )
+ $ LDA, A( 1, 1 ), LDA, BETA, C( 1 ), N2 )
*
END IF
*
@@ -343,24 +416,24 @@
* N is even, TRANSR = 'N', UPLO = 'L', and TRANS = 'N'
*
CALL DSYRK( 'L', 'N', NK, K, ALPHA, A( 1, 1 ), LDA,
- + BETA, C( 2 ), N+1 )
+ $ BETA, C( 2 ), N+1 )
CALL DSYRK( 'U', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA,
- + BETA, C( 1 ), N+1 )
+ $ BETA, C( 1 ), N+1 )
CALL DGEMM( 'N', 'T', NK, NK, K, ALPHA, A( NK+1, 1 ),
- + LDA, A( 1, 1 ), LDA, BETA, C( NK+2 ),
- + N+1 )
+ $ LDA, A( 1, 1 ), LDA, BETA, C( NK+2 ),
+ $ N+1 )
*
ELSE
*
* N is even, TRANSR = 'N', UPLO = 'L', and TRANS = 'T'
*
CALL DSYRK( 'L', 'T', NK, K, ALPHA, A( 1, 1 ), LDA,
- + BETA, C( 2 ), N+1 )
+ $ BETA, C( 2 ), N+1 )
CALL DSYRK( 'U', 'T', NK, K, ALPHA, A( 1, NK+1 ), LDA,
- + BETA, C( 1 ), N+1 )
+ $ BETA, C( 1 ), N+1 )
CALL DGEMM( 'T', 'N', NK, NK, K, ALPHA, A( 1, NK+1 ),
- + LDA, A( 1, 1 ), LDA, BETA, C( NK+2 ),
- + N+1 )
+ $ LDA, A( 1, 1 ), LDA, BETA, C( NK+2 ),
+ $ N+1 )
*
END IF
*
@@ -373,24 +446,24 @@
* N is even, TRANSR = 'N', UPLO = 'U', and TRANS = 'N'
*
CALL DSYRK( 'L', 'N', NK, K, ALPHA, A( 1, 1 ), LDA,
- + BETA, C( NK+2 ), N+1 )
+ $ BETA, C( NK+2 ), N+1 )
CALL DSYRK( 'U', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA,
- + BETA, C( NK+1 ), N+1 )
+ $ BETA, C( NK+1 ), N+1 )
CALL DGEMM( 'N', 'T', NK, NK, K, ALPHA, A( 1, 1 ),
- + LDA, A( NK+1, 1 ), LDA, BETA, C( 1 ),
- + N+1 )
+ $ LDA, A( NK+1, 1 ), LDA, BETA, C( 1 ),
+ $ N+1 )
*
ELSE
*
* N is even, TRANSR = 'N', UPLO = 'U', and TRANS = 'T'
*
CALL DSYRK( 'L', 'T', NK, K, ALPHA, A( 1, 1 ), LDA,
- + BETA, C( NK+2 ), N+1 )
+ $ BETA, C( NK+2 ), N+1 )
CALL DSYRK( 'U', 'T', NK, K, ALPHA, A( 1, NK+1 ), LDA,
- + BETA, C( NK+1 ), N+1 )
+ $ BETA, C( NK+1 ), N+1 )
CALL DGEMM( 'T', 'N', NK, NK, K, ALPHA, A( 1, 1 ),
- + LDA, A( 1, NK+1 ), LDA, BETA, C( 1 ),
- + N+1 )
+ $ LDA, A( 1, NK+1 ), LDA, BETA, C( 1 ),
+ $ N+1 )
*
END IF
*
@@ -409,24 +482,24 @@
* N is even, TRANSR = 'T', UPLO = 'L', and TRANS = 'N'
*
CALL DSYRK( 'U', 'N', NK, K, ALPHA, A( 1, 1 ), LDA,
- + BETA, C( NK+1 ), NK )
+ $ BETA, C( NK+1 ), NK )
CALL DSYRK( 'L', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA,
- + BETA, C( 1 ), NK )
+ $ BETA, C( 1 ), NK )
CALL DGEMM( 'N', 'T', NK, NK, K, ALPHA, A( 1, 1 ),
- + LDA, A( NK+1, 1 ), LDA, BETA,
- + C( ( ( NK+1 )*NK )+1 ), NK )
+ $ LDA, A( NK+1, 1 ), LDA, BETA,
+ $ C( ( ( NK+1 )*NK )+1 ), NK )
*
ELSE
*
* N is even, TRANSR = 'T', UPLO = 'L', and TRANS = 'T'
*
CALL DSYRK( 'U', 'T', NK, K, ALPHA, A( 1, 1 ), LDA,
- + BETA, C( NK+1 ), NK )
+ $ BETA, C( NK+1 ), NK )
CALL DSYRK( 'L', 'T', NK, K, ALPHA, A( 1, NK+1 ), LDA,
- + BETA, C( 1 ), NK )
+ $ BETA, C( 1 ), NK )
CALL DGEMM( 'T', 'N', NK, NK, K, ALPHA, A( 1, 1 ),
- + LDA, A( 1, NK+1 ), LDA, BETA,
- + C( ( ( NK+1 )*NK )+1 ), NK )
+ $ LDA, A( 1, NK+1 ), LDA, BETA,
+ $ C( ( ( NK+1 )*NK )+1 ), NK )
*
END IF
*
@@ -439,22 +512,22 @@
* N is even, TRANSR = 'T', UPLO = 'U', and TRANS = 'N'
*
CALL DSYRK( 'U', 'N', NK, K, ALPHA, A( 1, 1 ), LDA,
- + BETA, C( NK*( NK+1 )+1 ), NK )
+ $ BETA, C( NK*( NK+1 )+1 ), NK )
CALL DSYRK( 'L', 'N', NK, K, ALPHA, A( NK+1, 1 ), LDA,
- + BETA, C( NK*NK+1 ), NK )
+ $ BETA, C( NK*NK+1 ), NK )
CALL DGEMM( 'N', 'T', NK, NK, K, ALPHA, A( NK+1, 1 ),
- + LDA, A( 1, 1 ), LDA, BETA, C( 1 ), NK )
+ $ LDA, A( 1, 1 ), LDA, BETA, C( 1 ), NK )
*
ELSE
*
* N is even, TRANSR = 'T', UPLO = 'U', and TRANS = 'T'
*
CALL DSYRK( 'U', 'T', NK, K, ALPHA, A( 1, 1 ), LDA,
- + BETA, C( NK*( NK+1 )+1 ), NK )
+ $ BETA, C( NK*( NK+1 )+1 ), NK )
CALL DSYRK( 'L', 'T', NK, K, ALPHA, A( 1, NK+1 ), LDA,
- + BETA, C( NK*NK+1 ), NK )
+ $ BETA, C( NK*NK+1 ), NK )
CALL DGEMM( 'T', 'N', NK, NK, K, ALPHA, A( 1, NK+1 ),
- + LDA, A( 1, 1 ), LDA, BETA, C( 1 ), NK )
+ $ LDA, A( 1, 1 ), LDA, BETA, C( 1 ), NK )
*
END IF
*