LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
clanhf.f
Go to the documentation of this file.
00001 *> \brief \b CLANHF
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download CLANHF + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clanhf.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clanhf.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clanhf.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       REAL FUNCTION CLANHF( NORM, TRANSR, UPLO, N, A, WORK )
00022 * 
00023 *       .. Scalar Arguments ..
00024 *       CHARACTER          NORM, TRANSR, UPLO
00025 *       INTEGER            N
00026 *       ..
00027 *       .. Array Arguments ..
00028 *       REAL               WORK( 0: * )
00029 *       COMPLEX            A( 0: * )
00030 *       ..
00031 *  
00032 *
00033 *> \par Purpose:
00034 *  =============
00035 *>
00036 *> \verbatim
00037 *>
00038 *> CLANHF  returns the value of the one norm,  or the Frobenius norm, or
00039 *> the  infinity norm,  or the  element of  largest absolute value  of a
00040 *> complex Hermitian matrix A in RFP format.
00041 *> \endverbatim
00042 *>
00043 *> \return CLANHF
00044 *> \verbatim
00045 *>
00046 *>    CLANHF = ( max(abs(A(i,j))), NORM = 'M' or 'm'
00047 *>             (
00048 *>             ( norm1(A),         NORM = '1', 'O' or 'o'
00049 *>             (
00050 *>             ( normI(A),         NORM = 'I' or 'i'
00051 *>             (
00052 *>             ( normF(A),         NORM = 'F', 'f', 'E' or 'e'
00053 *>
00054 *> where  norm1  denotes the  one norm of a matrix (maximum column sum),
00055 *> normI  denotes the  infinity norm  of a matrix  (maximum row sum) and
00056 *> normF  denotes the  Frobenius norm of a matrix (square root of sum of
00057 *> squares).  Note that  max(abs(A(i,j)))  is not a  matrix norm.
00058 *> \endverbatim
00059 *
00060 *  Arguments:
00061 *  ==========
00062 *
00063 *> \param[in] NORM
00064 *> \verbatim
00065 *>          NORM is CHARACTER
00066 *>            Specifies the value to be returned in CLANHF as described
00067 *>            above.
00068 *> \endverbatim
00069 *>
00070 *> \param[in] TRANSR
00071 *> \verbatim
00072 *>          TRANSR is CHARACTER
00073 *>            Specifies whether the RFP format of A is normal or
00074 *>            conjugate-transposed format.
00075 *>            = 'N':  RFP format is Normal
00076 *>            = 'C':  RFP format is Conjugate-transposed
00077 *> \endverbatim
00078 *>
00079 *> \param[in] UPLO
00080 *> \verbatim
00081 *>          UPLO is CHARACTER
00082 *>            On entry, UPLO specifies whether the RFP matrix A came from
00083 *>            an upper or lower triangular matrix as follows:
00084 *>
00085 *>            UPLO = 'U' or 'u' RFP A came from an upper triangular
00086 *>            matrix
00087 *>
00088 *>            UPLO = 'L' or 'l' RFP A came from a  lower triangular
00089 *>            matrix
00090 *> \endverbatim
00091 *>
00092 *> \param[in] N
00093 *> \verbatim
00094 *>          N is INTEGER
00095 *>            The order of the matrix A.  N >= 0.  When N = 0, CLANHF is
00096 *>            set to zero.
00097 *> \endverbatim
00098 *>
00099 *> \param[in] A
00100 *> \verbatim
00101 *>          A is COMPLEX*16 array, dimension ( N*(N+1)/2 );
00102 *>            On entry, the matrix A in RFP Format.
00103 *>            RFP Format is described by TRANSR, UPLO and N as follows:
00104 *>            If TRANSR='N' then RFP A is (0:N,0:K-1) when N is even;
00105 *>            K=N/2. RFP A is (0:N-1,0:K) when N is odd; K=N/2. If
00106 *>            TRANSR = 'C' then RFP is the Conjugate-transpose of RFP A
00107 *>            as defined when TRANSR = 'N'. The contents of RFP A are
00108 *>            defined by UPLO as follows: If UPLO = 'U' the RFP A
00109 *>            contains the ( N*(N+1)/2 ) elements of upper packed A
00110 *>            either in normal or conjugate-transpose Format. If
00111 *>            UPLO = 'L' the RFP A contains the ( N*(N+1) /2 ) elements
00112 *>            of lower packed A either in normal or conjugate-transpose
00113 *>            Format. The LDA of RFP A is (N+1)/2 when TRANSR = 'C'. When
00114 *>            TRANSR is 'N' the LDA is N+1 when N is even and is N when
00115 *>            is odd. See the Note below for more details.
00116 *>            Unchanged on exit.
00117 *> \endverbatim
00118 *>
00119 *> \param[out] WORK
00120 *> \verbatim
00121 *>          WORK is REAL array, dimension (LWORK),
00122 *>            where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
00123 *>            WORK is not referenced.
00124 *> \endverbatim
00125 *
00126 *  Authors:
00127 *  ========
00128 *
00129 *> \author Univ. of Tennessee 
00130 *> \author Univ. of California Berkeley 
00131 *> \author Univ. of Colorado Denver 
00132 *> \author NAG Ltd. 
00133 *
00134 *> \date November 2011
00135 *
00136 *> \ingroup complexOTHERcomputational
00137 *
00138 *> \par Further Details:
00139 *  =====================
00140 *>
00141 *> \verbatim
00142 *>
00143 *>  We first consider Standard Packed Format when N is even.
00144 *>  We give an example where N = 6.
00145 *>
00146 *>      AP is Upper             AP is Lower
00147 *>
00148 *>   00 01 02 03 04 05       00
00149 *>      11 12 13 14 15       10 11
00150 *>         22 23 24 25       20 21 22
00151 *>            33 34 35       30 31 32 33
00152 *>               44 45       40 41 42 43 44
00153 *>                  55       50 51 52 53 54 55
00154 *>
00155 *>
00156 *>  Let TRANSR = 'N'. RFP holds AP as follows:
00157 *>  For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
00158 *>  three columns of AP upper. The lower triangle A(4:6,0:2) consists of
00159 *>  conjugate-transpose of the first three columns of AP upper.
00160 *>  For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
00161 *>  three columns of AP lower. The upper triangle A(0:2,0:2) consists of
00162 *>  conjugate-transpose of the last three columns of AP lower.
00163 *>  To denote conjugate we place -- above the element. This covers the
00164 *>  case N even and TRANSR = 'N'.
00165 *>
00166 *>         RFP A                   RFP A
00167 *>
00168 *>                                -- -- --
00169 *>        03 04 05                33 43 53
00170 *>                                   -- --
00171 *>        13 14 15                00 44 54
00172 *>                                      --
00173 *>        23 24 25                10 11 55
00174 *>
00175 *>        33 34 35                20 21 22
00176 *>        --
00177 *>        00 44 45                30 31 32
00178 *>        -- --
00179 *>        01 11 55                40 41 42
00180 *>        -- -- --
00181 *>        02 12 22                50 51 52
00182 *>
00183 *>  Now let TRANSR = 'C'. RFP A in both UPLO cases is just the conjugate-
00184 *>  transpose of RFP A above. One therefore gets:
00185 *>
00186 *>
00187 *>           RFP A                   RFP A
00188 *>
00189 *>     -- -- -- --                -- -- -- -- -- --
00190 *>     03 13 23 33 00 01 02    33 00 10 20 30 40 50
00191 *>     -- -- -- -- --                -- -- -- -- --
00192 *>     04 14 24 34 44 11 12    43 44 11 21 31 41 51
00193 *>     -- -- -- -- -- --                -- -- -- --
00194 *>     05 15 25 35 45 55 22    53 54 55 22 32 42 52
00195 *>
00196 *>
00197 *>  We next  consider Standard Packed Format when N is odd.
00198 *>  We give an example where N = 5.
00199 *>
00200 *>     AP is Upper                 AP is Lower
00201 *>
00202 *>   00 01 02 03 04              00
00203 *>      11 12 13 14              10 11
00204 *>         22 23 24              20 21 22
00205 *>            33 34              30 31 32 33
00206 *>               44              40 41 42 43 44
00207 *>
00208 *>
00209 *>  Let TRANSR = 'N'. RFP holds AP as follows:
00210 *>  For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
00211 *>  three columns of AP upper. The lower triangle A(3:4,0:1) consists of
00212 *>  conjugate-transpose of the first two   columns of AP upper.
00213 *>  For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
00214 *>  three columns of AP lower. The upper triangle A(0:1,1:2) consists of
00215 *>  conjugate-transpose of the last two   columns of AP lower.
00216 *>  To denote conjugate we place -- above the element. This covers the
00217 *>  case N odd  and TRANSR = 'N'.
00218 *>
00219 *>         RFP A                   RFP A
00220 *>
00221 *>                                   -- --
00222 *>        02 03 04                00 33 43
00223 *>                                      --
00224 *>        12 13 14                10 11 44
00225 *>
00226 *>        22 23 24                20 21 22
00227 *>        --
00228 *>        00 33 34                30 31 32
00229 *>        -- --
00230 *>        01 11 44                40 41 42
00231 *>
00232 *>  Now let TRANSR = 'C'. RFP A in both UPLO cases is just the conjugate-
00233 *>  transpose of RFP A above. One therefore gets:
00234 *>
00235 *>
00236 *>           RFP A                   RFP A
00237 *>
00238 *>     -- -- --                   -- -- -- -- -- --
00239 *>     02 12 22 00 01             00 10 20 30 40 50
00240 *>     -- -- -- --                   -- -- -- -- --
00241 *>     03 13 23 33 11             33 11 21 31 41 51
00242 *>     -- -- -- -- --                   -- -- -- --
00243 *>     04 14 24 34 44             43 44 22 32 42 52
00244 *> \endverbatim
00245 *>
00246 *  =====================================================================
00247       REAL FUNCTION CLANHF( NORM, TRANSR, UPLO, N, A, WORK )
00248 *
00249 *  -- LAPACK computational routine (version 3.4.0) --
00250 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00251 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00252 *     November 2011
00253 *
00254 *     .. Scalar Arguments ..
00255       CHARACTER          NORM, TRANSR, UPLO
00256       INTEGER            N
00257 *     ..
00258 *     .. Array Arguments ..
00259       REAL               WORK( 0: * )
00260       COMPLEX            A( 0: * )
00261 *     ..
00262 *
00263 *  =====================================================================
00264 *
00265 *     .. Parameters ..
00266       REAL               ONE, ZERO
00267       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
00268 *     ..
00269 *     .. Local Scalars ..
00270       INTEGER            I, J, IFM, ILU, NOE, N1, K, L, LDA
00271       REAL               SCALE, S, VALUE, AA
00272 *     ..
00273 *     .. External Functions ..
00274       LOGICAL            LSAME
00275       INTEGER            ISAMAX
00276       EXTERNAL           LSAME, ISAMAX
00277 *     ..
00278 *     .. External Subroutines ..
00279       EXTERNAL           CLASSQ
00280 *     ..
00281 *     .. Intrinsic Functions ..
00282       INTRINSIC          ABS, REAL, MAX, SQRT
00283 *     ..
00284 *     .. Executable Statements ..
00285 *
00286       IF( N.EQ.0 ) THEN
00287          CLANHF = ZERO
00288          RETURN
00289       ELSE IF( N.EQ.1 ) THEN
00290          CLANHF = ABS( A(0) )
00291          RETURN
00292       END IF
00293 *
00294 *     set noe = 1 if n is odd. if n is even set noe=0
00295 *
00296       NOE = 1
00297       IF( MOD( N, 2 ).EQ.0 )
00298      $   NOE = 0
00299 *
00300 *     set ifm = 0 when form='C' or 'c' and 1 otherwise
00301 *
00302       IFM = 1
00303       IF( LSAME( TRANSR, 'C' ) )
00304      $   IFM = 0
00305 *
00306 *     set ilu = 0 when uplo='U or 'u' and 1 otherwise
00307 *
00308       ILU = 1
00309       IF( LSAME( UPLO, 'U' ) )
00310      $   ILU = 0
00311 *
00312 *     set lda = (n+1)/2 when ifm = 0
00313 *     set lda = n when ifm = 1 and noe = 1
00314 *     set lda = n+1 when ifm = 1 and noe = 0
00315 *
00316       IF( IFM.EQ.1 ) THEN
00317          IF( NOE.EQ.1 ) THEN
00318             LDA = N
00319          ELSE
00320 *           noe=0
00321             LDA = N + 1
00322          END IF
00323       ELSE
00324 *        ifm=0
00325          LDA = ( N+1 ) / 2
00326       END IF
00327 *
00328       IF( LSAME( NORM, 'M' ) ) THEN
00329 *
00330 *       Find max(abs(A(i,j))).
00331 *
00332          K = ( N+1 ) / 2
00333          VALUE = ZERO
00334          IF( NOE.EQ.1 ) THEN
00335 *           n is odd & n = k + k - 1
00336             IF( IFM.EQ.1 ) THEN
00337 *              A is n by k
00338                IF( ILU.EQ.1 ) THEN
00339 *                 uplo ='L'
00340                   J = 0
00341 *                 -> L(0,0)
00342                   VALUE = MAX( VALUE, ABS( REAL( A( J+J*LDA ) ) ) )
00343                   DO I = 1, N - 1
00344                      VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00345                   END DO
00346                   DO J = 1, K - 1
00347                      DO I = 0, J - 2
00348                         VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00349                      END DO
00350                      I = J - 1
00351 *                    L(k+j,k+j)
00352                      VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) )
00353                      I = J
00354 *                    -> L(j,j)
00355                      VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) )
00356                      DO I = J + 1, N - 1
00357                         VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00358                      END DO
00359                   END DO
00360                ELSE
00361 *                 uplo = 'U'
00362                   DO J = 0, K - 2
00363                      DO I = 0, K + J - 2
00364                         VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00365                      END DO
00366                      I = K + J - 1
00367 *                    -> U(i,i)
00368                      VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) )
00369                      I = I + 1
00370 *                    =k+j; i -> U(j,j)
00371                      VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) )
00372                      DO I = K + J + 1, N - 1
00373                         VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00374                      END DO
00375                   END DO
00376                   DO I = 0, N - 2
00377                      VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00378 *                    j=k-1
00379                   END DO
00380 *                 i=n-1 -> U(n-1,n-1)
00381                   VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) )
00382                END IF
00383             ELSE
00384 *              xpose case; A is k by n
00385                IF( ILU.EQ.1 ) THEN
00386 *                 uplo ='L'
00387                   DO J = 0, K - 2
00388                      DO I = 0, J - 1
00389                         VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00390                      END DO
00391                      I = J
00392 *                    L(i,i)
00393                      VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) )
00394                      I = J + 1
00395 *                    L(j+k,j+k)
00396                      VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) )
00397                      DO I = J + 2, K - 1
00398                         VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00399                      END DO
00400                   END DO
00401                   J = K - 1
00402                   DO I = 0, K - 2
00403                      VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00404                   END DO
00405                   I = K - 1
00406 *                 -> L(i,i) is at A(i,j)
00407                   VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) )
00408                   DO J = K, N - 1
00409                      DO I = 0, K - 1
00410                         VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00411                      END DO
00412                   END DO
00413                ELSE
00414 *                 uplo = 'U'
00415                   DO J = 0, K - 2
00416                      DO I = 0, K - 1
00417                         VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00418                      END DO
00419                   END DO
00420                   J = K - 1
00421 *                 -> U(j,j) is at A(0,j)
00422                   VALUE = MAX( VALUE, ABS( REAL( A( 0+J*LDA ) ) ) )
00423                   DO I = 1, K - 1
00424                      VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00425                   END DO
00426                   DO J = K, N - 1
00427                      DO I = 0, J - K - 1
00428                         VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00429                      END DO
00430                      I = J - K
00431 *                    -> U(i,i) at A(i,j)
00432                      VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) )
00433                      I = J - K + 1
00434 *                    U(j,j)
00435                      VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) )
00436                      DO I = J - K + 2, K - 1
00437                         VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00438                      END DO
00439                   END DO
00440                END IF
00441             END IF
00442          ELSE
00443 *           n is even & k = n/2
00444             IF( IFM.EQ.1 ) THEN
00445 *              A is n+1 by k
00446                IF( ILU.EQ.1 ) THEN
00447 *                 uplo ='L'
00448                   J = 0
00449 *                 -> L(k,k) & j=1 -> L(0,0)
00450                   VALUE = MAX( VALUE, ABS( REAL( A( J+J*LDA ) ) ) )
00451                   VALUE = MAX( VALUE, ABS( REAL( A( J+1+J*LDA ) ) ) )
00452                   DO I = 2, N
00453                      VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00454                   END DO
00455                   DO J = 1, K - 1
00456                      DO I = 0, J - 1
00457                         VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00458                      END DO
00459                      I = J
00460 *                    L(k+j,k+j)
00461                      VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) )
00462                      I = J + 1
00463 *                    -> L(j,j)
00464                      VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) )
00465                      DO I = J + 2, N
00466                         VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00467                      END DO
00468                   END DO
00469                ELSE
00470 *                 uplo = 'U'
00471                   DO J = 0, K - 2
00472                      DO I = 0, K + J - 1
00473                         VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00474                      END DO
00475                      I = K + J
00476 *                    -> U(i,i)
00477                      VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) )
00478                      I = I + 1
00479 *                    =k+j+1; i -> U(j,j)
00480                      VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) )
00481                      DO I = K + J + 2, N
00482                         VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00483                      END DO
00484                   END DO
00485                   DO I = 0, N - 2
00486                      VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00487 *                    j=k-1
00488                   END DO
00489 *                 i=n-1 -> U(n-1,n-1)
00490                   VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) )
00491                   I = N
00492 *                 -> U(k-1,k-1)
00493                   VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) )
00494                END IF
00495             ELSE
00496 *              xpose case; A is k by n+1
00497                IF( ILU.EQ.1 ) THEN
00498 *                 uplo ='L'
00499                   J = 0
00500 *                 -> L(k,k) at A(0,0)
00501                   VALUE = MAX( VALUE, ABS( REAL( A( J+J*LDA ) ) ) )
00502                   DO I = 1, K - 1
00503                      VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00504                   END DO
00505                   DO J = 1, K - 1
00506                      DO I = 0, J - 2
00507                         VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00508                      END DO
00509                      I = J - 1
00510 *                    L(i,i)
00511                      VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) )
00512                      I = J
00513 *                    L(j+k,j+k)
00514                      VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) )
00515                      DO I = J + 1, K - 1
00516                         VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00517                      END DO
00518                   END DO
00519                   J = K
00520                   DO I = 0, K - 2
00521                      VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00522                   END DO
00523                   I = K - 1
00524 *                 -> L(i,i) is at A(i,j)
00525                   VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) )
00526                   DO J = K + 1, N
00527                      DO I = 0, K - 1
00528                         VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00529                      END DO
00530                   END DO
00531                ELSE
00532 *                 uplo = 'U'
00533                   DO J = 0, K - 1
00534                      DO I = 0, K - 1
00535                         VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00536                      END DO
00537                   END DO
00538                   J = K
00539 *                 -> U(j,j) is at A(0,j)
00540                   VALUE = MAX( VALUE, ABS( REAL( A( 0+J*LDA ) ) ) )
00541                   DO I = 1, K - 1
00542                      VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00543                   END DO
00544                   DO J = K + 1, N - 1
00545                      DO I = 0, J - K - 2
00546                         VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00547                      END DO
00548                      I = J - K - 1
00549 *                    -> U(i,i) at A(i,j)
00550                      VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) )
00551                      I = J - K
00552 *                    U(j,j)
00553                      VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) )
00554                      DO I = J - K + 1, K - 1
00555                         VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00556                      END DO
00557                   END DO
00558                   J = N
00559                   DO I = 0, K - 2
00560                      VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00561                   END DO
00562                   I = K - 1
00563 *                 U(k,k) at A(i,j)
00564                   VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) )
00565                END IF
00566             END IF
00567          END IF
00568       ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR.
00569      $         ( NORM.EQ.'1' ) ) THEN
00570 *
00571 *       Find normI(A) ( = norm1(A), since A is Hermitian).
00572 *
00573          IF( IFM.EQ.1 ) THEN
00574 *           A is 'N'
00575             K = N / 2
00576             IF( NOE.EQ.1 ) THEN
00577 *              n is odd & A is n by (n+1)/2
00578                IF( ILU.EQ.0 ) THEN
00579 *                 uplo = 'U'
00580                   DO I = 0, K - 1
00581                      WORK( I ) = ZERO
00582                   END DO
00583                   DO J = 0, K
00584                      S = ZERO
00585                      DO I = 0, K + J - 1
00586                         AA = ABS( A( I+J*LDA ) )
00587 *                       -> A(i,j+k)
00588                         S = S + AA
00589                         WORK( I ) = WORK( I ) + AA
00590                      END DO
00591                      AA = ABS( REAL( A( I+J*LDA ) ) )
00592 *                    -> A(j+k,j+k)
00593                      WORK( J+K ) = S + AA
00594                      IF( I.EQ.K+K )
00595      $                  GO TO 10
00596                      I = I + 1
00597                      AA = ABS( REAL( A( I+J*LDA ) ) )
00598 *                    -> A(j,j)
00599                      WORK( J ) = WORK( J ) + AA
00600                      S = ZERO
00601                      DO L = J + 1, K - 1
00602                         I = I + 1
00603                         AA = ABS( A( I+J*LDA ) )
00604 *                       -> A(l,j)
00605                         S = S + AA
00606                         WORK( L ) = WORK( L ) + AA
00607                      END DO
00608                      WORK( J ) = WORK( J ) + S
00609                   END DO
00610    10             CONTINUE
00611                   I = ISAMAX( N, WORK, 1 )
00612                   VALUE = WORK( I-1 )
00613                ELSE
00614 *                 ilu = 1 & uplo = 'L'
00615                   K = K + 1
00616 *                 k=(n+1)/2 for n odd and ilu=1
00617                   DO I = K, N - 1
00618                      WORK( I ) = ZERO
00619                   END DO
00620                   DO J = K - 1, 0, -1
00621                      S = ZERO
00622                      DO I = 0, J - 2
00623                         AA = ABS( A( I+J*LDA ) )
00624 *                       -> A(j+k,i+k)
00625                         S = S + AA
00626                         WORK( I+K ) = WORK( I+K ) + AA
00627                      END DO
00628                      IF( J.GT.0 ) THEN
00629                         AA = ABS( REAL( A( I+J*LDA ) ) )
00630 *                       -> A(j+k,j+k)
00631                         S = S + AA
00632                         WORK( I+K ) = WORK( I+K ) + S
00633 *                       i=j
00634                         I = I + 1
00635                      END IF
00636                      AA = ABS( REAL( A( I+J*LDA ) ) )
00637 *                    -> A(j,j)
00638                      WORK( J ) = AA
00639                      S = ZERO
00640                      DO L = J + 1, N - 1
00641                         I = I + 1
00642                         AA = ABS( A( I+J*LDA ) )
00643 *                       -> A(l,j)
00644                         S = S + AA
00645                         WORK( L ) = WORK( L ) + AA
00646                      END DO
00647                      WORK( J ) = WORK( J ) + S
00648                   END DO
00649                   I = ISAMAX( N, WORK, 1 )
00650                   VALUE = WORK( I-1 )
00651                END IF
00652             ELSE
00653 *              n is even & A is n+1 by k = n/2
00654                IF( ILU.EQ.0 ) THEN
00655 *                 uplo = 'U'
00656                   DO I = 0, K - 1
00657                      WORK( I ) = ZERO
00658                   END DO
00659                   DO J = 0, K - 1
00660                      S = ZERO
00661                      DO I = 0, K + J - 1
00662                         AA = ABS( A( I+J*LDA ) )
00663 *                       -> A(i,j+k)
00664                         S = S + AA
00665                         WORK( I ) = WORK( I ) + AA
00666                      END DO
00667                      AA = ABS( REAL( A( I+J*LDA ) ) )
00668 *                    -> A(j+k,j+k)
00669                      WORK( J+K ) = S + AA
00670                      I = I + 1
00671                      AA = ABS( REAL( A( I+J*LDA ) ) )
00672 *                    -> A(j,j)
00673                      WORK( J ) = WORK( J ) + AA
00674                      S = ZERO
00675                      DO L = J + 1, K - 1
00676                         I = I + 1
00677                         AA = ABS( A( I+J*LDA ) )
00678 *                       -> A(l,j)
00679                         S = S + AA
00680                         WORK( L ) = WORK( L ) + AA
00681                      END DO
00682                      WORK( J ) = WORK( J ) + S
00683                   END DO
00684                   I = ISAMAX( N, WORK, 1 )
00685                   VALUE = WORK( I-1 )
00686                ELSE
00687 *                 ilu = 1 & uplo = 'L'
00688                   DO I = K, N - 1
00689                      WORK( I ) = ZERO
00690                   END DO
00691                   DO J = K - 1, 0, -1
00692                      S = ZERO
00693                      DO I = 0, J - 1
00694                         AA = ABS( A( I+J*LDA ) )
00695 *                       -> A(j+k,i+k)
00696                         S = S + AA
00697                         WORK( I+K ) = WORK( I+K ) + AA
00698                      END DO
00699                      AA = ABS( REAL( A( I+J*LDA ) ) )
00700 *                    -> A(j+k,j+k)
00701                      S = S + AA
00702                      WORK( I+K ) = WORK( I+K ) + S
00703 *                    i=j
00704                      I = I + 1
00705                      AA = ABS( REAL( A( I+J*LDA ) ) )
00706 *                    -> A(j,j)
00707                      WORK( J ) = AA
00708                      S = ZERO
00709                      DO L = J + 1, N - 1
00710                         I = I + 1
00711                         AA = ABS( A( I+J*LDA ) )
00712 *                       -> A(l,j)
00713                         S = S + AA
00714                         WORK( L ) = WORK( L ) + AA
00715                      END DO
00716                      WORK( J ) = WORK( J ) + S
00717                   END DO
00718                   I = ISAMAX( N, WORK, 1 )
00719                   VALUE = WORK( I-1 )
00720                END IF
00721             END IF
00722          ELSE
00723 *           ifm=0
00724             K = N / 2
00725             IF( NOE.EQ.1 ) THEN
00726 *              n is odd & A is (n+1)/2 by n
00727                IF( ILU.EQ.0 ) THEN
00728 *                 uplo = 'U'
00729                   N1 = K
00730 *                 n/2
00731                   K = K + 1
00732 *                 k is the row size and lda
00733                   DO I = N1, N - 1
00734                      WORK( I ) = ZERO
00735                   END DO
00736                   DO J = 0, N1 - 1
00737                      S = ZERO
00738                      DO I = 0, K - 1
00739                         AA = ABS( A( I+J*LDA ) )
00740 *                       A(j,n1+i)
00741                         WORK( I+N1 ) = WORK( I+N1 ) + AA
00742                         S = S + AA
00743                      END DO
00744                      WORK( J ) = S
00745                   END DO
00746 *                 j=n1=k-1 is special
00747                   S = ABS( REAL( A( 0+J*LDA ) ) )
00748 *                 A(k-1,k-1)
00749                   DO I = 1, K - 1
00750                      AA = ABS( A( I+J*LDA ) )
00751 *                    A(k-1,i+n1)
00752                      WORK( I+N1 ) = WORK( I+N1 ) + AA
00753                      S = S + AA
00754                   END DO
00755                   WORK( J ) = WORK( J ) + S
00756                   DO J = K, N - 1
00757                      S = ZERO
00758                      DO I = 0, J - K - 1
00759                         AA = ABS( A( I+J*LDA ) )
00760 *                       A(i,j-k)
00761                         WORK( I ) = WORK( I ) + AA
00762                         S = S + AA
00763                      END DO
00764 *                    i=j-k
00765                      AA = ABS( REAL( A( I+J*LDA ) ) )
00766 *                    A(j-k,j-k)
00767                      S = S + AA
00768                      WORK( J-K ) = WORK( J-K ) + S
00769                      I = I + 1
00770                      S = ABS( REAL( A( I+J*LDA ) ) )
00771 *                    A(j,j)
00772                      DO L = J + 1, N - 1
00773                         I = I + 1
00774                         AA = ABS( A( I+J*LDA ) )
00775 *                       A(j,l)
00776                         WORK( L ) = WORK( L ) + AA
00777                         S = S + AA
00778                      END DO
00779                      WORK( J ) = WORK( J ) + S
00780                   END DO
00781                   I = ISAMAX( N, WORK, 1 )
00782                   VALUE = WORK( I-1 )
00783                ELSE
00784 *                 ilu=1 & uplo = 'L'
00785                   K = K + 1
00786 *                 k=(n+1)/2 for n odd and ilu=1
00787                   DO I = K, N - 1
00788                      WORK( I ) = ZERO
00789                   END DO
00790                   DO J = 0, K - 2
00791 *                    process
00792                      S = ZERO
00793                      DO I = 0, J - 1
00794                         AA = ABS( A( I+J*LDA ) )
00795 *                       A(j,i)
00796                         WORK( I ) = WORK( I ) + AA
00797                         S = S + AA
00798                      END DO
00799                      AA = ABS( REAL( A( I+J*LDA ) ) )
00800 *                    i=j so process of A(j,j)
00801                      S = S + AA
00802                      WORK( J ) = S
00803 *                    is initialised here
00804                      I = I + 1
00805 *                    i=j process A(j+k,j+k)
00806                      AA = ABS( REAL( A( I+J*LDA ) ) )
00807                      S = AA
00808                      DO L = K + J + 1, N - 1
00809                         I = I + 1
00810                         AA = ABS( A( I+J*LDA ) )
00811 *                       A(l,k+j)
00812                         S = S + AA
00813                         WORK( L ) = WORK( L ) + AA
00814                      END DO
00815                      WORK( K+J ) = WORK( K+J ) + S
00816                   END DO
00817 *                 j=k-1 is special :process col A(k-1,0:k-1)
00818                   S = ZERO
00819                   DO I = 0, K - 2
00820                      AA = ABS( A( I+J*LDA ) )
00821 *                    A(k,i)
00822                      WORK( I ) = WORK( I ) + AA
00823                      S = S + AA
00824                   END DO
00825 *                 i=k-1
00826                   AA = ABS( REAL( A( I+J*LDA ) ) )
00827 *                 A(k-1,k-1)
00828                   S = S + AA
00829                   WORK( I ) = S
00830 *                 done with col j=k+1
00831                   DO J = K, N - 1
00832 *                    process col j of A = A(j,0:k-1)
00833                      S = ZERO
00834                      DO I = 0, K - 1
00835                         AA = ABS( A( I+J*LDA ) )
00836 *                       A(j,i)
00837                         WORK( I ) = WORK( I ) + AA
00838                         S = S + AA
00839                      END DO
00840                      WORK( J ) = WORK( J ) + S
00841                   END DO
00842                   I = ISAMAX( N, WORK, 1 )
00843                   VALUE = WORK( I-1 )
00844                END IF
00845             ELSE
00846 *              n is even & A is k=n/2 by n+1
00847                IF( ILU.EQ.0 ) THEN
00848 *                 uplo = 'U'
00849                   DO I = K, N - 1
00850                      WORK( I ) = ZERO
00851                   END DO
00852                   DO J = 0, K - 1
00853                      S = ZERO
00854                      DO I = 0, K - 1
00855                         AA = ABS( A( I+J*LDA ) )
00856 *                       A(j,i+k)
00857                         WORK( I+K ) = WORK( I+K ) + AA
00858                         S = S + AA
00859                      END DO
00860                      WORK( J ) = S
00861                   END DO
00862 *                 j=k
00863                   AA = ABS( REAL( A( 0+J*LDA ) ) )
00864 *                 A(k,k)
00865                   S = AA
00866                   DO I = 1, K - 1
00867                      AA = ABS( A( I+J*LDA ) )
00868 *                    A(k,k+i)
00869                      WORK( I+K ) = WORK( I+K ) + AA
00870                      S = S + AA
00871                   END DO
00872                   WORK( J ) = WORK( J ) + S
00873                   DO J = K + 1, N - 1
00874                      S = ZERO
00875                      DO I = 0, J - 2 - K
00876                         AA = ABS( A( I+J*LDA ) )
00877 *                       A(i,j-k-1)
00878                         WORK( I ) = WORK( I ) + AA
00879                         S = S + AA
00880                      END DO
00881 *                    i=j-1-k
00882                      AA = ABS( REAL( A( I+J*LDA ) ) )
00883 *                    A(j-k-1,j-k-1)
00884                      S = S + AA
00885                      WORK( J-K-1 ) = WORK( J-K-1 ) + S
00886                      I = I + 1
00887                      AA = ABS( REAL( A( I+J*LDA ) ) )
00888 *                    A(j,j)
00889                      S = AA
00890                      DO L = J + 1, N - 1
00891                         I = I + 1
00892                         AA = ABS( A( I+J*LDA ) )
00893 *                       A(j,l)
00894                         WORK( L ) = WORK( L ) + AA
00895                         S = S + AA
00896                      END DO
00897                      WORK( J ) = WORK( J ) + S
00898                   END DO
00899 *                 j=n
00900                   S = ZERO
00901                   DO I = 0, K - 2
00902                      AA = ABS( A( I+J*LDA ) )
00903 *                    A(i,k-1)
00904                      WORK( I ) = WORK( I ) + AA
00905                      S = S + AA
00906                   END DO
00907 *                 i=k-1
00908                   AA = ABS( REAL( A( I+J*LDA ) ) )
00909 *                 A(k-1,k-1)
00910                   S = S + AA
00911                   WORK( I ) = WORK( I ) + S
00912                   I = ISAMAX( N, WORK, 1 )
00913                   VALUE = WORK( I-1 )
00914                ELSE
00915 *                 ilu=1 & uplo = 'L'
00916                   DO I = K, N - 1
00917                      WORK( I ) = ZERO
00918                   END DO
00919 *                 j=0 is special :process col A(k:n-1,k)
00920                   S = ABS( REAL( A( 0 ) ) )
00921 *                 A(k,k)
00922                   DO I = 1, K - 1
00923                      AA = ABS( A( I ) )
00924 *                    A(k+i,k)
00925                      WORK( I+K ) = WORK( I+K ) + AA
00926                      S = S + AA
00927                   END DO
00928                   WORK( K ) = WORK( K ) + S
00929                   DO J = 1, K - 1
00930 *                    process
00931                      S = ZERO
00932                      DO I = 0, J - 2
00933                         AA = ABS( A( I+J*LDA ) )
00934 *                       A(j-1,i)
00935                         WORK( I ) = WORK( I ) + AA
00936                         S = S + AA
00937                      END DO
00938                      AA = ABS( REAL( A( I+J*LDA ) ) )
00939 *                    i=j-1 so process of A(j-1,j-1)
00940                      S = S + AA
00941                      WORK( J-1 ) = S
00942 *                    is initialised here
00943                      I = I + 1
00944 *                    i=j process A(j+k,j+k)
00945                      AA = ABS( REAL( A( I+J*LDA ) ) )
00946                      S = AA
00947                      DO L = K + J + 1, N - 1
00948                         I = I + 1
00949                         AA = ABS( A( I+J*LDA ) )
00950 *                       A(l,k+j)
00951                         S = S + AA
00952                         WORK( L ) = WORK( L ) + AA
00953                      END DO
00954                      WORK( K+J ) = WORK( K+J ) + S
00955                   END DO
00956 *                 j=k is special :process col A(k,0:k-1)
00957                   S = ZERO
00958                   DO I = 0, K - 2
00959                      AA = ABS( A( I+J*LDA ) )
00960 *                    A(k,i)
00961                      WORK( I ) = WORK( I ) + AA
00962                      S = S + AA
00963                   END DO
00964 *
00965 *                 i=k-1
00966                   AA = ABS( REAL( A( I+J*LDA ) ) )
00967 *                 A(k-1,k-1)
00968                   S = S + AA
00969                   WORK( I ) = S
00970 *                 done with col j=k+1
00971                   DO J = K + 1, N
00972 *
00973 *                    process col j-1 of A = A(j-1,0:k-1)
00974                      S = ZERO
00975                      DO I = 0, K - 1
00976                         AA = ABS( A( I+J*LDA ) )
00977 *                       A(j-1,i)
00978                         WORK( I ) = WORK( I ) + AA
00979                         S = S + AA
00980                      END DO
00981                      WORK( J-1 ) = WORK( J-1 ) + S
00982                   END DO
00983                   I = ISAMAX( N, WORK, 1 )
00984                   VALUE = WORK( I-1 )
00985                END IF
00986             END IF
00987          END IF
00988       ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
00989 *
00990 *       Find normF(A).
00991 *
00992          K = ( N+1 ) / 2
00993          SCALE = ZERO
00994          S = ONE
00995          IF( NOE.EQ.1 ) THEN
00996 *           n is odd
00997             IF( IFM.EQ.1 ) THEN
00998 *              A is normal & A is n by k
00999                IF( ILU.EQ.0 ) THEN
01000 *                 A is upper
01001                   DO J = 0, K - 3
01002                      CALL CLASSQ( K-J-2, A( K+J+1+J*LDA ), 1, SCALE, S )
01003 *                    L at A(k,0)
01004                   END DO
01005                   DO J = 0, K - 1
01006                      CALL CLASSQ( K+J-1, A( 0+J*LDA ), 1, SCALE, S )
01007 *                    trap U at A(0,0)
01008                   END DO
01009                   S = S + S
01010 *                 double s for the off diagonal elements
01011                   L = K - 1
01012 *                 -> U(k,k) at A(k-1,0)
01013                   DO I = 0, K - 2
01014                      AA = REAL( A( L ) )
01015 *                    U(k+i,k+i)
01016                      IF( AA.NE.ZERO ) THEN
01017                         IF( SCALE.LT.AA ) THEN
01018                            S = ONE + S*( SCALE / AA )**2
01019                            SCALE = AA
01020                         ELSE
01021                            S = S + ( AA / SCALE )**2
01022                         END IF
01023                      END IF
01024                      AA = REAL( A( L+1 ) )
01025 *                    U(i,i)
01026                      IF( AA.NE.ZERO ) THEN
01027                         IF( SCALE.LT.AA ) THEN
01028                            S = ONE + S*( SCALE / AA )**2
01029                            SCALE = AA
01030                         ELSE
01031                            S = S + ( AA / SCALE )**2
01032                         END IF
01033                      END IF
01034                      L = L + LDA + 1
01035                   END DO
01036                   AA = REAL( A( L ) )
01037 *                 U(n-1,n-1)
01038                   IF( AA.NE.ZERO ) THEN
01039                      IF( SCALE.LT.AA ) THEN
01040                         S = ONE + S*( SCALE / AA )**2
01041                         SCALE = AA
01042                      ELSE
01043                         S = S + ( AA / SCALE )**2
01044                      END IF
01045                   END IF
01046                ELSE
01047 *                 ilu=1 & A is lower
01048                   DO J = 0, K - 1
01049                      CALL CLASSQ( N-J-1, A( J+1+J*LDA ), 1, SCALE, S )
01050 *                    trap L at A(0,0)
01051                   END DO
01052                   DO J = 1, K - 2
01053                      CALL CLASSQ( J, A( 0+( 1+J )*LDA ), 1, SCALE, S )
01054 *                    U at A(0,1)
01055                   END DO
01056                   S = S + S
01057 *                 double s for the off diagonal elements
01058                   AA = REAL( A( 0 ) )
01059 *                 L(0,0) at A(0,0)
01060                   IF( AA.NE.ZERO ) THEN
01061                      IF( SCALE.LT.AA ) THEN
01062                         S = ONE + S*( SCALE / AA )**2
01063                         SCALE = AA
01064                      ELSE
01065                         S = S + ( AA / SCALE )**2
01066                      END IF
01067                   END IF
01068                   L = LDA
01069 *                 -> L(k,k) at A(0,1)
01070                   DO I = 1, K - 1
01071                      AA = REAL( A( L ) )
01072 *                    L(k-1+i,k-1+i)
01073                      IF( AA.NE.ZERO ) THEN
01074                         IF( SCALE.LT.AA ) THEN
01075                            S = ONE + S*( SCALE / AA )**2
01076                            SCALE = AA
01077                         ELSE
01078                            S = S + ( AA / SCALE )**2
01079                         END IF
01080                      END IF
01081                      AA = REAL( A( L+1 ) )
01082 *                    L(i,i)
01083                      IF( AA.NE.ZERO ) THEN
01084                         IF( SCALE.LT.AA ) THEN
01085                            S = ONE + S*( SCALE / AA )**2
01086                            SCALE = AA
01087                         ELSE
01088                            S = S + ( AA / SCALE )**2
01089                         END IF
01090                      END IF
01091                      L = L + LDA + 1
01092                   END DO
01093                END IF
01094             ELSE
01095 *              A is xpose & A is k by n
01096                IF( ILU.EQ.0 ) THEN
01097 *                 A**H is upper
01098                   DO J = 1, K - 2
01099                      CALL CLASSQ( J, A( 0+( K+J )*LDA ), 1, SCALE, S )
01100 *                    U at A(0,k)
01101                   END DO
01102                   DO J = 0, K - 2
01103                      CALL CLASSQ( K, A( 0+J*LDA ), 1, SCALE, S )
01104 *                    k by k-1 rect. at A(0,0)
01105                   END DO
01106                   DO J = 0, K - 2
01107                      CALL CLASSQ( K-J-1, A( J+1+( J+K-1 )*LDA ), 1,
01108      $                            SCALE, S )
01109 *                    L at A(0,k-1)
01110                   END DO
01111                   S = S + S
01112 *                 double s for the off diagonal elements
01113                   L = 0 + K*LDA - LDA
01114 *                 -> U(k-1,k-1) at A(0,k-1)
01115                   AA = REAL( A( L ) )
01116 *                 U(k-1,k-1)
01117                   IF( AA.NE.ZERO ) THEN
01118                      IF( SCALE.LT.AA ) THEN
01119                         S = ONE + S*( SCALE / AA )**2
01120                         SCALE = AA
01121                      ELSE
01122                         S = S + ( AA / SCALE )**2
01123                      END IF
01124                   END IF
01125                   L = L + LDA
01126 *                 -> U(0,0) at A(0,k)
01127                   DO J = K, N - 1
01128                      AA = REAL( A( L ) )
01129 *                    -> U(j-k,j-k)
01130                      IF( AA.NE.ZERO ) THEN
01131                         IF( SCALE.LT.AA ) THEN
01132                            S = ONE + S*( SCALE / AA )**2
01133                            SCALE = AA
01134                         ELSE
01135                            S = S + ( AA / SCALE )**2
01136                         END IF
01137                      END IF
01138                      AA = REAL( A( L+1 ) )
01139 *                    -> U(j,j)
01140                      IF( AA.NE.ZERO ) THEN
01141                         IF( SCALE.LT.AA ) THEN
01142                            S = ONE + S*( SCALE / AA )**2
01143                            SCALE = AA
01144                         ELSE
01145                            S = S + ( AA / SCALE )**2
01146                         END IF
01147                      END IF
01148                      L = L + LDA + 1
01149                   END DO
01150                ELSE
01151 *                 A**H is lower
01152                   DO J = 1, K - 1
01153                      CALL CLASSQ( J, A( 0+J*LDA ), 1, SCALE, S )
01154 *                    U at A(0,0)
01155                   END DO
01156                   DO J = K, N - 1
01157                      CALL CLASSQ( K, A( 0+J*LDA ), 1, SCALE, S )
01158 *                    k by k-1 rect. at A(0,k)
01159                   END DO
01160                   DO J = 0, K - 3
01161                      CALL CLASSQ( K-J-2, A( J+2+J*LDA ), 1, SCALE, S )
01162 *                    L at A(1,0)
01163                   END DO
01164                   S = S + S
01165 *                 double s for the off diagonal elements
01166                   L = 0
01167 *                 -> L(0,0) at A(0,0)
01168                   DO I = 0, K - 2
01169                      AA = REAL( A( L ) )
01170 *                    L(i,i)
01171                      IF( AA.NE.ZERO ) THEN
01172                         IF( SCALE.LT.AA ) THEN
01173                            S = ONE + S*( SCALE / AA )**2
01174                            SCALE = AA
01175                         ELSE
01176                            S = S + ( AA / SCALE )**2
01177                         END IF
01178                      END IF
01179                      AA = REAL( A( L+1 ) )
01180 *                    L(k+i,k+i)
01181                      IF( AA.NE.ZERO ) THEN
01182                         IF( SCALE.LT.AA ) THEN
01183                            S = ONE + S*( SCALE / AA )**2
01184                            SCALE = AA
01185                         ELSE
01186                            S = S + ( AA / SCALE )**2
01187                         END IF
01188                      END IF
01189                      L = L + LDA + 1
01190                   END DO
01191 *                 L-> k-1 + (k-1)*lda or L(k-1,k-1) at A(k-1,k-1)
01192                   AA = REAL( A( L ) )
01193 *                 L(k-1,k-1) at A(k-1,k-1)
01194                   IF( AA.NE.ZERO ) THEN
01195                      IF( SCALE.LT.AA ) THEN
01196                         S = ONE + S*( SCALE / AA )**2
01197                         SCALE = AA
01198                      ELSE
01199                         S = S + ( AA / SCALE )**2
01200                      END IF
01201                   END IF
01202                END IF
01203             END IF
01204          ELSE
01205 *           n is even
01206             IF( IFM.EQ.1 ) THEN
01207 *              A is normal
01208                IF( ILU.EQ.0 ) THEN
01209 *                 A is upper
01210                   DO J = 0, K - 2
01211                      CALL CLASSQ( K-J-1, A( K+J+2+J*LDA ), 1, SCALE, S )
01212 *                 L at A(k+1,0)
01213                   END DO
01214                   DO J = 0, K - 1
01215                      CALL CLASSQ( K+J, A( 0+J*LDA ), 1, SCALE, S )
01216 *                 trap U at A(0,0)
01217                   END DO
01218                   S = S + S
01219 *                 double s for the off diagonal elements
01220                   L = K
01221 *                 -> U(k,k) at A(k,0)
01222                   DO I = 0, K - 1
01223                      AA = REAL( A( L ) )
01224 *                    U(k+i,k+i)
01225                      IF( AA.NE.ZERO ) THEN
01226                         IF( SCALE.LT.AA ) THEN
01227                            S = ONE + S*( SCALE / AA )**2
01228                            SCALE = AA
01229                         ELSE
01230                            S = S + ( AA / SCALE )**2
01231                         END IF
01232                      END IF
01233                      AA = REAL( A( L+1 ) )
01234 *                    U(i,i)
01235                      IF( AA.NE.ZERO ) THEN
01236                         IF( SCALE.LT.AA ) THEN
01237                            S = ONE + S*( SCALE / AA )**2
01238                            SCALE = AA
01239                         ELSE
01240                            S = S + ( AA / SCALE )**2
01241                         END IF
01242                      END IF
01243                      L = L + LDA + 1
01244                   END DO
01245                ELSE
01246 *                 ilu=1 & A is lower
01247                   DO J = 0, K - 1
01248                      CALL CLASSQ( N-J-1, A( J+2+J*LDA ), 1, SCALE, S )
01249 *                    trap L at A(1,0)
01250                   END DO
01251                   DO J = 1, K - 1
01252                      CALL CLASSQ( J, A( 0+J*LDA ), 1, SCALE, S )
01253 *                    U at A(0,0)
01254                   END DO
01255                   S = S + S
01256 *                 double s for the off diagonal elements
01257                   L = 0
01258 *                 -> L(k,k) at A(0,0)
01259                   DO I = 0, K - 1
01260                      AA = REAL( A( L ) )
01261 *                    L(k-1+i,k-1+i)
01262                      IF( AA.NE.ZERO ) THEN
01263                         IF( SCALE.LT.AA ) THEN
01264                            S = ONE + S*( SCALE / AA )**2
01265                            SCALE = AA
01266                         ELSE
01267                            S = S + ( AA / SCALE )**2
01268                         END IF
01269                      END IF
01270                      AA = REAL( A( L+1 ) )
01271 *                    L(i,i)
01272                      IF( AA.NE.ZERO ) THEN
01273                         IF( SCALE.LT.AA ) THEN
01274                            S = ONE + S*( SCALE / AA )**2
01275                            SCALE = AA
01276                         ELSE
01277                            S = S + ( AA / SCALE )**2
01278                         END IF
01279                      END IF
01280                      L = L + LDA + 1
01281                   END DO
01282                END IF
01283             ELSE
01284 *              A is xpose
01285                IF( ILU.EQ.0 ) THEN
01286 *                 A**H is upper
01287                   DO J = 1, K - 1
01288                      CALL CLASSQ( J, A( 0+( K+1+J )*LDA ), 1, SCALE, S )
01289 *                 U at A(0,k+1)
01290                   END DO
01291                   DO J = 0, K - 1
01292                      CALL CLASSQ( K, A( 0+J*LDA ), 1, SCALE, S )
01293 *                 k by k rect. at A(0,0)
01294                   END DO
01295                   DO J = 0, K - 2
01296                      CALL CLASSQ( K-J-1, A( J+1+( J+K )*LDA ), 1, SCALE,
01297      $                            S )
01298 *                 L at A(0,k)
01299                   END DO
01300                   S = S + S
01301 *                 double s for the off diagonal elements
01302                   L = 0 + K*LDA
01303 *                 -> U(k,k) at A(0,k)
01304                   AA = REAL( A( L ) )
01305 *                 U(k,k)
01306                   IF( AA.NE.ZERO ) THEN
01307                      IF( SCALE.LT.AA ) THEN
01308                         S = ONE + S*( SCALE / AA )**2
01309                         SCALE = AA
01310                      ELSE
01311                         S = S + ( AA / SCALE )**2
01312                      END IF
01313                   END IF
01314                   L = L + LDA
01315 *                 -> U(0,0) at A(0,k+1)
01316                   DO J = K + 1, N - 1
01317                      AA = REAL( A( L ) )
01318 *                    -> U(j-k-1,j-k-1)
01319                      IF( AA.NE.ZERO ) THEN
01320                         IF( SCALE.LT.AA ) THEN
01321                            S = ONE + S*( SCALE / AA )**2
01322                            SCALE = AA
01323                         ELSE
01324                            S = S + ( AA / SCALE )**2
01325                         END IF
01326                      END IF
01327                      AA = REAL( A( L+1 ) )
01328 *                    -> U(j,j)
01329                      IF( AA.NE.ZERO ) THEN
01330                         IF( SCALE.LT.AA ) THEN
01331                            S = ONE + S*( SCALE / AA )**2
01332                            SCALE = AA
01333                         ELSE
01334                            S = S + ( AA / SCALE )**2
01335                         END IF
01336                      END IF
01337                      L = L + LDA + 1
01338                   END DO
01339 *                 L=k-1+n*lda
01340 *                 -> U(k-1,k-1) at A(k-1,n)
01341                   AA = REAL( A( L ) )
01342 *                 U(k,k)
01343                   IF( AA.NE.ZERO ) THEN
01344                      IF( SCALE.LT.AA ) THEN
01345                         S = ONE + S*( SCALE / AA )**2
01346                         SCALE = AA
01347                      ELSE
01348                         S = S + ( AA / SCALE )**2
01349                      END IF
01350                   END IF
01351                ELSE
01352 *                 A**H is lower
01353                   DO J = 1, K - 1
01354                      CALL CLASSQ( J, A( 0+( J+1 )*LDA ), 1, SCALE, S )
01355 *                 U at A(0,1)
01356                   END DO
01357                   DO J = K + 1, N
01358                      CALL CLASSQ( K, A( 0+J*LDA ), 1, SCALE, S )
01359 *                 k by k rect. at A(0,k+1)
01360                   END DO
01361                   DO J = 0, K - 2
01362                      CALL CLASSQ( K-J-1, A( J+1+J*LDA ), 1, SCALE, S )
01363 *                 L at A(0,0)
01364                   END DO
01365                   S = S + S
01366 *                 double s for the off diagonal elements
01367                   L = 0
01368 *                 -> L(k,k) at A(0,0)
01369                   AA = REAL( A( L ) )
01370 *                 L(k,k) at A(0,0)
01371                   IF( AA.NE.ZERO ) THEN
01372                      IF( SCALE.LT.AA ) THEN
01373                         S = ONE + S*( SCALE / AA )**2
01374                         SCALE = AA
01375                      ELSE
01376                         S = S + ( AA / SCALE )**2
01377                      END IF
01378                   END IF
01379                   L = LDA
01380 *                 -> L(0,0) at A(0,1)
01381                   DO I = 0, K - 2
01382                      AA = REAL( A( L ) )
01383 *                    L(i,i)
01384                      IF( AA.NE.ZERO ) THEN
01385                         IF( SCALE.LT.AA ) THEN
01386                            S = ONE + S*( SCALE / AA )**2
01387                            SCALE = AA
01388                         ELSE
01389                            S = S + ( AA / SCALE )**2
01390                         END IF
01391                      END IF
01392                      AA = REAL( A( L+1 ) )
01393 *                    L(k+i+1,k+i+1)
01394                      IF( AA.NE.ZERO ) THEN
01395                         IF( SCALE.LT.AA ) THEN
01396                            S = ONE + S*( SCALE / AA )**2
01397                            SCALE = AA
01398                         ELSE
01399                            S = S + ( AA / SCALE )**2
01400                         END IF
01401                      END IF
01402                      L = L + LDA + 1
01403                   END DO
01404 *                 L-> k - 1 + k*lda or L(k-1,k-1) at A(k-1,k)
01405                   AA = REAL( A( L ) )
01406 *                 L(k-1,k-1) at A(k-1,k)
01407                   IF( AA.NE.ZERO ) THEN
01408                      IF( SCALE.LT.AA ) THEN
01409                         S = ONE + S*( SCALE / AA )**2
01410                         SCALE = AA
01411                      ELSE
01412                         S = S + ( AA / SCALE )**2
01413                      END IF
01414                   END IF
01415                END IF
01416             END IF
01417          END IF
01418          VALUE = SCALE*SQRT( S )
01419       END IF
01420 *
01421       CLANHF = VALUE
01422       RETURN
01423 *
01424 *     End of CLANHF
01425 *
01426       END
 All Files Functions