LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
csrscl.f
Go to the documentation of this file.
00001 *> \brief \b CSRSCL
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download CSRSCL + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/csrscl.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/csrscl.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/csrscl.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE CSRSCL( N, SA, SX, INCX )
00022 * 
00023 *       .. Scalar Arguments ..
00024 *       INTEGER            INCX, N
00025 *       REAL               SA
00026 *       ..
00027 *       .. Array Arguments ..
00028 *       COMPLEX            SX( * )
00029 *       ..
00030 *  
00031 *
00032 *> \par Purpose:
00033 *  =============
00034 *>
00035 *> \verbatim
00036 *>
00037 *> CSRSCL multiplies an n-element complex vector x by the real scalar
00038 *> 1/a.  This is done without overflow or underflow as long as
00039 *> the final result x/a does not overflow or underflow.
00040 *> \endverbatim
00041 *
00042 *  Arguments:
00043 *  ==========
00044 *
00045 *> \param[in] N
00046 *> \verbatim
00047 *>          N is INTEGER
00048 *>          The number of components of the vector x.
00049 *> \endverbatim
00050 *>
00051 *> \param[in] SA
00052 *> \verbatim
00053 *>          SA is REAL
00054 *>          The scalar a which is used to divide each component of x.
00055 *>          SA must be >= 0, or the subroutine will divide by zero.
00056 *> \endverbatim
00057 *>
00058 *> \param[in,out] SX
00059 *> \verbatim
00060 *>          SX is COMPLEX array, dimension
00061 *>                         (1+(N-1)*abs(INCX))
00062 *>          The n-element vector x.
00063 *> \endverbatim
00064 *>
00065 *> \param[in] INCX
00066 *> \verbatim
00067 *>          INCX is INTEGER
00068 *>          The increment between successive values of the vector SX.
00069 *>          > 0:  SX(1) = X(1) and SX(1+(i-1)*INCX) = x(i),     1< i<= n
00070 *> \endverbatim
00071 *
00072 *  Authors:
00073 *  ========
00074 *
00075 *> \author Univ. of Tennessee 
00076 *> \author Univ. of California Berkeley 
00077 *> \author Univ. of Colorado Denver 
00078 *> \author NAG Ltd. 
00079 *
00080 *> \date November 2011
00081 *
00082 *> \ingroup complexOTHERauxiliary
00083 *
00084 *  =====================================================================
00085       SUBROUTINE CSRSCL( N, SA, SX, INCX )
00086 *
00087 *  -- LAPACK auxiliary routine (version 3.4.0) --
00088 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00089 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00090 *     November 2011
00091 *
00092 *     .. Scalar Arguments ..
00093       INTEGER            INCX, N
00094       REAL               SA
00095 *     ..
00096 *     .. Array Arguments ..
00097       COMPLEX            SX( * )
00098 *     ..
00099 *
00100 * =====================================================================
00101 *
00102 *     .. Parameters ..
00103       REAL               ZERO, ONE
00104       PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
00105 *     ..
00106 *     .. Local Scalars ..
00107       LOGICAL            DONE
00108       REAL               BIGNUM, CDEN, CDEN1, CNUM, CNUM1, MUL, SMLNUM
00109 *     ..
00110 *     .. External Functions ..
00111       REAL               SLAMCH
00112       EXTERNAL           SLAMCH
00113 *     ..
00114 *     .. External Subroutines ..
00115       EXTERNAL           CSSCAL, SLABAD
00116 *     ..
00117 *     .. Intrinsic Functions ..
00118       INTRINSIC          ABS
00119 *     ..
00120 *     .. Executable Statements ..
00121 *
00122 *     Quick return if possible
00123 *
00124       IF( N.LE.0 )
00125      $   RETURN
00126 *
00127 *     Get machine parameters
00128 *
00129       SMLNUM = SLAMCH( 'S' )
00130       BIGNUM = ONE / SMLNUM
00131       CALL SLABAD( SMLNUM, BIGNUM )
00132 *
00133 *     Initialize the denominator to SA and the numerator to 1.
00134 *
00135       CDEN = SA
00136       CNUM = ONE
00137 *
00138    10 CONTINUE
00139       CDEN1 = CDEN*SMLNUM
00140       CNUM1 = CNUM / BIGNUM
00141       IF( ABS( CDEN1 ).GT.ABS( CNUM ) .AND. CNUM.NE.ZERO ) THEN
00142 *
00143 *        Pre-multiply X by SMLNUM if CDEN is large compared to CNUM.
00144 *
00145          MUL = SMLNUM
00146          DONE = .FALSE.
00147          CDEN = CDEN1
00148       ELSE IF( ABS( CNUM1 ).GT.ABS( CDEN ) ) THEN
00149 *
00150 *        Pre-multiply X by BIGNUM if CDEN is small compared to CNUM.
00151 *
00152          MUL = BIGNUM
00153          DONE = .FALSE.
00154          CNUM = CNUM1
00155       ELSE
00156 *
00157 *        Multiply X by CNUM / CDEN and return.
00158 *
00159          MUL = CNUM / CDEN
00160          DONE = .TRUE.
00161       END IF
00162 *
00163 *     Scale the vector X by MUL
00164 *
00165       CALL CSSCAL( N, MUL, SX, INCX )
00166 *
00167       IF( .NOT.DONE )
00168      $   GO TO 10
00169 *
00170       RETURN
00171 *
00172 *     End of CSRSCL
00173 *
00174       END
 All Files Functions