LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
clantr.f
Go to the documentation of this file.
00001 *> \brief \b CLANTR
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download CLANTR + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clantr.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clantr.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clantr.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       REAL             FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A, LDA,
00022 *                        WORK )
00023 * 
00024 *       .. Scalar Arguments ..
00025 *       CHARACTER          DIAG, NORM, UPLO
00026 *       INTEGER            LDA, M, N
00027 *       ..
00028 *       .. Array Arguments ..
00029 *       REAL               WORK( * )
00030 *       COMPLEX            A( LDA, * )
00031 *       ..
00032 *  
00033 *
00034 *> \par Purpose:
00035 *  =============
00036 *>
00037 *> \verbatim
00038 *>
00039 *> CLANTR  returns the value of the one norm,  or the Frobenius norm, or
00040 *> the  infinity norm,  or the  element of  largest absolute value  of a
00041 *> trapezoidal or triangular matrix A.
00042 *> \endverbatim
00043 *>
00044 *> \return CLANTR
00045 *> \verbatim
00046 *>
00047 *>    CLANTR = ( max(abs(A(i,j))), NORM = 'M' or 'm'
00048 *>             (
00049 *>             ( norm1(A),         NORM = '1', 'O' or 'o'
00050 *>             (
00051 *>             ( normI(A),         NORM = 'I' or 'i'
00052 *>             (
00053 *>             ( normF(A),         NORM = 'F', 'f', 'E' or 'e'
00054 *>
00055 *> where  norm1  denotes the  one norm of a matrix (maximum column sum),
00056 *> normI  denotes the  infinity norm  of a matrix  (maximum row sum) and
00057 *> normF  denotes the  Frobenius norm of a matrix (square root of sum of
00058 *> squares).  Note that  max(abs(A(i,j)))  is not a consistent matrix norm.
00059 *> \endverbatim
00060 *
00061 *  Arguments:
00062 *  ==========
00063 *
00064 *> \param[in] NORM
00065 *> \verbatim
00066 *>          NORM is CHARACTER*1
00067 *>          Specifies the value to be returned in CLANTR as described
00068 *>          above.
00069 *> \endverbatim
00070 *>
00071 *> \param[in] UPLO
00072 *> \verbatim
00073 *>          UPLO is CHARACTER*1
00074 *>          Specifies whether the matrix A is upper or lower trapezoidal.
00075 *>          = 'U':  Upper trapezoidal
00076 *>          = 'L':  Lower trapezoidal
00077 *>          Note that A is triangular instead of trapezoidal if M = N.
00078 *> \endverbatim
00079 *>
00080 *> \param[in] DIAG
00081 *> \verbatim
00082 *>          DIAG is CHARACTER*1
00083 *>          Specifies whether or not the matrix A has unit diagonal.
00084 *>          = 'N':  Non-unit diagonal
00085 *>          = 'U':  Unit diagonal
00086 *> \endverbatim
00087 *>
00088 *> \param[in] M
00089 *> \verbatim
00090 *>          M is INTEGER
00091 *>          The number of rows of the matrix A.  M >= 0, and if
00092 *>          UPLO = 'U', M <= N.  When M = 0, CLANTR is set to zero.
00093 *> \endverbatim
00094 *>
00095 *> \param[in] N
00096 *> \verbatim
00097 *>          N is INTEGER
00098 *>          The number of columns of the matrix A.  N >= 0, and if
00099 *>          UPLO = 'L', N <= M.  When N = 0, CLANTR is set to zero.
00100 *> \endverbatim
00101 *>
00102 *> \param[in] A
00103 *> \verbatim
00104 *>          A is COMPLEX array, dimension (LDA,N)
00105 *>          The trapezoidal matrix A (A is triangular if M = N).
00106 *>          If UPLO = 'U', the leading m by n upper trapezoidal part of
00107 *>          the array A contains the upper trapezoidal matrix, and the
00108 *>          strictly lower triangular part of A is not referenced.
00109 *>          If UPLO = 'L', the leading m by n lower trapezoidal part of
00110 *>          the array A contains the lower trapezoidal matrix, and the
00111 *>          strictly upper triangular part of A is not referenced.  Note
00112 *>          that when DIAG = 'U', the diagonal elements of A are not
00113 *>          referenced and are assumed to be one.
00114 *> \endverbatim
00115 *>
00116 *> \param[in] LDA
00117 *> \verbatim
00118 *>          LDA is INTEGER
00119 *>          The leading dimension of the array A.  LDA >= max(M,1).
00120 *> \endverbatim
00121 *>
00122 *> \param[out] WORK
00123 *> \verbatim
00124 *>          WORK is REAL array, dimension (MAX(1,LWORK)),
00125 *>          where LWORK >= M when NORM = 'I'; otherwise, WORK is not
00126 *>          referenced.
00127 *> \endverbatim
00128 *
00129 *  Authors:
00130 *  ========
00131 *
00132 *> \author Univ. of Tennessee 
00133 *> \author Univ. of California Berkeley 
00134 *> \author Univ. of Colorado Denver 
00135 *> \author NAG Ltd. 
00136 *
00137 *> \date November 2011
00138 *
00139 *> \ingroup complexOTHERauxiliary
00140 *
00141 *  =====================================================================
00142       REAL             FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A, LDA,
00143      $                 WORK )
00144 *
00145 *  -- LAPACK auxiliary routine (version 3.4.0) --
00146 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00147 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00148 *     November 2011
00149 *
00150 *     .. Scalar Arguments ..
00151       CHARACTER          DIAG, NORM, UPLO
00152       INTEGER            LDA, M, N
00153 *     ..
00154 *     .. Array Arguments ..
00155       REAL               WORK( * )
00156       COMPLEX            A( LDA, * )
00157 *     ..
00158 *
00159 * =====================================================================
00160 *
00161 *     .. Parameters ..
00162       REAL               ONE, ZERO
00163       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
00164 *     ..
00165 *     .. Local Scalars ..
00166       LOGICAL            UDIAG
00167       INTEGER            I, J
00168       REAL               SCALE, SUM, VALUE
00169 *     ..
00170 *     .. External Functions ..
00171       LOGICAL            LSAME
00172       EXTERNAL           LSAME
00173 *     ..
00174 *     .. External Subroutines ..
00175       EXTERNAL           CLASSQ
00176 *     ..
00177 *     .. Intrinsic Functions ..
00178       INTRINSIC          ABS, MAX, MIN, SQRT
00179 *     ..
00180 *     .. Executable Statements ..
00181 *
00182       IF( MIN( M, N ).EQ.0 ) THEN
00183          VALUE = ZERO
00184       ELSE IF( LSAME( NORM, 'M' ) ) THEN
00185 *
00186 *        Find max(abs(A(i,j))).
00187 *
00188          IF( LSAME( DIAG, 'U' ) ) THEN
00189             VALUE = ONE
00190             IF( LSAME( UPLO, 'U' ) ) THEN
00191                DO 20 J = 1, N
00192                   DO 10 I = 1, MIN( M, J-1 )
00193                      VALUE = MAX( VALUE, ABS( A( I, J ) ) )
00194    10             CONTINUE
00195    20          CONTINUE
00196             ELSE
00197                DO 40 J = 1, N
00198                   DO 30 I = J + 1, M
00199                      VALUE = MAX( VALUE, ABS( A( I, J ) ) )
00200    30             CONTINUE
00201    40          CONTINUE
00202             END IF
00203          ELSE
00204             VALUE = ZERO
00205             IF( LSAME( UPLO, 'U' ) ) THEN
00206                DO 60 J = 1, N
00207                   DO 50 I = 1, MIN( M, J )
00208                      VALUE = MAX( VALUE, ABS( A( I, J ) ) )
00209    50             CONTINUE
00210    60          CONTINUE
00211             ELSE
00212                DO 80 J = 1, N
00213                   DO 70 I = J, M
00214                      VALUE = MAX( VALUE, ABS( A( I, J ) ) )
00215    70             CONTINUE
00216    80          CONTINUE
00217             END IF
00218          END IF
00219       ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
00220 *
00221 *        Find norm1(A).
00222 *
00223          VALUE = ZERO
00224          UDIAG = LSAME( DIAG, 'U' )
00225          IF( LSAME( UPLO, 'U' ) ) THEN
00226             DO 110 J = 1, N
00227                IF( ( UDIAG ) .AND. ( J.LE.M ) ) THEN
00228                   SUM = ONE
00229                   DO 90 I = 1, J - 1
00230                      SUM = SUM + ABS( A( I, J ) )
00231    90             CONTINUE
00232                ELSE
00233                   SUM = ZERO
00234                   DO 100 I = 1, MIN( M, J )
00235                      SUM = SUM + ABS( A( I, J ) )
00236   100             CONTINUE
00237                END IF
00238                VALUE = MAX( VALUE, SUM )
00239   110       CONTINUE
00240          ELSE
00241             DO 140 J = 1, N
00242                IF( UDIAG ) THEN
00243                   SUM = ONE
00244                   DO 120 I = J + 1, M
00245                      SUM = SUM + ABS( A( I, J ) )
00246   120             CONTINUE
00247                ELSE
00248                   SUM = ZERO
00249                   DO 130 I = J, M
00250                      SUM = SUM + ABS( A( I, J ) )
00251   130             CONTINUE
00252                END IF
00253                VALUE = MAX( VALUE, SUM )
00254   140       CONTINUE
00255          END IF
00256       ELSE IF( LSAME( NORM, 'I' ) ) THEN
00257 *
00258 *        Find normI(A).
00259 *
00260          IF( LSAME( UPLO, 'U' ) ) THEN
00261             IF( LSAME( DIAG, 'U' ) ) THEN
00262                DO 150 I = 1, M
00263                   WORK( I ) = ONE
00264   150          CONTINUE
00265                DO 170 J = 1, N
00266                   DO 160 I = 1, MIN( M, J-1 )
00267                      WORK( I ) = WORK( I ) + ABS( A( I, J ) )
00268   160             CONTINUE
00269   170          CONTINUE
00270             ELSE
00271                DO 180 I = 1, M
00272                   WORK( I ) = ZERO
00273   180          CONTINUE
00274                DO 200 J = 1, N
00275                   DO 190 I = 1, MIN( M, J )
00276                      WORK( I ) = WORK( I ) + ABS( A( I, J ) )
00277   190             CONTINUE
00278   200          CONTINUE
00279             END IF
00280          ELSE
00281             IF( LSAME( DIAG, 'U' ) ) THEN
00282                DO 210 I = 1, N
00283                   WORK( I ) = ONE
00284   210          CONTINUE
00285                DO 220 I = N + 1, M
00286                   WORK( I ) = ZERO
00287   220          CONTINUE
00288                DO 240 J = 1, N
00289                   DO 230 I = J + 1, M
00290                      WORK( I ) = WORK( I ) + ABS( A( I, J ) )
00291   230             CONTINUE
00292   240          CONTINUE
00293             ELSE
00294                DO 250 I = 1, M
00295                   WORK( I ) = ZERO
00296   250          CONTINUE
00297                DO 270 J = 1, N
00298                   DO 260 I = J, M
00299                      WORK( I ) = WORK( I ) + ABS( A( I, J ) )
00300   260             CONTINUE
00301   270          CONTINUE
00302             END IF
00303          END IF
00304          VALUE = ZERO
00305          DO 280 I = 1, M
00306             VALUE = MAX( VALUE, WORK( I ) )
00307   280    CONTINUE
00308       ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
00309 *
00310 *        Find normF(A).
00311 *
00312          IF( LSAME( UPLO, 'U' ) ) THEN
00313             IF( LSAME( DIAG, 'U' ) ) THEN
00314                SCALE = ONE
00315                SUM = MIN( M, N )
00316                DO 290 J = 2, N
00317                   CALL CLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, SUM )
00318   290          CONTINUE
00319             ELSE
00320                SCALE = ZERO
00321                SUM = ONE
00322                DO 300 J = 1, N
00323                   CALL CLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, SUM )
00324   300          CONTINUE
00325             END IF
00326          ELSE
00327             IF( LSAME( DIAG, 'U' ) ) THEN
00328                SCALE = ONE
00329                SUM = MIN( M, N )
00330                DO 310 J = 1, N
00331                   CALL CLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, SCALE,
00332      $                         SUM )
00333   310          CONTINUE
00334             ELSE
00335                SCALE = ZERO
00336                SUM = ONE
00337                DO 320 J = 1, N
00338                   CALL CLASSQ( M-J+1, A( J, J ), 1, SCALE, SUM )
00339   320          CONTINUE
00340             END IF
00341          END IF
00342          VALUE = SCALE*SQRT( SUM )
00343       END IF
00344 *
00345       CLANTR = VALUE
00346       RETURN
00347 *
00348 *     End of CLANTR
00349 *
00350       END
 All Files Functions