118 SUBROUTINE sdisna( JOB, M, N, D, SEP, INFO )
130 REAL D( * ), SEP( * )
137 parameter ( zero = 0.0e+0 )
140 LOGICAL DECR, EIGEN, INCR, LEFT, RIGHT, SING
142 REAL ANORM, EPS, NEWGAP, OLDGAP, SAFMIN, THRESH
147 EXTERNAL lsame, slamch
150 INTRINSIC abs, max, min
160 eigen = lsame( job,
'E' )
161 left = lsame( job,
'L' )
162 right = lsame( job,
'R' )
163 sing = left .OR. right
169 IF( .NOT.eigen .AND. .NOT.sing )
THEN
171 ELSE IF( m.LT.0 )
THEN
173 ELSE IF( k.LT.0 )
THEN
180 $ incr = incr .AND. d( i ).LE.d( i+1 )
182 $ decr = decr .AND. d( i ).GE.d( i+1 )
184 IF( sing .AND. k.GT.0 )
THEN
186 $ incr = incr .AND. zero.LE.d( 1 )
188 $ decr = decr .AND. d( k ).GE.zero
190 IF( .NOT.( incr .OR. decr ) )
194 CALL xerbla(
'SDISNA', -info )
206 sep( 1 ) = slamch(
'O' )
208 oldgap = abs( d( 2 )-d( 1 ) )
211 newgap = abs( d( i+1 )-d( i ) )
212 sep( i ) = min( oldgap, newgap )
218 IF( ( left .AND. m.GT.n ) .OR. ( right .AND. m.LT.n ) )
THEN
220 $ sep( 1 ) = min( sep( 1 ), d( 1 ) )
222 $ sep( k ) = min( sep( k ), d( k ) )
230 safmin = slamch(
'S' )
231 anorm = max( abs( d( 1 ) ), abs( d( k ) ) )
232 IF( anorm.EQ.zero )
THEN
235 thresh = max( eps*anorm, safmin )
238 sep( i ) = max( sep( i ), thresh )
subroutine sdisna(JOB, M, N, D, SEP, INFO)
SDISNA
subroutine xerbla(SRNAME, INFO)
XERBLA