LAPACK: TESTING/LIN/cchkq3.f Source File

Go to the documentation of this file.
00001       SUBROUTINE CCHKQ3( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
00002      $                   THRESH, A, COPYA, S, COPYS, TAU, WORK, RWORK,
00003      $                   IWORK, NOUT )
00004 *
00005 *  -- LAPACK test routine (version 3.1) --
00006 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00007 *     November 2006
00008 *
00009 *     .. Scalar Arguments ..
00010       INTEGER            NM, NN, NNB, NOUT
00011       REAL               THRESH
00012 *     ..
00013 *     .. Array Arguments ..
00014       LOGICAL            DOTYPE( * )
00015       INTEGER            IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ),
00016      $                   NXVAL( * )
00017       REAL               COPYS( * ), RWORK( * ), S( * )
00018       COMPLEX            A( * ), COPYA( * ), TAU( * ), WORK( * )
00019 *     ..
00020 *
00021 *  Purpose
00022 *  =======
00023 *
00024 *  CCHKQ3 tests CGEQP3.
00025 *
00026 *  Arguments
00027 *  =========
00028 *
00029 *  DOTYPE  (input) LOGICAL array, dimension (NTYPES)
00030 *          The matrix types to be used for testing.  Matrices of type j
00031 *          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
00032 *          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
00033 *
00034 *  NM      (input) INTEGER
00035 *          The number of values of M contained in the vector MVAL.
00036 *
00037 *  MVAL    (input) INTEGER array, dimension (NM)
00038 *          The values of the matrix row dimension M.
00039 *
00040 *  NN      (input) INTEGER
00041 *          The number of values of N contained in the vector NVAL.
00042 *
00043 *  NVAL    (input) INTEGER array, dimension (NN)
00044 *          The values of the matrix column dimension N.
00045 *
00046 *  NNB     (input) INTEGER
00047 *          The number of values of NB and NX contained in the
00048 *          vectors NBVAL and NXVAL.  The blocking parameters are used
00049 *          in pairs (NB,NX).
00050 *
00051 *  NBVAL   (input) INTEGER array, dimension (NNB)
00052 *          The values of the blocksize NB.
00053 *
00054 *  NXVAL   (input) INTEGER array, dimension (NNB)
00055 *          The values of the crossover point NX.
00056 *
00057 *  THRESH  (input) REAL
00058 *          The threshold value for the test ratios.  A result is
00059 *          included in the output file if RESULT >= THRESH.  To have
00060 *          every test ratio printed, use THRESH = 0.
00061 *
00062 *  A       (workspace) COMPLEX array, dimension (MMAX*NMAX)
00063 *          where MMAX is the maximum value of M in MVAL and NMAX is the
00064 *          maximum value of N in NVAL.
00065 *
00066 *  COPYA   (workspace) COMPLEX array, dimension (MMAX*NMAX)
00067 *
00068 *  S       (workspace) REAL array, dimension
00069 *                      (min(MMAX,NMAX))
00070 *
00071 *  COPYS   (workspace) REAL array, dimension
00072 *                      (min(MMAX,NMAX))
00073 *
00074 *  TAU     (workspace) COMPLEX array, dimension (MMAX)
00075 *
00076 *  WORK    (workspace) COMPLEX array, dimension
00077 *                      (max(M*max(M,N) + 4*min(M,N) + max(M,N)))
00078 *
00079 *  RWORK   (workspace) REAL array, dimension (4*NMAX)
00080 *
00081 *  IWORK   (workspace) INTEGER array, dimension (2*NMAX)
00082 *
00083 *  NOUT    (input) INTEGER
00084 *          The unit number for output.
00085 *
00086 *  =====================================================================
00087 *
00088 *     .. Parameters ..
00089       INTEGER            NTYPES
00090       PARAMETER          ( NTYPES = 6 )
00091       INTEGER            NTESTS
00092       PARAMETER          ( NTESTS = 3 )
00093       REAL               ONE, ZERO
00094       COMPLEX            CZERO
00095       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0,
00096      $                   CZERO = ( 0.0E+0, 0.0E+0 ) )
00097 *     ..
00098 *     .. Local Scalars ..
00099       CHARACTER*3        PATH
00100       INTEGER            I, IHIGH, ILOW, IM, IMODE, IN, INB, INFO,
00101      $                   ISTEP, K, LDA, LW, LWORK, M, MNMIN, MODE, N,
00102      $                   NB, NERRS, NFAIL, NRUN, NX
00103       REAL               EPS
00104 *     ..
00105 *     .. Local Arrays ..
00106       INTEGER            ISEED( 4 ), ISEEDY( 4 )
00107       REAL               RESULT( NTESTS )
00108 *     ..
00109 *     .. External Functions ..
00110       REAL               CQPT01, CQRT11, CQRT12, SLAMCH
00111       EXTERNAL           CQPT01, CQRT11, CQRT12, SLAMCH
00112 *     ..
00113 *     .. External Subroutines ..
00114       EXTERNAL           ALAHD, ALASUM, CGEQP3, CLACPY, CLASET, CLATMS,
00115      $                   ICOPY, SLAORD, XLAENV
00116 *     ..
00117 *     .. Intrinsic Functions ..
00118       INTRINSIC          MAX, MIN
00119 *     ..
00120 *     .. Scalars in Common ..
00121       LOGICAL            LERR, OK
00122       CHARACTER*32       SRNAMT
00123       INTEGER            INFOT, IOUNIT
00124 *     ..
00125 *     .. Common blocks ..
00126       COMMON             / INFOC / INFOT, IOUNIT, OK, LERR
00127       COMMON             / SRNAMC / SRNAMT
00128 *     ..
00129 *     .. Data statements ..
00130       DATA               ISEEDY / 1988, 1989, 1990, 1991 /
00131 *     ..
00132 *     .. Executable Statements ..
00133 *
00134 *     Initialize constants and the random number seed.
00135 *
00136       PATH( 1: 1 ) = 'Complex precision'
00137       PATH( 2: 3 ) = 'Q3'
00138       NRUN = 0
00139       NFAIL = 0
00140       NERRS = 0
00141       DO 10 I = 1, 4
00142          ISEED( I ) = ISEEDY( I )
00143    10 CONTINUE
00144       EPS = SLAMCH( 'Epsilon' )
00145       INFOT = 0
00146 *
00147       DO 90 IM = 1, NM
00148 *
00149 *        Do for each value of M in MVAL.
00150 *
00151          M = MVAL( IM )
00152          LDA = MAX( 1, M )
00153 *
00154          DO 80 IN = 1, NN
00155 *
00156 *           Do for each value of N in NVAL.
00157 *
00158             N = NVAL( IN )
00159             MNMIN = MIN( M, N )
00160             LWORK = MAX( 1, M*MAX( M, N )+4*MNMIN+MAX( M, N ) )
00161 *
00162             DO 70 IMODE = 1, NTYPES
00163                IF( .NOT.DOTYPE( IMODE ) )
00164      $            GO TO 70
00165 *
00166 *              Do for each type of matrix
00167 *                 1:  zero matrix
00168 *                 2:  one small singular value
00169 *                 3:  geometric distribution of singular values
00170 *                 4:  first n/2 columns fixed
00171 *                 5:  last n/2 columns fixed
00172 *                 6:  every second column fixed
00173 *
00174                MODE = IMODE
00175                IF( IMODE.GT.3 )
00176      $            MODE = 1
00177 *
00178 *              Generate test matrix of size m by n using
00179 *              singular value distribution indicated by `mode'.
00180 *
00181                DO 20 I = 1, N
00182                   IWORK( I ) = 0
00183    20          CONTINUE
00184                IF( IMODE.EQ.1 ) THEN
00185                   CALL CLASET( 'Full', M, N, CZERO, CZERO, COPYA, LDA )
00186                   DO 30 I = 1, MNMIN
00187                      COPYS( I ) = ZERO
00188    30             CONTINUE
00189                ELSE
00190                   CALL CLATMS( M, N, 'Uniform', ISEED, 'Nonsymm', COPYS,
00191      $                         MODE, ONE / EPS, ONE, M, N, 'No packing',
00192      $                         COPYA, LDA, WORK, INFO )
00193                   IF( IMODE.GE.4 ) THEN
00194                      IF( IMODE.EQ.4 ) THEN
00195                         ILOW = 1
00196                         ISTEP = 1
00197                         IHIGH = MAX( 1, N / 2 )
00198                      ELSE IF( IMODE.EQ.5 ) THEN
00199                         ILOW = MAX( 1, N / 2 )
00200                         ISTEP = 1
00201                         IHIGH = N
00202                      ELSE IF( IMODE.EQ.6 ) THEN
00203                         ILOW = 1
00204                         ISTEP = 2
00205                         IHIGH = N
00206                      END IF
00207                      DO 40 I = ILOW, IHIGH, ISTEP
00208                         IWORK( I ) = 1
00209    40                CONTINUE
00210                   END IF
00211                   CALL SLAORD( 'Decreasing', MNMIN, COPYS, 1 )
00212                END IF
00213 *
00214                DO 60 INB = 1, NNB
00215 *
00216 *                 Do for each pair of values (NB,NX) in NBVAL and NXVAL.
00217 *
00218                   NB = NBVAL( INB )
00219                   CALL XLAENV( 1, NB )
00220                   NX = NXVAL( INB )
00221                   CALL XLAENV( 3, NX )
00222 *
00223 *                 Save A and its singular values and a copy of
00224 *                 vector IWORK.
00225 *
00226                   CALL CLACPY( 'All', M, N, COPYA, LDA, A, LDA )
00227                   CALL ICOPY( N, IWORK( 1 ), 1, IWORK( N+1 ), 1 )
00228 *
00229 *                 Workspace needed.
00230 *
00231                   LW = NB*( N+1 )
00232 *
00233                   SRNAMT = 'CGEQP3'
00234                   CALL CGEQP3( M, N, A, LDA, IWORK( N+1 ), TAU, WORK,
00235      $                         LW, RWORK, INFO )
00236 *
00237 *                 Compute norm(svd(a) - svd(r))
00238 *
00239                   RESULT( 1 ) = CQRT12( M, N, A, LDA, COPYS, WORK,
00240      $                          LWORK, RWORK )
00241 *
00242 *                 Compute norm( A*P - Q*R )
00243 *
00244                   RESULT( 2 ) = CQPT01( M, N, MNMIN, COPYA, A, LDA, TAU,
00245      $                          IWORK( N+1 ), WORK, LWORK )
00246 *
00247 *                 Compute Q'*Q
00248 *
00249                   RESULT( 3 ) = CQRT11( M, MNMIN, A, LDA, TAU, WORK,
00250      $                          LWORK )
00251 *
00252 *                 Print information about the tests that did not pass
00253 *                 the threshold.
00254 *
00255                   DO 50 K = 1, NTESTS
00256                      IF( RESULT( K ).GE.THRESH ) THEN
00257                         IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00258      $                     CALL ALAHD( NOUT, PATH )
00259                         WRITE( NOUT, FMT = 9999 )'CGEQP3', M, N, NB,
00260      $                     IMODE, K, RESULT( K )
00261                         NFAIL = NFAIL + 1
00262                      END IF
00263    50             CONTINUE
00264                   NRUN = NRUN + NTESTS
00265 *
00266    60          CONTINUE
00267    70       CONTINUE
00268    80    CONTINUE
00269    90 CONTINUE
00270 *
00271 *     Print a summary of the results.
00272 *
00273       CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
00274 *
00275  9999 FORMAT( 1X, A, ' M =', I5, ', N =', I5, ', NB =', I4, ', type ',
00276      $      I2, ', test ', I2, ', ratio =', G12.5 )
00277 *
00278 *     End of CCHKQ3
00279 *
00280       END