397 SUBROUTINE zdrvbd( 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 , LDA, LDU, LDVT, LWORK, NOUNIT, NSIZES
411DOUBLE PRECISION THRESH
415 INTEGER ISEED( 4 ), IWORK( * ), MM( * ), NN( * )
416 DOUBLE PRECISION E( * ), RWORK( * ), S( * ), SSAV( * )
417 COMPLEX*16 A( LDA, * ), ASAV( LDA, * ), U( LDU, * ),
418 $ usav( ldu, * ), vt( ldvt, * ),
419 $ vtsav( ldvt, * ), work( * )
425 DOUBLE PRECISION ZERO, ONE, TWO, HALF
426 PARAMETER ( ZERO = 0.0d0, one = 1.0d0, two = 2.0d0,
428 COMPLEX*16 CZERO, CONE
429 parameter( czero = ( 0.0d+0, 0.0d+0 ),
430 $ cone = ( 1.0d+0, 0.0d+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 DOUBLE PRECISION 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 )
451 DOUBLE PRECISION RESULT( 39 )
454 DOUBLE PRECISION , DLARND
455 EXTERNAL DLAMCH, DLARND
463 INTRINSIC abs, dble,
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(
'ZDRVBD', -info )
533 IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
542 rtunfl = sqrt( unfl )
548 DO 230 jsize = 1, nsizes
553 IF( nsizes.NE.1 )
THEN
554 mtypes =
min( maxtyp, ntypes )
556 mtypes =
min( maxtyp+1, ntypes )
559 DO 220 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 zlaset(
'Full', m, n, czero, czero, a, lda )
578 DO 30 i = 1,
min( m, n )
582 ELSE IF( jtype.EQ.2 )
THEN
586 CALL zlaset(
'Full', m, n, czero, cone, a, lda )
587 DO 40 i = 1,
min( m, n )
601 CALL zlatms( m, n,
'U', iseed,
'N', s, 4, dble( 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 zlacpy(
'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 zlacpy(
'F', m, n, asav, lda, a, lda )
636 CALL zgesvd(
'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 zbdt01( 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 zunt01(
'Columns', mnmin, m, usav, ldu, work,
651 $ lwork, rwork, result( 2 ) )
652 CALL zunt01(
'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 zlacpy(
'F', m, n, asav, lda, a, lda )
680 CALL zgesvd( 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 zunt03(
'C', m, mnmin, m, mnmin, usav,
689 $ ldu, a, lda, work, lwork, rwork,
691 ELSE IF( iju.EQ.2 )
THEN
692 CALL zunt03(
'C', m, mnmin, m, mnmin, usav,
693 $ ldu, u, ldu, work, lwork, rwork,
695 ELSE IF( iju.EQ.3 )
THEN
696 CALL zunt03(
'C', m, m, m, mnmin, usav, ldu,
697 $ u, ldu, work, lwork, rwork, dif,
701 result( 5 ) =
max( result( 5 ), dif )
708 CALL zunt03(
'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 zunt03(
'R', n, mnmin, n, mnmin, vtsav,
713 $ ldvt, vt, ldvt, work, lwork,
715 ELSE IF( ijvt.EQ.3 )
THEN
716 CALL zunt03(
'R', n, n, n, mnmin, vtsav,
717 $ ldvt, vt, ldvt, work, lwork,
721 result( 6 ) =
max( result( 6 ), dif )
726 div =
max( dble( mnmin )*ulp*s( 1 ),
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 zlacpy(
'F', m, n, asav
752 CALL zgesdd(
'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,
763 CALL zbdt01( 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 zunt01(
'Columns', mnmin, m, usav, ldu, work,
767 $ lwork, rwork, result( 9 ) )
768 CALL zunt01(
'Rows', mnmin, n, vtsav, ldvt, work,
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 zlacpy(
'F', m, n, asav, lda, a, lda )
792 CALL zgesdd( 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 zunt03(
'C', m, mnmin, m, mnmin, usav,
802 $ ldu, a, lda, work, lwork, rwork,
805 CALL zunt03(
'C', m, mnmin, m, mnmin, usav,
806 $ ldu, u, ldu, work, lwork, rwork,
809 ELSE IF( ijq.EQ.2 )
THEN
810 CALL zunt03(
'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 zunt03(
'R', n, mnmin, n, mnmin, vtsav,
824 $ ldvt, vt, ldvt, work, lwork,
825 $ rwork, dif, iinfo )
827 CALL zunt03(
'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 zunt03(
'R', n, mnmin, n, mnmin, vtsav,
833 $ ldvt, vt, ldvt, work, lwork, rwork,
837 result( 13 ) =
max( result( 13 ), dif )
842 div =
max( dble( mnmin )*ulp*s( 1 ),
843 $ dlamch(
'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 )
863 iwtmp = 2*mnmin*mnmin + 2*mnmin +
max( m, n )
864 lswork = iwtmp + ( iwspc-1 )*( lwork-iwtmp ) / 3
866 lswork =
max( lswork, 1 )
870 CALL zlacpy(
'F', m, n, asav, lda, a, lda )
873 lrwork =
max(2, m, 5*n)
875 CALL zgesvdq(
'H',
'N',
'N',
'A',
'A',
876 $ m, n, a, lda, ssav, usav, ldu,
877 $ vtsav, ldvt, numrank, iwork, liwork,
878 $ work, lwork, rwork, lrwork, iinfo )
880 IF( iinfo.NE.0 )
THEN
881 WRITE( nounit, fmt = 9995 )
'ZGESVDQ', iinfo, m, n,
882 $ jtype, lswork, ioldsd
889 CALL zbdt01( m, n, 0, asav, lda, usav, ldu
890 $ vtsav, ldvt, work, rwork, result( 36 ) )
891 IF( m.NE.0 .AND. n.NE.0 )
THEN
892 CALL zunt01(
'Columns', m, m, usav, ldu, work,
893 $ lwork, rwork, result( 37 ) )
894 CALL zunt01(
'Rows', n, n, vtsav, ldvt, work,
895 $ lwork, rwork, result( 38 ) )
898 DO 199 i = 1, mnmin - 1
899 IF( ssav( i ).LT.ssav( i+1 ) )
900 $ result( 39 ) = ulpinv
901 IF( ssav( i ).LT.zero )
902 $ result( 39 ) = ulpinv
904 IF( mnmin.GE.1 )
THEN
905 IF( ssav( mnmin ).LT.zero )
906 $ result( 39 ) = ulpinv
919 iwtmp = 2*mnmin*mnmin + 2*mnmin +
max( m, n )
920 lswork = iwtmp + ( iwspc-1 )*( lwork-iwtmp ) / 3
921 lswork =
min( lswork, lwork
922 lswork =
max( lswork, 1 )
927 CALL zlacpy(
'F', m, n, asav, lda, usav, lda )
929 CALL zgesvj(
'G',
'U',
'V', m, n, usav, lda, ssav,
930 & 0, a, ldvt, work, lwork, rwork,
937 vtsav(j,i) = conjg(a(i,j))
941 IF( iinfo.NE.0 )
THEN
942 WRITE( nounit, fmt = 9995 )
'GESVJ', iinfo, m, n,
943 $ jtype, lswork, ioldsd
950 CALL zbdt01( m, n, 0, asav, lda, usav, ldu, ssav, e,
951 $ vtsav, ldvt, work, rwork, result( 15 ) )
952 IF( m.NE.0 .AND. n.NE.0 )
THEN
953 CALL zunt01(
'Columns', m, m, usav, ldu, work,
954 $ lwork, rwork, result( 16 ) )
955 CALL zunt01(
'Rows', n, n, vtsav, ldvt, work,
956 $ lwork, rwork, result( 17 ) )
959 DO 131 i = 1, mnmin - 1
960 IF( ssav( i ).LT.ssav( i+1 ) )
961 $ result( 18 ) = ulpinv
962 IF( ssav( i ).LT.zero )
963 $ result( 18 ) = ulpinv
965 IF( mnmin.GE.1 )
THEN
966 IF( ssav( mnmin ).LT.zero )
967 $ result( 18 ) = ulpinv
979 iwtmp = 2*mnmin*mnmin + 2*mnmin +
max( m, n )
980 lswork = iwtmp + ( iwspc-1 )*( lwork-iwtmp ) / 3
981 lswork =
min( lswork, lwork )
982 lswork =
max( lswork, 1 )
985 lrwork =
max( 7, n + 2*m)
987 CALL zlacpy(
'F', m, n, asav, lda, vtsav, lda )
989 CALL ZGEJSV( 'g
', 'u
', 'v
', 'r
', 'n
', 'n
',
990 & M, N, VTSAV, LDA, SSAV, USAV, LDU, A, LDVT,
991 & WORK, LWORK, RWORK,
992 & LRWORK, IWORK, IINFO )
998 VTSAV(J,I) = CONJG (A(I,J))
1002.NE.
IF( IINFO0 ) THEN
1003 WRITE( NOUNIT, FMT = 9995 )'gejsv
', IINFO, M, N,
1004 $ JTYPE, LSWORK, IOLDSD
1011 CALL ZBDT01( M, N, 0, ASAV, LDA, USAV, LDU, SSAV, E,
1012 $ VTSAV, LDVT, WORK, RWORK, RESULT( 19 ) )
1013.NE..AND..NE.
IF( M0 N0 ) THEN
1014 CALL ZUNT01( 'columns
', M, M, USAV, LDU, WORK,
1015 $ LWORK, RWORK, RESULT( 20 ) )
1016 CALL ZUNT01( 'rows
', N, N, VTSAV, LDVT, WORK,
1017 $ LWORK, RWORK, RESULT( 21 ) )
1020 DO 134 I = 1, MNMIN - 1
1021.LT.
IF( SSAV( I )SSAV( I+1 ) )
1022 $ RESULT( 22 ) = ULPINV
1023.LT.
IF( SSAV( I )ZERO )
1024 $ RESULT( 22 ) = ULPINV
1026.GE.
IF( MNMIN1 ) THEN
1027.LT.
IF( SSAV( MNMIN )ZERO )
1028 $ RESULT( 22 ) = ULPINV
1036 CALL ZLACPY( 'f
', M, N, ASAV, LDA, A, LDA )
1038 CALL ZGESVDX( 'v
', 'v
', 'a
', M, N, A, LDA,
1039 $ VL, VU, IL, IU, NS, SSAV, USAV, LDU,
1040 $ VTSAV, LDVT, WORK, LWORK, RWORK,
1042.NE.
IF( IINFO0 ) THEN
1043 WRITE( NOUNIT, FMT = 9995 )'gesvdx
', IINFO, M, N,
1044 $ JTYPE, LSWORK, IOLDSD
1054 CALL ZBDT01( M, N, 0, ASAV, LDA, USAV, LDU, SSAV, E,
1055 $ VTSAV, LDVT, WORK, RWORK, RESULT( 23 ) )
1056.NE..AND..NE.
IF( M0 N0 ) THEN
1057 CALL ZUNT01( 'columns
', MNMIN, M, USAV, LDU, WORK,
1058 $ LWORK, RWORK, RESULT( 24 ) )
1059 CALL ZUNT01( 'rows
', MNMIN, N, VTSAV, LDVT, WORK,
1060 $ LWORK, RWORK, RESULT( 25 ) )
1063 DO 140 I = 1, MNMIN - 1
1064.LT.
IF( SSAV( I )SSAV( I+1 ) )
1065 $ RESULT( 26 ) = ULPINV
1066.LT.
IF( SSAV( I )ZERO )
1067 $ RESULT( 26 ) = ULPINV
1069.GE.
IF( MNMIN1 ) THEN
1070.LT.
IF( SSAV( MNMIN )ZERO )
1071 $ RESULT( 26 ) = ULPINV
1081.EQ..AND..EQ..OR.
IF( ( IJU0 IJVT0 )
1082.EQ..AND..EQ.
$ ( IJU1 IJVT1 ) ) GO TO 160
1083 JOBU = CJOBV( IJU+1 )
1084 JOBVT = CJOBV( IJVT+1 )
1086 CALL ZLACPY( 'f
', M, N, ASAV, LDA, A, LDA )
1088 CALL ZGESVDX( JOBU, JOBVT, 'a
', M, N, A, LDA,
1089 $ VL, VU, IL, IU, NS, SSAV, U, LDU,
1090 $ VT, LDVT, WORK, LWORK, RWORK,
1096.GT..AND..GT.
IF( M0 N0 ) THEN
1098 CALL ZUNT03( 'c
', M, MNMIN, M, MNMIN, USAV,
1099 $ LDU, U, LDU, WORK, LWORK, RWORK,
1103 RESULT( 27 ) = MAX( RESULT( 27 ), DIF )
1108.GT..AND..GT.
IF( M0 N0 ) THEN
1109.EQ.
IF( IJVT1 ) THEN
1110 CALL ZUNT03( 'r
', N, MNMIN, N, MNMIN, VTSAV,
1111 $ LDVT, VT, LDVT, WORK, LWORK,
1112 $ RWORK, DIF, IINFO )
1115 RESULT( 28 ) = MAX( RESULT( 28 ), DIF )
1120 DIV = MAX( DBLE( MNMIN )*ULP*S( 1 ),
1121 $ DLAMCH( 'safe minimum
' ) )
1122 DO 150 I = 1, MNMIN - 1
1123.LT.
IF( SSAV( I )SSAV( I+1 ) )
1125.LT.
IF( SSAV( I )ZERO )
1127 DIF = MAX( DIF, ABS( SSAV( I )-S( I ) ) / DIV )
1129 RESULT( 29) = MAX( RESULT( 29 ), DIF )
1136 ISEED2( I ) = ISEED( I )
1138.LE.
IF( MNMIN1 ) THEN
1140 IU = MAX( 1, MNMIN )
1142 IL = 1 + INT( ( MNMIN-1 )*DLARND( 1, ISEED2 ) )
1143 IU = 1 + INT( ( MNMIN-1 )*DLARND( 1, ISEED2 ) )
1150 CALL ZLACPY( 'f
', M, N, ASAV, LDA, A, LDA )
1152 CALL ZGESVDX( 'v
', 'v
', 'i
', M, N, A, LDA,
1153 $ VL, VU, IL, IU, NSI, S, U, LDU,
1154 $ VT, LDVT, WORK, LWORK, RWORK,
1156.NE.
IF( IINFO0 ) THEN
1157 WRITE( NOUNIT, FMT = 9995 )'gesvdx
', IINFO, M, N,
1158 $ JTYPE, LSWORK, IOLDSD
1166 CALL ZBDT05( M, N, ASAV, LDA, S, NSI, U, LDU,
1167 $ VT, LDVT, WORK, RESULT( 30 ) )
1168.NE..AND..NE.
IF( M0 N0 ) THEN
1169 CALL ZUNT01( 'columns
', M, NSI, U, LDU, WORK,
1170 $ LWORK, RWORK, RESULT( 31 ) )
1171 CALL ZUNT01( 'rows
', NSI, N, VT, LDVT, WORK,
1172 $ LWORK, RWORK, RESULT( 32 ) )
1177.GT..AND..GT.
IF( MNMIN0 NSI1 ) THEN
1180 $ MAX( HALF*ABS( SSAV( IL )-SSAV( IL-1 ) ),
1181 $ ULP*ANORM, TWO*RTUNFL )
1184 $ MAX( HALF*ABS( SSAV( NS )-SSAV( 1 ) ),
1185 $ ULP*ANORM, TWO*RTUNFL )
1188 VL = SSAV( IU ) - MAX( ULP*ANORM, TWO*RTUNFL,
1189 $ HALF*ABS( SSAV( IU+1 )-SSAV( IU ) ) )
1191 VL = SSAV( NS ) - MAX( ULP*ANORM, TWO*RTUNFL,
1192 $ HALF*ABS( SSAV( NS )-SSAV( 1 ) ) )
1196.GE.
IF( VLVU ) VU = MAX( VU*2, VU+VL+HALF )
1201 CALL ZLACPY( 'f
', M, N, ASAV, LDA, A, LDA )
1203 CALL ZGESVDX( 'v
', 'v
', 'v
', M, N, A, LDA,
1204 $ VL, VU, IL, IU, NSV, S, U, LDU,
1205 $ VT, LDVT, WORK, LWORK, RWORK,
1207.NE.
IF( IINFO0 ) THEN
1208 WRITE( NOUNIT, FMT = 9995 )'gesvdx
', IINFO, M, N,
1209 $ JTYPE, LSWORK, IOLDSD
1217 CALL ZBDT05( M, N, ASAV, LDA, S, NSV, U, LDU,
1218 $ VT, LDVT, WORK, RESULT( 33 ) )
1219.NE..AND..NE.
IF( M0 N0 ) THEN
1220 CALL ZUNT01( 'columns
', M, NSV, U, LDU, WORK,
1221 $ LWORK, RWORK, RESULT( 34 ) )
1222 CALL ZUNT01( 'rows
', NSV, N, VT, LDVT, WORK,
1223 $ LWORK, RWORK, RESULT( 35 ) )
1231.GE.
IF( RESULT( J )ZERO )
1233.GE.
IF( RESULT( J )THRESH )
1238 $ NTESTF = NTESTF + 1
1239.EQ.
IF( NTESTF1 ) THEN
1240 WRITE( NOUNIT, FMT = 9999 )
1241 WRITE( NOUNIT, FMT = 9998 )THRESH
1246.GE.
IF( RESULT( J )THRESH ) THEN
1247 WRITE( NOUNIT, FMT = 9997 )M, N, JTYPE, IWSPC,
1248 $ IOLDSD, J, RESULT( J )
1252 NERRS = NERRS + NFAIL
1253 NTESTT = NTESTT + NTEST
1262 CALL ALASVM( 'zbd
', NOUNIT, NERRS, NTESTT, 0 )
1264 9999 FORMAT( ' svd --
Complex Singular
Value Decomposition Driver
',
1265 $ / ' Matrix types (see ZDRVBD for details):
',
1266 $ / / ' 1 = zero matrix
', / ' 2 = identity matrix
',
1267 $ / ' 3 = evenly spaced singular values near 1
',
1268 $ / ' 4 = evenly spaced singular values near underflow
',
1269 $ / ' 5 = evenly spaced singular values near overflow
',
1270 $ / / ' tests performed: ( a is dense, u and v are unitary,
',
1271 $ / 19X, ' s is an array, and upartial, vtpartial, and
',
1272 $ / 19X, ' spartial are partially computed u, vt and s),
', / )
1273 9998 FORMAT( ' tests performed with test threshold =
', F8.2,
1276 $ / ' 2 = | i - u**t u | / ( m ulp )
',
1277 $ / ' 3 = | i - vt vt**t | / ( n ulp )
',
1278 $ / ' 4 = 0
if s
contains min(m,n) nonnegative values in
',
1279 $ ' decreasing order,
else 1/ulp
',
1280 $ / ' 5 = | u - upartial | / ( m ulp )
',
1281 $ / ' 6 = | vt - vtpartial | / ( n ulp )
',
1282 $ / ' 7 = | s - spartial | / (
min(m,n) ulp |s| )
',
1284 $ ' 8 = | a - u diag(s) vt | / ( |a|
max(m,n) ulp )
',
1285 $ / ' 9 = | i - u**t u | / ( m ulp )
',
1286 $ / '10 = | i - vt vt**t | / ( n ulp )
',
1287 $ / '11 = 0
if s
contains min(m,n) nonnegative
',
1288 $ ' decreasing order,
else 1/ulp
',
1289 $ / '12 = | u - upartial | / ( m ulp )
',
1290 $ / '13 = | vt - vtpartial | / ( n ulp )',
1291 $ /
'14 = | S - Spartial | / ( min(M,N) ulp |S| )',
1293 $ /
'15 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
1294 $ /
'16 = | I - U**T U | / ( M ulp ) ',
1295 $ /
'17 = | I - VT VT**T | / ( N ulp ) ',
1296 $ /
'18 = 0 if S contains min(M,N) nonnegative values in',
1297 $
' decreasing order, else 1/ulp',
1299 $ /
'19 = | A - U diag(S) VT | / ( |A| max(M,N) ulp )',
1300 $ / '20 = | i - u**t u | / ( m ulp )
',
1301 $ / '21 = | i - vt vt**t | / ( n ulp )
',
1302 $ / '22 = 0
if s
contains min(m,n) nonnegative values in
',
1303 $ ' decreasing order,
else 1/ulp
',
1305 $ '23 = | a - u diag(s) vt | / ( |a|
max(m,n) ulp )
',
1306 $ / '24 = | i - u**t u | / ( m ulp )
',
1307 $ / '25 = | i - vt vt**t | / ( n ulp )
',
1308 $ / '26 = 0
if s
contains min(m,n) nonnegative values in
',
1309 $ ' decreasing order,
else 1/ulp',
1310 $ /
'27 = | U - Upartial | / ( M ulp )',
1311 $ /
'28 = | VT - VTpartial | / ( N ulp )',
1312 $ /
'29 = | S - Spartial | / ( min(M,N) ulp |S| )'
1313 $ /
' ZGESVDX(V,V,I): ',
1314 $ /
'30 = | U**T A VT**T - diag(S) | / ( |A| max(M,N) ulp )',
1315 $ /
'31 = | I - U**T U | / ( M ulp ) ',
1316 $ /
'32 = | I - VT VT**T | / ( N ulp ) ',
1317 $ /
' ZGESVDX(V,V,V) ',
1318 $ /
'33 = | U**T A VT**T - diag(S) | / ( |A| max(M,N) ulp )',
1319 $ /
'34 = | I - U**T U | / ( M ulp ) ',
1320 $ /
'35 = | I - VT VT**T | / ( N ulp ) ',
1321 $
' ZGESVDQ(H,N,N,A,A',
1322 $ /
'36 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ) ',
1323 $ /
'37 = | I - U**T U | / ( M ulp ) ',
1324 $ /
'38 = | I - VT VT**T | / ( N ulp ) ',
1325 $ /
'39 = 0 if S contains min(M,N) nonnegative values in',
1326 $ ' decreasing order,
else 1/ulp
',
1328 9997 FORMAT( ' m=
', I5, ', n=
', I5, 'type ', I1, ', iws=
', I1,
1329 $ ',
seed=
', 4( I4, ',
' ), ' test(
', I2, ')=
', G11.4 )
1330 9996 FORMAT( ' zdrvbd:
', A, ' returned info=
', I6, '.
', / 9X, 'm=
',
1331 $ I6, ', n=', i6, ', jtype=
', I6, ', iseed=(
', 3( I5, ',
' ),
1333 9995 FORMAT( ' zdrvbd:
', A, ' returned info=
', I6, '.
', / 9X, 'm=
',
1334 $ I6, ', n=
', I6, ', jtype=
', I6, ', lswork=
', I6, / 9X,
1335 $ 'iseed=(
', 3( I5, ',
' ), I5, ')
' )