247 DOUBLE PRECISION FUNCTION zlanhf( NORM, TRANSR, UPLO, N, A, WORK )
255 CHARACTER NORM, TRANSR, UPLO
259 DOUBLE PRECISION WORK( 0: * )
266 DOUBLE PRECISION ONE, ZERO
267 parameter ( one = 1.0d+0, zero = 0.0d+0 )
270 INTEGER I, J, IFM, ILU, NOE, N1, K, L, LDA
271 DOUBLE PRECISION SCALE, S,
VALUE, AA, TEMP
274 LOGICAL LSAME, DISNAN
275 EXTERNAL lsame, disnan
281 INTRINSIC abs, dble, sqrt
288 ELSE IF( n.EQ.1 )
THEN
296 IF( mod( n, 2 ).EQ.0 )
302 IF( lsame( transr,
'C' ) )
308 IF( lsame( uplo,
'U' ) )
327 IF( lsame( norm,
'M' ) )
THEN
341 temp = abs( dble( a( j+j*lda ) ) )
342 IF(
VALUE .LT. temp .OR. disnan( temp ) )
345 temp = abs( a( i+j*lda ) )
346 IF(
VALUE .LT. temp .OR. disnan( temp ) )
351 temp = abs( a( i+j*lda ) )
352 IF(
VALUE .LT. temp .OR. disnan( temp ) )
357 temp = abs( dble( a( i+j*lda ) ) )
358 IF(
VALUE .LT. temp .OR. disnan( temp ) )
362 temp = abs( dble( a( i+j*lda ) ) )
363 IF(
VALUE .LT. temp .OR. disnan( temp ) )
366 temp = abs( a( i+j*lda ) )
367 IF(
VALUE .LT. temp .OR. disnan( temp ) )
375 temp = abs( a( i+j*lda ) )
376 IF(
VALUE .LT. temp .OR. disnan( temp ) )
381 temp = abs( dble( a( i+j*lda ) ) )
382 IF(
VALUE .LT. temp .OR. disnan( temp ) )
386 temp = abs( dble( a( i+j*lda ) ) )
387 IF(
VALUE .LT. temp .OR. disnan( temp ) )
389 DO i = k + j + 1, n - 1
390 temp = abs( a( i+j*lda ) )
391 IF(
VALUE .LT. temp .OR. disnan( temp ) )
396 temp = abs( a( i+j*lda ) )
397 IF(
VALUE .LT. temp .OR. disnan( temp ) )
402 temp = abs( dble( a( i+j*lda ) ) )
403 IF(
VALUE .LT. temp .OR. disnan( temp ) )
412 temp = abs( a( i+j*lda ) )
413 IF(
VALUE .LT. temp .OR. disnan( temp ) )
418 temp = abs( dble( a( i+j*lda ) ) )
419 IF(
VALUE .LT. temp .OR. disnan( temp ) )
423 temp = abs( dble( a( i+j*lda ) ) )
424 IF(
VALUE .LT. temp .OR. disnan( temp ) )
427 temp = abs( a( i+j*lda ) )
428 IF(
VALUE .LT. temp .OR. disnan( temp ) )
434 temp = abs( a( i+j*lda ) )
435 IF(
VALUE .LT. temp .OR. disnan( temp ) )
440 temp = abs( dble( a( i+j*lda ) ) )
441 IF(
VALUE .LT. temp .OR. disnan( temp ) )
445 temp = abs( a( i+j*lda ) )
446 IF(
VALUE .LT. temp .OR. disnan( temp ) )
454 temp = abs( a( i+j*lda ) )
455 IF(
VALUE .LT. temp .OR. disnan( temp ) )
461 temp = abs( dble( a( 0+j*lda ) ) )
462 IF(
VALUE .LT. temp .OR. disnan( temp ) )
465 temp = abs( a( i+j*lda ) )
466 IF(
VALUE .LT. temp .OR. disnan( temp ) )
471 temp = abs( a( i+j*lda ) )
472 IF(
VALUE .LT. temp .OR. disnan( temp ) )
477 temp = abs( dble( a( i+j*lda ) ) )
478 IF(
VALUE .LT. temp .OR. disnan( temp ) )
482 temp = abs( dble( a( i+j*lda ) ) )
483 IF(
VALUE .LT. temp .OR. disnan( temp ) )
485 DO i = j - k + 2, k - 1
486 temp = abs( a( i+j*lda ) )
487 IF(
VALUE .LT. temp .OR. disnan( temp ) )
501 temp = abs( dble( a( j+j*lda ) ) )
502 IF(
VALUE .LT. temp .OR. disnan( temp ) )
504 temp = abs( dble( a( j+1+j*lda ) ) )
505 IF(
VALUE .LT. temp .OR. disnan( temp ) )
508 temp = abs( a( i+j*lda ) )
509 IF(
VALUE .LT. temp .OR. disnan( temp ) )
514 temp = abs( a( i+j*lda ) )
515 IF(
VALUE .LT. temp .OR. disnan( temp ) )
520 temp = abs( dble( a( i+j*lda ) ) )
521 IF(
VALUE .LT. temp .OR. disnan( temp ) )
525 temp = abs( dble( a( i+j*lda ) ) )
526 IF(
VALUE .LT. temp .OR. disnan( temp ) )
529 temp = abs( a( i+j*lda ) )
530 IF(
VALUE .LT. temp .OR. disnan( temp ) )
538 temp = abs( a( i+j*lda ) )
539 IF(
VALUE .LT. temp .OR. disnan( temp ) )
544 temp = abs( dble( a( i+j*lda ) ) )
545 IF(
VALUE .LT. temp .OR. disnan( temp ) )
549 temp = abs( dble( a( i+j*lda ) ) )
550 IF(
VALUE .LT. temp .OR. disnan( temp ) )
553 temp = abs( a( i+j*lda ) )
554 IF(
VALUE .LT. temp .OR. disnan( temp ) )
559 temp = abs( a( i+j*lda ) )
560 IF(
VALUE .LT. temp .OR. disnan( temp ) )
565 temp = abs( dble( a( i+j*lda ) ) )
566 IF(
VALUE .LT. temp .OR. disnan( temp ) )
570 temp = abs( dble( a( i+j*lda ) ) )
571 IF(
VALUE .LT. temp .OR. disnan( temp ) )
580 temp = abs( dble( a( j+j*lda ) ) )
581 IF(
VALUE .LT. temp .OR. disnan( temp ) )
584 temp = abs( a( i+j*lda ) )
585 IF(
VALUE .LT. temp .OR. disnan( temp ) )
590 temp = abs( a( i+j*lda ) )
591 IF(
VALUE .LT. temp .OR. disnan( temp ) )
596 temp = abs( dble( a( i+j*lda ) ) )
597 IF(
VALUE .LT. temp .OR. disnan( temp ) )
601 temp = abs( dble( a( i+j*lda ) ) )
602 IF(
VALUE .LT. temp .OR. disnan( temp ) )
605 temp = abs( a( i+j*lda ) )
606 IF(
VALUE .LT. temp .OR. disnan( temp ) )
612 temp = abs( a( i+j*lda ) )
613 IF(
VALUE .LT. temp .OR. disnan( temp ) )
618 temp = abs( dble( a( i+j*lda ) ) )
619 IF(
VALUE .LT. temp .OR. disnan( temp ) )
623 temp = abs( a( i+j*lda ) )
624 IF(
VALUE .LT. temp .OR. disnan( temp ) )
632 temp = abs( a( i+j*lda ) )
633 IF(
VALUE .LT. temp .OR. disnan( temp ) )
639 temp = abs( dble( a( 0+j*lda ) ) )
640 IF(
VALUE .LT. temp .OR. disnan( temp ) )
643 temp = abs( a( i+j*lda ) )
644 IF(
VALUE .LT. temp .OR. disnan( temp ) )
649 temp = abs( a( i+j*lda ) )
650 IF(
VALUE .LT. temp .OR. disnan( temp ) )
655 temp = abs( dble( a( i+j*lda ) ) )
656 IF(
VALUE .LT. temp .OR. disnan( temp ) )
660 temp = abs( dble( a( i+j*lda ) ) )
661 IF(
VALUE .LT. temp .OR. disnan( temp ) )
663 DO i = j - k + 1, k - 1
664 temp = abs( a( i+j*lda ) )
665 IF(
VALUE .LT. temp .OR. disnan( temp ) )
671 temp = abs( a( i+j*lda ) )
672 IF(
VALUE .LT. temp .OR. disnan( temp ) )
677 temp = abs( dble( a( i+j*lda ) ) )
678 IF(
VALUE .LT. temp .OR. disnan( temp ) )
683 ELSE IF( ( lsame( norm,
'I' ) ) .OR. ( lsame( norm,
'O' ) ) .OR.
684 $ ( norm.EQ.
'1' ) )
THEN
701 aa = abs( a( i+j*lda ) )
704 work( i ) = work( i ) + aa
706 aa = abs( dble( a( i+j*lda ) ) )
712 aa = abs( dble( a( i+j*lda ) ) )
714 work( j ) = work( j ) + aa
718 aa = abs( a( i+j*lda ) )
721 work( l ) = work( l ) + aa
723 work( j ) = work( j ) + s
729 IF(
VALUE .LT. temp .OR. disnan( temp ) )
742 aa = abs( a( i+j*lda ) )
745 work( i+k ) = work( i+k ) + aa
748 aa = abs( dble( a( i+j*lda ) ) )
751 work( i+k ) = work( i+k ) + s
755 aa = abs( dble( a( i+j*lda ) ) )
761 aa = abs( a( i+j*lda ) )
764 work( l ) = work( l ) + aa
766 work( j ) = work( j ) + s
771 IF(
VALUE .LT. temp .OR. disnan( temp ) )
785 aa = abs( a( i+j*lda ) )
788 work( i ) = work( i ) + aa
790 aa = abs( dble( a( i+j*lda ) ) )
794 aa = abs( dble( a( i+j*lda ) ) )
796 work( j ) = work( j ) + aa
800 aa = abs( a( i+j*lda ) )
803 work( l ) = work( l ) + aa
805 work( j ) = work( j ) + s
810 IF(
VALUE .LT. temp .OR. disnan( temp ) )
821 aa = abs( a( i+j*lda ) )
824 work( i+k ) = work( i+k ) + aa
826 aa = abs( dble( a( i+j*lda ) ) )
829 work( i+k ) = work( i+k ) + s
832 aa = abs( dble( a( i+j*lda ) ) )
838 aa = abs( a( i+j*lda ) )
841 work( l ) = work( l ) + aa
843 work( j ) = work( j ) + s
848 IF(
VALUE .LT. temp .OR. disnan( temp ) )
870 aa = abs( a( i+j*lda ) )
872 work( i+n1 ) = work( i+n1 ) + aa
878 s = abs( dble( a( 0+j*lda ) ) )
881 aa = abs( a( i+j*lda ) )
883 work( i+n1 ) = work( i+n1 ) + aa
886 work( j ) = work( j ) + s
890 aa = abs( a( i+j*lda ) )
892 work( i ) = work( i ) + aa
896 aa = abs( dble( a( i+j*lda ) ) )
899 work( j-k ) = work( j-k ) + s
901 s = abs( dble( a( i+j*lda ) ) )
905 aa = abs( a( i+j*lda ) )
907 work( l ) = work( l ) + aa
910 work( j ) = work( j ) + s
915 IF(
VALUE .LT. temp .OR. disnan( temp ) )
929 aa = abs( a( i+j*lda ) )
931 work( i ) = work( i ) + aa
934 aa = abs( dble( a( i+j*lda ) ) )
941 aa = abs( dble( a( i+j*lda ) ) )
943 DO l = k + j + 1, n - 1
945 aa = abs( a( i+j*lda ) )
948 work( l ) = work( l ) + aa
950 work( k+j ) = work( k+j ) + s
955 aa = abs( a( i+j*lda ) )
957 work( i ) = work( i ) + aa
961 aa = abs( dble( a( i+j*lda ) ) )
970 aa = abs( a( i+j*lda ) )
972 work( i ) = work( i ) + aa
975 work( j ) = work( j ) + s
980 IF(
VALUE .LT. temp .OR. disnan( temp ) )
994 aa = abs( a( i+j*lda ) )
996 work( i+k ) = work( i+k ) + aa
1002 aa = abs( dble( a( 0+j*lda ) ) )
1006 aa = abs( a( i+j*lda ) )
1008 work( i+k ) = work( i+k ) + aa
1011 work( j ) = work( j ) + s
1015 aa = abs( a( i+j*lda ) )
1017 work( i ) = work( i ) + aa
1021 aa = abs( dble( a( i+j*lda ) ) )
1024 work( j-k-1 ) = work( j-k-1 ) + s
1026 aa = abs( dble( a( i+j*lda ) ) )
1031 aa = abs( a( i+j*lda ) )
1033 work( l ) = work( l ) + aa
1036 work( j ) = work( j ) + s
1041 aa = abs( a( i+j*lda ) )
1043 work( i ) = work( i ) + aa
1047 aa = abs( dble( a( i+j*lda ) ) )
1050 work( i ) = work( i ) + s
1054 IF(
VALUE .LT. temp .OR. disnan( temp ) )
1063 s = abs( dble( a( 0 ) ) )
1068 work( i+k ) = work( i+k ) + aa
1071 work( k ) = work( k ) + s
1076 aa = abs( a( i+j*lda ) )
1078 work( i ) = work( i ) + aa
1081 aa = abs( dble( a( i+j*lda ) ) )
1088 aa = abs( dble( a( i+j*lda ) ) )
1090 DO l = k + j + 1, n - 1
1092 aa = abs( a( i+j*lda ) )
1095 work( l ) = work( l ) + aa
1097 work( k+j ) = work( k+j ) + s
1102 aa = abs( a( i+j*lda ) )
1104 work( i ) = work( i ) + aa
1109 aa = abs( dble( a( i+j*lda ) ) )
1119 aa = abs( a( i+j*lda ) )
1121 work( i ) = work( i ) + aa
1124 work( j-1 ) = work( j-1 ) + s
1129 IF(
VALUE .LT. temp .OR. disnan( temp ) )
1135 ELSE IF( ( lsame( norm,
'F' ) ) .OR. ( lsame( norm,
'E' ) ) )
THEN
1149 CALL zlassq( k-j-2, a( k+j+1+j*lda ), 1, scale, s )
1153 CALL zlassq( k+j-1, a( 0+j*lda ), 1, scale, s )
1163 IF( aa.NE.zero )
THEN
1164 IF( scale.LT.aa )
THEN
1165 s = one + s*( scale / aa )**2
1168 s = s + ( aa / scale )**2
1171 aa = dble( a( l+1 ) )
1173 IF( aa.NE.zero )
THEN
1174 IF( scale.LT.aa )
THEN
1175 s = one + s*( scale / aa )**2
1178 s = s + ( aa / scale )**2
1185 IF( aa.NE.zero )
THEN
1186 IF( scale.LT.aa )
THEN
1187 s = one + s*( scale / aa )**2
1190 s = s + ( aa / scale )**2
1196 CALL zlassq( n-j-1, a( j+1+j*lda ), 1, scale, s )
1200 CALL zlassq( j, a( 0+( 1+j )*lda ), 1, scale, s )
1207 IF( aa.NE.zero )
THEN
1208 IF( scale.LT.aa )
THEN
1209 s = one + s*( scale / aa )**2
1212 s = s + ( aa / scale )**2
1220 IF( aa.NE.zero )
THEN
1221 IF( scale.LT.aa )
THEN
1222 s = one + s*( scale / aa )**2
1225 s = s + ( aa / scale )**2
1228 aa = dble( a( l+1 ) )
1230 IF( aa.NE.zero )
THEN
1231 IF( scale.LT.aa )
THEN
1232 s = one + s*( scale / aa )**2
1235 s = s + ( aa / scale )**2
1246 CALL zlassq( j, a( 0+( k+j )*lda ), 1, scale, s )
1250 CALL zlassq( k, a( 0+j*lda ), 1, scale, s )
1254 CALL zlassq( k-j-1, a( j+1+( j+k-1 )*lda ), 1,
1264 IF( aa.NE.zero )
THEN
1265 IF( scale.LT.aa )
THEN
1266 s = one + s*( scale / aa )**2
1269 s = s + ( aa / scale )**2
1277 IF( aa.NE.zero )
THEN
1278 IF( scale.LT.aa )
THEN
1279 s = one + s*( scale / aa )**2
1282 s = s + ( aa / scale )**2
1285 aa = dble( a( l+1 ) )
1287 IF( aa.NE.zero )
THEN
1288 IF( scale.LT.aa )
THEN
1289 s = one + s*( scale / aa )**2
1292 s = s + ( aa / scale )**2
1300 CALL zlassq( j, a( 0+j*lda ), 1, scale, s )
1304 CALL zlassq( k, a( 0+j*lda ), 1, scale, s )
1308 CALL zlassq( k-j-2, a( j+2+j*lda ), 1, scale, s )
1318 IF( aa.NE.zero )
THEN
1319 IF( scale.LT.aa )
THEN
1320 s = one + s*( scale / aa )**2
1323 s = s + ( aa / scale )**2
1326 aa = dble( a( l+1 ) )
1328 IF( aa.NE.zero )
THEN
1329 IF( scale.LT.aa )
THEN
1330 s = one + s*( scale / aa )**2
1333 s = s + ( aa / scale )**2
1341 IF( aa.NE.zero )
THEN
1342 IF( scale.LT.aa )
THEN
1343 s = one + s*( scale / aa )**2
1346 s = s + ( aa / scale )**2
1358 CALL zlassq( k-j-1, a( k+j+2+j*lda ), 1, scale, s )
1362 CALL zlassq( k+j, a( 0+j*lda ), 1, scale, s )
1372 IF( aa.NE.zero )
THEN
1373 IF( scale.LT.aa )
THEN
1374 s = one + s*( scale / aa )**2
1377 s = s + ( aa / scale )**2
1380 aa = dble( a( l+1 ) )
1382 IF( aa.NE.zero )
THEN
1383 IF( scale.LT.aa )
THEN
1384 s = one + s*( scale / aa )**2
1387 s = s + ( aa / scale )**2
1395 CALL zlassq( n-j-1, a( j+2+j*lda ), 1, scale, s )
1399 CALL zlassq( j, a( 0+j*lda ), 1, scale, s )
1409 IF( aa.NE.zero )
THEN
1410 IF( scale.LT.aa )
THEN
1411 s = one + s*( scale / aa )**2
1414 s = s + ( aa / scale )**2
1417 aa = dble( a( l+1 ) )
1419 IF( aa.NE.zero )
THEN
1420 IF( scale.LT.aa )
THEN
1421 s = one + s*( scale / aa )**2
1424 s = s + ( aa / scale )**2
1435 CALL zlassq( j, a( 0+( k+1+j )*lda ), 1, scale, s )
1439 CALL zlassq( k, a( 0+j*lda ), 1, scale, s )
1443 CALL zlassq( k-j-1, a( j+1+( j+k )*lda ), 1, scale,
1453 IF( aa.NE.zero )
THEN
1454 IF( scale.LT.aa )
THEN
1455 s = one + s*( scale / aa )**2
1458 s = s + ( aa / scale )**2
1466 IF( aa.NE.zero )
THEN
1467 IF( scale.LT.aa )
THEN
1468 s = one + s*( scale / aa )**2
1471 s = s + ( aa / scale )**2
1474 aa = dble( a( l+1 ) )
1476 IF( aa.NE.zero )
THEN
1477 IF( scale.LT.aa )
THEN
1478 s = one + s*( scale / aa )**2
1481 s = s + ( aa / scale )**2
1490 IF( aa.NE.zero )
THEN
1491 IF( scale.LT.aa )
THEN
1492 s = one + s*( scale / aa )**2
1495 s = s + ( aa / scale )**2
1501 CALL zlassq( j, a( 0+( j+1 )*lda ), 1, scale, s )
1505 CALL zlassq( k, a( 0+j*lda ), 1, scale, s )
1509 CALL zlassq( k-j-1, a( j+1+j*lda ), 1, scale, s )
1518 IF( aa.NE.zero )
THEN
1519 IF( scale.LT.aa )
THEN
1520 s = one + s*( scale / aa )**2
1523 s = s + ( aa / scale )**2
1531 IF( aa.NE.zero )
THEN
1532 IF( scale.LT.aa )
THEN
1533 s = one + s*( scale / aa )**2
1536 s = s + ( aa / scale )**2
1539 aa = dble( a( l+1 ) )
1541 IF( aa.NE.zero )
THEN
1542 IF( scale.LT.aa )
THEN
1543 s = one + s*( scale / aa )**2
1546 s = s + ( aa / scale )**2
1554 IF( aa.NE.zero )
THEN
1555 IF( scale.LT.aa )
THEN
1556 s = one + s*( scale / aa )**2
1559 s = s + ( aa / scale )**2
1565 VALUE = scale*sqrt( s )
subroutine zlassq(N, X, INCX, SCALE, SUMSQ)
ZLASSQ updates a sum of squares represented in scaled form.
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.