LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
zchkqp.f
Go to the documentation of this file.
00001 *> \brief \b ZCHKQP
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 ZCHKQP( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A,
00012 *                          COPYA, S, TAU, WORK, RWORK, IWORK,
00013 *                          NOUT )
00014 * 
00015 *       .. Scalar Arguments ..
00016 *       LOGICAL            TSTERR
00017 *       INTEGER            NM, NN, NOUT
00018 *       DOUBLE PRECISION   THRESH
00019 *       ..
00020 *       .. Array Arguments ..
00021 *       LOGICAL            DOTYPE( * )
00022 *       INTEGER            IWORK( * ), MVAL( * ), NVAL( * )
00023 *       DOUBLE PRECISION   S( * ), RWORK( * )
00024 *       COMPLEX*16         A( * ), COPYA( * ), TAU( * ), WORK( * )
00025 *       ..
00026 *  
00027 *
00028 *> \par Purpose:
00029 *  =============
00030 *>
00031 *> \verbatim
00032 *>
00033 *> ZCHKQP tests ZGEQPF.
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] THRESH
00072 *> \verbatim
00073 *>          THRESH is DOUBLE PRECISION
00074 *>          The threshold value for the test ratios.  A result is
00075 *>          included in the output file if RESULT >= THRESH.  To have
00076 *>          every test ratio printed, use THRESH = 0.
00077 *> \endverbatim
00078 *>
00079 *> \param[in] TSTERR
00080 *> \verbatim
00081 *>          TSTERR is LOGICAL
00082 *>          Flag that indicates whether error exits are to be tested.
00083 *> \endverbatim
00084 *>
00085 *> \param[out] A
00086 *> \verbatim
00087 *>          A is COMPLEX*16 array, dimension (MMAX*NMAX)
00088 *>          where MMAX is the maximum value of M in MVAL and NMAX is the
00089 *>          maximum value of N in NVAL.
00090 *> \endverbatim
00091 *>
00092 *> \param[out] COPYA
00093 *> \verbatim
00094 *>          COPYA is COMPLEX*16 array, dimension (MMAX*NMAX)
00095 *> \endverbatim
00096 *>
00097 *> \param[out] S
00098 *> \verbatim
00099 *>          S is DOUBLE PRECISION array, dimension
00100 *>                      (min(MMAX,NMAX))
00101 *> \endverbatim
00102 *>
00103 *> \param[out] TAU
00104 *> \verbatim
00105 *>          TAU is COMPLEX*16 array, dimension (MMAX)
00106 *> \endverbatim
00107 *>
00108 *> \param[out] WORK
00109 *> \verbatim
00110 *>          WORK is COMPLEX*16 array, dimension
00111 *>                      (max(M*max(M,N) + 4*min(M,N) + max(M,N)))
00112 *> \endverbatim
00113 *>
00114 *> \param[out] RWORK
00115 *> \verbatim
00116 *>          RWORK is DOUBLE PRECISION array, dimension (4*NMAX)
00117 *> \endverbatim
00118 *>
00119 *> \param[out] IWORK
00120 *> \verbatim
00121 *>          IWORK is INTEGER array, dimension (NMAX)
00122 *> \endverbatim
00123 *>
00124 *> \param[in] NOUT
00125 *> \verbatim
00126 *>          NOUT is INTEGER
00127 *>          The unit number for output.
00128 *> \endverbatim
00129 *
00130 *  Authors:
00131 *  ========
00132 *
00133 *> \author Univ. of Tennessee 
00134 *> \author Univ. of California Berkeley 
00135 *> \author Univ. of Colorado Denver 
00136 *> \author NAG Ltd. 
00137 *
00138 *> \date November 2011
00139 *
00140 *> \ingroup complex16_lin
00141 *
00142 *  =====================================================================
00143       SUBROUTINE ZCHKQP( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A,
00144      $                   COPYA, S, TAU, WORK, RWORK, IWORK,
00145      $                   NOUT )
00146 *
00147 *  -- LAPACK test routine (version 3.4.0) --
00148 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00149 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00150 *     November 2011
00151 *
00152 *     .. Scalar Arguments ..
00153       LOGICAL            TSTERR
00154       INTEGER            NM, NN, NOUT
00155       DOUBLE PRECISION   THRESH
00156 *     ..
00157 *     .. Array Arguments ..
00158       LOGICAL            DOTYPE( * )
00159       INTEGER            IWORK( * ), MVAL( * ), NVAL( * )
00160       DOUBLE PRECISION   S( * ), RWORK( * )
00161       COMPLEX*16         A( * ), COPYA( * ), TAU( * ), WORK( * )
00162 *     ..
00163 *
00164 *  =====================================================================
00165 *
00166 *     .. Parameters ..
00167       INTEGER            NTYPES
00168       PARAMETER          ( NTYPES = 6 )
00169       INTEGER            NTESTS
00170       PARAMETER          ( NTESTS = 3 )
00171       DOUBLE PRECISION   ONE, ZERO
00172       PARAMETER          ( ONE = 1.0D0, ZERO = 0.0D0 )
00173 *     ..
00174 *     .. Local Scalars ..
00175       CHARACTER*3        PATH
00176       INTEGER            I, IHIGH, ILOW, IM, IMODE, IN, INFO, ISTEP, K,
00177      $                   LDA, LWORK, M, MNMIN, MODE, N, NERRS, NFAIL,
00178      $                   NRUN
00179       DOUBLE PRECISION   EPS
00180 *     ..
00181 *     .. Local Arrays ..
00182       INTEGER            ISEED( 4 ), ISEEDY( 4 )
00183       DOUBLE PRECISION   RESULT( NTESTS )
00184 *     ..
00185 *     .. External Functions ..
00186       DOUBLE PRECISION   DLAMCH, ZQPT01, ZQRT11, ZQRT12
00187       EXTERNAL           DLAMCH, ZQPT01, ZQRT11, ZQRT12
00188 *     ..
00189 *     .. External Subroutines ..
00190       EXTERNAL           ALAHD, ALASUM, DLAORD, ZERRQP, ZGEQPF, ZLACPY,
00191      $                   ZLASET, ZLATMS
00192 *     ..
00193 *     .. Intrinsic Functions ..
00194       INTRINSIC          DCMPLX, MAX, MIN
00195 *     ..
00196 *     .. Scalars in Common ..
00197       LOGICAL            LERR, OK
00198       CHARACTER*32       SRNAMT
00199       INTEGER            INFOT, IOUNIT
00200 *     ..
00201 *     .. Common blocks ..
00202       COMMON             / INFOC / INFOT, IOUNIT, OK, LERR
00203       COMMON             / SRNAMC / SRNAMT
00204 *     ..
00205 *     .. Data statements ..
00206       DATA               ISEEDY / 1988, 1989, 1990, 1991 /
00207 *     ..
00208 *     .. Executable Statements ..
00209 *
00210 *     Initialize constants and the random number seed.
00211 *
00212       PATH( 1: 1 ) = 'Zomplex precision'
00213       PATH( 2: 3 ) = 'QP'
00214       NRUN = 0
00215       NFAIL = 0
00216       NERRS = 0
00217       DO 10 I = 1, 4
00218          ISEED( I ) = ISEEDY( I )
00219    10 CONTINUE
00220       EPS = DLAMCH( 'Epsilon' )
00221 *
00222 *     Test the error exits
00223 *
00224       IF( TSTERR )
00225      $   CALL ZERRQP( PATH, NOUT )
00226       INFOT = 0
00227 *
00228       DO 80 IM = 1, NM
00229 *
00230 *        Do for each value of M in MVAL.
00231 *
00232          M = MVAL( IM )
00233          LDA = MAX( 1, M )
00234 *
00235          DO 70 IN = 1, NN
00236 *
00237 *           Do for each value of N in NVAL.
00238 *
00239             N = NVAL( IN )
00240             MNMIN = MIN( M, N )
00241             LWORK = MAX( 1, M*MAX( M, N )+4*MNMIN+MAX( M, N ) )
00242 *
00243             DO 60 IMODE = 1, NTYPES
00244                IF( .NOT.DOTYPE( IMODE ) )
00245      $            GO TO 60
00246 *
00247 *              Do for each type of matrix
00248 *                 1:  zero matrix
00249 *                 2:  one small singular value
00250 *                 3:  geometric distribution of singular values
00251 *                 4:  first n/2 columns fixed
00252 *                 5:  last n/2 columns fixed
00253 *                 6:  every second column fixed
00254 *
00255                MODE = IMODE
00256                IF( IMODE.GT.3 )
00257      $            MODE = 1
00258 *
00259 *              Generate test matrix of size m by n using
00260 *              singular value distribution indicated by `mode'.
00261 *
00262                DO 20 I = 1, N
00263                   IWORK( I ) = 0
00264    20          CONTINUE
00265                IF( IMODE.EQ.1 ) THEN
00266                   CALL ZLASET( 'Full', M, N, DCMPLX( ZERO ),
00267      $                         DCMPLX( ZERO ), COPYA, LDA )
00268                   DO 30 I = 1, MNMIN
00269                      S( I ) = ZERO
00270    30             CONTINUE
00271                ELSE
00272                   CALL ZLATMS( M, N, 'Uniform', ISEED, 'Nonsymm', S,
00273      $                         MODE, ONE / EPS, ONE, M, N, 'No packing',
00274      $                         COPYA, LDA, WORK, INFO )
00275                   IF( IMODE.GE.4 ) THEN
00276                      IF( IMODE.EQ.4 ) THEN
00277                         ILOW = 1
00278                         ISTEP = 1
00279                         IHIGH = MAX( 1, N / 2 )
00280                      ELSE IF( IMODE.EQ.5 ) THEN
00281                         ILOW = MAX( 1, N / 2 )
00282                         ISTEP = 1
00283                         IHIGH = N
00284                      ELSE IF( IMODE.EQ.6 ) THEN
00285                         ILOW = 1
00286                         ISTEP = 2
00287                         IHIGH = N
00288                      END IF
00289                      DO 40 I = ILOW, IHIGH, ISTEP
00290                         IWORK( I ) = 1
00291    40                CONTINUE
00292                   END IF
00293                   CALL DLAORD( 'Decreasing', MNMIN, S, 1 )
00294                END IF
00295 *
00296 *              Save A and its singular values
00297 *
00298                CALL ZLACPY( 'All', M, N, COPYA, LDA, A, LDA )
00299 *
00300 *              Compute the QR factorization with pivoting of A
00301 *
00302                SRNAMT = 'ZGEQPF'
00303                CALL ZGEQPF( M, N, A, LDA, IWORK, TAU, WORK, RWORK,
00304      $                      INFO )
00305 *
00306 *              Compute norm(svd(a) - svd(r))
00307 *
00308                RESULT( 1 ) = ZQRT12( M, N, A, LDA, S, WORK, LWORK,
00309      $                       RWORK )
00310 *
00311 *              Compute norm( A*P - Q*R )
00312 *
00313                RESULT( 2 ) = ZQPT01( M, N, MNMIN, COPYA, A, LDA, TAU,
00314      $                       IWORK, WORK, LWORK )
00315 *
00316 *              Compute Q'*Q
00317 *
00318                RESULT( 3 ) = ZQRT11( M, MNMIN, A, LDA, TAU, WORK,
00319      $                       LWORK )
00320 *
00321 *              Print information about the tests that did not pass
00322 *              the threshold.
00323 *
00324                DO 50 K = 1, 3
00325                   IF( RESULT( K ).GE.THRESH ) THEN
00326                      IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00327      $                  CALL ALAHD( NOUT, PATH )
00328                      WRITE( NOUT, FMT = 9999 )M, N, IMODE, K,
00329      $                  RESULT( K )
00330                      NFAIL = NFAIL + 1
00331                   END IF
00332    50          CONTINUE
00333                NRUN = NRUN + 3
00334    60       CONTINUE
00335    70    CONTINUE
00336    80 CONTINUE
00337 *
00338 *     Print a summary of the results.
00339 *
00340       CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
00341 *
00342  9999 FORMAT( ' M =', I5, ', N =', I5, ', type ', I2, ', test ', I2,
00343      $      ', ratio =', G12.5 )
00344 *
00345 *     End of ZCHKQP
00346 *
00347       END
 All Files Functions