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