![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
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