324 SUBROUTINE sgesvj( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V,
325 $ LDV, WORK, LWORK, INFO )
332 INTEGER INFO, LDA, LDV, LWORK, M, MV, N
333 CHARACTER*1 JOBA, JOBU, JOBV
336 REAL A( LDA, * ), SVA( N ), V( LDV, * ),
344 parameter( zero = 0.0e0, half = 0.5e0, one = 1.0e0)
346 parameter( nsweep = 30 )
349 REAL AAPP, AAPP0, AAPQ, AAQQ, APOAQ, AQOAP, BIG,
350 $ bigtheta, cs, ctol, epsln, large, mxaapq,
351 $ mxsinj, rootbig, rooteps, rootsfmin, roottol,
352 $ skl, sfmin, small, sn, t, temp1, theta,
354 INTEGER BLSKIP, EMPTSW, i, ibr, IERR, igl, IJBLSK, ir1,
355 $ iswrot, jbc, jgl, kbl, lkahead, mvl, n2, n34,
356 $ n4, nbl, notrot, p, pskipped, q, rowskip,
357 $ swband, minmn, lwmin
358 LOGICAL APPLV, GOSCALE, LOWER, LQUERY, LSVEC, NOSCALE,
359 $ rotok, rsvec, uctol, upper
365 INTRINSIC abs, max, min, float, sign, sqrt
375 REAL SLAMCH, SROUNDUP_LWORK
376 EXTERNAL slamch, sroundup_lwork
393 lsvec = lsame( jobu,
'U' )
394 uctol = lsame( jobu,
'C' )
395 rsvec = lsame( jobv,
'V' )
396 applv = lsame( jobv,
'A' )
397 upper = lsame( joba,
'U' )
398 lower = lsame( joba,
'L' )
401 IF( minmn.EQ.0 )
THEN
404 lwmin = max( 6, m+n )
407 lquery = ( lwork.EQ.-1 )
408 IF( .NOT.( upper .OR. lower .OR. lsame( joba,
'G' ) ) )
THEN
410 ELSE IF( .NOT.( lsvec .OR.
412 $ lsame( jobu,
'N' ) ) )
THEN
414 ELSE IF( .NOT.( rsvec .OR.
416 $ lsame( jobv,
'N' ) ) )
THEN
418 ELSE IF( m.LT.0 )
THEN
420 ELSE IF( ( n.LT.0 ) .OR. ( n.GT.m ) )
THEN
422 ELSE IF( lda.LT.m )
THEN
424 ELSE IF( mv.LT.0 )
THEN
426 ELSE IF( ( rsvec .AND. ( ldv.LT.n ) ) .OR.
427 $ ( applv .AND. ( ldv.LT.mv ) ) )
THEN
429 ELSE IF( uctol .AND. ( work( 1 ).LE.one ) )
THEN
431 ELSE IF( lwork.LT.lwmin .AND. ( .NOT.lquery ) )
THEN
439 CALL xerbla(
'SGESVJ', -info )
441 ELSE IF( lquery )
THEN
442 work( 1 ) = sroundup_lwork( lwmin )
448 IF( minmn.EQ.0 )
RETURN
462 IF( lsvec .OR. rsvec .OR. applv )
THEN
463 ctol = sqrt( float( m ) )
471 epsln = slamch(
'Epsilon' )
472 rooteps = sqrt( epsln )
473 sfmin = slamch(
'SafeMinimum' )
474 rootsfmin = sqrt( sfmin )
475 small = sfmin / epsln
476 big = slamch(
'Overflow' )
478 rootbig = one / rootsfmin
479 large = big / sqrt( float( m*n ) )
480 bigtheta = one / rooteps
483 roottol = sqrt( tol )
485 IF( float( m )*epsln.GE.one )
THEN
487 CALL xerbla(
'SGESVJ', -info )
495 CALL slaset(
'A', mvl, n, zero, one, v, ldv )
496 ELSE IF( applv )
THEN
499 rsvec = rsvec .OR. applv
510 skl = one / sqrt( float( m )*float( n ) )
519 CALL slassq( m-p+1, a( p, p ), 1, aapp, aaqq )
520 IF( aapp.GT.big )
THEN
522 CALL xerbla(
'SGESVJ', -info )
526 IF( ( aapp.LT.( big / aaqq ) ) .AND. noscale )
THEN
530 sva( p ) = aapp*( aaqq*skl )
534 sva( q ) = sva( q )*skl
539 ELSE IF( upper )
THEN
544 CALL slassq( p, a( 1, p ), 1, aapp, aaqq )
545 IF( aapp.GT.big )
THEN
547 CALL xerbla(
'SGESVJ', -info )
551 IF( ( aapp.LT.( big / aaqq ) ) .AND. noscale )
THEN
555 sva( p ) = aapp*( aaqq*skl )
559 sva( q ) = sva( q )*skl
569 CALL slassq( m, a( 1, p ), 1, aapp, aaqq )
570 IF( aapp.GT.big )
THEN
572 CALL xerbla(
'SGESVJ', -info )
576 IF( ( aapp.LT.( big / aaqq ) ) .AND. noscale )
THEN
580 sva( p ) = aapp*( aaqq*skl )
584 sva( q ) = sva( q )*skl
591 IF( noscale )skl = one
600 IF( sva( p ).NE.zero )aaqq = min( aaqq, sva( p ) )
601 aapp = max( aapp, sva( p ) )
606 IF( aapp.EQ.zero )
THEN
607 IF( lsvec )
CALL slaset(
'G', m, n, zero, one, a, lda )
620 IF( lsvec )
CALL slascl(
'G', 0, 0, sva( 1 ), skl, m, 1,
621 $ a( 1, 1 ), lda, ierr )
622 work( 1 ) = one / skl
623 IF( sva( 1 ).GE.sfmin )
THEN
638 sn = sqrt( sfmin / epsln )
639 temp1 = sqrt( big / float( n ) )
640 IF( ( aapp.LE.sn ) .OR. ( aaqq.GE.temp1 ) .OR.
641 $ ( ( sn.LE.aaqq ) .AND. ( aapp.LE.temp1 ) ) )
THEN
642 temp1 = min( big, temp1 / aapp )
645 ELSE IF( ( aaqq.LE.sn ) .AND. ( aapp.LE.temp1 ) )
THEN
646 temp1 = min( sn / aaqq, big / ( aapp*sqrt( float( n ) ) ) )
649 ELSE IF( ( aaqq.GE.sn ) .AND. ( aapp.GE.temp1 ) )
THEN
650 temp1 = max( sn / aaqq, temp1 / aapp )
653 ELSE IF( ( aaqq.LE.sn ) .AND. ( aapp.GE.temp1 ) )
THEN
654 temp1 = min( sn / aaqq, big / ( sqrt( float( n ) )*aapp ) )
663 IF( temp1.NE.one )
THEN
664 CALL slascl(
'G', 0, 0, one, temp1, n, 1, sva, n, ierr )
667 IF( skl.NE.one )
THEN
668 CALL slascl( joba, 0, 0, one, skl, m, n, a, lda, ierr )
674 emptsw = ( n*( n-1 ) ) / 2
702 IF( ( nbl*kbl ).NE.n )nbl = nbl + 1
707 rowskip = min( 5, kbl )
718 IF( ( lower .OR. upper ) .AND. ( n.GT.max( 64, 4*kbl ) ) )
THEN
740 CALL sgsvj0( jobv, m-n34, n-n34, a( n34+1, n34+1 ), lda,
741 $ work( n34+1 ), sva( n34+1 ), mvl,
742 $ v( n34*q+1, n34+1 ), ldv, epsln, sfmin, tol,
743 $ 2, work( n+1 ), lwork-n, ierr )
745 CALL sgsvj0( jobv, m-n2, n34-n2, a( n2+1, n2+1 ), lda,
746 $ work( n2+1 ), sva( n2+1 ), mvl,
747 $ v( n2*q+1, n2+1 ), ldv, epsln, sfmin, tol, 2,
748 $ work( n+1 ), lwork-n, ierr )
750 CALL sgsvj1( jobv, m-n2, n-n2, n4, a( n2+1, n2+1 ), lda,
751 $ work( n2+1 ), sva( n2+1 ), mvl,
752 $ v( n2*q+1, n2+1 ), ldv, epsln, sfmin, tol, 1,
753 $ work( n+1 ), lwork-n, ierr )
755 CALL sgsvj0( jobv, m-n4, n2-n4, a( n4+1, n4+1 ), lda,
756 $ work( n4+1 ), sva( n4+1 ), mvl,
757 $ v( n4*q+1, n4+1 ), ldv, epsln, sfmin, tol, 1,
758 $ work( n+1 ), lwork-n, ierr )
760 CALL sgsvj0( jobv, m, n4, a, lda, work, sva, mvl, v, ldv,
761 $ epsln, sfmin, tol, 1, work( n+1 ), lwork-n,
764 CALL sgsvj1( jobv, m, n2, n4, a, lda, work, sva, mvl, v,
765 $ ldv, epsln, sfmin, tol, 1, work( n+1 ),
769 ELSE IF( upper )
THEN
772 CALL sgsvj0( jobv, n4, n4, a, lda, work, sva, mvl, v,
774 $ epsln, sfmin, tol, 2, work( n+1 ), lwork-n,
777 CALL sgsvj0( jobv, n2, n4, a( 1, n4+1 ), lda,
779 $ sva( n4+1 ), mvl, v( n4*q+1, n4+1 ), ldv,
780 $ epsln, sfmin, tol, 1, work( n+1 ), lwork-n,
783 CALL sgsvj1( jobv, n2, n2, n4, a, lda, work, sva, mvl, v,
784 $ ldv, epsln, sfmin, tol, 1, work( n+1 ),
787 CALL sgsvj0( jobv, n2+n4, n4, a( 1, n2+1 ), lda,
788 $ work( n2+1 ), sva( n2+1 ), mvl,
789 $ v( n2*q+1, n2+1 ), ldv, epsln, sfmin, tol, 1,
790 $ work( n+1 ), lwork-n, ierr )
798 DO 1993 i = 1, nsweep
816 igl = ( ibr-1 )*kbl + 1
818 DO 1002 ir1 = 0, min( lkahead, nbl-ibr )
822 DO 2001 p = igl, min( igl+kbl-1, n-1 )
826 q = isamax( n-p+1, sva( p ), 1 ) + p - 1
828 CALL sswap( m, a( 1, p ), 1, a( 1, q ), 1 )
829 IF( rsvec )
CALL sswap( mvl, v( 1, p ), 1,
835 work( p ) = work( q )
853 IF( ( sva( p ).LT.rootbig ) .AND.
854 $ ( sva( p ).GT.rootsfmin ) )
THEN
855 sva( p ) = snrm2( m, a( 1, p ), 1 )*work( p )
859 CALL slassq( m, a( 1, p ), 1, temp1, aapp )
860 sva( p ) = temp1*sqrt( aapp )*work( p )
867 IF( aapp.GT.zero )
THEN
871 DO 2002 q = p + 1, min( igl+kbl-1, n )
875 IF( aaqq.GT.zero )
THEN
878 IF( aaqq.GE.one )
THEN
879 rotok = ( small*aapp ).LE.aaqq
880 IF( aapp.LT.( big / aaqq ) )
THEN
881 aapq = ( sdot( m, a( 1, p ), 1,
883 $ q ), 1 )*work( p )*work( q ) /
886 CALL scopy( m, a( 1, p ), 1,
888 CALL slascl(
'G', 0, 0, aapp,
890 $ work( n+1 ), lda, ierr )
891 aapq = sdot( m, work( n+1 ), 1,
892 $ a( 1, q ), 1 )*work( q ) / aaqq
895 rotok = aapp.LE.( aaqq / small )
896 IF( aapp.GT.( small / aaqq ) )
THEN
897 aapq = ( sdot( m, a( 1, p ), 1,
899 $ q ), 1 )*work( p )*work( q ) /
902 CALL scopy( m, a( 1, q ), 1,
904 CALL slascl(
'G', 0, 0, aaqq,
906 $ work( n+1 ), lda, ierr )
907 aapq = sdot( m, work( n+1 ), 1,
908 $ a( 1, p ), 1 )*work( p ) / aapp
912 mxaapq = max( mxaapq, abs( aapq ) )
916 IF( abs( aapq ).GT.tol )
THEN
931 theta = -half*abs( aqoap-apoaq ) / aapq
933 IF( abs( theta ).GT.bigtheta )
THEN
936 fastr( 3 ) = t*work( p ) / work( q )
937 fastr( 4 ) = -t*work( q ) /
939 CALL srotm( m, a( 1, p ), 1,
940 $ a( 1, q ), 1, fastr )
941 IF( rsvec )
CALL srotm( mvl,
945 sva( q ) = aaqq*sqrt( max( zero,
946 $ one+t*apoaq*aapq ) )
947 aapp = aapp*sqrt( max( zero,
948 $ one-t*aqoap*aapq ) )
949 mxsinj = max( mxsinj, abs( t ) )
955 thsign = -sign( one, aapq )
956 t = one / ( theta+thsign*
957 $ sqrt( one+theta*theta ) )
958 cs = sqrt( one / ( one+t*t ) )
961 mxsinj = max( mxsinj, abs( sn ) )
962 sva( q ) = aaqq*sqrt( max( zero,
963 $ one+t*apoaq*aapq ) )
964 aapp = aapp*sqrt( max( zero,
965 $ one-t*aqoap*aapq ) )
967 apoaq = work( p ) / work( q )
968 aqoap = work( q ) / work( p )
969 IF( work( p ).GE.one )
THEN
970 IF( work( q ).GE.one )
THEN
972 fastr( 4 ) = -t*aqoap
973 work( p ) = work( p )*cs
974 work( q ) = work( q )*cs
975 CALL srotm( m, a( 1, p ),
979 IF( rsvec )
CALL srotm( mvl,
980 $ v( 1, p ), 1, v( 1, q ),
983 CALL saxpy( m, -t*aqoap,
986 CALL saxpy( m, cs*sn*apoaq,
989 work( p ) = work( p )*cs
990 work( q ) = work( q ) / cs
1003 IF( work( q ).GE.one )
THEN
1004 CALL saxpy( m, t*apoaq,
1011 work( p ) = work( p ) / cs
1012 work( q ) = work( q )*cs
1024 IF( work( p ).GE.work( q ) )
1026 CALL saxpy( m, -t*aqoap,
1033 work( p ) = work( p )*cs
1034 work( q ) = work( q ) / cs
1046 CALL saxpy( m, t*apoaq,
1053 work( p ) = work( p ) / cs
1054 work( q ) = work( q )*cs
1057 $ t*apoaq, v( 1, p ),
1071 CALL scopy( m, a( 1, p ), 1,
1073 CALL slascl(
'G', 0, 0, aapp, one,
1075 $ 1, work( n+1 ), lda,
1077 CALL slascl(
'G', 0, 0, aaqq, one,
1079 $ 1, a( 1, q ), lda, ierr )
1080 temp1 = -aapq*work( p ) / work( q )
1081 CALL saxpy( m, temp1, work( n+1 ),
1084 CALL slascl(
'G', 0, 0, one, aaqq,
1086 $ 1, a( 1, q ), lda, ierr )
1087 sva( q ) = aaqq*sqrt( max( zero,
1089 mxsinj = max( mxsinj, sfmin )
1096 IF( ( sva( q ) / aaqq )**2.LE.rooteps )
1098 IF( ( aaqq.LT.rootbig ) .AND.
1099 $ ( aaqq.GT.rootsfmin ) )
THEN
1100 sva( q ) = snrm2( m, a( 1, q ),
1106 CALL slassq( m, a( 1, q ), 1, t,
1108 sva( q ) = t*sqrt( aaqq )*work( q )
1111 IF( ( aapp / aapp0 ).LE.rooteps )
THEN
1112 IF( ( aapp.LT.rootbig ) .AND.
1113 $ ( aapp.GT.rootsfmin ) )
THEN
1114 aapp = snrm2( m, a( 1, p ), 1 )*
1119 CALL slassq( m, a( 1, p ), 1, t,
1121 aapp = t*sqrt( aapp )*work( p )
1128 IF( ir1.EQ.0 )notrot = notrot + 1
1130 pskipped = pskipped + 1
1134 IF( ir1.EQ.0 )notrot = notrot + 1
1135 pskipped = pskipped + 1
1138 IF( ( i.LE.swband ) .AND.
1139 $ ( pskipped.GT.rowskip ) )
THEN
1140 IF( ir1.EQ.0 )aapp = -aapp
1155 IF( ( ir1.EQ.0 ) .AND. ( aapp.EQ.zero ) )
1156 $ notrot = notrot + min( igl+kbl-1, n ) - p
1167 igl = ( ibr-1 )*kbl + 1
1169 DO 2010 jbc = ibr + 1, nbl
1171 jgl = ( jbc-1 )*kbl + 1
1176 DO 2100 p = igl, min( igl+kbl-1, n )
1179 IF( aapp.GT.zero )
THEN
1183 DO 2200 q = jgl, min( jgl+kbl-1, n )
1186 IF( aaqq.GT.zero )
THEN
1193 IF( aaqq.GE.one )
THEN
1194 IF( aapp.GE.aaqq )
THEN
1195 rotok = ( small*aapp ).LE.aaqq
1197 rotok = ( small*aaqq ).LE.aapp
1199 IF( aapp.LT.( big / aaqq ) )
THEN
1200 aapq = ( sdot( m, a( 1, p ), 1,
1202 $ q ), 1 )*work( p )*work( q ) /
1205 CALL scopy( m, a( 1, p ), 1,
1207 CALL slascl(
'G', 0, 0, aapp,
1209 $ work( n+1 ), lda, ierr )
1210 aapq = sdot( m, work( n+1 ), 1,
1211 $ a( 1, q ), 1 )*work( q ) / aaqq
1214 IF( aapp.GE.aaqq )
THEN
1215 rotok = aapp.LE.( aaqq / small )
1217 rotok = aaqq.LE.( aapp / small )
1219 IF( aapp.GT.( small / aaqq ) )
THEN
1220 aapq = ( sdot( m, a( 1, p ), 1,
1222 $ q ), 1 )*work( p )*work( q ) /
1225 CALL scopy( m, a( 1, q ), 1,
1227 CALL slascl(
'G', 0, 0, aaqq,
1229 $ work( n+1 ), lda, ierr )
1230 aapq = sdot( m, work( n+1 ), 1,
1231 $ a( 1, p ), 1 )*work( p ) / aapp
1235 mxaapq = max( mxaapq, abs( aapq ) )
1239 IF( abs( aapq ).GT.tol )
THEN
1249 theta = -half*abs( aqoap-apoaq ) / aapq
1250 IF( aaqq.GT.aapp0 )theta = -theta
1252 IF( abs( theta ).GT.bigtheta )
THEN
1254 fastr( 3 ) = t*work( p ) / work( q )
1255 fastr( 4 ) = -t*work( q ) /
1257 CALL srotm( m, a( 1, p ), 1,
1258 $ a( 1, q ), 1, fastr )
1259 IF( rsvec )
CALL srotm( mvl,
1263 sva( q ) = aaqq*sqrt( max( zero,
1264 $ one+t*apoaq*aapq ) )
1265 aapp = aapp*sqrt( max( zero,
1266 $ one-t*aqoap*aapq ) )
1267 mxsinj = max( mxsinj, abs( t ) )
1272 thsign = -sign( one, aapq )
1273 IF( aaqq.GT.aapp0 )thsign = -thsign
1274 t = one / ( theta+thsign*
1275 $ sqrt( one+theta*theta ) )
1276 cs = sqrt( one / ( one+t*t ) )
1278 mxsinj = max( mxsinj, abs( sn ) )
1279 sva( q ) = aaqq*sqrt( max( zero,
1280 $ one+t*apoaq*aapq ) )
1281 aapp = aapp*sqrt( max( zero,
1282 $ one-t*aqoap*aapq ) )
1284 apoaq = work( p ) / work( q )
1285 aqoap = work( q ) / work( p )
1286 IF( work( p ).GE.one )
THEN
1288 IF( work( q ).GE.one )
THEN
1289 fastr( 3 ) = t*apoaq
1290 fastr( 4 ) = -t*aqoap
1291 work( p ) = work( p )*cs
1292 work( q ) = work( q )*cs
1293 CALL srotm( m, a( 1, p ),
1297 IF( rsvec )
CALL srotm( mvl,
1298 $ v( 1, p ), 1, v( 1, q ),
1301 CALL saxpy( m, -t*aqoap,
1304 CALL saxpy( m, cs*sn*apoaq,
1317 work( p ) = work( p )*cs
1318 work( q ) = work( q ) / cs
1321 IF( work( q ).GE.one )
THEN
1322 CALL saxpy( m, t*apoaq,
1339 work( p ) = work( p ) / cs
1340 work( q ) = work( q )*cs
1342 IF( work( p ).GE.work( q ) )
1344 CALL saxpy( m, -t*aqoap,
1351 work( p ) = work( p )*cs
1352 work( q ) = work( q ) / cs
1364 CALL saxpy( m, t*apoaq,
1371 work( p ) = work( p ) / cs
1372 work( q ) = work( q )*cs
1375 $ t*apoaq, v( 1, p ),
1388 IF( aapp.GT.aaqq )
THEN
1389 CALL scopy( m, a( 1, p ), 1,
1391 CALL slascl(
'G', 0, 0, aapp,
1393 $ m, 1, work( n+1 ), lda,
1395 CALL slascl(
'G', 0, 0, aaqq,
1397 $ m, 1, a( 1, q ), lda,
1399 temp1 = -aapq*work( p ) / work( q )
1400 CALL saxpy( m, temp1,
1403 CALL slascl(
'G', 0, 0, one,
1405 $ m, 1, a( 1, q ), lda,
1407 sva( q ) = aaqq*sqrt( max( zero,
1409 mxsinj = max( mxsinj, sfmin )
1411 CALL scopy( m, a( 1, q ), 1,
1413 CALL slascl(
'G', 0, 0, aaqq,
1415 $ m, 1, work( n+1 ), lda,
1417 CALL slascl(
'G', 0, 0, aapp,
1419 $ m, 1, a( 1, p ), lda,
1421 temp1 = -aapq*work( q ) / work( p )
1422 CALL saxpy( m, temp1,
1425 CALL slascl(
'G', 0, 0, one,
1427 $ m, 1, a( 1, p ), lda,
1429 sva( p ) = aapp*sqrt( max( zero,
1431 mxsinj = max( mxsinj, sfmin )
1438 IF( ( sva( q ) / aaqq )**2.LE.rooteps )
1440 IF( ( aaqq.LT.rootbig ) .AND.
1441 $ ( aaqq.GT.rootsfmin ) )
THEN
1442 sva( q ) = snrm2( m, a( 1, q ),
1448 CALL slassq( m, a( 1, q ), 1, t,
1450 sva( q ) = t*sqrt( aaqq )*work( q )
1453 IF( ( aapp / aapp0 )**2.LE.rooteps )
THEN
1454 IF( ( aapp.LT.rootbig ) .AND.
1455 $ ( aapp.GT.rootsfmin ) )
THEN
1456 aapp = snrm2( m, a( 1, p ), 1 )*
1461 CALL slassq( m, a( 1, p ), 1, t,
1463 aapp = t*sqrt( aapp )*work( p )
1471 pskipped = pskipped + 1
1476 pskipped = pskipped + 1
1480 IF( ( i.LE.swband ) .AND. ( ijblsk.GE.blskip ) )
1486 IF( ( i.LE.swband ) .AND.
1487 $ ( pskipped.GT.rowskip ) )
THEN
1501 IF( aapp.EQ.zero )notrot = notrot +
1502 $ min( jgl+kbl-1, n ) - jgl + 1
1503 IF( aapp.LT.zero )notrot = 0
1513 DO 2012 p = igl, min( igl+kbl-1, n )
1514 sva( p ) = abs( sva( p ) )
1521 IF( ( sva( n ).LT.rootbig ) .AND. ( sva( n ).GT.rootsfmin ) )
1523 sva( n ) = snrm2( m, a( 1, n ), 1 )*work( n )
1527 CALL slassq( m, a( 1, n ), 1, t, aapp )
1528 sva( n ) = t*sqrt( aapp )*work( n )
1533 IF( ( i.LT.swband ) .AND. ( ( mxaapq.LE.roottol ) .OR.
1534 $ ( iswrot.LE.n ) ) )swband = i
1536 IF( ( i.GT.swband+1 ) .AND. ( mxaapq.LT.sqrt( float( n ) )*
1537 $ tol ) .AND. ( float( n )*mxaapq*mxsinj.LT.tol ) )
THEN
1541 IF( notrot.GE.emptsw )
GO TO 1994
1563 DO 5991 p = 1, n - 1
1564 q = isamax( n-p+1, sva( p ), 1 ) + p - 1
1570 work( p ) = work( q )
1572 CALL sswap( m, a( 1, p ), 1, a( 1, q ), 1 )
1573 IF( rsvec )
CALL sswap( mvl, v( 1, p ), 1, v( 1, q ), 1 )
1575 IF( sva( p ).NE.zero )
THEN
1577 IF( sva( p )*skl.GT.sfmin )n2 = n2 + 1
1580 IF( sva( n ).NE.zero )
THEN
1582 IF( sva( n )*skl.GT.sfmin )n2 = n2 + 1
1587 IF( lsvec .OR. uctol )
THEN
1589 CALL sscal( m, work( p ) / sva( p ), a( 1, p ), 1 )
1598 CALL sscal( mvl, work( p ), v( 1, p ), 1 )
1602 temp1 = one / snrm2( mvl, v( 1, p ), 1 )
1603 CALL sscal( mvl, temp1, v( 1, p ), 1 )
1609 IF( ( ( skl.GT.one ) .AND. ( sva( 1 ).LT.( big / skl ) ) )
1610 $ .OR. ( ( skl.LT.one ) .AND. ( sva( max( n2, 1 ) ) .GT.
1611 $ ( sfmin / skl ) ) ) )
THEN
1613 sva( p ) = skl*sva( p )
1623 work( 2 ) = float( n4 )
1626 work( 3 ) = float( n2 )
1631 work( 4 ) = float( i )