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