Numérotation des lignes :

dlascl
C DLASCL    SOURCE    BP208322  18/07/10    21:15:17     9872           *> \brief \b DLASCL 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 DLASCL + dependencies*> &lt;a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlascl.f">*> [TGZ]&lt;/a>*> &lt;a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlascl.f">*> [ZIP]&lt;/a>*> &lt;a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlascl.f">*> [TXT]&lt;/a>*> \endhtmlonly**  Definition:*  ===========**       SUBROUTINE DLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO )**       .. Scalar Arguments ..*       CHARACTER          TYPE*       INTEGER            INFO, KL, KU, LDA, M, N*       REAL*8   CFROM, CTO*       ..*       .. Array Arguments ..*       REAL*8   A( LDA, * )*       ..***> \par Purpose:*  =============*>*> \verbatim*>*> DLASCL 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 DGBTRF 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 DOUBLE PRECISION*> \endverbatim*>*> \param[in] CTO*> \verbatim*>          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.*> \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 DOUBLE PRECISION 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*>          &lt;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 DLASCL( 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*8   CFROM, CTO*     ..*     .. Array Arguments ..      REAL*8   A( LDA, * )*     ..**  =====================================================================**     .. Parameters ..      REAL*8   ZERO, ONE      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )*     ..*     .. Local Scalars ..      LOGICAL            DONE      INTEGER            I, ITYPE, J, K1, K2, K3, K4      REAL*8   BIGNUM, CFROM1, CFROMC, CTO1, CTOC, MUL, SMLNUM*     ..*     .. External Functions ..      LOGICAL            LSAME, DISNAN      REAL*8   DLAMCH      EXTERNAL           LSAME, DLAMCH, DISNAN*     ..**     .. 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. DISNAN(CFROM) ) THEN         INFO = -4      ELSE IF( DISNAN(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( 'DLASCL', -INFO ) RETURN END IF** Quick return if possible* IF( N.EQ.0 .OR. M.EQ.0 )$   RETURN**     Get machine parameters*      SMLNUM = DLAMCH( '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 DLASCL*      END   

© Cast3M 2003 - Tous droits réservés.
Mentions légales