00001 SUBROUTINE CHPEV( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, RWORK,
00002 $ INFO )
00003
00004
00005
00006
00007
00008
00009
00010 CHARACTER JOBZ, UPLO
00011 INTEGER INFO, LDZ, N
00012
00013
00014 REAL RWORK( * ), W( * )
00015 COMPLEX AP( * ), 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 REAL ZERO, ONE
00080 PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
00081
00082
00083 LOGICAL WANTZ
00084 INTEGER IINFO, IMAX, INDE, INDRWK, INDTAU, INDWRK,
00085 $ ISCALE
00086 REAL ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
00087 $ SMLNUM
00088
00089
00090 LOGICAL LSAME
00091 REAL CLANHP, SLAMCH
00092 EXTERNAL LSAME, CLANHP, SLAMCH
00093
00094
00095 EXTERNAL CHPTRD, CSSCAL, CSTEQR, CUPGTR, SSCAL, SSTERF,
00096 $ XERBLA
00097
00098
00099 INTRINSIC SQRT
00100
00101
00102
00103
00104
00105 WANTZ = LSAME( JOBZ, 'V' )
00106
00107 INFO = 0
00108 IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
00109 INFO = -1
00110 ELSE IF( .NOT.( LSAME( UPLO, 'L' ) .OR. LSAME( UPLO, 'U' ) ) )
00111 $ THEN
00112 INFO = -2
00113 ELSE IF( N.LT.0 ) THEN
00114 INFO = -3
00115 ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
00116 INFO = -7
00117 END IF
00118
00119 IF( INFO.NE.0 ) THEN
00120 CALL XERBLA( 'CHPEV ', -INFO )
00121 RETURN
00122 END IF
00123
00124
00125
00126 IF( N.EQ.0 )
00127 $ RETURN
00128
00129 IF( N.EQ.1 ) THEN
00130 W( 1 ) = AP( 1 )
00131 RWORK( 1 ) = 1
00132 IF( WANTZ )
00133 $ Z( 1, 1 ) = ONE
00134 RETURN
00135 END IF
00136
00137
00138
00139 SAFMIN = SLAMCH( 'Safe minimum' )
00140 EPS = SLAMCH( 'Precision' )
00141 SMLNUM = SAFMIN / EPS
00142 BIGNUM = ONE / SMLNUM
00143 RMIN = SQRT( SMLNUM )
00144 RMAX = SQRT( BIGNUM )
00145
00146
00147
00148 ANRM = CLANHP( 'M', UPLO, N, AP, RWORK )
00149 ISCALE = 0
00150 IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
00151 ISCALE = 1
00152 SIGMA = RMIN / ANRM
00153 ELSE IF( ANRM.GT.RMAX ) THEN
00154 ISCALE = 1
00155 SIGMA = RMAX / ANRM
00156 END IF
00157 IF( ISCALE.EQ.1 ) THEN
00158 CALL CSSCAL( ( N*( N+1 ) ) / 2, SIGMA, AP, 1 )
00159 END IF
00160
00161
00162
00163 INDE = 1
00164 INDTAU = 1
00165 CALL CHPTRD( UPLO, N, AP, W, RWORK( INDE ), WORK( INDTAU ),
00166 $ IINFO )
00167
00168
00169
00170
00171 IF( .NOT.WANTZ ) THEN
00172 CALL SSTERF( N, W, RWORK( INDE ), INFO )
00173 ELSE
00174 INDWRK = INDTAU + N
00175 CALL CUPGTR( UPLO, N, AP, WORK( INDTAU ), Z, LDZ,
00176 $ WORK( INDWRK ), IINFO )
00177 INDRWK = INDE + N
00178 CALL CSTEQR( JOBZ, N, W, RWORK( INDE ), Z, LDZ,
00179 $ RWORK( INDRWK ), INFO )
00180 END IF
00181
00182
00183
00184 IF( ISCALE.EQ.1 ) THEN
00185 IF( INFO.EQ.0 ) THEN
00186 IMAX = N
00187 ELSE
00188 IMAX = INFO - 1
00189 END IF
00190 CALL SSCAL( IMAX, ONE / SIGMA, W, 1 )
00191 END IF
00192
00193 RETURN
00194
00195
00196
00197 END