|
1
2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 |
SUBROUTINE DLAQSP( UPLO, N, AP, S, SCOND, AMAX, EQUED )
* * -- LAPACK auxiliary routine (version 3.2) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * November 2006 * * .. Scalar Arguments .. CHARACTER EQUED, UPLO INTEGER N DOUBLE PRECISION AMAX, SCOND * .. * .. Array Arguments .. DOUBLE PRECISION AP( * ), S( * ) * .. * * Purpose * ======= * * DLAQSP equilibrates a symmetric matrix A using the scaling factors * in the vector S. * * Arguments * ========= * * UPLO (input) CHARACTER*1 * Specifies whether the upper or lower triangular part of the * symmetric matrix A is stored. * = 'U': Upper triangular * = 'L': Lower triangular * * N (input) INTEGER * The order of the matrix A. N >= 0. * * AP (input/output) DOUBLE PRECISION array, dimension (N*(N+1)/2) * On entry, the upper or lower triangle of the symmetric 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. * * On exit, the equilibrated matrix: diag(S) * A * diag(S), in * the same storage format as A. * * S (input) DOUBLE PRECISION array, dimension (N) * The scale factors for A. * * SCOND (input) DOUBLE PRECISION * Ratio of the smallest S(i) to the largest S(i). * * AMAX (input) DOUBLE PRECISION * Absolute value of largest matrix entry. * * EQUED (output) CHARACTER*1 * Specifies whether or not equilibration was done. * = 'N': No equilibration. * = 'Y': Equilibration was done, i.e., A has been replaced by * diag(S) * A * diag(S). * * Internal Parameters * =================== * * THRESH is a threshold value used to decide if scaling should be done * based on the ratio of the scaling factors. If SCOND < THRESH, * scaling is done. * * LARGE and SMALL are threshold values used to decide if scaling should * be done based on the absolute size of the largest matrix element. * If AMAX > LARGE or AMAX < SMALL, scaling is done. * * ===================================================================== * * .. Parameters .. DOUBLE PRECISION ONE, THRESH PARAMETER ( ONE = 1.0D+0, THRESH = 0.1D+0 ) * .. * .. Local Scalars .. INTEGER I, J, JC DOUBLE PRECISION CJ, LARGE, SMALL * .. * .. External Functions .. LOGICAL LSAME DOUBLE PRECISION DLAMCH EXTERNAL LSAME, DLAMCH * .. * .. Executable Statements .. * * Quick return if possible * IF( N.LE.0 ) THEN EQUED = 'N' RETURN END IF * * Initialize LARGE and SMALL. * SMALL = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' ) LARGE = ONE / SMALL * IF( SCOND.GE.THRESH .AND. AMAX.GE.SMALL .AND. AMAX.LE.LARGE ) THEN * * No equilibration * EQUED = 'N' ELSE * * Replace A by diag(S) * A * diag(S). * IF( LSAME( UPLO, 'U' ) ) THEN * * Upper triangle of A is stored. * JC = 1 DO 20 J = 1, N CJ = S( J ) DO 10 I = 1, J AP( JC+I-1 ) = CJ*S( I )*AP( JC+I-1 ) 10 CONTINUE JC = JC + J 20 CONTINUE ELSE * * Lower triangle of A is stored. * JC = 1 DO 40 J = 1, N CJ = S( J ) DO 30 I = J, N AP( JC+I-J ) = CJ*S( I )*AP( JC+I-J ) 30 CONTINUE JC = JC + N - J + 1 40 CONTINUE END IF EQUED = 'Y' END IF * RETURN * * End of DLAQSP * END |