467 SUBROUTINE dlatmr( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX,
468 $ RSIGN, GRADE, DL, MODEL, CONDL, DR, MODER,
469 $ CONDR, PIVTNG, IPIVOT, KL, KU, SPARSE, ANORM,
470 $ PACK, A, LDA, IWORK, INFO )
477 CHARACTER DIST, , PACK, PIVTNG, RSIGN, SYM
478 INTEGER INFO, KL, , LDA, M, MODE, MODEL, , N
479 DOUBLE PRECISION ANORM, COND, CONDL, CONDR, , SPARSE
482 INTEGER IPIVOT( * ), ISEED( 4 ), IWORK( * )
483 DOUBLE PRECISION ( LDA, * ), D( * ), DL( * ), DR( * )
490 PARAMETER ( ZERO = 0.0d0 )
492 parameter( one = 1.0d0 )
495 LOGICAL BADPVT, DZERO, FULBND
496 INTEGER I, IDIST, IGRADE, IISUB, IPACK, IPVTNG, IRSIGN,
497 $ ISUB, ISYM, J, JJSUB, JSUB, K, KLL, KUU, MNMIN,
498 $ mnsub, mxsub, npvts
499 DOUBLE PRECISION ALPHA, ONORM, TEMP
502 DOUBLE PRECISION TEMPA( 1 )
506 DOUBLE PRECISION DLANGB, DLANGE, DLANSB, DLANSP, DLANSY, DLATM2,
508 EXTERNAL lsame, dlangb, dlange, dlansb, dlansp
515 INTRINSIC abs,
max,
min, mod
526 IF( m.EQ.0 .OR. n.EQ.0 )
531 IF( lsame( dist,
'U' ) )
THEN
533 ELSE IF( lsame( dist,
'S' ) )
THEN
535 ELSE IF( lsame( dist,
'N' ) )
THEN
543 IF( lsame( sym,
'S' ) )
THEN
545 ELSE IF( lsame( sym,
'N' ) )
THEN
547 ELSE IF( lsame( sym,
'H' ) )
THEN
555 IF( lsame( rsign,
'F' ) )
THEN
557 ELSE IF( lsame( rsign,
'T' ) )
THEN
565 IF( lsame( pivtng,
'N' ) )
THEN
567 ELSE IF( lsame( pivtng,
' ' ) )
THEN
569 ELSE IF( lsame( pivtng,
'L' ) )
THEN
572 ELSE IF( lsame( pivtng,
'R' ) )
THEN
575 ELSE IF( lsame( pivtng,
'B' ) )
THEN
578 ELSE IF( lsame( pivtng,
'F' ) )
THEN
587 IF( lsame( grade,
'N' ) )
THEN
589 ELSE IF( lsame( grade, 'l
' ) ) THEN
591 ELSE IF( LSAME( GRADE, 'r
' ) ) THEN
593 ELSE IF( LSAME( GRADE, 'b
' ) ) THEN
595 ELSE IF( LSAME( GRADE, 'e
' ) ) THEN
597 ELSE IF( LSAME( GRADE, 'h.OR.
' ) LSAME( GRADE, 's
' ) ) THEN
605 IF( LSAME( PACK, 'n
' ) ) THEN
607 ELSE IF( LSAME( PACK, 'u
' ) ) THEN
609 ELSE IF( LSAME( PACK, 'l
' ) ) THEN
611 ELSE IF( LSAME( PACK, 'c
' ) ) THEN
613 ELSE IF( LSAME( PACK, 'r
' ) ) THEN
615 ELSE IF( LSAME( PACK, 'b
' ) ) THEN
617 ELSE IF( LSAME( PACK, 'q
' ) ) THEN
619 ELSE IF( LSAME( PACK, 'z
' ) ) THEN
634.EQ..AND..EQ.
IF( IGRADE4 MODEL0 ) THEN
636.EQ.
IF( DL( I )ZERO )
644.GT.
IF( IPVTNG0 ) THEN
646.LE..OR..GT.
IF( IPIVOT( J )0 IPIVOT( J )NPVTS )
655.NE..AND..EQ.
ELSE IF( MN ISYM0 ) THEN
657.LT.
ELSE IF( N0 ) THEN
659.EQ.
ELSE IF( IDIST-1 ) THEN
661.EQ.
ELSE IF( ISYM-1 ) THEN
663.LT..OR..GT.
ELSE IF( MODE-6 MODE6 ) THEN
665.NE..AND..NE..AND..NE..AND.
ELSE IF( ( MODE-6 MODE0 MODE6 )
668.NE..AND..NE..AND..NE..AND.
ELSE IF( ( MODE-6 MODE0 MODE6 )
669.EQ.
$ IRSIGN-1 ) THEN
671.EQ..OR..EQ..AND..NE..OR.
ELSE IF( IGRADE-1 ( IGRADE4 MN )
672.GE..AND..LE..AND..EQ.
$ ( ( IGRADE1 IGRADE4 ) ISYM0 ) )
675.EQ..AND.
ELSE IF( IGRADE4 DZERO ) THEN
677.EQ..OR..EQ..OR..EQ..OR.
ELSE IF( ( IGRADE1 IGRADE3 IGRADE4
678.EQ..AND..LT..OR..GT.
$ IGRADE5 ) ( MODEL-6 MODEL6 ) )
681.EQ..OR..EQ..OR..EQ..OR.
ELSE IF( ( IGRADE1 IGRADE3 IGRADE4
682.EQ..AND..NE..AND..NE..AND.
$ IGRADE5 ) ( MODEL-6 MODEL0
683.NE..AND..LT.
$ MODEL6 ) CONDLONE ) THEN
685.EQ..OR..EQ..AND.
ELSE IF( ( IGRADE2 IGRADE3 )
686.LT..OR..GT.
$ ( MODER-6 MODER6 ) ) THEN
688.EQ..OR..EQ..AND.
ELSE IF( ( IGRADE2 IGRADE3 )
689.NE..AND..NE..AND..NE..AND.
$ ( MODER-6 MODER0 MODER6 )
690.LT.
$ CONDRONE ) THEN
692.EQ..OR..EQ..AND..NE..OR.
ELSE IF( IPVTNG-1 ( IPVTNG3 MN )
693.EQ..OR..EQ..AND..EQ.
$ ( ( IPVTNG1 IPVTNG2 ) ISYM0 ) )
696.NE..AND.
ELSE IF( IPVTNG0 BADPVT ) THEN
698.LT.
ELSE IF( KL0 ) THEN
700.LT..OR..EQ..AND..NE.
ELSE IF( KU0 ( ISYM0 KLKU ) ) THEN
702.LT..OR..GT.
ELSE IF( SPARSEZERO SPARSEONE ) THEN
704.EQ..OR..EQ..OR..EQ..OR.
ELSE IF( IPACK-1 ( ( IPACK1 IPACK2
705.EQ..OR..EQ..AND..EQ..OR.
$ IPACK5 IPACK6 ) ISYM1 )
706.EQ..AND..EQ..AND..NE..OR..NE.
$ ( IPACK3 ISYM1 ( KL0 M
707.OR..EQ..AND..EQ..AND..NE.
$ N ) ) ( IPACK4 ISYM1 ( KU
708.OR..NE.
$ 0 MN ) ) ) THEN
710.EQ..OR..EQ..OR..EQ..AND.
ELSE IF( ( ( IPACK0 IPACK1 IPACK2 )
711.LT..OR..EQ..OR..EQ.
$ LDAMAX( 1, M ) ) ( ( IPACK3 IPACK
712.AND..LT..OR..EQ..OR..EQ.
$ 4 ) LDA1 ) ( ( IPACK5 IPACK
713.AND..LT..OR.
$ 6 ) LDAKUU+1 )
714.EQ..AND..LT.
$ ( IPACK7 LDAKLL+KUU+1 ) ) THEN
719 CALL XERBLA( 'dlatmr', -INFO )
726.EQ..AND..EQ.
IF( KUUN-1 KLLM-1 )
732 ISEED( I ) = MOD( ABS( ISEED( I ) ), 4096 )
735 ISEED( 4 ) = 2*( ISEED( 4 ) / 2 ) + 1
741 CALL DLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, MNMIN, INFO )
746.NE..AND..NE..AND..NE.
IF( MODE0 MODE-6 MODE6 ) THEN
752 TEMP = MAX( TEMP, ABS( D( I ) ) )
754.EQ..AND..NE.
IF( TEMPZERO DMAXZERO ) THEN
758.NE.
IF( TEMPZERO ) THEN
764 D( I ) = ALPHA*D( I )
771.EQ..OR..EQ..OR..EQ..OR..EQ.
IF( IGRADE1 IGRADE3 IGRADE4 IGRADE
773 CALL DLATM1( MODEL, CONDL, 0, IDIST, ISEED, DL, M, INFO )
782.EQ..OR..EQ.
IF( IGRADE2 IGRADE3 ) THEN
783 CALL DLATM1( MODER, CONDR, 0, IDIST, ISEED, DR, N, INFO )
792.GT.
IF( IPVTNG0 ) THEN
800 IWORK( I ) = IWORK( K )
804 DO 80 I = NPVTS, 1, -1
807 IWORK( I ) = IWORK( K )
823.EQ.
IF( IPACK0 ) THEN
827 TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
828 $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
830 A( ISUB, JSUB ) = TEMP
831 A( JSUB, ISUB ) = TEMP
834.EQ.
ELSE IF( ISYM1 ) THEN
837 TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
838 $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
840 A( ISUB, JSUB ) = TEMP
845.EQ.
ELSE IF( IPACK1 ) THEN
849 TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
850 $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
852 MNSUB = MIN( ISUB, JSUB )
853 MXSUB = MAX( ISUB, JSUB )
854 A( MNSUB, MXSUB ) = TEMP
856 $ A( MXSUB, MNSUB ) = ZERO
860.EQ.
ELSE IF( IPACK2 ) THEN
864 TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
865 $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
867 MNSUB = MIN( ISUB, JSUB )
868 MXSUB = MAX( ISUB, JSUB )
869 A( MXSUB, MNSUB ) = TEMP
871 $ A( MNSUB, MXSUB ) = ZERO
875.EQ.
ELSE IF( IPACK3 ) THEN
879 TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
880 $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
886 MNSUB = MIN( ISUB, JSUB )
887 MXSUB = MAX( ISUB, JSUB )
888 K = MXSUB*( MXSUB-1 ) / 2 + MNSUB
892 JJSUB = ( K-1 ) / LDA + 1
893 IISUB = K - LDA*( JJSUB-1 )
895 A( IISUB, JJSUB ) = TEMP
899.EQ.
ELSE IF( IPACK4 ) THEN
903 TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
904 $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
909 MNSUB = MIN( ISUB, JSUB )
910 MXSUB = MAX( ISUB, JSUB )
911.EQ.
IF( MNSUB1 ) THEN
914 K = N*( N+1 ) / 2 - ( N-MNSUB+1 )*( N-MNSUB+2 ) /
915 $ 2 + MXSUB - MNSUB + 1
920 JJSUB = ( K-1 ) / LDA + 1
921 IISUB = K - LDA*( JJSUB-1 )
923 A( IISUB, JJSUB ) = TEMP
927.EQ.
ELSE IF( IPACK5 ) THEN
930 DO 210 I = J - KUU, J
932 A( J-I+1, I+N ) = ZERO
934 TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
935 $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
937 MNSUB = MIN( ISUB, JSUB )
938 MXSUB = MAX( ISUB, JSUB )
939 A( MXSUB-MNSUB+1, MNSUB ) = TEMP
944.EQ.
ELSE IF( IPACK6 ) THEN
947 DO 230 I = J - KUU, J
948 TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
949 $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
951 MNSUB = MIN( ISUB, JSUB )
952 MXSUB = MAX( ISUB, JSUB )
953 A( MNSUB-MXSUB+KUU+1, MXSUB ) = TEMP
957.EQ.
ELSE IF( IPACK7 ) THEN
961 DO 250 I = J - KUU, J
962 TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
963 $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
965 MNSUB = MIN( ISUB, JSUB )
966 MXSUB = MAX( ISUB, JSUB )
967 A( MNSUB-MXSUB+KUU+1, MXSUB ) = TEMP
969 $ A( J-I+1+KUU, I+N ) = ZERO
970.GE..AND..NE.
IF( I1 MNSUBMXSUB )
971 $ A( MXSUB-MNSUB+1+KUU, MNSUB ) = TEMP
974.EQ.
ELSE IF( ISYM1 ) THEN
976 DO 270 I = J - KUU, J + KLL
977 TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
978 $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
980 A( ISUB-JSUB+KUU+1, JSUB ) = TEMP
991.EQ.
IF( IPACK0 ) THEN
995 A( I, J ) = DLATM2( M, N, I, J, KL, KU, IDIST,
996 $ ISEED, D, IGRADE, DL, DR, IPVTNG,
998 A( J, I ) = A( I, J )
1001.EQ.
ELSE IF( ISYM1 ) THEN
1004 A( I, J ) = DLATM2( M, N, I, J, KL, KU, IDIST,
1005 $ ISEED, D, IGRADE, DL, DR, IPVTNG,
1011.EQ.
ELSE IF( IPACK1 ) THEN
1015 A( I, J ) = DLATM2( M, N, I, J, KL, KU, IDIST, ISEED,
1016 $ D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE )
1022.EQ.
ELSE IF( IPACK2 ) THEN
1026 A( J, I ) = DLATM2( M, N, I, J, KL, KU, IDIST, ISEED,
1027 $ D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE )
1033.EQ.
ELSE IF( IPACK3 ) THEN
1040.GT.
IF( ISUBLDA ) THEN
1044 A( ISUB, JSUB ) = DLATM2( M, N, I, J, KL, KU, IDIST,
1045 $ ISEED, D, IGRADE, DL, DR, IPVTNG,
1050.EQ.
ELSE IF( IPACK4 ) THEN
1052.EQ.
IF( ISYM0 ) THEN
1061 K = N*( N+1 ) / 2 - ( N-I+1 )*( N-I+2 ) / 2 +
1067 JSUB = ( K-1 ) / LDA + 1
1068 ISUB = K - LDA*( JSUB-1 )
1070 A( ISUB, JSUB ) = DLATM2( M, N, I, J, KL, KU,
1071 $ IDIST, ISEED, D, IGRADE, DL, DR,
1072 $ IPVTNG, IWORK, SPARSE )
1081.GT.
IF( ISUBLDA ) THEN
1085 A( ISUB, JSUB ) = DLATM2( M, N, I, J, KL, KU,
1086 $ IDIST, ISEED, D, IGRADE, DL, DR,
1087 $ IPVTNG, IWORK, SPARSE )
1092.EQ.
ELSE IF( IPACK5 ) THEN
1095 DO 430 I = J - KUU, J
1097 A( J-I+1, I+N ) = ZERO
1099 A( J-I+1, I ) = DLATM2( M, N, I, J, KL, KU, IDIST,
1100 $ ISEED, D, IGRADE, DL, DR, IPVTNG,
1106.EQ.
ELSE IF( IPACK6 ) THEN
1109 DO 450 I = J - KUU, J
1110 A( I-J+KUU+1, J ) = DLATM2( M, N, I, J, KL, KU, IDIST,
1111 $ ISEED, D, IGRADE, DL, DR, IPVTNG,
1116.EQ.
ELSE IF( IPACK7 ) THEN
1118.EQ.
IF( ISYM0 ) THEN
1120 DO 470 I = J - KUU, J
1121 A( I-J+KUU+1, J ) = DLATM2( M, N, I, J, KL, KU,
1122 $ IDIST, ISEED, D, IGRADE, DL,
1123 $ DR, IPVTNG, IWORK, SPARSE )
1125 $ A( J-I+1+KUU, I+N ) = ZERO
1126.GE..AND..NE.
IF( I1 IJ )
1127 $ A( J-I+1+KUU, I ) = A( I-J+KUU+1, J )
1130.EQ.
ELSE IF( ISYM1 ) THEN
1132 DO 490 I = J - KUU, J + KLL
1133 A( I-J+KUU+1, J ) = DLATM2( M, N, I, J, KL, KU,
1134 $ IDIST, ISEED, D, IGRADE, DL,
1135 $ DR, IPVTNG, IWORK, SPARSE )
1146.EQ.
IF( IPACK0 ) THEN
1147 ONORM = DLANGE( 'm
', M, N, A, LDA, TEMPA )
1148.EQ.
ELSE IF( IPACK1 ) THEN
1149 ONORM = DLANSY( 'm
', 'u
', N, A, LDA, TEMPA )
1150.EQ.
ELSE IF( IPACK2 ) THEN
1151 ONORM = DLANSY( 'm
', 'l
', N, A, LDA, TEMPA )
1152.EQ.
ELSE IF( IPACK3 ) THEN
1153 ONORM = DLANSP( 'm
', 'u
', N, A, TEMPA )
1154.EQ.
ELSE IF( IPACK4 ) THEN
1155 ONORM = DLANSP( 'm
', 'l
', N, A, TEMPA )
1156.EQ.
ELSE IF( IPACK5 ) THEN
1157 ONORM = DLANSB( 'm
', 'l
', N, KLL, A, LDA, TEMPA )
1158.EQ.
ELSE IF( IPACK6 ) THEN
1159 ONORM = DLANSB( 'm
', 'u
', N, KUU, A, LDA, TEMPA )
1160.EQ.
ELSE IF( IPACK7 ) THEN
1161 ONORM = DLANGB( 'm
', N, KLL, KUU, A, LDA, TEMPA )
1164.GE.
IF( ANORMZERO ) THEN
1166.GT..AND..EQ.
IF( ANORMZERO ONORMZERO ) THEN
1173.GT..AND..LT..OR.
ELSE IF( ( ANORMONE ONORMONE )
1174.LT..AND..GT.
$ ( ANORMONE ONORMONE ) ) THEN
1178.LE.
IF( IPACK2 ) THEN
1180 CALL DSCAL( M, ONE / ONORM, A( 1, J ), 1 )
1181 CALL DSCAL( M, ANORM, A( 1, J ), 1 )
1184.EQ..OR..EQ.
ELSE IF( IPACK3 IPACK4 ) THEN
1186 CALL DSCAL( N*( N+1 ) / 2, ONE / ONORM, A, 1 )
1187 CALL DSCAL( N*( N+1 ) / 2, ANORM, A, 1 )
1189.GE.
ELSE IF( IPACK5 ) THEN
1192 CALL DSCAL( KLL+KUU+1, ONE / ONORM, A( 1, J ), 1 )
1193 CALL DSCAL( KLL+KUU+1, ANORM, A( 1, J ), 1 )
1202.LE.
IF( IPACK2 ) THEN
1204 CALL DSCAL( M, ANORM / ONORM, A( 1, J ), 1 )
1207.EQ..OR..EQ.
ELSE IF( IPACK3 IPACK4 ) THEN
1209 CALL DSCAL( N*( N+1 ) / 2, ANORM / ONORM, A, 1 )
1211.GE.
ELSE IF( IPACK5 ) THEN
1214 CALL DSCAL( KLL+KUU+1, ANORM / ONORM, A( 1, J ), 1 )
subroutine dlatmr(m, n, dist, iseed, sym, d, mode, cond, dmax, rsign, grade, dl, model, condl, dr, moder, condr, pivtng, ipivot, kl, ku, sparse, anorm, pack, a, lda, iwork, info)
DLATMR