00001 SUBROUTINE ZHBEV( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK,
00002 $ RWORK, INFO )
00003
00004
00005
00006
00007
00008
00009
00010 CHARACTER JOBZ, UPLO
00011 INTEGER INFO, KD, LDAB, LDZ, N
00012
00013
00014 DOUBLE PRECISION RWORK( * ), W( * )
00015 COMPLEX*16 AB( LDAB, * ), WORK( * ), Z( LDZ, * )
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
00079
00080
00081
00082
00083
00084
00085
00086
00087 DOUBLE PRECISION ZERO, ONE
00088 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
00089
00090
00091 LOGICAL LOWER, WANTZ
00092 INTEGER IINFO, IMAX, INDE, INDRWK, ISCALE
00093 DOUBLE PRECISION ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
00094 $ SMLNUM
00095
00096
00097 LOGICAL LSAME
00098 DOUBLE PRECISION DLAMCH, ZLANHB
00099 EXTERNAL LSAME, DLAMCH, ZLANHB
00100
00101
00102 EXTERNAL DSCAL, DSTERF, XERBLA, ZHBTRD, ZLASCL, ZSTEQR
00103
00104
00105 INTRINSIC SQRT
00106
00107
00108
00109
00110
00111 WANTZ = LSAME( JOBZ, 'V' )
00112 LOWER = LSAME( UPLO, 'L' )
00113
00114 INFO = 0
00115 IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
00116 INFO = -1
00117 ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
00118 INFO = -2
00119 ELSE IF( N.LT.0 ) THEN
00120 INFO = -3
00121 ELSE IF( KD.LT.0 ) THEN
00122 INFO = -4
00123 ELSE IF( LDAB.LT.KD+1 ) THEN
00124 INFO = -6
00125 ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
00126 INFO = -9
00127 END IF
00128
00129 IF( INFO.NE.0 ) THEN
00130 CALL XERBLA( 'ZHBEV ', -INFO )
00131 RETURN
00132 END IF
00133
00134
00135
00136 IF( N.EQ.0 )
00137 $ RETURN
00138
00139 IF( N.EQ.1 ) THEN
00140 IF( LOWER ) THEN
00141 W( 1 ) = AB( 1, 1 )
00142 ELSE
00143 W( 1 ) = AB( KD+1, 1 )
00144 END IF
00145 IF( WANTZ )
00146 $ Z( 1, 1 ) = ONE
00147 RETURN
00148 END IF
00149
00150
00151
00152 SAFMIN = DLAMCH( 'Safe minimum' )
00153 EPS = DLAMCH( 'Precision' )
00154 SMLNUM = SAFMIN / EPS
00155 BIGNUM = ONE / SMLNUM
00156 RMIN = SQRT( SMLNUM )
00157 RMAX = SQRT( BIGNUM )
00158
00159
00160
00161 ANRM = ZLANHB( 'M', UPLO, N, KD, AB, LDAB, RWORK )
00162 ISCALE = 0
00163 IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
00164 ISCALE = 1
00165 SIGMA = RMIN / ANRM
00166 ELSE IF( ANRM.GT.RMAX ) THEN
00167 ISCALE = 1
00168 SIGMA = RMAX / ANRM
00169 END IF
00170 IF( ISCALE.EQ.1 ) THEN
00171 IF( LOWER ) THEN
00172 CALL ZLASCL( 'B', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
00173 ELSE
00174 CALL ZLASCL( 'Q', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
00175 END IF
00176 END IF
00177
00178
00179
00180 INDE = 1
00181 CALL ZHBTRD( JOBZ, UPLO, N, KD, AB, LDAB, W, RWORK( INDE ), Z,
00182 $ LDZ, WORK, IINFO )
00183
00184
00185
00186 IF( .NOT.WANTZ ) THEN
00187 CALL DSTERF( N, W, RWORK( INDE ), INFO )
00188 ELSE
00189 INDRWK = INDE + N
00190 CALL ZSTEQR( JOBZ, N, W, RWORK( INDE ), Z, LDZ,
00191 $ RWORK( INDRWK ), INFO )
00192 END IF
00193
00194
00195
00196 IF( ISCALE.EQ.1 ) THEN
00197 IF( INFO.EQ.0 ) THEN
00198 IMAX = N
00199 ELSE
00200 IMAX = INFO - 1
00201 END IF
00202 CALL DSCAL( IMAX, ONE / SIGMA, W, 1 )
00203 END IF
00204
00205 RETURN
00206
00207
00208
00209 END