140 SUBROUTINE dlascl( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO )
149 INTEGER info, kl, ku, lda, m, n
150 DOUBLE PRECISION cfrom, cto
153 DOUBLE PRECISION a( lda, * )
159 DOUBLE PRECISION zero, one
160 parameter( zero = 0.0d0, one = 1.0d0 )
164 INTEGER i, itype, j, k1, k2, k3, k4
165 DOUBLE PRECISION bignum, cfrom1, cfromc, cto1, ctoc, mul, smlnum
168 LOGICAL lsame, disnan
169 DOUBLE PRECISION dlamch
170 EXTERNAL lsame, dlamch, disnan
173 INTRINSIC abs, max, min
184 IF( lsame(
TYPE,
'G' ) ) then
186 ELSE IF( lsame(
TYPE,
'L' ) ) then
188 ELSE IF( lsame(
TYPE,
'U' ) ) then
190 ELSE IF( lsame(
TYPE,
'H' ) ) then
192 ELSE IF( lsame(
TYPE,
'B' ) ) then
194 ELSE IF( lsame(
TYPE,
'Q' ) ) then
196 ELSE IF( lsame(
TYPE,
'Z' ) ) then
202 IF( itype.EQ.-1 )
THEN 204 ELSE IF( cfrom.EQ.zero .OR. disnan(cfrom) )
THEN 206 ELSE IF( disnan(cto) )
THEN 208 ELSE IF( m.LT.0 )
THEN 210 ELSE IF( n.LT.0 .OR. ( itype.EQ.4 .AND. n.NE.m ) .OR.
211 $ ( itype.EQ.5 .AND. n.NE.m ) )
THEN 213 ELSE IF( itype.LE.3 .AND. lda.LT.max( 1, m ) )
THEN 215 ELSE IF( itype.GE.4 )
THEN 216 IF( kl.LT.0 .OR. kl.GT.max( m-1, 0 ) )
THEN 218 ELSE IF( ku.LT.0 .OR. ku.GT.max( n-1, 0 ) .OR.
219 $ ( ( itype.EQ.4 .OR. itype.EQ.5 ) .AND. kl.NE.ku ) )
222 ELSE IF( ( itype.EQ.4 .AND. lda.LT.kl+1 ) .OR.
223 $ ( itype.EQ.5 .AND. lda.LT.ku+1 ) .OR.
224 $ ( itype.EQ.6 .AND. lda.LT.2*kl+ku+1 ) )
THEN 230 CALL xerbla(
'DLASCL', -info )
236 IF( n.EQ.0 .OR. m.EQ.0 )
241 smlnum = dlamch(
'S' )
242 bignum = one / smlnum
248 cfrom1 = cfromc*smlnum
249 IF( cfrom1.EQ.cfromc )
THEN 257 IF( cto1.EQ.ctoc )
THEN 263 ELSE IF( abs( cfrom1 ).GT.abs( ctoc ) .AND. ctoc.NE.zero )
THEN 267 ELSE IF( abs( cto1 ).GT.abs( cfromc ) )
THEN 277 IF( itype.EQ.0 )
THEN 283 a( i, j ) = a( i, j )*mul
287 ELSE IF( itype.EQ.1 )
THEN 293 a( i, j ) = a( i, j )*mul
297 ELSE IF( itype.EQ.2 )
THEN 302 DO 60 i = 1, min( j, m )
303 a( i, j ) = a( i, j )*mul
307 ELSE IF( itype.EQ.3 )
THEN 312 DO 80 i = 1, min( j+1, m )
313 a( i, j ) = a( i, j )*mul
317 ELSE IF( itype.EQ.4 )
THEN 324 DO 100 i = 1, min( k3, k4-j )
325 a( i, j ) = a( i, j )*mul
329 ELSE IF( itype.EQ.5 )
THEN 336 DO 120 i = max( k1-j, 1 ), k3
337 a( i, j ) = a( i, j )*mul
341 ELSE IF( itype.EQ.6 )
THEN 350 DO 140 i = max( k1-j, k2 ), min( k3, k4-j )
351 a( i, j ) = a( i, j )*mul