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