486 SUBROUTINE zlatmr( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX,
487 $ RSIGN, GRADE, DL, MODEL, CONDL, DR, MODER,
488 $ CONDR, PIVTNG, IPIVOT, KL, KU, SPARSE, ANORM,
489 $ PACK, A, LDA, IWORK, INFO )
496 CHARACTER DIST, GRADE, PACK, PIVTNG, RSIGN, SYM
497 INTEGER INFO, KL, KU, LDA, M, MODE, MODEL, MODER, N
498 DOUBLE PRECISION ANORM, COND, CONDL, CONDR, SPARSE
502 INTEGER IPIVOT( * ), ISEED( 4 ), IWORK( * )
503 COMPLEX*16 A( LDA, * ), D( * ), DL( * ), DR( * )
509 DOUBLE PRECISION ZERO
510 PARAMETER ( ZERO = 0.0d0 )
512 parameter( one = 1.0d0 )
514 parameter( cone = ( 1.0d0, 0.0d0 ) )
516 parameter( czero = ( 0.0d0, 0.0d0 ) )
519 LOGICAL BADPVT, DZERO, FULBND
520 INTEGER I, IDIST, IGRADE, IISUB, IPACK, IPVTNG, IRSIGN,
521 $ ISUB, ISYM, J, JJSUB, JSUB, K, KLL, KUU, MNMIN,
522 $ mnsub, mxsub, npvts
523 DOUBLE PRECISION ONORM, TEMP
524 COMPLEX*16 CALPHA, CTEMP
527 DOUBLE PRECISION TEMPA( 1 )
531 DOUBLE PRECISION ZLANGB, ZLANGE, ZLANSB, ZLANSP, ZLANSY
532 COMPLEX*16 ZLATM2, ZLATM3
533 EXTERNAL lsame, zlangb, zlange, zlansb, zlansp, zlansy,
540 INTRINSIC abs, dble, dconjg,
max,
min, mod
551 IF( m.EQ.0 .OR. n.EQ.0 )
556 IF( lsame( dist,
'U' ) )
THEN
558 ELSE IF( lsame( dist,
'S' ) )
THEN
560 ELSE IF( lsame( dist,
'N' ) )
THEN
562 ELSE IF( lsame( dist,
'D' ) )
THEN
570 IF( lsame( sym,
'H' ) )
THEN
572 ELSE IF( lsame( sym,
'N' ) )
THEN
574 ELSE IF( lsame( sym,
'S' ) )
THEN
582 IF( lsame( rsign,
'F' ) )
THEN
584 ELSE IF( lsame( rsign,
'T' ) )
THEN
592 IF( lsame( pivtng,
'N' ) )
THEN
594 ELSE IF( lsame( pivtng,
' ' ) )
THEN
596 ELSE IF( lsame( pivtng,
'L' ) )
THEN
599 ELSE IF( lsame( pivtng,
'R' ) )
THEN
602 ELSE IF( lsame( pivtng,
'B' ) )
THEN
605 ELSE IF( lsame( pivtng,
'F' ) )
THEN
614 IF( lsame( grade,
'N' ) )
THEN
616 ELSE IF( lsame( grade,
'L' ) )
THEN
618 ELSE IF( lsame( grade,
'R' ) )
THEN
620 ELSE IF( lsame( grade,
'B' ) )
THEN
622 ELSE IF( lsame( grade,
'E' ) )
THEN
624 ELSE IF( lsame( grade,
'H' ) )
THEN
626 ELSE IF( lsame( grade,
'S' ) )
THEN
634 IF( lsame( pack,
'N' ) )
THEN
636 ELSE IF( lsame( pack,
'U' ) )
THEN
638 ELSE IF( lsame( pack,
'L' ) )
THEN
640 ELSE IF( lsame( pack,
'C' ) )
THEN
642 ELSE IF( lsame( pack,
'R' ) )
THEN
644 ELSE IF( lsame( pack,
'B' ) )
THEN
646 ELSE IF( lsame( pack,
'Q' ) )
THEN
648 ELSE IF( lsame( pack,
'Z' ) )
THEN
663 IF( igrade.EQ.4 .AND. model.EQ.0 )
THEN
665 IF( dl( i ).EQ.czero )
673 IF( ipvtng.GT.0 )
THEN
675 IF( ipivot( j ).LE.0 .OR. ipivot( j ).GT.npvts )
684 ELSE IF( m.NE.n .AND. ( isym.EQ.0 .OR. isym.EQ.2 ) )
THEN
686 ELSE IF( n.LT.0 )
THEN
688 ELSE IF( idist.EQ.-1 )
THEN
690 ELSE IF( isym.EQ.-1 )
THEN
692 ELSE IF( mode.LT.-6 .OR. mode.GT.6 )
THEN
694 ELSE IF( ( mode.NE.-6 .AND. mode.NE.0 .AND. mode.NE.6 ) .AND.
697 ELSE IF( ( mode.NE.-6 .AND. mode.NE.0 .AND. mode.NE.6 ) .AND.
698 $ irsign.EQ.-1 )
THEN
700 ELSE IF( igrade.EQ.-1 .OR. ( igrade.EQ.4 .AND. m.NE.n ) .OR.
701 $ ( ( igrade.EQ.1 .OR. igrade.EQ.2 .OR. igrade.EQ.3 .OR.
702 $ igrade.EQ.4 .OR. igrade.EQ.6 ) .AND. isym.EQ.0 ) .OR.
703 $ ( ( igrade.EQ.1 .OR. igrade.EQ.2 .OR. igrade.EQ.3 .OR.
704 $ igrade.EQ.4 .OR. igrade.EQ.5 ) .AND. isym.EQ.2 ) )
THEN
706 ELSE IF( igrade.EQ.4 .AND. dzero )
THEN
708 ELSE IF( ( igrade.EQ.1 .OR. igrade.EQ.3 .OR. igrade.EQ.4 .OR.
709 $ igrade.EQ.5 .OR. igrade.EQ.6 ) .AND.
710 $ ( model.LT.-6 .OR. model.GT.6 ) )
THEN
712 ELSE IF( ( igrade.EQ.1 .OR. igrade.EQ.3 .OR. igrade.EQ.4 .OR.
713 $ igrade.EQ.5 .OR. igrade.EQ.6 ) .AND.
714 $ ( model.NE.-6 .AND. model.NE.0 .AND. model.NE.6 ) .AND.
715 $ condl.LT.one )
THEN
717 ELSE IF( ( igrade.EQ.2 .OR. igrade.EQ.3 ) .AND.
718 $ ( moder.LT.-6 .OR. moder.GT.6 ) )
THEN
720 ELSE IF( ( igrade.EQ.2 .OR. igrade.EQ.3 ) .AND.
721 $ ( moder.NE.-6 .AND. moder.NE.0 .AND. moder.NE.6 ) .AND.
722 $ condr.LT.one )
THEN
724 ELSE IF( ipvtng.EQ.-1 .OR. ( ipvtng.EQ.3 .AND. m.NE.n ) .OR.
725 $ ( ( ipvtng.EQ.1 .OR. ipvtng.EQ.2 ) .AND. ( isym.EQ.0 .OR.
726 $ isym.EQ.2 ) ) )
THEN
728 ELSE IF( ipvtng.NE.0 .AND. badpvt )
THEN
730 ELSE IF( kl.LT.0 )
THEN
732 ELSE IF( ku.LT.0 .OR. ( ( isym.EQ.0 .OR. isym.EQ.2 ) .AND. kl.NE.
735 ELSE IF( sparse.LT.zero .OR. sparse.GT.one )
THEN
737 ELSE IF( ipack.EQ.-1 .OR. ( ( ipack.EQ.1 .OR. ipack.EQ.2 .OR.
738 $ ipack.EQ.5 .OR. ipack.EQ.6 ) .AND. isym.EQ.1 ) .OR.
739 $ ( ipack.EQ.3 .AND. isym.EQ.1 .AND. ( kl.NE.0 .OR. m.NE.
740 $ n ) ) .OR. ( ipack.EQ.4 .AND. isym.EQ.1 .AND. ( ku.NE.
741 $ 0 .OR. m.NE.n ) ) )
THEN
743 ELSE IF( ( ( ipack.EQ.0 .OR. ipack.EQ.1 .OR. ipack.EQ.2 ) .AND.
744 $ lda.LT.
max( 1, m ) ) .OR. ( ( ipack.EQ.3 .OR. ipack.EQ.
745 $ 4 ) .AND. lda.LT.1 ) .OR. ( ( ipack.EQ.5 .OR. ipack.EQ.
746 $ 6 ) .AND. lda.LT.kuu+1 ) .OR.
747 $ ( ipack.EQ.7 .AND. lda.LT.kll+kuu+1 ) )
THEN
752 CALL xerbla(
'ZLATMR', -info )
759 IF( kuu.EQ.n-1 .AND. kll.EQ.m-1 )
765 iseed( i ) = mod( abs( iseed( i ) ), 4096 )
768 iseed( 4 ) = 2*( iseed( 4 ) / 2 ) + 1
774 CALL zlatm1( mode, cond, irsign, idist, iseed, d, mnmin, info )
779 IF( mode.NE.0 .AND. mode.NE.-6 .AND. mode.NE.6 )
THEN
785 temp =
max( temp, abs( d( i ) ) )
787 IF( temp.EQ.zero .AND. dmax.NE.czero )
THEN
791 IF( temp.NE.zero )
THEN
797 d( i ) = calpha*d( i )
806 d( i ) = dble( d( i ) )
812 IF( igrade.EQ.1 .OR. igrade.EQ.3 .OR. igrade.EQ.4 .OR. igrade.EQ.
813 $ 5 .OR. igrade.EQ.6 )
THEN
814 CALL zlatm1( model, condl, 0, idist, iseed, dl, m, info )
823 IF( igrade.EQ.2 .OR. igrade.EQ.3 )
THEN
824 CALL zlatm1( moder, condr, 0, idist, iseed, dr, n, info )
833 IF( ipvtng.GT.0 )
THEN
841 iwork( i ) = iwork( k )
845 DO 90 i = npvts, 1, -1
848 iwork( i ) = iwork( k )
864 IF( ipack.EQ.0 )
THEN
868 ctemp = zlatm3( m, n, i, j, isub, jsub, kl, ku,
869 $ idist, iseed, d, igrade, dl, dr, ipvtng,
871 a( isub, jsub ) = ctemp
872 a( jsub, isub ) = dconjg( ctemp )
875 ELSE IF( isym.EQ.1 )
THEN
878 ctemp = zlatm3( m, n, i, j, isub, jsub, kl, ku,
879 $ idist, iseed, d, igrade, dl, dr, ipvtng,
881 a( isub, jsub ) = ctemp
884 ELSE IF( isym.EQ.2 )
THEN
887 ctemp = zlatm3( m, n, i, j, isub, jsub, kl, ku,
888 $ idist, iseed, d, igrade, dl, dr, ipvtng,
890 a( isub, jsub ) = ctemp
891 a( jsub, isub ) = ctemp
896 ELSE IF( ipack.EQ.1 )
THEN
900 ctemp = zlatm3( m, n, i, j, isub, jsub, kl, ku, idist,
901 $ iseed, d, igrade, dl, dr, ipvtng, iwork,
903 mnsub =
min( isub, jsub )
904 mxsub =
max( isub, jsub )
905 IF( mxsub.EQ.isub .AND. isym.EQ.0 )
THEN
906 a( mnsub, mxsub ) = dconjg( ctemp )
908 a( mnsub, mxsub ) = ctemp
911 $ a( mxsub, mnsub ) = czero
915 ELSE IF( ipack.EQ.2 )
THEN
919 ctemp = zlatm3( m, n, i, j, isub, jsub, kl, ku, idist,
920 $ iseed, d, igrade, dl, dr, ipvtng, iwork,
922 mnsub =
min( isub, jsub )
923 mxsub =
max( isub, jsub )
924 IF( mxsub.EQ.jsub .AND. isym.EQ.0 )
THEN
925 a( mxsub, mnsub ) = dconjg( ctemp )
927 a( mxsub, mnsub ) = ctemp
930 $ a( mnsub, mxsub ) = czero
934 ELSE IF( ipack.EQ.3 )
THEN
938 ctemp = zlatm3( m, n, i, j, isub, jsub, kl, ku, idist,
939 $ iseed, d, igrade, dl, dr, ipvtng
946 mxsub =
max( isub, jsub )
947 k = mxsub*( mxsub-1 ) / 2 + mnsub
951 jjsub = ( k-1 ) / lda + 1
952 iisub = k - lda*( jjsub-1 )
954 IF( mxsub.EQ.isub
THEN
955 a( iisub, jjsub ) = dconjg( ctemp )
957 a( iisub, jjsub ) = ctemp
962 ELSE IF( ipack.EQ.4 )
THEN
973 mxsub =
max( isub, jsub )
974 IF( mnsub.EQ.1 )
THEN
977 k = n*( n+1 ) / 2 - ( n-mnsub+1 )*( n-mnsub+2 ) /
978 $ 2 + mxsub - mnsub + 1
983 jjsub = ( k-1 ) / lda + 1
984 iisub = k - lda*( jjsub-1 )
986 IF( mxsub.EQ.jsub .AND. isym.EQ.0 )
THEN
987 a( iisub, jjsub ) = dconjg( ctemp )
989 a( iisub, jjsub ) = ctemp
994 ELSE IF( ipack.EQ.5 )
THEN
997 DO 240 i = j - kuu, j
999 a( j-i+1, i+n ) = czero
1001 ctemp = zlatm3( m, n, i, j, isub, jsub, kl, ku,
1002 $ idist, iseed, d, igrade, dl, dr, ipvtng,
1004 mnsub =
min( isub, jsub )
1005 mxsub =
max( isub, jsub )
1006 IF( mxsub.EQ.jsub .AND. isym.EQ.0 )
THEN
1007 a( mxsub-mnsub+1, mnsub ) = dconjg( ctemp )
1009 a( mxsub-mnsub+1, mnsub ) = ctemp
1015 ELSE IF( ipack.EQ.6 )
THEN
1018 DO 260 i = j - kuu, j
1019 ctemp = zlatm3( m, n, i, j, isub, jsub, kl, ku, idist,
1020 $ iseed, d, igrade, dl, dr, ipvtng, iwork,
1022 mnsub =
min( isub, jsub )
1023 mxsub =
max( isub, jsub )
1024 IF( mxsub.EQ.isub .AND. isym.EQ.0 )
THEN
1025 a( mnsub-mxsub+kuu+1, mxsub ) = dconjg( ctemp )
1027 a( mnsub-mxsub+kuu+1, mxsub ) = ctemp
1029 260 CONTINUE
270 CONTINUE
*
ELSE IF( IPACK.EQ.7 ) THEN
*
IF( ISYM.NE.1 ) THEN
DO 290 J = 1, N
DO 280 I = J - KUU, J
CTEMP = ZLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
$ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
$ IWORK, SPARSE )
MNSUB = MIN( ISUB, JSUB )
MXSUB = MAX( ISUB, JSUB )
IF( I.LT.1 )
$ A( J-I+1+KUU, I+N ) = CZERO
IF( MXSUB.EQ.ISUB .AND. ISYM.EQ.0 ) THEN
A( MNSUB-MXSUB+KUU+1, MXSUB ) = DCONJG( CTEMP )
ELSE
A( MNSUB-MXSUB+KUU+1, MXSUB ) = CTEMP
END IF
IF( I.GE.1 .AND. MNSUB.NE.MXSUB ) THEN
IF( MNSUB.EQ.ISUB .AND. ISYM.EQ.0 ) THEN
A( MXSUB-MNSUB+1+KUU,
$ MNSUB ) = DCONJG( CTEMP )
ELSE
A( MXSUB-MNSUB+1+KUU, MNSUB ) = CTEMP
END IF
END IF
280 CONTINUE
290 CONTINUE
ELSE IF( ISYM.EQ.1 ) THEN
DO 310 J = 1, N
DO 300 I = J - KUU, J + KLL
CTEMP = ZLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
$ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
$ IWORK, SPARSE )
A( ISUB-JSUB+KUU+1, JSUB ) = CTEMP
300 CONTINUE
310 CONTINUE
END IF
*
END IF
*
ELSE
*
* Use ZLATM2
*
IF( IPACK.EQ.0 ) THEN
IF( ISYM.EQ.0 ) THEN
DO 330 J = 1, N
DO 320 I = 1, J
A( I, J ) = ZLATM2( M, N, I, J, KL, KU, IDIST,
$ ISEED, D, IGRADE, DL, DR, IPVTNG,
$ IWORK, SPARSE )
A( J, I ) = DCONJG( A( I, J ) )
320 CONTINUE
330 CONTINUE
ELSE IF( ISYM.EQ.1 ) THEN
DO 350 J = 1, N
DO 340 I = 1, M
A( I, J ) = ZLATM2( M, N, I, J, KL, KU, IDIST,
$ ISEED, D, IGRADE, DL, DR, IPVTNG,
$ IWORK, SPARSE )
340 CONTINUE
350 CONTINUE
ELSE IF( ISYM.EQ.2 ) THEN
DO 370 J = 1, N
DO 360 I = 1, J
A( I, J ) = ZLATM2( M, N, I, J, KL, KU, IDIST,
$ ISEED, D, IGRADE, DL, DR, IPVTNG,
$ IWORK, SPARSE )
A( J, I ) = A( I, J )
360 CONTINUE
370 CONTINUE
END IF
*
ELSE IF( IPACK.EQ.1 ) THEN
*
DO 390 J = 1, N
DO 380 I = 1, J
A( I, J ) = ZLATM2( M, N, I, J, KL, KU, IDIST, ISEED,
$ D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE )
IF( I.NE.J )
$ A( J, I ) = CZERO
380 CONTINUE
390 CONTINUE
*
ELSE IF( IPACK.EQ.2 ) THEN
*
DO 410 J = 1, N
DO 400 I = 1, J
IF( ISYM.EQ.0 ) THEN
A( J, I ) = DCONJG( ZLATM2( M, N, I, J, KL, KU,
$ IDIST, ISEED, D, IGRADE, DL, DR,
$ IPVTNG, IWORK, SPARSE ) )
ELSE
A( J, I ) = ZLATM2( M, N, I, J, KL, KU, IDIST,
$ ISEED, D, IGRADE, DL, DR, IPVTNG,
$ IWORK, SPARSE )
END IF
IF( I.NE.J )
$ A( I, J ) = CZERO
400 CONTINUE
410 CONTINUE
*
ELSE IF( IPACK.EQ.3 ) THEN
*
ISUB = 0
JSUB = 1
DO 430 J = 1, N
DO 420 I = 1, J
ISUB = ISUB + 1
IF( ISUB.GT.LDA ) THEN
ISUB = 1
JSUB = JSUB + 1
END IF
A( ISUB, JSUB ) = ZLATM2( M, N, I, J, KL, KU, IDIST,
$ ISEED, D, IGRADE, DL, DR, IPVTNG,
$ IWORK, SPARSE )
420 CONTINUE
430 CONTINUE
*
ELSE IF( IPACK.EQ.4 ) THEN
*
IF( ISYM.EQ.0 .OR. ISYM.EQ.2 ) THEN
DO 450 J = 1, N
DO 440 I = 1, J
*
* Compute K = location of (I,J) entry in packed array
*
IF( I.EQ.1 ) THEN
K = J
ELSE
K = N*( N+1 ) / 2 - ( N-I+1 )*( N-I+2 ) / 2 +
$ J - I + 1
END IF
*
* Convert K to (ISUB,JSUB) location
*
JSUB = ( K-1 ) / LDA + 1
ISUB = K - LDA*( JSUB-1 )
*
A( ISUB, JSUB ) = ZLATM2( M, N, I, J, KL, KU,
$ IDIST, ISEED, D, IGRADE, DL, DR,
$ IPVTNG, IWORK, SPARSE )
IF( ISYM.EQ.0 )
$ A( ISUB, JSUB ) = DCONJG( A( ISUB, JSUB ) )
440 CONTINUE
450 CONTINUE
ELSE
ISUB = 0
JSUB = 1
DO 470 J = 1, N
DO 460 I = J, M
ISUB = ISUB + 1
IF( ISUB.GT.LDA ) THEN
ISUB = 1
JSUB = JSUB + 1
END IF
A( ISUB, JSUB ) = ZLATM2( M, N, I, J, KL, KU,
$ IDIST, ISEED, D, IGRADE, DL, DR,
$ IPVTNG, IWORK, SPARSE )
460 CONTINUE
470 CONTINUE
END IF
*
ELSE IF( IPACK.EQ.5 ) THEN
*
DO 490 J = 1, N
DO 480 I = J - KUU, J
IF( I.LT.1 ) THEN
A( J-I+1, I+N ) = CZERO
ELSE
IF( ISYM.EQ.0 ) THEN
A( J-I+1, I ) = DCONJG( ZLATM2( M, N, I, J, KL,
$ KU, IDIST, ISEED, D, IGRADE, DL,
$ DR, IPVTNG, IWORK, SPARSE ) )
ELSE
A( J-I+1, I ) = ZLATM2( M, N, I, J, KL, KU,
$ IDIST, ISEED, D, IGRADE, DL, DR,
$ IPVTNG, IWORK, SPARSE )
END IF
END IF
480 CONTINUE
490 CONTINUE
*
ELSE IF( IPACK.EQ.6 ) THEN
*
DO 510 J = 1, N
DO 500 I = J - KUU, J
A( I-J+KUU+1, J ) = ZLATM2( M, N, I, J, KL, KU, IDIST,
$ ISEED, D, IGRADE, DL, DR, IPVTNG,
$ IWORK, SPARSE )
500 CONTINUE
510 CONTINUE
*
ELSE IF( IPACK.EQ.7 ) THEN
*
IF( ISYM.NE.1 ) THEN
DO 530 J = 1, N
DO 520 I = J - KUU, J
A( I-J+KUU+1, J ) = ZLATM2( M, N, I, J, KL, KU,
$ IDIST, ISEED, D, IGRADE, DL,
$ DR, IPVTNG, IWORK, SPARSE )
IF( I.LT.1 )
$ A( J-I+1+KUU, I+N ) = CZERO
IF( I.GE.1 .AND. I.NE.J ) THEN
IF( ISYM.EQ.0 ) THEN
A( J-I+1+KUU, I ) = DCONJG( A( I-J+KUU+1,
$ J ) )
ELSE
A( J-I+1+KUU, I ) = A( I-J+KUU+1, J )
END IF
END IF
520 CONTINUE
530 CONTINUE
ELSE IF( ISYM.EQ.1 ) THEN
DO 550 J = 1, N
DO 540 I = J - KUU, J + KLL
A( I-J+KUU+1, J ) = ZLATM2( M, N, I, J, KL, KU,
$ IDIST, ISEED, D, IGRADE, DL,
$ DR, IPVTNG, IWORK, SPARSE )
540 CONTINUE
550 CONTINUE
END IF
*
END IF
*
END IF
*
* 5) Scaling the norm
*
IF( IPACK.EQ.0 ) THEN
ONORM = ZLANGE( 'M', M, N, A, LDA, TEMPA )
ELSE IF( IPACK.EQ.1 ) THEN
ONORM = ZLANSY( 'M', 'U', N, A, LDA, TEMPA )
ELSE IF( IPACK.EQ.2 ) THEN
ONORM = ZLANSY( 'M', 'L', N, A, LDA, TEMPA )
ELSE IF( IPACK.EQ.3 ) THEN
ONORM = ZLANSP( 'M', 'U', N, A, TEMPA )
ELSE IF( IPACK.EQ.4 ) THEN
ONORM = ZLANSP( 'M', 'L', N, A, TEMPA )
ELSE IF( IPACK.EQ.5 ) THEN
ONORM = ZLANSB( 'M', 'L', N, KLL, A, LDA, TEMPA )
ELSE IF( IPACK.EQ.6 ) THEN
ONORM = ZLANSB( 'M', 'U', N, KUU, A, LDA, TEMPA )
ELSE IF( IPACK.EQ.7 ) THEN
ONORM = ZLANGB( 'M', N, KLL, KUU, A, LDA, TEMPA )
END IF
*
IF( ANORM.GE.ZERO ) THEN
*
IF( ANORM.GT.ZERO .AND. ONORM.EQ.ZERO ) THEN
*
* Desired scaling impossible
*
INFO = 5
RETURN
*
ELSE IF( ( ANORM.GT.ONE .AND. ONORM.LT.ONE ) .OR.
$ ( ANORM.LT.ONE .AND. ONORM.GT.ONE ) ) THEN
*
* Scale carefully to avoid over / underflow
*
IF( IPACK.LE.2 ) THEN
DO 560 J = 1, N
CALL ZDSCAL( M, ONE / ONORM, A( 1, J ), 1 )
CALL ZDSCAL( M, ANORM, A( 1, J ), 1 )
560 CONTINUE
*
ELSE IF( IPACK.EQ.3 .OR. IPACK.EQ.4 ) THEN
*
CALL ZDSCAL( N*( N+1 ) / 2, ONE / ONORM, A, 1 )
CALL ZDSCAL( N*( N+1 ) / 2, ANORM, A, 1 )
*
ELSE IF( IPACK.GE.5 ) THEN
*
DO 570 J = 1, N
CALL ZDSCAL( KLL+KUU+1, ONE / ONORM, A( 1, J ), 1 )
CALL ZDSCAL( KLL+KUU+1, ANORM, A( 1, J ), 1 )
570 CONTINUE
*
END IF
*
ELSE
*
* Scale straightforwardly
*
IF( IPACK.LE.2 ) THEN
DO 580 J = 1, N
CALL ZDSCAL( M, ANORM / ONORM, A( 1, J ), 1 )
580 CONTINUE
*
ELSE IF( IPACK.EQ.3 .OR. IPACK.EQ.4 ) THEN
*
CALL ZDSCAL( N*( N+1 ) / 2, ANORM / ONORM, A, 1 )
*
ELSE IF( IPACK.GE.5 ) THEN
*
DO 590 J = 1, N
CALL ZDSCAL( KLL+KUU+1, ANORM / ONORM, A( 1, J ), 1 )
590 CONTINUE
END IF
*
END IF
*
END IF
*
* End of ZLATMR
*
END
CONTINUE
1032 ELSE IF( ipack.EQ.7 )
THEN
1034 IF( isym.NE.1 )
THEN
1036 DO 280 i = j - kuu, j
1037 ctemp = zlatm3( m, n, i, j, isub, jsub, kl, ku,
1038 $ idist, iseed, d, igrade, dl, dr, ipvtng,
1041 mxsub =
max( isub, jsub )
1043 $ a( j-i+1+kuu, i+n ) = czero
1044 IF( mxsub.EQ.isub .AND. isym.EQ.0 )
THEN
1045 a( mnsub-mxsub+kuu+1, mxsub ) = dconjg( ctemp )
1047 a( mnsub-mxsub+kuu+1, mxsub ) = ctemp
1049 IF( i.GE.1 .AND. mnsub.NE.mxsub )
THEN
1050 IF( mnsub.EQ.isub .AND. isym.EQ.0 )
THEN
1051 a( mxsub-mnsub+1+kuu,
1052 $ mnsub ) = dconjg( ctemp )
1054 a( mxsub-mnsub+1+kuu, mnsub ) = ctemp
1059 ELSE IF( isym.EQ.1 )
THEN
1061 DO 300 i = j - kuu, j + kll
1062 ctemp = zlatm3( m, n, i, j, isub, jsub, kl, ku,
1063 $ idist, iseed, d, igrade, dl, dr, ipvtng,
1065 a( isub-jsub+kuu+1, jsub ) = ctemp
1076 IF( ipack.EQ.0 )
THEN
1077 IF( isym.EQ.0 )
THEN
1080 a( i, j ) = zlatm2( m, n, i, j, kl, ku, idist,
1081 $ iseed, d, igrade, dl, dr, ipvtng,
1083 a( j, i ) = dconjg( a( i, j ) )
1086 ELSE IF( isym.EQ.1 )
THEN
1089 a( i, j ) = zlatm2( m, n, i, j, kl, ku, idist,
1090 $ iseed, d, igrade, dl, dr, ipvtng,
1094 ELSE IF( isym.EQ.2 )
THEN
1097 a( i, j ) = zlatm2( m, n, i, j, kl, ku, idist,
1098 $ iseed, d, igrade, dl, dr, ipvtng,
1100 a( j, i ) = a( i, j )
1105 ELSE IF( ipack.EQ.1 )
THEN
1109 a( i, j ) = zlatm2( m, n, i, j, kl, ku, idist, iseed,
1110 $ d, igrade, dl, dr, ipvtng, iwork, sparse )
1116 ELSE IF( ipack.EQ.2 )
THEN
1120 IF( isym.EQ.0 )
THEN
1121 a( j, i ) = dconjg( zlatm2( m, n, i, j, kl, ku,
1122 $ idist, iseed, d, igrade, dl, dr,
1123 $ ipvtng, iwork, sparse ) )
1125 a( j, i ) = zlatm2( m, n, i, j, kl, ku, idist,
1126 $ iseed, d, igrade, dl, dr, ipvtng,
1134 ELSE IF( ipack.EQ.3 )
THEN
1141 IF( isub.GT.lda )
THEN
1145 a( isub, jsub ) = zlatm2( m, n, i, j, kl, ku, idist,
1146 $ iseed, d, igrade, dl, dr, ipvtng,
1151 ELSE IF( ipack.EQ.4 )
THEN
1153 IF( isym.EQ.0 .OR. isym.EQ.2 )
THEN
1162 k = n*( n+1 ) / 2 - ( n-i+1 )*( n-i+2 ) / 2 +
1168 jsub = ( k-1 ) / lda + 1
1169 isub = k - lda*( jsub-1 )
1171 a( isub, jsub ) = zlatm2( m, n, i, j, kl, ku,
1172 $ idist, iseed, d, igrade, dl, dr,
1173 $ ipvtng, iwork, sparse )
1175 $ a( isub, jsub ) = dconjg( a( isub, jsub ) )
1184 IF( isub.GT.lda )
THEN
1188 a( isub, jsub ) = zlatm2( m, n, i, j, kl, ku,
1189 $ idist, iseed, d, igrade, dl, dr,
1190 $ ipvtng, iwork, sparse )
1195 ELSE IF( ipack.EQ.5 )
THEN
1198 DO 480 i = j - kuu, j
1200 a( j-i+1, i+n ) = czero
1202 IF( isym.EQ.0 )
THEN
1203 a( j-i+1, i ) = dconjg( zlatm2( m, n, i, j, kl,
1204 $ ku, idist, iseed, d, igrade, dl,
1205 $ dr, ipvtng, iwork, sparse ) )
1207 a( j-i+1, i ) = zlatm2( m, n, i, j, kl, ku,
1208 $ idist, iseed, d, igrade, dl, dr,
1209 $ ipvtng, iwork, sparse )
1215 ELSE IF( ipack.EQ.6 )
THEN
1218 DO 500 i = j - kuu, j
1219 a( i-j+kuu+1, j ) = zlatm2( m, n, i, j, kl, ku, idist,
1220 $ iseed, d, igrade, dl, dr, ipvtng,
1225 ELSE IF( ipack.EQ.7 )
THEN
1227 IF( isym.NE.1 )
THEN
1229 DO 520 i = j - kuu, j
1230 a( i-j+kuu+1, j ) = zlatm2( m, n, i, j, kl, ku,
1231 $ idist, iseed, d, igrade, dl,
1232 $ dr, ipvtng, iwork, sparse )
1234 $ a( j-i+1+kuu, i+n ) = czero
1235 IF( i.GE.1 .AND. i.NE.j )
THEN
1236 IF( isym.EQ.0 )
THEN
1237 a( j-i+1+kuu, i ) = dconjg( a( i-j+kuu+1,
1240 a( j-i+1+kuu, i ) = a( i-j+kuu+1, j )
1245 ELSE IF( isym.EQ.1 )
THEN
1247 DO 540 i = j - kuu, j + kll
1248 a( i-j+kuu+1, j ) = zlatm2( m, n, i, j, kl, ku,
1249 $ idist, iseed, d, igrade, dl,
1250 $ dr, ipvtng, iwork, sparse )
1261 IF( ipack.EQ.0 )
THEN
1262 onorm = zlange(
'M', m, n, a, lda, tempa )
1263 ELSE IF( ipack.EQ.1 )
THEN
1264 onorm = zlansy(
'M',
'U', n, a, lda, tempa )
1265 ELSE IF( ipack.EQ.2 )
THEN
1266 onorm = zlansy(
'M',
'L', n, a, lda, tempa )
1267 ELSE IF( ipack.EQ.3 )
THEN
1268 onorm = zlansp(
'M',
'U', n, a, tempa )
1269 ELSE IF( ipack.EQ.4 )
THEN
1270 onorm = zlansp(
'M',
'L', n, a, tempa )
1271 ELSE IF( ipack.EQ.5 )
THEN
1272 onorm = zlansb(
'M',
'L', n, kll, a, lda, tempa )
1273 ELSE IF( ipack.EQ.6 )
THEN
1274 onorm = zlansb(
'M',
'U', n, kuu, a, lda, tempa )
1275 ELSE IF( ipack.EQ.7 )
THEN
1276 onorm = zlangb(
'M', n, kll, kuu, a, lda, tempa )
1279 IF( anorm.GE.zero )
THEN
1281 IF( anorm.GT.zero .AND. onorm.EQ.zero )
THEN
1288 ELSE IF( ( anorm.GT.one .AND. onorm.LT.one ) .OR.
1289 $ ( anorm.LT.one .AND. onorm.GT.one ) )
THEN
1293 IF( ipack.LE.2 )
THEN
1295 CALL zdscal( m, one / onorm, a( 1, j ), 1 )
1296 CALL zdscal( m, anorm, a( 1, j ), 1 )
1299 ELSE IF( ipack.EQ.3 .OR. ipack.EQ.4 )
THEN
1301 CALL zdscal( n*( n+1 ) / 2, one / onorm, a, 1 )
1302 CALL zdscal( n*( n+1 ) / 2, anorm, a, 1 )
1304 ELSE IF( ipack.GE.5 )
THEN
1307 CALL zdscal( kll+kuu+1, one / onorm, a( 1, j ), 1 )
1308 CALL zdscal( kll+kuu+1, anorm, a( 1, j ), 1 )
1317 IF( ipack.LE.2 )
THEN
1319 CALL zdscal( m, anorm / onorm, a( 1, j ), 1 )
1322 ELSE IF( ipack.EQ.3 .OR. ipack.EQ.4 )
THEN
1324 CALL zdscal( n*( n+1 ) / 2, anorm / onorm, a, 1 )
1326 ELSE IF( ipack.GE.5 )
THEN
1329 CALL zdscal( kll+kuu+1, anorm / onorm, a( 1, j ), 1 )