1*> \brief \b DQRT13 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8* Definition: 9* =========== 10* 11* SUBROUTINE DQRT13( SCALE, M, N, A, LDA, NORMA, ISEED ) 12* 13* .. Scalar Arguments .. 14* INTEGER LDA, M, N, SCALE 15* DOUBLE PRECISION NORMA 16* .. 17* .. Array Arguments .. 18* INTEGER ISEED( 4 ) 19* DOUBLE PRECISION A( LDA, * ) 20* .. 21* 22* 23*> \par Purpose: 24* ============= 25*> 26*> \verbatim 27*> 28*> DQRT13 generates a full-rank matrix that may be scaled to have large 29*> or small norm. 30*> \endverbatim 31* 32* Arguments: 33* ========== 34* 35*> \param[in] SCALE 36*> \verbatim 37*> SCALE is INTEGER 38*> SCALE = 1: normally scaled matrix 39*> SCALE = 2: matrix scaled up 40*> SCALE = 3: matrix scaled down 41*> \endverbatim 42*> 43*> \param[in] M 44*> \verbatim 45*> M is INTEGER 46*> The number of rows of the matrix A. 47*> \endverbatim 48*> 49*> \param[in] N 50*> \verbatim 51*> N is INTEGER 52*> The number of columns of A. 53*> \endverbatim 54*> 55*> \param[out] A 56*> \verbatim 57*> A is DOUBLE PRECISION array, dimension (LDA,N) 58*> The M-by-N matrix A. 59*> \endverbatim 60*> 61*> \param[in] LDA 62*> \verbatim 63*> LDA is INTEGER 64*> The leading dimension of the array A. 65*> \endverbatim 66*> 67*> \param[out] NORMA 68*> \verbatim 69*> NORMA is DOUBLE PRECISION 70*> The one-norm of A. 71*> \endverbatim 72*> 73*> \param[in,out] ISEED 74*> \verbatim 75*> ISEED is integer array, dimension (4) 76*> Seed for random number generator 77*> \endverbatim 78* 79* Authors: 80* ======== 81* 82*> \author Univ. of Tennessee 83*> \author Univ. of California Berkeley 84*> \author Univ. of Colorado Denver 85*> \author NAG Ltd. 86* 87*> \date November 2011 88* 89*> \ingroup double_lin 90* 91* ===================================================================== 92 SUBROUTINE DQRT13( SCALE, M, N, A, LDA, NORMA, ISEED ) 93* 94* -- LAPACK test routine (version 3.4.0) -- 95* -- LAPACK is a software package provided by Univ. of Tennessee, -- 96* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 97* November 2011 98* 99* .. Scalar Arguments .. 100 INTEGER LDA, M, N, SCALE 101 DOUBLE PRECISION NORMA 102* .. 103* .. Array Arguments .. 104 INTEGER ISEED( 4 ) 105 DOUBLE PRECISION A( LDA, * ) 106* .. 107* 108* ===================================================================== 109* 110* .. Parameters .. 111 DOUBLE PRECISION ONE 112 PARAMETER ( ONE = 1.0D0 ) 113* .. 114* .. Local Scalars .. 115 INTEGER INFO, J 116 DOUBLE PRECISION BIGNUM, SMLNUM 117* .. 118* .. External Functions .. 119 DOUBLE PRECISION DASUM, DLAMCH, DLANGE 120 EXTERNAL DASUM, DLAMCH, DLANGE 121* .. 122* .. External Subroutines .. 123 EXTERNAL DLABAD, DLARNV, DLASCL 124* .. 125* .. Intrinsic Functions .. 126 INTRINSIC SIGN 127* .. 128* .. Local Arrays .. 129 DOUBLE PRECISION DUMMY( 1 ) 130* .. 131* .. Executable Statements .. 132* 133 IF( M.LE.0 .OR. N.LE.0 ) 134 $ RETURN 135* 136* benign matrix 137* 138 DO 10 J = 1, N 139 CALL DLARNV( 2, ISEED, M, A( 1, J ) ) 140 IF( J.LE.M ) THEN 141 A( J, J ) = A( J, J ) + SIGN( DASUM( M, A( 1, J ), 1 ), 142 $ A( J, J ) ) 143 END IF 144 10 CONTINUE 145* 146* scaled versions 147* 148 IF( SCALE.NE.1 ) THEN 149 NORMA = DLANGE( 'Max', M, N, A, LDA, DUMMY ) 150 SMLNUM = DLAMCH( 'Safe minimum' ) 151 BIGNUM = ONE / SMLNUM 152 CALL DLABAD( SMLNUM, BIGNUM ) 153 SMLNUM = SMLNUM / DLAMCH( 'Epsilon' ) 154 BIGNUM = ONE / SMLNUM 155* 156 IF( SCALE.EQ.2 ) THEN 157* 158* matrix scaled up 159* 160 CALL DLASCL( 'General', 0, 0, NORMA, BIGNUM, M, N, A, LDA, 161 $ INFO ) 162 ELSE IF( SCALE.EQ.3 ) THEN 163* 164* matrix scaled down 165* 166 CALL DLASCL( 'General', 0, 0, NORMA, SMLNUM, M, N, A, LDA, 167 $ INFO ) 168 END IF 169 END IF 170* 171 NORMA = DLANGE( 'One-norm', M, N, A, LDA, DUMMY ) 172 RETURN 173* 174* End of DQRT13 175* 176 END 177