diff options
author | julie <julielangou@users.noreply.github.com> | 2008-12-16 17:06:58 +0000 |
---|---|---|
committer | julie <julielangou@users.noreply.github.com> | 2008-12-16 17:06:58 +0000 |
commit | ff981f106bde4ce6a74aa4f4a572c943f5a395b2 (patch) | |
tree | a386cad907bcaefd6893535c31d67ec9468e693e /SRC/zlat2c.f | |
parent | e58b61578b55644f6391f3333262b72c1dc88437 (diff) | |
download | lapack-ff981f106bde4ce6a74aa4f4a572c943f5a395b2.tar.gz lapack-ff981f106bde4ce6a74aa4f4a572c943f5a395b2.tar.bz2 lapack-ff981f106bde4ce6a74aa4f4a572c943f5a395b2.zip |
Diffstat (limited to 'SRC/zlat2c.f')
-rw-r--r-- | SRC/zlat2c.f | 110 |
1 files changed, 110 insertions, 0 deletions
diff --git a/SRC/zlat2c.f b/SRC/zlat2c.f new file mode 100644 index 00000000..a85dcde0 --- /dev/null +++ b/SRC/zlat2c.f @@ -0,0 +1,110 @@ + SUBROUTINE ZLAT2C( UPLO, N, A, LDA, SA, LDSA, INFO ) +* +* -- LAPACK PROTOTYPE auxiliary routine (version 3.1.2) -- +* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. +* May 2007 +* +* .. Scalar Arguments .. + CHARACTER UPLO + INTEGER INFO, LDA, LDSA, N +* .. +* .. Array Arguments .. + COMPLEX SA( LDSA, * ) + COMPLEX*16 A( LDA, * ) +* .. +* +* Purpose +* ======= +* +* ZLAT2C converts a COMPLEX*16 triangular matrix, SA, to a COMPLEX +* triangular matrix, A. +* +* RMAX is the overflow for the SINGLE PRECISION arithmetic +* ZLAT2C checks that all the entries of A are between -RMAX and +* RMAX. If not the convertion is aborted and a flag is raised. +* +* This is an auxiliary routine so there is no argument checking. +* +* Arguments +* ========= +* +* UPLO (input) CHARACTER*1 +* = 'U': A is upper triangular; +* = 'L': A is lower triangular. +* +* N (input) INTEGER +* The number of rows and columns of the matrix A. N >= 0. +* +* A (input) COMPLEX*16 array, dimension (LDA,N) +* On entry, the N-by-N triangular coefficient matrix A. +* +* LDA (input) INTEGER +* The leading dimension of the array A. LDA >= max(1,N). +* +* SA (output) COMPLEX array, dimension (LDSA,N) +* Only the UPLO part of SA is referenced. On exit, if INFO=0, +* the N-by-N coefficient matrix SA; if INFO>0, the content of +* the UPLO part of SA is unspecified. +* +* LDSA (input) INTEGER +* The leading dimension of the array SA. LDSA >= max(1,M). +* +* INFO (output) INTEGER +* = 0: successful exit. +* = 1: an entry of the matrix A is greater than the SINGLE +* PRECISION overflow threshold, in this case, the content +* of the UPLO part of SA in exit is unspecified. +* +* ========= +* +* .. Local Scalars .. + INTEGER I, J + DOUBLE PRECISION RMAX + LOGICAL UPPER +* .. +* .. Intrinsic Functions .. + INTRINSIC DBLE, DIMAG +* .. +* .. External Functions .. + REAL SLAMCH + LOGICAL LSAME + EXTERNAL SLAMCH, LSAME +* .. +* .. Executable Statements .. +* + RMAX = SLAMCH( 'O' ) + UPPER = LSAME( UPLO, 'U' ) + IF( UPPER ) THEN + DO 20 J = 1, N + DO 10 I = 1, J + IF( ( DBLE( A( I, J ) ).LT.-RMAX ) .OR. + + ( DBLE( A( I, J ) ).GT.RMAX ) .OR. + + ( DIMAG( A( I, J ) ).LT.-RMAX ) .OR. + + ( DIMAG( A( I, J ) ).GT.RMAX ) ) THEN + INFO = 1 + GO TO 50 + END IF + SA( I, J ) = A( I, J ) + 10 CONTINUE + 20 CONTINUE + ELSE + DO 40 J = 1, N + DO 30 I = J, N + IF( ( DBLE( A( I, J ) ).LT.-RMAX ) .OR. + + ( DBLE( A( I, J ) ).GT.RMAX ) .OR. + + ( DIMAG( A( I, J ) ).LT.-RMAX ) .OR. + + ( DIMAG( A( I, J ) ).GT.RMAX ) ) THEN + INFO = 1 + GO TO 50 + END IF + SA( I, J ) = A( I, J ) + 30 CONTINUE + 40 CONTINUE + END IF + 50 CONTINUE +* + RETURN +* +* End of ZLAT2C +* + END |