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 ), ( * ), MM( * ), NN( * )
416 REAL E( * ), RWORK( * ), ( * ), 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, , IJQ, IJU, IJVT, IL, IU, ,
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 )
455EXTERNAL 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
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,
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.NE..AND..NE.
IF( M0 N0 ) 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.LT.
IF( SSAV( I )SSAV( I+1 ) )
962 $ RESULT( 18 ) = ULPINV
963.LT.
IF( SSAV( I )ZERO )
964 $ RESULT( 18 ) = ULPINV
966.GE.
IF( MNMIN1 ) THEN
967.LT.
IF( SSAV( MNMIN )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.NE.
IF( IINFO0 ) 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.NE..AND..NE.
IF( M0 N0 ) 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.LT.
IF( SSAV( I )SSAV( I+1 ) )
1023 $ RESULT( 22 ) = ULPINV
1024.LT.
IF( SSAV( I )ZERO )
1025 $ RESULT( 22 ) = ULPINV
1027.GE.
IF( MNMIN1 ) THEN
1028.LT.
IF( SSAV( MNMIN )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.NE.
IF( IINFO0 ) 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.NE..AND..NE.
IF( M0 N0 ) 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.LT.
IF( SSAV( I )SSAV( I+1 ) )
1066 $ RESULT( 26 ) = ULPINV
1067.LT.
IF( SSAV( I )ZERO )
1068 $ RESULT( 26 ) = ULPINV
1070.GE.
IF( MNMIN1 ) THEN
1071.LT.
IF( SSAV( MNMIN )ZERO )
1072 $ RESULT( 26 ) = ULPINV
1082.EQ..AND..EQ..OR.
IF( ( IJU0 IJVT0 )
1083.EQ..AND..EQ.
$ ( IJU1 IJVT1 ) ) 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.GT..AND..GT.
IF( M0 N0 ) 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.GT..AND..GT.
IF( M0 N0 ) THEN
1110.EQ.
IF( IJVT1 ) 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.LT.
IF( SSAV( I )SSAV( I+1 ) )
1126.LT.
IF( SSAV( I )ZERO )
1128 DIF = MAX( DIF, ABS( SSAV( I )-S( I ) ) / DIV )
1130 RESULT( 29) = MAX( RESULT( 29 ), DIF )
1137 ISEED2( I ) = ISEED( I )
1139.LE.
IF( MNMIN1 ) 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.NE.
IF( IINFO0 ) 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.NE..AND..NE.
IF( M0 N0 ) 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.GT..AND..GT.
IF( MNMIN0 NSI1 ) 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.GE.
IF( VLVU ) 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.NE.
IF( IINFO0 ) 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.NE..AND..NE.
IF( M0 N0 ) 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.GE.
IF( RESULT( J )ZERO )
1234.GE.
IF( RESULT( J )THRESH )
1239 $ NTESTF = NTESTF + 1
1240.EQ.
IF( NTESTF1 ) THEN
1241 WRITE( NOUNIT, FMT = 9999 )
1242 WRITE( NOUNIT, FMT = 9998 )THRESH
1247.GE.
IF( RESULT( J )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
',
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| )
',
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,
')' )