LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
dlansf.f
Go to the documentation of this file.
1 *> \brief \b DLANSF
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download DLANSF + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlansf.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlansf.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlansf.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * DOUBLE PRECISION FUNCTION DLANSF( NORM, TRANSR, UPLO, N, A, WORK )
22 *
23 * .. Scalar Arguments ..
24 * CHARACTER NORM, TRANSR, UPLO
25 * INTEGER N
26 * ..
27 * .. Array Arguments ..
28 * DOUBLE PRECISION A( 0: * ), WORK( 0: * )
29 * ..
30 *
31 *
32 *> \par Purpose:
33 * =============
34 *>
35 *> \verbatim
36 *>
37 *> DLANSF 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 DLANSF
43 *> \verbatim
44 *>
45 *> DLANSF = ( 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 DLANSF 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, DLANSF is
91 *> set to zero.
92 *> \endverbatim
93 *>
94 *> \param[in] A
95 *> \verbatim
96 *> A is DOUBLE PRECISION 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 DOUBLE PRECISION 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 November 2011
119 *
120 *> \ingroup doubleOTHERcomputational
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  DOUBLE PRECISION FUNCTION dlansf( NORM, TRANSR, UPLO, N, A, WORK )
211 *
212 * -- LAPACK computational routine (version 3.4.0) --
213 * -- LAPACK is a software package provided by Univ. of Tennessee, --
214 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
215 * November 2011
216 *
217 * .. Scalar Arguments ..
218  CHARACTER norm, transr, uplo
219  INTEGER n
220 * ..
221 * .. Array Arguments ..
222  DOUBLE PRECISION a( 0: * ), work( 0: * )
223 * ..
224 *
225 * =====================================================================
226 *
227 * .. Parameters ..
228  DOUBLE PRECISION one, zero
229  parameter( one = 1.0d+0, zero = 0.0d+0 )
230 * ..
231 * .. Local Scalars ..
232  INTEGER i, j, ifm, ilu, noe, n1, k, l, lda
233  DOUBLE PRECISION scale, s, value, aa
234 * ..
235 * .. External Functions ..
236  LOGICAL lsame
237  INTEGER idamax
238  EXTERNAL lsame, idamax
239 * ..
240 * .. External Subroutines ..
241  EXTERNAL dlassq
242 * ..
243 * .. Intrinsic Functions ..
244  INTRINSIC abs, max, sqrt
245 * ..
246 * .. Executable Statements ..
247 *
248  IF( n.EQ.0 ) THEN
249  dlansf = zero
250  RETURN
251  ELSE IF( n.EQ.1 ) THEN
252  dlansf = 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  value = max( value, abs( a( i+j*lda ) ) )
303  END DO
304  END DO
305  ELSE
306 * xpose case; A is k by n
307  DO j = 0, n - 1
308  DO i = 0, k - 1
309  value = max( value, abs( a( i+j*lda ) ) )
310  END DO
311  END DO
312  END IF
313  ELSE
314 * n is even
315  IF( ifm.EQ.1 ) THEN
316 * A is n+1 by k
317  DO j = 0, k - 1
318  DO i = 0, n
319  value = max( value, abs( a( i+j*lda ) ) )
320  END DO
321  END DO
322  ELSE
323 * xpose case; A is k by n+1
324  DO j = 0, n
325  DO i = 0, k - 1
326  value = max( value, abs( a( i+j*lda ) ) )
327  END DO
328  END DO
329  END IF
330  END IF
331  ELSE IF( ( lsame( norm, 'I' ) ) .OR. ( lsame( norm, 'O' ) ) .OR.
332  $ ( norm.EQ.'1' ) ) THEN
333 *
334 * Find normI(A) ( = norm1(A), since A is symmetric).
335 *
336  IF( ifm.EQ.1 ) THEN
337  k = n / 2
338  IF( noe.EQ.1 ) THEN
339 * n is odd
340  IF( ilu.EQ.0 ) THEN
341  DO i = 0, k - 1
342  work( i ) = zero
343  END DO
344  DO j = 0, k
345  s = zero
346  DO i = 0, k + j - 1
347  aa = abs( a( i+j*lda ) )
348 * -> A(i,j+k)
349  s = s + aa
350  work( i ) = work( i ) + aa
351  END DO
352  aa = abs( a( i+j*lda ) )
353 * -> A(j+k,j+k)
354  work( j+k ) = s + aa
355  IF( i.EQ.k+k )
356  $ go to 10
357  i = i + 1
358  aa = abs( a( i+j*lda ) )
359 * -> A(j,j)
360  work( j ) = work( j ) + aa
361  s = zero
362  DO l = j + 1, k - 1
363  i = i + 1
364  aa = abs( a( i+j*lda ) )
365 * -> A(l,j)
366  s = s + aa
367  work( l ) = work( l ) + aa
368  END DO
369  work( j ) = work( j ) + s
370  END DO
371  10 CONTINUE
372  i = idamax( n, work, 1 )
373  value = work( i-1 )
374  ELSE
375 * ilu = 1
376  k = k + 1
377 * k=(n+1)/2 for n odd and ilu=1
378  DO i = k, n - 1
379  work( i ) = zero
380  END DO
381  DO j = k - 1, 0, -1
382  s = zero
383  DO i = 0, j - 2
384  aa = abs( a( i+j*lda ) )
385 * -> A(j+k,i+k)
386  s = s + aa
387  work( i+k ) = work( i+k ) + aa
388  END DO
389  IF( j.GT.0 ) THEN
390  aa = abs( a( i+j*lda ) )
391 * -> A(j+k,j+k)
392  s = s + aa
393  work( i+k ) = work( i+k ) + s
394 * i=j
395  i = i + 1
396  END IF
397  aa = abs( a( i+j*lda ) )
398 * -> A(j,j)
399  work( j ) = aa
400  s = zero
401  DO l = j + 1, n - 1
402  i = i + 1
403  aa = abs( a( i+j*lda ) )
404 * -> A(l,j)
405  s = s + aa
406  work( l ) = work( l ) + aa
407  END DO
408  work( j ) = work( j ) + s
409  END DO
410  i = idamax( n, work, 1 )
411  value = work( i-1 )
412  END IF
413  ELSE
414 * n is even
415  IF( ilu.EQ.0 ) THEN
416  DO i = 0, k - 1
417  work( i ) = zero
418  END DO
419  DO j = 0, k - 1
420  s = zero
421  DO i = 0, k + j - 1
422  aa = abs( a( i+j*lda ) )
423 * -> A(i,j+k)
424  s = s + aa
425  work( i ) = work( i ) + aa
426  END DO
427  aa = abs( a( i+j*lda ) )
428 * -> A(j+k,j+k)
429  work( j+k ) = s + aa
430  i = i + 1
431  aa = abs( a( i+j*lda ) )
432 * -> A(j,j)
433  work( j ) = work( j ) + aa
434  s = zero
435  DO l = j + 1, k - 1
436  i = i + 1
437  aa = abs( a( i+j*lda ) )
438 * -> A(l,j)
439  s = s + aa
440  work( l ) = work( l ) + aa
441  END DO
442  work( j ) = work( j ) + s
443  END DO
444  i = idamax( n, work, 1 )
445  value = work( i-1 )
446  ELSE
447 * ilu = 1
448  DO i = k, n - 1
449  work( i ) = zero
450  END DO
451  DO j = k - 1, 0, -1
452  s = zero
453  DO i = 0, j - 1
454  aa = abs( a( i+j*lda ) )
455 * -> A(j+k,i+k)
456  s = s + aa
457  work( i+k ) = work( i+k ) + aa
458  END DO
459  aa = abs( a( i+j*lda ) )
460 * -> A(j+k,j+k)
461  s = s + aa
462  work( i+k ) = work( i+k ) + s
463 * i=j
464  i = i + 1
465  aa = abs( a( i+j*lda ) )
466 * -> A(j,j)
467  work( j ) = aa
468  s = zero
469  DO l = j + 1, n - 1
470  i = i + 1
471  aa = abs( a( i+j*lda ) )
472 * -> A(l,j)
473  s = s + aa
474  work( l ) = work( l ) + aa
475  END DO
476  work( j ) = work( j ) + s
477  END DO
478  i = idamax( n, work, 1 )
479  value = work( i-1 )
480  END IF
481  END IF
482  ELSE
483 * ifm=0
484  k = n / 2
485  IF( noe.EQ.1 ) THEN
486 * n is odd
487  IF( ilu.EQ.0 ) THEN
488  n1 = k
489 * n/2
490  k = k + 1
491 * k is the row size and lda
492  DO i = n1, n - 1
493  work( i ) = zero
494  END DO
495  DO j = 0, n1 - 1
496  s = zero
497  DO i = 0, k - 1
498  aa = abs( a( i+j*lda ) )
499 * A(j,n1+i)
500  work( i+n1 ) = work( i+n1 ) + aa
501  s = s + aa
502  END DO
503  work( j ) = s
504  END DO
505 * j=n1=k-1 is special
506  s = abs( a( 0+j*lda ) )
507 * A(k-1,k-1)
508  DO i = 1, k - 1
509  aa = abs( a( i+j*lda ) )
510 * A(k-1,i+n1)
511  work( i+n1 ) = work( i+n1 ) + aa
512  s = s + aa
513  END DO
514  work( j ) = work( j ) + s
515  DO j = k, n - 1
516  s = zero
517  DO i = 0, j - k - 1
518  aa = abs( a( i+j*lda ) )
519 * A(i,j-k)
520  work( i ) = work( i ) + aa
521  s = s + aa
522  END DO
523 * i=j-k
524  aa = abs( a( i+j*lda ) )
525 * A(j-k,j-k)
526  s = s + aa
527  work( j-k ) = work( j-k ) + s
528  i = i + 1
529  s = abs( a( i+j*lda ) )
530 * A(j,j)
531  DO l = j + 1, n - 1
532  i = i + 1
533  aa = abs( a( i+j*lda ) )
534 * A(j,l)
535  work( l ) = work( l ) + aa
536  s = s + aa
537  END DO
538  work( j ) = work( j ) + s
539  END DO
540  i = idamax( n, work, 1 )
541  value = work( i-1 )
542  ELSE
543 * ilu=1
544  k = k + 1
545 * k=(n+1)/2 for n odd and ilu=1
546  DO i = k, n - 1
547  work( i ) = zero
548  END DO
549  DO j = 0, k - 2
550 * process
551  s = zero
552  DO i = 0, j - 1
553  aa = abs( a( i+j*lda ) )
554 * A(j,i)
555  work( i ) = work( i ) + aa
556  s = s + aa
557  END DO
558  aa = abs( a( i+j*lda ) )
559 * i=j so process of A(j,j)
560  s = s + aa
561  work( j ) = s
562 * is initialised here
563  i = i + 1
564 * i=j process A(j+k,j+k)
565  aa = abs( a( i+j*lda ) )
566  s = aa
567  DO l = k + j + 1, n - 1
568  i = i + 1
569  aa = abs( a( i+j*lda ) )
570 * A(l,k+j)
571  s = s + aa
572  work( l ) = work( l ) + aa
573  END DO
574  work( k+j ) = work( k+j ) + s
575  END DO
576 * j=k-1 is special :process col A(k-1,0:k-1)
577  s = zero
578  DO i = 0, k - 2
579  aa = abs( a( i+j*lda ) )
580 * A(k,i)
581  work( i ) = work( i ) + aa
582  s = s + aa
583  END DO
584 * i=k-1
585  aa = abs( a( i+j*lda ) )
586 * A(k-1,k-1)
587  s = s + aa
588  work( i ) = s
589 * done with col j=k+1
590  DO j = k, n - 1
591 * process col j of A = A(j,0:k-1)
592  s = zero
593  DO i = 0, k - 1
594  aa = abs( a( i+j*lda ) )
595 * A(j,i)
596  work( i ) = work( i ) + aa
597  s = s + aa
598  END DO
599  work( j ) = work( j ) + s
600  END DO
601  i = idamax( n, work, 1 )
602  value = work( i-1 )
603  END IF
604  ELSE
605 * n is even
606  IF( ilu.EQ.0 ) THEN
607  DO i = k, n - 1
608  work( i ) = zero
609  END DO
610  DO j = 0, k - 1
611  s = zero
612  DO i = 0, k - 1
613  aa = abs( a( i+j*lda ) )
614 * A(j,i+k)
615  work( i+k ) = work( i+k ) + aa
616  s = s + aa
617  END DO
618  work( j ) = s
619  END DO
620 * j=k
621  aa = abs( a( 0+j*lda ) )
622 * A(k,k)
623  s = aa
624  DO i = 1, k - 1
625  aa = abs( a( i+j*lda ) )
626 * A(k,k+i)
627  work( i+k ) = work( i+k ) + aa
628  s = s + aa
629  END DO
630  work( j ) = work( j ) + s
631  DO j = k + 1, n - 1
632  s = zero
633  DO i = 0, j - 2 - k
634  aa = abs( a( i+j*lda ) )
635 * A(i,j-k-1)
636  work( i ) = work( i ) + aa
637  s = s + aa
638  END DO
639 * i=j-1-k
640  aa = abs( a( i+j*lda ) )
641 * A(j-k-1,j-k-1)
642  s = s + aa
643  work( j-k-1 ) = work( j-k-1 ) + s
644  i = i + 1
645  aa = abs( a( i+j*lda ) )
646 * A(j,j)
647  s = aa
648  DO l = j + 1, n - 1
649  i = i + 1
650  aa = abs( a( i+j*lda ) )
651 * A(j,l)
652  work( l ) = work( l ) + aa
653  s = s + aa
654  END DO
655  work( j ) = work( j ) + s
656  END DO
657 * j=n
658  s = zero
659  DO i = 0, k - 2
660  aa = abs( a( i+j*lda ) )
661 * A(i,k-1)
662  work( i ) = work( i ) + aa
663  s = s + aa
664  END DO
665 * i=k-1
666  aa = abs( a( i+j*lda ) )
667 * A(k-1,k-1)
668  s = s + aa
669  work( i ) = work( i ) + s
670  i = idamax( n, work, 1 )
671  value = work( i-1 )
672  ELSE
673 * ilu=1
674  DO i = k, n - 1
675  work( i ) = zero
676  END DO
677 * j=0 is special :process col A(k:n-1,k)
678  s = abs( a( 0 ) )
679 * A(k,k)
680  DO i = 1, k - 1
681  aa = abs( a( i ) )
682 * A(k+i,k)
683  work( i+k ) = work( i+k ) + aa
684  s = s + aa
685  END DO
686  work( k ) = work( k ) + s
687  DO j = 1, k - 1
688 * process
689  s = zero
690  DO i = 0, j - 2
691  aa = abs( a( i+j*lda ) )
692 * A(j-1,i)
693  work( i ) = work( i ) + aa
694  s = s + aa
695  END DO
696  aa = abs( a( i+j*lda ) )
697 * i=j-1 so process of A(j-1,j-1)
698  s = s + aa
699  work( j-1 ) = s
700 * is initialised here
701  i = i + 1
702 * i=j process A(j+k,j+k)
703  aa = abs( a( i+j*lda ) )
704  s = aa
705  DO l = k + j + 1, n - 1
706  i = i + 1
707  aa = abs( a( i+j*lda ) )
708 * A(l,k+j)
709  s = s + aa
710  work( l ) = work( l ) + aa
711  END DO
712  work( k+j ) = work( k+j ) + s
713  END DO
714 * j=k is special :process col A(k,0:k-1)
715  s = zero
716  DO i = 0, k - 2
717  aa = abs( a( i+j*lda ) )
718 * A(k,i)
719  work( i ) = work( i ) + aa
720  s = s + aa
721  END DO
722 * i=k-1
723  aa = abs( a( i+j*lda ) )
724 * A(k-1,k-1)
725  s = s + aa
726  work( i ) = s
727 * done with col j=k+1
728  DO j = k + 1, n
729 * process col j-1 of A = A(j-1,0:k-1)
730  s = zero
731  DO i = 0, k - 1
732  aa = abs( a( i+j*lda ) )
733 * A(j-1,i)
734  work( i ) = work( i ) + aa
735  s = s + aa
736  END DO
737  work( j-1 ) = work( j-1 ) + s
738  END DO
739  i = idamax( n, work, 1 )
740  value = work( i-1 )
741  END IF
742  END IF
743  END IF
744  ELSE IF( ( lsame( norm, 'F' ) ) .OR. ( lsame( norm, 'E' ) ) ) THEN
745 *
746 * Find normF(A).
747 *
748  k = ( n+1 ) / 2
749  scale = zero
750  s = one
751  IF( noe.EQ.1 ) THEN
752 * n is odd
753  IF( ifm.EQ.1 ) THEN
754 * A is normal
755  IF( ilu.EQ.0 ) THEN
756 * A is upper
757  DO j = 0, k - 3
758  CALL dlassq( k-j-2, a( k+j+1+j*lda ), 1, scale, s )
759 * L at A(k,0)
760  END DO
761  DO j = 0, k - 1
762  CALL dlassq( k+j-1, a( 0+j*lda ), 1, scale, s )
763 * trap U at A(0,0)
764  END DO
765  s = s + s
766 * double s for the off diagonal elements
767  CALL dlassq( k-1, a( k ), lda+1, scale, s )
768 * tri L at A(k,0)
769  CALL dlassq( k, a( k-1 ), lda+1, scale, s )
770 * tri U at A(k-1,0)
771  ELSE
772 * ilu=1 & A is lower
773  DO j = 0, k - 1
774  CALL dlassq( n-j-1, a( j+1+j*lda ), 1, scale, s )
775 * trap L at A(0,0)
776  END DO
777  DO j = 0, k - 2
778  CALL dlassq( j, a( 0+( 1+j )*lda ), 1, scale, s )
779 * U at A(0,1)
780  END DO
781  s = s + s
782 * double s for the off diagonal elements
783  CALL dlassq( k, a( 0 ), lda+1, scale, s )
784 * tri L at A(0,0)
785  CALL dlassq( k-1, a( 0+lda ), lda+1, scale, s )
786 * tri U at A(0,1)
787  END IF
788  ELSE
789 * A is xpose
790  IF( ilu.EQ.0 ) THEN
791 * A**T is upper
792  DO j = 1, k - 2
793  CALL dlassq( j, a( 0+( k+j )*lda ), 1, scale, s )
794 * U at A(0,k)
795  END DO
796  DO j = 0, k - 2
797  CALL dlassq( k, a( 0+j*lda ), 1, scale, s )
798 * k by k-1 rect. at A(0,0)
799  END DO
800  DO j = 0, k - 2
801  CALL dlassq( k-j-1, a( j+1+( j+k-1 )*lda ), 1,
802  $ scale, s )
803 * L at A(0,k-1)
804  END DO
805  s = s + s
806 * double s for the off diagonal elements
807  CALL dlassq( k-1, a( 0+k*lda ), lda+1, scale, s )
808 * tri U at A(0,k)
809  CALL dlassq( k, a( 0+( k-1 )*lda ), lda+1, scale, s )
810 * tri L at A(0,k-1)
811  ELSE
812 * A**T is lower
813  DO j = 1, k - 1
814  CALL dlassq( j, a( 0+j*lda ), 1, scale, s )
815 * U at A(0,0)
816  END DO
817  DO j = k, n - 1
818  CALL dlassq( k, a( 0+j*lda ), 1, scale, s )
819 * k by k-1 rect. at A(0,k)
820  END DO
821  DO j = 0, k - 3
822  CALL dlassq( k-j-2, a( j+2+j*lda ), 1, scale, s )
823 * L at A(1,0)
824  END DO
825  s = s + s
826 * double s for the off diagonal elements
827  CALL dlassq( k, a( 0 ), lda+1, scale, s )
828 * tri U at A(0,0)
829  CALL dlassq( k-1, a( 1 ), lda+1, scale, s )
830 * tri L at A(1,0)
831  END IF
832  END IF
833  ELSE
834 * n is even
835  IF( ifm.EQ.1 ) THEN
836 * A is normal
837  IF( ilu.EQ.0 ) THEN
838 * A is upper
839  DO j = 0, k - 2
840  CALL dlassq( k-j-1, a( k+j+2+j*lda ), 1, scale, s )
841 * L at A(k+1,0)
842  END DO
843  DO j = 0, k - 1
844  CALL dlassq( k+j, a( 0+j*lda ), 1, scale, s )
845 * trap U at A(0,0)
846  END DO
847  s = s + s
848 * double s for the off diagonal elements
849  CALL dlassq( k, a( k+1 ), lda+1, scale, s )
850 * tri L at A(k+1,0)
851  CALL dlassq( k, a( k ), lda+1, scale, s )
852 * tri U at A(k,0)
853  ELSE
854 * ilu=1 & A is lower
855  DO j = 0, k - 1
856  CALL dlassq( n-j-1, a( j+2+j*lda ), 1, scale, s )
857 * trap L at A(1,0)
858  END DO
859  DO j = 1, k - 1
860  CALL dlassq( j, a( 0+j*lda ), 1, scale, s )
861 * U at A(0,0)
862  END DO
863  s = s + s
864 * double s for the off diagonal elements
865  CALL dlassq( k, a( 1 ), lda+1, scale, s )
866 * tri L at A(1,0)
867  CALL dlassq( k, a( 0 ), lda+1, scale, s )
868 * tri U at A(0,0)
869  END IF
870  ELSE
871 * A is xpose
872  IF( ilu.EQ.0 ) THEN
873 * A**T is upper
874  DO j = 1, k - 1
875  CALL dlassq( j, a( 0+( k+1+j )*lda ), 1, scale, s )
876 * U at A(0,k+1)
877  END DO
878  DO j = 0, k - 1
879  CALL dlassq( k, a( 0+j*lda ), 1, scale, s )
880 * k by k rect. at A(0,0)
881  END DO
882  DO j = 0, k - 2
883  CALL dlassq( k-j-1, a( j+1+( j+k )*lda ), 1, scale,
884  $ s )
885 * L at A(0,k)
886  END DO
887  s = s + s
888 * double s for the off diagonal elements
889  CALL dlassq( k, a( 0+( k+1 )*lda ), lda+1, scale, s )
890 * tri U at A(0,k+1)
891  CALL dlassq( k, a( 0+k*lda ), lda+1, scale, s )
892 * tri L at A(0,k)
893  ELSE
894 * A**T is lower
895  DO j = 1, k - 1
896  CALL dlassq( j, a( 0+( j+1 )*lda ), 1, scale, s )
897 * U at A(0,1)
898  END DO
899  DO j = k + 1, n
900  CALL dlassq( k, a( 0+j*lda ), 1, scale, s )
901 * k by k rect. at A(0,k+1)
902  END DO
903  DO j = 0, k - 2
904  CALL dlassq( k-j-1, a( j+1+j*lda ), 1, scale, s )
905 * L at A(0,0)
906  END DO
907  s = s + s
908 * double s for the off diagonal elements
909  CALL dlassq( k, a( lda ), lda+1, scale, s )
910 * tri L at A(0,1)
911  CALL dlassq( k, a( 0 ), lda+1, scale, s )
912 * tri U at A(0,0)
913  END IF
914  END IF
915  END IF
916  value = scale*sqrt( s )
917  END IF
918 *
919  dlansf = value
920  RETURN
921 *
922 * End of DLANSF
923 *
924  END