177 lines
		
	
	
		
			4.7 KiB
		
	
	
	
		
			Fortran
		
	
	
	
			
		
		
	
	
			177 lines
		
	
	
		
			4.7 KiB
		
	
	
	
		
			Fortran
		
	
	
	
| *> \brief \b CTRTTP copies a triangular matrix from the standard full format (TR) to the standard packed format (TP).
 | |
| *
 | |
| *  =========== DOCUMENTATION ===========
 | |
| *
 | |
| * Online html documentation available at
 | |
| *            http://www.netlib.org/lapack/explore-html/
 | |
| *
 | |
| *> \htmlonly
 | |
| *> Download CTRTTP + dependencies
 | |
| *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ctrttp.f">
 | |
| *> [TGZ]</a>
 | |
| *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ctrttp.f">
 | |
| *> [ZIP]</a>
 | |
| *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ctrttp.f">
 | |
| *> [TXT]</a>
 | |
| *> \endhtmlonly
 | |
| *
 | |
| *  Definition:
 | |
| *  ===========
 | |
| *
 | |
| *       SUBROUTINE CTRTTP( UPLO, N, A, LDA, AP, INFO )
 | |
| *
 | |
| *       .. Scalar Arguments ..
 | |
| *       CHARACTER          UPLO
 | |
| *       INTEGER            INFO, N, LDA
 | |
| *       ..
 | |
| *       .. Array Arguments ..
 | |
| *       COMPLEX            A( LDA, * ), AP( * )
 | |
| *       ..
 | |
| *
 | |
| *
 | |
| *> \par Purpose:
 | |
| *  =============
 | |
| *>
 | |
| *> \verbatim
 | |
| *>
 | |
| *> CTRTTP copies a triangular matrix A from full format (TR) to standard
 | |
| *> packed format (TP).
 | |
| *> \endverbatim
 | |
| *
 | |
| *  Arguments:
 | |
| *  ==========
 | |
| *
 | |
| *> \param[in] UPLO
 | |
| *> \verbatim
 | |
| *>          UPLO is CHARACTER*1
 | |
| *>          = 'U':  A is upper triangular;
 | |
| *>          = 'L':  A is lower triangular.
 | |
| *> \endverbatim
 | |
| *>
 | |
| *> \param[in] N
 | |
| *> \verbatim
 | |
| *>          N is INTEGER
 | |
| *>          The order of the matrices AP and A.  N >= 0.
 | |
| *> \endverbatim
 | |
| *>
 | |
| *> \param[in] A
 | |
| *> \verbatim
 | |
| *>          A is COMPLEX array, dimension (LDA,N)
 | |
| *>          On entry, the triangular matrix A.  If UPLO = 'U', the leading
 | |
| *>          N-by-N upper triangular part of A contains the upper
 | |
| *>          triangular part of the matrix A, and the strictly lower
 | |
| *>          triangular part of A is not referenced.  If UPLO = 'L', the
 | |
| *>          leading N-by-N lower triangular part of A contains the lower
 | |
| *>          triangular part of the matrix A, and the strictly upper
 | |
| *>          triangular part of A is not referenced.
 | |
| *> \endverbatim
 | |
| *>
 | |
| *> \param[in] LDA
 | |
| *> \verbatim
 | |
| *>          LDA is INTEGER
 | |
| *>          The leading dimension of the array A.  LDA >= max(1,N).
 | |
| *> \endverbatim
 | |
| *>
 | |
| *> \param[out] AP
 | |
| *> \verbatim
 | |
| *>          AP is COMPLEX array, dimension ( N*(N+1)/2 ),
 | |
| *>          On exit, the upper or lower triangular matrix A, packed
 | |
| *>          columnwise in a linear array. The j-th column of A is stored
 | |
| *>          in the array AP as follows:
 | |
| *>          if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
 | |
| *>          if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
 | |
| *> \endverbatim
 | |
| *>
 | |
| *> \param[out] INFO
 | |
| *> \verbatim
 | |
| *>          INFO is INTEGER
 | |
| *>          = 0:  successful exit
 | |
| *>          < 0:  if INFO = -i, the i-th argument had an illegal value
 | |
| *> \endverbatim
 | |
| *
 | |
| *  Authors:
 | |
| *  ========
 | |
| *
 | |
| *> \author Univ. of Tennessee
 | |
| *> \author Univ. of California Berkeley
 | |
| *> \author Univ. of Colorado Denver
 | |
| *> \author NAG Ltd.
 | |
| *
 | |
| *> \date December 2016
 | |
| *
 | |
| *> \ingroup complexOTHERcomputational
 | |
| *
 | |
| *  =====================================================================
 | |
|       SUBROUTINE CTRTTP( UPLO, N, A, LDA, AP, INFO )
 | |
| *
 | |
| *  -- LAPACK computational routine (version 3.7.0) --
 | |
| *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 | |
| *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 | |
| *     December 2016
 | |
| *
 | |
| *     .. Scalar Arguments ..
 | |
|       CHARACTER          UPLO
 | |
|       INTEGER            INFO, N, LDA
 | |
| *     ..
 | |
| *     .. Array Arguments ..
 | |
|       COMPLEX            A( LDA, * ), AP( * )
 | |
| *     ..
 | |
| *
 | |
| *  =====================================================================
 | |
| *
 | |
| *     .. Parameters ..
 | |
| *     ..
 | |
| *     .. Local Scalars ..
 | |
|       LOGICAL            LOWER
 | |
|       INTEGER            I, J, K
 | |
| *     ..
 | |
| *     .. External Functions ..
 | |
|       LOGICAL            LSAME
 | |
|       EXTERNAL           LSAME
 | |
| *     ..
 | |
| *     .. External Subroutines ..
 | |
|       EXTERNAL           XERBLA
 | |
| *     ..
 | |
| *     .. Executable Statements ..
 | |
| *
 | |
| *     Test the input parameters.
 | |
| *
 | |
|       INFO = 0
 | |
|       LOWER = LSAME( UPLO, 'L' )
 | |
|       IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
 | |
|          INFO = -1
 | |
|       ELSE IF( N.LT.0 ) THEN
 | |
|          INFO = -2
 | |
|       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
 | |
|          INFO = -4
 | |
|       END IF
 | |
|       IF( INFO.NE.0 ) THEN
 | |
|          CALL XERBLA( 'CTRTTP', -INFO )
 | |
|          RETURN
 | |
|       END IF
 | |
| *
 | |
|       IF( LOWER ) THEN
 | |
|          K = 0
 | |
|          DO J = 1, N
 | |
|             DO I = J, N
 | |
|                K = K + 1
 | |
|                AP( K ) = A( I, J )
 | |
|             END DO
 | |
|          END DO
 | |
|       ELSE
 | |
|          K = 0
 | |
|          DO J = 1, N
 | |
|             DO I = 1, J
 | |
|                K = K + 1
 | |
|                AP( K ) = A( I, J )
 | |
|             END DO
 | |
|          END DO
 | |
|       END IF
 | |
| *
 | |
| *
 | |
|       RETURN
 | |
| *
 | |
| *     End of CTRTTP
 | |
| *
 | |
|       END
 |