![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZPBEQU 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download ZPBEQU + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zpbequ.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zpbequ.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zpbequ.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE ZPBEQU( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO ) 00022 * 00023 * .. Scalar Arguments .. 00024 * CHARACTER UPLO 00025 * INTEGER INFO, KD, LDAB, N 00026 * DOUBLE PRECISION AMAX, SCOND 00027 * .. 00028 * .. Array Arguments .. 00029 * DOUBLE PRECISION S( * ) 00030 * COMPLEX*16 AB( LDAB, * ) 00031 * .. 00032 * 00033 * 00034 *> \par Purpose: 00035 * ============= 00036 *> 00037 *> \verbatim 00038 *> 00039 *> ZPBEQU computes row and column scalings intended to equilibrate a 00040 *> Hermitian positive definite band matrix A and reduce its condition 00041 *> number (with respect to the two-norm). S contains the scale factors, 00042 *> S(i) = 1/sqrt(A(i,i)), chosen so that the scaled matrix B with 00043 *> elements B(i,j) = S(i)*A(i,j)*S(j) has ones on the diagonal. This 00044 *> choice of S puts the condition number of B within a factor N of the 00045 *> smallest possible condition number over all possible diagonal 00046 *> scalings. 00047 *> \endverbatim 00048 * 00049 * Arguments: 00050 * ========== 00051 * 00052 *> \param[in] UPLO 00053 *> \verbatim 00054 *> UPLO is CHARACTER*1 00055 *> = 'U': Upper triangular of A is stored; 00056 *> = 'L': Lower triangular of A is stored. 00057 *> \endverbatim 00058 *> 00059 *> \param[in] N 00060 *> \verbatim 00061 *> N is INTEGER 00062 *> The order of the matrix A. N >= 0. 00063 *> \endverbatim 00064 *> 00065 *> \param[in] KD 00066 *> \verbatim 00067 *> KD is INTEGER 00068 *> The number of superdiagonals of the matrix A if UPLO = 'U', 00069 *> or the number of subdiagonals if UPLO = 'L'. KD >= 0. 00070 *> \endverbatim 00071 *> 00072 *> \param[in] AB 00073 *> \verbatim 00074 *> AB is COMPLEX*16 array, dimension (LDAB,N) 00075 *> The upper or lower triangle of the Hermitian band matrix A, 00076 *> stored in the first KD+1 rows of the array. The j-th column 00077 *> of A is stored in the j-th column of the array AB as follows: 00078 *> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j; 00079 *> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd). 00080 *> \endverbatim 00081 *> 00082 *> \param[in] LDAB 00083 *> \verbatim 00084 *> LDAB is INTEGER 00085 *> The leading dimension of the array A. LDAB >= KD+1. 00086 *> \endverbatim 00087 *> 00088 *> \param[out] S 00089 *> \verbatim 00090 *> S is DOUBLE PRECISION array, dimension (N) 00091 *> If INFO = 0, S contains the scale factors for A. 00092 *> \endverbatim 00093 *> 00094 *> \param[out] SCOND 00095 *> \verbatim 00096 *> SCOND is DOUBLE PRECISION 00097 *> If INFO = 0, S contains the ratio of the smallest S(i) to 00098 *> the largest S(i). If SCOND >= 0.1 and AMAX is neither too 00099 *> large nor too small, it is not worth scaling by S. 00100 *> \endverbatim 00101 *> 00102 *> \param[out] AMAX 00103 *> \verbatim 00104 *> AMAX is DOUBLE PRECISION 00105 *> Absolute value of largest matrix element. If AMAX is very 00106 *> close to overflow or very close to underflow, the matrix 00107 *> should be scaled. 00108 *> \endverbatim 00109 *> 00110 *> \param[out] INFO 00111 *> \verbatim 00112 *> INFO is INTEGER 00113 *> = 0: successful exit 00114 *> < 0: if INFO = -i, the i-th argument had an illegal value. 00115 *> > 0: if INFO = i, the i-th diagonal element is nonpositive. 00116 *> \endverbatim 00117 * 00118 * Authors: 00119 * ======== 00120 * 00121 *> \author Univ. of Tennessee 00122 *> \author Univ. of California Berkeley 00123 *> \author Univ. of Colorado Denver 00124 *> \author NAG Ltd. 00125 * 00126 *> \date November 2011 00127 * 00128 *> \ingroup complex16OTHERcomputational 00129 * 00130 * ===================================================================== 00131 SUBROUTINE ZPBEQU( UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO ) 00132 * 00133 * -- LAPACK computational routine (version 3.4.0) -- 00134 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00135 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00136 * November 2011 00137 * 00138 * .. Scalar Arguments .. 00139 CHARACTER UPLO 00140 INTEGER INFO, KD, LDAB, N 00141 DOUBLE PRECISION AMAX, SCOND 00142 * .. 00143 * .. Array Arguments .. 00144 DOUBLE PRECISION S( * ) 00145 COMPLEX*16 AB( LDAB, * ) 00146 * .. 00147 * 00148 * ===================================================================== 00149 * 00150 * .. Parameters .. 00151 DOUBLE PRECISION ZERO, ONE 00152 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) 00153 * .. 00154 * .. Local Scalars .. 00155 LOGICAL UPPER 00156 INTEGER I, J 00157 DOUBLE PRECISION SMIN 00158 * .. 00159 * .. External Functions .. 00160 LOGICAL LSAME 00161 EXTERNAL LSAME 00162 * .. 00163 * .. External Subroutines .. 00164 EXTERNAL XERBLA 00165 * .. 00166 * .. Intrinsic Functions .. 00167 INTRINSIC DBLE, MAX, MIN, SQRT 00168 * .. 00169 * .. Executable Statements .. 00170 * 00171 * Test the input parameters. 00172 * 00173 INFO = 0 00174 UPPER = LSAME( UPLO, 'U' ) 00175 IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN 00176 INFO = -1 00177 ELSE IF( N.LT.0 ) THEN 00178 INFO = -2 00179 ELSE IF( KD.LT.0 ) THEN 00180 INFO = -3 00181 ELSE IF( LDAB.LT.KD+1 ) THEN 00182 INFO = -5 00183 END IF 00184 IF( INFO.NE.0 ) THEN 00185 CALL XERBLA( 'ZPBEQU', -INFO ) 00186 RETURN 00187 END IF 00188 * 00189 * Quick return if possible 00190 * 00191 IF( N.EQ.0 ) THEN 00192 SCOND = ONE 00193 AMAX = ZERO 00194 RETURN 00195 END IF 00196 * 00197 IF( UPPER ) THEN 00198 J = KD + 1 00199 ELSE 00200 J = 1 00201 END IF 00202 * 00203 * Initialize SMIN and AMAX. 00204 * 00205 S( 1 ) = DBLE( AB( J, 1 ) ) 00206 SMIN = S( 1 ) 00207 AMAX = S( 1 ) 00208 * 00209 * Find the minimum and maximum diagonal elements. 00210 * 00211 DO 10 I = 2, N 00212 S( I ) = DBLE( AB( J, I ) ) 00213 SMIN = MIN( SMIN, S( I ) ) 00214 AMAX = MAX( AMAX, S( I ) ) 00215 10 CONTINUE 00216 * 00217 IF( SMIN.LE.ZERO ) THEN 00218 * 00219 * Find the first non-positive diagonal element and return. 00220 * 00221 DO 20 I = 1, N 00222 IF( S( I ).LE.ZERO ) THEN 00223 INFO = I 00224 RETURN 00225 END IF 00226 20 CONTINUE 00227 ELSE 00228 * 00229 * Set the scale factors to the reciprocals 00230 * of the diagonal elements. 00231 * 00232 DO 30 I = 1, N 00233 S( I ) = ONE / SQRT( S( I ) ) 00234 30 CONTINUE 00235 * 00236 * Compute SCOND = min(S(I)) / max(S(I)) 00237 * 00238 SCOND = SQRT( SMIN ) / SQRT( AMAX ) 00239 END IF 00240 RETURN 00241 * 00242 * End of ZPBEQU 00243 * 00244 END