00001 SUBROUTINE ZLAT2C( UPLO, N, A, LDA, SA, LDSA, INFO ) 00002 * 00003 * -- LAPACK PROTOTYPE auxiliary routine (version 3.1.2) -- 00004 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00005 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00006 * May 2007 00007 * 00008 * .. Scalar Arguments .. 00009 CHARACTER UPLO 00010 INTEGER INFO, LDA, LDSA, N 00011 * .. 00012 * .. Array Arguments .. 00013 COMPLEX SA( LDSA, * ) 00014 COMPLEX*16 A( LDA, * ) 00015 * .. 00016 * 00017 * Purpose 00018 * ======= 00019 * 00020 * ZLAT2C converts a COMPLEX*16 triangular matrix, SA, to a COMPLEX 00021 * triangular matrix, A. 00022 * 00023 * RMAX is the overflow for the SINGLE PRECISION arithmetic 00024 * ZLAT2C checks that all the entries of A are between -RMAX and 00025 * RMAX. If not the convertion is aborted and a flag is raised. 00026 * 00027 * This is an auxiliary routine so there is no argument checking. 00028 * 00029 * Arguments 00030 * ========= 00031 * 00032 * UPLO (input) CHARACTER*1 00033 * = 'U': A is upper triangular; 00034 * = 'L': A is lower triangular. 00035 * 00036 * N (input) INTEGER 00037 * The number of rows and columns of the matrix A. N >= 0. 00038 * 00039 * A (input) COMPLEX*16 array, dimension (LDA,N) 00040 * On entry, the N-by-N triangular coefficient matrix A. 00041 * 00042 * LDA (input) INTEGER 00043 * The leading dimension of the array A. LDA >= max(1,N). 00044 * 00045 * SA (output) COMPLEX array, dimension (LDSA,N) 00046 * Only the UPLO part of SA is referenced. On exit, if INFO=0, 00047 * the N-by-N coefficient matrix SA; if INFO>0, the content of 00048 * the UPLO part of SA is unspecified. 00049 * 00050 * LDSA (input) INTEGER 00051 * The leading dimension of the array SA. LDSA >= max(1,M). 00052 * 00053 * INFO (output) INTEGER 00054 * = 0: successful exit. 00055 * = 1: an entry of the matrix A is greater than the SINGLE 00056 * PRECISION overflow threshold, in this case, the content 00057 * of the UPLO part of SA in exit is unspecified. 00058 * 00059 * ========= 00060 * 00061 * .. Local Scalars .. 00062 INTEGER I, J 00063 DOUBLE PRECISION RMAX 00064 LOGICAL UPPER 00065 * .. 00066 * .. Intrinsic Functions .. 00067 INTRINSIC DBLE, DIMAG 00068 * .. 00069 * .. External Functions .. 00070 REAL SLAMCH 00071 LOGICAL LSAME 00072 EXTERNAL SLAMCH, LSAME 00073 * .. 00074 * .. Executable Statements .. 00075 * 00076 RMAX = SLAMCH( 'O' ) 00077 UPPER = LSAME( UPLO, 'U' ) 00078 IF( UPPER ) THEN 00079 DO 20 J = 1, N 00080 DO 10 I = 1, J 00081 IF( ( DBLE( A( I, J ) ).LT.-RMAX ) .OR. 00082 + ( DBLE( A( I, J ) ).GT.RMAX ) .OR. 00083 + ( DIMAG( A( I, J ) ).LT.-RMAX ) .OR. 00084 + ( DIMAG( A( I, J ) ).GT.RMAX ) ) THEN 00085 INFO = 1 00086 GO TO 50 00087 END IF 00088 SA( I, J ) = A( I, J ) 00089 10 CONTINUE 00090 20 CONTINUE 00091 ELSE 00092 DO 40 J = 1, N 00093 DO 30 I = J, N 00094 IF( ( DBLE( A( I, J ) ).LT.-RMAX ) .OR. 00095 + ( DBLE( A( I, J ) ).GT.RMAX ) .OR. 00096 + ( DIMAG( A( I, J ) ).LT.-RMAX ) .OR. 00097 + ( DIMAG( A( I, J ) ).GT.RMAX ) ) THEN 00098 INFO = 1 00099 GO TO 50 00100 END IF 00101 SA( I, J ) = A( I, J ) 00102 30 CONTINUE 00103 40 CONTINUE 00104 END IF 00105 50 CONTINUE 00106 * 00107 RETURN 00108 * 00109 * End of ZLAT2C 00110 * 00111 END
1.7.2