SRC/slansf.f

   1 *> \brief \b SLANSF
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *> \htmlonly
   9 *> Download SLANSF + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slansf.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slansf.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slansf.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       REAL FUNCTION SLANSF( NORM, TRANSR, UPLO, N, A, WORK )
  22 *
  23 *       .. Scalar Arguments ..
  24 *       CHARACTER          NORM, TRANSR, UPLO
  25 *       INTEGER            N
  26 *       ..
  27 *       .. Array Arguments ..
  28 *       REAL               A( 0: * ), WORK( 0: * )
  29 *       ..
  30 *
  31 *
  32 *> \par Purpose:
  33 *  =============
  34 *>
  35 *> \verbatim
  36 *>
  37 *> SLANSF returns the value of the one norm, or the Frobenius norm, or
  38 *> the infinity norm, or the element of largest absolute value of a
  39 *> real symmetric matrix A in RFP format.
  40 *> \endverbatim
  41 *>
  42 *> \return SLANSF
  43 *> \verbatim
  44 *>
  45 *>    SLANSF = ( max(abs(A(i,j))), NORM = 'M' or 'm'
  46 *>             (
  47 *>             ( norm1(A),         NORM = '1', 'O' or 'o'
  48 *>             (
  49 *>             ( normI(A),         NORM = 'I' or 'i'
  50 *>             (
  51 *>             ( normF(A),         NORM = 'F', 'f', 'E' or 'e'
  52 *>
  53 *> where  norm1  denotes the  one norm of a matrix (maximum column sum),
  54 *> normI  denotes the  infinity norm  of a matrix  (maximum row sum) and
  55 *> normF  denotes the  Frobenius norm of a matrix (square root of sum of
  56 *> squares).  Note that  max(abs(A(i,j)))  is not a  matrix norm.
  57 *> \endverbatim
  58 *
  59 *  Arguments:
  60 *  ==========
  61 *
  62 *> \param[in] NORM
  63 *> \verbatim
  64 *>          NORM is CHARACTER*1
  65 *>          Specifies the value to be returned in SLANSF as described
  66 *>          above.
  67 *> \endverbatim
  68 *>
  69 *> \param[in] TRANSR
  70 *> \verbatim
  71 *>          TRANSR is CHARACTER*1
  72 *>          Specifies whether the RFP format of A is normal or
  73 *>          transposed format.
  74 *>          = 'N':  RFP format is Normal;
  75 *>          = 'T':  RFP format is Transpose.
  76 *> \endverbatim
  77 *>
  78 *> \param[in] UPLO
  79 *> \verbatim
  80 *>          UPLO is CHARACTER*1
  81 *>           On entry, UPLO specifies whether the RFP matrix A came from
  82 *>           an upper or lower triangular matrix as follows:
  83 *>           = 'U': RFP A came from an upper triangular matrix;
  84 *>           = 'L': RFP A came from a lower triangular matrix.
  85 *> \endverbatim
  86 *>
  87 *> \param[in] N
  88 *> \verbatim
  89 *>          N is INTEGER
  90 *>          The order of the matrix A. N >= 0. When N = 0, SLANSF is
  91 *>          set to zero.
  92 *> \endverbatim
  93 *>
  94 *> \param[in] A
  95 *> \verbatim
  96 *>          A is REAL array, dimension ( N*(N+1)/2 );
  97 *>          On entry, the upper (if UPLO = 'U') or lower (if UPLO = 'L')
  98 *>          part of the symmetric matrix A stored in RFP format. See the
  99 *>          "Notes" below for more details.
 100 *>          Unchanged on exit.
 101 *> \endverbatim
 102 *>
 103 *> \param[out] WORK
 104 *> \verbatim
 105 *>          WORK is REAL array, dimension (MAX(1,LWORK)),
 106 *>          where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
 107 *>          WORK is not referenced.
 108 *> \endverbatim
 109 *
 110 *  Authors:
 111 *  ========
 112 *
 113 *> \author Univ. of Tennessee
 114 *> \author Univ. of California Berkeley
 115 *> \author Univ. of Colorado Denver
 116 *> \author NAG Ltd.
 117 *
 118 *> \date September 2012
 119 *
 120 *> \ingroup realOTHERcomputational
 121 *
 122 *> \par Further Details:
 123 *  =====================
 124 *>
 125 *> \verbatim
 126 *>
 127 *>  We first consider Rectangular Full Packed (RFP) Format when N is
 128 *>  even. We give an example where N = 6.
 129 *>
 130 *>      AP is Upper             AP is Lower
 131 *>
 132 *>   00 01 02 03 04 05       00
 133 *>      11 12 13 14 15       10 11
 134 *>         22 23 24 25       20 21 22
 135 *>            33 34 35       30 31 32 33
 136 *>               44 45       40 41 42 43 44
 137 *>                  55       50 51 52 53 54 55
 138 *>
 139 *>
 140 *>  Let TRANSR = 'N'. RFP holds AP as follows:
 141 *>  For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
 142 *>  three columns of AP upper. The lower triangle A(4:6,0:2) consists of
 143 *>  the transpose of the first three columns of AP upper.
 144 *>  For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
 145 *>  three columns of AP lower. The upper triangle A(0:2,0:2) consists of
 146 *>  the transpose of the last three columns of AP lower.
 147 *>  This covers the case N even and TRANSR = 'N'.
 148 *>
 149 *>         RFP A                   RFP A
 150 *>
 151 *>        03 04 05                33 43 53
 152 *>        13 14 15                00 44 54
 153 *>        23 24 25                10 11 55
 154 *>        33 34 35                20 21 22
 155 *>        00 44 45                30 31 32
 156 *>        01 11 55                40 41 42
 157 *>        02 12 22                50 51 52
 158 *>
 159 *>  Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
 160 *>  transpose of RFP A above. One therefore gets:
 161 *>
 162 *>
 163 *>           RFP A                   RFP A
 164 *>
 165 *>     03 13 23 33 00 01 02    33 00 10 20 30 40 50
 166 *>     04 14 24 34 44 11 12    43 44 11 21 31 41 51
 167 *>     05 15 25 35 45 55 22    53 54 55 22 32 42 52
 168 *>
 169 *>
 170 *>  We then consider Rectangular Full Packed (RFP) Format when N is
 171 *>  odd. We give an example where N = 5.
 172 *>
 173 *>     AP is Upper                 AP is Lower
 174 *>
 175 *>   00 01 02 03 04              00
 176 *>      11 12 13 14              10 11
 177 *>         22 23 24              20 21 22
 178 *>            33 34              30 31 32 33
 179 *>               44              40 41 42 43 44
 180 *>
 181 *>
 182 *>  Let TRANSR = 'N'. RFP holds AP as follows:
 183 *>  For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
 184 *>  three columns of AP upper. The lower triangle A(3:4,0:1) consists of
 185 *>  the transpose of the first two columns of AP upper.
 186 *>  For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
 187 *>  three columns of AP lower. The upper triangle A(0:1,1:2) consists of
 188 *>  the transpose of the last two columns of AP lower.
 189 *>  This covers the case N odd and TRANSR = 'N'.
 190 *>
 191 *>         RFP A                   RFP A
 192 *>
 193 *>        02 03 04                00 33 43
 194 *>        12 13 14                10 11 44
 195 *>        22 23 24                20 21 22
 196 *>        00 33 34                30 31 32
 197 *>        01 11 44                40 41 42
 198 *>
 199 *>  Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
 200 *>  transpose of RFP A above. One therefore gets:
 201 *>
 202 *>           RFP A                   RFP A
 203 *>
 204 *>     02 12 22 00 01             00 10 20 30 40 50
 205 *>     03 13 23 33 11             33 11 21 31 41 51
 206 *>     04 14 24 34 44             43 44 22 32 42 52
 207 *> \endverbatim
 208 *
 209 *  =====================================================================
 210       REAL FUNCTION SLANSF( NORM, TRANSR, UPLO, N, A, WORK )
 211 *
 212 *  -- LAPACK computational routine (version 3.4.2) --
 213 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 214 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 215 *     September 2012
 216 *
 217 *     .. Scalar Arguments ..
 218       CHARACTER          NORM, TRANSR, UPLO
 219       INTEGER            N
 220 *     ..
 221 *     .. Array Arguments ..
 222       REAL               A( 0: * ), WORK( 0: * )
 223 *     ..
 224 *
 225 *  =====================================================================
 226 *
 227 *     ..
 228 *     .. Parameters ..
 229       REAL               ONE, ZERO
 230       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
 231 *     ..
 232 *     .. Local Scalars ..
 233       INTEGER            I, J, IFM, ILU, NOE, N1, K, L, LDA
 234       REAL               SCALE, S, VALUE, AA, TEMP
 235 *     ..
 236 *     .. External Functions ..
 237       LOGICAL            LSAME, SISNAN
 238       EXTERNAL           LSAME, SISNAN
 239 *     ..
 240 *     .. External Subroutines ..
 241       EXTERNAL           SLASSQ
 242 *     ..
 243 *     .. Intrinsic Functions ..
 244       INTRINSIC          ABS, SQRT
 245 *     ..
 246 *     .. Executable Statements ..
 247 *
 248       IF( N.EQ.0 ) THEN
 249          SLANSF = ZERO
 250          RETURN
 251       ELSE IF( N.EQ.1 ) THEN
 252          SLANSF = ABS( A(0) )
 253          RETURN
 254       END IF
 255 *
 256 *     set noe = 1 if n is odd. if n is even set noe=0
 257 *
 258       NOE = 1
 259       IF( MOD( N, 2 ).EQ.0 )
 260      $   NOE = 0
 261 *
 262 *     set ifm = 0 when form='T or 't' and 1 otherwise
 263 *
 264       IFM = 1
 265       IF( LSAME( TRANSR, 'T' ) )
 266      $   IFM = 0
 267 *
 268 *     set ilu = 0 when uplo='U or 'u' and 1 otherwise
 269 *
 270       ILU = 1
 271       IF( LSAME( UPLO, 'U' ) )
 272      $   ILU = 0
 273 *
 274 *     set lda = (n+1)/2 when ifm = 0
 275 *     set lda = n when ifm = 1 and noe = 1
 276 *     set lda = n+1 when ifm = 1 and noe = 0
 277 *
 278       IF( IFM.EQ.1 ) THEN
 279          IF( NOE.EQ.1 ) THEN
 280             LDA = N
 281          ELSE
 282 *           noe=0
 283             LDA = N + 1
 284          END IF
 285       ELSE
 286 *        ifm=0
 287          LDA = ( N+1 ) / 2
 288       END IF
 289 *
 290       IF( LSAME( NORM, 'M' ) ) THEN
 291 *
 292 *       Find max(abs(A(i,j))).
 293 *
 294          K = ( N+1 ) / 2
 295          VALUE = ZERO
 296          IF( NOE.EQ.1 ) THEN
 297 *           n is odd
 298             IF( IFM.EQ.1 ) THEN
 299 *           A is n by k
 300                DO J = 0, K - 1
 301                   DO I = 0, N - 1
 302                      TEMP = ABS( A( I+J*LDA ) )
 303                      IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) )
 304      $                    VALUE = TEMP
 305                   END DO
 306                END DO
 307             ELSE
 308 *              xpose case; A is k by n
 309                DO J = 0, N - 1
 310                   DO I = 0, K - 1
 311                      TEMP = ABS( A( I+J*LDA ) )
 312                      IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) )
 313      $                    VALUE = TEMP
 314                   END DO
 315                END DO
 316             END IF
 317          ELSE
 318 *           n is even
 319             IF( IFM.EQ.1 ) THEN
 320 *              A is n+1 by k
 321                DO J = 0, K - 1
 322                   DO I = 0, N
 323                      TEMP = ABS( A( I+J*LDA ) )
 324                      IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) )
 325      $                    VALUE = TEMP
 326                   END DO
 327                END DO
 328             ELSE
 329 *              xpose case; A is k by n+1
 330                DO J = 0, N
 331                   DO I = 0, K - 1
 332                      TEMP = ABS( A( I+J*LDA ) )
 333                      IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) )
 334      $                    VALUE = TEMP
 335                   END DO
 336                END DO
 337             END IF
 338          END IF
 339       ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR.
 340      $         ( NORM.EQ.'1' ) ) THEN
 341 *
 342 *        Find normI(A) ( = norm1(A), since A is symmetric).
 343 *
 344          IF( IFM.EQ.1 ) THEN
 345             K = N / 2
 346             IF( NOE.EQ.1 ) THEN
 347 *              n is odd
 348                IF( ILU.EQ.0 ) THEN
 349                   DO I = 0, K - 1
 350                      WORK( I ) = ZERO
 351                   END DO
 352                   DO J = 0, K
 353                      S = ZERO
 354                      DO I = 0, K + J - 1
 355                         AA = ABS( A( I+J*LDA ) )
 356 *                       -> A(i,j+k)
 357                         S = S + AA
 358                         WORK( I ) = WORK( I ) + AA
 359                      END DO
 360                      AA = ABS( A( I+J*LDA ) )
 361 *                    -> A(j+k,j+k)
 362                      WORK( J+K ) = S + AA
 363                      IF( I.EQ.K+K )
 364      $                  GO TO 10
 365                      I = I + 1
 366                      AA = ABS( A( I+J*LDA ) )
 367 *                    -> A(j,j)
 368                      WORK( J ) = WORK( J ) + AA
 369                      S = ZERO
 370                      DO L = J + 1, K - 1
 371                         I = I + 1
 372                         AA = ABS( A( I+J*LDA ) )
 373 *                       -> A(l,j)
 374                         S = S + AA
 375                         WORK( L ) = WORK( L ) + AA
 376                      END DO
 377                      WORK( J ) = WORK( J ) + S
 378                   END DO
 379    10             CONTINUE
 380                   VALUE = WORK( 0 )
 381                   DO I = 1, N-1
 382                      TEMP = WORK( I )
 383                      IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) )
 384      $                    VALUE = TEMP
 385                   END DO
 386                ELSE
 387 *                 ilu = 1
 388                   K = K + 1
 389 *                 k=(n+1)/2 for n odd and ilu=1
 390                   DO I = K, N - 1
 391                      WORK( I ) = ZERO
 392                   END DO
 393                   DO J = K - 1, 0, -1
 394                      S = ZERO
 395                      DO I = 0, J - 2
 396                         AA = ABS( A( I+J*LDA ) )
 397 *                       -> A(j+k,i+k)
 398                         S = S + AA
 399                         WORK( I+K ) = WORK( I+K ) + AA
 400                      END DO
 401                      IF( J.GT.0 ) THEN
 402                         AA = ABS( A( I+J*LDA ) )
 403 *                       -> A(j+k,j+k)
 404                         S = S + AA
 405                         WORK( I+K ) = WORK( I+K ) + S
 406 *                       i=j
 407                         I = I + 1
 408                      END IF
 409                      AA = ABS( A( I+J*LDA ) )
 410 *                    -> A(j,j)
 411                      WORK( J ) = AA
 412                      S = ZERO
 413                      DO L = J + 1, N - 1
 414                         I = I + 1
 415                         AA = ABS( A( I+J*LDA ) )
 416 *                       -> A(l,j)
 417                         S = S + AA
 418                         WORK( L ) = WORK( L ) + AA
 419                      END DO
 420                      WORK( J ) = WORK( J ) + S
 421                   END DO
 422                   VALUE = WORK( 0 )
 423                   DO I = 1, N-1
 424                      TEMP = WORK( I )
 425                      IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) )
 426      $                    VALUE = TEMP
 427                   END DO
 428                END IF
 429             ELSE
 430 *              n is even
 431                IF( ILU.EQ.0 ) THEN
 432                   DO I = 0, K - 1
 433                      WORK( I ) = ZERO
 434                   END DO
 435                   DO J = 0, K - 1
 436                      S = ZERO
 437                      DO I = 0, K + J - 1
 438                         AA = ABS( A( I+J*LDA ) )
 439 *                       -> A(i,j+k)
 440                         S = S + AA
 441                         WORK( I ) = WORK( I ) + AA
 442                      END DO
 443                      AA = ABS( A( I+J*LDA ) )
 444 *                    -> A(j+k,j+k)
 445                      WORK( J+K ) = S + AA
 446                      I = I + 1
 447                      AA = ABS( A( I+J*LDA ) )
 448 *                    -> A(j,j)
 449                      WORK( J ) = WORK( J ) + AA
 450                      S = ZERO
 451                      DO L = J + 1, K - 1
 452                         I = I + 1
 453                         AA = ABS( A( I+J*LDA ) )
 454 *                       -> A(l,j)
 455                         S = S + AA
 456                         WORK( L ) = WORK( L ) + AA
 457                      END DO
 458                      WORK( J ) = WORK( J ) + S
 459                   END DO
 460                   VALUE = WORK( 0 )
 461                   DO I = 1, N-1
 462                      TEMP = WORK( I )
 463                      IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) )
 464      $                    VALUE = TEMP
 465                   END DO
 466                ELSE
 467 *                 ilu = 1
 468                   DO I = K, N - 1
 469                      WORK( I ) = ZERO
 470                   END DO
 471                   DO J = K - 1, 0, -1
 472                      S = ZERO
 473                      DO I = 0, J - 1
 474                         AA = ABS( A( I+J*LDA ) )
 475 *                       -> A(j+k,i+k)
 476                         S = S + AA
 477                         WORK( I+K ) = WORK( I+K ) + AA
 478                      END DO
 479                      AA = ABS( A( I+J*LDA ) )
 480 *                    -> A(j+k,j+k)
 481                      S = S + AA
 482                      WORK( I+K ) = WORK( I+K ) + S
 483 *                    i=j
 484                      I = I + 1
 485                      AA = ABS( A( I+J*LDA ) )
 486 *                    -> A(j,j)
 487                      WORK( J ) = AA
 488                      S = ZERO
 489                      DO L = J + 1, N - 1
 490                         I = I + 1
 491                         AA = ABS( A( I+J*LDA ) )
 492 *                       -> A(l,j)
 493                         S = S + AA
 494                         WORK( L ) = WORK( L ) + AA
 495                      END DO
 496                      WORK( J ) = WORK( J ) + S
 497                   END DO
 498                   VALUE = WORK( 0 )
 499                   DO I = 1, N-1
 500                      TEMP = WORK( I )
 501                      IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) )
 502      $                    VALUE = TEMP
 503                   END DO
 504                END IF
 505             END IF
 506          ELSE
 507 *           ifm=0
 508             K = N / 2
 509             IF( NOE.EQ.1 ) THEN
 510 *              n is odd
 511                IF( ILU.EQ.0 ) THEN
 512                   N1 = K
 513 *                 n/2
 514                   K = K + 1
 515 *                 k is the row size and lda
 516                   DO I = N1, N - 1
 517                      WORK( I ) = ZERO
 518                   END DO
 519                   DO J = 0, N1 - 1
 520                      S = ZERO
 521                      DO I = 0, K - 1
 522                         AA = ABS( A( I+J*LDA ) )
 523 *                       A(j,n1+i)
 524                         WORK( I+N1 ) = WORK( I+N1 ) + AA
 525                         S = S + AA
 526                      END DO
 527                      WORK( J ) = S
 528                   END DO
 529 *                 j=n1=k-1 is special
 530                   S = ABS( A( 0+J*LDA ) )
 531 *                 A(k-1,k-1)
 532                   DO I = 1, K - 1
 533                      AA = ABS( A( I+J*LDA ) )
 534 *                    A(k-1,i+n1)
 535                      WORK( I+N1 ) = WORK( I+N1 ) + AA
 536                      S = S + AA
 537                   END DO
 538                   WORK( J ) = WORK( J ) + S
 539                   DO J = K, N - 1
 540                      S = ZERO
 541                      DO I = 0, J - K - 1
 542                         AA = ABS( A( I+J*LDA ) )
 543 *                       A(i,j-k)
 544                         WORK( I ) = WORK( I ) + AA
 545                         S = S + AA
 546                      END DO
 547 *                    i=j-k
 548                      AA = ABS( A( I+J*LDA ) )
 549 *                    A(j-k,j-k)
 550                      S = S + AA
 551                      WORK( J-K ) = WORK( J-K ) + S
 552                      I = I + 1
 553                      S = ABS( A( I+J*LDA ) )
 554 *                    A(j,j)
 555                      DO L = J + 1, N - 1
 556                         I = I + 1
 557                         AA = ABS( A( I+J*LDA ) )
 558 *                       A(j,l)
 559                         WORK( L ) = WORK( L ) + AA
 560                         S = S + AA
 561                      END DO
 562                      WORK( J ) = WORK( J ) + S
 563                   END DO
 564                   VALUE = WORK( 0 )
 565                   DO I = 1, N-1
 566                      TEMP = WORK( I )
 567                      IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) )
 568      $                    VALUE = TEMP
 569                   END DO
 570                ELSE
 571 *                 ilu=1
 572                   K = K + 1
 573 *                 k=(n+1)/2 for n odd and ilu=1
 574                   DO I = K, N - 1
 575                      WORK( I ) = ZERO
 576                   END DO
 577                   DO J = 0, K - 2
 578 *                    process
 579                      S = ZERO
 580                      DO I = 0, J - 1
 581                         AA = ABS( A( I+J*LDA ) )
 582 *                       A(j,i)
 583                         WORK( I ) = WORK( I ) + AA
 584                         S = S + AA
 585                      END DO
 586                      AA = ABS( A( I+J*LDA ) )
 587 *                    i=j so process of A(j,j)
 588                      S = S + AA
 589                      WORK( J ) = S
 590 *                    is initialised here
 591                      I = I + 1
 592 *                    i=j process A(j+k,j+k)
 593                      AA = ABS( A( I+J*LDA ) )
 594                      S = AA
 595                      DO L = K + J + 1, N - 1
 596                         I = I + 1
 597                         AA = ABS( A( I+J*LDA ) )
 598 *                       A(l,k+j)
 599                         S = S + AA
 600                         WORK( L ) = WORK( L ) + AA
 601                      END DO
 602                      WORK( K+J ) = WORK( K+J ) + S
 603                   END DO
 604 *                 j=k-1 is special :process col A(k-1,0:k-1)
 605                   S = ZERO
 606                   DO I = 0, K - 2
 607                      AA = ABS( A( I+J*LDA ) )
 608 *                    A(k,i)
 609                      WORK( I ) = WORK( I ) + AA
 610                      S = S + AA
 611                   END DO
 612 *                 i=k-1
 613                   AA = ABS( A( I+J*LDA ) )
 614 *                 A(k-1,k-1)
 615                   S = S + AA
 616                   WORK( I ) = S
 617 *                 done with col j=k+1
 618                   DO J = K, N - 1
 619 *                    process col j of A = A(j,0:k-1)
 620                      S = ZERO
 621                      DO I = 0, K - 1
 622                         AA = ABS( A( I+J*LDA ) )
 623 *                       A(j,i)
 624                         WORK( I ) = WORK( I ) + AA
 625                         S = S + AA
 626                      END DO
 627                      WORK( J ) = WORK( J ) + S
 628                   END DO
 629                   VALUE = WORK( 0 )
 630                   DO I = 1, N-1
 631                      TEMP = WORK( I )
 632                      IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) )
 633      $                    VALUE = TEMP
 634                   END DO
 635                END IF
 636             ELSE
 637 *              n is even
 638                IF( ILU.EQ.0 ) THEN
 639                   DO I = K, N - 1
 640                      WORK( I ) = ZERO
 641                   END DO
 642                   DO J = 0, K - 1
 643                      S = ZERO
 644                      DO I = 0, K - 1
 645                         AA = ABS( A( I+J*LDA ) )
 646 *                       A(j,i+k)
 647                         WORK( I+K ) = WORK( I+K ) + AA
 648                         S = S + AA
 649                      END DO
 650                      WORK( J ) = S
 651                   END DO
 652 *                 j=k
 653                   AA = ABS( A( 0+J*LDA ) )
 654 *                 A(k,k)
 655                   S = AA
 656                   DO I = 1, K - 1
 657                      AA = ABS( A( I+J*LDA ) )
 658 *                    A(k,k+i)
 659                      WORK( I+K ) = WORK( I+K ) + AA
 660                      S = S + AA
 661                   END DO
 662                   WORK( J ) = WORK( J ) + S
 663                   DO J = K + 1, N - 1
 664                      S = ZERO
 665                      DO I = 0, J - 2 - K
 666                         AA = ABS( A( I+J*LDA ) )
 667 *                       A(i,j-k-1)
 668                         WORK( I ) = WORK( I ) + AA
 669                         S = S + AA
 670                      END DO
 671 *                     i=j-1-k
 672                      AA = ABS( A( I+J*LDA ) )
 673 *                    A(j-k-1,j-k-1)
 674                      S = S + AA
 675                      WORK( J-K-1 ) = WORK( J-K-1 ) + S
 676                      I = I + 1
 677                      AA = ABS( A( I+J*LDA ) )
 678 *                    A(j,j)
 679                      S = AA
 680                      DO L = J + 1, N - 1
 681                         I = I + 1
 682                         AA = ABS( A( I+J*LDA ) )
 683 *                       A(j,l)
 684                         WORK( L ) = WORK( L ) + AA
 685                         S = S + AA
 686                      END DO
 687                      WORK( J ) = WORK( J ) + S
 688                   END DO
 689 *                 j=n
 690                   S = ZERO
 691                   DO I = 0, K - 2
 692                      AA = ABS( A( I+J*LDA ) )
 693 *                    A(i,k-1)
 694                      WORK( I ) = WORK( I ) + AA
 695                      S = S + AA
 696                   END DO
 697 *                 i=k-1
 698                   AA = ABS( A( I+J*LDA ) )
 699 *                 A(k-1,k-1)
 700                   S = S + AA
 701                   WORK( I ) = WORK( I ) + S
 702                   VALUE = WORK ( 0 )
 703                   DO I = 1, N-1
 704                      TEMP = WORK( I )
 705                      IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) )
 706      $                    VALUE = TEMP
 707                   END DO
 708                ELSE
 709 *                 ilu=1
 710                   DO I = K, N - 1
 711                      WORK( I ) = ZERO
 712                   END DO
 713 *                 j=0 is special :process col A(k:n-1,k)
 714                   S = ABS( A( 0 ) )
 715 *                 A(k,k)
 716                   DO I = 1, K - 1
 717                      AA = ABS( A( I ) )
 718 *                    A(k+i,k)
 719                      WORK( I+K ) = WORK( I+K ) + AA
 720                      S = S + AA
 721                   END DO
 722                   WORK( K ) = WORK( K ) + S
 723                   DO J = 1, K - 1
 724 *                    process
 725                      S = ZERO
 726                      DO I = 0, J - 2
 727                         AA = ABS( A( I+J*LDA ) )
 728 *                       A(j-1,i)
 729                         WORK( I ) = WORK( I ) + AA
 730                         S = S + AA
 731                      END DO
 732                      AA = ABS( A( I+J*LDA ) )
 733 *                    i=j-1 so process of A(j-1,j-1)
 734                      S = S + AA
 735                      WORK( J-1 ) = S
 736 *                    is initialised here
 737                      I = I + 1
 738 *                    i=j process A(j+k,j+k)
 739                      AA = ABS( A( I+J*LDA ) )
 740                      S = AA
 741                      DO L = K + J + 1, N - 1
 742                         I = I + 1
 743                         AA = ABS( A( I+J*LDA ) )
 744 *                       A(l,k+j)
 745                         S = S + AA
 746                         WORK( L ) = WORK( L ) + AA
 747                      END DO
 748                      WORK( K+J ) = WORK( K+J ) + S
 749                   END DO
 750 *                 j=k is special :process col A(k,0:k-1)
 751                   S = ZERO
 752                   DO I = 0, K - 2
 753                      AA = ABS( A( I+J*LDA ) )
 754 *                    A(k,i)
 755                      WORK( I ) = WORK( I ) + AA
 756                      S = S + AA
 757                   END DO
 758 *                 i=k-1
 759                   AA = ABS( A( I+J*LDA ) )
 760 *                 A(k-1,k-1)
 761                   S = S + AA
 762                   WORK( I ) = S
 763 *                 done with col j=k+1
 764                   DO J = K + 1, N
 765 *                    process col j-1 of A = A(j-1,0:k-1)
 766                      S = ZERO
 767                      DO I = 0, K - 1
 768                         AA = ABS( A( I+J*LDA ) )
 769 *                       A(j-1,i)
 770                         WORK( I ) = WORK( I ) + AA
 771                         S = S + AA
 772                      END DO
 773                      WORK( J-1 ) = WORK( J-1 ) + S
 774                   END DO
 775                   VALUE = WORK( 0 )
 776                   DO I = 1, N-1
 777                      TEMP = WORK( I )
 778                      IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) )
 779      $                    VALUE = TEMP
 780                   END DO
 781                END IF
 782             END IF
 783          END IF
 784       ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
 785 *
 786 *       Find normF(A).
 787 *
 788          K = ( N+1 ) / 2
 789          SCALE = ZERO
 790          S = ONE
 791          IF( NOE.EQ.1 ) THEN
 792 *           n is odd
 793             IF( IFM.EQ.1 ) THEN
 794 *              A is normal
 795                IF( ILU.EQ.0 ) THEN
 796 *                 A is upper
 797                   DO J = 0, K - 3
 798                      CALL SLASSQ( K-J-2, A( K+J+1+J*LDA ), 1, SCALE, S )
 799 *                    L at A(k,0)
 800                   END DO
 801                   DO J = 0, K - 1
 802                      CALL SLASSQ( K+J-1, A( 0+J*LDA ), 1, SCALE, S )
 803 *                    trap U at A(0,0)
 804                   END DO
 805                   S = S + S
 806 *                 double s for the off diagonal elements
 807                   CALL SLASSQ( K-1, A( K ), LDA+1, SCALE, S )
 808 *                 tri L at A(k,0)
 809                   CALL SLASSQ( K, A( K-1 ), LDA+1, SCALE, S )
 810 *                 tri U at A(k-1,0)
 811                ELSE
 812 *                 ilu=1 & A is lower
 813                   DO J = 0, K - 1
 814                      CALL SLASSQ( N-J-1, A( J+1+J*LDA ), 1, SCALE, S )
 815 *                    trap L at A(0,0)
 816                   END DO
 817                   DO J = 0, K - 2
 818                      CALL SLASSQ( J, A( 0+( 1+J )*LDA ), 1, SCALE, S )
 819 *                    U at A(0,1)
 820                   END DO
 821                   S = S + S
 822 *                 double s for the off diagonal elements
 823                   CALL SLASSQ( K, A( 0 ), LDA+1, SCALE, S )
 824 *                 tri L at A(0,0)
 825                   CALL SLASSQ( K-1, A( 0+LDA ), LDA+1, SCALE, S )
 826 *                 tri U at A(0,1)
 827                END IF
 828             ELSE
 829 *              A is xpose
 830                IF( ILU.EQ.0 ) THEN
 831 *                 A**T is upper
 832                   DO J = 1, K - 2
 833                      CALL SLASSQ( J, A( 0+( K+J )*LDA ), 1, SCALE, S )
 834 *                    U at A(0,k)
 835                   END DO
 836                   DO J = 0, K - 2
 837                      CALL SLASSQ( K, A( 0+J*LDA ), 1, SCALE, S )
 838 *                    k by k-1 rect. at A(0,0)
 839                   END DO
 840                   DO J = 0, K - 2
 841                      CALL SLASSQ( K-J-1, A( J+1+( J+K-1 )*LDA ), 1,
 842      $                            SCALE, S )
 843 *                    L at A(0,k-1)
 844                   END DO
 845                   S = S + S
 846 *                 double s for the off diagonal elements
 847                   CALL SLASSQ( K-1, A( 0+K*LDA ), LDA+1, SCALE, S )
 848 *                 tri U at A(0,k)
 849                   CALL SLASSQ( K, A( 0+( K-1 )*LDA ), LDA+1, SCALE, S )
 850 *                 tri L at A(0,k-1)
 851                ELSE
 852 *                 A**T is lower
 853                   DO J = 1, K - 1
 854                      CALL SLASSQ( J, A( 0+J*LDA ), 1, SCALE, S )
 855 *                    U at A(0,0)
 856                   END DO
 857                   DO J = K, N - 1
 858                      CALL SLASSQ( K, A( 0+J*LDA ), 1, SCALE, S )
 859 *                    k by k-1 rect. at A(0,k)
 860                   END DO
 861                   DO J = 0, K - 3
 862                      CALL SLASSQ( K-J-2, A( J+2+J*LDA ), 1, SCALE, S )
 863 *                    L at A(1,0)
 864                   END DO
 865                   S = S + S
 866 *                 double s for the off diagonal elements
 867                   CALL SLASSQ( K, A( 0 ), LDA+1, SCALE, S )
 868 *                 tri U at A(0,0)
 869                   CALL SLASSQ( K-1, A( 1 ), LDA+1, SCALE, S )
 870 *                 tri L at A(1,0)
 871                END IF
 872             END IF
 873          ELSE
 874 *           n is even
 875             IF( IFM.EQ.1 ) THEN
 876 *              A is normal
 877                IF( ILU.EQ.0 ) THEN
 878 *                 A is upper
 879                   DO J = 0, K - 2
 880                      CALL SLASSQ( K-J-1, A( K+J+2+J*LDA ), 1, SCALE, S )
 881 *                    L at A(k+1,0)
 882                   END DO
 883                   DO J = 0, K - 1
 884                      CALL SLASSQ( K+J, A( 0+J*LDA ), 1, SCALE, S )
 885 *                    trap U at A(0,0)
 886                   END DO
 887                   S = S + S
 888 *                 double s for the off diagonal elements
 889                   CALL SLASSQ( K, A( K+1 ), LDA+1, SCALE, S )
 890 *                 tri L at A(k+1,0)
 891                   CALL SLASSQ( K, A( K ), LDA+1, SCALE, S )
 892 *                 tri U at A(k,0)
 893                ELSE
 894 *                 ilu=1 & A is lower
 895                   DO J = 0, K - 1
 896                      CALL SLASSQ( N-J-1, A( J+2+J*LDA ), 1, SCALE, S )
 897 *                    trap L at A(1,0)
 898                   END DO
 899                   DO J = 1, K - 1
 900                      CALL SLASSQ( J, A( 0+J*LDA ), 1, SCALE, S )
 901 *                    U at A(0,0)
 902                   END DO
 903                   S = S + S
 904 *                 double s for the off diagonal elements
 905                   CALL SLASSQ( K, A( 1 ), LDA+1, SCALE, S )
 906 *                 tri L at A(1,0)
 907                   CALL SLASSQ( K, A( 0 ), LDA+1, SCALE, S )
 908 *                 tri U at A(0,0)
 909                END IF
 910             ELSE
 911 *              A is xpose
 912                IF( ILU.EQ.0 ) THEN
 913 *                 A**T is upper
 914                   DO J = 1, K - 1
 915                      CALL SLASSQ( J, A( 0+( K+1+J )*LDA ), 1, SCALE, S )
 916 *                    U at A(0,k+1)
 917                   END DO
 918                   DO J = 0, K - 1
 919                      CALL SLASSQ( K, A( 0+J*LDA ), 1, SCALE, S )
 920 *                    k by k rect. at A(0,0)
 921                   END DO
 922                   DO J = 0, K - 2
 923                      CALL SLASSQ( K-J-1, A( J+1+( J+K )*LDA ), 1, SCALE,
 924      $                            S )
 925 *                    L at A(0,k)
 926                   END DO
 927                   S = S + S
 928 *                 double s for the off diagonal elements
 929                   CALL SLASSQ( K, A( 0+( K+1 )*LDA ), LDA+1, SCALE, S )
 930 *                 tri U at A(0,k+1)
 931                   CALL SLASSQ( K, A( 0+K*LDA ), LDA+1, SCALE, S )
 932 *                 tri L at A(0,k)
 933                ELSE
 934 *                 A**T is lower
 935                   DO J = 1, K - 1
 936                      CALL SLASSQ( J, A( 0+( J+1 )*LDA ), 1, SCALE, S )
 937 *                    U at A(0,1)
 938                   END DO
 939                   DO J = K + 1, N
 940                      CALL SLASSQ( K, A( 0+J*LDA ), 1, SCALE, S )
 941 *                    k by k rect. at A(0,k+1)
 942                   END DO
 943                   DO J = 0, K - 2
 944                      CALL SLASSQ( K-J-1, A( J+1+J*LDA ), 1, SCALE, S )
 945 *                    L at A(0,0)
 946                   END DO
 947                   S = S + S
 948 *                 double s for the off diagonal elements
 949                   CALL SLASSQ( K, A( LDA ), LDA+1, SCALE, S )
 950 *                 tri L at A(0,1)
 951                   CALL SLASSQ( K, A( 0 ), LDA+1, SCALE, S )
 952 *                 tri U at A(0,0)
 953                END IF
 954             END IF
 955          END IF
 956          VALUE = SCALE*SQRT( S )
 957       END IF
 958 *
 959       SLANSF = VALUE
 960       RETURN
 961 *
 962 *     End of SLANSF
 963 *
 964       END