001:       REAL FUNCTION SLANSF( NORM, TRANSR, UPLO, N, A, WORK )
002: *
003: *  -- LAPACK routine (version 3.2.1)                                    --
004: *
005: *  -- Contributed by Fred Gustavson of the IBM Watson Research Center --
006: *  -- April 2009                                                      --
007: *
008: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
009: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
010: *
011: *     .. Scalar Arguments ..
012:       CHARACTER          NORM, TRANSR, UPLO
013:       INTEGER            N
014: *     ..
015: *     .. Array Arguments ..
016:       REAL               A( 0: * ), WORK( 0: * )
017: *     ..
018: *
019: *  Purpose
020: *  =======
021: *
022: *  SLANSF returns the value of the one norm, or the Frobenius norm, or
023: *  the infinity norm, or the element of largest absolute value of a
024: *  real symmetric matrix A in RFP format.
025: *
026: *  Description
027: *  ===========
028: *
029: *  SLANSF returns the value
030: *
031: *     SLANSF = ( max(abs(A(i,j))), NORM = 'M' or 'm'
032: *              (
033: *              ( norm1(A),         NORM = '1', 'O' or 'o'
034: *              (
035: *              ( normI(A),         NORM = 'I' or 'i'
036: *              (
037: *              ( normF(A),         NORM = 'F', 'f', 'E' or 'e'
038: *
039: *  where  norm1  denotes the  one norm of a matrix (maximum column sum),
040: *  normI  denotes the  infinity norm  of a matrix  (maximum row sum) and
041: *  normF  denotes the  Frobenius norm of a matrix (square root of sum of
042: *  squares).  Note that  max(abs(A(i,j)))  is not a  matrix norm.
043: *
044: *  Arguments
045: *  =========
046: *
047: *  NORM    (input) CHARACTER
048: *          Specifies the value to be returned in SLANSF as described
049: *          above.
050: *
051: *  TRANSR  (input) CHARACTER
052: *          Specifies whether the RFP format of A is normal or
053: *          transposed format.
054: *          = 'N':  RFP format is Normal;
055: *          = 'T':  RFP format is Transpose.
056: *
057: *  UPLO    (input) CHARACTER
058: *           On entry, UPLO specifies whether the RFP matrix A came from
059: *           an upper or lower triangular matrix as follows:
060: *           = 'U': RFP A came from an upper triangular matrix;
061: *           = 'L': RFP A came from a lower triangular matrix.
062: *
063: *  N       (input) INTEGER
064: *          The order of the matrix A. N >= 0. When N = 0, SLANSF is
065: *          set to zero.
066: *
067: *  A       (input) REAL array, dimension ( N*(N+1)/2 );
068: *          On entry, the upper (if UPLO = 'U') or lower (if UPLO = 'L')
069: *          part of the symmetric matrix A stored in RFP format. See the
070: *          "Notes" below for more details.
071: *          Unchanged on exit.
072: *
073: *  WORK    (workspace) REAL array, dimension (MAX(1,LWORK)),
074: *          where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
075: *          WORK is not referenced.
076: *
077: *  Further Details
078: *  ===============
079: *
080: *  We first consider Rectangular Full Packed (RFP) Format when N is
081: *  even. We give an example where N = 6.
082: *
083: *      AP is Upper             AP is Lower
084: *
085: *   00 01 02 03 04 05       00
086: *      11 12 13 14 15       10 11
087: *         22 23 24 25       20 21 22
088: *            33 34 35       30 31 32 33
089: *               44 45       40 41 42 43 44
090: *                  55       50 51 52 53 54 55
091: *
092: *
093: *  Let TRANSR = 'N'. RFP holds AP as follows:
094: *  For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
095: *  three columns of AP upper. The lower triangle A(4:6,0:2) consists of
096: *  the transpose of the first three columns of AP upper.
097: *  For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
098: *  three columns of AP lower. The upper triangle A(0:2,0:2) consists of
099: *  the transpose of the last three columns of AP lower.
100: *  This covers the case N even and TRANSR = 'N'.
101: *
102: *         RFP A                   RFP A
103: *
104: *        03 04 05                33 43 53
105: *        13 14 15                00 44 54
106: *        23 24 25                10 11 55
107: *        33 34 35                20 21 22
108: *        00 44 45                30 31 32
109: *        01 11 55                40 41 42
110: *        02 12 22                50 51 52
111: *
112: *  Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
113: *  transpose of RFP A above. One therefore gets:
114: *
115: *
116: *           RFP A                   RFP A
117: *
118: *     03 13 23 33 00 01 02    33 00 10 20 30 40 50
119: *     04 14 24 34 44 11 12    43 44 11 21 31 41 51
120: *     05 15 25 35 45 55 22    53 54 55 22 32 42 52
121: *
122: *
123: *  We first consider Rectangular Full Packed (RFP) Format when N is
124: *  odd. We give an example where N = 5.
125: *
126: *     AP is Upper                 AP is Lower
127: *
128: *   00 01 02 03 04              00
129: *      11 12 13 14              10 11
130: *         22 23 24              20 21 22
131: *            33 34              30 31 32 33
132: *               44              40 41 42 43 44
133: *
134: *
135: *  Let TRANSR = 'N'. RFP holds AP as follows:
136: *  For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
137: *  three columns of AP upper. The lower triangle A(3:4,0:1) consists of
138: *  the transpose of the first two columns of AP upper.
139: *  For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
140: *  three columns of AP lower. The upper triangle A(0:1,1:2) consists of
141: *  the transpose of the last two columns of AP lower.
142: *  This covers the case N odd and TRANSR = 'N'.
143: *
144: *         RFP A                   RFP A
145: *
146: *        02 03 04                00 33 43
147: *        12 13 14                10 11 44
148: *        22 23 24                20 21 22
149: *        00 33 34                30 31 32
150: *        01 11 44                40 41 42
151: *
152: *  Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
153: *  transpose of RFP A above. One therefore gets:
154: *
155: *           RFP A                   RFP A
156: *
157: *     02 12 22 00 01             00 10 20 30 40 50
158: *     03 13 23 33 11             33 11 21 31 41 51
159: *     04 14 24 34 44             43 44 22 32 42 52
160: *
161: *  Reference
162: *  =========
163: *
164: *  =====================================================================
165: *
166: *     ..
167: *     .. Parameters ..
168:       REAL               ONE, ZERO
169:       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
170: *     ..
171: *     .. Local Scalars ..
172:       INTEGER            I, J, IFM, ILU, NOE, N1, K, L, LDA
173:       REAL               SCALE, S, VALUE, AA
174: *     ..
175: *     .. External Functions ..
176:       LOGICAL            LSAME
177:       INTEGER            ISAMAX
178:       EXTERNAL           LSAME, ISAMAX
179: *     ..
180: *     .. External Subroutines ..
181:       EXTERNAL           SLASSQ
182: *     ..
183: *     .. Intrinsic Functions ..
184:       INTRINSIC          ABS, MAX, SQRT
185: *     ..
186: *     .. Executable Statements ..
187: *
188:       IF( N.EQ.0 ) THEN
189:          SLANSF = ZERO
190:          RETURN
191:       END IF
192: *
193: *     set noe = 1 if n is odd. if n is even set noe=0
194: *
195:       NOE = 1
196:       IF( MOD( N, 2 ).EQ.0 )
197:      +   NOE = 0
198: *
199: *     set ifm = 0 when form='T or 't' and 1 otherwise
200: *
201:       IFM = 1
202:       IF( LSAME( TRANSR, 'T' ) )
203:      +   IFM = 0
204: *
205: *     set ilu = 0 when uplo='U or 'u' and 1 otherwise
206: *
207:       ILU = 1
208:       IF( LSAME( UPLO, 'U' ) )
209:      +   ILU = 0
210: *
211: *     set lda = (n+1)/2 when ifm = 0
212: *     set lda = n when ifm = 1 and noe = 1
213: *     set lda = n+1 when ifm = 1 and noe = 0
214: *
215:       IF( IFM.EQ.1 ) THEN
216:          IF( NOE.EQ.1 ) THEN
217:             LDA = N
218:          ELSE
219: *           noe=0
220:             LDA = N + 1
221:          END IF
222:       ELSE
223: *        ifm=0
224:          LDA = ( N+1 ) / 2
225:       END IF
226: *
227:       IF( LSAME( NORM, 'M' ) ) THEN
228: *
229: *       Find max(abs(A(i,j))).
230: *
231:          K = ( N+1 ) / 2
232:          VALUE = ZERO
233:          IF( NOE.EQ.1 ) THEN
234: *           n is odd
235:             IF( IFM.EQ.1 ) THEN
236: *           A is n by k
237:                DO J = 0, K - 1
238:                   DO I = 0, N - 1
239:                      VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
240:                   END DO
241:                END DO
242:             ELSE
243: *              xpose case; A is k by n
244:                DO J = 0, N - 1
245:                   DO I = 0, K - 1
246:                      VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
247:                   END DO
248:                END DO
249:             END IF
250:          ELSE
251: *           n is even
252:             IF( IFM.EQ.1 ) THEN
253: *              A is n+1 by k
254:                DO J = 0, K - 1
255:                   DO I = 0, N
256:                      VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
257:                   END DO
258:                END DO
259:             ELSE
260: *              xpose case; A is k by n+1
261:                DO J = 0, N
262:                   DO I = 0, K - 1
263:                      VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) )
264:                   END DO
265:                END DO
266:             END IF
267:          END IF
268:       ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR.
269:      +         ( NORM.EQ.'1' ) ) THEN
270: *
271: *        Find normI(A) ( = norm1(A), since A is symmetric).
272: *
273:          IF( IFM.EQ.1 ) THEN
274:             K = N / 2
275:             IF( NOE.EQ.1 ) THEN
276: *              n is odd
277:                IF( ILU.EQ.0 ) THEN
278:                   DO I = 0, K - 1
279:                      WORK( I ) = ZERO
280:                   END DO
281:                   DO J = 0, K
282:                      S = ZERO
283:                      DO I = 0, K + J - 1
284:                         AA = ABS( A( I+J*LDA ) )
285: *                       -> A(i,j+k)
286:                         S = S + AA
287:                         WORK( I ) = WORK( I ) + AA
288:                      END DO
289:                      AA = ABS( A( I+J*LDA ) )
290: *                    -> A(j+k,j+k)
291:                      WORK( J+K ) = S + AA
292:                      IF( I.EQ.K+K )
293:      +                  GO TO 10
294:                      I = I + 1
295:                      AA = ABS( A( I+J*LDA ) )
296: *                    -> A(j,j)
297:                      WORK( J ) = WORK( J ) + AA
298:                      S = ZERO
299:                      DO L = J + 1, K - 1
300:                         I = I + 1
301:                         AA = ABS( A( I+J*LDA ) )
302: *                       -> A(l,j)
303:                         S = S + AA
304:                         WORK( L ) = WORK( L ) + AA
305:                      END DO
306:                      WORK( J ) = WORK( J ) + S
307:                   END DO
308:    10             CONTINUE
309:                   I = ISAMAX( N, WORK, 1 )
310:                   VALUE = WORK( I-1 )
311:                ELSE
312: *                 ilu = 1
313:                   K = K + 1
314: *                 k=(n+1)/2 for n odd and ilu=1
315:                   DO I = K, N - 1
316:                      WORK( I ) = ZERO
317:                   END DO
318:                   DO J = K - 1, 0, -1
319:                      S = ZERO
320:                      DO I = 0, J - 2
321:                         AA = ABS( A( I+J*LDA ) )
322: *                       -> A(j+k,i+k)
323:                         S = S + AA
324:                         WORK( I+K ) = WORK( I+K ) + AA
325:                      END DO
326:                      IF( J.GT.0 ) THEN
327:                         AA = ABS( A( I+J*LDA ) )
328: *                       -> A(j+k,j+k)
329:                         S = S + AA
330:                         WORK( I+K ) = WORK( I+K ) + S
331: *                       i=j
332:                         I = I + 1
333:                      END IF
334:                      AA = ABS( A( I+J*LDA ) )
335: *                    -> A(j,j)
336:                      WORK( J ) = AA
337:                      S = ZERO
338:                      DO L = J + 1, N - 1
339:                         I = I + 1
340:                         AA = ABS( A( I+J*LDA ) )
341: *                       -> A(l,j)
342:                         S = S + AA
343:                         WORK( L ) = WORK( L ) + AA
344:                      END DO
345:                      WORK( J ) = WORK( J ) + S
346:                   END DO
347:                   I = ISAMAX( N, WORK, 1 )
348:                   VALUE = WORK( I-1 )
349:                END IF
350:             ELSE
351: *              n is even
352:                IF( ILU.EQ.0 ) THEN
353:                   DO I = 0, K - 1
354:                      WORK( I ) = ZERO
355:                   END DO
356:                   DO J = 0, K - 1
357:                      S = ZERO
358:                      DO I = 0, K + J - 1
359:                         AA = ABS( A( I+J*LDA ) )
360: *                       -> A(i,j+k)
361:                         S = S + AA
362:                         WORK( I ) = WORK( I ) + AA
363:                      END DO
364:                      AA = ABS( A( I+J*LDA ) )
365: *                    -> A(j+k,j+k)
366:                      WORK( J+K ) = S + AA
367:                      I = I + 1
368:                      AA = ABS( A( I+J*LDA ) )
369: *                    -> A(j,j)
370:                      WORK( J ) = WORK( J ) + AA
371:                      S = ZERO
372:                      DO L = J + 1, K - 1
373:                         I = I + 1
374:                         AA = ABS( A( I+J*LDA ) )
375: *                       -> A(l,j)
376:                         S = S + AA
377:                         WORK( L ) = WORK( L ) + AA
378:                      END DO
379:                      WORK( J ) = WORK( J ) + S
380:                   END DO
381:                   I = ISAMAX( N, WORK, 1 )
382:                   VALUE = WORK( I-1 )
383:                ELSE
384: *                 ilu = 1
385:                   DO I = K, N - 1
386:                      WORK( I ) = ZERO
387:                   END DO
388:                   DO J = K - 1, 0, -1
389:                      S = ZERO
390:                      DO I = 0, J - 1
391:                         AA = ABS( A( I+J*LDA ) )
392: *                       -> A(j+k,i+k)
393:                         S = S + AA
394:                         WORK( I+K ) = WORK( I+K ) + AA
395:                      END DO
396:                      AA = ABS( A( I+J*LDA ) )
397: *                    -> A(j+k,j+k)
398:                      S = S + AA
399:                      WORK( I+K ) = WORK( I+K ) + S
400: *                    i=j
401:                      I = I + 1
402:                      AA = ABS( A( I+J*LDA ) )
403: *                    -> A(j,j)
404:                      WORK( J ) = AA
405:                      S = ZERO
406:                      DO L = J + 1, N - 1
407:                         I = I + 1
408:                         AA = ABS( A( I+J*LDA ) )
409: *                       -> A(l,j)
410:                         S = S + AA
411:                         WORK( L ) = WORK( L ) + AA
412:                      END DO
413:                      WORK( J ) = WORK( J ) + S
414:                   END DO
415:                   I = ISAMAX( N, WORK, 1 )
416:                   VALUE = WORK( I-1 )
417:                END IF
418:             END IF
419:          ELSE
420: *           ifm=0
421:             K = N / 2
422:             IF( NOE.EQ.1 ) THEN
423: *              n is odd
424:                IF( ILU.EQ.0 ) THEN
425:                   N1 = K
426: *                 n/2
427:                   K = K + 1
428: *                 k is the row size and lda
429:                   DO I = N1, N - 1
430:                      WORK( I ) = ZERO
431:                   END DO
432:                   DO J = 0, N1 - 1
433:                      S = ZERO
434:                      DO I = 0, K - 1
435:                         AA = ABS( A( I+J*LDA ) )
436: *                       A(j,n1+i)
437:                         WORK( I+N1 ) = WORK( I+N1 ) + AA
438:                         S = S + AA
439:                      END DO
440:                      WORK( J ) = S
441:                   END DO
442: *                 j=n1=k-1 is special
443:                   S = ABS( A( 0+J*LDA ) )
444: *                 A(k-1,k-1)
445:                   DO I = 1, K - 1
446:                      AA = ABS( A( I+J*LDA ) )
447: *                    A(k-1,i+n1)
448:                      WORK( I+N1 ) = WORK( I+N1 ) + AA
449:                      S = S + AA
450:                   END DO
451:                   WORK( J ) = WORK( J ) + S
452:                   DO J = K, N - 1
453:                      S = ZERO
454:                      DO I = 0, J - K - 1
455:                         AA = ABS( A( I+J*LDA ) )
456: *                       A(i,j-k)
457:                         WORK( I ) = WORK( I ) + AA
458:                         S = S + AA
459:                      END DO
460: *                    i=j-k
461:                      AA = ABS( A( I+J*LDA ) )
462: *                    A(j-k,j-k)
463:                      S = S + AA
464:                      WORK( J-K ) = WORK( J-K ) + S
465:                      I = I + 1
466:                      S = ABS( A( I+J*LDA ) )
467: *                    A(j,j)
468:                      DO L = J + 1, N - 1
469:                         I = I + 1
470:                         AA = ABS( A( I+J*LDA ) )
471: *                       A(j,l)
472:                         WORK( L ) = WORK( L ) + AA
473:                         S = S + AA
474:                      END DO
475:                      WORK( J ) = WORK( J ) + S
476:                   END DO
477:                   I = ISAMAX( N, WORK, 1 )
478:                   VALUE = WORK( I-1 )
479:                ELSE
480: *                 ilu=1
481:                   K = K + 1
482: *                 k=(n+1)/2 for n odd and ilu=1
483:                   DO I = K, N - 1
484:                      WORK( I ) = ZERO
485:                   END DO
486:                   DO J = 0, K - 2
487: *                    process
488:                      S = ZERO
489:                      DO I = 0, J - 1
490:                         AA = ABS( A( I+J*LDA ) )
491: *                       A(j,i)
492:                         WORK( I ) = WORK( I ) + AA
493:                         S = S + AA
494:                      END DO
495:                      AA = ABS( A( I+J*LDA ) )
496: *                    i=j so process of A(j,j)
497:                      S = S + AA
498:                      WORK( J ) = S
499: *                    is initialised here
500:                      I = I + 1
501: *                    i=j process A(j+k,j+k)
502:                      AA = ABS( A( I+J*LDA ) )
503:                      S = AA
504:                      DO L = K + J + 1, N - 1
505:                         I = I + 1
506:                         AA = ABS( A( I+J*LDA ) )
507: *                       A(l,k+j)
508:                         S = S + AA
509:                         WORK( L ) = WORK( L ) + AA
510:                      END DO
511:                      WORK( K+J ) = WORK( K+J ) + S
512:                   END DO
513: *                 j=k-1 is special :process col A(k-1,0:k-1)
514:                   S = ZERO
515:                   DO I = 0, K - 2
516:                      AA = ABS( A( I+J*LDA ) )
517: *                    A(k,i)
518:                      WORK( I ) = WORK( I ) + AA
519:                      S = S + AA
520:                   END DO
521: *                 i=k-1
522:                   AA = ABS( A( I+J*LDA ) )
523: *                 A(k-1,k-1)
524:                   S = S + AA
525:                   WORK( I ) = S
526: *                 done with col j=k+1
527:                   DO J = K, N - 1
528: *                    process col j of A = A(j,0:k-1)
529:                      S = ZERO
530:                      DO I = 0, K - 1
531:                         AA = ABS( A( I+J*LDA ) )
532: *                       A(j,i)
533:                         WORK( I ) = WORK( I ) + AA
534:                         S = S + AA
535:                      END DO
536:                      WORK( J ) = WORK( J ) + S
537:                   END DO
538:                   I = ISAMAX( N, WORK, 1 )
539:                   VALUE = WORK( I-1 )
540:                END IF
541:             ELSE
542: *              n is even
543:                IF( ILU.EQ.0 ) THEN
544:                   DO I = K, N - 1
545:                      WORK( I ) = ZERO
546:                   END DO
547:                   DO J = 0, K - 1
548:                      S = ZERO
549:                      DO I = 0, K - 1
550:                         AA = ABS( A( I+J*LDA ) )
551: *                       A(j,i+k)
552:                         WORK( I+K ) = WORK( I+K ) + AA
553:                         S = S + AA
554:                      END DO
555:                      WORK( J ) = S
556:                   END DO
557: *                 j=k
558:                   AA = ABS( A( 0+J*LDA ) )
559: *                 A(k,k)
560:                   S = AA
561:                   DO I = 1, K - 1
562:                      AA = ABS( A( I+J*LDA ) )
563: *                    A(k,k+i)
564:                      WORK( I+K ) = WORK( I+K ) + AA
565:                      S = S + AA
566:                   END DO
567:                   WORK( J ) = WORK( J ) + S
568:                   DO J = K + 1, N - 1
569:                      S = ZERO
570:                      DO I = 0, J - 2 - K
571:                         AA = ABS( A( I+J*LDA ) )
572: *                       A(i,j-k-1)
573:                         WORK( I ) = WORK( I ) + AA
574:                         S = S + AA
575:                      END DO
576: *                     i=j-1-k
577:                      AA = ABS( A( I+J*LDA ) )
578: *                    A(j-k-1,j-k-1)
579:                      S = S + AA
580:                      WORK( J-K-1 ) = WORK( J-K-1 ) + S
581:                      I = I + 1
582:                      AA = ABS( A( I+J*LDA ) )
583: *                    A(j,j)
584:                      S = AA
585:                      DO L = J + 1, N - 1
586:                         I = I + 1
587:                         AA = ABS( A( I+J*LDA ) )
588: *                       A(j,l)
589:                         WORK( L ) = WORK( L ) + AA
590:                         S = S + AA
591:                      END DO
592:                      WORK( J ) = WORK( J ) + S
593:                   END DO
594: *                 j=n
595:                   S = ZERO
596:                   DO I = 0, K - 2
597:                      AA = ABS( A( I+J*LDA ) )
598: *                    A(i,k-1)
599:                      WORK( I ) = WORK( I ) + AA
600:                      S = S + AA
601:                   END DO
602: *                 i=k-1
603:                   AA = ABS( A( I+J*LDA ) )
604: *                 A(k-1,k-1)
605:                   S = S + AA
606:                   WORK( I ) = WORK( I ) + S
607:                   I = ISAMAX( N, WORK, 1 )
608:                   VALUE = WORK( I-1 )
609:                ELSE
610: *                 ilu=1
611:                   DO I = K, N - 1
612:                      WORK( I ) = ZERO
613:                   END DO
614: *                 j=0 is special :process col A(k:n-1,k)
615:                   S = ABS( A( 0 ) )
616: *                 A(k,k)
617:                   DO I = 1, K - 1
618:                      AA = ABS( A( I ) )
619: *                    A(k+i,k)
620:                      WORK( I+K ) = WORK( I+K ) + AA
621:                      S = S + AA
622:                   END DO
623:                   WORK( K ) = WORK( K ) + S
624:                   DO J = 1, K - 1
625: *                    process
626:                      S = ZERO
627:                      DO I = 0, J - 2
628:                         AA = ABS( A( I+J*LDA ) )
629: *                       A(j-1,i)
630:                         WORK( I ) = WORK( I ) + AA
631:                         S = S + AA
632:                      END DO
633:                      AA = ABS( A( I+J*LDA ) )
634: *                    i=j-1 so process of A(j-1,j-1)
635:                      S = S + AA
636:                      WORK( J-1 ) = S
637: *                    is initialised here
638:                      I = I + 1
639: *                    i=j process A(j+k,j+k)
640:                      AA = ABS( A( I+J*LDA ) )
641:                      S = AA
642:                      DO L = K + J + 1, N - 1
643:                         I = I + 1
644:                         AA = ABS( A( I+J*LDA ) )
645: *                       A(l,k+j)
646:                         S = S + AA
647:                         WORK( L ) = WORK( L ) + AA
648:                      END DO
649:                      WORK( K+J ) = WORK( K+J ) + S
650:                   END DO
651: *                 j=k is special :process col A(k,0:k-1)
652:                   S = ZERO
653:                   DO I = 0, K - 2
654:                      AA = ABS( A( I+J*LDA ) )
655: *                    A(k,i)
656:                      WORK( I ) = WORK( I ) + AA
657:                      S = S + AA
658:                   END DO
659: *                 i=k-1
660:                   AA = ABS( A( I+J*LDA ) )
661: *                 A(k-1,k-1)
662:                   S = S + AA
663:                   WORK( I ) = S
664: *                 done with col j=k+1
665:                   DO J = K + 1, N
666: *                    process col j-1 of A = A(j-1,0:k-1)
667:                      S = ZERO
668:                      DO I = 0, K - 1
669:                         AA = ABS( A( I+J*LDA ) )
670: *                       A(j-1,i)
671:                         WORK( I ) = WORK( I ) + AA
672:                         S = S + AA
673:                      END DO
674:                      WORK( J-1 ) = WORK( J-1 ) + S
675:                   END DO
676:                   I = ISAMAX( N, WORK, 1 )
677:                   VALUE = WORK( I-1 )
678:                END IF
679:             END IF
680:          END IF
681:       ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
682: *
683: *       Find normF(A).
684: *
685:          K = ( N+1 ) / 2
686:          SCALE = ZERO
687:          S = ONE
688:          IF( NOE.EQ.1 ) THEN
689: *           n is odd
690:             IF( IFM.EQ.1 ) THEN
691: *              A is normal
692:                IF( ILU.EQ.0 ) THEN
693: *                 A is upper
694:                   DO J = 0, K - 3
695:                      CALL SLASSQ( K-J-2, A( K+J+1+J*LDA ), 1, SCALE, S )
696: *                    L at A(k,0)
697:                   END DO
698:                   DO J = 0, K - 1
699:                      CALL SLASSQ( K+J-1, A( 0+J*LDA ), 1, SCALE, S )
700: *                    trap U at A(0,0)
701:                   END DO
702:                   S = S + S
703: *                 double s for the off diagonal elements
704:                   CALL SLASSQ( K-1, A( K ), LDA+1, SCALE, S )
705: *                 tri L at A(k,0)
706:                   CALL SLASSQ( K, A( K-1 ), LDA+1, SCALE, S )
707: *                 tri U at A(k-1,0)
708:                ELSE
709: *                 ilu=1 & A is lower
710:                   DO J = 0, K - 1
711:                      CALL SLASSQ( N-J-1, A( J+1+J*LDA ), 1, SCALE, S )
712: *                    trap L at A(0,0)
713:                   END DO
714:                   DO J = 0, K - 2
715:                      CALL SLASSQ( J, A( 0+( 1+J )*LDA ), 1, SCALE, S )
716: *                    U at A(0,1)
717:                   END DO
718:                   S = S + S
719: *                 double s for the off diagonal elements
720:                   CALL SLASSQ( K, A( 0 ), LDA+1, SCALE, S )
721: *                 tri L at A(0,0)
722:                   CALL SLASSQ( K-1, A( 0+LDA ), LDA+1, SCALE, S )
723: *                 tri U at A(0,1)
724:                END IF
725:             ELSE
726: *              A is xpose
727:                IF( ILU.EQ.0 ) THEN
728: *                 A' is upper
729:                   DO J = 1, K - 2
730:                      CALL SLASSQ( J, A( 0+( K+J )*LDA ), 1, SCALE, S )
731: *                    U at A(0,k)
732:                   END DO
733:                   DO J = 0, K - 2
734:                      CALL SLASSQ( K, A( 0+J*LDA ), 1, SCALE, S )
735: *                    k by k-1 rect. at A(0,0)
736:                   END DO
737:                   DO J = 0, K - 2
738:                      CALL SLASSQ( K-J-1, A( J+1+( J+K-1 )*LDA ), 1,
739:      +                            SCALE, S )
740: *                    L at A(0,k-1)
741:                   END DO
742:                   S = S + S
743: *                 double s for the off diagonal elements
744:                   CALL SLASSQ( K-1, A( 0+K*LDA ), LDA+1, SCALE, S )
745: *                 tri U at A(0,k)
746:                   CALL SLASSQ( K, A( 0+( K-1 )*LDA ), LDA+1, SCALE, S )
747: *                 tri L at A(0,k-1)
748:                ELSE
749: *                 A' is lower
750:                   DO J = 1, K - 1
751:                      CALL SLASSQ( J, A( 0+J*LDA ), 1, SCALE, S )
752: *                    U at A(0,0)
753:                   END DO
754:                   DO J = K, N - 1
755:                      CALL SLASSQ( K, A( 0+J*LDA ), 1, SCALE, S )
756: *                    k by k-1 rect. at A(0,k)
757:                   END DO
758:                   DO J = 0, K - 3
759:                      CALL SLASSQ( K-J-2, A( J+2+J*LDA ), 1, SCALE, S )
760: *                    L at A(1,0)
761:                   END DO
762:                   S = S + S
763: *                 double s for the off diagonal elements
764:                   CALL SLASSQ( K, A( 0 ), LDA+1, SCALE, S )
765: *                 tri U at A(0,0)
766:                   CALL SLASSQ( K-1, A( 1 ), LDA+1, SCALE, S )
767: *                 tri L at A(1,0)
768:                END IF
769:             END IF
770:          ELSE
771: *           n is even
772:             IF( IFM.EQ.1 ) THEN
773: *              A is normal
774:                IF( ILU.EQ.0 ) THEN
775: *                 A is upper
776:                   DO J = 0, K - 2
777:                      CALL SLASSQ( K-J-1, A( K+J+2+J*LDA ), 1, SCALE, S )
778: *                    L at A(k+1,0)
779:                   END DO
780:                   DO J = 0, K - 1
781:                      CALL SLASSQ( K+J, A( 0+J*LDA ), 1, SCALE, S )
782: *                    trap U at A(0,0)
783:                   END DO
784:                   S = S + S
785: *                 double s for the off diagonal elements
786:                   CALL SLASSQ( K, A( K+1 ), LDA+1, SCALE, S )
787: *                 tri L at A(k+1,0)
788:                   CALL SLASSQ( K, A( K ), LDA+1, SCALE, S )
789: *                 tri U at A(k,0)
790:                ELSE
791: *                 ilu=1 & A is lower
792:                   DO J = 0, K - 1
793:                      CALL SLASSQ( N-J-1, A( J+2+J*LDA ), 1, SCALE, S )
794: *                    trap L at A(1,0)
795:                   END DO
796:                   DO J = 1, K - 1
797:                      CALL SLASSQ( J, A( 0+J*LDA ), 1, SCALE, S )
798: *                    U at A(0,0)
799:                   END DO
800:                   S = S + S
801: *                 double s for the off diagonal elements
802:                   CALL SLASSQ( K, A( 1 ), LDA+1, SCALE, S )
803: *                 tri L at A(1,0)
804:                   CALL SLASSQ( K, A( 0 ), LDA+1, SCALE, S )
805: *                 tri U at A(0,0)
806:                END IF
807:             ELSE
808: *              A is xpose
809:                IF( ILU.EQ.0 ) THEN
810: *                 A' is upper
811:                   DO J = 1, K - 1
812:                      CALL SLASSQ( J, A( 0+( K+1+J )*LDA ), 1, SCALE, S )
813: *                    U at A(0,k+1)
814:                   END DO
815:                   DO J = 0, K - 1
816:                      CALL SLASSQ( K, A( 0+J*LDA ), 1, SCALE, S )
817: *                    k by k rect. at A(0,0)
818:                   END DO
819:                   DO J = 0, K - 2
820:                      CALL SLASSQ( K-J-1, A( J+1+( J+K )*LDA ), 1, SCALE,
821:      +                            S )
822: *                    L at A(0,k)
823:                   END DO
824:                   S = S + S
825: *                 double s for the off diagonal elements
826:                   CALL SLASSQ( K, A( 0+( K+1 )*LDA ), LDA+1, SCALE, S )
827: *                 tri U at A(0,k+1)
828:                   CALL SLASSQ( K, A( 0+K*LDA ), LDA+1, SCALE, S )
829: *                 tri L at A(0,k)
830:                ELSE
831: *                 A' is lower
832:                   DO J = 1, K - 1
833:                      CALL SLASSQ( J, A( 0+( J+1 )*LDA ), 1, SCALE, S )
834: *                    U at A(0,1)
835:                   END DO
836:                   DO J = K + 1, N
837:                      CALL SLASSQ( K, A( 0+J*LDA ), 1, SCALE, S )
838: *                    k by k rect. at A(0,k+1)
839:                   END DO
840:                   DO J = 0, K - 2
841:                      CALL SLASSQ( K-J-1, A( J+1+J*LDA ), 1, SCALE, S )
842: *                    L at A(0,0)
843:                   END DO
844:                   S = S + S
845: *                 double s for the off diagonal elements
846:                   CALL SLASSQ( K, A( LDA ), LDA+1, SCALE, S )
847: *                 tri L at A(0,1)
848:                   CALL SLASSQ( K, A( 0 ), LDA+1, SCALE, S )
849: *                 tri U at A(0,0)
850:                END IF
851:             END IF
852:          END IF
853:          VALUE = SCALE*SQRT( S )
854:       END IF
855: *
856:       SLANSF = VALUE
857:       RETURN
858: *
859: *     End of SLANSF
860: *
861:       END
862: