140 SUBROUTINE clascl( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO )
149 INTEGER info, kl, ku, lda, m, n
160 parameter( zero = 0.0e0, one = 1.0e0 )
164 INTEGER i, itype,
j, k1, k2, k3, k4
165 REAL bignum, cfrom1, cfromc, cto1, ctoc, mul, smlnum
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.
sisnan(cfrom) )
THEN
206 ELSE IF(
sisnan(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(
'CLASCL', -info )
236 IF( n.EQ.0 .OR. m.EQ.0 )
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
LOGICAL function lsame(CA, CB)
LSAME
REAL function slamch(CMACH)
SLAMCH
subroutine xerbla(SRNAME, INFO)
XERBLA
LOGICAL function sisnan(SIN)
SISNAN tests input for NaN.
subroutine clascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
CLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j