LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
cckgqr.f
Go to the documentation of this file.
00001 *> \brief \b CCKGQR
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 CCKGQR( NM, MVAL, NP, PVAL, NN, NVAL, NMATS, ISEED,
00012 *                          THRESH, NMAX, A, AF, AQ, AR, TAUA, B, BF, BZ,
00013 *                          BT, BWK, TAUB, WORK, RWORK, NIN, NOUT, INFO )
00014 * 
00015 *       .. Scalar Arguments ..
00016 *       INTEGER            INFO, NIN, NM, NMATS, NMAX, NN, NOUT, NP
00017 *       REAL               THRESH
00018 *       ..
00019 *       .. Array Arguments ..
00020 *       INTEGER            ISEED( 4 ), MVAL( * ), NVAL( * ), PVAL( * )
00021 *       REAL               RWORK( * )
00022 *       COMPLEX            A( * ), AF( * ), AQ( * ), AR( * ), B( * ),
00023 *      $                   BF( * ), BT( * ), BWK( * ), BZ( * ), TAUA( * ),
00024 *      $                   TAUB( * ), WORK( * )
00025 *       ..
00026 *  
00027 *
00028 *> \par Purpose:
00029 *  =============
00030 *>
00031 *> \verbatim
00032 *>
00033 *> CCKGQR tests
00034 *> CGGQRF: GQR factorization for N-by-M matrix A and N-by-P matrix B,
00035 *> CGGRQF: GRQ factorization for M-by-N matrix A and P-by-N matrix B.
00036 *> \endverbatim
00037 *
00038 *  Arguments:
00039 *  ==========
00040 *
00041 *> \param[in] NM
00042 *> \verbatim
00043 *>          NM is INTEGER
00044 *>          The number of values of M contained in the vector MVAL.
00045 *> \endverbatim
00046 *>
00047 *> \param[in] MVAL
00048 *> \verbatim
00049 *>          MVAL is INTEGER array, dimension (NM)
00050 *>          The values of the matrix row(column) dimension M.
00051 *> \endverbatim
00052 *>
00053 *> \param[in] NP
00054 *> \verbatim
00055 *>          NP is INTEGER
00056 *>          The number of values of P contained in the vector PVAL.
00057 *> \endverbatim
00058 *>
00059 *> \param[in] PVAL
00060 *> \verbatim
00061 *>          PVAL is INTEGER array, dimension (NP)
00062 *>          The values of the matrix row(column) dimension P.
00063 *> \endverbatim
00064 *>
00065 *> \param[in] NN
00066 *> \verbatim
00067 *>          NN is INTEGER
00068 *>          The number of values of N contained in the vector NVAL.
00069 *> \endverbatim
00070 *>
00071 *> \param[in] NVAL
00072 *> \verbatim
00073 *>          NVAL is INTEGER array, dimension (NN)
00074 *>          The values of the matrix column(row) dimension N.
00075 *> \endverbatim
00076 *>
00077 *> \param[in] NMATS
00078 *> \verbatim
00079 *>          NMATS is INTEGER
00080 *>          The number of matrix types to be tested for each combination
00081 *>          of matrix dimensions.  If NMATS >= NTYPES (the maximum
00082 *>          number of matrix types), then all the different types are
00083 *>          generated for testing.  If NMATS < NTYPES, another input line
00084 *>          is read to get the numbers of the matrix types to be used.
00085 *> \endverbatim
00086 *>
00087 *> \param[in,out] ISEED
00088 *> \verbatim
00089 *>          ISEED is INTEGER array, dimension (4)
00090 *>          On entry, the seed of the random number generator.  The array
00091 *>          elements should be between 0 and 4095, otherwise they will be
00092 *>          reduced mod 4096, and ISEED(4) must be odd.
00093 *>          On exit, the next seed in the random number sequence after
00094 *>          all the test matrices have been generated.
00095 *> \endverbatim
00096 *>
00097 *> \param[in] THRESH
00098 *> \verbatim
00099 *>          THRESH is REAL
00100 *>          The threshold value for the test ratios.  A result is
00101 *>          included in the output file if RESULT >= THRESH.  To have
00102 *>          every test ratio printed, use THRESH = 0.
00103 *> \endverbatim
00104 *>
00105 *> \param[in] NMAX
00106 *> \verbatim
00107 *>          NMAX is INTEGER
00108 *>          The maximum value permitted for M or N, used in dimensioning
00109 *>          the work arrays.
00110 *> \endverbatim
00111 *>
00112 *> \param[out] A
00113 *> \verbatim
00114 *>          A is COMPLEX array, dimension (NMAX*NMAX)
00115 *> \endverbatim
00116 *>
00117 *> \param[out] AF
00118 *> \verbatim
00119 *>          AF is COMPLEX array, dimension (NMAX*NMAX)
00120 *> \endverbatim
00121 *>
00122 *> \param[out] AQ
00123 *> \verbatim
00124 *>          AQ is COMPLEX array, dimension (NMAX*NMAX)
00125 *> \endverbatim
00126 *>
00127 *> \param[out] AR
00128 *> \verbatim
00129 *>          AR is COMPLEX array, dimension (NMAX*NMAX)
00130 *> \endverbatim
00131 *>
00132 *> \param[out] TAUA
00133 *> \verbatim
00134 *>          TAUA is COMPLEX array, dimension (NMAX)
00135 *> \endverbatim
00136 *>
00137 *> \param[out] B
00138 *> \verbatim
00139 *>          B is COMPLEX array, dimension (NMAX*NMAX)
00140 *> \endverbatim
00141 *>
00142 *> \param[out] BF
00143 *> \verbatim
00144 *>          BF is COMPLEX array, dimension (NMAX*NMAX)
00145 *> \endverbatim
00146 *>
00147 *> \param[out] BZ
00148 *> \verbatim
00149 *>          BZ is COMPLEX array, dimension (NMAX*NMAX)
00150 *> \endverbatim
00151 *>
00152 *> \param[out] BT
00153 *> \verbatim
00154 *>          BT is COMPLEX array, dimension (NMAX*NMAX)
00155 *> \endverbatim
00156 *>
00157 *> \param[out] BWK
00158 *> \verbatim
00159 *>          BWK is COMPLEX array, dimension (NMAX*NMAX)
00160 *> \endverbatim
00161 *>
00162 *> \param[out] TAUB
00163 *> \verbatim
00164 *>          TAUB is COMPLEX array, dimension (NMAX)
00165 *> \endverbatim
00166 *>
00167 *> \param[out] WORK
00168 *> \verbatim
00169 *>          WORK is COMPLEX array, dimension (NMAX*NMAX)
00170 *> \endverbatim
00171 *>
00172 *> \param[out] RWORK
00173 *> \verbatim
00174 *>          RWORK is REAL array, dimension (NMAX)
00175 *> \endverbatim
00176 *>
00177 *> \param[in] NIN
00178 *> \verbatim
00179 *>          NIN is INTEGER
00180 *>          The unit number for input.
00181 *> \endverbatim
00182 *>
00183 *> \param[in] NOUT
00184 *> \verbatim
00185 *>          NOUT is INTEGER
00186 *>          The unit number for output.
00187 *> \endverbatim
00188 *>
00189 *> \param[out] INFO
00190 *> \verbatim
00191 *>          INFO is INTEGER
00192 *>          = 0 :  successful exit
00193 *>          > 0 :  If CLATMS returns an error code, the absolute value
00194 *>                 of it is returned.
00195 *> \endverbatim
00196 *
00197 *  Authors:
00198 *  ========
00199 *
00200 *> \author Univ. of Tennessee 
00201 *> \author Univ. of California Berkeley 
00202 *> \author Univ. of Colorado Denver 
00203 *> \author NAG Ltd. 
00204 *
00205 *> \date November 2011
00206 *
00207 *> \ingroup complex_eig
00208 *
00209 *  =====================================================================
00210       SUBROUTINE CCKGQR( NM, MVAL, NP, PVAL, NN, NVAL, NMATS, ISEED,
00211      $                   THRESH, NMAX, A, AF, AQ, AR, TAUA, B, BF, BZ,
00212      $                   BT, BWK, TAUB, WORK, RWORK, NIN, NOUT, INFO )
00213 *
00214 *  -- LAPACK test routine (version 3.4.0) --
00215 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00216 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00217 *     November 2011
00218 *
00219 *     .. Scalar Arguments ..
00220       INTEGER            INFO, NIN, NM, NMATS, NMAX, NN, NOUT, NP
00221       REAL               THRESH
00222 *     ..
00223 *     .. Array Arguments ..
00224       INTEGER            ISEED( 4 ), MVAL( * ), NVAL( * ), PVAL( * )
00225       REAL               RWORK( * )
00226       COMPLEX            A( * ), AF( * ), AQ( * ), AR( * ), B( * ),
00227      $                   BF( * ), BT( * ), BWK( * ), BZ( * ), TAUA( * ),
00228      $                   TAUB( * ), WORK( * )
00229 *     ..
00230 *
00231 *  =====================================================================
00232 *
00233 *     .. Parameters ..
00234       INTEGER            NTESTS
00235       PARAMETER          ( NTESTS = 7 )
00236       INTEGER            NTYPES
00237       PARAMETER          ( NTYPES = 8 )
00238 *     ..
00239 *     .. Local Scalars ..
00240       LOGICAL            FIRSTT
00241       CHARACTER          DISTA, DISTB, TYPE
00242       CHARACTER*3        PATH
00243       INTEGER            I, IINFO, IM, IMAT, IN, IP, KLA, KLB, KUA, KUB,
00244      $                   LDA, LDB, LWORK, M, MODEA, MODEB, N, NFAIL,
00245      $                   NRUN, NT, P
00246       REAL               ANORM, BNORM, CNDNMA, CNDNMB
00247 *     ..
00248 *     .. Local Arrays ..
00249       LOGICAL            DOTYPE( NTYPES )
00250       REAL               RESULT( NTESTS )
00251 *     ..
00252 *     .. External Subroutines ..
00253       EXTERNAL           ALAHDG, ALAREQ, ALASUM, CGQRTS, CGRQTS, CLATMS,
00254      $                   SLATB9
00255 *     ..
00256 *     .. Intrinsic Functions ..
00257       INTRINSIC          ABS
00258 *     ..
00259 *     .. Executable Statements ..
00260 *
00261 *     Initialize constants.
00262 *
00263       PATH( 1: 3 ) = 'GQR'
00264       INFO = 0
00265       NRUN = 0
00266       NFAIL = 0
00267       FIRSTT = .TRUE.
00268       CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
00269       LDA = NMAX
00270       LDB = NMAX
00271       LWORK = NMAX*NMAX
00272 *
00273 *     Do for each value of M in MVAL.
00274 *
00275       DO 60 IM = 1, NM
00276          M = MVAL( IM )
00277 *
00278 *        Do for each value of P in PVAL.
00279 *
00280          DO 50 IP = 1, NP
00281             P = PVAL( IP )
00282 *
00283 *           Do for each value of N in NVAL.
00284 *
00285             DO 40 IN = 1, NN
00286                N = NVAL( IN )
00287 *
00288                DO 30 IMAT = 1, NTYPES
00289 *
00290 *                 Do the tests only if DOTYPE( IMAT ) is true.
00291 *
00292                   IF( .NOT.DOTYPE( IMAT ) )
00293      $               GO TO 30
00294 *
00295 *                 Test CGGRQF
00296 *
00297 *                 Set up parameters with SLATB9 and generate test
00298 *                 matrices A and B with CLATMS.
00299 *
00300                   CALL SLATB9( 'GRQ', IMAT, M, P, N, TYPE, KLA, KUA,
00301      $                         KLB, KUB, ANORM, BNORM, MODEA, MODEB,
00302      $                         CNDNMA, CNDNMB, DISTA, DISTB )
00303 *
00304                   CALL CLATMS( M, N, DISTA, ISEED, TYPE, RWORK, MODEA,
00305      $                         CNDNMA, ANORM, KLA, KUA, 'No packing', A,
00306      $                         LDA, WORK, IINFO )
00307                   IF( IINFO.NE.0 ) THEN
00308                      WRITE( NOUT, FMT = 9999 )IINFO
00309                      INFO = ABS( IINFO )
00310                      GO TO 30
00311                   END IF
00312 *
00313                   CALL CLATMS( P, N, DISTB, ISEED, TYPE, RWORK, MODEB,
00314      $                         CNDNMB, BNORM, KLB, KUB, 'No packing', B,
00315      $                         LDB, WORK, IINFO )
00316                   IF( IINFO.NE.0 ) THEN
00317                      WRITE( NOUT, FMT = 9999 )IINFO
00318                      INFO = ABS( IINFO )
00319                      GO TO 30
00320                   END IF
00321 *
00322                   NT = 4
00323 *
00324                   CALL CGRQTS( M, P, N, A, AF, AQ, AR, LDA, TAUA, B, BF,
00325      $                         BZ, BT, BWK, LDB, TAUB, WORK, LWORK,
00326      $                         RWORK, RESULT )
00327 *
00328 *                 Print information about the tests that did not
00329 *                 pass the threshold.
00330 *
00331                   DO 10 I = 1, NT
00332                      IF( RESULT( I ).GE.THRESH ) THEN
00333                         IF( NFAIL.EQ.0 .AND. FIRSTT ) THEN
00334                            FIRSTT = .FALSE.
00335                            CALL ALAHDG( NOUT, 'GRQ' )
00336                         END IF
00337                         WRITE( NOUT, FMT = 9998 )M, P, N, IMAT, I,
00338      $                     RESULT( I )
00339                         NFAIL = NFAIL + 1
00340                      END IF
00341    10             CONTINUE
00342                   NRUN = NRUN + NT
00343 *
00344 *                 Test CGGQRF
00345 *
00346 *                 Set up parameters with SLATB9 and generate test
00347 *                 matrices A and B with CLATMS.
00348 *
00349                   CALL SLATB9( 'GQR', IMAT, M, P, N, TYPE, KLA, KUA,
00350      $                         KLB, KUB, ANORM, BNORM, MODEA, MODEB,
00351      $                         CNDNMA, CNDNMB, DISTA, DISTB )
00352 *
00353                   CALL CLATMS( N, M, DISTA, ISEED, TYPE, RWORK, MODEA,
00354      $                         CNDNMA, ANORM, KLA, KUA, 'No packing', A,
00355      $                         LDA, WORK, IINFO )
00356                   IF( IINFO.NE.0 ) THEN
00357                      WRITE( NOUT, FMT = 9999 )IINFO
00358                      INFO = ABS( IINFO )
00359                      GO TO 30
00360                   END IF
00361 *
00362                   CALL CLATMS( N, P, DISTB, ISEED, TYPE, RWORK, MODEA,
00363      $                         CNDNMA, BNORM, KLB, KUB, 'No packing', B,
00364      $                         LDB, WORK, IINFO )
00365                   IF( IINFO.NE.0 ) THEN
00366                      WRITE( NOUT, FMT = 9999 )IINFO
00367                      INFO = ABS( IINFO )
00368                      GO TO 30
00369                   END IF
00370 *
00371                   NT = 4
00372 *
00373                   CALL CGQRTS( N, M, P, A, AF, AQ, AR, LDA, TAUA, B, BF,
00374      $                         BZ, BT, BWK, LDB, TAUB, WORK, LWORK,
00375      $                         RWORK, RESULT )
00376 *
00377 *                 Print information about the tests that did not
00378 *                 pass the threshold.
00379 *
00380                   DO 20 I = 1, NT
00381                      IF( RESULT( I ).GE.THRESH ) THEN
00382                         IF( NFAIL.EQ.0 .AND. FIRSTT ) THEN
00383                            FIRSTT = .FALSE.
00384                            CALL ALAHDG( NOUT, PATH )
00385                         END IF
00386                         WRITE( NOUT, FMT = 9997 )N, M, P, IMAT, I,
00387      $                     RESULT( I )
00388                         NFAIL = NFAIL + 1
00389                      END IF
00390    20             CONTINUE
00391                   NRUN = NRUN + NT
00392 *
00393    30          CONTINUE
00394    40       CONTINUE
00395    50    CONTINUE
00396    60 CONTINUE
00397 *
00398 *     Print a summary of the results.
00399 *
00400       CALL ALASUM( PATH, NOUT, NFAIL, NRUN, 0 )
00401 *
00402  9999 FORMAT( ' CLATMS in CCKGQR:    INFO = ', I5 )
00403  9998 FORMAT( ' M=', I4, ' P=', I4, ', N=', I4, ', type ', I2,
00404      $      ', test ', I2, ', ratio=', G13.6 )
00405  9997 FORMAT( ' N=', I4, ' M=', I4, ', P=', I4, ', type ', I2,
00406      $      ', test ', I2, ', ratio=', G13.6 )
00407       RETURN
00408 *
00409 *     End of CCKGQR
00410 *
00411       END
 All Files Functions