LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
zchkq3.f
Go to the documentation of this file.
00001 *> \brief \b ZCHKQ3
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *  Definition:
00009 *  ===========
00010 *
00011 *       SUBROUTINE ZCHKQ3( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
00012 *                          THRESH, A, COPYA, S, TAU, WORK, RWORK,
00013 *                          IWORK, NOUT )
00014 * 
00015 *       .. Scalar Arguments ..
00016 *       INTEGER            NM, NN, NNB, NOUT
00017 *       DOUBLE PRECISION   THRESH
00018 *       ..
00019 *       .. Array Arguments ..
00020 *       LOGICAL            DOTYPE( * )
00021 *       INTEGER            IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ),
00022 *      $                   NXVAL( * )
00023 *       DOUBLE PRECISION   S( * ), RWORK( * )
00024 *       COMPLEX*16         A( * ), COPYA( * ), TAU( * ), WORK( * )
00025 *       ..
00026 *  
00027 *
00028 *> \par Purpose:
00029 *  =============
00030 *>
00031 *> \verbatim
00032 *>
00033 *> ZCHKQ3 tests ZGEQP3.
00034 *> \endverbatim
00035 *
00036 *  Arguments:
00037 *  ==========
00038 *
00039 *> \param[in] DOTYPE
00040 *> \verbatim
00041 *>          DOTYPE is LOGICAL array, dimension (NTYPES)
00042 *>          The matrix types to be used for testing.  Matrices of type j
00043 *>          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
00044 *>          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
00045 *> \endverbatim
00046 *>
00047 *> \param[in] NM
00048 *> \verbatim
00049 *>          NM is INTEGER
00050 *>          The number of values of M contained in the vector MVAL.
00051 *> \endverbatim
00052 *>
00053 *> \param[in] MVAL
00054 *> \verbatim
00055 *>          MVAL is INTEGER array, dimension (NM)
00056 *>          The values of the matrix row dimension M.
00057 *> \endverbatim
00058 *>
00059 *> \param[in] NN
00060 *> \verbatim
00061 *>          NN is INTEGER
00062 *>          The number of values of N contained in the vector NVAL.
00063 *> \endverbatim
00064 *>
00065 *> \param[in] NVAL
00066 *> \verbatim
00067 *>          NVAL is INTEGER array, dimension (NN)
00068 *>          The values of the matrix column dimension N.
00069 *> \endverbatim
00070 *>
00071 *> \param[in] NNB
00072 *> \verbatim
00073 *>          NNB is INTEGER
00074 *>          The number of values of NB and NX contained in the
00075 *>          vectors NBVAL and NXVAL.  The blocking parameters are used
00076 *>          in pairs (NB,NX).
00077 *> \endverbatim
00078 *>
00079 *> \param[in] NBVAL
00080 *> \verbatim
00081 *>          NBVAL is INTEGER array, dimension (NNB)
00082 *>          The values of the blocksize NB.
00083 *> \endverbatim
00084 *>
00085 *> \param[in] NXVAL
00086 *> \verbatim
00087 *>          NXVAL is INTEGER array, dimension (NNB)
00088 *>          The values of the crossover point NX.
00089 *> \endverbatim
00090 *>
00091 *> \param[in] THRESH
00092 *> \verbatim
00093 *>          THRESH is DOUBLE PRECISION
00094 *>          The threshold value for the test ratios.  A result is
00095 *>          included in the output file if RESULT >= THRESH.  To have
00096 *>          every test ratio printed, use THRESH = 0.
00097 *> \endverbatim
00098 *>
00099 *> \param[out] A
00100 *> \verbatim
00101 *>          A is COMPLEX*16 array, dimension (MMAX*NMAX)
00102 *>          where MMAX is the maximum value of M in MVAL and NMAX is the
00103 *>          maximum value of N in NVAL.
00104 *> \endverbatim
00105 *>
00106 *> \param[out] COPYA
00107 *> \verbatim
00108 *>          COPYA is COMPLEX*16 array, dimension (MMAX*NMAX)
00109 *> \endverbatim
00110 *>
00111 *> \param[out] S
00112 *> \verbatim
00113 *>          S is DOUBLE PRECISION array, dimension
00114 *>                      (min(MMAX,NMAX))
00115 *> \endverbatim
00116 *>
00117 *> \param[out] TAU
00118 *> \verbatim
00119 *>          TAU is COMPLEX*16 array, dimension (MMAX)
00120 *> \endverbatim
00121 *>
00122 *> \param[out] WORK
00123 *> \verbatim
00124 *>          WORK is COMPLEX*16 array, dimension
00125 *>                      (max(M*max(M,N) + 4*min(M,N) + max(M,N)))
00126 *> \endverbatim
00127 *>
00128 *> \param[out] RWORK
00129 *> \verbatim
00130 *>          RWORK is DOUBLE PRECISION array, dimension (4*NMAX)
00131 *> \endverbatim
00132 *>
00133 *> \param[out] IWORK
00134 *> \verbatim
00135 *>          IWORK is INTEGER array, dimension (2*NMAX)
00136 *> \endverbatim
00137 *>
00138 *> \param[in] NOUT
00139 *> \verbatim
00140 *>          NOUT is INTEGER
00141 *>          The unit number for output.
00142 *> \endverbatim
00143 *
00144 *  Authors:
00145 *  ========
00146 *
00147 *> \author Univ. of Tennessee 
00148 *> \author Univ. of California Berkeley 
00149 *> \author Univ. of Colorado Denver 
00150 *> \author NAG Ltd. 
00151 *
00152 *> \date November 2011
00153 *
00154 *> \ingroup complex16_lin
00155 *
00156 *  =====================================================================
00157       SUBROUTINE ZCHKQ3( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
00158      $                   THRESH, A, COPYA, S, TAU, WORK, RWORK,
00159      $                   IWORK, NOUT )
00160 *
00161 *  -- LAPACK test routine (version 3.4.0) --
00162 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00163 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00164 *     November 2011
00165 *
00166 *     .. Scalar Arguments ..
00167       INTEGER            NM, NN, NNB, NOUT
00168       DOUBLE PRECISION   THRESH
00169 *     ..
00170 *     .. Array Arguments ..
00171       LOGICAL            DOTYPE( * )
00172       INTEGER            IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ),
00173      $                   NXVAL( * )
00174       DOUBLE PRECISION   S( * ), RWORK( * )
00175       COMPLEX*16         A( * ), COPYA( * ), TAU( * ), WORK( * )
00176 *     ..
00177 *
00178 *  =====================================================================
00179 *
00180 *     .. Parameters ..
00181       INTEGER            NTYPES
00182       PARAMETER          ( NTYPES = 6 )
00183       INTEGER            NTESTS
00184       PARAMETER          ( NTESTS = 3 )
00185       DOUBLE PRECISION   ONE, ZERO
00186       COMPLEX*16         CZERO
00187       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0,
00188      $                   CZERO = ( 0.0D+0, 0.0D+0 ) )
00189 *     ..
00190 *     .. Local Scalars ..
00191       CHARACTER*3        PATH
00192       INTEGER            I, IHIGH, ILOW, IM, IMODE, IN, INB, INFO,
00193      $                   ISTEP, K, LDA, LW, LWORK, M, MNMIN, MODE, N,
00194      $                   NB, NERRS, NFAIL, NRUN, NX
00195       DOUBLE PRECISION   EPS
00196 *     ..
00197 *     .. Local Arrays ..
00198       INTEGER            ISEED( 4 ), ISEEDY( 4 )
00199       DOUBLE PRECISION   RESULT( NTESTS )
00200 *     ..
00201 *     .. External Functions ..
00202       DOUBLE PRECISION   DLAMCH, ZQPT01, ZQRT11, ZQRT12
00203       EXTERNAL           DLAMCH, ZQPT01, ZQRT11, ZQRT12
00204 *     ..
00205 *     .. External Subroutines ..
00206       EXTERNAL           ALAHD, ALASUM, DLAORD, ICOPY, XLAENV, ZGEQP3,
00207      $                   ZLACPY, ZLASET, ZLATMS
00208 *     ..
00209 *     .. Intrinsic Functions ..
00210       INTRINSIC          MAX, MIN
00211 *     ..
00212 *     .. Scalars in Common ..
00213       LOGICAL            LERR, OK
00214       CHARACTER*32       SRNAMT
00215       INTEGER            INFOT, IOUNIT
00216 *     ..
00217 *     .. Common blocks ..
00218       COMMON             / INFOC / INFOT, IOUNIT, OK, LERR
00219       COMMON             / SRNAMC / SRNAMT
00220 *     ..
00221 *     .. Data statements ..
00222       DATA               ISEEDY / 1988, 1989, 1990, 1991 /
00223 *     ..
00224 *     .. Executable Statements ..
00225 *
00226 *     Initialize constants and the random number seed.
00227 *
00228       PATH( 1: 1 ) = 'Zomplex precision'
00229       PATH( 2: 3 ) = 'Q3'
00230       NRUN = 0
00231       NFAIL = 0
00232       NERRS = 0
00233       DO 10 I = 1, 4
00234          ISEED( I ) = ISEEDY( I )
00235    10 CONTINUE
00236       EPS = DLAMCH( 'Epsilon' )
00237       INFOT = 0
00238 *
00239       DO 90 IM = 1, NM
00240 *
00241 *        Do for each value of M in MVAL.
00242 *
00243          M = MVAL( IM )
00244          LDA = MAX( 1, M )
00245 *
00246          DO 80 IN = 1, NN
00247 *
00248 *           Do for each value of N in NVAL.
00249 *
00250             N = NVAL( IN )
00251             MNMIN = MIN( M, N )
00252             LWORK = MAX( 1, M*MAX( M, N )+4*MNMIN+MAX( M, N ) )
00253 *
00254             DO 70 IMODE = 1, NTYPES
00255                IF( .NOT.DOTYPE( IMODE ) )
00256      $            GO TO 70
00257 *
00258 *              Do for each type of matrix
00259 *                 1:  zero matrix
00260 *                 2:  one small singular value
00261 *                 3:  geometric distribution of singular values
00262 *                 4:  first n/2 columns fixed
00263 *                 5:  last n/2 columns fixed
00264 *                 6:  every second column fixed
00265 *
00266                MODE = IMODE
00267                IF( IMODE.GT.3 )
00268      $            MODE = 1
00269 *
00270 *              Generate test matrix of size m by n using
00271 *              singular value distribution indicated by `mode'.
00272 *
00273                DO 20 I = 1, N
00274                   IWORK( I ) = 0
00275    20          CONTINUE
00276                IF( IMODE.EQ.1 ) THEN
00277                   CALL ZLASET( 'Full', M, N, CZERO, CZERO, COPYA, LDA )
00278                   DO 30 I = 1, MNMIN
00279                      S( I ) = ZERO
00280    30             CONTINUE
00281                ELSE
00282                   CALL ZLATMS( M, N, 'Uniform', ISEED, 'Nonsymm', S,
00283      $                         MODE, ONE / EPS, ONE, M, N, 'No packing',
00284      $                         COPYA, LDA, WORK, INFO )
00285                   IF( IMODE.GE.4 ) THEN
00286                      IF( IMODE.EQ.4 ) THEN
00287                         ILOW = 1
00288                         ISTEP = 1
00289                         IHIGH = MAX( 1, N / 2 )
00290                      ELSE IF( IMODE.EQ.5 ) THEN
00291                         ILOW = MAX( 1, N / 2 )
00292                         ISTEP = 1
00293                         IHIGH = N
00294                      ELSE IF( IMODE.EQ.6 ) THEN
00295                         ILOW = 1
00296                         ISTEP = 2
00297                         IHIGH = N
00298                      END IF
00299                      DO 40 I = ILOW, IHIGH, ISTEP
00300                         IWORK( I ) = 1
00301    40                CONTINUE
00302                   END IF
00303                   CALL DLAORD( 'Decreasing', MNMIN, S, 1 )
00304                END IF
00305 *
00306                DO 60 INB = 1, NNB
00307 *
00308 *                 Do for each pair of values (NB,NX) in NBVAL and NXVAL.
00309 *
00310                   NB = NBVAL( INB )
00311                   CALL XLAENV( 1, NB )
00312                   NX = NXVAL( INB )
00313                   CALL XLAENV( 3, NX )
00314 *
00315 *                 Save A and its singular values and a copy of
00316 *                 vector IWORK.
00317 *
00318                   CALL ZLACPY( 'All', M, N, COPYA, LDA, A, LDA )
00319                   CALL ICOPY( N, IWORK( 1 ), 1, IWORK( N+1 ), 1 )
00320 *
00321 *                 Workspace needed.
00322 *
00323                   LW = NB*( N+1 )
00324 *
00325                   SRNAMT = 'ZGEQP3'
00326                   CALL ZGEQP3( M, N, A, LDA, IWORK( N+1 ), TAU, WORK,
00327      $                         LW, RWORK, INFO )
00328 *
00329 *                 Compute norm(svd(a) - svd(r))
00330 *
00331                   RESULT( 1 ) = ZQRT12( M, N, A, LDA, S, WORK,
00332      $                          LWORK, RWORK )
00333 *
00334 *                 Compute norm( A*P - Q*R )
00335 *
00336                   RESULT( 2 ) = ZQPT01( M, N, MNMIN, COPYA, A, LDA, TAU,
00337      $                          IWORK( N+1 ), WORK, LWORK )
00338 *
00339 *                 Compute Q'*Q
00340 *
00341                   RESULT( 3 ) = ZQRT11( M, MNMIN, A, LDA, TAU, WORK,
00342      $                          LWORK )
00343 *
00344 *                 Print information about the tests that did not pass
00345 *                 the threshold.
00346 *
00347                   DO 50 K = 1, NTESTS
00348                      IF( RESULT( K ).GE.THRESH ) THEN
00349                         IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00350      $                     CALL ALAHD( NOUT, PATH )
00351                         WRITE( NOUT, FMT = 9999 )'ZGEQP3', M, N, NB,
00352      $                     IMODE, K, RESULT( K )
00353                         NFAIL = NFAIL + 1
00354                      END IF
00355    50             CONTINUE
00356                   NRUN = NRUN + NTESTS
00357 *
00358    60          CONTINUE
00359    70       CONTINUE
00360    80    CONTINUE
00361    90 CONTINUE
00362 *
00363 *     Print a summary of the results.
00364 *
00365       CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
00366 *
00367  9999 FORMAT( 1X, A, ' M =', I5, ', N =', I5, ', NB =', I4, ', type ',
00368      $      I2, ', test ', I2, ', ratio =', G12.5 )
00369 *
00370 *     End of ZCHKQ3
00371 *
00372       END
 All Files Functions