LAPACK  3.9.1
LAPACK: Linear Algebra PACKage

◆ zlascl()

subroutine zlascl ( character  TYPE,
integer  KL,
integer  KU,
double precision  CFROM,
double precision  CTO,
integer  M,
integer  N,
complex*16, dimension( lda, * )  A,
integer  LDA,
integer  INFO 
)

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

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

Purpose:
 ZLASCL multiplies the M by N complex 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 ZGBTRF 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 DOUBLE PRECISION
[in]CTO
          CTO is DOUBLE PRECISION

          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 COMPLEX*16 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.

Definition at line 142 of file zlascl.f.

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