LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
zqrt15.f
Go to the documentation of this file.
00001 *> \brief \b ZQRT15
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 ZQRT15( SCALE, RKSEL, M, N, NRHS, A, LDA, B, LDB, S,
00012 *                          RANK, NORMA, NORMB, ISEED, WORK, LWORK )
00013 * 
00014 *       .. Scalar Arguments ..
00015 *       INTEGER            LDA, LDB, LWORK, M, N, NRHS, RANK, RKSEL, SCALE
00016 *       DOUBLE PRECISION   NORMA, NORMB
00017 *       ..
00018 *       .. Array Arguments ..
00019 *       INTEGER            ISEED( 4 )
00020 *       DOUBLE PRECISION   S( * )
00021 *       COMPLEX*16         A( LDA, * ), B( LDB, * ), WORK( LWORK )
00022 *       ..
00023 *  
00024 *
00025 *> \par Purpose:
00026 *  =============
00027 *>
00028 *> \verbatim
00029 *>
00030 *> ZQRT15 generates a matrix with full or deficient rank and of various
00031 *> norms.
00032 *> \endverbatim
00033 *
00034 *  Arguments:
00035 *  ==========
00036 *
00037 *> \param[in] SCALE
00038 *> \verbatim
00039 *>          SCALE is INTEGER
00040 *>          SCALE = 1: normally scaled matrix
00041 *>          SCALE = 2: matrix scaled up
00042 *>          SCALE = 3: matrix scaled down
00043 *> \endverbatim
00044 *>
00045 *> \param[in] RKSEL
00046 *> \verbatim
00047 *>          RKSEL is INTEGER
00048 *>          RKSEL = 1: full rank matrix
00049 *>          RKSEL = 2: rank-deficient matrix
00050 *> \endverbatim
00051 *>
00052 *> \param[in] M
00053 *> \verbatim
00054 *>          M is INTEGER
00055 *>          The number of rows of the matrix A.
00056 *> \endverbatim
00057 *>
00058 *> \param[in] N
00059 *> \verbatim
00060 *>          N is INTEGER
00061 *>          The number of columns of A.
00062 *> \endverbatim
00063 *>
00064 *> \param[in] NRHS
00065 *> \verbatim
00066 *>          NRHS is INTEGER
00067 *>          The number of columns of B.
00068 *> \endverbatim
00069 *>
00070 *> \param[out] A
00071 *> \verbatim
00072 *>          A is COMPLEX*16 array, dimension (LDA,N)
00073 *>          The M-by-N matrix A.
00074 *> \endverbatim
00075 *>
00076 *> \param[in] LDA
00077 *> \verbatim
00078 *>          LDA is INTEGER
00079 *>          The leading dimension of the array A.
00080 *> \endverbatim
00081 *>
00082 *> \param[out] B
00083 *> \verbatim
00084 *>          B is COMPLEX*16 array, dimension (LDB, NRHS)
00085 *>          A matrix that is in the range space of matrix A.
00086 *> \endverbatim
00087 *>
00088 *> \param[in] LDB
00089 *> \verbatim
00090 *>          LDB is INTEGER
00091 *>          The leading dimension of the array B.
00092 *> \endverbatim
00093 *>
00094 *> \param[out] S
00095 *> \verbatim
00096 *>          S is DOUBLE PRECISION array, dimension MIN(M,N)
00097 *>          Singular values of A.
00098 *> \endverbatim
00099 *>
00100 *> \param[out] RANK
00101 *> \verbatim
00102 *>          RANK is INTEGER
00103 *>          number of nonzero singular values of A.
00104 *> \endverbatim
00105 *>
00106 *> \param[out] NORMA
00107 *> \verbatim
00108 *>          NORMA is DOUBLE PRECISION
00109 *>          one-norm norm of A.
00110 *> \endverbatim
00111 *>
00112 *> \param[out] NORMB
00113 *> \verbatim
00114 *>          NORMB is DOUBLE PRECISION
00115 *>          one-norm norm of B.
00116 *> \endverbatim
00117 *>
00118 *> \param[in,out] ISEED
00119 *> \verbatim
00120 *>          ISEED is integer array, dimension (4)
00121 *>          seed for random number generator.
00122 *> \endverbatim
00123 *>
00124 *> \param[out] WORK
00125 *> \verbatim
00126 *>          WORK is COMPLEX*16 array, dimension (LWORK)
00127 *> \endverbatim
00128 *>
00129 *> \param[in] LWORK
00130 *> \verbatim
00131 *>          LWORK is INTEGER
00132 *>          length of work space required.
00133 *>          LWORK >= MAX(M+MIN(M,N),NRHS*MIN(M,N),2*N+M)
00134 *> \endverbatim
00135 *
00136 *  Authors:
00137 *  ========
00138 *
00139 *> \author Univ. of Tennessee 
00140 *> \author Univ. of California Berkeley 
00141 *> \author Univ. of Colorado Denver 
00142 *> \author NAG Ltd. 
00143 *
00144 *> \date November 2011
00145 *
00146 *> \ingroup complex16_lin
00147 *
00148 *  =====================================================================
00149       SUBROUTINE ZQRT15( SCALE, RKSEL, M, N, NRHS, A, LDA, B, LDB, S,
00150      $                   RANK, NORMA, NORMB, ISEED, WORK, LWORK )
00151 *
00152 *  -- LAPACK test routine (version 3.4.0) --
00153 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00154 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00155 *     November 2011
00156 *
00157 *     .. Scalar Arguments ..
00158       INTEGER            LDA, LDB, LWORK, M, N, NRHS, RANK, RKSEL, SCALE
00159       DOUBLE PRECISION   NORMA, NORMB
00160 *     ..
00161 *     .. Array Arguments ..
00162       INTEGER            ISEED( 4 )
00163       DOUBLE PRECISION   S( * )
00164       COMPLEX*16         A( LDA, * ), B( LDB, * ), WORK( LWORK )
00165 *     ..
00166 *
00167 *  =====================================================================
00168 *
00169 *     .. Parameters ..
00170       DOUBLE PRECISION   ZERO, ONE, TWO, SVMIN
00171       PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0,
00172      $                   SVMIN = 0.1D+0 )
00173       COMPLEX*16         CZERO, CONE
00174       PARAMETER          ( CZERO = ( 0.0D+0, 0.0D+0 ),
00175      $                   CONE = ( 1.0D+0, 0.0D+0 ) )
00176 *     ..
00177 *     .. Local Scalars ..
00178       INTEGER            INFO, J, MN
00179       DOUBLE PRECISION   BIGNUM, EPS, SMLNUM, TEMP
00180 *     ..
00181 *     .. Local Arrays ..
00182       DOUBLE PRECISION   DUMMY( 1 )
00183 *     ..
00184 *     .. External Functions ..
00185       DOUBLE PRECISION   DASUM, DLAMCH, DLARND, DZNRM2, ZLANGE
00186       EXTERNAL           DASUM, DLAMCH, DLARND, DZNRM2, ZLANGE
00187 *     ..
00188 *     .. External Subroutines ..
00189       EXTERNAL           DLABAD, DLAORD, DLASCL, XERBLA, ZDSCAL, ZGEMM,
00190      $                   ZLARF, ZLARNV, ZLAROR, ZLASCL, ZLASET
00191 *     ..
00192 *     .. Intrinsic Functions ..
00193       INTRINSIC          ABS, DCMPLX, MAX, MIN
00194 *     ..
00195 *     .. Executable Statements ..
00196 *
00197       MN = MIN( M, N )
00198       IF( LWORK.LT.MAX( M+MN, MN*NRHS, 2*N+M ) ) THEN
00199          CALL XERBLA( 'ZQRT15', 16 )
00200          RETURN
00201       END IF
00202 *
00203       SMLNUM = DLAMCH( 'Safe minimum' )
00204       BIGNUM = ONE / SMLNUM
00205       CALL DLABAD( SMLNUM, BIGNUM )
00206       EPS = DLAMCH( 'Epsilon' )
00207       SMLNUM = ( SMLNUM / EPS ) / EPS
00208       BIGNUM = ONE / SMLNUM
00209 *
00210 *     Determine rank and (unscaled) singular values
00211 *
00212       IF( RKSEL.EQ.1 ) THEN
00213          RANK = MN
00214       ELSE IF( RKSEL.EQ.2 ) THEN
00215          RANK = ( 3*MN ) / 4
00216          DO 10 J = RANK + 1, MN
00217             S( J ) = ZERO
00218    10    CONTINUE
00219       ELSE
00220          CALL XERBLA( 'ZQRT15', 2 )
00221       END IF
00222 *
00223       IF( RANK.GT.0 ) THEN
00224 *
00225 *        Nontrivial case
00226 *
00227          S( 1 ) = ONE
00228          DO 30 J = 2, RANK
00229    20       CONTINUE
00230             TEMP = DLARND( 1, ISEED )
00231             IF( TEMP.GT.SVMIN ) THEN
00232                S( J ) = ABS( TEMP )
00233             ELSE
00234                GO TO 20
00235             END IF
00236    30    CONTINUE
00237          CALL DLAORD( 'Decreasing', RANK, S, 1 )
00238 *
00239 *        Generate 'rank' columns of a random orthogonal matrix in A
00240 *
00241          CALL ZLARNV( 2, ISEED, M, WORK )
00242          CALL ZDSCAL( M, ONE / DZNRM2( M, WORK, 1 ), WORK, 1 )
00243          CALL ZLASET( 'Full', M, RANK, CZERO, CONE, A, LDA )
00244          CALL ZLARF( 'Left', M, RANK, WORK, 1, DCMPLX( TWO ), A, LDA,
00245      $               WORK( M+1 ) )
00246 *
00247 *        workspace used: m+mn
00248 *
00249 *        Generate consistent rhs in the range space of A
00250 *
00251          CALL ZLARNV( 2, ISEED, RANK*NRHS, WORK )
00252          CALL ZGEMM( 'No transpose', 'No transpose', M, NRHS, RANK,
00253      $               CONE, A, LDA, WORK, RANK, CZERO, B, LDB )
00254 *
00255 *        work space used: <= mn *nrhs
00256 *
00257 *        generate (unscaled) matrix A
00258 *
00259          DO 40 J = 1, RANK
00260             CALL ZDSCAL( M, S( J ), A( 1, J ), 1 )
00261    40    CONTINUE
00262          IF( RANK.LT.N )
00263      $      CALL ZLASET( 'Full', M, N-RANK, CZERO, CZERO,
00264      $                   A( 1, RANK+1 ), LDA )
00265          CALL ZLAROR( 'Right', 'No initialization', M, N, A, LDA, ISEED,
00266      $                WORK, INFO )
00267 *
00268       ELSE
00269 *
00270 *        work space used 2*n+m
00271 *
00272 *        Generate null matrix and rhs
00273 *
00274          DO 50 J = 1, MN
00275             S( J ) = ZERO
00276    50    CONTINUE
00277          CALL ZLASET( 'Full', M, N, CZERO, CZERO, A, LDA )
00278          CALL ZLASET( 'Full', M, NRHS, CZERO, CZERO, B, LDB )
00279 *
00280       END IF
00281 *
00282 *     Scale the matrix
00283 *
00284       IF( SCALE.NE.1 ) THEN
00285          NORMA = ZLANGE( 'Max', M, N, A, LDA, DUMMY )
00286          IF( NORMA.NE.ZERO ) THEN
00287             IF( SCALE.EQ.2 ) THEN
00288 *
00289 *              matrix scaled up
00290 *
00291                CALL ZLASCL( 'General', 0, 0, NORMA, BIGNUM, M, N, A,
00292      $                      LDA, INFO )
00293                CALL DLASCL( 'General', 0, 0, NORMA, BIGNUM, MN, 1, S,
00294      $                      MN, INFO )
00295                CALL ZLASCL( 'General', 0, 0, NORMA, BIGNUM, M, NRHS, B,
00296      $                      LDB, INFO )
00297             ELSE IF( SCALE.EQ.3 ) THEN
00298 *
00299 *              matrix scaled down
00300 *
00301                CALL ZLASCL( 'General', 0, 0, NORMA, SMLNUM, M, N, A,
00302      $                      LDA, INFO )
00303                CALL DLASCL( 'General', 0, 0, NORMA, SMLNUM, MN, 1, S,
00304      $                      MN, INFO )
00305                CALL ZLASCL( 'General', 0, 0, NORMA, SMLNUM, M, NRHS, B,
00306      $                      LDB, INFO )
00307             ELSE
00308                CALL XERBLA( 'ZQRT15', 1 )
00309                RETURN
00310             END IF
00311          END IF
00312       END IF
00313 *
00314       NORMA = DASUM( MN, S, 1 )
00315       NORMB = ZLANGE( 'One-norm', M, NRHS, B, LDB, DUMMY )
00316 *
00317       RETURN
00318 *
00319 *     End of ZQRT15
00320 *
00321       END
 All Files Functions