LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
zqrt13.f
Go to the documentation of this file.
00001 *> \brief \b ZQRT13
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 ZQRT13( SCALE, M, N, A, LDA, NORMA, ISEED )
00012 * 
00013 *       .. Scalar Arguments ..
00014 *       INTEGER            LDA, M, N, SCALE
00015 *       DOUBLE PRECISION   NORMA
00016 *       ..
00017 *       .. Array Arguments ..
00018 *       INTEGER            ISEED( 4 )
00019 *       COMPLEX*16         A( LDA, * )
00020 *       ..
00021 *  
00022 *
00023 *> \par Purpose:
00024 *  =============
00025 *>
00026 *> \verbatim
00027 *>
00028 *> ZQRT13 generates a full-rank matrix that may be scaled to have large
00029 *> or small norm.
00030 *> \endverbatim
00031 *
00032 *  Arguments:
00033 *  ==========
00034 *
00035 *> \param[in] SCALE
00036 *> \verbatim
00037 *>          SCALE is INTEGER
00038 *>          SCALE = 1: normally scaled matrix
00039 *>          SCALE = 2: matrix scaled up
00040 *>          SCALE = 3: matrix scaled down
00041 *> \endverbatim
00042 *>
00043 *> \param[in] M
00044 *> \verbatim
00045 *>          M is INTEGER
00046 *>          The number of rows of the matrix A.
00047 *> \endverbatim
00048 *>
00049 *> \param[in] N
00050 *> \verbatim
00051 *>          N is INTEGER
00052 *>          The number of columns of A.
00053 *> \endverbatim
00054 *>
00055 *> \param[out] A
00056 *> \verbatim
00057 *>          A is COMPLEX*16 array, dimension (LDA,N)
00058 *>          The M-by-N matrix A.
00059 *> \endverbatim
00060 *>
00061 *> \param[in] LDA
00062 *> \verbatim
00063 *>          LDA is INTEGER
00064 *>          The leading dimension of the array A.
00065 *> \endverbatim
00066 *>
00067 *> \param[out] NORMA
00068 *> \verbatim
00069 *>          NORMA is DOUBLE PRECISION
00070 *>          The one-norm of A.
00071 *> \endverbatim
00072 *>
00073 *> \param[in,out] ISEED
00074 *> \verbatim
00075 *>          ISEED is integer array, dimension (4)
00076 *>          Seed for random number generator
00077 *> \endverbatim
00078 *
00079 *  Authors:
00080 *  ========
00081 *
00082 *> \author Univ. of Tennessee 
00083 *> \author Univ. of California Berkeley 
00084 *> \author Univ. of Colorado Denver 
00085 *> \author NAG Ltd. 
00086 *
00087 *> \date November 2011
00088 *
00089 *> \ingroup complex16_lin
00090 *
00091 *  =====================================================================
00092       SUBROUTINE ZQRT13( SCALE, M, N, A, LDA, NORMA, ISEED )
00093 *
00094 *  -- LAPACK test routine (version 3.4.0) --
00095 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00096 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00097 *     November 2011
00098 *
00099 *     .. Scalar Arguments ..
00100       INTEGER            LDA, M, N, SCALE
00101       DOUBLE PRECISION   NORMA
00102 *     ..
00103 *     .. Array Arguments ..
00104       INTEGER            ISEED( 4 )
00105       COMPLEX*16         A( LDA, * )
00106 *     ..
00107 *
00108 *  =====================================================================
00109 *
00110 *     .. Parameters ..
00111       DOUBLE PRECISION   ONE
00112       PARAMETER          ( ONE = 1.0D0 )
00113 *     ..
00114 *     .. Local Scalars ..
00115       INTEGER            INFO, J
00116       DOUBLE PRECISION   BIGNUM, SMLNUM
00117 *     ..
00118 *     .. External Functions ..
00119       DOUBLE PRECISION   DLAMCH, DZASUM, ZLANGE
00120       EXTERNAL           DLAMCH, DZASUM, ZLANGE
00121 *     ..
00122 *     .. External Subroutines ..
00123       EXTERNAL           DLABAD, ZLARNV, ZLASCL
00124 *     ..
00125 *     .. Intrinsic Functions ..
00126       INTRINSIC          DBLE, DCMPLX, SIGN
00127 *     ..
00128 *     .. Local Arrays ..
00129       DOUBLE PRECISION   DUMMY( 1 )
00130 *     ..
00131 *     .. Executable Statements ..
00132 *
00133       IF( M.LE.0 .OR. N.LE.0 )
00134      $   RETURN
00135 *
00136 *     benign matrix
00137 *
00138       DO 10 J = 1, N
00139          CALL ZLARNV( 2, ISEED, M, A( 1, J ) )
00140          IF( J.LE.M ) THEN
00141             A( J, J ) = A( J, J ) + DCMPLX( SIGN( DZASUM( M, A( 1, J ),
00142      $                  1 ), DBLE( A( J, J ) ) ) )
00143          END IF
00144    10 CONTINUE
00145 *
00146 *     scaled versions
00147 *
00148       IF( SCALE.NE.1 ) THEN
00149          NORMA = ZLANGE( 'Max', M, N, A, LDA, DUMMY )
00150          SMLNUM = DLAMCH( 'Safe minimum' )
00151          BIGNUM = ONE / SMLNUM
00152          CALL DLABAD( SMLNUM, BIGNUM )
00153          SMLNUM = SMLNUM / DLAMCH( 'Epsilon' )
00154          BIGNUM = ONE / SMLNUM
00155 *
00156          IF( SCALE.EQ.2 ) THEN
00157 *
00158 *           matrix scaled up
00159 *
00160             CALL ZLASCL( 'General', 0, 0, NORMA, BIGNUM, M, N, A, LDA,
00161      $                   INFO )
00162          ELSE IF( SCALE.EQ.3 ) THEN
00163 *
00164 *           matrix scaled down
00165 *
00166             CALL ZLASCL( 'General', 0, 0, NORMA, SMLNUM, M, N, A, LDA,
00167      $                   INFO )
00168          END IF
00169       END IF
00170 *
00171       NORMA = ZLANGE( 'One-norm', M, N, A, LDA, DUMMY )
00172       RETURN
00173 *
00174 *     End of ZQRT13
00175 *
00176       END
 All Files Functions