TESTING/LIN/cchkq3.f

   1 *> \brief \b CCHKQ3
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *  Definition:
   9 *  ===========
  10 *
  11 *       SUBROUTINE CCHKQ3( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
  12 *                          THRESH, A, COPYA, S, TAU, WORK, RWORK,
  13 *                          IWORK, NOUT )
  14 *
  15 *       .. Scalar Arguments ..
  16 *       INTEGER            NM, NN, NNB, NOUT
  17 *       REAL               THRESH
  18 *       ..
  19 *       .. Array Arguments ..
  20 *       LOGICAL            DOTYPE( * )
  21 *       INTEGER            IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ),
  22 *      $                   NXVAL( * )
  23 *       REAL               S( * ), RWORK( * )
  24 *       COMPLEX            A( * ), COPYA( * ), TAU( * ), WORK( * )
  25 *       ..
  26 *
  27 *
  28 *> \par Purpose:
  29 *  =============
  30 *>
  31 *> \verbatim
  32 *>
  33 *> CCHKQ3 tests CGEQP3.
  34 *> \endverbatim
  35 *
  36 *  Arguments:
  37 *  ==========
  38 *
  39 *> \param[in] DOTYPE
  40 *> \verbatim
  41 *>          DOTYPE is LOGICAL array, dimension (NTYPES)
  42 *>          The matrix types to be used for testing.  Matrices of type j
  43 *>          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
  44 *>          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
  45 *> \endverbatim
  46 *>
  47 *> \param[in] NM
  48 *> \verbatim
  49 *>          NM is INTEGER
  50 *>          The number of values of M contained in the vector MVAL.
  51 *> \endverbatim
  52 *>
  53 *> \param[in] MVAL
  54 *> \verbatim
  55 *>          MVAL is INTEGER array, dimension (NM)
  56 *>          The values of the matrix row dimension M.
  57 *> \endverbatim
  58 *>
  59 *> \param[in] NN
  60 *> \verbatim
  61 *>          NN is INTEGER
  62 *>          The number of values of N contained in the vector NVAL.
  63 *> \endverbatim
  64 *>
  65 *> \param[in] NVAL
  66 *> \verbatim
  67 *>          NVAL is INTEGER array, dimension (NN)
  68 *>          The values of the matrix column dimension N.
  69 *> \endverbatim
  70 *>
  71 *> \param[in] NNB
  72 *> \verbatim
  73 *>          NNB is INTEGER
  74 *>          The number of values of NB and NX contained in the
  75 *>          vectors NBVAL and NXVAL.  The blocking parameters are used
  76 *>          in pairs (NB,NX).
  77 *> \endverbatim
  78 *>
  79 *> \param[in] NBVAL
  80 *> \verbatim
  81 *>          NBVAL is INTEGER array, dimension (NNB)
  82 *>          The values of the blocksize NB.
  83 *> \endverbatim
  84 *>
  85 *> \param[in] NXVAL
  86 *> \verbatim
  87 *>          NXVAL is INTEGER array, dimension (NNB)
  88 *>          The values of the crossover point NX.
  89 *> \endverbatim
  90 *>
  91 *> \param[in] THRESH
  92 *> \verbatim
  93 *>          THRESH is REAL
  94 *>          The threshold value for the test ratios.  A result is
  95 *>          included in the output file if RESULT >= THRESH.  To have
  96 *>          every test ratio printed, use THRESH = 0.
  97 *> \endverbatim
  98 *>
  99 *> \param[out] A
 100 *> \verbatim
 101 *>          A is COMPLEX array, dimension (MMAX*NMAX)
 102 *>          where MMAX is the maximum value of M in MVAL and NMAX is the
 103 *>          maximum value of N in NVAL.
 104 *> \endverbatim
 105 *>
 106 *> \param[out] COPYA
 107 *> \verbatim
 108 *>          COPYA is COMPLEX array, dimension (MMAX*NMAX)
 109 *> \endverbatim
 110 *>
 111 *> \param[out] S
 112 *> \verbatim
 113 *>          S is REAL array, dimension
 114 *>                      (min(MMAX,NMAX))
 115 *> \endverbatim
 116 *>
 117 *> \param[out] TAU
 118 *> \verbatim
 119 *>          TAU is COMPLEX array, dimension (MMAX)
 120 *> \endverbatim
 121 *>
 122 *> \param[out] WORK
 123 *> \verbatim
 124 *>          WORK is COMPLEX array, dimension
 125 *>                      (max(M*max(M,N) + 4*min(M,N) + max(M,N)))
 126 *> \endverbatim
 127 *>
 128 *> \param[out] RWORK
 129 *> \verbatim
 130 *>          RWORK is REAL array, dimension (4*NMAX)
 131 *> \endverbatim
 132 *>
 133 *> \param[out] IWORK
 134 *> \verbatim
 135 *>          IWORK is INTEGER array, dimension (2*NMAX)
 136 *> \endverbatim
 137 *>
 138 *> \param[in] NOUT
 139 *> \verbatim
 140 *>          NOUT is INTEGER
 141 *>          The unit number for output.
 142 *> \endverbatim
 143 *
 144 *  Authors:
 145 *  ========
 146 *
 147 *> \author Univ. of Tennessee
 148 *> \author Univ. of California Berkeley
 149 *> \author Univ. of Colorado Denver
 150 *> \author NAG Ltd.
 151 *
 152 *> \date November 2011
 153 *
 154 *> \ingroup complex_lin
 155 *
 156 *  =====================================================================
 157       SUBROUTINE CCHKQ3( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
 158      $                   THRESH, A, COPYA, S, TAU, WORK, RWORK,
 159      $                   IWORK, NOUT )
 160 *
 161 *  -- LAPACK test routine (version 3.4.0) --
 162 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 163 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 164 *     November 2011
 165 *
 166 *     .. Scalar Arguments ..
 167       INTEGER            NM, NN, NNB, NOUT
 168       REAL               THRESH
 169 *     ..
 170 *     .. Array Arguments ..
 171       LOGICAL            DOTYPE( * )
 172       INTEGER            IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ),
 173      $                   NXVAL( * )
 174       REAL               S( * ), RWORK( * )
 175       COMPLEX            A( * ), COPYA( * ), TAU( * ), WORK( * )
 176 *     ..
 177 *
 178 *  =====================================================================
 179 *
 180 *     .. Parameters ..
 181       INTEGER            NTYPES
 182       PARAMETER          ( NTYPES = 6 )
 183       INTEGER            NTESTS
 184       PARAMETER          ( NTESTS = 3 )
 185       REAL               ONE, ZERO
 186       COMPLEX            CZERO
 187       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0,
 188      $                   CZERO = ( 0.0E+0, 0.0E+0 ) )
 189 *     ..
 190 *     .. Local Scalars ..
 191       CHARACTER*3        PATH
 192       INTEGER            I, IHIGH, ILOW, IM, IMODE, IN, INB, INFO,
 193      $                   ISTEP, K, LDA, LW, LWORK, M, MNMIN, MODE, N,
 194      $                   NB, NERRS, NFAIL, NRUN, NX
 195       REAL               EPS
 196 *     ..
 197 *     .. Local Arrays ..
 198       INTEGER            ISEED( 4 ), ISEEDY( 4 )
 199       REAL               RESULT( NTESTS )
 200 *     ..
 201 *     .. External Functions ..
 202       REAL               CQPT01, CQRT11, CQRT12, SLAMCH
 203       EXTERNAL           CQPT01, CQRT11, CQRT12, SLAMCH
 204 *     ..
 205 *     .. External Subroutines ..
 206       EXTERNAL           ALAHD, ALASUM, CGEQP3, CLACPY, CLASET, CLATMS,
 207      $                   ICOPY, SLAORD, XLAENV
 208 *     ..
 209 *     .. Intrinsic Functions ..
 210       INTRINSIC          MAX, MIN
 211 *     ..
 212 *     .. Scalars in Common ..
 213       LOGICAL            LERR, OK
 214       CHARACTER*32       SRNAMT
 215       INTEGER            INFOT, IOUNIT
 216 *     ..
 217 *     .. Common blocks ..
 218       COMMON             / INFOC / INFOT, IOUNIT, OK, LERR
 219       COMMON             / SRNAMC / SRNAMT
 220 *     ..
 221 *     .. Data statements ..
 222       DATA               ISEEDY / 1988, 1989, 1990, 1991 /
 223 *     ..
 224 *     .. Executable Statements ..
 225 *
 226 *     Initialize constants and the random number seed.
 227 *
 228       PATH( 1: 1 ) = 'Complex precision'
 229       PATH( 2: 3 ) = 'Q3'
 230       NRUN = 0
 231       NFAIL = 0
 232       NERRS = 0
 233       DO 10 I = 1, 4
 234          ISEED( I ) = ISEEDY( I )
 235    10 CONTINUE
 236       EPS = SLAMCH( 'Epsilon' )
 237       INFOT = 0
 238 *
 239       DO 90 IM = 1, NM
 240 *
 241 *        Do for each value of M in MVAL.
 242 *
 243          M = MVAL( IM )
 244          LDA = MAX( 1, M )
 245 *
 246          DO 80 IN = 1, NN
 247 *
 248 *           Do for each value of N in NVAL.
 249 *
 250             N = NVAL( IN )
 251             MNMIN = MIN( M, N )
 252             LWORK = MAX( 1, M*MAX( M, N )+4*MNMIN+MAX( M, N ) )
 253 *
 254             DO 70 IMODE = 1, NTYPES
 255                IF( .NOT.DOTYPE( IMODE ) )
 256      $            GO TO 70
 257 *
 258 *              Do for each type of matrix
 259 *                 1:  zero matrix
 260 *                 2:  one small singular value
 261 *                 3:  geometric distribution of singular values
 262 *                 4:  first n/2 columns fixed
 263 *                 5:  last n/2 columns fixed
 264 *                 6:  every second column fixed
 265 *
 266                MODE = IMODE
 267                IF( IMODE.GT.3 )
 268      $            MODE = 1
 269 *
 270 *              Generate test matrix of size m by n using
 271 *              singular value distribution indicated by `mode'.
 272 *
 273                DO 20 I = 1, N
 274                   IWORK( I ) = 0
 275    20          CONTINUE
 276                IF( IMODE.EQ.1 ) THEN
 277                   CALL CLASET( 'Full', M, N, CZERO, CZERO, COPYA, LDA )
 278                   DO 30 I = 1, MNMIN
 279                      S( I ) = ZERO
 280    30             CONTINUE
 281                ELSE
 282                   CALL CLATMS( M, N, 'Uniform', ISEED, 'Nonsymm', S,
 283      $                         MODE, ONE / EPS, ONE, M, N, 'No packing',
 284      $                         COPYA, LDA, WORK, INFO )
 285                   IF( IMODE.GE.4 ) THEN
 286                      IF( IMODE.EQ.4 ) THEN
 287                         ILOW = 1
 288                         ISTEP = 1
 289                         IHIGH = MAX( 1, N / 2 )
 290                      ELSE IF( IMODE.EQ.5 ) THEN
 291                         ILOW = MAX( 1, N / 2 )
 292                         ISTEP = 1
 293                         IHIGH = N
 294                      ELSE IF( IMODE.EQ.6 ) THEN
 295                         ILOW = 1
 296                         ISTEP = 2
 297                         IHIGH = N
 298                      END IF
 299                      DO 40 I = ILOW, IHIGH, ISTEP
 300                         IWORK( I ) = 1
 301    40                CONTINUE
 302                   END IF
 303                   CALL SLAORD( 'Decreasing', MNMIN, S, 1 )
 304                END IF
 305 *
 306                DO 60 INB = 1, NNB
 307 *
 308 *                 Do for each pair of values (NB,NX) in NBVAL and NXVAL.
 309 *
 310                   NB = NBVAL( INB )
 311                   CALL XLAENV( 1, NB )
 312                   NX = NXVAL( INB )
 313                   CALL XLAENV( 3, NX )
 314 *
 315 *                 Save A and its singular values and a copy of
 316 *                 vector IWORK.
 317 *
 318                   CALL CLACPY( 'All', M, N, COPYA, LDA, A, LDA )
 319                   CALL ICOPY( N, IWORK( 1 ), 1, IWORK( N+1 ), 1 )
 320 *
 321 *                 Workspace needed.
 322 *
 323                   LW = NB*( N+1 )
 324 *
 325                   SRNAMT = 'CGEQP3'
 326                   CALL CGEQP3( M, N, A, LDA, IWORK( N+1 ), TAU, WORK,
 327      $                         LW, RWORK, INFO )
 328 *
 329 *                 Compute norm(svd(a) - svd(r))
 330 *
 331                   RESULT( 1 ) = CQRT12( M, N, A, LDA, S, WORK,
 332      $                          LWORK, RWORK )
 333 *
 334 *                 Compute norm( A*P - Q*R )
 335 *
 336                   RESULT( 2 ) = CQPT01( M, N, MNMIN, COPYA, A, LDA, TAU,
 337      $                          IWORK( N+1 ), WORK, LWORK )
 338 *
 339 *                 Compute Q'*Q
 340 *
 341                   RESULT( 3 ) = CQRT11( M, MNMIN, A, LDA, TAU, WORK,
 342      $                          LWORK )
 343 *
 344 *                 Print information about the tests that did not pass
 345 *                 the threshold.
 346 *
 347                   DO 50 K = 1, NTESTS
 348                      IF( RESULT( K ).GE.THRESH ) THEN
 349                         IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
 350      $                     CALL ALAHD( NOUT, PATH )
 351                         WRITE( NOUT, FMT = 9999 )'CGEQP3', M, N, NB,
 352      $                     IMODE, K, RESULT( K )
 353                         NFAIL = NFAIL + 1
 354                      END IF
 355    50             CONTINUE
 356                   NRUN = NRUN + NTESTS
 357 *
 358    60          CONTINUE
 359    70       CONTINUE
 360    80    CONTINUE
 361    90 CONTINUE
 362 *
 363 *     Print a summary of the results.
 364 *
 365       CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
 366 *
 367  9999 FORMAT( 1X, A, ' M =', I5, ', N =', I5, ', NB =', I4, ', type ',
 368      $      I2, ', test ', I2, ', ratio =', G12.5 )
 369 *
 370 *     End of CCHKQ3
 371 *
 372       END