LAPACK 3.3.0
|
00001 SUBROUTINE DLAT2S( 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 REAL SA( LDSA, * ) 00014 DOUBLE PRECISION A( LDA, * ) 00015 * .. 00016 * 00017 * Purpose 00018 * ======= 00019 * 00020 * DLAT2S converts a DOUBLE PRECISION triangular matrix, SA, to a SINGLE 00021 * PRECISION triangular matrix, A. 00022 * 00023 * RMAX is the overflow for the SINGLE PRECISION arithmetic 00024 * DLAS2S 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) DOUBLE PRECISION 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) REAL 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 * .. External Functions .. 00067 REAL SLAMCH 00068 LOGICAL LSAME 00069 EXTERNAL SLAMCH, LSAME 00070 * .. 00071 * .. Executable Statements .. 00072 * 00073 RMAX = SLAMCH( 'O' ) 00074 UPPER = LSAME( UPLO, 'U' ) 00075 IF( UPPER ) THEN 00076 DO 20 J = 1, N 00077 DO 10 I = 1, J 00078 IF( ( A( I, J ).LT.-RMAX ) .OR. ( A( I, J ).GT.RMAX ) ) 00079 + THEN 00080 INFO = 1 00081 GO TO 50 00082 END IF 00083 SA( I, J ) = A( I, J ) 00084 10 CONTINUE 00085 20 CONTINUE 00086 ELSE 00087 DO 40 J = 1, N 00088 DO 30 I = J, N 00089 IF( ( A( I, J ).LT.-RMAX ) .OR. ( A( I, J ).GT.RMAX ) ) 00090 + THEN 00091 INFO = 1 00092 GO TO 50 00093 END IF 00094 SA( I, J ) = A( I, J ) 00095 30 CONTINUE 00096 40 CONTINUE 00097 END IF 00098 50 CONTINUE 00099 * 00100 RETURN 00101 * 00102 * End of DLAT2S 00103 * 00104 END