KTH framework for Nek5000 toolboxes; testing version  0.0.1
zdrscl.f
Go to the documentation of this file.
1  SUBROUTINE zdrscl( N, SA, SX, INCX )
2 *
3 * -- LAPACK auxiliary routine (version 3.0) --
4 * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
5 * Courant Institute, Argonne National Lab, and Rice University
6 * September 30, 1994
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
subroutine dlabad(SMALL, LARGE)
Definition: dlabad.f:2
subroutine zdrscl(N, SA, SX, INCX)
Definition: zdrscl.f:2
subroutine zdscal(n, da, zx, incx)
Definition: zdscal.f:2