LAPACK: SRC/dlansf.f Source File

Go to the documentation of this file.
00001       DOUBLE PRECISION FUNCTION DLANSF( NORM, TRANSR, UPLO, N, A, WORK )
00002 *
00003 *  -- LAPACK routine (version 3.3.0)                                    --
00004 *
00005 *  -- Contributed by Fred Gustavson of the IBM Watson Research Center --
00006 *     November 2010
00007 *
00008 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00009 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00010 *
00011 *     .. Scalar Arguments ..
00012       CHARACTER          NORM, TRANSR, UPLO
00013       INTEGER            N
00014 *     ..
00015 *     .. Array Arguments ..
00016       DOUBLE PRECISION   A( 0: * ), WORK( 0: * )
00017 *     ..
00018 *
00019 *  Purpose
00020 *  =======
00021 *
00022 *  DLANSF returns the value of the one norm, or the Frobenius norm, or
00023 *  the infinity norm, or the element of largest absolute value of a
00024 *  real symmetric matrix A in RFP format.
00025 *
00026 *  Description
00027 *  ===========
00028 *
00029 *  DLANSF returns the value
00030 *
00031 *     DLANSF = ( max(abs(A(i,j))), NORM = 'M' or 'm'
00032 *              (
00033 *              ( norm1(A),         NORM = '1', 'O' or 'o'
00034 *              (
00035 *              ( normI(A),         NORM = 'I' or 'i'
00036 *              (
00037 *              ( normF(A),         NORM = 'F', 'f', 'E' or 'e'
00038 *
00039 *  where  norm1  denotes the  one norm of a matrix (maximum column sum),
00040 *  normI  denotes the  infinity norm  of a matrix  (maximum row sum) and
00041 *  normF  denotes the  Frobenius norm of a matrix (square root of sum of
00042 *  squares).  Note that  max(abs(A(i,j)))  is not a  matrix norm.
00043 *
00044 *  Arguments
00045 *  =========
00046 *
00047 *  NORM    (input) CHARACTER*1
00048 *          Specifies the value to be returned in DLANSF as described
00049 *          above.
00050 *
00051 *  TRANSR  (input) CHARACTER*1
00052 *          Specifies whether the RFP format of A is normal or
00053 *          transposed format.
00054 *          = 'N':  RFP format is Normal;
00055 *          = 'T':  RFP format is Transpose.
00056 *
00057 *  UPLO    (input) CHARACTER*1
00058 *           On entry, UPLO specifies whether the RFP matrix A came from
00059 *           an upper or lower triangular matrix as follows:
00060 *           = 'U': RFP A came from an upper triangular matrix;
00061 *           = 'L': RFP A came from a lower triangular matrix.
00062 *
00063 *  N       (input) INTEGER
00064 *          The order of the matrix A. N >= 0. When N = 0, DLANSF is
00065 *          set to zero.
00066 *
00067 *  A       (input) DOUBLE PRECISION array, dimension ( N*(N+1)/2 );
00068 *          On entry, the upper (if UPLO = 'U') or lower (if UPLO = 'L')
00069 *          part of the symmetric matrix A stored in RFP format. See the
00070 *          "Notes" below for more details.
00071 *          Unchanged on exit.
00072 *
00073 *  WORK    (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
00074 *          where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
00075 *          WORK is not referenced.
00076 *
00077 *  Further Details
00078 *  ===============
00079 *
00080 *  We first consider Rectangular Full Packed (RFP) Format when N is
00081 *  even. We give an example where N = 6.
00082 *
00083 *      AP is Upper             AP is Lower
00084 *
00085 *   00 01 02 03 04 05       00
00086 *      11 12 13 14 15       10 11
00087 *         22 23 24 25       20 21 22
00088 *            33 34 35       30 31 32 33
00089 *               44 45       40 41 42 43 44
00090 *                  55       50 51 52 53 54 55
00091 *
00092 *
00093 *  Let TRANSR = 'N'. RFP holds AP as follows:
00094 *  For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
00095 *  three columns of AP upper. The lower triangle A(4:6,0:2) consists of
00096 *  the transpose of the first three columns of AP upper.
00097 *  For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
00098 *  three columns of AP lower. The upper triangle A(0:2,0:2) consists of
00099 *  the transpose of the last three columns of AP lower.
00100 *  This covers the case N even and TRANSR = 'N'.
00101 *
00102 *         RFP A                   RFP A
00103 *
00104 *        03 04 05                33 43 53
00105 *        13 14 15                00 44 54
00106 *        23 24 25                10 11 55
00107 *        33 34 35                20 21 22
00108 *        00 44 45                30 31 32
00109 *        01 11 55                40 41 42
00110 *        02 12 22                50 51 52
00111 *
00112 *  Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
00113 *  transpose of RFP A above. One therefore gets:
00114 *
00115 *
00116 *           RFP A                   RFP A
00117 *
00118 *     03 13 23 33 00 01 02    33 00 10 20 30 40 50
00119 *     04 14 24 34 44 11 12    43 44 11 21 31 41 51
00120 *     05 15 25 35 45 55 22    53 54 55 22 32 42 52
00121 *
00122 *
00123 *  We then consider Rectangular Full Packed (RFP) Format when N is
00124 *  odd. We give an example where N = 5.
00125 *
00126 *     AP is Upper                 AP is Lower
00127 *
00128 *   00 01 02 03 04              00
00129 *      11 12 13 14              10 11
00130 *         22 23 24              20 21 22
00131 *            33 34              30 31 32 33
00132 *               44              40 41 42 43 44
00133 *
00134 *
00135 *  Let TRANSR = 'N'. RFP holds AP as follows:
00136 *  For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
00137 *  three columns of AP upper. The lower triangle A(3:4,0:1) consists of
00138 *  the transpose of the first two columns of AP upper.
00139 *  For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
00140 *  three columns of AP lower. The upper triangle A(0:1,1:2) consists of
00141 *  the transpose of the last two columns of AP lower.
00142 *  This covers the case N odd and TRANSR = 'N'.
00143 *
00144 *         RFP A                   RFP A
00145 *
00146 *        02 03 04                00 33 43
00147 *        12 13 14                10 11 44
00148 *        22 23 24                20 21 22
00149 *        00 33 34                30 31 32
00150 *        01 11 44                40 41 42
00151 *
00152 *  Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
00153 *  transpose of RFP A above. One therefore gets:
00154 *
00155 *           RFP A                   RFP A
00156 *
00157 *     02 12 22 00 01             00 10 20 30 40 50
00158 *     03 13 23 33 11             33 11 21 31 41 51
00159 *     04 14 24 34 44             43 44 22 32 42 52
00160 *
00161 *  Reference
00162 *  =========
00163 *
00164 *  =====================================================================
00165 *
00166 *     .. Parameters ..
00167       DOUBLE PRECISION   ONE, ZERO
00168       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
00169 *     ..
00170 *     .. Local Scalars ..
00171       INTEGER            I, J, IFM, ILU, NOE, N1, K, L, LDA
00172       DOUBLE PRECISION   SCALE, S, VALUE, AA
00173 *     ..
00174 *     .. External Functions ..
00175       LOGICAL            LSAME
00176       INTEGER            IDAMAX
00177       EXTERNAL           LSAME, IDAMAX
00178 *     ..
00179 *     .. External Subroutines ..
00180       EXTERNAL           DLASSQ
00181 *     ..
00182 *     .. Intrinsic Functions ..
00183       INTRINSIC          ABS, MAX, SQRT
00184 *     ..
00185 *     .. Executable Statements ..
00186 *
00187       IF( N.EQ.0 ) THEN
00188          DLANSF = ZERO
00189          RETURN
00190       END IF
00191 *
00192 *     set noe = 1 if n is odd. if n is even set noe=0
00193 *
00194       NOE = 1
00195       IF( MOD( N, 2 ).EQ.0 )
00196      +   NOE = 0
00197 *
00198 *     set ifm = 0 when form='T or 't' and 1 otherwise
00199 *
00200       IFM = 1
00201       IF( LSAME( TRANSR, 'T' ) )
00202      +   IFM = 0
00203 *
00204 *     set ilu = 0 when uplo='U or 'u' and 1 otherwise
00205 *
00206       ILU = 1
00207       IF( LSAME( UPLO, 'U' ) )
00208      +   ILU = 0
00209 *
00210 *     set lda = (n+1)/2 when ifm = 0
00211 *     set lda = n when ifm = 1 and noe = 1
00212 *     set lda = n+1 when ifm = 1 and noe = 0
00213 *
00214       IF( IFM.EQ.1 ) THEN
00215          IF( NOE.EQ.1 ) THEN
00216             LDA = N
00217          ELSE
00218 *           noe=0
00219             LDA = N + 1
00220          END IF
00221       ELSE
00222 *        ifm=0
00223          LDA = ( N+1 ) / 2
00224       END IF
00225 *
00226       IF( LSAME( NORM, 'M' ) ) THEN
00227 *
00228 *       Find max(abs(A(i,j))).
00229 *
00230          K = ( N+1 ) / 2
00231          VALUE = ZERO
00232          IF( NOE.EQ.1 ) THEN
00233 *           n is odd
00234             IF( IFM.EQ.1 ) THEN
00235 *           A is n by k
00236                DO J = 0, K - 1
00237                   DO I = 0, N - 1
00238                      VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00239                   END DO
00240                END DO
00241             ELSE
00242 *              xpose case; A is k by n
00243                DO J = 0, N - 1
00244                   DO I = 0, K - 1
00245                      VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00246                   END DO
00247                END DO
00248             END IF
00249          ELSE
00250 *           n is even
00251             IF( IFM.EQ.1 ) THEN
00252 *              A is n+1 by k
00253                DO J = 0, K - 1
00254                   DO I = 0, N
00255                      VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00256                   END DO
00257                END DO
00258             ELSE
00259 *              xpose case; A is k by n+1
00260                DO J = 0, N
00261                   DO I = 0, K - 1
00262                      VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
00263                   END DO
00264                END DO
00265             END IF
00266          END IF
00267       ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR.
00268      +         ( NORM.EQ.'1' ) ) THEN
00269 *
00270 *        Find normI(A) ( = norm1(A), since A is symmetric).
00271 *
00272          IF( IFM.EQ.1 ) THEN
00273             K = N / 2
00274             IF( NOE.EQ.1 ) THEN
00275 *              n is odd
00276                IF( ILU.EQ.0 ) THEN
00277                   DO I = 0, K - 1
00278                      WORK( I ) = ZERO
00279                   END DO
00280                   DO J = 0, K
00281                      S = ZERO
00282                      DO I = 0, K + J - 1
00283                         AA = ABS( A( I+J*LDA ) )
00284 *                       -> A(i,j+k)
00285                         S = S + AA
00286                         WORK( I ) = WORK( I ) + AA
00287                      END DO
00288                      AA = ABS( A( I+J*LDA ) )
00289 *                    -> A(j+k,j+k)
00290                      WORK( J+K ) = S + AA
00291                      IF( I.EQ.K+K )
00292      +                  GO TO 10
00293                      I = I + 1
00294                      AA = ABS( A( I+J*LDA ) )
00295 *                    -> A(j,j)
00296                      WORK( J ) = WORK( J ) + AA
00297                      S = ZERO
00298                      DO L = J + 1, K - 1
00299                         I = I + 1
00300                         AA = ABS( A( I+J*LDA ) )
00301 *                       -> A(l,j)
00302                         S = S + AA
00303                         WORK( L ) = WORK( L ) + AA
00304                      END DO
00305                      WORK( J ) = WORK( J ) + S
00306                   END DO
00307    10             CONTINUE
00308                   I = IDAMAX( N, WORK, 1 )
00309                   VALUE = WORK( I-1 )
00310                ELSE
00311 *                 ilu = 1
00312                   K = K + 1
00313 *                 k=(n+1)/2 for n odd and ilu=1
00314                   DO I = K, N - 1
00315                      WORK( I ) = ZERO
00316                   END DO
00317                   DO J = K - 1, 0, -1
00318                      S = ZERO
00319                      DO I = 0, J - 2
00320                         AA = ABS( A( I+J*LDA ) )
00321 *                       -> A(j+k,i+k)
00322                         S = S + AA
00323                         WORK( I+K ) = WORK( I+K ) + AA
00324                      END DO
00325                      IF( J.GT.0 ) THEN
00326                         AA = ABS( A( I+J*LDA ) )
00327 *                       -> A(j+k,j+k)
00328                         S = S + AA
00329                         WORK( I+K ) = WORK( I+K ) + S
00330 *                       i=j
00331                         I = I + 1
00332                      END IF
00333                      AA = ABS( A( I+J*LDA ) )
00334 *                    -> A(j,j)
00335                      WORK( J ) = AA
00336                      S = ZERO
00337                      DO L = J + 1, N - 1
00338                         I = I + 1
00339                         AA = ABS( A( I+J*LDA ) )
00340 *                       -> A(l,j)
00341                         S = S + AA
00342                         WORK( L ) = WORK( L ) + AA
00343                      END DO
00344                      WORK( J ) = WORK( J ) + S
00345                   END DO
00346                   I = IDAMAX( N, WORK, 1 )
00347                   VALUE = WORK( I-1 )
00348                END IF
00349             ELSE
00350 *              n is even
00351                IF( ILU.EQ.0 ) THEN
00352                   DO I = 0, K - 1
00353                      WORK( I ) = ZERO
00354                   END DO
00355                   DO J = 0, K - 1
00356                      S = ZERO
00357                      DO I = 0, K + J - 1
00358                         AA = ABS( A( I+J*LDA ) )
00359 *                       -> A(i,j+k)
00360                         S = S + AA
00361                         WORK( I ) = WORK( I ) + AA
00362                      END DO
00363                      AA = ABS( A( I+J*LDA ) )
00364 *                    -> A(j+k,j+k)
00365                      WORK( J+K ) = S + AA
00366                      I = I + 1
00367                      AA = ABS( A( I+J*LDA ) )
00368 *                    -> A(j,j)
00369                      WORK( J ) = WORK( J ) + AA
00370                      S = ZERO
00371                      DO L = J + 1, K - 1
00372                         I = I + 1
00373                         AA = ABS( A( I+J*LDA ) )
00374 *                       -> A(l,j)
00375                         S = S + AA
00376                         WORK( L ) = WORK( L ) + AA
00377                      END DO
00378                      WORK( J ) = WORK( J ) + S
00379                   END DO
00380                   I = IDAMAX( N, WORK, 1 )
00381                   VALUE = WORK( I-1 )
00382                ELSE
00383 *                 ilu = 1
00384                   DO I = K, N - 1
00385                      WORK( I ) = ZERO
00386                   END DO
00387                   DO J = K - 1, 0, -1
00388                      S = ZERO
00389                      DO I = 0, J - 1
00390                         AA = ABS( A( I+J*LDA ) )
00391 *                       -> A(j+k,i+k)
00392                         S = S + AA
00393                         WORK( I+K ) = WORK( I+K ) + AA
00394                      END DO
00395                      AA = ABS( A( I+J*LDA ) )
00396 *                    -> A(j+k,j+k)
00397                      S = S + AA
00398                      WORK( I+K ) = WORK( I+K ) + S
00399 *                    i=j
00400                      I = I + 1
00401                      AA = ABS( A( I+J*LDA ) )
00402 *                    -> A(j,j)
00403                      WORK( J ) = AA
00404                      S = ZERO
00405                      DO L = J + 1, N - 1
00406                         I = I + 1
00407                         AA = ABS( A( I+J*LDA ) )
00408 *                       -> A(l,j)
00409                         S = S + AA
00410                         WORK( L ) = WORK( L ) + AA
00411                      END DO
00412                      WORK( J ) = WORK( J ) + S
00413                   END DO
00414                   I = IDAMAX( N, WORK, 1 )
00415                   VALUE = WORK( I-1 )
00416                END IF
00417             END IF
00418          ELSE
00419 *           ifm=0
00420             K = N / 2
00421             IF( NOE.EQ.1 ) THEN
00422 *              n is odd
00423                IF( ILU.EQ.0 ) THEN
00424                   N1 = K
00425 *                 n/2
00426                   K = K + 1
00427 *                 k is the row size and lda
00428                   DO I = N1, N - 1
00429                      WORK( I ) = ZERO
00430                   END DO
00431                   DO J = 0, N1 - 1
00432                      S = ZERO
00433                      DO I = 0, K - 1
00434                         AA = ABS( A( I+J*LDA ) )
00435 *                       A(j,n1+i)
00436                         WORK( I+N1 ) = WORK( I+N1 ) + AA
00437                         S = S + AA
00438                      END DO
00439                      WORK( J ) = S
00440                   END DO
00441 *                 j=n1=k-1 is special
00442                   S = ABS( A( 0+J*LDA ) )
00443 *                 A(k-1,k-1)
00444                   DO I = 1, K - 1
00445                      AA = ABS( A( I+J*LDA ) )
00446 *                    A(k-1,i+n1)
00447                      WORK( I+N1 ) = WORK( I+N1 ) + AA
00448                      S = S + AA
00449                   END DO
00450                   WORK( J ) = WORK( J ) + S
00451                   DO J = K, N - 1
00452                      S = ZERO
00453                      DO I = 0, J - K - 1
00454                         AA = ABS( A( I+J*LDA ) )
00455 *                       A(i,j-k)
00456                         WORK( I ) = WORK( I ) + AA
00457                         S = S + AA
00458                      END DO
00459 *                    i=j-k
00460                      AA = ABS( A( I+J*LDA ) )
00461 *                    A(j-k,j-k)
00462                      S = S + AA
00463                      WORK( J-K ) = WORK( J-K ) + S
00464                      I = I + 1
00465                      S = ABS( A( I+J*LDA ) )
00466 *                    A(j,j)
00467                      DO L = J + 1, N - 1
00468                         I = I + 1
00469                         AA = ABS( A( I+J*LDA ) )
00470 *                       A(j,l)
00471                         WORK( L ) = WORK( L ) + AA
00472                         S = S + AA
00473                      END DO
00474                      WORK( J ) = WORK( J ) + S
00475                   END DO
00476                   I = IDAMAX( N, WORK, 1 )
00477                   VALUE = WORK( I-1 )
00478                ELSE
00479 *                 ilu=1
00480                   K = K + 1
00481 *                 k=(n+1)/2 for n odd and ilu=1
00482                   DO I = K, N - 1
00483                      WORK( I ) = ZERO
00484                   END DO
00485                   DO J = 0, K - 2
00486 *                    process
00487                      S = ZERO
00488                      DO I = 0, J - 1
00489                         AA = ABS( A( I+J*LDA ) )
00490 *                       A(j,i)
00491                         WORK( I ) = WORK( I ) + AA
00492                         S = S + AA
00493                      END DO
00494                      AA = ABS( A( I+J*LDA ) )
00495 *                    i=j so process of A(j,j)
00496                      S = S + AA
00497                      WORK( J ) = S
00498 *                    is initialised here
00499                      I = I + 1
00500 *                    i=j process A(j+k,j+k)
00501                      AA = ABS( A( I+J*LDA ) )
00502                      S = AA
00503                      DO L = K + J + 1, N - 1
00504                         I = I + 1
00505                         AA = ABS( A( I+J*LDA ) )
00506 *                       A(l,k+j)
00507                         S = S + AA
00508                         WORK( L ) = WORK( L ) + AA
00509                      END DO
00510                      WORK( K+J ) = WORK( K+J ) + S
00511                   END DO
00512 *                 j=k-1 is special :process col A(k-1,0:k-1)
00513                   S = ZERO
00514                   DO I = 0, K - 2
00515                      AA = ABS( A( I+J*LDA ) )
00516 *                    A(k,i)
00517                      WORK( I ) = WORK( I ) + AA
00518                      S = S + AA
00519                   END DO
00520 *                 i=k-1
00521                   AA = ABS( A( I+J*LDA ) )
00522 *                 A(k-1,k-1)
00523                   S = S + AA
00524                   WORK( I ) = S
00525 *                 done with col j=k+1
00526                   DO J = K, N - 1
00527 *                    process col j of A = A(j,0:k-1)
00528                      S = ZERO
00529                      DO I = 0, K - 1
00530                         AA = ABS( A( I+J*LDA ) )
00531 *                       A(j,i)
00532                         WORK( I ) = WORK( I ) + AA
00533                         S = S + AA
00534                      END DO
00535                      WORK( J ) = WORK( J ) + S
00536                   END DO
00537                   I = IDAMAX( N, WORK, 1 )
00538                   VALUE = WORK( I-1 )
00539                END IF
00540             ELSE
00541 *              n is even
00542                IF( ILU.EQ.0 ) THEN
00543                   DO I = K, N - 1
00544                      WORK( I ) = ZERO
00545                   END DO
00546                   DO J = 0, K - 1
00547                      S = ZERO
00548                      DO I = 0, K - 1
00549                         AA = ABS( A( I+J*LDA ) )
00550 *                       A(j,i+k)
00551                         WORK( I+K ) = WORK( I+K ) + AA
00552                         S = S + AA
00553                      END DO
00554                      WORK( J ) = S
00555                   END DO
00556 *                 j=k
00557                   AA = ABS( A( 0+J*LDA ) )
00558 *                 A(k,k)
00559                   S = AA
00560                   DO I = 1, K - 1
00561                      AA = ABS( A( I+J*LDA ) )
00562 *                    A(k,k+i)
00563                      WORK( I+K ) = WORK( I+K ) + AA
00564                      S = S + AA
00565                   END DO
00566                   WORK( J ) = WORK( J ) + S
00567                   DO J = K + 1, N - 1
00568                      S = ZERO
00569                      DO I = 0, J - 2 - K
00570                         AA = ABS( A( I+J*LDA ) )
00571 *                       A(i,j-k-1)
00572                         WORK( I ) = WORK( I ) + AA
00573                         S = S + AA
00574                      END DO
00575 *                     i=j-1-k
00576                      AA = ABS( A( I+J*LDA ) )
00577 *                    A(j-k-1,j-k-1)
00578                      S = S + AA
00579                      WORK( J-K-1 ) = WORK( J-K-1 ) + S
00580                      I = I + 1
00581                      AA = ABS( A( I+J*LDA ) )
00582 *                    A(j,j)
00583                      S = AA
00584                      DO L = J + 1, N - 1
00585                         I = I + 1
00586                         AA = ABS( A( I+J*LDA ) )
00587 *                       A(j,l)
00588                         WORK( L ) = WORK( L ) + AA
00589                         S = S + AA
00590                      END DO
00591                      WORK( J ) = WORK( J ) + S
00592                   END DO
00593 *                 j=n
00594                   S = ZERO
00595                   DO I = 0, K - 2
00596                      AA = ABS( A( I+J*LDA ) )
00597 *                    A(i,k-1)
00598                      WORK( I ) = WORK( I ) + AA
00599                      S = S + AA
00600                   END DO
00601 *                 i=k-1
00602                   AA = ABS( A( I+J*LDA ) )
00603 *                 A(k-1,k-1)
00604                   S = S + AA
00605                   WORK( I ) = WORK( I ) + S
00606                   I = IDAMAX( N, WORK, 1 )
00607                   VALUE = WORK( I-1 )
00608                ELSE
00609 *                 ilu=1
00610                   DO I = K, N - 1
00611                      WORK( I ) = ZERO
00612                   END DO
00613 *                 j=0 is special :process col A(k:n-1,k)
00614                   S = ABS( A( 0 ) )
00615 *                 A(k,k)
00616                   DO I = 1, K - 1
00617                      AA = ABS( A( I ) )
00618 *                    A(k+i,k)
00619                      WORK( I+K ) = WORK( I+K ) + AA
00620                      S = S + AA
00621                   END DO
00622                   WORK( K ) = WORK( K ) + S
00623                   DO J = 1, K - 1
00624 *                    process
00625                      S = ZERO
00626                      DO I = 0, J - 2
00627                         AA = ABS( A( I+J*LDA ) )
00628 *                       A(j-1,i)
00629                         WORK( I ) = WORK( I ) + AA
00630                         S = S + AA
00631                      END DO
00632                      AA = ABS( A( I+J*LDA ) )
00633 *                    i=j-1 so process of A(j-1,j-1)
00634                      S = S + AA
00635                      WORK( J-1 ) = S
00636 *                    is initialised here
00637                      I = I + 1
00638 *                    i=j process A(j+k,j+k)
00639                      AA = ABS( A( I+J*LDA ) )
00640                      S = AA
00641                      DO L = K + J + 1, N - 1
00642                         I = I + 1
00643                         AA = ABS( A( I+J*LDA ) )
00644 *                       A(l,k+j)
00645                         S = S + AA
00646                         WORK( L ) = WORK( L ) + AA
00647                      END DO
00648                      WORK( K+J ) = WORK( K+J ) + S
00649                   END DO
00650 *                 j=k is special :process col A(k,0:k-1)
00651                   S = ZERO
00652                   DO I = 0, K - 2
00653                      AA = ABS( A( I+J*LDA ) )
00654 *                    A(k,i)
00655                      WORK( I ) = WORK( I ) + AA
00656                      S = S + AA
00657                   END DO
00658 *                 i=k-1
00659                   AA = ABS( A( I+J*LDA ) )
00660 *                 A(k-1,k-1)
00661                   S = S + AA
00662                   WORK( I ) = S
00663 *                 done with col j=k+1
00664                   DO J = K + 1, N
00665 *                    process col j-1 of A = A(j-1,0:k-1)
00666                      S = ZERO
00667                      DO I = 0, K - 1
00668                         AA = ABS( A( I+J*LDA ) )
00669 *                       A(j-1,i)
00670                         WORK( I ) = WORK( I ) + AA
00671                         S = S + AA
00672                      END DO
00673                      WORK( J-1 ) = WORK( J-1 ) + S
00674                   END DO
00675                   I = IDAMAX( N, WORK, 1 )
00676                   VALUE = WORK( I-1 )
00677                END IF
00678             END IF
00679          END IF
00680       ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
00681 *
00682 *       Find normF(A).
00683 *
00684          K = ( N+1 ) / 2
00685          SCALE = ZERO
00686          S = ONE
00687          IF( NOE.EQ.1 ) THEN
00688 *           n is odd
00689             IF( IFM.EQ.1 ) THEN
00690 *              A is normal
00691                IF( ILU.EQ.0 ) THEN
00692 *                 A is upper
00693                   DO J = 0, K - 3
00694                      CALL DLASSQ( K-J-2, A( K+J+1+J*LDA ), 1, SCALE, S )
00695 *                    L at A(k,0)
00696                   END DO
00697                   DO J = 0, K - 1
00698                      CALL DLASSQ( K+J-1, A( 0+J*LDA ), 1, SCALE, S )
00699 *                    trap U at A(0,0)
00700                   END DO
00701                   S = S + S
00702 *                 double s for the off diagonal elements
00703                   CALL DLASSQ( K-1, A( K ), LDA+1, SCALE, S )
00704 *                 tri L at A(k,0)
00705                   CALL DLASSQ( K, A( K-1 ), LDA+1, SCALE, S )
00706 *                 tri U at A(k-1,0)
00707                ELSE
00708 *                 ilu=1 & A is lower
00709                   DO J = 0, K - 1
00710                      CALL DLASSQ( N-J-1, A( J+1+J*LDA ), 1, SCALE, S )
00711 *                    trap L at A(0,0)
00712                   END DO
00713                   DO J = 0, K - 2
00714                      CALL DLASSQ( J, A( 0+( 1+J )*LDA ), 1, SCALE, S )
00715 *                    U at A(0,1)
00716                   END DO
00717                   S = S + S
00718 *                 double s for the off diagonal elements
00719                   CALL DLASSQ( K, A( 0 ), LDA+1, SCALE, S )
00720 *                 tri L at A(0,0)
00721                   CALL DLASSQ( K-1, A( 0+LDA ), LDA+1, SCALE, S )
00722 *                 tri U at A(0,1)
00723                END IF
00724             ELSE
00725 *              A is xpose
00726                IF( ILU.EQ.0 ) THEN
00727 *                 A' is upper
00728                   DO J = 1, K - 2
00729                      CALL DLASSQ( J, A( 0+( K+J )*LDA ), 1, SCALE, S )
00730 *                    U at A(0,k)
00731                   END DO
00732                   DO J = 0, K - 2
00733                      CALL DLASSQ( K, A( 0+J*LDA ), 1, SCALE, S )
00734 *                    k by k-1 rect. at A(0,0)
00735                   END DO
00736                   DO J = 0, K - 2
00737                      CALL DLASSQ( K-J-1, A( J+1+( J+K-1 )*LDA ), 1,
00738      +                            SCALE, S )
00739 *                    L at A(0,k-1)
00740                   END DO
00741                   S = S + S
00742 *                 double s for the off diagonal elements
00743                   CALL DLASSQ( K-1, A( 0+K*LDA ), LDA+1, SCALE, S )
00744 *                 tri U at A(0,k)
00745                   CALL DLASSQ( K, A( 0+( K-1 )*LDA ), LDA+1, SCALE, S )
00746 *                 tri L at A(0,k-1)
00747                ELSE
00748 *                 A' is lower
00749                   DO J = 1, K - 1
00750                      CALL DLASSQ( J, A( 0+J*LDA ), 1, SCALE, S )
00751 *                    U at A(0,0)
00752                   END DO
00753                   DO J = K, N - 1
00754                      CALL DLASSQ( K, A( 0+J*LDA ), 1, SCALE, S )
00755 *                    k by k-1 rect. at A(0,k)
00756                   END DO
00757                   DO J = 0, K - 3
00758                      CALL DLASSQ( K-J-2, A( J+2+J*LDA ), 1, SCALE, S )
00759 *                    L at A(1,0)
00760                   END DO
00761                   S = S + S
00762 *                 double s for the off diagonal elements
00763                   CALL DLASSQ( K, A( 0 ), LDA+1, SCALE, S )
00764 *                 tri U at A(0,0)
00765                   CALL DLASSQ( K-1, A( 1 ), LDA+1, SCALE, S )
00766 *                 tri L at A(1,0)
00767                END IF
00768             END IF
00769          ELSE
00770 *           n is even
00771             IF( IFM.EQ.1 ) THEN
00772 *              A is normal
00773                IF( ILU.EQ.0 ) THEN
00774 *                 A is upper
00775                   DO J = 0, K - 2
00776                      CALL DLASSQ( K-J-1, A( K+J+2+J*LDA ), 1, SCALE, S )
00777 *                    L at A(k+1,0)
00778                   END DO
00779                   DO J = 0, K - 1
00780                      CALL DLASSQ( K+J, A( 0+J*LDA ), 1, SCALE, S )
00781 *                    trap U at A(0,0)
00782                   END DO
00783                   S = S + S
00784 *                 double s for the off diagonal elements
00785                   CALL DLASSQ( K, A( K+1 ), LDA+1, SCALE, S )
00786 *                 tri L at A(k+1,0)
00787                   CALL DLASSQ( K, A( K ), LDA+1, SCALE, S )
00788 *                 tri U at A(k,0)
00789                ELSE
00790 *                 ilu=1 & A is lower
00791                   DO J = 0, K - 1
00792                      CALL DLASSQ( N-J-1, A( J+2+J*LDA ), 1, SCALE, S )
00793 *                    trap L at A(1,0)
00794                   END DO
00795                   DO J = 1, K - 1
00796                      CALL DLASSQ( J, A( 0+J*LDA ), 1, SCALE, S )
00797 *                    U at A(0,0)
00798                   END DO
00799                   S = S + S
00800 *                 double s for the off diagonal elements
00801                   CALL DLASSQ( K, A( 1 ), LDA+1, SCALE, S )
00802 *                 tri L at A(1,0)
00803                   CALL DLASSQ( K, A( 0 ), LDA+1, SCALE, S )
00804 *                 tri U at A(0,0)
00805                END IF
00806             ELSE
00807 *              A is xpose
00808                IF( ILU.EQ.0 ) THEN
00809 *                 A' is upper
00810                   DO J = 1, K - 1
00811                      CALL DLASSQ( J, A( 0+( K+1+J )*LDA ), 1, SCALE, S )
00812 *                    U at A(0,k+1)
00813                   END DO
00814                   DO J = 0, K - 1
00815                      CALL DLASSQ( K, A( 0+J*LDA ), 1, SCALE, S )
00816 *                    k by k rect. at A(0,0)
00817                   END DO
00818                   DO J = 0, K - 2
00819                      CALL DLASSQ( K-J-1, A( J+1+( J+K )*LDA ), 1, SCALE,
00820      +                            S )
00821 *                    L at A(0,k)
00822                   END DO
00823                   S = S + S
00824 *                 double s for the off diagonal elements
00825                   CALL DLASSQ( K, A( 0+( K+1 )*LDA ), LDA+1, SCALE, S )
00826 *                 tri U at A(0,k+1)
00827                   CALL DLASSQ( K, A( 0+K*LDA ), LDA+1, SCALE, S )
00828 *                 tri L at A(0,k)
00829                ELSE
00830 *                 A' is lower
00831                   DO J = 1, K - 1
00832                      CALL DLASSQ( J, A( 0+( J+1 )*LDA ), 1, SCALE, S )
00833 *                    U at A(0,1)
00834                   END DO
00835                   DO J = K + 1, N
00836                      CALL DLASSQ( K, A( 0+J*LDA ), 1, SCALE, S )
00837 *                    k by k rect. at A(0,k+1)
00838                   END DO
00839                   DO J = 0, K - 2
00840                      CALL DLASSQ( K-J-1, A( J+1+J*LDA ), 1, SCALE, S )
00841 *                    L at A(0,0)
00842                   END DO
00843                   S = S + S
00844 *                 double s for the off diagonal elements
00845                   CALL DLASSQ( K, A( LDA ), LDA+1, SCALE, S )
00846 *                 tri L at A(0,1)
00847                   CALL DLASSQ( K, A( 0 ), LDA+1, SCALE, S )
00848 *                 tri U at A(0,0)
00849                END IF
00850             END IF
00851          END IF
00852          VALUE = SCALE*SQRT( S )
00853       END IF
00854 *
00855       DLANSF = VALUE
00856       RETURN
00857 *
00858 *     End of DLANSF
00859 *
00860       END