1 SUBROUTINE dlascl( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO )
10 INTEGER INFO, KL, KU, LDA, M, N
11 DOUBLE PRECISION CFROM, CTO
14 DOUBLE PRECISION A( LDA, * )
79 DOUBLE PRECISION ZERO, ONE
80 parameter( zero = 0.0d0, one = 1.0d0 )
84 INTEGER I, ITYPE, J, K1, K2, K3, K4
85 DOUBLE PRECISION BIGNUM, CFROM1, CFROMC, CTO1, CTOC, MUL, SMLNUM
89 DOUBLE PRECISION DLAMCH
90 EXTERNAL lsame, dlamch
93 INTRINSIC abs, max, min
104 IF( lsame(
TYPE,
'G' ) ) then
106 ELSE IF( lsame(
TYPE,
'L' ) ) then
108 ELSE IF( lsame(
TYPE,
'U' ) ) then
110 ELSE IF( lsame(
TYPE,
'H' ) ) then
112 ELSE IF( lsame(
TYPE,
'B' ) ) then
114 ELSE IF( lsame(
TYPE,
'Q' ) ) then
116 ELSE IF( lsame(
TYPE,
'Z' ) ) then
122 IF( itype.EQ.-1 )
THEN
124 ELSE IF( cfrom.EQ.zero )
THEN
126 ELSE IF( m.LT.0 )
THEN
128 ELSE IF( n.LT.0 .OR. ( itype.EQ.4 .AND. n.NE.m ) .OR.
129 $ ( itype.EQ.5 .AND. n.NE.m ) )
THEN
131 ELSE IF( itype.LE.3 .AND. lda.LT.max( 1, m ) )
THEN
133 ELSE IF( itype.GE.4 )
THEN
134 IF( kl.LT.0 .OR. kl.GT.max( m-1, 0 ) )
THEN
136 ELSE IF( ku.LT.0 .OR. ku.GT.max( n-1, 0 ) .OR.
137 $ ( ( itype.EQ.4 .OR. itype.EQ.5 ) .AND. kl.NE.ku ) )
140 ELSE IF( ( itype.EQ.4 .AND. lda.LT.kl+1 ) .OR.
141 $ ( itype.EQ.5 .AND. lda.LT.ku+1 ) .OR.
142 $ ( itype.EQ.6 .AND. lda.LT.2*kl+ku+1 ) )
THEN
148 CALL xerbla(
'DLASCL', -info )
154 IF( n.EQ.0 .OR. m.EQ.0 )
159 smlnum = dlamch(
'S' )
160 bignum = one / smlnum
166 cfrom1 = cfromc*smlnum
168 IF( abs( cfrom1 ).GT.abs( ctoc ) .AND. ctoc.NE.zero )
THEN
172 ELSE IF( abs( cto1 ).GT.abs( cfromc ) )
THEN
181 IF( itype.EQ.0 )
THEN
187 a( i, j ) = a( i, j )*mul
191 ELSE IF( itype.EQ.1 )
THEN
197 a( i, j ) = a( i, j )*mul
201 ELSE IF( itype.EQ.2 )
THEN
206 DO 60 i = 1, min( j, m )
207 a( i, j ) = a( i, j )*mul
211 ELSE IF( itype.EQ.3 )
THEN
216 DO 80 i = 1, min( j+1, m )
217 a( i, j ) = a( i, j )*mul
221 ELSE IF( itype.EQ.4 )
THEN
228 DO 100 i = 1, min( k3, k4-j )
229 a( i, j ) = a( i, j )*mul
233 ELSE IF( itype.EQ.5 )
THEN
240 DO 120 i = max( k1-j, 1 ), k3
241 a( i, j ) = a( i, j )*mul
245 ELSE IF( itype.EQ.6 )
THEN
254 DO 140 i = max( k1-j, k2 ), min( k3, k4-j )
255 a( i, j ) = a( i, j )*mul
subroutine dlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
subroutine xerbla(SRNAME, INFO)