LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ sladiv()

subroutine sladiv ( real a,
real b,
real c,
real d,
real p,
real q )

SLADIV performs complex division in real arithmetic, avoiding unnecessary overflow.

Download SLADIV + dependencies [TGZ] [ZIP] [TXT]

Purpose:
!>
!> SLADIV performs complex division in  real arithmetic
!>
!>                       a + i*b
!>            p + i*q = ---------
!>                       c + i*d
!>
!> The algorithm is due to Michael Baudin and Robert L. Smith
!> and can be found in the paper
!> 
!> 
Parameters
[in]A
!>          A is REAL
!> 
[in]B
!>          B is REAL
!> 
[in]C
!>          C is REAL
!> 
[in]D
!>          D is REAL
!>          The scalars a, b, c, and d in the above expression.
!> 
[out]P
!>          P is REAL
!> 
[out]Q
!>          Q is REAL
!>          The scalars p and q in the above expression.
!> 
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 88 of file sladiv.f.

89*
90* -- LAPACK auxiliary routine --
91* -- LAPACK is a software package provided by Univ. of Tennessee, --
92* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
93*
94* .. Scalar Arguments ..
95 REAL A, B, C, D, P, Q
96* ..
97*
98* =====================================================================
99*
100* .. Parameters ..
101 REAL BS
102 parameter( bs = 2.0e0 )
103 REAL HALF
104 parameter( half = 0.5e0 )
105 REAL TWO
106 parameter( two = 2.0e0 )
107*
108* .. Local Scalars ..
109 REAL AA, BB, CC, DD, AB, CD, S, OV, UN, BE, EPS
110* ..
111* .. External Functions ..
112 REAL SLAMCH
113 EXTERNAL slamch
114* ..
115* .. External Subroutines ..
116 EXTERNAL sladiv1
117* ..
118* .. Intrinsic Functions ..
119 INTRINSIC abs, max
120* ..
121* .. Executable Statements ..
122*
123 aa = a
124 bb = b
125 cc = c
126 dd = d
127 ab = max( abs(a), abs(b) )
128 cd = max( abs(c), abs(d) )
129 s = 1.0e0
130
131 ov = slamch( 'Overflow threshold' )
132 un = slamch( 'Safe minimum' )
133 eps = slamch( 'Epsilon' )
134 be = bs / (eps*eps)
135
136 IF( ab >= half*ov ) THEN
137 aa = half * aa
138 bb = half * bb
139 s = two * s
140 END IF
141 IF( cd >= half*ov ) THEN
142 cc = half * cc
143 dd = half * dd
144 s = half * s
145 END IF
146 IF( ab <= un*bs/eps ) THEN
147 aa = aa * be
148 bb = bb * be
149 s = s / be
150 END IF
151 IF( cd <= un*bs/eps ) THEN
152 cc = cc * be
153 dd = dd * be
154 s = s * be
155 END IF
156 IF( abs( d ).LE.abs( c ) ) THEN
157 CALL sladiv1(aa, bb, cc, dd, p, q)
158 ELSE
159 CALL sladiv1(bb, aa, dd, cc, p, q)
160 q = -q
161 END IF
162 p = p * s
163 q = q * s
164*
165 RETURN
166*
167* End of SLADIV
168*
subroutine sladiv1(a, b, c, d, p, q)
Definition sladiv.f:175
real function slamch(cmach)
SLAMCH
Definition slamch.f:68
Here is the call graph for this function:
Here is the caller graph for this function: