349 SUBROUTINE zgesvj( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V,
350 $ ldv, cwork, lwork, rwork, lrwork, info )
359 INTEGER INFO, LDA, LDV, LWORK, LRWORK, M, MV, N
360 CHARACTER*1 JOBA, JOBU, JOBV
363 COMPLEX*16 A( lda, * ), V( ldv, * ), CWORK( lwork )
364 DOUBLE PRECISION RWORK( lrwork ), SVA( n )
370 DOUBLE PRECISION ZERO, HALF, ONE
371 parameter( zero = 0.0d0, half = 0.5d0, one = 1.0d0)
372 COMPLEX*16 CZERO, CONE
373 parameter( czero = (0.0d0, 0.0d0), cone = (1.0d0, 0.0d0) )
375 parameter( nsweep = 30 )
378 COMPLEX*16 AAPQ, OMPQ
379 DOUBLE PRECISION AAPP, AAPP0, AAPQ1, AAQQ, APOAQ, AQOAP, BIG,
380 $ bigtheta, cs, ctol, epsln, mxaapq,
381 $ mxsinj, rootbig, rooteps, rootsfmin, roottol,
382 $ skl, sfmin, small, sn, t, temp1, theta, thsign, tol
383 INTEGER BLSKIP, EMPTSW, i, ibr, IERR, igl, IJBLSK, ir1,
384 $ iswrot, jbc, jgl, kbl, lkahead, mvl, n2, n34,
385 $ n4, nbl, notrot, p, pskipped, q, rowskip, swband
386 LOGICAL APPLV, GOSCALE, LOWER, LQUERY, LSVEC, NOSCALE, ROTOK,
387 $ rsvec, uctol, upper
391 INTRINSIC abs, max, min, conjg, dble, sign, sqrt
396 DOUBLE PRECISION DZNRM2
398 EXTERNAL zdotc, dznrm2
402 DOUBLE PRECISION DLAMCH
419 lsvec = lsame( jobu,
'U' ) .OR. lsame( jobu,
'F' )
420 uctol = lsame( jobu,
'C' )
421 rsvec = lsame( jobv,
'V' ) .OR. lsame( jobv,
'J' )
422 applv = lsame( jobv,
'A' )
423 upper = lsame( joba,
'U' )
424 lower = lsame( joba,
'L' )
426 lquery = ( lwork .EQ. -1 ) .OR. ( lrwork .EQ. -1 )
427 IF( .NOT.( upper .OR. lower .OR. lsame( joba,
'G' ) ) )
THEN
429 ELSE IF( .NOT.( lsvec .OR. uctol .OR. lsame( jobu,
'N' ) ) )
THEN
431 ELSE IF( .NOT.( rsvec .OR. applv .OR. lsame( jobv,
'N' ) ) )
THEN
433 ELSE IF( m.LT.0 )
THEN
435 ELSE IF( ( n.LT.0 ) .OR. ( n.GT.m ) )
THEN
437 ELSE IF( lda.LT.m )
THEN
439 ELSE IF( mv.LT.0 )
THEN
441 ELSE IF( ( rsvec .AND. ( ldv.LT.n ) ) .OR.
442 $ ( applv .AND. ( ldv.LT.mv ) ) )
THEN
444 ELSE IF( uctol .AND. ( rwork( 1 ).LE.one ) )
THEN
446 ELSE IF( ( lwork.LT.( m+n ) ) .AND. ( .NOT.lquery ) )
THEN
448 ELSE IF( ( lrwork.LT.max( n, 6 ) ) .AND. ( .NOT.lquery ) )
THEN
456 CALL xerbla(
'ZGESVJ', -info )
458 ELSE IF ( lquery )
THEN
460 rwork(1) = max( n, 6 )
466 IF( ( m.EQ.0 ) .OR. ( n.EQ.0 ) )
RETURN
480 IF( lsvec .OR. rsvec .OR. applv )
THEN
481 ctol = sqrt( dble( m ) )
489 epsln = dlamch(
'Epsilon' )
490 rooteps = sqrt( epsln )
491 sfmin = dlamch(
'SafeMinimum' )
492 rootsfmin = sqrt( sfmin )
493 small = sfmin / epsln
494 big = dlamch(
'Overflow' )
496 rootbig = one / rootsfmin
498 bigtheta = one / rooteps
501 roottol = sqrt( tol )
503 IF( dble( m )*epsln.GE.one )
THEN
505 CALL xerbla(
'ZGESVJ', -info )
513 CALL zlaset(
'A', mvl, n, czero, cone, v, ldv )
514 ELSE IF( applv )
THEN
517 rsvec = rsvec .OR. applv
528 skl = one / sqrt( dble( m )*dble( n ) )
537 CALL zlassq( m-p+1, a( p, p ), 1, aapp, aaqq )
538 IF( aapp.GT.big )
THEN
540 CALL xerbla(
'ZGESVJ', -info )
544 IF( ( aapp.LT.( big / aaqq ) ) .AND. noscale )
THEN
548 sva( p ) = aapp*( aaqq*skl )
552 sva( q ) = sva( q )*skl
557 ELSE IF( upper )
THEN
562 CALL zlassq( p, a( 1, p ), 1, aapp, aaqq )
563 IF( aapp.GT.big )
THEN
565 CALL xerbla(
'ZGESVJ', -info )
569 IF( ( aapp.LT.( big / aaqq ) ) .AND. noscale )
THEN
573 sva( p ) = aapp*( aaqq*skl )
577 sva( q ) = sva( q )*skl
587 CALL zlassq( m, a( 1, p ), 1, aapp, aaqq )
588 IF( aapp.GT.big )
THEN
590 CALL xerbla(
'ZGESVJ', -info )
594 IF( ( aapp.LT.( big / aaqq ) ) .AND. noscale )
THEN
598 sva( p ) = aapp*( aaqq*skl )
602 sva( q ) = sva( q )*skl
609 IF( noscale )skl = one
618 IF( sva( p ).NE.zero )aaqq = min( aaqq, sva( p ) )
619 aapp = max( aapp, sva( p ) )
624 IF( aapp.EQ.zero )
THEN
625 IF( lsvec )
CALL zlaset(
'G', m, n, czero, cone, a, lda )
638 IF( lsvec )
CALL zlascl(
'G', 0, 0, sva( 1 ), skl, m, 1,
639 $ a( 1, 1 ), lda, ierr )
640 rwork( 1 ) = one / skl
641 IF( sva( 1 ).GE.sfmin )
THEN
656 sn = sqrt( sfmin / epsln )
657 temp1 = sqrt( big / dble( n ) )
658 IF( ( aapp.LE.sn ) .OR. ( aaqq.GE.temp1 ) .OR.
659 $ ( ( sn.LE.aaqq ) .AND. ( aapp.LE.temp1 ) ) )
THEN
660 temp1 = min( big, temp1 / aapp )
663 ELSE IF( ( aaqq.LE.sn ) .AND. ( aapp.LE.temp1 ) )
THEN
664 temp1 = min( sn / aaqq, big / (aapp*sqrt( dble(n)) ) )
667 ELSE IF( ( aaqq.GE.sn ) .AND. ( aapp.GE.temp1 ) )
THEN
668 temp1 = max( sn / aaqq, temp1 / aapp )
671 ELSE IF( ( aaqq.LE.sn ) .AND. ( aapp.GE.temp1 ) )
THEN
672 temp1 = min( sn / aaqq, big / ( sqrt( dble( n ) )*aapp ) )
681 IF( temp1.NE.one )
THEN
682 CALL dlascl(
'G', 0, 0, one, temp1, n, 1, sva, n, ierr )
685 IF( skl.NE.one )
THEN
686 CALL zlascl( joba, 0, 0, one, skl, m, n, a, lda, ierr )
692 emptsw = ( n*( n-1 ) ) / 2
716 IF( ( nbl*kbl ).NE.n )nbl = nbl + 1
721 rowskip = min( 5, kbl )
732 IF( ( lower .OR. upper ) .AND. ( n.GT.max( 64, 4*kbl ) ) )
THEN
754 CALL zgsvj0( jobv, m-n34, n-n34, a( n34+1, n34+1 ), lda,
755 $ cwork( n34+1 ), sva( n34+1 ), mvl,
756 $ v( n34*q+1, n34+1 ), ldv, epsln, sfmin, tol,
757 $ 2, cwork( n+1 ), lwork-n, ierr )
759 CALL zgsvj0( jobv, m-n2, n34-n2, a( n2+1, n2+1 ), lda,
760 $ cwork( n2+1 ), sva( n2+1 ), mvl,
761 $ v( n2*q+1, n2+1 ), ldv, epsln, sfmin, tol, 2,
762 $ cwork( n+1 ), lwork-n, ierr )
764 CALL zgsvj1( jobv, m-n2, n-n2, n4, a( n2+1, n2+1 ), lda,
765 $ cwork( n2+1 ), sva( n2+1 ), mvl,
766 $ v( n2*q+1, n2+1 ), ldv, epsln, sfmin, tol, 1,
767 $ cwork( n+1 ), lwork-n, ierr )
769 CALL zgsvj0( jobv, m-n4, n2-n4, a( n4+1, n4+1 ), lda,
770 $ cwork( n4+1 ), sva( n4+1 ), mvl,
771 $ v( n4*q+1, n4+1 ), ldv, epsln, sfmin, tol, 1,
772 $ cwork( n+1 ), lwork-n, ierr )
774 CALL zgsvj0( jobv, m, n4, a, lda, cwork, sva, mvl, v, ldv,
775 $ epsln, sfmin, tol, 1, cwork( n+1 ), lwork-n,
778 CALL zgsvj1( jobv, m, n2, n4, a, lda, cwork, sva, mvl, v,
779 $ ldv, epsln, sfmin, tol, 1, cwork( n+1 ),
783 ELSE IF( upper )
THEN
786 CALL zgsvj0( jobv, n4, n4, a, lda, cwork, sva, mvl, v, ldv,
787 $ epsln, sfmin, tol, 2, cwork( n+1 ), lwork-n,
790 CALL zgsvj0( jobv, n2, n4, a( 1, n4+1 ), lda, cwork( n4+1 ),
791 $ sva( n4+1 ), mvl, v( n4*q+1, n4+1 ), ldv,
792 $ epsln, sfmin, tol, 1, cwork( n+1 ), lwork-n,
795 CALL zgsvj1( jobv, n2, n2, n4, a, lda, cwork, sva, mvl, v,
796 $ ldv, epsln, sfmin, tol, 1, cwork( n+1 ),
799 CALL zgsvj0( jobv, n2+n4, n4, a( 1, n2+1 ), lda,
800 $ cwork( n2+1 ), sva( n2+1 ), mvl,
801 $ v( n2*q+1, n2+1 ), ldv, epsln, sfmin, tol, 1,
802 $ cwork( n+1 ), lwork-n, ierr )
810 DO 1993 i = 1, nsweep
828 igl = ( ibr-1 )*kbl + 1
830 DO 1002 ir1 = 0, min( lkahead, nbl-ibr )
834 DO 2001 p = igl, min( igl+kbl-1, n-1 )
838 q = idamax( n-p+1, sva( p ), 1 ) + p - 1
840 CALL zswap( m, a( 1, p ), 1, a( 1, q ), 1 )
841 IF( rsvec )
CALL zswap( mvl, v( 1, p ), 1,
865 IF( ( sva( p ).LT.rootbig ) .AND.
866 $ ( sva( p ).GT.rootsfmin ) )
THEN
867 sva( p ) = dznrm2( m, a( 1, p ), 1 )
871 CALL zlassq( m, a( 1, p ), 1, temp1, aapp )
872 sva( p ) = temp1*sqrt( aapp )
879 IF( aapp.GT.zero )
THEN
883 DO 2002 q = p + 1, min( igl+kbl-1, n )
887 IF( aaqq.GT.zero )
THEN
890 IF( aaqq.GE.one )
THEN
891 rotok = ( small*aapp ).LE.aaqq
892 IF( aapp.LT.( big / aaqq ) )
THEN
893 aapq = ( zdotc( m, a( 1, p ), 1,
894 $ a( 1, q ), 1 ) / aaqq ) / aapp
896 CALL zcopy( m, a( 1, p ), 1,
898 CALL zlascl(
'G', 0, 0, aapp, one,
899 $ m, 1, cwork(n+1), lda, ierr )
900 aapq = zdotc( m, cwork(n+1), 1,
901 $ a( 1, q ), 1 ) / aaqq
904 rotok = aapp.LE.( aaqq / small )
905 IF( aapp.GT.( small / aaqq ) )
THEN
906 aapq = ( zdotc( m, a( 1, p ), 1,
907 $ a( 1, q ), 1 ) / aapp ) / aaqq
909 CALL zcopy( m, a( 1, q ), 1,
911 CALL zlascl(
'G', 0, 0, aaqq,
913 $ cwork(n+1), lda, ierr )
914 aapq = zdotc( m, a(1, p ), 1,
915 $ cwork(n+1), 1 ) / aapp
922 mxaapq = max( mxaapq, -aapq1 )
926 IF( abs( aapq1 ).GT.tol )
THEN
927 ompq = aapq / abs(aapq)
942 theta = -half*abs( aqoap-apoaq )/aapq1
944 IF( abs( theta ).GT.bigtheta )
THEN
949 CALL zrot( m, a(1,p), 1, a(1,q), 1,
950 $ cs, conjg(ompq)*t )
952 CALL zrot( mvl, v(1,p), 1,
953 $ v(1,q), 1, cs, conjg(ompq)*t )
956 sva( q ) = aaqq*sqrt( max( zero,
957 $ one+t*apoaq*aapq1 ) )
958 aapp = aapp*sqrt( max( zero,
959 $ one-t*aqoap*aapq1 ) )
960 mxsinj = max( mxsinj, abs( t ) )
966 thsign = -sign( one, aapq1 )
967 t = one / ( theta+thsign*
968 $ sqrt( one+theta*theta ) )
969 cs = sqrt( one / ( one+t*t ) )
972 mxsinj = max( mxsinj, abs( sn ) )
973 sva( q ) = aaqq*sqrt( max( zero,
974 $ one+t*apoaq*aapq1 ) )
975 aapp = aapp*sqrt( max( zero,
976 $ one-t*aqoap*aapq1 ) )
978 CALL zrot( m, a(1,p), 1, a(1,q), 1,
979 $ cs, conjg(ompq)*sn )
981 CALL zrot( mvl, v(1,p), 1,
982 $ v(1,q), 1, cs, conjg(ompq)*sn )
985 cwork(p) = -cwork(q) * ompq
989 CALL zcopy( m, a( 1, p ), 1,
991 CALL zlascl(
'G', 0, 0, aapp, one, m,
992 $ 1, cwork(n+1), lda,
994 CALL zlascl(
'G', 0, 0, aaqq, one, m,
995 $ 1, a( 1, q ), lda, ierr )
996 CALL zaxpy( m, -aapq, cwork(n+1), 1,
998 CALL zlascl(
'G', 0, 0, one, aaqq, m,
999 $ 1, a( 1, q ), lda, ierr )
1000 sva( q ) = aaqq*sqrt( max( zero,
1001 $ one-aapq1*aapq1 ) )
1002 mxsinj = max( mxsinj, sfmin )
1009 IF( ( sva( q ) / aaqq )**2.LE.rooteps )
1011 IF( ( aaqq.LT.rootbig ) .AND.
1012 $ ( aaqq.GT.rootsfmin ) )
THEN
1013 sva( q ) = dznrm2( m, a( 1, q ), 1 )
1017 CALL zlassq( m, a( 1, q ), 1, t,
1019 sva( q ) = t*sqrt( aaqq )
1022 IF( ( aapp / aapp0 ).LE.rooteps )
THEN
1023 IF( ( aapp.LT.rootbig ) .AND.
1024 $ ( aapp.GT.rootsfmin ) )
THEN
1025 aapp = dznrm2( m, a( 1, p ), 1 )
1029 CALL zlassq( m, a( 1, p ), 1, t,
1031 aapp = t*sqrt( aapp )
1038 IF( ir1.EQ.0 )notrot = notrot + 1
1040 pskipped = pskipped + 1
1044 IF( ir1.EQ.0 )notrot = notrot + 1
1045 pskipped = pskipped + 1
1048 IF( ( i.LE.swband ) .AND.
1049 $ ( pskipped.GT.rowskip ) )
THEN
1050 IF( ir1.EQ.0 )aapp = -aapp
1065 IF( ( ir1.EQ.0 ) .AND. ( aapp.EQ.zero ) )
1066 $ notrot = notrot + min( igl+kbl-1, n ) - p
1077 igl = ( ibr-1 )*kbl + 1
1079 DO 2010 jbc = ibr + 1, nbl
1081 jgl = ( jbc-1 )*kbl + 1
1086 DO 2100 p = igl, min( igl+kbl-1, n )
1089 IF( aapp.GT.zero )
THEN
1093 DO 2200 q = jgl, min( jgl+kbl-1, n )
1096 IF( aaqq.GT.zero )
THEN
1103 IF( aaqq.GE.one )
THEN
1104 IF( aapp.GE.aaqq )
THEN
1105 rotok = ( small*aapp ).LE.aaqq
1107 rotok = ( small*aaqq ).LE.aapp
1109 IF( aapp.LT.( big / aaqq ) )
THEN
1110 aapq = ( zdotc( m, a( 1, p ), 1,
1111 $ a( 1, q ), 1 ) / aaqq ) / aapp
1113 CALL zcopy( m, a( 1, p ), 1,
1115 CALL zlascl(
'G', 0, 0, aapp,
1117 $ cwork(n+1), lda, ierr )
1118 aapq = zdotc( m, cwork(n+1), 1,
1119 $ a( 1, q ), 1 ) / aaqq
1122 IF( aapp.GE.aaqq )
THEN
1123 rotok = aapp.LE.( aaqq / small )
1125 rotok = aaqq.LE.( aapp / small )
1127 IF( aapp.GT.( small / aaqq ) )
THEN
1128 aapq = ( zdotc( m, a( 1, p ), 1,
1129 $ a( 1, q ), 1 ) / max(aaqq,aapp) )
1132 CALL zcopy( m, a( 1, q ), 1,
1134 CALL zlascl(
'G', 0, 0, aaqq,
1136 $ cwork(n+1), lda, ierr )
1137 aapq = zdotc( m, a( 1, p ), 1,
1138 $ cwork(n+1), 1 ) / aapp
1145 mxaapq = max( mxaapq, -aapq1 )
1149 IF( abs( aapq1 ).GT.tol )
THEN
1150 ompq = aapq / abs(aapq)
1160 theta = -half*abs( aqoap-apoaq )/ aapq1
1161 IF( aaqq.GT.aapp0 )theta = -theta
1163 IF( abs( theta ).GT.bigtheta )
THEN
1166 CALL zrot( m, a(1,p), 1, a(1,q), 1,
1167 $ cs, conjg(ompq)*t )
1169 CALL zrot( mvl, v(1,p), 1,
1170 $ v(1,q), 1, cs, conjg(ompq)*t )
1172 sva( q ) = aaqq*sqrt( max( zero,
1173 $ one+t*apoaq*aapq1 ) )
1174 aapp = aapp*sqrt( max( zero,
1175 $ one-t*aqoap*aapq1 ) )
1176 mxsinj = max( mxsinj, abs( t ) )
1181 thsign = -sign( one, aapq1 )
1182 IF( aaqq.GT.aapp0 )thsign = -thsign
1183 t = one / ( theta+thsign*
1184 $ sqrt( one+theta*theta ) )
1185 cs = sqrt( one / ( one+t*t ) )
1187 mxsinj = max( mxsinj, abs( sn ) )
1188 sva( q ) = aaqq*sqrt( max( zero,
1189 $ one+t*apoaq*aapq1 ) )
1190 aapp = aapp*sqrt( max( zero,
1191 $ one-t*aqoap*aapq1 ) )
1193 CALL zrot( m, a(1,p), 1, a(1,q), 1,
1194 $ cs, conjg(ompq)*sn )
1196 CALL zrot( mvl, v(1,p), 1,
1197 $ v(1,q), 1, cs, conjg(ompq)*sn )
1200 cwork(p) = -cwork(q) * ompq
1204 IF( aapp.GT.aaqq )
THEN
1205 CALL zcopy( m, a( 1, p ), 1,
1207 CALL zlascl(
'G', 0, 0, aapp, one,
1208 $ m, 1, cwork(n+1),lda,
1210 CALL zlascl(
'G', 0, 0, aaqq, one,
1211 $ m, 1, a( 1, q ), lda,
1213 CALL zaxpy( m, -aapq, cwork(n+1),
1215 CALL zlascl(
'G', 0, 0, one, aaqq,
1216 $ m, 1, a( 1, q ), lda,
1218 sva( q ) = aaqq*sqrt( max( zero,
1219 $ one-aapq1*aapq1 ) )
1220 mxsinj = max( mxsinj, sfmin )
1222 CALL zcopy( m, a( 1, q ), 1,
1224 CALL zlascl(
'G', 0, 0, aaqq, one,
1225 $ m, 1, cwork(n+1),lda,
1227 CALL zlascl(
'G', 0, 0, aapp, one,
1228 $ m, 1, a( 1, p ), lda,
1230 CALL zaxpy( m, -conjg(aapq),
1231 $ cwork(n+1), 1, a( 1, p ), 1 )
1232 CALL zlascl(
'G', 0, 0, one, aapp,
1233 $ m, 1, a( 1, p ), lda,
1235 sva( p ) = aapp*sqrt( max( zero,
1236 $ one-aapq1*aapq1 ) )
1237 mxsinj = max( mxsinj, sfmin )
1244 IF( ( sva( q ) / aaqq )**2.LE.rooteps )
1246 IF( ( aaqq.LT.rootbig ) .AND.
1247 $ ( aaqq.GT.rootsfmin ) )
THEN
1248 sva( q ) = dznrm2( m, a( 1, q ), 1)
1252 CALL zlassq( m, a( 1, q ), 1, t,
1254 sva( q ) = t*sqrt( aaqq )
1257 IF( ( aapp / aapp0 )**2.LE.rooteps )
THEN
1258 IF( ( aapp.LT.rootbig ) .AND.
1259 $ ( aapp.GT.rootsfmin ) )
THEN
1260 aapp = dznrm2( m, a( 1, p ), 1 )
1264 CALL zlassq( m, a( 1, p ), 1, t,
1266 aapp = t*sqrt( aapp )
1274 pskipped = pskipped + 1
1279 pskipped = pskipped + 1
1283 IF( ( i.LE.swband ) .AND. ( ijblsk.GE.blskip ) )
1289 IF( ( i.LE.swband ) .AND.
1290 $ ( pskipped.GT.rowskip ) )
THEN
1304 IF( aapp.EQ.zero )notrot = notrot +
1305 $ min( jgl+kbl-1, n ) - jgl + 1
1306 IF( aapp.LT.zero )notrot = 0
1316 DO 2012 p = igl, min( igl+kbl-1, n )
1317 sva( p ) = abs( sva( p ) )
1324 IF( ( sva( n ).LT.rootbig ) .AND. ( sva( n ).GT.rootsfmin ) )
1326 sva( n ) = dznrm2( m, a( 1, n ), 1 )
1330 CALL zlassq( m, a( 1, n ), 1, t, aapp )
1331 sva( n ) = t*sqrt( aapp )
1336 IF( ( i.LT.swband ) .AND. ( ( mxaapq.LE.roottol ) .OR.
1337 $ ( iswrot.LE.n ) ) )swband = i
1339 IF( ( i.GT.swband+1 ) .AND. ( mxaapq.LT.sqrt( dble( n ) )*
1340 $ tol ) .AND. ( dble( n )*mxaapq*mxsinj.LT.tol ) )
THEN
1344 IF( notrot.GE.emptsw )
GO TO 1994
1366 DO 5991 p = 1, n - 1
1367 q = idamax( n-p+1, sva( p ), 1 ) + p - 1
1372 CALL zswap( m, a( 1, p ), 1, a( 1, q ), 1 )
1373 IF( rsvec )
CALL zswap( mvl, v( 1, p ), 1, v( 1, q ), 1 )
1375 IF( sva( p ).NE.zero )
THEN
1377 IF( sva( p )*skl.GT.sfmin )n2 = n2 + 1
1380 IF( sva( n ).NE.zero )
THEN
1382 IF( sva( n )*skl.GT.sfmin )n2 = n2 + 1
1387 IF( lsvec .OR. uctol )
THEN
1390 CALL zlascl(
'G',0,0, sva(p), one, m, 1, a(1,p), m, ierr )
1398 temp1 = one / dznrm2( mvl, v( 1, p ), 1 )
1399 CALL zdscal( mvl, temp1, v( 1, p ), 1 )
1404 IF( ( ( skl.GT.one ) .AND. ( sva( 1 ).LT.( big / skl ) ) )
1405 $ .OR. ( ( skl.LT.one ) .AND. ( sva( max( n2, 1 ) ) .GT.
1406 $ ( sfmin / skl ) ) ) )
THEN
1408 sva( p ) = skl*sva( p )
1418 rwork( 2 ) = dble( n4 )
1421 rwork( 3 ) = dble( n2 )
1426 rwork( 4 ) = dble( i )
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine dlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
DLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
subroutine zlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
ZLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine zrot(N, CX, INCX, CY, INCY, C, S)
ZROT applies a plane rotation with real cosine and complex sine to a pair of complex vectors...
subroutine zgsvj0(JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, SFMIN, TOL, NSWEEP, WORK, LWORK, INFO)
ZGSVJ0 pre-processor for the routine zgesvj.
subroutine zlassq(N, X, INCX, SCALE, SUMSQ)
ZLASSQ updates a sum of squares represented in scaled form.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
subroutine zgesvj(JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, LDV, CWORK, LWORK, RWORK, LRWORK, INFO)
ZGESVJ
subroutine zgsvj1(JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, EPS, SFMIN, TOL, NSWEEP, WORK, LWORK, INFO)
ZGSVJ1 pre-processor for the routine zgesvj, applies Jacobi rotations targeting only particular pivot...
subroutine zaxpy(N, ZA, ZX, INCX, ZY, INCY)
ZAXPY