349 SUBROUTINE cgesvj( 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 A( lda, * ), V( ldv, * ), CWORK( lwork )
364 REAL RWORK( lrwork ), SVA( n )
371 parameter( zero = 0.0e0, half = 0.5e0, one = 1.0e0)
373 parameter( czero = (0.0e0, 0.0e0), cone = (1.0e0, 0.0e0) )
375 parameter( nsweep = 30 )
379 REAL 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,
REAL, SIGN, SQRT
398 EXTERNAL cdotc, scnrm2
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(
'CGESVJ', -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(
REAL( M ) )
489 epsln = slamch(
'Epsilon' )
490 rooteps = sqrt( epsln )
491 sfmin = slamch(
'SafeMinimum' )
492 rootsfmin = sqrt( sfmin )
493 small = sfmin / epsln
496 rootbig = one / rootsfmin
498 bigtheta = one / rooteps
501 roottol = sqrt( tol )
503 IF(
REAL( m )*EPSLN.GE.ONE ) then
505 CALL xerbla(
'CGESVJ', -info )
513 CALL claset(
'A', mvl, n, czero, cone, v, ldv )
514 ELSE IF( applv )
THEN
517 rsvec = rsvec .OR. applv
528 skl = one / sqrt(
REAL( m )*
REAL( N ) )
537 CALL classq( m-p+1, a( p, p ), 1, aapp, aaqq )
538 IF( aapp.GT.big )
THEN
540 CALL xerbla(
'CGESVJ', -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 classq( p, a( 1, p ), 1, aapp, aaqq )
563 IF( aapp.GT.big )
THEN
565 CALL xerbla(
'CGESVJ', -info )
569 IF( ( aapp.LT.( big / aaqq ) ) .AND. noscale )
THEN
573 sva( p ) = aapp*( aaqq*skl )
577 sva( q ) = sva( q )*skl
587 CALL classq( m, a( 1, p ), 1, aapp, aaqq )
588 IF( aapp.GT.big )
THEN
590 CALL xerbla(
'CGESVJ', -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 claset(
'G', m, n, czero, cone, a, lda )
638 IF( lsvec )
CALL clascl(
'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 /
REAL( 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(
REAL( 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(
REAL( N ) )*aapp ) )
681 IF( temp1.NE.one )
THEN
682 CALL slascl(
'G', 0, 0, one, temp1, n, 1, sva, n, ierr )
685 IF( skl.NE.one )
THEN
686 CALL clascl( 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 cgsvj0( 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 cgsvj0( 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 cgsvj1( 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 cgsvj0( 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 cgsvj0( jobv, m, n4, a, lda, cwork, sva, mvl, v, ldv,
775 $ epsln, sfmin, tol, 1, cwork( n+1 ), lwork-n,
778 CALL cgsvj1( 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 cgsvj0( jobv, n4, n4, a, lda, cwork, sva, mvl, v, ldv,
787 $ epsln, sfmin, tol, 2, cwork( n+1 ), lwork-n,
790 CALL cgsvj0( 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 cgsvj1( jobv, n2, n2, n4, a, lda, cwork, sva, mvl, v,
796 $ ldv, epsln, sfmin, tol, 1, cwork( n+1 ),
799 CALL cgsvj0( 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 = isamax( n-p+1, sva( p ), 1 ) + p - 1
840 CALL cswap( m, a( 1, p ), 1, a( 1, q ), 1 )
841 IF( rsvec )
CALL cswap( mvl, v( 1, p ), 1,
865 IF( ( sva( p ).LT.rootbig ) .AND.
866 $ ( sva( p ).GT.rootsfmin ) )
THEN
867 sva( p ) = scnrm2( m, a( 1, p ), 1 )
871 CALL classq( 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 = ( cdotc( m, a( 1, p ), 1,
894 $ a( 1, q ), 1 ) / aaqq ) / aapp
896 CALL ccopy( m, a( 1, p ), 1,
898 CALL clascl(
'G', 0, 0, aapp, one,
899 $ m, 1, cwork(n+1), lda, ierr )
900 aapq = cdotc( 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 = ( cdotc( m, a( 1, p ), 1,
907 $ a( 1, q ), 1 ) / aapp ) / aaqq
909 CALL ccopy( m, a( 1, q ), 1,
911 CALL clascl(
'G', 0, 0, aaqq,
913 $ cwork(n+1), lda, ierr )
914 aapq = cdotc( m, a(1, p ), 1,
915 $ cwork(n+1), 1 ) / aapp
921 mxaapq = max( mxaapq, -aapq1 )
925 IF( abs( aapq1 ).GT.tol )
THEN
926 ompq = aapq / abs(aapq)
941 theta = -half*abs( aqoap-apoaq )/aapq1
943 IF( abs( theta ).GT.bigtheta )
THEN
948 CALL crot( m, a(1,p), 1, a(1,q), 1,
949 $ cs, conjg(ompq)*t )
951 CALL crot( mvl, v(1,p), 1,
952 $ v(1,q), 1, cs, conjg(ompq)*t )
955 sva( q ) = aaqq*sqrt( max( zero,
956 $ one+t*apoaq*aapq1 ) )
957 aapp = aapp*sqrt( max( zero,
958 $ one-t*aqoap*aapq1 ) )
959 mxsinj = max( mxsinj, abs( t ) )
965 thsign = -sign( one, aapq1 )
966 t = one / ( theta+thsign*
967 $ sqrt( one+theta*theta ) )
968 cs = sqrt( one / ( one+t*t ) )
971 mxsinj = max( mxsinj, abs( sn ) )
972 sva( q ) = aaqq*sqrt( max( zero,
973 $ one+t*apoaq*aapq1 ) )
974 aapp = aapp*sqrt( max( zero,
975 $ one-t*aqoap*aapq1 ) )
977 CALL crot( m, a(1,p), 1, a(1,q), 1,
978 $ cs, conjg(ompq)*sn )
980 CALL crot( mvl, v(1,p), 1,
981 $ v(1,q), 1, cs, conjg(ompq)*sn )
984 cwork(p) = -cwork(q) * ompq
988 CALL ccopy( m, a( 1, p ), 1,
990 CALL clascl(
'G', 0, 0, aapp, one, m,
991 $ 1, cwork(n+1), lda,
993 CALL clascl(
'G', 0, 0, aaqq, one, m,
994 $ 1, a( 1, q ), lda, ierr )
995 CALL caxpy( m, -aapq, cwork(n+1), 1,
997 CALL clascl(
'G', 0, 0, one, aaqq, m,
998 $ 1, a( 1, q ), lda, ierr )
999 sva( q ) = aaqq*sqrt( max( zero,
1000 $ one-aapq1*aapq1 ) )
1001 mxsinj = max( mxsinj, sfmin )
1008 IF( ( sva( q ) / aaqq )**2.LE.rooteps )
1010 IF( ( aaqq.LT.rootbig ) .AND.
1011 $ ( aaqq.GT.rootsfmin ) )
THEN
1012 sva( q ) = scnrm2( m, a( 1, q ), 1 )
1016 CALL classq( m, a( 1, q ), 1, t,
1018 sva( q ) = t*sqrt( aaqq )
1021 IF( ( aapp / aapp0 ).LE.rooteps )
THEN
1022 IF( ( aapp.LT.rootbig ) .AND.
1023 $ ( aapp.GT.rootsfmin ) )
THEN
1024 aapp = scnrm2( m, a( 1, p ), 1 )
1028 CALL classq( m, a( 1, p ), 1, t,
1030 aapp = t*sqrt( aapp )
1037 IF( ir1.EQ.0 )notrot = notrot + 1
1039 pskipped = pskipped + 1
1043 IF( ir1.EQ.0 )notrot = notrot + 1
1044 pskipped = pskipped + 1
1047 IF( ( i.LE.swband ) .AND.
1048 $ ( pskipped.GT.rowskip ) )
THEN
1049 IF( ir1.EQ.0 )aapp = -aapp
1064 IF( ( ir1.EQ.0 ) .AND. ( aapp.EQ.zero ) )
1065 $ notrot = notrot + min( igl+kbl-1, n ) - p
1076 igl = ( ibr-1 )*kbl + 1
1078 DO 2010 jbc = ibr + 1, nbl
1080 jgl = ( jbc-1 )*kbl + 1
1085 DO 2100 p = igl, min( igl+kbl-1, n )
1088 IF( aapp.GT.zero )
THEN
1092 DO 2200 q = jgl, min( jgl+kbl-1, n )
1095 IF( aaqq.GT.zero )
THEN
1102 IF( aaqq.GE.one )
THEN
1103 IF( aapp.GE.aaqq )
THEN
1104 rotok = ( small*aapp ).LE.aaqq
1106 rotok = ( small*aaqq ).LE.aapp
1108 IF( aapp.LT.( big / aaqq ) )
THEN
1109 aapq = ( cdotc( m, a( 1, p ), 1,
1110 $ a( 1, q ), 1 ) / aaqq ) / aapp
1112 CALL ccopy( m, a( 1, p ), 1,
1114 CALL clascl(
'G', 0, 0, aapp,
1116 $ cwork(n+1), lda, ierr )
1117 aapq = cdotc( m, cwork(n+1), 1,
1118 $ a( 1, q ), 1 ) / aaqq
1121 IF( aapp.GE.aaqq )
THEN
1122 rotok = aapp.LE.( aaqq / small )
1124 rotok = aaqq.LE.( aapp / small )
1126 IF( aapp.GT.( small / aaqq ) )
THEN
1127 aapq = ( cdotc( m, a( 1, p ), 1,
1128 $ a( 1, q ), 1 ) / max(aaqq,aapp) )
1131 CALL ccopy( m, a( 1, q ), 1,
1133 CALL clascl(
'G', 0, 0, aaqq,
1135 $ cwork(n+1), lda, ierr )
1136 aapq = cdotc( m, a( 1, p ), 1,
1137 $ cwork(n+1), 1 ) / aapp
1143 mxaapq = max( mxaapq, -aapq1 )
1147 IF( abs( aapq1 ).GT.tol )
THEN
1148 ompq = aapq / abs(aapq)
1158 theta = -half*abs( aqoap-apoaq )/ aapq1
1159 IF( aaqq.GT.aapp0 )theta = -theta
1161 IF( abs( theta ).GT.bigtheta )
THEN
1164 CALL crot( m, a(1,p), 1, a(1,q), 1,
1165 $ cs, conjg(ompq)*t )
1167 CALL crot( mvl, v(1,p), 1,
1168 $ v(1,q), 1, cs, conjg(ompq)*t )
1170 sva( q ) = aaqq*sqrt( max( zero,
1171 $ one+t*apoaq*aapq1 ) )
1172 aapp = aapp*sqrt( max( zero,
1173 $ one-t*aqoap*aapq1 ) )
1174 mxsinj = max( mxsinj, abs( t ) )
1179 thsign = -sign( one, aapq1 )
1180 IF( aaqq.GT.aapp0 )thsign = -thsign
1181 t = one / ( theta+thsign*
1182 $ sqrt( one+theta*theta ) )
1183 cs = sqrt( one / ( one+t*t ) )
1185 mxsinj = max( mxsinj, abs( sn ) )
1186 sva( q ) = aaqq*sqrt( max( zero,
1187 $ one+t*apoaq*aapq1 ) )
1188 aapp = aapp*sqrt( max( zero,
1189 $ one-t*aqoap*aapq1 ) )
1191 CALL crot( m, a(1,p), 1, a(1,q), 1,
1192 $ cs, conjg(ompq)*sn )
1194 CALL crot( mvl, v(1,p), 1,
1195 $ v(1,q), 1, cs, conjg(ompq)*sn )
1198 cwork(p) = -cwork(q) * ompq
1202 IF( aapp.GT.aaqq )
THEN
1203 CALL ccopy( m, a( 1, p ), 1,
1205 CALL clascl(
'G', 0, 0, aapp, one,
1206 $ m, 1, cwork(n+1),lda,
1208 CALL clascl(
'G', 0, 0, aaqq, one,
1209 $ m, 1, a( 1, q ), lda,
1211 CALL caxpy( m, -aapq, cwork(n+1),
1213 CALL clascl(
'G', 0, 0, one, aaqq,
1214 $ m, 1, a( 1, q ), lda,
1216 sva( q ) = aaqq*sqrt( max( zero,
1217 $ one-aapq1*aapq1 ) )
1218 mxsinj = max( mxsinj, sfmin )
1220 CALL ccopy( m, a( 1, q ), 1,
1222 CALL clascl(
'G', 0, 0, aaqq, one,
1223 $ m, 1, cwork(n+1),lda,
1225 CALL clascl(
'G', 0, 0, aapp, one,
1226 $ m, 1, a( 1, p ), lda,
1228 CALL caxpy( m, -conjg(aapq),
1229 $ cwork(n+1), 1, a( 1, p ), 1 )
1230 CALL clascl(
'G', 0, 0, one, aapp,
1231 $ m, 1, a( 1, p ), lda,
1233 sva( p ) = aapp*sqrt( max( zero,
1234 $ one-aapq1*aapq1 ) )
1235 mxsinj = max( mxsinj, sfmin )
1242 IF( ( sva( q ) / aaqq )**2.LE.rooteps )
1244 IF( ( aaqq.LT.rootbig ) .AND.
1245 $ ( aaqq.GT.rootsfmin ) )
THEN
1246 sva( q ) = scnrm2( m, a( 1, q ), 1)
1250 CALL classq( m, a( 1, q ), 1, t,
1252 sva( q ) = t*sqrt( aaqq )
1255 IF( ( aapp / aapp0 )**2.LE.rooteps )
THEN
1256 IF( ( aapp.LT.rootbig ) .AND.
1257 $ ( aapp.GT.rootsfmin ) )
THEN
1258 aapp = scnrm2( m, a( 1, p ), 1 )
1262 CALL classq( m, a( 1, p ), 1, t,
1264 aapp = t*sqrt( aapp )
1272 pskipped = pskipped + 1
1277 pskipped = pskipped + 1
1281 IF( ( i.LE.swband ) .AND. ( ijblsk.GE.blskip ) )
1287 IF( ( i.LE.swband ) .AND.
1288 $ ( pskipped.GT.rowskip ) )
THEN
1302 IF( aapp.EQ.zero )notrot = notrot +
1303 $ min( jgl+kbl-1, n ) - jgl + 1
1304 IF( aapp.LT.zero )notrot = 0
1314 DO 2012 p = igl, min( igl+kbl-1, n )
1315 sva( p ) = abs( sva( p ) )
1322 IF( ( sva( n ).LT.rootbig ) .AND. ( sva( n ).GT.rootsfmin ) )
1324 sva( n ) = scnrm2( m, a( 1, n ), 1 )
1328 CALL classq( m, a( 1, n ), 1, t, aapp )
1329 sva( n ) = t*sqrt( aapp )
1334 IF( ( i.LT.swband ) .AND. ( ( mxaapq.LE.roottol ) .OR.
1335 $ ( iswrot.LE.n ) ) )swband = i
1337 IF( ( i.GT.swband+1 ) .AND. ( mxaapq.LT.sqrt(
REAL( N ) )*
1338 $ tol ) .AND. (
REAL( n )*MXAAPQ*MXSINJ.LT.TOL ) ) then
1342 IF( notrot.GE.emptsw )
GO TO 1994
1364 DO 5991 p = 1, n - 1
1365 q = isamax( n-p+1, sva( p ), 1 ) + p - 1
1370 CALL cswap( m, a( 1, p ), 1, a( 1, q ), 1 )
1371 IF( rsvec )
CALL cswap( mvl, v( 1, p ), 1, v( 1, q ), 1 )
1373 IF( sva( p ).NE.zero )
THEN
1375 IF( sva( p )*skl.GT.sfmin )n2 = n2 + 1
1378 IF( sva( n ).NE.zero )
THEN
1380 IF( sva( n )*skl.GT.sfmin )n2 = n2 + 1
1385 IF( lsvec .OR. uctol )
THEN
1388 CALL clascl(
'G',0,0, sva(p), one, m, 1, a(1,p), m, ierr )
1396 temp1 = one / scnrm2( mvl, v( 1, p ), 1 )
1397 CALL csscal( mvl, temp1, v( 1, p ), 1 )
1402 IF( ( ( skl.GT.one ) .AND. ( sva( 1 ).LT.( big / skl ) ) )
1403 $ .OR. ( ( skl.LT.one ) .AND. ( sva( max( n2, 1 ) ) .GT.
1404 $ ( sfmin / skl ) ) ) )
THEN
1406 sva( p ) = skl*sva( p )
1416 rwork( 2 ) =
REAL( n4 )
1419 rwork( 3 ) =
REAL( n2 )
1424 rwork( 4 ) =
REAL( i )
subroutine cgesvj(JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V, LDV, CWORK, LWORK, RWORK, LRWORK, INFO)
CGESVJ
subroutine cgsvj0(JOBV, M, N, A, LDA, D, SVA, MV, V, LDV, EPS, SFMIN, TOL, NSWEEP, WORK, LWORK, INFO)
CGSVJ0 pre-processor for the routine cgesvj.
subroutine classq(N, X, INCX, SCALE, SUMSQ)
CLASSQ updates a sum of squares represented in scaled form.
subroutine crot(N, CX, INCX, CY, INCY, C, S)
CROT applies a plane rotation with real cosine and complex sine to a pair of complex vectors...
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine clascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
CLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine slascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
SLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
subroutine caxpy(N, CA, CX, INCX, CY, INCY)
CAXPY
subroutine csscal(N, SA, CX, INCX)
CSSCAL
subroutine cgsvj1(JOBV, M, N, N1, A, LDA, D, SVA, MV, V, LDV, EPS, SFMIN, TOL, NSWEEP, WORK, LWORK, INFO)
CGSVJ1 pre-processor for the routine cgesvj, applies Jacobi rotations targeting only particular pivot...