1 SUBROUTINE ZDRSCL( N, SA, SX, INCX )
2 *
3 * -- LAPACK auxiliary routine (version 3.2) --
4 * -- LAPACK is a software package provided by Univ. of Tennessee, --
5 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6 * November 2006
7 *
8 * .. Scalar Arguments ..
9 INTEGER INCX, N
10 DOUBLE PRECISION SA
11 * ..
12 * .. Array Arguments ..
13 COMPLEX*16 SX( * )
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * ZDRSCL multiplies an n-element complex vector x by the real scalar
20 * 1/a. This is done without overflow or underflow as long as
21 * the final result x/a does not overflow or underflow.
22 *
23 * Arguments
24 * =========
25 *
26 * N (input) INTEGER
27 * The number of components of the vector x.
28 *
29 * SA (input) DOUBLE PRECISION
30 * The scalar a which is used to divide each component of x.
31 * SA must be >= 0, or the subroutine will divide by zero.
32 *
33 * SX (input/output) COMPLEX*16 array, dimension
34 * (1+(N-1)*abs(INCX))
35 * The n-element vector x.
36 *
37 * INCX (input) INTEGER
38 * The increment between successive values of the vector SX.
39 * > 0: SX(1) = X(1) and SX(1+(i-1)*INCX) = x(i), 1< i<= n
40 *
41 * =====================================================================
42 *
43 * .. Parameters ..
44 DOUBLE PRECISION ZERO, ONE
45 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
46 * ..
47 * .. Local Scalars ..
48 LOGICAL DONE
49 DOUBLE PRECISION BIGNUM, CDEN, CDEN1, CNUM, CNUM1, MUL, SMLNUM
50 * ..
51 * .. External Functions ..
52 DOUBLE PRECISION DLAMCH
53 EXTERNAL DLAMCH
54 * ..
55 * .. External Subroutines ..
56 EXTERNAL DLABAD, ZDSCAL
57 * ..
58 * .. Intrinsic Functions ..
59 INTRINSIC ABS
60 * ..
61 * .. Executable Statements ..
62 *
63 * Quick return if possible
64 *
65 IF( N.LE.0 )
66 $ RETURN
67 *
68 * Get machine parameters
69 *
70 SMLNUM = DLAMCH( 'S' )
71 BIGNUM = ONE / SMLNUM
72 CALL DLABAD( SMLNUM, BIGNUM )
73 *
74 * Initialize the denominator to SA and the numerator to 1.
75 *
76 CDEN = SA
77 CNUM = ONE
78 *
79 10 CONTINUE
80 CDEN1 = CDEN*SMLNUM
81 CNUM1 = CNUM / BIGNUM
82 IF( ABS( CDEN1 ).GT.ABS( CNUM ) .AND. CNUM.NE.ZERO ) THEN
83 *
84 * Pre-multiply X by SMLNUM if CDEN is large compared to CNUM.
85 *
86 MUL = SMLNUM
87 DONE = .FALSE.
88 CDEN = CDEN1
89 ELSE IF( ABS( CNUM1 ).GT.ABS( CDEN ) ) THEN
90 *
91 * Pre-multiply X by BIGNUM if CDEN is small compared to CNUM.
92 *
93 MUL = BIGNUM
94 DONE = .FALSE.
95 CNUM = CNUM1
96 ELSE
97 *
98 * Multiply X by CNUM / CDEN and return.
99 *
100 MUL = CNUM / CDEN
101 DONE = .TRUE.
102 END IF
103 *
104 * Scale the vector X by MUL
105 *
106 CALL ZDSCAL( N, MUL, SX, INCX )
107 *
108 IF( .NOT.DONE )
109 $ GO TO 10
110 *
111 RETURN
112 *
113 * End of ZDRSCL
114 *
115 END
2 *
3 * -- LAPACK auxiliary routine (version 3.2) --
4 * -- LAPACK is a software package provided by Univ. of Tennessee, --
5 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6 * November 2006
7 *
8 * .. Scalar Arguments ..
9 INTEGER INCX, N
10 DOUBLE PRECISION SA
11 * ..
12 * .. Array Arguments ..
13 COMPLEX*16 SX( * )
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * ZDRSCL multiplies an n-element complex vector x by the real scalar
20 * 1/a. This is done without overflow or underflow as long as
21 * the final result x/a does not overflow or underflow.
22 *
23 * Arguments
24 * =========
25 *
26 * N (input) INTEGER
27 * The number of components of the vector x.
28 *
29 * SA (input) DOUBLE PRECISION
30 * The scalar a which is used to divide each component of x.
31 * SA must be >= 0, or the subroutine will divide by zero.
32 *
33 * SX (input/output) COMPLEX*16 array, dimension
34 * (1+(N-1)*abs(INCX))
35 * The n-element vector x.
36 *
37 * INCX (input) INTEGER
38 * The increment between successive values of the vector SX.
39 * > 0: SX(1) = X(1) and SX(1+(i-1)*INCX) = x(i), 1< i<= n
40 *
41 * =====================================================================
42 *
43 * .. Parameters ..
44 DOUBLE PRECISION ZERO, ONE
45 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
46 * ..
47 * .. Local Scalars ..
48 LOGICAL DONE
49 DOUBLE PRECISION BIGNUM, CDEN, CDEN1, CNUM, CNUM1, MUL, SMLNUM
50 * ..
51 * .. External Functions ..
52 DOUBLE PRECISION DLAMCH
53 EXTERNAL DLAMCH
54 * ..
55 * .. External Subroutines ..
56 EXTERNAL DLABAD, ZDSCAL
57 * ..
58 * .. Intrinsic Functions ..
59 INTRINSIC ABS
60 * ..
61 * .. Executable Statements ..
62 *
63 * Quick return if possible
64 *
65 IF( N.LE.0 )
66 $ RETURN
67 *
68 * Get machine parameters
69 *
70 SMLNUM = DLAMCH( 'S' )
71 BIGNUM = ONE / SMLNUM
72 CALL DLABAD( SMLNUM, BIGNUM )
73 *
74 * Initialize the denominator to SA and the numerator to 1.
75 *
76 CDEN = SA
77 CNUM = ONE
78 *
79 10 CONTINUE
80 CDEN1 = CDEN*SMLNUM
81 CNUM1 = CNUM / BIGNUM
82 IF( ABS( CDEN1 ).GT.ABS( CNUM ) .AND. CNUM.NE.ZERO ) THEN
83 *
84 * Pre-multiply X by SMLNUM if CDEN is large compared to CNUM.
85 *
86 MUL = SMLNUM
87 DONE = .FALSE.
88 CDEN = CDEN1
89 ELSE IF( ABS( CNUM1 ).GT.ABS( CDEN ) ) THEN
90 *
91 * Pre-multiply X by BIGNUM if CDEN is small compared to CNUM.
92 *
93 MUL = BIGNUM
94 DONE = .FALSE.
95 CNUM = CNUM1
96 ELSE
97 *
98 * Multiply X by CNUM / CDEN and return.
99 *
100 MUL = CNUM / CDEN
101 DONE = .TRUE.
102 END IF
103 *
104 * Scale the vector X by MUL
105 *
106 CALL ZDSCAL( N, MUL, SX, INCX )
107 *
108 IF( .NOT.DONE )
109 $ GO TO 10
110 *
111 RETURN
112 *
113 * End of ZDRSCL
114 *
115 END