00001 SUBROUTINE SSTEV( JOBZ, N, D, E, Z, LDZ, WORK, INFO )
00002
00003
00004
00005
00006
00007
00008
00009 CHARACTER JOBZ
00010 INTEGER INFO, LDZ, N
00011
00012
00013 REAL D( * ), E( * ), 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 REAL ZERO, ONE
00065 PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
00066
00067
00068 LOGICAL WANTZ
00069 INTEGER IMAX, ISCALE
00070 REAL BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM,
00071 $ TNRM
00072
00073
00074 LOGICAL LSAME
00075 REAL SLAMCH, SLANST
00076 EXTERNAL LSAME, SLAMCH, SLANST
00077
00078
00079 EXTERNAL SSCAL, SSTEQR, SSTERF, XERBLA
00080
00081
00082 INTRINSIC SQRT
00083
00084
00085
00086
00087
00088 WANTZ = LSAME( JOBZ, 'V' )
00089
00090 INFO = 0
00091 IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
00092 INFO = -1
00093 ELSE IF( N.LT.0 ) THEN
00094 INFO = -2
00095 ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
00096 INFO = -6
00097 END IF
00098
00099 IF( INFO.NE.0 ) THEN
00100 CALL XERBLA( 'SSTEV ', -INFO )
00101 RETURN
00102 END IF
00103
00104
00105
00106 IF( N.EQ.0 )
00107 $ RETURN
00108
00109 IF( N.EQ.1 ) THEN
00110 IF( WANTZ )
00111 $ Z( 1, 1 ) = ONE
00112 RETURN
00113 END IF
00114
00115
00116
00117 SAFMIN = SLAMCH( 'Safe minimum' )
00118 EPS = SLAMCH( 'Precision' )
00119 SMLNUM = SAFMIN / EPS
00120 BIGNUM = ONE / SMLNUM
00121 RMIN = SQRT( SMLNUM )
00122 RMAX = SQRT( BIGNUM )
00123
00124
00125
00126 ISCALE = 0
00127 TNRM = SLANST( 'M', N, D, E )
00128 IF( TNRM.GT.ZERO .AND. TNRM.LT.RMIN ) THEN
00129 ISCALE = 1
00130 SIGMA = RMIN / TNRM
00131 ELSE IF( TNRM.GT.RMAX ) THEN
00132 ISCALE = 1
00133 SIGMA = RMAX / TNRM
00134 END IF
00135 IF( ISCALE.EQ.1 ) THEN
00136 CALL SSCAL( N, SIGMA, D, 1 )
00137 CALL SSCAL( N-1, SIGMA, E( 1 ), 1 )
00138 END IF
00139
00140
00141
00142
00143 IF( .NOT.WANTZ ) THEN
00144 CALL SSTERF( N, D, E, INFO )
00145 ELSE
00146 CALL SSTEQR( 'I', N, D, E, Z, LDZ, WORK, INFO )
00147 END IF
00148
00149
00150
00151 IF( ISCALE.EQ.1 ) THEN
00152 IF( INFO.EQ.0 ) THEN
00153 IMAX = N
00154 ELSE
00155 IMAX = INFO - 1
00156 END IF
00157 CALL SSCAL( IMAX, ONE / SIGMA, D, 1 )
00158 END IF
00159
00160 RETURN
00161
00162
00163
00164 END