1*> \brief \b CLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom. 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8*> \htmlonly 9*> Download CLASCL + dependencies 10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clascl.f"> 11*> [TGZ]</a> 12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clascl.f"> 13*> [ZIP]</a> 14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clascl.f"> 15*> [TXT]</a> 16*> \endhtmlonly 17* 18* Definition: 19* =========== 20* 21* SUBROUTINE CLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO ) 22* 23* .. Scalar Arguments .. 24* CHARACTER TYPE 25* INTEGER INFO, KL, KU, LDA, M, N 26* REAL CFROM, CTO 27* .. 28* .. Array Arguments .. 29* COMPLEX A( LDA, * ) 30* .. 31* 32* 33*> \par Purpose: 34* ============= 35*> 36*> \verbatim 37*> 38*> CLASCL multiplies the M by N complex matrix A by the real scalar 39*> CTO/CFROM. This is done without over/underflow as long as the final 40*> result CTO*A(I,J)/CFROM does not over/underflow. TYPE specifies that 41*> A may be full, upper triangular, lower triangular, upper Hessenberg, 42*> or banded. 43*> \endverbatim 44* 45* Arguments: 46* ========== 47* 48*> \param[in] TYPE 49*> \verbatim 50*> TYPE is CHARACTER*1 51*> TYPE indices the storage type of the input matrix. 52*> = 'G': A is a full matrix. 53*> = 'L': A is a lower triangular matrix. 54*> = 'U': A is an upper triangular matrix. 55*> = 'H': A is an upper Hessenberg matrix. 56*> = 'B': A is a symmetric band matrix with lower bandwidth KL 57*> and upper bandwidth KU and with the only the lower 58*> half stored. 59*> = 'Q': A is a symmetric band matrix with lower bandwidth KL 60*> and upper bandwidth KU and with the only the upper 61*> half stored. 62*> = 'Z': A is a band matrix with lower bandwidth KL and upper 63*> bandwidth KU. See CGBTRF for storage details. 64*> \endverbatim 65*> 66*> \param[in] KL 67*> \verbatim 68*> KL is INTEGER 69*> The lower bandwidth of A. Referenced only if TYPE = 'B', 70*> 'Q' or 'Z'. 71*> \endverbatim 72*> 73*> \param[in] KU 74*> \verbatim 75*> KU is INTEGER 76*> The upper bandwidth of A. Referenced only if TYPE = 'B', 77*> 'Q' or 'Z'. 78*> \endverbatim 79*> 80*> \param[in] CFROM 81*> \verbatim 82*> CFROM is REAL 83*> \endverbatim 84*> 85*> \param[in] CTO 86*> \verbatim 87*> CTO is REAL 88*> 89*> The matrix A is multiplied by CTO/CFROM. A(I,J) is computed 90*> without over/underflow if the final result CTO*A(I,J)/CFROM 91*> can be represented without over/underflow. CFROM must be 92*> nonzero. 93*> \endverbatim 94*> 95*> \param[in] M 96*> \verbatim 97*> M is INTEGER 98*> The number of rows of the matrix A. M >= 0. 99*> \endverbatim 100*> 101*> \param[in] N 102*> \verbatim 103*> N is INTEGER 104*> The number of columns of the matrix A. N >= 0. 105*> \endverbatim 106*> 107*> \param[in,out] A 108*> \verbatim 109*> A is COMPLEX array, dimension (LDA,N) 110*> The matrix to be multiplied by CTO/CFROM. See TYPE for the 111*> storage type. 112*> \endverbatim 113*> 114*> \param[in] LDA 115*> \verbatim 116*> LDA is INTEGER 117*> The leading dimension of the array A. 118*> If TYPE = 'G', 'L', 'U', 'H', LDA >= max(1,M); 119*> TYPE = 'B', LDA >= KL+1; 120*> TYPE = 'Q', LDA >= KU+1; 121*> TYPE = 'Z', LDA >= 2*KL+KU+1. 122*> \endverbatim 123*> 124*> \param[out] INFO 125*> \verbatim 126*> INFO is INTEGER 127*> 0 - successful exit 128*> <0 - if INFO = -i, the i-th argument had an illegal value. 129*> \endverbatim 130* 131* Authors: 132* ======== 133* 134*> \author Univ. of Tennessee 135*> \author Univ. of California Berkeley 136*> \author Univ. of Colorado Denver 137*> \author NAG Ltd. 138* 139*> \date June 2016 140* 141*> \ingroup complexOTHERauxiliary 142* 143* ===================================================================== 144 SUBROUTINE CLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO ) 145* 146* -- LAPACK auxiliary routine (version 3.7.0) -- 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 COMPLEX 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( 'CLASCL', -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 CLASCL 367* 368 END 369