00001 SUBROUTINE DLAQSY( UPLO, N, A, LDA, S, SCOND, AMAX, EQUED ) 00002 * 00003 * -- LAPACK auxiliary routine (version 3.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 * November 2006 00007 * 00008 * .. Scalar Arguments .. 00009 CHARACTER EQUED, UPLO 00010 INTEGER LDA, N 00011 DOUBLE PRECISION AMAX, SCOND 00012 * .. 00013 * .. Array Arguments .. 00014 DOUBLE PRECISION A( LDA, * ), S( * ) 00015 * .. 00016 * 00017 * Purpose 00018 * ======= 00019 * 00020 * DLAQSY equilibrates a symmetric matrix A using the scaling factors 00021 * in the vector S. 00022 * 00023 * Arguments 00024 * ========= 00025 * 00026 * UPLO (input) CHARACTER*1 00027 * Specifies whether the upper or lower triangular part of the 00028 * symmetric matrix A is stored. 00029 * = 'U': Upper triangular 00030 * = 'L': Lower triangular 00031 * 00032 * N (input) INTEGER 00033 * The order of the matrix A. N >= 0. 00034 * 00035 * A (input/output) DOUBLE PRECISION array, dimension (LDA,N) 00036 * On entry, the symmetric matrix A. If UPLO = 'U', the leading 00037 * n by n upper triangular part of A contains the upper 00038 * triangular part of the matrix A, and the strictly lower 00039 * triangular part of A is not referenced. If UPLO = 'L', the 00040 * leading n by n lower triangular part of A contains the lower 00041 * triangular part of the matrix A, and the strictly upper 00042 * triangular part of A is not referenced. 00043 * 00044 * On exit, if EQUED = 'Y', the equilibrated matrix: 00045 * diag(S) * A * diag(S). 00046 * 00047 * LDA (input) INTEGER 00048 * The leading dimension of the array A. LDA >= max(N,1). 00049 * 00050 * S (input) DOUBLE PRECISION array, dimension (N) 00051 * The scale factors for A. 00052 * 00053 * SCOND (input) DOUBLE PRECISION 00054 * Ratio of the smallest S(i) to the largest S(i). 00055 * 00056 * AMAX (input) DOUBLE PRECISION 00057 * Absolute value of largest matrix entry. 00058 * 00059 * EQUED (output) CHARACTER*1 00060 * Specifies whether or not equilibration was done. 00061 * = 'N': No equilibration. 00062 * = 'Y': Equilibration was done, i.e., A has been replaced by 00063 * diag(S) * A * diag(S). 00064 * 00065 * Internal Parameters 00066 * =================== 00067 * 00068 * THRESH is a threshold value used to decide if scaling should be done 00069 * based on the ratio of the scaling factors. If SCOND < THRESH, 00070 * scaling is done. 00071 * 00072 * LARGE and SMALL are threshold values used to decide if scaling should 00073 * be done based on the absolute size of the largest matrix element. 00074 * If AMAX > LARGE or AMAX < SMALL, scaling is done. 00075 * 00076 * ===================================================================== 00077 * 00078 * .. Parameters .. 00079 DOUBLE PRECISION ONE, THRESH 00080 PARAMETER ( ONE = 1.0D+0, THRESH = 0.1D+0 ) 00081 * .. 00082 * .. Local Scalars .. 00083 INTEGER I, J 00084 DOUBLE PRECISION CJ, LARGE, SMALL 00085 * .. 00086 * .. External Functions .. 00087 LOGICAL LSAME 00088 DOUBLE PRECISION DLAMCH 00089 EXTERNAL LSAME, DLAMCH 00090 * .. 00091 * .. Executable Statements .. 00092 * 00093 * Quick return if possible 00094 * 00095 IF( N.LE.0 ) THEN 00096 EQUED = 'N' 00097 RETURN 00098 END IF 00099 * 00100 * Initialize LARGE and SMALL. 00101 * 00102 SMALL = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' ) 00103 LARGE = ONE / SMALL 00104 * 00105 IF( SCOND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE ) THEN 00106 * 00107 * No equilibration 00108 * 00109 EQUED = 'N' 00110 ELSE 00111 * 00112 * Replace A by diag(S) * A * diag(S). 00113 * 00114 IF( LSAME( UPLO, 'U' ) ) THEN 00115 * 00116 * Upper triangle of A is stored. 00117 * 00118 DO 20 J = 1, N 00119 CJ = S( J ) 00120 DO 10 I = 1, J 00121 A( I, J ) = CJ*S( I )*A( I, J ) 00122 10 CONTINUE 00123 20 CONTINUE 00124 ELSE 00125 * 00126 * Lower triangle of A is stored. 00127 * 00128 DO 40 J = 1, N 00129 CJ = S( J ) 00130 DO 30 I = J, N 00131 A( I, J ) = CJ*S( I )*A( I, J ) 00132 30 CONTINUE 00133 40 CONTINUE 00134 END IF 00135 EQUED = 'Y' 00136 END IF 00137 * 00138 RETURN 00139 * 00140 * End of DLAQSY 00141 * 00142 END
1.7.2