00001 SUBROUTINE ZDRSCL( N, SA, SX, INCX ) 00002 * 00003 * -- LAPACK auxiliary routine (version 3.2) -- 00004 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00005 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00006 * November 2006 00007 * 00008 * .. Scalar Arguments .. 00009 INTEGER INCX, N 00010 DOUBLE PRECISION SA 00011 * .. 00012 * .. Array Arguments .. 00013 COMPLEX*16 SX( * ) 00014 * .. 00015 * 00016 * Purpose 00017 * ======= 00018 * 00019 * ZDRSCL multiplies an n-element complex vector x by the real scalar 00020 * 1/a. This is done without overflow or underflow as long as 00021 * the final result x/a does not overflow or underflow. 00022 * 00023 * Arguments 00024 * ========= 00025 * 00026 * N (input) INTEGER 00027 * The number of components of the vector x. 00028 * 00029 * SA (input) DOUBLE PRECISION 00030 * The scalar a which is used to divide each component of x. 00031 * SA must be >= 0, or the subroutine will divide by zero. 00032 * 00033 * SX (input/output) COMPLEX*16 array, dimension 00034 * (1+(N-1)*abs(INCX)) 00035 * The n-element vector x. 00036 * 00037 * INCX (input) INTEGER 00038 * The increment between successive values of the vector SX. 00039 * > 0: SX(1) = X(1) and SX(1+(i-1)*INCX) = x(i), 1< i<= n 00040 * 00041 * ===================================================================== 00042 * 00043 * .. Parameters .. 00044 DOUBLE PRECISION ZERO, ONE 00045 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) 00046 * .. 00047 * .. Local Scalars .. 00048 LOGICAL DONE 00049 DOUBLE PRECISION BIGNUM, CDEN, CDEN1, CNUM, CNUM1, MUL, SMLNUM 00050 * .. 00051 * .. External Functions .. 00052 DOUBLE PRECISION DLAMCH 00053 EXTERNAL DLAMCH 00054 * .. 00055 * .. External Subroutines .. 00056 EXTERNAL DLABAD, ZDSCAL 00057 * .. 00058 * .. Intrinsic Functions .. 00059 INTRINSIC ABS 00060 * .. 00061 * .. Executable Statements .. 00062 * 00063 * Quick return if possible 00064 * 00065 IF( N.LE.0 ) 00066 $ RETURN 00067 * 00068 * Get machine parameters 00069 * 00070 SMLNUM = DLAMCH( 'S' ) 00071 BIGNUM = ONE / SMLNUM 00072 CALL DLABAD( SMLNUM, BIGNUM ) 00073 * 00074 * Initialize the denominator to SA and the numerator to 1. 00075 * 00076 CDEN = SA 00077 CNUM = ONE 00078 * 00079 10 CONTINUE 00080 CDEN1 = CDEN*SMLNUM 00081 CNUM1 = CNUM / BIGNUM 00082 IF( ABS( CDEN1 ).GT.ABS( CNUM ) .AND. CNUM.NE.ZERO ) THEN 00083 * 00084 * Pre-multiply X by SMLNUM if CDEN is large compared to CNUM. 00085 * 00086 MUL = SMLNUM 00087 DONE = .FALSE. 00088 CDEN = CDEN1 00089 ELSE IF( ABS( CNUM1 ).GT.ABS( CDEN ) ) THEN 00090 * 00091 * Pre-multiply X by BIGNUM if CDEN is small compared to CNUM. 00092 * 00093 MUL = BIGNUM 00094 DONE = .FALSE. 00095 CNUM = CNUM1 00096 ELSE 00097 * 00098 * Multiply X by CNUM / CDEN and return. 00099 * 00100 MUL = CNUM / CDEN 00101 DONE = .TRUE. 00102 END IF 00103 * 00104 * Scale the vector X by MUL 00105 * 00106 CALL ZDSCAL( N, MUL, SX, INCX ) 00107 * 00108 IF( .NOT.DONE ) 00109 $ GO TO 10 00110 * 00111 RETURN 00112 * 00113 * End of ZDRSCL 00114 * 00115 END
1.7.2