text: *> \brief \b SLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
  *
  *  =========== DOCUMENTATION ===========
  *
  * Online html documentation available at
  *            http://www.netlib.org/lapack/explore-html/
  *
  *> \htmlonly
  *> Download SLASCL + dependencies
  *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slascl.f">
  *> [TGZ]</a>
  *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slascl.f">
  *> [ZIP]</a>
  *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slascl.f">
  *> [TXT]</a>
  *> \endhtmlonly
  *
  *  Definition:
  *  ===========
  *
  *       SUBROUTINE SLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO )
  *
  *       .. Scalar Arguments ..
  *       CHARACTER          TYPE
  *       INTEGER            INFO, KL, KU, LDA, M, N
  *       REAL               CFROM, CTO
  *       ..
  *       .. Array Arguments ..
  *       REAL               A( LDA, * )
  *       ..
  *
  *
  *> \par Purpose:
  *  =============
  *>
  *> \verbatim
  *>
  *> 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.
  *> \endverbatim
  *
  *  Arguments:
  *  ==========
  *
  *> \param[in] TYPE
  *> \verbatim
  *>          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.
  *> \endverbatim
  *>
  *> \param[in] KL
  *> \verbatim
  *>          KL is INTEGER
  *>          The lower bandwidth of A.  Referenced only if TYPE = 'B',
  *>          'Q' or 'Z'.
  *> \endverbatim
  *>
  *> \param[in] KU
  *> \verbatim
  *>          KU is INTEGER
  *>          The upper bandwidth of A.  Referenced only if TYPE = 'B',
  *>          'Q' or 'Z'.
  *> \endverbatim
  *>
  *> \param[in] CFROM
  *> \verbatim
  *>          CFROM is REAL
  *> \endverbatim
  *>
  *> \param[in] CTO
  *> \verbatim
  *>          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.
  *> \endverbatim
  *>
  *> \param[in] M
  *> \verbatim
  *>          M is INTEGER
  *>          The number of rows of the matrix A.  M >= 0.
  *> \endverbatim
  *>
  *> \param[in] N
  *> \verbatim
  *>          N is INTEGER
  *>          The number of columns of the matrix A.  N >= 0.
  *> \endverbatim
  *>
  *> \param[in,out] A
  *> \verbatim
  *>          A is REAL array, dimension (LDA,N)
  *>          The matrix to be multiplied by CTO/CFROM.  See TYPE for the
  *>          storage type.
  *> \endverbatim
  *>
  *> \param[in] LDA
  *> \verbatim
  *>          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.
  *> \endverbatim
  *>
  *> \param[out] INFO
  *> \verbatim
  *>          INFO is INTEGER
  *>          0  - successful exit
  *>          <0 - if INFO = -i, the i-th argument had an illegal value.
  *> \endverbatim
  *
  *  Authors:
  *  ========
  *
  *> \author Univ. of Tennessee
  *> \author Univ. of California Berkeley
  *> \author Univ. of Colorado Denver
  *> \author NAG Ltd.
  *
  *> \date June 2016
  *
  *> \ingroup OTHERauxiliary
  *
  *  =====================================================================
        SUBROUTINE SLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO )
  *
  *  -- LAPACK auxiliary routine (version 3.7.0) --
  *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  *     June 2016
  *
  *     .. Scalar Arguments ..
        CHARACTER          TYPE
        INTEGER            INFO, KL, KU, LDA, M, N
        REAL               CFROM, CTO
  *     ..
  *     .. Array Arguments ..
        REAL               A( LDA, * )
  *     ..
  *
  *  =====================================================================
  *
  *     .. Parameters ..
        REAL               ZERO, ONE
        PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0 )
  *     ..
  *     .. Local Scalars ..
        LOGICAL            DONE
        INTEGER            I, ITYPE, J, K1, K2, K3, K4
        REAL               BIGNUM, CFROM1, CFROMC, CTO1, CTOC, MUL, SMLNUM
  *     ..
  *     .. External Functions ..
        LOGICAL            LSAME, SISNAN
        REAL               SLAMCH
        EXTERNAL           LSAME, SLAMCH, SISNAN
  *     ..
  *     .. Intrinsic Functions ..
        INTRINSIC          ABS, MAX, MIN
  *     ..
  *     .. External Subroutines ..
        EXTERNAL           XERBLA
  *     ..
  *     .. Executable Statements ..
  *
  *     Test the input arguments
  *
        INFO = 0
  *
        IF( LSAME( TYPE, 'G' ) ) THEN
           ITYPE = 0
        ELSE IF( LSAME( TYPE, 'L' ) ) THEN
           ITYPE = 1
        ELSE IF( LSAME( TYPE, 'U' ) ) THEN
           ITYPE = 2
        ELSE IF( LSAME( TYPE, 'H' ) ) THEN
           ITYPE = 3
        ELSE IF( LSAME( TYPE, 'B' ) ) THEN
           ITYPE = 4
        ELSE IF( LSAME( TYPE, 'Q' ) ) THEN
           ITYPE = 5
        ELSE IF( LSAME( TYPE, 'Z' ) ) THEN
           ITYPE = 6
        ELSE
           ITYPE = -1
        END IF
  *
        IF( ITYPE.EQ.-1 ) THEN
           INFO = -1
        ELSE IF( CFROM.EQ.ZERO .OR. SISNAN(CFROM) ) THEN
           INFO = -4
        ELSE IF( SISNAN(CTO) ) THEN
           INFO = -5
        ELSE IF( M.LT.0 ) THEN
           INFO = -6
        ELSE IF( N.LT.0 .OR. ( ITYPE.EQ.4 .AND. N.NE.M ) .OR.
       $         ( ITYPE.EQ.5 .AND. N.NE.M ) ) THEN
           INFO = -7
        ELSE IF( ITYPE.LE.3 .AND. LDA.LT.MAX( 1, M ) ) THEN
           INFO = -9
        ELSE IF( ITYPE.GE.4 ) THEN
           IF( KL.LT.0 .OR. KL.GT.MAX( M-1, 0 ) ) THEN
              INFO = -2
           ELSE IF( KU.LT.0 .OR. KU.GT.MAX( N-1, 0 ) .OR.
       $            ( ( ITYPE.EQ.4 .OR. ITYPE.EQ.5 ) .AND. KL.NE.KU ) )
       $             THEN
              INFO = -3
           ELSE IF( ( ITYPE.EQ.4 .AND. LDA.LT.KL+1 ) .OR.
       $            ( ITYPE.EQ.5 .AND. LDA.LT.KU+1 ) .OR.
       $            ( ITYPE.EQ.6 .AND. LDA.LT.2*KL+KU+1 ) ) THEN
              INFO = -9
           END IF
        END IF
  *
        IF( INFO.NE.0 ) THEN
           CALL XERBLA( 'SLASCL', -INFO )
           RETURN
        END IF
  *
  *     Quick return if possible
  *
        IF( N.EQ.0 .OR. M.EQ.0 )
       $   RETURN
  *
  *     Get machine parameters
  *
        SMLNUM = SLAMCH( 'S' )
        BIGNUM = ONE / SMLNUM
  *
        CFROMC = CFROM
        CTOC = CTO
  *
     10 CONTINUE
        CFROM1 = CFROMC*SMLNUM
        IF( CFROM1.EQ.CFROMC ) THEN
  !        CFROMC is an inf.  Multiply by a correctly signed zero for
  !        finite CTOC, or a NaN if CTOC is infinite.
           MUL = CTOC / CFROMC
           DONE = .TRUE.
           CTO1 = CTOC
        ELSE
           CTO1 = CTOC / BIGNUM
           IF( CTO1.EQ.CTOC ) THEN
  !           CTOC is either 0 or an inf.  In both cases, CTOC itself
  !           serves as the correct multiplication factor.
              MUL = CTOC
              DONE = .TRUE.
              CFROMC = ONE
           ELSE IF( ABS( CFROM1 ).GT.ABS( CTOC ) .AND. CTOC.NE.ZERO ) THEN
              MUL = SMLNUM
              DONE = .FALSE.
              CFROMC = CFROM1
           ELSE IF( ABS( CTO1 ).GT.ABS( CFROMC ) ) THEN
              MUL = BIGNUM
              DONE = .FALSE.
              CTOC = CTO1
           ELSE
              MUL = CTOC / CFROMC
              DONE = .TRUE.
           END IF
        END IF
  *
        IF( ITYPE.EQ.0 ) THEN
  *
  *        Full matrix
  *
           DO 30 J = 1, N
              DO 20 I = 1, M
                 A( I, J ) = A( I, J )*MUL
     20       CONTINUE
     30    CONTINUE
  *
        ELSE IF( ITYPE.EQ.1 ) THEN
  *
  *        Lower triangular matrix
  *
           DO 50 J = 1, N
              DO 40 I = J, M
                 A( I, J ) = A( I, J )*MUL
     40       CONTINUE
     50    CONTINUE
  *
        ELSE IF( ITYPE.EQ.2 ) THEN
  *
  *        Upper triangular matrix
  *
           DO 70 J = 1, N
              DO 60 I = 1, MIN( J, M )
                 A( I, J ) = A( I, J )*MUL
     60       CONTINUE
     70    CONTINUE
  *
        ELSE IF( ITYPE.EQ.3 ) THEN
  *
  *        Upper Hessenberg matrix
  *
           DO 90 J = 1, N
              DO 80 I = 1, MIN( J+1, M )
                 A( I, J ) = A( I, J )*MUL
     80       CONTINUE
     90    CONTINUE
  *
        ELSE IF( ITYPE.EQ.4 ) THEN
  *
  *        Lower half of a symmetric band matrix
  *
           K3 = KL + 1
           K4 = N + 1
           DO 110 J = 1, N
              DO 100 I = 1, MIN( K3, K4-J )
                 A( I, J ) = A( I, J )*MUL
    100       CONTINUE
    110    CONTINUE
  *
        ELSE IF( ITYPE.EQ.5 ) THEN
  *
  *        Upper half of a symmetric band matrix
  *
           K1 = KU + 2
           K3 = KU + 1
           DO 130 J = 1, N
              DO 120 I = MAX( K1-J, 1 ), K3
                 A( I, J ) = A( I, J )*MUL
    120       CONTINUE
    130    CONTINUE
  *
        ELSE IF( ITYPE.EQ.6 ) THEN
  *
  *        Band matrix
  *
           K1 = KL + KU + 2
           K2 = KL + 1
           K3 = 2*KL + KU + 1
           K4 = KL + KU + 1 + M
           DO 150 J = 1, N
              DO 140 I = MAX( K1-J, K2 ), MIN( K3, K4-J )
                 A( I, J ) = A( I, J )*MUL
    140       CONTINUE
    150    CONTINUE
  *
        END IF
  *
        IF( .NOT.DONE )
       $   GO TO 10
  *
        RETURN
  *
  *     End of SLASCL
  *
        END
  