LAPACK: TESTING/LIN/cchkqr.f Source File

Go to the documentation of this file.
00001       SUBROUTINE CCHKQR( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL,
00002      $                   NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AR, AC,
00003      $                   B, X, XACT, TAU, WORK, RWORK, IWORK, NOUT )
00004 *
00005 *  -- LAPACK test routine (version 3.3.0) --
00006 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00007 *     November 2010
00008 *
00009 *     .. Scalar Arguments ..
00010       LOGICAL            TSTERR
00011       INTEGER            NM, NMAX, NN, NNB, NOUT, NRHS
00012       REAL               THRESH
00013 *     ..
00014 *     .. Array Arguments ..
00015       LOGICAL            DOTYPE( * )
00016       INTEGER            IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ),
00017      $                   NXVAL( * )
00018       REAL               RWORK( * )
00019       COMPLEX            A( * ), AC( * ), AF( * ), AQ( * ), AR( * ),
00020      $                   B( * ), TAU( * ), WORK( * ), X( * ), XACT( * )
00021 *     ..
00022 *
00023 *  Purpose
00024 *  =======
00025 *
00026 *  CCHKQR tests CGEQRF, CUNGQR and CUNMQR.
00027 *
00028 *  Arguments
00029 *  =========
00030 *
00031 *  DOTYPE  (input) LOGICAL array, dimension (NTYPES)
00032 *          The matrix types to be used for testing.  Matrices of type j
00033 *          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
00034 *          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
00035 *
00036 *  NM      (input) INTEGER
00037 *          The number of values of M contained in the vector MVAL.
00038 *
00039 *  MVAL    (input) INTEGER array, dimension (NM)
00040 *          The values of the matrix row dimension M.
00041 *
00042 *  NN      (input) INTEGER
00043 *          The number of values of N contained in the vector NVAL.
00044 *
00045 *  NVAL    (input) INTEGER array, dimension (NN)
00046 *          The values of the matrix column dimension N.
00047 *
00048 *  NNB     (input) INTEGER
00049 *          The number of values of NB and NX contained in the
00050 *          vectors NBVAL and NXVAL.  The blocking parameters are used
00051 *          in pairs (NB,NX).
00052 *
00053 *  NBVAL   (input) INTEGER array, dimension (NNB)
00054 *          The values of the blocksize NB.
00055 *
00056 *  NXVAL   (input) INTEGER array, dimension (NNB)
00057 *          The values of the crossover point NX.
00058 *
00059 *  NRHS    (input) INTEGER
00060 *          The number of right hand side vectors to be generated for
00061 *          each linear system.
00062 *
00063 *  THRESH  (input) REAL
00064 *          The threshold value for the test ratios.  A result is
00065 *          included in the output file if RESULT >= THRESH.  To have
00066 *          every test ratio printed, use THRESH = 0.
00067 *
00068 *  TSTERR  (input) LOGICAL
00069 *          Flag that indicates whether error exits are to be tested.
00070 *
00071 *  NMAX    (input) INTEGER
00072 *          The maximum value permitted for M or N, used in dimensioning
00073 *          the work arrays.
00074 *
00075 *  A       (workspace) COMPLEX array, dimension (NMAX*NMAX)
00076 *
00077 *  AF      (workspace) COMPLEX array, dimension (NMAX*NMAX)
00078 *
00079 *  AQ      (workspace) COMPLEX array, dimension (NMAX*NMAX)
00080 *
00081 *  AR      (workspace) COMPLEX array, dimension (NMAX*NMAX)
00082 *
00083 *  AC      (workspace) COMPLEX array, dimension (NMAX*NMAX)
00084 *
00085 *  B       (workspace) COMPLEX array, dimension (NMAX*NRHS)
00086 *
00087 *  X       (workspace) COMPLEX array, dimension (NMAX*NRHS)
00088 *
00089 *  XACT    (workspace) COMPLEX array, dimension (NMAX*NRHS)
00090 *
00091 *  TAU     (workspace) COMPLEX array, dimension (NMAX)
00092 *
00093 *  WORK    (workspace) COMPLEX array, dimension (NMAX*NMAX)
00094 *
00095 *  RWORK   (workspace) REAL array, dimension (NMAX)
00096 *
00097 *  IWORK   (workspace) INTEGER array, dimension (NMAX)
00098 *
00099 *  NOUT    (input) INTEGER
00100 *          The unit number for output.
00101 *
00102 *  =====================================================================
00103 *
00104 *     .. Parameters ..
00105       INTEGER            NTESTS
00106       PARAMETER          ( NTESTS = 9 )
00107       INTEGER            NTYPES
00108       PARAMETER          ( NTYPES = 8 )
00109       REAL               ZERO
00110       PARAMETER          ( ZERO = 0.0E0 )
00111 *     ..
00112 *     .. Local Scalars ..
00113       CHARACTER          DIST, TYPE
00114       CHARACTER*3        PATH
00115       INTEGER            I, IK, IM, IMAT, IN, INB, INFO, K, KL, KU, LDA,
00116      $                   LWORK, M, MINMN, MODE, N, NB, NERRS, NFAIL, NK,
00117      $                   NRUN, NT, NX
00118       REAL               ANORM, CNDNUM
00119 *     ..
00120 *     .. Local Arrays ..
00121       INTEGER            ISEED( 4 ), ISEEDY( 4 ), KVAL( 4 )
00122       REAL               RESULT( NTESTS )
00123 *     ..
00124 *     .. External Functions ..
00125       LOGICAL            CGENND
00126       EXTERNAL           CGENND
00127 *     ..
00128 *     .. External Subroutines ..
00129       EXTERNAL           ALAERH, ALAHD, ALASUM, CERRQR, CGEQRS, CGET02,
00130      $                   CLACPY, CLARHS, CLATB4, CLATMS, CQRT01,
00131      $                   CQRT01P, CQRT02, CQRT03, XLAENV
00132 *     ..
00133 *     .. Intrinsic Functions ..
00134       INTRINSIC          MAX, MIN
00135 *     ..
00136 *     .. Scalars in Common ..
00137       LOGICAL            LERR, OK
00138       CHARACTER*32       SRNAMT
00139       INTEGER            INFOT, NUNIT
00140 *     ..
00141 *     .. Common blocks ..
00142       COMMON             / INFOC / INFOT, NUNIT, OK, LERR
00143       COMMON             / SRNAMC / SRNAMT
00144 *     ..
00145 *     .. Data statements ..
00146       DATA               ISEEDY / 1988, 1989, 1990, 1991 /
00147 *     ..
00148 *     .. Executable Statements ..
00149 *
00150 *     Initialize constants and the random number seed.
00151 *
00152       PATH( 1: 1 ) = 'Complex precision'
00153       PATH( 2: 3 ) = 'QR'
00154       NRUN = 0
00155       NFAIL = 0
00156       NERRS = 0
00157       DO 10 I = 1, 4
00158          ISEED( I ) = ISEEDY( I )
00159    10 CONTINUE
00160 *
00161 *     Test the error exits
00162 *
00163       IF( TSTERR )
00164      $   CALL CERRQR( PATH, NOUT )
00165       INFOT = 0
00166       CALL XLAENV( 2, 2 )
00167 *
00168       LDA = NMAX
00169       LWORK = NMAX*MAX( NMAX, NRHS )
00170 *
00171 *     Do for each value of M in MVAL.
00172 *
00173       DO 70 IM = 1, NM
00174          M = MVAL( IM )
00175 *
00176 *        Do for each value of N in NVAL.
00177 *
00178          DO 60 IN = 1, NN
00179             N = NVAL( IN )
00180             MINMN = MIN( M, N )
00181             DO 50 IMAT = 1, NTYPES
00182 *
00183 *              Do the tests only if DOTYPE( IMAT ) is true.
00184 *
00185                IF( .NOT.DOTYPE( IMAT ) )
00186      $            GO TO 50
00187 *
00188 *              Set up parameters with CLATB4 and generate a test matrix
00189 *              with CLATMS.
00190 *
00191                CALL CLATB4( PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE,
00192      $                      CNDNUM, DIST )
00193 *
00194                SRNAMT = 'CLATMS'
00195                CALL CLATMS( M, N, DIST, ISEED, TYPE, RWORK, MODE,
00196      $                      CNDNUM, ANORM, KL, KU, 'No packing', A, LDA,
00197      $                      WORK, INFO )
00198 *
00199 *              Check error code from CLATMS.
00200 *
00201                IF( INFO.NE.0 ) THEN
00202                   CALL ALAERH( PATH, 'CLATMS', INFO, 0, ' ', M, N, -1,
00203      $                         -1, -1, IMAT, NFAIL, NERRS, NOUT )
00204                   GO TO 50
00205                END IF
00206 *
00207 *              Set some values for K: the first value must be MINMN,
00208 *              corresponding to the call of CQRT01; other values are
00209 *              used in the calls of CQRT02, and must not exceed MINMN.
00210 *
00211                KVAL( 1 ) = MINMN
00212                KVAL( 2 ) = 0
00213                KVAL( 3 ) = 1
00214                KVAL( 4 ) = MINMN / 2
00215                IF( MINMN.EQ.0 ) THEN
00216                   NK = 1
00217                ELSE IF( MINMN.EQ.1 ) THEN
00218                   NK = 2
00219                ELSE IF( MINMN.LE.3 ) THEN
00220                   NK = 3
00221                ELSE
00222                   NK = 4
00223                END IF
00224 *
00225 *              Do for each value of K in KVAL
00226 *
00227                DO 40 IK = 1, NK
00228                   K = KVAL( IK )
00229 *
00230 *                 Do for each pair of values (NB,NX) in NBVAL and NXVAL.
00231 *
00232                   DO 30 INB = 1, NNB
00233                      NB = NBVAL( INB )
00234                      CALL XLAENV( 1, NB )
00235                      NX = NXVAL( INB )
00236                      CALL XLAENV( 3, NX )
00237                      DO I = 1, NTESTS
00238                         RESULT( I ) = ZERO
00239                      END DO
00240                      NT = 2
00241                      IF( IK.EQ.1 ) THEN
00242 *
00243 *                       Test CGEQRF
00244 *
00245                         CALL CQRT01( M, N, A, AF, AQ, AR, LDA, TAU,
00246      $                               WORK, LWORK, RWORK, RESULT( 1 ) )
00247 *
00248 *                       Test CGEQRFP
00249 *
00250                         CALL CQRT01P( M, N, A, AF, AQ, AR, LDA, TAU,
00251      $                               WORK, LWORK, RWORK, RESULT( 8 ) )
00252 
00253                          IF( .NOT. CGENND( M, N, AF, LDA ) )
00254      $                       RESULT( 9 ) = 2*THRESH
00255                         NT = NT + 1
00256                     ELSE IF( M.GE.N ) THEN
00257 *
00258 *                       Test CUNGQR, using factorization
00259 *                       returned by CQRT01
00260 *
00261                         CALL CQRT02( M, N, K, A, AF, AQ, AR, LDA, TAU,
00262      $                               WORK, LWORK, RWORK, RESULT( 1 ) )
00263                      END IF
00264                      IF( M.GE.K ) THEN
00265 *
00266 *                       Test CUNMQR, using factorization returned
00267 *                       by CQRT01
00268 *
00269                         CALL CQRT03( M, N, K, AF, AC, AR, AQ, LDA, TAU,
00270      $                               WORK, LWORK, RWORK, RESULT( 3 ) )
00271                         NT = NT + 4
00272 *
00273 *                       If M>=N and K=N, call CGEQRS to solve a system
00274 *                       with NRHS right hand sides and compute the
00275 *                       residual.
00276 *
00277                         IF( K.EQ.N .AND. INB.EQ.1 ) THEN
00278 *
00279 *                          Generate a solution and set the right
00280 *                          hand side.
00281 *
00282                            SRNAMT = 'CLARHS'
00283                            CALL CLARHS( PATH, 'New', 'Full',
00284      $                                  'No transpose', M, N, 0, 0,
00285      $                                  NRHS, A, LDA, XACT, LDA, B, LDA,
00286      $                                  ISEED, INFO )
00287 *
00288                            CALL CLACPY( 'Full', M, NRHS, B, LDA, X,
00289      $                                  LDA )
00290                            SRNAMT = 'CGEQRS'
00291                            CALL CGEQRS( M, N, NRHS, AF, LDA, TAU, X,
00292      $                                  LDA, WORK, LWORK, INFO )
00293 *
00294 *                          Check error code from CGEQRS.
00295 *
00296                            IF( INFO.NE.0 )
00297      $                        CALL ALAERH( PATH, 'CGEQRS', INFO, 0, ' ',
00298      $                                     M, N, NRHS, -1, NB, IMAT,
00299      $                                     NFAIL, NERRS, NOUT )
00300 *
00301                            CALL CGET02( 'No transpose', M, N, NRHS, A,
00302      $                                  LDA, X, LDA, B, LDA, RWORK,
00303      $                                  RESULT( 7 ) )
00304                            NT = NT + 1
00305                         END IF
00306                      END IF
00307 *
00308 *                    Print information about the tests that did not
00309 *                    pass the threshold.
00310 *
00311                      DO 20 I = 1, NTESTS
00312                         IF( RESULT( I ).GE.THRESH ) THEN
00313                            IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00314      $                        CALL ALAHD( NOUT, PATH )
00315                            WRITE( NOUT, FMT = 9999 )M, N, K, NB, NX,
00316      $                        IMAT, I, RESULT( I )
00317                            NFAIL = NFAIL + 1
00318                         END IF
00319    20                CONTINUE
00320                      NRUN = NRUN + NT
00321    30             CONTINUE
00322    40          CONTINUE
00323    50       CONTINUE
00324    60    CONTINUE
00325    70 CONTINUE
00326 *
00327 *     Print a summary of the results.
00328 *
00329       CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
00330 *
00331  9999 FORMAT( ' M=', I5, ', N=', I5, ', K=', I5, ', NB=', I4, ', NX=',
00332      $      I5, ', type ', I2, ', test(', I2, ')=', G12.5 )
00333       RETURN
00334 *
00335 *     End of CCHKQR
00336 *
00337       END