LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
double precision function zlanhf ( character  NORM,
character  TRANSR,
character  UPLO,
integer  N,
complex*16, dimension( 0: * )  A,
double precision, dimension( 0: * )  WORK 
)

ZLANHF returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a Hermitian matrix in RFP format.

Download ZLANHF + dependencies [TGZ] [ZIP] [TXT]

Purpose: 
 ZLANHF  returns the value of the one norm,  or the Frobenius norm, or
 the  infinity norm,  or the  element of  largest absolute value  of a
 complex Hermitian matrix A in RFP format.
Returns
ZLANHF 
    ZLANHF = ( max(abs(A(i,j))), NORM = 'M' or 'm'
             (
             ( norm1(A),         NORM = '1', 'O' or 'o'
             (
             ( normI(A),         NORM = 'I' or 'i'
             (
             ( normF(A),         NORM = 'F', 'f', 'E' or 'e'

 where  norm1  denotes the  one norm of a matrix (maximum column sum),
 normI  denotes the  infinity norm  of a matrix  (maximum row sum) and
 normF  denotes the  Frobenius norm of a matrix (square root of sum of
 squares).  Note that  max(abs(A(i,j)))  is not a  matrix norm.
Parameters
[in]NORM
          NORM is CHARACTER
            Specifies the value to be returned in ZLANHF as described
            above.
[in]TRANSR
          TRANSR is CHARACTER
            Specifies whether the RFP format of A is normal or
            conjugate-transposed format.
            = 'N':  RFP format is Normal
            = 'C':  RFP format is Conjugate-transposed
[in]UPLO
          UPLO is CHARACTER
            On entry, UPLO specifies whether the RFP matrix A came from
            an upper or lower triangular matrix as follows:

            UPLO = 'U' or 'u' RFP A came from an upper triangular
            matrix

            UPLO = 'L' or 'l' RFP A came from a  lower triangular
            matrix
[in]N
          N is INTEGER
            The order of the matrix A.  N >= 0.  When N = 0, ZLANHF is
            set to zero.
[in]A
          A is COMPLEX*16 array, dimension ( N*(N+1)/2 );
            On entry, the matrix A in RFP Format.
            RFP Format is described by TRANSR, UPLO and N as follows:
            If TRANSR='N' then RFP A is (0:N,0:K-1) when N is even;
            K=N/2. RFP A is (0:N-1,0:K) when N is odd; K=N/2. If
            TRANSR = 'C' then RFP is the Conjugate-transpose of RFP A
            as defined when TRANSR = 'N'. The contents of RFP A are
            defined by UPLO as follows: If UPLO = 'U' the RFP A
            contains the ( N*(N+1)/2 ) elements of upper packed A
            either in normal or conjugate-transpose Format. If
            UPLO = 'L' the RFP A contains the ( N*(N+1) /2 ) elements
            of lower packed A either in normal or conjugate-transpose
            Format. The LDA of RFP A is (N+1)/2 when TRANSR = 'C'. When
            TRANSR is 'N' the LDA is N+1 when N is even and is N when
            is odd. See the Note below for more details.
            Unchanged on exit.
[out]WORK
          WORK is DOUBLE PRECISION array, dimension (LWORK),
            where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
            WORK is not referenced.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2015
Further Details: 
  We first consider Standard Packed Format when N is even.
  We give an example where N = 6.

      AP is Upper             AP is Lower

   00 01 02 03 04 05       00
      11 12 13 14 15       10 11
         22 23 24 25       20 21 22
            33 34 35       30 31 32 33
               44 45       40 41 42 43 44
                  55       50 51 52 53 54 55


  Let TRANSR = 'N'. RFP holds AP as follows:
  For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
  three columns of AP upper. The lower triangle A(4:6,0:2) consists of
  conjugate-transpose of the first three columns of AP upper.
  For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
  three columns of AP lower. The upper triangle A(0:2,0:2) consists of
  conjugate-transpose of the last three columns of AP lower.
  To denote conjugate we place -- above the element. This covers the
  case N even and TRANSR = 'N'.

         RFP A                   RFP A

                                -- -- --
        03 04 05                33 43 53
                                   -- --
        13 14 15                00 44 54
                                      --
        23 24 25                10 11 55

        33 34 35                20 21 22
        --
        00 44 45                30 31 32
        -- --
        01 11 55                40 41 42
        -- -- --
        02 12 22                50 51 52

  Now let TRANSR = 'C'. RFP A in both UPLO cases is just the conjugate-
  transpose of RFP A above. One therefore gets:


           RFP A                   RFP A

     -- -- -- --                -- -- -- -- -- --
     03 13 23 33 00 01 02    33 00 10 20 30 40 50
     -- -- -- -- --                -- -- -- -- --
     04 14 24 34 44 11 12    43 44 11 21 31 41 51
     -- -- -- -- -- --                -- -- -- --
     05 15 25 35 45 55 22    53 54 55 22 32 42 52


  We next  consider Standard Packed Format when N is odd.
  We give an example where N = 5.

     AP is Upper                 AP is Lower

   00 01 02 03 04              00
      11 12 13 14              10 11
         22 23 24              20 21 22
            33 34              30 31 32 33
               44              40 41 42 43 44


  Let TRANSR = 'N'. RFP holds AP as follows:
  For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
  three columns of AP upper. The lower triangle A(3:4,0:1) consists of
  conjugate-transpose of the first two   columns of AP upper.
  For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
  three columns of AP lower. The upper triangle A(0:1,1:2) consists of
  conjugate-transpose of the last two   columns of AP lower.
  To denote conjugate we place -- above the element. This covers the
  case N odd  and TRANSR = 'N'.

         RFP A                   RFP A

                                   -- --
        02 03 04                00 33 43
                                      --
        12 13 14                10 11 44

        22 23 24                20 21 22
        --
        00 33 34                30 31 32
        -- --
        01 11 44                40 41 42

  Now let TRANSR = 'C'. RFP A in both UPLO cases is just the conjugate-
  transpose of RFP A above. One therefore gets:


           RFP A                   RFP A

     -- -- --                   -- -- -- -- -- --
     02 12 22 00 01             00 10 20 30 40 50
     -- -- -- --                   -- -- -- -- --
     03 13 23 33 11             33 11 21 31 41 51
     -- -- -- -- --                   -- -- -- --
     04 14 24 34 44             43 44 22 32 42 52

Definition at line 248 of file zlanhf.f.

248 *
249 * -- LAPACK computational routine (version 3.6.0) --
250 * -- LAPACK is a software package provided by Univ. of Tennessee, --
251 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
252 * November 2015
253 *
254 * .. Scalar Arguments ..
255  CHARACTER norm, transr, uplo
256  INTEGER n
257 * ..
258 * .. Array Arguments ..
259  DOUBLE PRECISION work( 0: * )
260  COMPLEX*16 a( 0: * )
261 * ..
262 *
263 * =====================================================================
264 *
265 * .. Parameters ..
266  DOUBLE PRECISION one, zero
267  parameter ( one = 1.0d+0, zero = 0.0d+0 )
268 * ..
269 * .. Local Scalars ..
270  INTEGER i, j, ifm, ilu, noe, n1, k, l, lda
271  DOUBLE PRECISION scale, s, VALUE, aa, temp
272 * ..
273 * .. External Functions ..
274  LOGICAL lsame, disnan
275  EXTERNAL lsame, disnan
276 * ..
277 * .. External Subroutines ..
278  EXTERNAL zlassq
279 * ..
280 * .. Intrinsic Functions ..
281  INTRINSIC abs, dble, sqrt
282 * ..
283 * .. Executable Statements ..
284 *
285  IF( n.EQ.0 ) THEN
286  zlanhf = zero
287  RETURN
288  ELSE IF( n.EQ.1 ) THEN
289  zlanhf = abs(dble(a(0)))
290  RETURN
291  END IF
292 *
293 * set noe = 1 if n is odd. if n is even set noe=0
294 *
295  noe = 1
296  IF( mod( n, 2 ).EQ.0 )
297  $ noe = 0
298 *
299 * set ifm = 0 when form='C' or 'c' and 1 otherwise
300 *
301  ifm = 1
302  IF( lsame( transr, 'C' ) )
303  $ ifm = 0
304 *
305 * set ilu = 0 when uplo='U or 'u' and 1 otherwise
306 *
307  ilu = 1
308  IF( lsame( uplo, 'U' ) )
309  $ ilu = 0
310 *
311 * set lda = (n+1)/2 when ifm = 0
312 * set lda = n when ifm = 1 and noe = 1
313 * set lda = n+1 when ifm = 1 and noe = 0
314 *
315  IF( ifm.EQ.1 ) THEN
316  IF( noe.EQ.1 ) THEN
317  lda = n
318  ELSE
319 * noe=0
320  lda = n + 1
321  END IF
322  ELSE
323 * ifm=0
324  lda = ( n+1 ) / 2
325  END IF
326 *
327  IF( lsame( norm, 'M' ) ) THEN
328 *
329 * Find max(abs(A(i,j))).
330 *
331  k = ( n+1 ) / 2
332  VALUE = zero
333  IF( noe.EQ.1 ) THEN
334 * n is odd & n = k + k - 1
335  IF( ifm.EQ.1 ) THEN
336 * A is n by k
337  IF( ilu.EQ.1 ) THEN
338 * uplo ='L'
339  j = 0
340 * -> L(0,0)
341  temp = abs( dble( a( j+j*lda ) ) )
342  IF( VALUE .LT. temp .OR. disnan( temp ) )
343  $ VALUE = temp
344  DO i = 1, n - 1
345  temp = abs( a( i+j*lda ) )
346  IF( VALUE .LT. temp .OR. disnan( temp ) )
347  $ VALUE = temp
348  END DO
349  DO j = 1, k - 1
350  DO i = 0, j - 2
351  temp = abs( a( i+j*lda ) )
352  IF( VALUE .LT. temp .OR. disnan( temp ) )
353  $ VALUE = temp
354  END DO
355  i = j - 1
356 * L(k+j,k+j)
357  temp = abs( dble( a( i+j*lda ) ) )
358  IF( VALUE .LT. temp .OR. disnan( temp ) )
359  $ VALUE = temp
360  i = j
361 * -> L(j,j)
362  temp = abs( dble( a( i+j*lda ) ) )
363  IF( VALUE .LT. temp .OR. disnan( temp ) )
364  $ VALUE = temp
365  DO i = j + 1, n - 1
366  temp = abs( a( i+j*lda ) )
367  IF( VALUE .LT. temp .OR. disnan( temp ) )
368  $ VALUE = temp
369  END DO
370  END DO
371  ELSE
372 * uplo = 'U'
373  DO j = 0, k - 2
374  DO i = 0, k + j - 2
375  temp = abs( a( i+j*lda ) )
376  IF( VALUE .LT. temp .OR. disnan( temp ) )
377  $ VALUE = temp
378  END DO
379  i = k + j - 1
380 * -> U(i,i)
381  temp = abs( dble( a( i+j*lda ) ) )
382  IF( VALUE .LT. temp .OR. disnan( temp ) )
383  $ VALUE = temp
384  i = i + 1
385 * =k+j; i -> U(j,j)
386  temp = abs( dble( a( i+j*lda ) ) )
387  IF( VALUE .LT. temp .OR. disnan( temp ) )
388  $ VALUE = temp
389  DO i = k + j + 1, n - 1
390  temp = abs( a( i+j*lda ) )
391  IF( VALUE .LT. temp .OR. disnan( temp ) )
392  $ VALUE = temp
393  END DO
394  END DO
395  DO i = 0, n - 2
396  temp = abs( a( i+j*lda ) )
397  IF( VALUE .LT. temp .OR. disnan( temp ) )
398  $ VALUE = temp
399 * j=k-1
400  END DO
401 * i=n-1 -> U(n-1,n-1)
402  temp = abs( dble( a( i+j*lda ) ) )
403  IF( VALUE .LT. temp .OR. disnan( temp ) )
404  $ VALUE = temp
405  END IF
406  ELSE
407 * xpose case; A is k by n
408  IF( ilu.EQ.1 ) THEN
409 * uplo ='L'
410  DO j = 0, k - 2
411  DO i = 0, j - 1
412  temp = abs( a( i+j*lda ) )
413  IF( VALUE .LT. temp .OR. disnan( temp ) )
414  $ VALUE = temp
415  END DO
416  i = j
417 * L(i,i)
418  temp = abs( dble( a( i+j*lda ) ) )
419  IF( VALUE .LT. temp .OR. disnan( temp ) )
420  $ VALUE = temp
421  i = j + 1
422 * L(j+k,j+k)
423  temp = abs( dble( a( i+j*lda ) ) )
424  IF( VALUE .LT. temp .OR. disnan( temp ) )
425  $ VALUE = temp
426  DO i = j + 2, k - 1
427  temp = abs( a( i+j*lda ) )
428  IF( VALUE .LT. temp .OR. disnan( temp ) )
429  $ VALUE = temp
430  END DO
431  END DO
432  j = k - 1
433  DO i = 0, k - 2
434  temp = abs( a( i+j*lda ) )
435  IF( VALUE .LT. temp .OR. disnan( temp ) )
436  $ VALUE = temp
437  END DO
438  i = k - 1
439 * -> L(i,i) is at A(i,j)
440  temp = abs( dble( a( i+j*lda ) ) )
441  IF( VALUE .LT. temp .OR. disnan( temp ) )
442  $ VALUE = temp
443  DO j = k, n - 1
444  DO i = 0, k - 1
445  temp = abs( a( i+j*lda ) )
446  IF( VALUE .LT. temp .OR. disnan( temp ) )
447  $ VALUE = temp
448  END DO
449  END DO
450  ELSE
451 * uplo = 'U'
452  DO j = 0, k - 2
453  DO i = 0, k - 1
454  temp = abs( a( i+j*lda ) )
455  IF( VALUE .LT. temp .OR. disnan( temp ) )
456  $ VALUE = temp
457  END DO
458  END DO
459  j = k - 1
460 * -> U(j,j) is at A(0,j)
461  temp = abs( dble( a( 0+j*lda ) ) )
462  IF( VALUE .LT. temp .OR. disnan( temp ) )
463  $ VALUE = temp
464  DO i = 1, k - 1
465  temp = abs( a( i+j*lda ) )
466  IF( VALUE .LT. temp .OR. disnan( temp ) )
467  $ VALUE = temp
468  END DO
469  DO j = k, n - 1
470  DO i = 0, j - k - 1
471  temp = abs( a( i+j*lda ) )
472  IF( VALUE .LT. temp .OR. disnan( temp ) )
473  $ VALUE = temp
474  END DO
475  i = j - k
476 * -> U(i,i) at A(i,j)
477  temp = abs( dble( a( i+j*lda ) ) )
478  IF( VALUE .LT. temp .OR. disnan( temp ) )
479  $ VALUE = temp
480  i = j - k + 1
481 * U(j,j)
482  temp = abs( dble( a( i+j*lda ) ) )
483  IF( VALUE .LT. temp .OR. disnan( temp ) )
484  $ VALUE = temp
485  DO i = j - k + 2, k - 1
486  temp = abs( a( i+j*lda ) )
487  IF( VALUE .LT. temp .OR. disnan( temp ) )
488  $ VALUE = temp
489  END DO
490  END DO
491  END IF
492  END IF
493  ELSE
494 * n is even & k = n/2
495  IF( ifm.EQ.1 ) THEN
496 * A is n+1 by k
497  IF( ilu.EQ.1 ) THEN
498 * uplo ='L'
499  j = 0
500 * -> L(k,k) & j=1 -> L(0,0)
501  temp = abs( dble( a( j+j*lda ) ) )
502  IF( VALUE .LT. temp .OR. disnan( temp ) )
503  $ VALUE = temp
504  temp = abs( dble( a( j+1+j*lda ) ) )
505  IF( VALUE .LT. temp .OR. disnan( temp ) )
506  $ VALUE = temp
507  DO i = 2, n
508  temp = abs( a( i+j*lda ) )
509  IF( VALUE .LT. temp .OR. disnan( temp ) )
510  $ VALUE = temp
511  END DO
512  DO j = 1, k - 1
513  DO i = 0, j - 1
514  temp = abs( a( i+j*lda ) )
515  IF( VALUE .LT. temp .OR. disnan( temp ) )
516  $ VALUE = temp
517  END DO
518  i = j
519 * L(k+j,k+j)
520  temp = abs( dble( a( i+j*lda ) ) )
521  IF( VALUE .LT. temp .OR. disnan( temp ) )
522  $ VALUE = temp
523  i = j + 1
524 * -> L(j,j)
525  temp = abs( dble( a( i+j*lda ) ) )
526  IF( VALUE .LT. temp .OR. disnan( temp ) )
527  $ VALUE = temp
528  DO i = j + 2, n
529  temp = abs( a( i+j*lda ) )
530  IF( VALUE .LT. temp .OR. disnan( temp ) )
531  $ VALUE = temp
532  END DO
533  END DO
534  ELSE
535 * uplo = 'U'
536  DO j = 0, k - 2
537  DO i = 0, k + j - 1
538  temp = abs( a( i+j*lda ) )
539  IF( VALUE .LT. temp .OR. disnan( temp ) )
540  $ VALUE = temp
541  END DO
542  i = k + j
543 * -> U(i,i)
544  temp = abs( dble( a( i+j*lda ) ) )
545  IF( VALUE .LT. temp .OR. disnan( temp ) )
546  $ VALUE = temp
547  i = i + 1
548 * =k+j+1; i -> U(j,j)
549  temp = abs( dble( a( i+j*lda ) ) )
550  IF( VALUE .LT. temp .OR. disnan( temp ) )
551  $ VALUE = temp
552  DO i = k + j + 2, n
553  temp = abs( a( i+j*lda ) )
554  IF( VALUE .LT. temp .OR. disnan( temp ) )
555  $ VALUE = temp
556  END DO
557  END DO
558  DO i = 0, n - 2
559  temp = abs( a( i+j*lda ) )
560  IF( VALUE .LT. temp .OR. disnan( temp ) )
561  $ VALUE = temp
562 * j=k-1
563  END DO
564 * i=n-1 -> U(n-1,n-1)
565  temp = abs( dble( a( i+j*lda ) ) )
566  IF( VALUE .LT. temp .OR. disnan( temp ) )
567  $ VALUE = temp
568  i = n
569 * -> U(k-1,k-1)
570  temp = abs( dble( a( i+j*lda ) ) )
571  IF( VALUE .LT. temp .OR. disnan( temp ) )
572  $ VALUE = temp
573  END IF
574  ELSE
575 * xpose case; A is k by n+1
576  IF( ilu.EQ.1 ) THEN
577 * uplo ='L'
578  j = 0
579 * -> L(k,k) at A(0,0)
580  temp = abs( dble( a( j+j*lda ) ) )
581  IF( VALUE .LT. temp .OR. disnan( temp ) )
582  $ VALUE = temp
583  DO i = 1, k - 1
584  temp = abs( a( i+j*lda ) )
585  IF( VALUE .LT. temp .OR. disnan( temp ) )
586  $ VALUE = temp
587  END DO
588  DO j = 1, k - 1
589  DO i = 0, j - 2
590  temp = abs( a( i+j*lda ) )
591  IF( VALUE .LT. temp .OR. disnan( temp ) )
592  $ VALUE = temp
593  END DO
594  i = j - 1
595 * L(i,i)
596  temp = abs( dble( a( i+j*lda ) ) )
597  IF( VALUE .LT. temp .OR. disnan( temp ) )
598  $ VALUE = temp
599  i = j
600 * L(j+k,j+k)
601  temp = abs( dble( a( i+j*lda ) ) )
602  IF( VALUE .LT. temp .OR. disnan( temp ) )
603  $ VALUE = temp
604  DO i = j + 1, k - 1
605  temp = abs( a( i+j*lda ) )
606  IF( VALUE .LT. temp .OR. disnan( temp ) )
607  $ VALUE = temp
608  END DO
609  END DO
610  j = k
611  DO i = 0, k - 2
612  temp = abs( a( i+j*lda ) )
613  IF( VALUE .LT. temp .OR. disnan( temp ) )
614  $ VALUE = temp
615  END DO
616  i = k - 1
617 * -> L(i,i) is at A(i,j)
618  temp = abs( dble( a( i+j*lda ) ) )
619  IF( VALUE .LT. temp .OR. disnan( temp ) )
620  $ VALUE = temp
621  DO j = k + 1, n
622  DO i = 0, k - 1
623  temp = abs( a( i+j*lda ) )
624  IF( VALUE .LT. temp .OR. disnan( temp ) )
625  $ VALUE = temp
626  END DO
627  END DO
628  ELSE
629 * uplo = 'U'
630  DO j = 0, k - 1
631  DO i = 0, k - 1
632  temp = abs( a( i+j*lda ) )
633  IF( VALUE .LT. temp .OR. disnan( temp ) )
634  $ VALUE = temp
635  END DO
636  END DO
637  j = k
638 * -> U(j,j) is at A(0,j)
639  temp = abs( dble( a( 0+j*lda ) ) )
640  IF( VALUE .LT. temp .OR. disnan( temp ) )
641  $ VALUE = temp
642  DO i = 1, k - 1
643  temp = abs( a( i+j*lda ) )
644  IF( VALUE .LT. temp .OR. disnan( temp ) )
645  $ VALUE = temp
646  END DO
647  DO j = k + 1, n - 1
648  DO i = 0, j - k - 2
649  temp = abs( a( i+j*lda ) )
650  IF( VALUE .LT. temp .OR. disnan( temp ) )
651  $ VALUE = temp
652  END DO
653  i = j - k - 1
654 * -> U(i,i) at A(i,j)
655  temp = abs( dble( a( i+j*lda ) ) )
656  IF( VALUE .LT. temp .OR. disnan( temp ) )
657  $ VALUE = temp
658  i = j - k
659 * U(j,j)
660  temp = abs( dble( a( i+j*lda ) ) )
661  IF( VALUE .LT. temp .OR. disnan( temp ) )
662  $ VALUE = temp
663  DO i = j - k + 1, k - 1
664  temp = abs( a( i+j*lda ) )
665  IF( VALUE .LT. temp .OR. disnan( temp ) )
666  $ VALUE = temp
667  END DO
668  END DO
669  j = n
670  DO i = 0, k - 2
671  temp = abs( a( i+j*lda ) )
672  IF( VALUE .LT. temp .OR. disnan( temp ) )
673  $ VALUE = temp
674  END DO
675  i = k - 1
676 * U(k,k) at A(i,j)
677  temp = abs( dble( a( i+j*lda ) ) )
678  IF( VALUE .LT. temp .OR. disnan( temp ) )
679  $ VALUE = temp
680  END IF
681  END IF
682  END IF
683  ELSE IF( ( lsame( norm, 'I' ) ) .OR. ( lsame( norm, 'O' ) ) .OR.
684  $ ( norm.EQ.'1' ) ) THEN
685 *
686 * Find normI(A) ( = norm1(A), since A is Hermitian).
687 *
688  IF( ifm.EQ.1 ) THEN
689 * A is 'N'
690  k = n / 2
691  IF( noe.EQ.1 ) THEN
692 * n is odd & A is n by (n+1)/2
693  IF( ilu.EQ.0 ) THEN
694 * uplo = 'U'
695  DO i = 0, k - 1
696  work( i ) = zero
697  END DO
698  DO j = 0, k
699  s = zero
700  DO i = 0, k + j - 1
701  aa = abs( a( i+j*lda ) )
702 * -> A(i,j+k)
703  s = s + aa
704  work( i ) = work( i ) + aa
705  END DO
706  aa = abs( dble( a( i+j*lda ) ) )
707 * -> A(j+k,j+k)
708  work( j+k ) = s + aa
709  IF( i.EQ.k+k )
710  $ GO TO 10
711  i = i + 1
712  aa = abs( dble( a( i+j*lda ) ) )
713 * -> A(j,j)
714  work( j ) = work( j ) + aa
715  s = zero
716  DO l = j + 1, k - 1
717  i = i + 1
718  aa = abs( a( i+j*lda ) )
719 * -> A(l,j)
720  s = s + aa
721  work( l ) = work( l ) + aa
722  END DO
723  work( j ) = work( j ) + s
724  END DO
725  10 CONTINUE
726  VALUE = work( 0 )
727  DO i = 1, n-1
728  temp = work( i )
729  IF( VALUE .LT. temp .OR. disnan( temp ) )
730  $ VALUE = temp
731  END DO
732  ELSE
733 * ilu = 1 & uplo = 'L'
734  k = k + 1
735 * k=(n+1)/2 for n odd and ilu=1
736  DO i = k, n - 1
737  work( i ) = zero
738  END DO
739  DO j = k - 1, 0, -1
740  s = zero
741  DO i = 0, j - 2
742  aa = abs( a( i+j*lda ) )
743 * -> A(j+k,i+k)
744  s = s + aa
745  work( i+k ) = work( i+k ) + aa
746  END DO
747  IF( j.GT.0 ) THEN
748  aa = abs( dble( a( i+j*lda ) ) )
749 * -> A(j+k,j+k)
750  s = s + aa
751  work( i+k ) = work( i+k ) + s
752 * i=j
753  i = i + 1
754  END IF
755  aa = abs( dble( a( i+j*lda ) ) )
756 * -> A(j,j)
757  work( j ) = aa
758  s = zero
759  DO l = j + 1, n - 1
760  i = i + 1
761  aa = abs( a( i+j*lda ) )
762 * -> A(l,j)
763  s = s + aa
764  work( l ) = work( l ) + aa
765  END DO
766  work( j ) = work( j ) + s
767  END DO
768  VALUE = work( 0 )
769  DO i = 1, n-1
770  temp = work( i )
771  IF( VALUE .LT. temp .OR. disnan( temp ) )
772  $ VALUE = temp
773  END DO
774  END IF
775  ELSE
776 * n is even & A is n+1 by k = n/2
777  IF( ilu.EQ.0 ) THEN
778 * uplo = 'U'
779  DO i = 0, k - 1
780  work( i ) = zero
781  END DO
782  DO j = 0, k - 1
783  s = zero
784  DO i = 0, k + j - 1
785  aa = abs( a( i+j*lda ) )
786 * -> A(i,j+k)
787  s = s + aa
788  work( i ) = work( i ) + aa
789  END DO
790  aa = abs( dble( a( i+j*lda ) ) )
791 * -> A(j+k,j+k)
792  work( j+k ) = s + aa
793  i = i + 1
794  aa = abs( dble( a( i+j*lda ) ) )
795 * -> A(j,j)
796  work( j ) = work( j ) + aa
797  s = zero
798  DO l = j + 1, k - 1
799  i = i + 1
800  aa = abs( a( i+j*lda ) )
801 * -> A(l,j)
802  s = s + aa
803  work( l ) = work( l ) + aa
804  END DO
805  work( j ) = work( j ) + s
806  END DO
807  VALUE = work( 0 )
808  DO i = 1, n-1
809  temp = work( i )
810  IF( VALUE .LT. temp .OR. disnan( temp ) )
811  $ VALUE = temp
812  END DO
813  ELSE
814 * ilu = 1 & uplo = 'L'
815  DO i = k, n - 1
816  work( i ) = zero
817  END DO
818  DO j = k - 1, 0, -1
819  s = zero
820  DO i = 0, j - 1
821  aa = abs( a( i+j*lda ) )
822 * -> A(j+k,i+k)
823  s = s + aa
824  work( i+k ) = work( i+k ) + aa
825  END DO
826  aa = abs( dble( a( i+j*lda ) ) )
827 * -> A(j+k,j+k)
828  s = s + aa
829  work( i+k ) = work( i+k ) + s
830 * i=j
831  i = i + 1
832  aa = abs( dble( a( i+j*lda ) ) )
833 * -> A(j,j)
834  work( j ) = aa
835  s = zero
836  DO l = j + 1, n - 1
837  i = i + 1
838  aa = abs( a( i+j*lda ) )
839 * -> A(l,j)
840  s = s + aa
841  work( l ) = work( l ) + aa
842  END DO
843  work( j ) = work( j ) + s
844  END DO
845  VALUE = work( 0 )
846  DO i = 1, n-1
847  temp = work( i )
848  IF( VALUE .LT. temp .OR. disnan( temp ) )
849  $ VALUE = temp
850  END DO
851  END IF
852  END IF
853  ELSE
854 * ifm=0
855  k = n / 2
856  IF( noe.EQ.1 ) THEN
857 * n is odd & A is (n+1)/2 by n
858  IF( ilu.EQ.0 ) THEN
859 * uplo = 'U'
860  n1 = k
861 * n/2
862  k = k + 1
863 * k is the row size and lda
864  DO i = n1, n - 1
865  work( i ) = zero
866  END DO
867  DO j = 0, n1 - 1
868  s = zero
869  DO i = 0, k - 1
870  aa = abs( a( i+j*lda ) )
871 * A(j,n1+i)
872  work( i+n1 ) = work( i+n1 ) + aa
873  s = s + aa
874  END DO
875  work( j ) = s
876  END DO
877 * j=n1=k-1 is special
878  s = abs( dble( a( 0+j*lda ) ) )
879 * A(k-1,k-1)
880  DO i = 1, k - 1
881  aa = abs( a( i+j*lda ) )
882 * A(k-1,i+n1)
883  work( i+n1 ) = work( i+n1 ) + aa
884  s = s + aa
885  END DO
886  work( j ) = work( j ) + s
887  DO j = k, n - 1
888  s = zero
889  DO i = 0, j - k - 1
890  aa = abs( a( i+j*lda ) )
891 * A(i,j-k)
892  work( i ) = work( i ) + aa
893  s = s + aa
894  END DO
895 * i=j-k
896  aa = abs( dble( a( i+j*lda ) ) )
897 * A(j-k,j-k)
898  s = s + aa
899  work( j-k ) = work( j-k ) + s
900  i = i + 1
901  s = abs( dble( a( i+j*lda ) ) )
902 * A(j,j)
903  DO l = j + 1, n - 1
904  i = i + 1
905  aa = abs( a( i+j*lda ) )
906 * A(j,l)
907  work( l ) = work( l ) + aa
908  s = s + aa
909  END DO
910  work( j ) = work( j ) + s
911  END DO
912  VALUE = work( 0 )
913  DO i = 1, n-1
914  temp = work( i )
915  IF( VALUE .LT. temp .OR. disnan( temp ) )
916  $ VALUE = temp
917  END DO
918  ELSE
919 * ilu=1 & uplo = 'L'
920  k = k + 1
921 * k=(n+1)/2 for n odd and ilu=1
922  DO i = k, n - 1
923  work( i ) = zero
924  END DO
925  DO j = 0, k - 2
926 * process
927  s = zero
928  DO i = 0, j - 1
929  aa = abs( a( i+j*lda ) )
930 * A(j,i)
931  work( i ) = work( i ) + aa
932  s = s + aa
933  END DO
934  aa = abs( dble( a( i+j*lda ) ) )
935 * i=j so process of A(j,j)
936  s = s + aa
937  work( j ) = s
938 * is initialised here
939  i = i + 1
940 * i=j process A(j+k,j+k)
941  aa = abs( dble( a( i+j*lda ) ) )
942  s = aa
943  DO l = k + j + 1, n - 1
944  i = i + 1
945  aa = abs( a( i+j*lda ) )
946 * A(l,k+j)
947  s = s + aa
948  work( l ) = work( l ) + aa
949  END DO
950  work( k+j ) = work( k+j ) + s
951  END DO
952 * j=k-1 is special :process col A(k-1,0:k-1)
953  s = zero
954  DO i = 0, k - 2
955  aa = abs( a( i+j*lda ) )
956 * A(k,i)
957  work( i ) = work( i ) + aa
958  s = s + aa
959  END DO
960 * i=k-1
961  aa = abs( dble( a( i+j*lda ) ) )
962 * A(k-1,k-1)
963  s = s + aa
964  work( i ) = s
965 * done with col j=k+1
966  DO j = k, n - 1
967 * process col j of A = A(j,0:k-1)
968  s = zero
969  DO i = 0, k - 1
970  aa = abs( a( i+j*lda ) )
971 * A(j,i)
972  work( i ) = work( i ) + aa
973  s = s + aa
974  END DO
975  work( j ) = work( j ) + s
976  END DO
977  VALUE = work( 0 )
978  DO i = 1, n-1
979  temp = work( i )
980  IF( VALUE .LT. temp .OR. disnan( temp ) )
981  $ VALUE = temp
982  END DO
983  END IF
984  ELSE
985 * n is even & A is k=n/2 by n+1
986  IF( ilu.EQ.0 ) THEN
987 * uplo = 'U'
988  DO i = k, n - 1
989  work( i ) = zero
990  END DO
991  DO j = 0, k - 1
992  s = zero
993  DO i = 0, k - 1
994  aa = abs( a( i+j*lda ) )
995 * A(j,i+k)
996  work( i+k ) = work( i+k ) + aa
997  s = s + aa
998  END DO
999  work( j ) = s
1000  END DO
1001 * j=k
1002  aa = abs( dble( a( 0+j*lda ) ) )
1003 * A(k,k)
1004  s = aa
1005  DO i = 1, k - 1
1006  aa = abs( a( i+j*lda ) )
1007 * A(k,k+i)
1008  work( i+k ) = work( i+k ) + aa
1009  s = s + aa
1010  END DO
1011  work( j ) = work( j ) + s
1012  DO j = k + 1, n - 1
1013  s = zero
1014  DO i = 0, j - 2 - k
1015  aa = abs( a( i+j*lda ) )
1016 * A(i,j-k-1)
1017  work( i ) = work( i ) + aa
1018  s = s + aa
1019  END DO
1020 * i=j-1-k
1021  aa = abs( dble( a( i+j*lda ) ) )
1022 * A(j-k-1,j-k-1)
1023  s = s + aa
1024  work( j-k-1 ) = work( j-k-1 ) + s
1025  i = i + 1
1026  aa = abs( dble( a( i+j*lda ) ) )
1027 * A(j,j)
1028  s = aa
1029  DO l = j + 1, n - 1
1030  i = i + 1
1031  aa = abs( a( i+j*lda ) )
1032 * A(j,l)
1033  work( l ) = work( l ) + aa
1034  s = s + aa
1035  END DO
1036  work( j ) = work( j ) + s
1037  END DO
1038 * j=n
1039  s = zero
1040  DO i = 0, k - 2
1041  aa = abs( a( i+j*lda ) )
1042 * A(i,k-1)
1043  work( i ) = work( i ) + aa
1044  s = s + aa
1045  END DO
1046 * i=k-1
1047  aa = abs( dble( a( i+j*lda ) ) )
1048 * A(k-1,k-1)
1049  s = s + aa
1050  work( i ) = work( i ) + s
1051  VALUE = work( 0 )
1052  DO i = 1, n-1
1053  temp = work( i )
1054  IF( VALUE .LT. temp .OR. disnan( temp ) )
1055  $ VALUE = temp
1056  END DO
1057  ELSE
1058 * ilu=1 & uplo = 'L'
1059  DO i = k, n - 1
1060  work( i ) = zero
1061  END DO
1062 * j=0 is special :process col A(k:n-1,k)
1063  s = abs( dble( a( 0 ) ) )
1064 * A(k,k)
1065  DO i = 1, k - 1
1066  aa = abs( a( i ) )
1067 * A(k+i,k)
1068  work( i+k ) = work( i+k ) + aa
1069  s = s + aa
1070  END DO
1071  work( k ) = work( k ) + s
1072  DO j = 1, k - 1
1073 * process
1074  s = zero
1075  DO i = 0, j - 2
1076  aa = abs( a( i+j*lda ) )
1077 * A(j-1,i)
1078  work( i ) = work( i ) + aa
1079  s = s + aa
1080  END DO
1081  aa = abs( dble( a( i+j*lda ) ) )
1082 * i=j-1 so process of A(j-1,j-1)
1083  s = s + aa
1084  work( j-1 ) = s
1085 * is initialised here
1086  i = i + 1
1087 * i=j process A(j+k,j+k)
1088  aa = abs( dble( a( i+j*lda ) ) )
1089  s = aa
1090  DO l = k + j + 1, n - 1
1091  i = i + 1
1092  aa = abs( a( i+j*lda ) )
1093 * A(l,k+j)
1094  s = s + aa
1095  work( l ) = work( l ) + aa
1096  END DO
1097  work( k+j ) = work( k+j ) + s
1098  END DO
1099 * j=k is special :process col A(k,0:k-1)
1100  s = zero
1101  DO i = 0, k - 2
1102  aa = abs( a( i+j*lda ) )
1103 * A(k,i)
1104  work( i ) = work( i ) + aa
1105  s = s + aa
1106  END DO
1107 *
1108 * i=k-1
1109  aa = abs( dble( a( i+j*lda ) ) )
1110 * A(k-1,k-1)
1111  s = s + aa
1112  work( i ) = s
1113 * done with col j=k+1
1114  DO j = k + 1, n
1115 *
1116 * process col j-1 of A = A(j-1,0:k-1)
1117  s = zero
1118  DO i = 0, k - 1
1119  aa = abs( a( i+j*lda ) )
1120 * A(j-1,i)
1121  work( i ) = work( i ) + aa
1122  s = s + aa
1123  END DO
1124  work( j-1 ) = work( j-1 ) + s
1125  END DO
1126  VALUE = work( 0 )
1127  DO i = 1, n-1
1128  temp = work( i )
1129  IF( VALUE .LT. temp .OR. disnan( temp ) )
1130  $ VALUE = temp
1131  END DO
1132  END IF
1133  END IF
1134  END IF
1135  ELSE IF( ( lsame( norm, 'F' ) ) .OR. ( lsame( norm, 'E' ) ) ) THEN
1136 *
1137 * Find normF(A).
1138 *
1139  k = ( n+1 ) / 2
1140  scale = zero
1141  s = one
1142  IF( noe.EQ.1 ) THEN
1143 * n is odd
1144  IF( ifm.EQ.1 ) THEN
1145 * A is normal & A is n by k
1146  IF( ilu.EQ.0 ) THEN
1147 * A is upper
1148  DO j = 0, k - 3
1149  CALL zlassq( k-j-2, a( k+j+1+j*lda ), 1, scale, s )
1150 * L at A(k,0)
1151  END DO
1152  DO j = 0, k - 1
1153  CALL zlassq( k+j-1, a( 0+j*lda ), 1, scale, s )
1154 * trap U at A(0,0)
1155  END DO
1156  s = s + s
1157 * double s for the off diagonal elements
1158  l = k - 1
1159 * -> U(k,k) at A(k-1,0)
1160  DO i = 0, k - 2
1161  aa = dble( a( l ) )
1162 * U(k+i,k+i)
1163  IF( aa.NE.zero ) THEN
1164  IF( scale.LT.aa ) THEN
1165  s = one + s*( scale / aa )**2
1166  scale = aa
1167  ELSE
1168  s = s + ( aa / scale )**2
1169  END IF
1170  END IF
1171  aa = dble( a( l+1 ) )
1172 * U(i,i)
1173  IF( aa.NE.zero ) THEN
1174  IF( scale.LT.aa ) THEN
1175  s = one + s*( scale / aa )**2
1176  scale = aa
1177  ELSE
1178  s = s + ( aa / scale )**2
1179  END IF
1180  END IF
1181  l = l + lda + 1
1182  END DO
1183  aa = dble( a( l ) )
1184 * U(n-1,n-1)
1185  IF( aa.NE.zero ) THEN
1186  IF( scale.LT.aa ) THEN
1187  s = one + s*( scale / aa )**2
1188  scale = aa
1189  ELSE
1190  s = s + ( aa / scale )**2
1191  END IF
1192  END IF
1193  ELSE
1194 * ilu=1 & A is lower
1195  DO j = 0, k - 1
1196  CALL zlassq( n-j-1, a( j+1+j*lda ), 1, scale, s )
1197 * trap L at A(0,0)
1198  END DO
1199  DO j = 1, k - 2
1200  CALL zlassq( j, a( 0+( 1+j )*lda ), 1, scale, s )
1201 * U at A(0,1)
1202  END DO
1203  s = s + s
1204 * double s for the off diagonal elements
1205  aa = dble( a( 0 ) )
1206 * L(0,0) at A(0,0)
1207  IF( aa.NE.zero ) THEN
1208  IF( scale.LT.aa ) THEN
1209  s = one + s*( scale / aa )**2
1210  scale = aa
1211  ELSE
1212  s = s + ( aa / scale )**2
1213  END IF
1214  END IF
1215  l = lda
1216 * -> L(k,k) at A(0,1)
1217  DO i = 1, k - 1
1218  aa = dble( a( l ) )
1219 * L(k-1+i,k-1+i)
1220  IF( aa.NE.zero ) THEN
1221  IF( scale.LT.aa ) THEN
1222  s = one + s*( scale / aa )**2
1223  scale = aa
1224  ELSE
1225  s = s + ( aa / scale )**2
1226  END IF
1227  END IF
1228  aa = dble( a( l+1 ) )
1229 * L(i,i)
1230  IF( aa.NE.zero ) THEN
1231  IF( scale.LT.aa ) THEN
1232  s = one + s*( scale / aa )**2
1233  scale = aa
1234  ELSE
1235  s = s + ( aa / scale )**2
1236  END IF
1237  END IF
1238  l = l + lda + 1
1239  END DO
1240  END IF
1241  ELSE
1242 * A is xpose & A is k by n
1243  IF( ilu.EQ.0 ) THEN
1244 * A**H is upper
1245  DO j = 1, k - 2
1246  CALL zlassq( j, a( 0+( k+j )*lda ), 1, scale, s )
1247 * U at A(0,k)
1248  END DO
1249  DO j = 0, k - 2
1250  CALL zlassq( k, a( 0+j*lda ), 1, scale, s )
1251 * k by k-1 rect. at A(0,0)
1252  END DO
1253  DO j = 0, k - 2
1254  CALL zlassq( k-j-1, a( j+1+( j+k-1 )*lda ), 1,
1255  $ scale, s )
1256 * L at A(0,k-1)
1257  END DO
1258  s = s + s
1259 * double s for the off diagonal elements
1260  l = 0 + k*lda - lda
1261 * -> U(k-1,k-1) at A(0,k-1)
1262  aa = dble( a( l ) )
1263 * U(k-1,k-1)
1264  IF( aa.NE.zero ) THEN
1265  IF( scale.LT.aa ) THEN
1266  s = one + s*( scale / aa )**2
1267  scale = aa
1268  ELSE
1269  s = s + ( aa / scale )**2
1270  END IF
1271  END IF
1272  l = l + lda
1273 * -> U(0,0) at A(0,k)
1274  DO j = k, n - 1
1275  aa = dble( a( l ) )
1276 * -> U(j-k,j-k)
1277  IF( aa.NE.zero ) THEN
1278  IF( scale.LT.aa ) THEN
1279  s = one + s*( scale / aa )**2
1280  scale = aa
1281  ELSE
1282  s = s + ( aa / scale )**2
1283  END IF
1284  END IF
1285  aa = dble( a( l+1 ) )
1286 * -> U(j,j)
1287  IF( aa.NE.zero ) THEN
1288  IF( scale.LT.aa ) THEN
1289  s = one + s*( scale / aa )**2
1290  scale = aa
1291  ELSE
1292  s = s + ( aa / scale )**2
1293  END IF
1294  END IF
1295  l = l + lda + 1
1296  END DO
1297  ELSE
1298 * A**H is lower
1299  DO j = 1, k - 1
1300  CALL zlassq( j, a( 0+j*lda ), 1, scale, s )
1301 * U at A(0,0)
1302  END DO
1303  DO j = k, n - 1
1304  CALL zlassq( k, a( 0+j*lda ), 1, scale, s )
1305 * k by k-1 rect. at A(0,k)
1306  END DO
1307  DO j = 0, k - 3
1308  CALL zlassq( k-j-2, a( j+2+j*lda ), 1, scale, s )
1309 * L at A(1,0)
1310  END DO
1311  s = s + s
1312 * double s for the off diagonal elements
1313  l = 0
1314 * -> L(0,0) at A(0,0)
1315  DO i = 0, k - 2
1316  aa = dble( a( l ) )
1317 * L(i,i)
1318  IF( aa.NE.zero ) THEN
1319  IF( scale.LT.aa ) THEN
1320  s = one + s*( scale / aa )**2
1321  scale = aa
1322  ELSE
1323  s = s + ( aa / scale )**2
1324  END IF
1325  END IF
1326  aa = dble( a( l+1 ) )
1327 * L(k+i,k+i)
1328  IF( aa.NE.zero ) THEN
1329  IF( scale.LT.aa ) THEN
1330  s = one + s*( scale / aa )**2
1331  scale = aa
1332  ELSE
1333  s = s + ( aa / scale )**2
1334  END IF
1335  END IF
1336  l = l + lda + 1
1337  END DO
1338 * L-> k-1 + (k-1)*lda or L(k-1,k-1) at A(k-1,k-1)
1339  aa = dble( a( l ) )
1340 * L(k-1,k-1) at A(k-1,k-1)
1341  IF( aa.NE.zero ) THEN
1342  IF( scale.LT.aa ) THEN
1343  s = one + s*( scale / aa )**2
1344  scale = aa
1345  ELSE
1346  s = s + ( aa / scale )**2
1347  END IF
1348  END IF
1349  END IF
1350  END IF
1351  ELSE
1352 * n is even
1353  IF( ifm.EQ.1 ) THEN
1354 * A is normal
1355  IF( ilu.EQ.0 ) THEN
1356 * A is upper
1357  DO j = 0, k - 2
1358  CALL zlassq( k-j-1, a( k+j+2+j*lda ), 1, scale, s )
1359 * L at A(k+1,0)
1360  END DO
1361  DO j = 0, k - 1
1362  CALL zlassq( k+j, a( 0+j*lda ), 1, scale, s )
1363 * trap U at A(0,0)
1364  END DO
1365  s = s + s
1366 * double s for the off diagonal elements
1367  l = k
1368 * -> U(k,k) at A(k,0)
1369  DO i = 0, k - 1
1370  aa = dble( a( l ) )
1371 * U(k+i,k+i)
1372  IF( aa.NE.zero ) THEN
1373  IF( scale.LT.aa ) THEN
1374  s = one + s*( scale / aa )**2
1375  scale = aa
1376  ELSE
1377  s = s + ( aa / scale )**2
1378  END IF
1379  END IF
1380  aa = dble( a( l+1 ) )
1381 * U(i,i)
1382  IF( aa.NE.zero ) THEN
1383  IF( scale.LT.aa ) THEN
1384  s = one + s*( scale / aa )**2
1385  scale = aa
1386  ELSE
1387  s = s + ( aa / scale )**2
1388  END IF
1389  END IF
1390  l = l + lda + 1
1391  END DO
1392  ELSE
1393 * ilu=1 & A is lower
1394  DO j = 0, k - 1
1395  CALL zlassq( n-j-1, a( j+2+j*lda ), 1, scale, s )
1396 * trap L at A(1,0)
1397  END DO
1398  DO j = 1, k - 1
1399  CALL zlassq( j, a( 0+j*lda ), 1, scale, s )
1400 * U at A(0,0)
1401  END DO
1402  s = s + s
1403 * double s for the off diagonal elements
1404  l = 0
1405 * -> L(k,k) at A(0,0)
1406  DO i = 0, k - 1
1407  aa = dble( a( l ) )
1408 * L(k-1+i,k-1+i)
1409  IF( aa.NE.zero ) THEN
1410  IF( scale.LT.aa ) THEN
1411  s = one + s*( scale / aa )**2
1412  scale = aa
1413  ELSE
1414  s = s + ( aa / scale )**2
1415  END IF
1416  END IF
1417  aa = dble( a( l+1 ) )
1418 * L(i,i)
1419  IF( aa.NE.zero ) THEN
1420  IF( scale.LT.aa ) THEN
1421  s = one + s*( scale / aa )**2
1422  scale = aa
1423  ELSE
1424  s = s + ( aa / scale )**2
1425  END IF
1426  END IF
1427  l = l + lda + 1
1428  END DO
1429  END IF
1430  ELSE
1431 * A is xpose
1432  IF( ilu.EQ.0 ) THEN
1433 * A**H is upper
1434  DO j = 1, k - 1
1435  CALL zlassq( j, a( 0+( k+1+j )*lda ), 1, scale, s )
1436 * U at A(0,k+1)
1437  END DO
1438  DO j = 0, k - 1
1439  CALL zlassq( k, a( 0+j*lda ), 1, scale, s )
1440 * k by k rect. at A(0,0)
1441  END DO
1442  DO j = 0, k - 2
1443  CALL zlassq( k-j-1, a( j+1+( j+k )*lda ), 1, scale,
1444  $ s )
1445 * L at A(0,k)
1446  END DO
1447  s = s + s
1448 * double s for the off diagonal elements
1449  l = 0 + k*lda
1450 * -> U(k,k) at A(0,k)
1451  aa = dble( a( l ) )
1452 * U(k,k)
1453  IF( aa.NE.zero ) THEN
1454  IF( scale.LT.aa ) THEN
1455  s = one + s*( scale / aa )**2
1456  scale = aa
1457  ELSE
1458  s = s + ( aa / scale )**2
1459  END IF
1460  END IF
1461  l = l + lda
1462 * -> U(0,0) at A(0,k+1)
1463  DO j = k + 1, n - 1
1464  aa = dble( a( l ) )
1465 * -> U(j-k-1,j-k-1)
1466  IF( aa.NE.zero ) THEN
1467  IF( scale.LT.aa ) THEN
1468  s = one + s*( scale / aa )**2
1469  scale = aa
1470  ELSE
1471  s = s + ( aa / scale )**2
1472  END IF
1473  END IF
1474  aa = dble( a( l+1 ) )
1475 * -> U(j,j)
1476  IF( aa.NE.zero ) THEN
1477  IF( scale.LT.aa ) THEN
1478  s = one + s*( scale / aa )**2
1479  scale = aa
1480  ELSE
1481  s = s + ( aa / scale )**2
1482  END IF
1483  END IF
1484  l = l + lda + 1
1485  END DO
1486 * L=k-1+n*lda
1487 * -> U(k-1,k-1) at A(k-1,n)
1488  aa = dble( a( l ) )
1489 * U(k,k)
1490  IF( aa.NE.zero ) THEN
1491  IF( scale.LT.aa ) THEN
1492  s = one + s*( scale / aa )**2
1493  scale = aa
1494  ELSE
1495  s = s + ( aa / scale )**2
1496  END IF
1497  END IF
1498  ELSE
1499 * A**H is lower
1500  DO j = 1, k - 1
1501  CALL zlassq( j, a( 0+( j+1 )*lda ), 1, scale, s )
1502 * U at A(0,1)
1503  END DO
1504  DO j = k + 1, n
1505  CALL zlassq( k, a( 0+j*lda ), 1, scale, s )
1506 * k by k rect. at A(0,k+1)
1507  END DO
1508  DO j = 0, k - 2
1509  CALL zlassq( k-j-1, a( j+1+j*lda ), 1, scale, s )
1510 * L at A(0,0)
1511  END DO
1512  s = s + s
1513 * double s for the off diagonal elements
1514  l = 0
1515 * -> L(k,k) at A(0,0)
1516  aa = dble( a( l ) )
1517 * L(k,k) at A(0,0)
1518  IF( aa.NE.zero ) THEN
1519  IF( scale.LT.aa ) THEN
1520  s = one + s*( scale / aa )**2
1521  scale = aa
1522  ELSE
1523  s = s + ( aa / scale )**2
1524  END IF
1525  END IF
1526  l = lda
1527 * -> L(0,0) at A(0,1)
1528  DO i = 0, k - 2
1529  aa = dble( a( l ) )
1530 * L(i,i)
1531  IF( aa.NE.zero ) THEN
1532  IF( scale.LT.aa ) THEN
1533  s = one + s*( scale / aa )**2
1534  scale = aa
1535  ELSE
1536  s = s + ( aa / scale )**2
1537  END IF
1538  END IF
1539  aa = dble( a( l+1 ) )
1540 * L(k+i+1,k+i+1)
1541  IF( aa.NE.zero ) THEN
1542  IF( scale.LT.aa ) THEN
1543  s = one + s*( scale / aa )**2
1544  scale = aa
1545  ELSE
1546  s = s + ( aa / scale )**2
1547  END IF
1548  END IF
1549  l = l + lda + 1
1550  END DO
1551 * L-> k - 1 + k*lda or L(k-1,k-1) at A(k-1,k)
1552  aa = dble( a( l ) )
1553 * L(k-1,k-1) at A(k-1,k)
1554  IF( aa.NE.zero ) THEN
1555  IF( scale.LT.aa ) THEN
1556  s = one + s*( scale / aa )**2
1557  scale = aa
1558  ELSE
1559  s = s + ( aa / scale )**2
1560  END IF
1561  END IF
1562  END IF
1563  END IF
1564  END IF
1565  VALUE = scale*sqrt( s )
1566  END IF
1567 *
1568  zlanhf = VALUE
1569  RETURN
1570 *
1571 * End of ZLANHF
1572 *
disnan
logical function disnan(DIN)
DISNAN tests input for NaN.
Definition: disnan.f:61
zlanhf
double precision function zlanhf(NORM, TRANSR, UPLO, N, A, WORK)
ZLANHF returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a Hermitian matrix in RFP format.
Definition: zlanhf.f:248
zlassq
subroutine zlassq(N, X, INCX, SCALE, SUMSQ)
ZLASSQ updates a sum of squares represented in scaled form.
Definition: zlassq.f:108
lsame
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55

Here is the call graph for this function: