310 CHARACTER COMPQ, COMPZ, JOB
311 INTEGER IHI, ILO, INFO, LDH, LDQ, LDT, LDZ, LWORK, N
314 REAL ALPHAI( * ), ALPHAR( * ), BETA( * ),
315 $ H( LDH, * ), Q( LDQ, * ), T( LDT, * ),
316 $ WORK( * ), Z( LDZ, * )
323 REAL HALF, ZERO, ONE, SAFETY
324 parameter( half = 0.5e+0, zero = 0.0e+0, one = 1.0e+0,
328 LOGICAL ILAZR2, ILAZRO, ILPIVT, ILQ, ILSCHR, ILZ,
330 INTEGER ICOMPQ, ICOMPZ, IFIRST, IFRSTM, IITER, ILAST,
331 $ ILASTM, IN, ISCHUR, ISTART, J, JC, JCH, JITER,
333 REAL A11, A12, A1I, A1R, A21, A22, A2I, A2R, AD11,
334 $ AD11L, AD12, AD12L, AD21, AD21L, AD22, AD22L,
335 $ AD32L, AN, ANORM, ASCALE, ATOL, B11, B1A, B1I,
336 $ B1R, B22, B2A, B2I, B2R, BN, BNORM, BSCALE,
337 $ BTOL, C, C11I, C11R, C12, C21, C22I, C22R, CL,
338 $ CQ, CR, CZ, ESHIFT, S, S1, S1INV, S2, SAFMAX,
339 $ SAFMIN, SCALE, SL, SQI, SQR, SR, SZI, SZR, T1,
340 $ TAU, TEMP, TEMP2, TEMPI, TEMPR, U1, U12, U12L,
341 $ U2, ULP, VS, W11, W12, W21, W22, WABS, WI, WR,
349 REAL SLAMCH, SLANHS, SLAPY2, SLAPY3
357 INTRINSIC abs, max, min, real, sqrt
363 IF(
lsame( job,
'E' ) )
THEN
366 ELSE IF(
lsame( job,
'S' ) )
THEN
373 IF(
lsame( compq,
'N' ) )
THEN
376 ELSE IF(
lsame( compq,
'V' ) )
THEN
379 ELSE IF(
lsame( compq,
'I' ) )
THEN
386 IF(
lsame( compz,
'N' ) )
THEN
389 ELSE IF(
lsame( compz,
'V' ) )
THEN
392 ELSE IF(
lsame( compz,
'I' ) )
THEN
402 work( 1 ) = max( 1, n )
403 lquery = ( lwork.EQ.-1 )
404 IF( ischur.EQ.0 )
THEN
406 ELSE IF( icompq.EQ.0 )
THEN
408 ELSE IF( icompz.EQ.0 )
THEN
410 ELSE IF( n.LT.0 )
THEN
412 ELSE IF( ilo.LT.1 )
THEN
414 ELSE IF( ihi.GT.n .OR. ihi.LT.ilo-1 )
THEN
416 ELSE IF( ldh.LT.n )
THEN
418 ELSE IF( ldt.LT.n )
THEN
420 ELSE IF( ldq.LT.1 .OR. ( ilq .AND. ldq.LT.n ) )
THEN
422 ELSE IF( ldz.LT.1 .OR. ( ilz .AND. ldz.LT.n ) )
THEN
424 ELSE IF( lwork.LT.max( 1, n ) .AND. .NOT.lquery )
THEN
428 CALL xerbla(
'SHGEQZ', -info )
430 ELSE IF( lquery )
THEN
437 work( 1 ) = real( 1 )
444 $
CALL slaset(
'Full', n, n, zero, one, q, ldq )
446 $
CALL slaset(
'Full', n, n, zero, one, z, ldz )
452 safmax = one / safmin
454 anorm =
slanhs(
'F', in, h( ilo, ilo ), ldh, work )
455 bnorm =
slanhs(
'F', in, t( ilo, ilo ), ldt, work )
456 atol = max( safmin, ulp*anorm )
457 btol = max( safmin, ulp*bnorm )
458 ascale = one / max( safmin, anorm )
459 bscale = one / max( safmin, bnorm )
464 IF( t( j, j ).LT.zero )
THEN
467 h( jr, j ) = -h( jr, j )
468 t( jr, j ) = -t( jr, j )
471 h( j, j ) = -h( j, j )
472 t( j, j ) = -t( j, j )
476 z( jr, j ) = -z( jr, j )
480 alphar( j ) = h( j, j )
482 beta( j ) = t( j, j )
515 maxit = 30*( ihi-ilo+1 )
517 DO 360 jiter = 1, maxit
525 IF( ilast.EQ.ilo )
THEN
531 IF( abs( h( ilast, ilast-1 ) ).LE.max( safmin, ulp*(
532 $ abs( h( ilast, ilast ) ) + abs( h( ilast-1, ilast-1 ) )
534 h( ilast, ilast-1 ) = zero
539 IF( abs( t( ilast, ilast ) ).LE.max( safmin, ulp*(
540 $ abs( t( ilast - 1, ilast ) ) + abs( t( ilast-1, ilast-1 )
542 t( ilast, ilast ) = zero
548 DO 60 j = ilast - 1, ilo, -1
555 IF( abs( h( j, j-1 ) ).LE.max( safmin, ulp*(
556 $ abs( h( j, j ) ) + abs( h( j-1, j-1 ) )
567 temp = abs( t( j, j + 1 ) )
569 $ temp = temp + abs( t( j - 1, j ) )
570 IF( abs( t( j, j ) ).LT.max( safmin,ulp*temp ) )
THEN
576 IF( .NOT.ilazro )
THEN
577 temp = abs( h( j, j-1 ) )
578 temp2 = abs( h( j, j ) )
579 tempr = max( temp, temp2 )
580 IF( tempr.LT.one .AND. tempr.NE.zero )
THEN
582 temp2 = temp2 / tempr
584 IF( temp*( ascale*abs( h( j+1, j ) ) ).LE.temp2*
585 $ ( ascale*atol ) )ilazr2 = .true.
594 IF( ilazro .OR. ilazr2 )
THEN
595 DO 40 jch = j, ilast - 1
597 CALL slartg( temp, h( jch+1, jch ), c, s,
599 h( jch+1, jch ) = zero
600 CALL srot( ilastm-jch, h( jch, jch+1 ), ldh,
601 $ h( jch+1, jch+1 ), ldh, c, s )
602 CALL srot( ilastm-jch, t( jch, jch+1 ), ldt,
603 $ t( jch+1, jch+1 ), ldt, c, s )
605 $
CALL srot( n, q( 1, jch ), 1, q( 1, jch+1 ), 1,
608 $ h( jch, jch-1 ) = h( jch, jch-1 )*c
610 IF( abs( t( jch+1, jch+1 ) ).GE.btol )
THEN
611 IF( jch+1.GE.ilast )
THEN
618 t( jch+1, jch+1 ) = zero
626 DO 50 jch = j, ilast - 1
627 temp = t( jch, jch+1 )
628 CALL slartg( temp, t( jch+1, jch+1 ), c, s,
630 t( jch+1, jch+1 ) = zero
631 IF( jch.LT.ilastm-1 )
632 $
CALL srot( ilastm-jch-1, t( jch, jch+2 ), ldt,
633 $ t( jch+1, jch+2 ), ldt, c, s )
634 CALL srot( ilastm-jch+2, h( jch, jch-1 ), ldh,
635 $ h( jch+1, jch-1 ), ldh, c, s )
637 $
CALL srot( n, q( 1, jch ), 1, q( 1, jch+1 ), 1,
639 temp = h( jch+1, jch )
640 CALL slartg( temp, h( jch+1, jch-1 ), c, s,
642 h( jch+1, jch-1 ) = zero
643 CALL srot( jch+1-ifrstm, h( ifrstm, jch ), 1,
644 $ h( ifrstm, jch-1 ), 1, c, s )
645 CALL srot( jch-ifrstm, t( ifrstm, jch ), 1,
646 $ t( ifrstm, jch-1 ), 1, c, s )
648 $
CALL srot( n, z( 1, jch ), 1, z( 1, jch-1 ), 1,
653 ELSE IF( ilazro )
THEN
674 temp = h( ilast, ilast )
675 CALL slartg( temp, h( ilast, ilast-1 ), c, s,
676 $ h( ilast, ilast ) )
677 h( ilast, ilast-1 ) = zero
678 CALL srot( ilast-ifrstm, h( ifrstm, ilast ), 1,
679 $ h( ifrstm, ilast-1 ), 1, c, s )
680 CALL srot( ilast-ifrstm, t( ifrstm, ilast ), 1,
681 $ t( ifrstm, ilast-1 ), 1, c, s )
683 $
CALL srot( n, z( 1, ilast ), 1, z( 1, ilast-1 ), 1, c, s )
689 IF( t( ilast, ilast ).LT.zero )
THEN
691 DO 90 j = ifrstm, ilast
692 h( j, ilast ) = -h( j, ilast )
693 t( j, ilast ) = -t( j, ilast )
696 h( ilast, ilast ) = -h( ilast, ilast )
697 t( ilast, ilast ) = -t( ilast, ilast )
701 z( j, ilast ) = -z( j, ilast )
705 alphar( ilast ) = h( ilast, ilast )
706 alphai( ilast ) = zero
707 beta( ilast ) = t( ilast, ilast )
719 IF( .NOT.ilschr )
THEN
721 IF( ifrstm.GT.ilast )
733 IF( .NOT.ilschr )
THEN
743 IF( ( iiter / 10 )*10.EQ.iiter )
THEN
748 IF( ( real( maxit )*safmin )*abs( h( ilast, ilast-1 ) ).LT.
749 $ abs( t( ilast-1, ilast-1 ) ) )
THEN
750 eshift = h( ilast, ilast-1 ) /
751 $ t( ilast-1, ilast-1 )
753 eshift = eshift + one / ( safmin*real( maxit ) )
764 CALL slag2( h( ilast-1, ilast-1 ), ldh,
765 $ t( ilast-1, ilast-1 ), ldt, safmin*safety, s1,
768 IF ( abs( (wr/s1)*t( ilast, ilast ) - h( ilast, ilast ) )
769 $ .GT. abs( (wr2/s2)*t( ilast, ilast )
770 $ - h( ilast, ilast ) ) )
THEN
778 temp = max( s1, safmin*max( one, abs( wr ), abs( wi ) ) )
785 temp = min( ascale, one )*( half*safmax )
786 IF( s1.GT.temp )
THEN
792 temp = min( bscale, one )*( half*safmax )
793 IF( abs( wr ).GT.temp )
794 $ scale = min( scale, temp / abs( wr ) )
800 DO 120 j = ilast - 1, ifirst + 1, -1
802 temp = abs( s1*h( j, j-1 ) )
803 temp2 = abs( s1*h( j, j )-wr*t( j, j ) )
804 tempr = max( temp, temp2 )
805 IF( tempr.LT.one .AND. tempr.NE.zero )
THEN
807 temp2 = temp2 / tempr
809 IF( abs( ( ascale*h( j+1, j ) )*temp ).LE.( ascale*atol )*
820 temp = s1*h( istart, istart ) - wr*t( istart, istart )
821 temp2 = s1*h( istart+1, istart )
822 CALL slartg( temp, temp2, c, s, tempr )
826 DO 190 j = istart, ilast - 1
827 IF( j.GT.istart )
THEN
829 CALL slartg( temp, h( j+1, j-1 ), c, s, h( j, j-1 ) )
833 DO 140 jc = j, ilastm
834 temp = c*h( j, jc ) + s*h( j+1, jc )
835 h( j+1, jc ) = -s*h( j, jc ) + c*h( j+1, jc )
837 temp2 = c*t( j, jc ) + s*t( j+1, jc )
838 t( j+1, jc ) = -s*t( j, jc ) + c*t( j+1, jc )
843 temp = c*q( jr, j ) + s*q( jr, j+1 )
844 q( jr, j+1 ) = -s*q( jr, j ) + c*q( jr, j+1 )
850 CALL slartg( temp, t( j+1, j ), c, s, t( j+1, j+1 ) )
853 DO 160 jr = ifrstm, min( j+2, ilast )
854 temp = c*h( jr, j+1 ) + s*h( jr, j )
855 h( jr, j ) = -s*h( jr, j+1 ) + c*h( jr, j )
858 DO 170 jr = ifrstm, j
859 temp = c*t( jr, j+1 ) + s*t( jr, j )
860 t( jr, j ) = -s*t( jr, j+1 ) + c*t( jr, j )
865 temp = c*z( jr, j+1 ) + s*z( jr, j )
866 z( jr, j ) = -s*z( jr, j+1 ) + c*z( jr, j )
882 IF( ifirst+1.EQ.ilast )
THEN
892 CALL slasv2( t( ilast-1, ilast-1 ), t( ilast-1, ilast ),
893 $ t( ilast, ilast ), b22, b11, sr, cr, sl, cl )
895 IF( b11.LT.zero )
THEN
902 CALL srot( ilastm+1-ifirst, h( ilast-1, ilast-1 ), ldh,
903 $ h( ilast, ilast-1 ), ldh, cl, sl )
904 CALL srot( ilast+1-ifrstm, h( ifrstm, ilast-1 ), 1,
905 $ h( ifrstm, ilast ), 1, cr, sr )
907 IF( ilast.LT.ilastm )
908 $
CALL srot( ilastm-ilast, t( ilast-1, ilast+1 ), ldt,
909 $ t( ilast, ilast+1 ), ldt, cl, sl )
910 IF( ifrstm.LT.ilast-1 )
911 $
CALL srot( ifirst-ifrstm, t( ifrstm, ilast-1 ), 1,
912 $ t( ifrstm, ilast ), 1, cr, sr )
915 $
CALL srot( n, q( 1, ilast-1 ), 1, q( 1, ilast ), 1, cl,
918 $
CALL srot( n, z( 1, ilast-1 ), 1, z( 1, ilast ), 1, cr,
921 t( ilast-1, ilast-1 ) = b11
922 t( ilast-1, ilast ) = zero
923 t( ilast, ilast-1 ) = zero
924 t( ilast, ilast ) = b22
928 IF( b22.LT.zero )
THEN
929 DO 210 j = ifrstm, ilast
930 h( j, ilast ) = -h( j, ilast )
931 t( j, ilast ) = -t( j, ilast )
936 z( j, ilast ) = -z( j, ilast )
946 CALL slag2( h( ilast-1, ilast-1 ), ldh,
947 $ t( ilast-1, ilast-1 ), ldt, safmin*safety, s1,
948 $ temp, wr, temp2, wi )
959 a11 = h( ilast-1, ilast-1 )
960 a21 = h( ilast, ilast-1 )
961 a12 = h( ilast-1, ilast )
962 a22 = h( ilast, ilast )
970 c11r = s1*a11 - wr*b11
974 c22r = s1*a22 - wr*b22
977 IF( abs( c11r )+abs( c11i )+abs( c12 ).GT.abs( c21 )+
978 $ abs( c22r )+abs( c22i ) )
THEN
979 t1 =
slapy3( c12, c11r, c11i )
985 IF( cz.LE.safmin )
THEN
994 szr = -c21*tempr / t1
1005 an = abs( a11 ) + abs( a12 ) + abs( a21 ) + abs( a22 )
1006 bn = abs( b11 ) + abs( b22 )
1007 wabs = abs( wr ) + abs( wi )
1008 IF( s1*an.GT.wabs*bn )
THEN
1013 a1r = cz*a11 + szr*a12
1015 a2r = cz*a21 + szr*a22
1018 IF( cq.LE.safmin )
THEN
1025 sqr = tempr*a2r + tempi*a2i
1026 sqi = tempi*a2r - tempr*a2i
1029 t1 =
slapy3( cq, sqr, sqi )
1036 tempr = sqr*szr - sqi*szi
1037 tempi = sqr*szi + sqi*szr
1038 b1r = cq*cz*b11 + tempr*b22
1041 b2r = cq*cz*b22 + tempr*b11
1047 beta( ilast-1 ) = b1a
1049 alphar( ilast-1 ) = ( wr*b1a )*s1inv
1050 alphai( ilast-1 ) = ( wi*b1a )*s1inv
1051 alphar( ilast ) = ( wr*b2a )*s1inv
1052 alphai( ilast ) = -( wi*b2a )*s1inv
1064 IF( .NOT.ilschr )
THEN
1066 IF( ifrstm.GT.ilast )
1084 ad11 = ( ascale*h( ilast-1, ilast-1 ) ) /
1085 $ ( bscale*t( ilast-1, ilast-1 ) )
1086 ad21 = ( ascale*h( ilast, ilast-1 ) ) /
1087 $ ( bscale*t( ilast-1, ilast-1 ) )
1088 ad12 = ( ascale*h( ilast-1, ilast ) ) /
1089 $ ( bscale*t( ilast, ilast ) )
1090 ad22 = ( ascale*h( ilast, ilast ) ) /
1091 $ ( bscale*t( ilast, ilast ) )
1092 u12 = t( ilast-1, ilast ) / t( ilast, ilast )
1093 ad11l = ( ascale*h( ifirst, ifirst ) ) /
1094 $ ( bscale*t( ifirst, ifirst ) )
1095 ad21l = ( ascale*h( ifirst+1, ifirst ) ) /
1096 $ ( bscale*t( ifirst, ifirst ) )
1097 ad12l = ( ascale*h( ifirst, ifirst+1 ) ) /
1098 $ ( bscale*t( ifirst+1, ifirst+1 ) )
1099 ad22l = ( ascale*h( ifirst+1, ifirst+1 ) ) /
1100 $ ( bscale*t( ifirst+1, ifirst+1 ) )
1101 ad32l = ( ascale*h( ifirst+2, ifirst+1 ) ) /
1102 $ ( bscale*t( ifirst+1, ifirst+1 ) )
1103 u12l = t( ifirst, ifirst+1 ) / t( ifirst+1, ifirst+1 )
1105 v( 1 ) = ( ad11-ad11l )*( ad22-ad11l ) - ad12*ad21 +
1106 $ ad21*u12*ad11l + ( ad12l-ad11l*u12l )*ad21l
1107 v( 2 ) = ( ( ad22l-ad11l )-ad21l*u12l-( ad11-ad11l )-
1108 $ ( ad22-ad11l )+ad21*u12 )*ad21l
1109 v( 3 ) = ad32l*ad21l
1113 CALL slarfg( 3, v( 1 ), v( 2 ), 1, tau )
1118 DO 290 j = istart, ilast - 2
1124 IF( j.GT.istart )
THEN
1125 v( 1 ) = h( j, j-1 )
1126 v( 2 ) = h( j+1, j-1 )
1127 v( 3 ) = h( j+2, j-1 )
1129 CALL slarfg( 3, h( j, j-1 ), v( 2 ), 1, tau )
1131 h( j+1, j-1 ) = zero
1132 h( j+2, j-1 ) = zero
1135 DO 230 jc = j, ilastm
1136 temp = tau*( h( j, jc )+v( 2 )*h( j+1, jc )+v( 3 )*
1138 h( j, jc ) = h( j, jc ) - temp
1139 h( j+1, jc ) = h( j+1, jc ) - temp*v( 2 )
1140 h( j+2, jc ) = h( j+2, jc ) - temp*v( 3 )
1141 temp2 = tau*( t( j, jc )+v( 2 )*t( j+1, jc )+v( 3 )*
1143 t( j, jc ) = t( j, jc ) - temp2
1144 t( j+1, jc ) = t( j+1, jc ) - temp2*v( 2 )
1145 t( j+2, jc ) = t( j+2, jc ) - temp2*v( 3 )
1149 temp = tau*( q( jr, j )+v( 2 )*q( jr, j+1 )+v( 3 )*
1151 q( jr, j ) = q( jr, j ) - temp
1152 q( jr, j+1 ) = q( jr, j+1 ) - temp*v( 2 )
1153 q( jr, j+2 ) = q( jr, j+2 ) - temp*v( 3 )
1162 temp = max( abs( t( j+1, j+1 ) ), abs( t( j+1, j+2 ) ) )
1163 temp2 = max( abs( t( j+2, j+1 ) ), abs( t( j+2, j+2 ) ) )
1164 IF( max( temp, temp2 ).LT.safmin )
THEN
1169 ELSE IF( temp.GE.temp2 )
THEN
1187 IF( abs( w12 ).GT.abs( w11 ) )
THEN
1201 w22 = w22 - temp*w12
1207 IF( abs( w22 ).LT.safmin )
THEN
1213 IF( abs( w22 ).LT.abs( u2 ) )
1214 $ scale = abs( w22 / u2 )
1215 IF( abs( w11 ).LT.abs( u1 ) )
1216 $ scale = min( scale, abs( w11 / u1 ) )
1220 u2 = ( scale*u2 ) / w22
1221 u1 = ( scale*u1-w12*u2 ) / w11
1232 t1 = sqrt( scale**2+u1**2+u2**2 )
1233 tau = one + scale / t1
1234 vs = -one / ( scale+t1 )
1241 DO 260 jr = ifrstm, min( j+3, ilast )
1242 temp = tau*( h( jr, j )+v( 2 )*h( jr, j+1 )+v( 3 )*
1244 h( jr, j ) = h( jr, j ) - temp
1245 h( jr, j+1 ) = h( jr, j+1 ) - temp*v( 2 )
1246 h( jr, j+2 ) = h( jr, j+2 ) - temp*v( 3 )
1248 DO 270 jr = ifrstm, j + 2
1249 temp = tau*( t( jr, j )+v( 2 )*t( jr, j+1 )+v( 3 )*
1251 t( jr, j ) = t( jr, j ) - temp
1252 t( jr, j+1 ) = t( jr, j+1 ) - temp*v( 2 )
1253 t( jr, j+2 ) = t( jr, j+2 ) - temp*v( 3 )
1257 temp = tau*( z( jr, j )+v( 2 )*z( jr, j+1 )+v( 3 )*
1259 z( jr, j ) = z( jr, j ) - temp
1260 z( jr, j+1 ) = z( jr, j+1 ) - temp*v( 2 )
1261 z( jr, j+2 ) = z( jr, j+2 ) - temp*v( 3 )
1274 CALL slartg( temp, h( j+1, j-1 ), c, s, h( j, j-1 ) )
1275 h( j+1, j-1 ) = zero
1277 DO 300 jc = j, ilastm
1278 temp = c*h( j, jc ) + s*h( j+1, jc )
1279 h( j+1, jc ) = -s*h( j, jc ) + c*h( j+1, jc )
1281 temp2 = c*t( j, jc ) + s*t( j+1, jc )
1282 t( j+1, jc ) = -s*t( j, jc ) + c*t( j+1, jc )
1287 temp = c*q( jr, j ) + s*q( jr, j+1 )
1288 q( jr, j+1 ) = -s*q( jr, j ) + c*q( jr, j+1 )
1295 temp = t( j+1, j+1 )
1296 CALL slartg( temp, t( j+1, j ), c, s, t( j+1, j+1 ) )
1299 DO 320 jr = ifrstm, ilast
1300 temp = c*h( jr, j+1 ) + s*h( jr, j )
1301 h( jr, j ) = -s*h( jr, j+1 ) + c*h( jr, j )
1304 DO 330 jr = ifrstm, ilast - 1
1305 temp = c*t( jr, j+1 ) + s*t( jr, j )
1306 t( jr, j ) = -s*t( jr, j+1 ) + c*t( jr, j )
1311 temp = c*z( jr, j+1 ) + s*z( jr, j )
1312 z( jr, j ) = -s*z( jr, j+1 ) + c*z( jr, j )
1339 DO 410 j = 1, ilo - 1
1340 IF( t( j, j ).LT.zero )
THEN
1343 h( jr, j ) = -h( jr, j )
1344 t( jr, j ) = -t( jr, j )
1347 h( j, j ) = -h( j, j )
1348 t( j, j ) = -t( j, j )
1352 z( jr, j ) = -z( jr, j )
1356 alphar( j ) = h( j, j )
1358 beta( j ) = t( j, j )
1368 work( 1 ) = real( n )
subroutine slaset(UPLO, M, N, ALPHA, BETA, A, LDA)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
subroutine slasv2(F, G, H, SSMIN, SSMAX, SNR, CSR, SNL, CSL)
SLASV2 computes the singular value decomposition of a 2-by-2 triangular matrix.
subroutine slartg(f, g, c, s, r)
SLARTG generates a plane rotation with real cosine and real sine.
real function slapy2(X, Y)
SLAPY2 returns sqrt(x2+y2).
real function slapy3(X, Y, Z)
SLAPY3 returns sqrt(x2+y2+z2).
subroutine xerbla(SRNAME, INFO)
XERBLA
logical function lsame(CA, CB)
LSAME
subroutine slarfg(N, ALPHA, X, INCX, TAU)
SLARFG generates an elementary reflector (Householder matrix).
subroutine slag2(A, LDA, B, LDB, SAFMIN, SCALE1, SCALE2, WR1, WR2, WI)
SLAG2 computes the eigenvalues of a 2-by-2 generalized eigenvalue problem, with scaling as necessary ...
real function slanhs(NORM, N, A, LDA, WORK)
SLANHS returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine srot(N, SX, INCX, SY, INCY, C, S)
SROT
real function slamch(CMACH)
SLAMCH