397 SUBROUTINE cdrvbd( NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH,
398 $ A, LDA, U, LDU, VT, LDVT, ASAV, USAV, VTSAV, S,
399 $ SSAV, E, WORK, LWORK, RWORK, IWORK, NOUNIT,
409 INTEGER INFO, LDA, LDU, LDVT, LWORK, NOUNIT, NSIZES,
415 INTEGER ISEED( 4 ), IWORK( * ), MM( * ), NN( * )
416 REAL E( * ), RWORK( * ), S( * ), SSAV( * )
417 COMPLEX A( LDA, * ), ASAV( LDA, * ), U( LDU, * ),
418 $ usav( ldu, * ), vt( ldvt, * ),
419 $ vtsav( ldvt, * ), work( * )
425 REAL ZERO, ONE, TWO, HALF
426 PARAMETER ( ZERO = 0.0e0, one = 1.0e0, two = 2.0e0,
429 parameter( czero = ( 0.0e+0, 0.0e+0 ),
430 $ cone = ( 1.0e+0, 0.0e+0 ) )
432 parameter( maxtyp = 5 )
436 CHARACTER JOBQ, JOBU, JOBVT, RANGE
437 INTEGER I, IINFO, IJQ, IJU, IJVT, IL, IU, ITEMP,
438 $ iwspc, iwtmp, j, jsize, jtype, lswork, m,
439 $ minwrk, mmax, mnmax, mnmin, mtypes, n,
440 $ nerrs, nfail, nmax, ns, nsi, nsv, ntest,
441 $ ntestf, ntestt, lrwork
442 REAL ANORM, DIF, DIV, OVFL, RTUNFL, ULP, ULPINV,
446 INTEGER LIWORK, NUMRANK
449 CHARACTER CJOB( 4 ), CJOBR( 3 ), CJOBV( 2 )
450 INTEGER IOLDSD( 4 ), ISEED2( 4 )
455 EXTERNAL SLAMCH, SLARND
463 INTRINSIC abs, real, max, min
469 COMMON / srnamc / srnamt
472 DATA cjob /
'N',
'O',
'S',
'A' /
473 DATA cjobr /
'A',
'V',
'I' /
474 DATA cjobv /
'N',
'V' /
494 mmax = max( mmax, mm( j ) )
497 nmax = max( nmax, nn( j ) )
500 mnmax = max( mnmax, min( mm( j ), nn( j ) ) )
501 minwrk = max( minwrk, max( 3*min( mm( j ),
502 $ nn( j ) )+max( mm( j ), nn( j ) )**2, 5*min( mm( j ),
503 $ nn( j ) ), 3*max( mm( j ), nn( j ) ) ) )
508 IF( nsizes.LT.0 )
THEN
510 ELSE IF( badmm )
THEN
512 ELSE IF( badnn )
THEN
514 ELSE IF( ntypes.LT.0 )
THEN
516 ELSE IF( lda.LT.max( 1, mmax ) )
THEN
518 ELSE IF( ldu.LT.max( 1, mmax ) )
THEN
520 ELSE IF( ldvt.LT.max( 1, nmax ) )
THEN
522 ELSE IF( minwrk.GT.lwork )
THEN
527 CALL xerbla(
'CDRVBD', -info )
533 IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
542 rtunfl = sqrt( unfl )
548 DO 310 jsize = 1, nsizes
553 IF( nsizes.NE.1 )
THEN
554 mtypes = min( maxtyp, ntypes )
556 mtypes = min( maxtyp+1, ntypes )
559 DO 300 jtype = 1, mtypes
560 IF( .NOT.dotype( jtype ) )
565 ioldsd( j ) = iseed( j )
570 IF( mtypes.GT.maxtyp )
573 IF( jtype.EQ.1 )
THEN
577 CALL claset(
'Full', m, n, czero, czero, a, lda )
578 DO 30 i = 1, min( m, n )
582 ELSE IF( jtype.EQ.2 )
THEN
586 CALL claset(
'Full', m, n, czero, cone, a, lda )
587 DO 40 i = 1, min( m, n )
601 CALL clatms( m, n,
'U', iseed,
'N', s, 4, real( mnmin ),
602 $ anorm, m-1, n-1,
'N', a, lda, work, iinfo )
603 IF( iinfo.NE.0 )
THEN
604 WRITE( nounit, fmt = 9996 )
'Generator', iinfo, m, n,
612 CALL clacpy(
'F', m, n, a, lda, asav, lda )
620 iwtmp = 2*min( m, n )+max( m, n )
621 lswork = iwtmp + ( iwspc-1 )*( lwork-iwtmp ) / 3
622 lswork = min( lswork, lwork )
623 lswork = max( lswork, 1 )
634 $
CALL clacpy(
'F', m, n, asav, lda, a, lda )
636 CALL cgesvd(
'A',
'A', m, n, a, lda, ssav, usav, ldu,
637 $ vtsav, ldvt, work, lswork, rwork, iinfo )
638 IF( iinfo.NE.0 )
THEN
639 WRITE( nounit, fmt = 9995 )
'GESVD', iinfo, m, n,
640 $ jtype, lswork, ioldsd
647 CALL cbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
648 $ vtsav, ldvt, work, rwork, result( 1 ) )
649 IF( m.NE.0 .AND. n.NE.0 )
THEN
650 CALL cunt01(
'Columns', mnmin, m, usav, ldu, work,
651 $ lwork, rwork, result( 2 ) )
652 CALL cunt01(
'Rows', mnmin, n, vtsav, ldvt, work,
653 $ lwork, rwork, result( 3 ) )
656 DO 70 i = 1, mnmin - 1
657 IF( ssav( i ).LT.ssav( i+1 ) )
658 $ result( 4 ) = ulpinv
659 IF( ssav( i ).LT.zero )
660 $ result( 4 ) = ulpinv
662 IF( mnmin.GE.1 )
THEN
663 IF( ssav( mnmin ).LT.zero )
664 $ result( 4 ) = ulpinv
674 IF( ( iju.EQ.3 .AND. ijvt.EQ.3 ) .OR.
675 $ ( iju.EQ.1 .AND. ijvt.EQ.1 ) )
GO TO 90
677 jobvt = cjob( ijvt+1 )
678 CALL clacpy(
'F', m, n, asav, lda, a, lda )
680 CALL cgesvd( jobu, jobvt, m, n, a, lda, s, u, ldu,
681 $ vt, ldvt, work, lswork, rwork, iinfo )
686 IF( m.GT.0 .AND. n.GT.0 )
THEN
688 CALL cunt03(
'C', m, mnmin, m, mnmin, usav,
689 $ ldu, a, lda, work, lwork, rwork,
691 ELSE IF( iju.EQ.2 )
THEN
692 CALL cunt03(
'C', m, mnmin, m, mnmin, usav,
693 $ ldu, u, ldu, work, lwork, rwork,
695 ELSE IF( iju.EQ.3 )
THEN
696 CALL cunt03(
'C', m, m, m, mnmin, usav, ldu,
697 $ u, ldu, work, lwork, rwork, dif,
701 result( 5 ) = max( result( 5 ), dif )
706 IF( m.GT.0 .AND. n.GT.0 )
THEN
708 CALL cunt03(
'R', n, mnmin, n, mnmin, vtsav,
709 $ ldvt, a, lda, work, lwork,
710 $ rwork, dif, iinfo )
711 ELSE IF( ijvt.EQ.2 )
THEN
712 CALL cunt03(
'R', n, mnmin, n, mnmin, vtsav,
713 $ ldvt, vt, ldvt, work, lwork,
714 $ rwork, dif, iinfo )
715 ELSE IF( ijvt.EQ.3 )
THEN
716 CALL cunt03(
'R', n, n, n, mnmin, vtsav,
717 $ ldvt, vt, ldvt, work, lwork,
718 $ rwork, dif, iinfo )
721 result( 6 ) = max( result( 6 ), dif )
726 div = max( real( mnmin )*ulp*s( 1 ),
727 $ slamch(
'Safe minimum' ) )
728 DO 80 i = 1, mnmin - 1
729 IF( ssav( i ).LT.ssav( i+1 ) )
731 IF( ssav( i ).LT.zero )
733 dif = max( dif, abs( ssav( i )-s( i ) ) / div )
735 result( 7 ) = max( result( 7 ), dif )
741 iwtmp = 2*mnmin*mnmin + 2*mnmin + max( m, n )
742 lswork = iwtmp + ( iwspc-1 )*( lwork-iwtmp ) / 3
743 lswork = min( lswork, lwork )
744 lswork = max( lswork, 1 )
750 CALL clacpy(
'F', m, n, asav, lda, a, lda )
752 CALL cgesdd(
'A', m, n, a, lda, ssav, usav, ldu, vtsav,
753 $ ldvt, work, lswork, rwork, iwork, iinfo )
754 IF( iinfo.NE.0 )
THEN
755 WRITE( nounit, fmt = 9995 )
'GESDD', iinfo, m, n,
756 $ jtype, lswork, ioldsd
763 CALL cbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
764 $ vtsav, ldvt, work, rwork, result( 8 ) )
765 IF( m.NE.0 .AND. n.NE.0 )
THEN
766 CALL cunt01(
'Columns', mnmin, m, usav, ldu, work,
767 $ lwork, rwork, result( 9 ) )
768 CALL cunt01(
'Rows', mnmin, n, vtsav, ldvt, work,
769 $ lwork, rwork, result( 10 ) )
772 DO 110 i = 1, mnmin - 1
773 IF( ssav( i ).LT.ssav( i+1 ) )
774 $ result( 11 ) = ulpinv
775 IF( ssav( i ).LT.zero )
776 $ result( 11 ) = ulpinv
778 IF( mnmin.GE.1 )
THEN
779 IF( ssav( mnmin ).LT.zero )
780 $ result( 11 ) = ulpinv
790 CALL clacpy(
'F', m, n, asav, lda, a, lda )
792 CALL cgesdd( jobq, m, n, a, lda, s, u, ldu, vt, ldvt,
793 $ work, lswork, rwork, iwork, iinfo )
798 IF( m.GT.0 .AND. n.GT.0 )
THEN
801 CALL cunt03(
'C', m, mnmin, m, mnmin, usav,
802 $ ldu, a, lda, work, lwork, rwork,
805 CALL cunt03(
'C', m, mnmin, m, mnmin, usav,
806 $ ldu, u, ldu, work, lwork, rwork,
809 ELSE IF( ijq.EQ.2 )
THEN
810 CALL cunt03(
'C', m, mnmin, m, mnmin, usav, ldu,
811 $ u, ldu, work, lwork, rwork, dif,
815 result( 12 ) = max( result( 12 ), dif )
820 IF( m.GT.0 .AND. n.GT.0 )
THEN
823 CALL cunt03(
'R', n, mnmin, n, mnmin, vtsav,
824 $ ldvt, vt, ldvt, work, lwork,
825 $ rwork, dif, iinfo )
827 CALL cunt03(
'R', n, mnmin, n, mnmin, vtsav,
828 $ ldvt, a, lda, work, lwork,
829 $ rwork, dif, iinfo )
831 ELSE IF( ijq.EQ.2 )
THEN
832 CALL cunt03(
'R', n, mnmin, n, mnmin, vtsav,
833 $ ldvt, vt, ldvt, work, lwork, rwork,
837 result( 13 ) = max( result( 13 ), dif )
842 div = max( real( mnmin )*ulp*s( 1 ),
843 $ slamch(
'Safe minimum' ) )
844 DO 120 i = 1, mnmin - 1
845 IF( ssav( i ).LT.ssav( i+1 ) )
847 IF( ssav( i ).LT.zero )
849 dif = max( dif, abs( ssav( i )-s( i ) ) / div )
851 result( 14 ) = max( result( 14 ), dif )
864 iwtmp = 2*mnmin*mnmin + 2*mnmin + max( m, n )
865 lswork = iwtmp + ( iwspc-1 )*( lwork-iwtmp ) / 3
866 lswork = min( lswork, lwork )
867 lswork = max( lswork, 1 )
871 CALL clacpy(
'F', m, n, asav, lda, a, lda )
874 lrwork = max(2, m, 5*n)
876 CALL cgesvdq(
'H',
'N',
'N',
'A',
'A',
877 $ m, n, a, lda, ssav, usav, ldu,
878 $ vtsav, ldvt, numrank, iwork, liwork,
879 $ work, lwork, rwork, lrwork, iinfo )
881 IF( iinfo.NE.0 )
THEN
882 WRITE( nounit, fmt = 9995 )
'CGESVDQ', iinfo, m, n,
883 $ jtype, lswork, ioldsd
890 CALL cbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
891 $ vtsav, ldvt, work, rwork, result( 36 ) )
892 IF( m.NE.0 .AND. n.NE.0 )
THEN
893 CALL cunt01(
'Columns', m, m, usav, ldu, work,
894 $ lwork, rwork, result( 37 ) )
895 CALL cunt01(
'Rows', n, n, vtsav, ldvt, work,
896 $ lwork, rwork, result( 38 ) )
899 DO 199 i = 1, mnmin - 1
900 IF( ssav( i ).LT.ssav( i+1 ) )
901 $ result( 39 ) = ulpinv
902 IF( ssav( i ).LT.zero )
903 $ result( 39 ) = ulpinv
905 IF( mnmin.GE.1 )
THEN
906 IF( ssav( mnmin ).LT.zero )
907 $ result( 39 ) = ulpinv
920 iwtmp = 2*mnmin*mnmin + 2*mnmin + max( m, n )
921 lswork = iwtmp + ( iwspc-1 )*( lwork-iwtmp ) / 3
922 lswork = min( lswork, lwork )
923 lswork = max( lswork, 1 )
928 CALL clacpy(
'F', m, n, asav, lda, usav, lda )
930 CALL cgesvj(
'G',
'U',
'V', m, n, usav, lda, ssav,
931 & 0, a, ldvt, work, lwork, rwork,
938 vtsav(j,i) = conjg(a(i,j))
942 IF( iinfo.NE.0 )
THEN
943 WRITE( nounit, fmt = 9995 )
'GESVJ', iinfo, m, n,
944 $ jtype, lswork, ioldsd
951 CALL cbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
952 $ vtsav, ldvt, work, rwork, result( 15 ) )
953 IF( m.NE.0 .AND. n.NE.0 )
THEN
954 CALL cunt01(
'Columns', m, m, usav, ldu, work,
955 $ lwork, rwork, result( 16 ) )
956 CALL cunt01(
'Rows', n, n, vtsav, ldvt, work,
957 $ lwork, rwork, result( 17 ) )
960 DO 131 i = 1, mnmin - 1
961 IF( ssav( i ).LT.ssav( i+1 ) )
962 $ result( 18 ) = ulpinv
963 IF( ssav( i ).LT.zero )
964 $ result( 18 ) = ulpinv
966 IF( mnmin.GE.1 )
THEN
967 IF( ssav( mnmin ).LT.zero )
968 $ result( 18 ) = ulpinv
980 iwtmp = 2*mnmin*mnmin + 2*mnmin + max( m, n )
981 lswork = iwtmp + ( iwspc-1 )*( lwork-iwtmp ) / 3
982 lswork = min( lswork, lwork )
983 lswork = max( lswork, 1 )
986 lrwork = max( 7, n + 2*m)
988 CALL clacpy(
'F', m, n, asav, lda, vtsav, lda )
990 CALL cgejsv(
'G',
'U',
'V',
'R',
'N',
'N',
991 & m, n, vtsav, lda, ssav, usav, ldu, a, ldvt,
992 & work, lwork, rwork,
993 & lrwork, iwork, iinfo )
999 vtsav(j,i) = conjg(a(i,j))
1003 IF( iinfo.NE.0 )
THEN
1004 WRITE( nounit, fmt = 9995 )
'GEJSV', iinfo, m, n,
1005 $ jtype, lswork, ioldsd
1012 CALL cbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
1013 $ vtsav, ldvt, work, rwork, result( 19 ) )
1014 IF( m.NE.0 .AND. n.NE.0 )
THEN
1015 CALL cunt01(
'Columns', m, m, usav, ldu, work,
1016 $ lwork, rwork, result( 20 ) )
1017 CALL cunt01(
'Rows', n, n, vtsav, ldvt, work,
1018 $ lwork, rwork, result( 21 ) )
1021 DO 134 i = 1, mnmin - 1
1022 IF( ssav( i ).LT.ssav( i+1 ) )
1023 $ result( 22 ) = ulpinv
1024 IF( ssav( i ).LT.zero )
1025 $ result( 22 ) = ulpinv
1027 IF( mnmin.GE.1 )
THEN
1028 IF( ssav( mnmin ).LT.zero )
1029 $ result( 22 ) = ulpinv
1037 CALL clacpy(
'F', m, n, asav, lda, a, lda )
1039 CALL cgesvdx(
'V',
'V',
'A', m, n, a, lda,
1040 $ vl, vu, il, iu, ns, ssav, usav, ldu,
1041 $ vtsav, ldvt, work, lwork, rwork,
1043 IF( iinfo.NE.0 )
THEN
1044 WRITE( nounit, fmt = 9995 )
'GESVDX', iinfo, m, n,
1045 $ jtype, lswork, ioldsd
1055 CALL cbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
1056 $ vtsav, ldvt, work, rwork, result( 23 ) )
1057 IF( m.NE.0 .AND. n.NE.0 )
THEN
1058 CALL cunt01(
'Columns', mnmin, m, usav, ldu, work,
1059 $ lwork, rwork, result( 24 ) )
1060 CALL cunt01(
'Rows', mnmin, n, vtsav, ldvt, work,
1061 $ lwork, rwork, result( 25 ) )
1064 DO 140 i = 1, mnmin - 1
1065 IF( ssav( i ).LT.ssav( i+1 ) )
1066 $ result( 26 ) = ulpinv
1067 IF( ssav( i ).LT.zero )
1068 $ result( 26 ) = ulpinv
1070 IF( mnmin.GE.1 )
THEN
1071 IF( ssav( mnmin ).LT.zero )
1072 $ result( 26 ) = ulpinv
1082 IF( ( iju.EQ.0 .AND. ijvt.EQ.0 ) .OR.
1083 $ ( iju.EQ.1 .AND. ijvt.EQ.1 ) )
GO TO 160
1084 jobu = cjobv( iju+1 )
1085 jobvt = cjobv( ijvt+1 )
1087 CALL clacpy(
'F', m, n, asav, lda, a, lda )
1089 CALL cgesvdx( jobu, jobvt,
'A', m, n, a, lda,
1090 $ vl, vu, il, iu, ns, ssav, u, ldu,
1091 $ vt, ldvt, work, lwork, rwork,
1097 IF( m.GT.0 .AND. n.GT.0 )
THEN
1099 CALL cunt03(
'C', m, mnmin, m, mnmin, usav,
1100 $ ldu, u, ldu, work, lwork, rwork,
1104 result( 27 ) = max( result( 27 ), dif )
1109 IF( m.GT.0 .AND. n.GT.0 )
THEN
1110 IF( ijvt.EQ.1 )
THEN
1111 CALL cunt03(
'R', n, mnmin, n, mnmin, vtsav,
1112 $ ldvt, vt, ldvt, work, lwork,
1113 $ rwork, dif, iinfo )
1116 result( 28 ) = max( result( 28 ), dif )
1121 div = max( real( mnmin )*ulp*s( 1 ),
1122 $ slamch(
'Safe minimum' ) )
1123 DO 150 i = 1, mnmin - 1
1124 IF( ssav( i ).LT.ssav( i+1 ) )
1126 IF( ssav( i ).LT.zero )
1128 dif = max( dif, abs( ssav( i )-s( i ) ) / div )
1130 result( 29) = max( result( 29 ), dif )
1137 iseed2( i ) = iseed( i )
1139 IF( mnmin.LE.1 )
THEN
1141 iu = max( 1, mnmin )
1143 il = 1 + int( ( mnmin-1 )*slarnd( 1, iseed2 ) )
1144 iu = 1 + int( ( mnmin-1 )*slarnd( 1, iseed2 ) )
1151 CALL clacpy(
'F', m, n, asav, lda, a, lda )
1153 CALL cgesvdx(
'V',
'V',
'I', m, n, a, lda,
1154 $ vl, vu, il, iu, nsi, s, u, ldu,
1155 $ vt, ldvt, work, lwork, rwork,
1157 IF( iinfo.NE.0 )
THEN
1158 WRITE( nounit, fmt = 9995 )
'GESVDX', iinfo, m, n,
1159 $ jtype, lswork, ioldsd
1167 CALL cbdt05( m, n, asav, lda, s, nsi, u, ldu,
1168 $ vt, ldvt, work, result( 30 ) )
1169 IF( m.NE.0 .AND. n.NE.0 )
THEN
1170 CALL cunt01(
'Columns', m, nsi, u, ldu, work,
1171 $ lwork, rwork, result( 31 ) )
1172 CALL cunt01(
'Rows', nsi, n, vt, ldvt, work,
1173 $ lwork, rwork, result( 32 ) )
1178 IF( mnmin.GT.0 .AND. nsi.GT.1 )
THEN
1181 $ max( half*abs( ssav( il )-ssav( il-1 ) ),
1182 $ ulp*anorm, two*rtunfl )
1185 $ max( half*abs( ssav( ns )-ssav( 1 ) ),
1186 $ ulp*anorm, two*rtunfl )
1189 vl = ssav( iu ) - max( ulp*anorm, two*rtunfl,
1190 $ half*abs( ssav( iu+1 )-ssav( iu ) ) )
1192 vl = ssav( ns ) - max( ulp*anorm, two*rtunfl,
1193 $ half*abs( ssav( ns )-ssav( 1 ) ) )
1197 IF( vl.GE.vu ) vu = max( vu*2, vu+vl+half )
1202 CALL clacpy(
'F', m, n, asav, lda, a, lda )
1204 CALL cgesvdx(
'V',
'V',
'V', m, n, a, lda,
1205 $ vl, vu, il, iu, nsv, s, u, ldu,
1206 $ vt, ldvt, work, lwork, rwork,
1208 IF( iinfo.NE.0 )
THEN
1209 WRITE( nounit, fmt = 9995 )
'GESVDX', iinfo, m, n,
1210 $ jtype, lswork, ioldsd
1218 CALL cbdt05( m, n, asav, lda, s, nsv, u, ldu,
1219 $ vt, ldvt, work, result( 33 ) )
1220 IF( m.NE.0 .AND. n.NE.0 )
THEN
1221 CALL cunt01(
'Columns', m, nsv, u, ldu, work,
1222 $ lwork, rwork, result( 34 ) )
1223 CALL cunt01(
'Rows', nsv, n, vt, ldvt, work,
1224 $ lwork, rwork, result( 35 ) )
1232 IF( result( j ).GE.zero )
1234 IF( result( j ).GE.thresh )
1239 $ ntestf = ntestf + 1
1240 IF( ntestf.EQ.1 )
THEN
1241 WRITE( nounit, fmt = 9999 )
1242 WRITE( nounit, fmt = 9998 )thresh
1247 IF( result( j ).GE.thresh )
THEN
1248 WRITE( nounit, fmt = 9997 )m, n, jtype, iwspc,
1249 $ ioldsd, j, result( j )
1253 nerrs = nerrs + nfail
1254 ntestt = ntestt + ntest
1263 CALL alasvm(
'CBD', nounit, nerrs, ntestt, 0 )
1265 9999
FORMAT(
' SVD -- Complex Singular Value Decomposition Driver ',
1266 $ /
' Matrix types (see CDRVBD for details):',
1267 $ / /
' 1 = Zero matrix', /
' 2 = Identity matrix',
1268 $ /
' 3 = Evenly spaced singular values near 1',
1269 $ /
' 4 = Evenly spaced singular values near underflow',
1270 $ /
' 5 = Evenly spaced singular values near overflow',
1271 $ / /
' Tests performed: ( A is dense, U and V are unitary,',
1272 $ / 19x,
' S is an array, and Upartial, VTpartial, and',
1273 $ / 19x,
' Spartial are partially computed U, VT and S),', / )
1274 9998
FORMAT(
' Tests performed with Test Threshold = ', f8.2,
1276 $
' 1 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
1277 $ /
' 2 = | I - U**T U | / ( M ulp ) ',
1278 $ /
' 3 = | I - VT VT**T | / ( N ulp ) ',
1279 $ /
' 4 = 0 if S contains min(M,N) nonnegative values in',
1280 $
' decreasing order, else 1/ulp',
1281 $ /
' 5 = | U - Upartial | / ( M ulp )',
1282 $ /
' 6 = | VT - VTpartial | / ( N ulp )',
1283 $ /
' 7 = | S - Spartial | / ( min(M,N) ulp |S| )',
1285 $
' 8 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
1286 $ /
' 9 = | I - U**T U | / ( M ulp ) ',
1287 $ /
'10 = | I - VT VT**T | / ( N ulp ) ',
1288 $ /
'11 = 0 if S contains min(M,N) nonnegative values in',
1289 $
' decreasing order, else 1/ulp',
1290 $ /
'12 = | U - Upartial | / ( M ulp )',
1291 $ /
'13 = | VT - VTpartial | / ( N ulp )',
1292 $ /
'14 = | S - Spartial | / ( min(M,N) ulp |S| )',
1294 $ /
'15 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
1295 $ /
'16 = | I - U**T U | / ( M ulp ) ',
1296 $ /
'17 = | I - VT VT**T | / ( N ulp ) ',
1297 $ /
'18 = 0 if S contains min(M,N) nonnegative values in',
1298 $
' decreasing order, else 1/ulp',
1300 $ /
'19 = | A - U diag(S) VT | / ( |A| max(M,N) ulp )',
1301 $ /
'20 = | I - U**T U | / ( M ulp ) ',
1302 $ /
'21 = | I - VT VT**T | / ( N ulp ) ',
1303 $ /
'22 = 0 if S contains min(M,N) nonnegative values in',
1304 $
' decreasing order, else 1/ulp',
1305 $ /
' CGESVDX(V,V,A): ', /
1306 $
'23 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
1307 $ /
'24 = | I - U**T U | / ( M ulp ) ',
1308 $ /
'25 = | I - VT VT**T | / ( N ulp ) ',
1309 $ /
'26 = 0 if S contains min(M,N) nonnegative values in',
1310 $
' decreasing order, else 1/ulp',
1311 $ /
'27 = | U - Upartial | / ( M ulp )',
1312 $ /
'28 = | VT - VTpartial | / ( N ulp )',
1313 $ /
'29 = | S - Spartial | / ( min(M,N) ulp |S| )',
1314 $ /
' CGESVDX(V,V,I): ',
1315 $ /
'30 = | U**T A VT**T - diag(S) | / ( |A| max(M,N) ulp )',
1316 $ /
'31 = | I - U**T U | / ( M ulp ) ',
1317 $ /
'32 = | I - VT VT**T | / ( N ulp ) ',
1318 $ /
' CGESVDX(V,V,V) ',
1319 $ /
'33 = | U**T A VT**T - diag(S) | / ( |A| max(M,N) ulp )',
1320 $ /
'34 = | I - U**T U | / ( M ulp ) ',
1321 $ /
'35 = | I - VT VT**T | / ( N ulp ) ',
1322 $
' CGESVDQ(H,N,N,A,A',
1323 $ /
'36 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
1324 $ /
'37 = | I - U**T U | / ( M ulp ) ',
1325 $ /
'38 = | I - VT VT**T | / ( N ulp ) ',
1326 $ /
'39 = 0 if S contains min(M,N) nonnegative values in',
1327 $
' decreasing order, else 1/ulp',
1329 9997
FORMAT(
' M=', i5,
', N=', i5,
', type ', i1,
', IWS=', i1,
1330 $
', seed=', 4( i4,
',' ),
' test(', i2,
')=', g11.4 )
1331 9996
FORMAT(
' CDRVBD: ', a,
' returned INFO=', i6,
'.', / 9x,
'M=',
1332 $ i6,
', N=', i6,
', JTYPE=', i6,
', ISEED=(', 3( i5,
',' ),
1334 9995
FORMAT(
' CDRVBD: ', a,
' returned INFO=', i6,
'.', / 9x,
'M=',
1335 $ i6,
', N=', i6,
', JTYPE=', i6,
', LSWORK=', i6, / 9x,
1336 $
'ISEED=(', 3( i5,
',' ), i5,
')' )