LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine slascl ( character  TYPE,
integer  KL,
integer  KU,
real  CFROM,
real  CTO,
integer  M,
integer  N,
real, dimension( lda, * )  A,
integer  LDA,
integer  INFO 
)

SLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.

Download SLASCL + dependencies [TGZ] [ZIP] [TXT]

Purpose: 
 SLASCL multiplies the M by N real matrix A by the real scalar
 CTO/CFROM.  This is done without over/underflow as long as the final
 result CTO*A(I,J)/CFROM does not over/underflow. TYPE specifies that
 A may be full, upper triangular, lower triangular, upper Hessenberg,
 or banded.
Parameters
[in]TYPE
          TYPE is CHARACTER*1
          TYPE indices the storage type of the input matrix.
          = 'G':  A is a full matrix.
          = 'L':  A is a lower triangular matrix.
          = 'U':  A is an upper triangular matrix.
          = 'H':  A is an upper Hessenberg matrix.
          = 'B':  A is a symmetric band matrix with lower bandwidth KL
                  and upper bandwidth KU and with the only the lower
                  half stored.
          = 'Q':  A is a symmetric band matrix with lower bandwidth KL
                  and upper bandwidth KU and with the only the upper
                  half stored.
          = 'Z':  A is a band matrix with lower bandwidth KL and upper
                  bandwidth KU. See SGBTRF for storage details.
[in]KL
          KL is INTEGER
          The lower bandwidth of A.  Referenced only if TYPE = 'B',
          'Q' or 'Z'.
[in]KU
          KU is INTEGER
          The upper bandwidth of A.  Referenced only if TYPE = 'B',
          'Q' or 'Z'.
[in]CFROM
          CFROM is REAL
[in]CTO
          CTO is REAL

          The matrix A is multiplied by CTO/CFROM. A(I,J) is computed
          without over/underflow if the final result CTO*A(I,J)/CFROM
          can be represented without over/underflow.  CFROM must be
          nonzero.
[in]M
          M is INTEGER
          The number of rows of the matrix A.  M >= 0.
[in]N
          N is INTEGER
          The number of columns of the matrix A.  N >= 0.
[in,out]A
          A is REAL array, dimension (LDA,N)
          The matrix to be multiplied by CTO/CFROM.  See TYPE for the
          storage type.
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A.
          If TYPE = 'G', 'L', 'U', 'H', LDA >= max(1,M);
             TYPE = 'B', LDA >= KL+1;
             TYPE = 'Q', LDA >= KU+1;
             TYPE = 'Z', LDA >= 2*KL+KU+1.
[out]INFO
          INFO is INTEGER
          0  - successful exit
          <0 - if INFO = -i, the i-th argument had an illegal value.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
June 2016

Definition at line 145 of file slascl.f.

145 *
146 * -- LAPACK auxiliary routine (version 3.6.1) --
147 * -- LAPACK is a software package provided by Univ. of Tennessee, --
148 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
149 * June 2016
150 *
151 * .. Scalar Arguments ..
152  CHARACTER type
153  INTEGER info, kl, ku, lda, m, n
154  REAL cfrom, cto
155 * ..
156 * .. Array Arguments ..
157  REAL a( lda, * )
158 * ..
159 *
160 * =====================================================================
161 *
162 * .. Parameters ..
163  REAL zero, one
164  parameter ( zero = 0.0e0, one = 1.0e0 )
165 * ..
166 * .. Local Scalars ..
167  LOGICAL done
168  INTEGER i, itype, j, k1, k2, k3, k4
169  REAL bignum, cfrom1, cfromc, cto1, ctoc, mul, smlnum
170 * ..
171 * .. External Functions ..
172  LOGICAL lsame, sisnan
173  REAL slamch
174  EXTERNAL lsame, slamch, sisnan
175 * ..
176 * .. Intrinsic Functions ..
177  INTRINSIC abs, max, min
178 * ..
179 * .. External Subroutines ..
180  EXTERNAL xerbla
181 * ..
182 * .. Executable Statements ..
183 *
184 * Test the input arguments
185 *
186  info = 0
187 *
188  IF( lsame( TYPE, 'G' ) ) then
189  itype = 0
190  ELSE IF( lsame( TYPE, 'L' ) ) then
191  itype = 1
192  ELSE IF( lsame( TYPE, 'U' ) ) then
193  itype = 2
194  ELSE IF( lsame( TYPE, 'H' ) ) then
195  itype = 3
196  ELSE IF( lsame( TYPE, 'B' ) ) then
197  itype = 4
198  ELSE IF( lsame( TYPE, 'Q' ) ) then
199  itype = 5
200  ELSE IF( lsame( TYPE, 'Z' ) ) then
201  itype = 6
202  ELSE
203  itype = -1
204  END IF
205 *
206  IF( itype.EQ.-1 ) THEN
207  info = -1
208  ELSE IF( cfrom.EQ.zero .OR. sisnan(cfrom) ) THEN
209  info = -4
210  ELSE IF( sisnan(cto) ) THEN
211  info = -5
212  ELSE IF( m.LT.0 ) THEN
213  info = -6
214  ELSE IF( n.LT.0 .OR. ( itype.EQ.4 .AND. n.NE.m ) .OR.
215  $ ( itype.EQ.5 .AND. n.NE.m ) ) THEN
216  info = -7
217  ELSE IF( itype.LE.3 .AND. lda.LT.max( 1, m ) ) THEN
218  info = -9
219  ELSE IF( itype.GE.4 ) THEN
220  IF( kl.LT.0 .OR. kl.GT.max( m-1, 0 ) ) THEN
221  info = -2
222  ELSE IF( ku.LT.0 .OR. ku.GT.max( n-1, 0 ) .OR.
223  $ ( ( itype.EQ.4 .OR. itype.EQ.5 ) .AND. kl.NE.ku ) )
224  $ THEN
225  info = -3
226  ELSE IF( ( itype.EQ.4 .AND. lda.LT.kl+1 ) .OR.
227  $ ( itype.EQ.5 .AND. lda.LT.ku+1 ) .OR.
228  $ ( itype.EQ.6 .AND. lda.LT.2*kl+ku+1 ) ) THEN
229  info = -9
230  END IF
231  END IF
232 *
233  IF( info.NE.0 ) THEN
234  CALL xerbla( 'SLASCL', -info )
235  RETURN
236  END IF
237 *
238 * Quick return if possible
239 *
240  IF( n.EQ.0 .OR. m.EQ.0 )
241  $ RETURN
242 *
243 * Get machine parameters
244 *
245  smlnum = slamch( 'S' )
246  bignum = one / smlnum
247 *
248  cfromc = cfrom
249  ctoc = cto
250 *
251  10 CONTINUE
252  cfrom1 = cfromc*smlnum
253  IF( cfrom1.EQ.cfromc ) THEN
254 ! CFROMC is an inf. Multiply by a correctly signed zero for
255 ! finite CTOC, or a NaN if CTOC is infinite.
256  mul = ctoc / cfromc
257  done = .true.
258  cto1 = ctoc
259  ELSE
260  cto1 = ctoc / bignum
261  IF( cto1.EQ.ctoc ) THEN
262 ! CTOC is either 0 or an inf. In both cases, CTOC itself
263 ! serves as the correct multiplication factor.
264  mul = ctoc
265  done = .true.
266  cfromc = one
267  ELSE IF( abs( cfrom1 ).GT.abs( ctoc ) .AND. ctoc.NE.zero ) THEN
268  mul = smlnum
269  done = .false.
270  cfromc = cfrom1
271  ELSE IF( abs( cto1 ).GT.abs( cfromc ) ) THEN
272  mul = bignum
273  done = .false.
274  ctoc = cto1
275  ELSE
276  mul = ctoc / cfromc
277  done = .true.
278  END IF
279  END IF
280 *
281  IF( itype.EQ.0 ) THEN
282 *
283 * Full matrix
284 *
285  DO 30 j = 1, n
286  DO 20 i = 1, m
287  a( i, j ) = a( i, j )*mul
288  20 CONTINUE
289  30 CONTINUE
290 *
291  ELSE IF( itype.EQ.1 ) THEN
292 *
293 * Lower triangular matrix
294 *
295  DO 50 j = 1, n
296  DO 40 i = j, m
297  a( i, j ) = a( i, j )*mul
298  40 CONTINUE
299  50 CONTINUE
300 *
301  ELSE IF( itype.EQ.2 ) THEN
302 *
303 * Upper triangular matrix
304 *
305  DO 70 j = 1, n
306  DO 60 i = 1, min( j, m )
307  a( i, j ) = a( i, j )*mul
308  60 CONTINUE
309  70 CONTINUE
310 *
311  ELSE IF( itype.EQ.3 ) THEN
312 *
313 * Upper Hessenberg matrix
314 *
315  DO 90 j = 1, n
316  DO 80 i = 1, min( j+1, m )
317  a( i, j ) = a( i, j )*mul
318  80 CONTINUE
319  90 CONTINUE
320 *
321  ELSE IF( itype.EQ.4 ) THEN
322 *
323 * Lower half of a symmetric band matrix
324 *
325  k3 = kl + 1
326  k4 = n + 1
327  DO 110 j = 1, n
328  DO 100 i = 1, min( k3, k4-j )
329  a( i, j ) = a( i, j )*mul
330  100 CONTINUE
331  110 CONTINUE
332 *
333  ELSE IF( itype.EQ.5 ) THEN
334 *
335 * Upper half of a symmetric band matrix
336 *
337  k1 = ku + 2
338  k3 = ku + 1
339  DO 130 j = 1, n
340  DO 120 i = max( k1-j, 1 ), k3
341  a( i, j ) = a( i, j )*mul
342  120 CONTINUE
343  130 CONTINUE
344 *
345  ELSE IF( itype.EQ.6 ) THEN
346 *
347 * Band matrix
348 *
349  k1 = kl + ku + 2
350  k2 = kl + 1
351  k3 = 2*kl + ku + 1
352  k4 = kl + ku + 1 + m
353  DO 150 j = 1, n
354  DO 140 i = max( k1-j, k2 ), min( k3, k4-j )
355  a( i, j ) = a( i, j )*mul
356  140 CONTINUE
357  150 CONTINUE
358 *
359  END IF
360 *
361  IF( .NOT.done )
362  $ GO TO 10
363 *
364  RETURN
365 *
366 * End of SLASCL
367 *
sisnan
logical function sisnan(SIN)
SISNAN tests input for NaN.
Definition: sisnan.f:61
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
slamch
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
lsame
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55

Here is the call graph for this function: