142 SUBROUTINE zlascl( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO )
150 INTEGER INFO, KL, KU, LDA, M, N
151 DOUBLE PRECISION CFROM, CTO
154 COMPLEX*16 A( LDA, * )
160 DOUBLE PRECISION ZERO, ONE
161 parameter( zero = 0.0d0, one = 1.0d0 )
165 INTEGER I, ITYPE, J, K1, K2, K3, K4
166 DOUBLE PRECISION BIGNUM, CFROM1, CFROMC, CTO1, CTOC, MUL, SMLNUM
169 LOGICAL LSAME, DISNAN
170 DOUBLE PRECISION DLAMCH
171 EXTERNAL lsame, dlamch, disnan
174 INTRINSIC abs, max, min
185 IF( lsame(
TYPE,
'G' ) ) then
187 ELSE IF( lsame(
TYPE,
'L' ) ) then
189 ELSE IF( lsame(
TYPE,
'U' ) ) then
191 ELSE IF( lsame(
TYPE,
'H' ) ) then
193 ELSE IF( lsame(
TYPE,
'B' ) ) then
195 ELSE IF( lsame(
TYPE,
'Q' ) ) then
197 ELSE IF( lsame(
TYPE,
'Z' ) ) then
203 IF( itype.EQ.-1 )
THEN
205 ELSE IF( cfrom.EQ.zero .OR. disnan(cfrom) )
THEN
207 ELSE IF( disnan(cto) )
THEN
209 ELSE IF( m.LT.0 )
THEN
211 ELSE IF( n.LT.0 .OR. ( itype.EQ.4 .AND. n.NE.m ) .OR.
212 $ ( itype.EQ.5 .AND. n.NE.m ) )
THEN
214 ELSE IF( itype.LE.3 .AND. lda.LT.max( 1, m ) )
THEN
216 ELSE IF( itype.GE.4 )
THEN
217 IF( kl.LT.0 .OR. kl.GT.max( m-1, 0 ) )
THEN
219 ELSE IF( ku.LT.0 .OR. ku.GT.max( n-1, 0 ) .OR.
220 $ ( ( itype.EQ.4 .OR. itype.EQ.5 ) .AND. kl.NE.ku ) )
223 ELSE IF( ( itype.EQ.4 .AND. lda.LT.kl+1 ) .OR.
224 $ ( itype.EQ.5 .AND. lda.LT.ku+1 ) .OR.
225 $ ( itype.EQ.6 .AND. lda.LT.2*kl+ku+1 ) )
THEN
231 CALL xerbla(
'ZLASCL', -info )
237 IF( n.EQ.0 .OR. m.EQ.0 )
242 smlnum = dlamch(
'S' )
243 bignum = one / smlnum
249 cfrom1 = cfromc*smlnum
250 IF( cfrom1.EQ.cfromc )
THEN
258 IF( cto1.EQ.ctoc )
THEN
264 ELSE IF( abs( cfrom1 ).GT.abs( ctoc ) .AND. ctoc.NE.zero )
THEN
268 ELSE IF( abs( cto1 ).GT.abs( cfromc ) )
THEN
278 IF( itype.EQ.0 )
THEN
284 a( i, j ) = a( i, j )*mul
288 ELSE IF( itype.EQ.1 )
THEN
294 a( i, j ) = a( i, j )*mul
298 ELSE IF( itype.EQ.2 )
THEN
303 DO 60 i = 1, min( j, m )
304 a( i, j ) = a( i, j )*mul
308 ELSE IF( itype.EQ.3 )
THEN
313 DO 80 i = 1, min( j+1, m )
314 a( i, j ) = a( i, j )*mul
318 ELSE IF( itype.EQ.4 )
THEN
325 DO 100 i = 1, min( k3, k4-j )
326 a( i, j ) = a( i, j )*mul
330 ELSE IF( itype.EQ.5 )
THEN
337 DO 120 i = max( k1-j, 1 ), k3
338 a( i, j ) = a( i, j )*mul
342 ELSE IF( itype.EQ.6 )
THEN
351 DO 140 i = max( k1-j, k2 ), min( k3, k4-j )
352 a( i, j ) = a( i, j )*mul
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
ZLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.