*> \brief \b DLADIV performs complex division in real arithmetic, avoiding unnecessary overflow. * * =========== DOCUMENTATION =========== * * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * *> \htmlonly *> Download DLADIV + dependencies *> *> [TGZ] *> *> [ZIP] *> *> [TXT] *> \endhtmlonly * * Definition: * =========== * * SUBROUTINE DLADIV( A, B, C, D, P, Q ) * * .. Scalar Arguments .. * DOUBLE PRECISION A, B, C, D, P, Q * .. * * *> \par Purpose: * ============= *> *> \verbatim *> *> DLADIV 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 *> "A Robust Complex Division in Scilab" *> \endverbatim * * Arguments: * ========== * *> \param[in] A *> \verbatim *> A is DOUBLE PRECISION *> \endverbatim *> *> \param[in] B *> \verbatim *> B is DOUBLE PRECISION *> \endverbatim *> *> \param[in] C *> \verbatim *> C is DOUBLE PRECISION *> \endverbatim *> *> \param[in] D *> \verbatim *> D is DOUBLE PRECISION *> The scalars a, b, c, and d in the above expression. *> \endverbatim *> *> \param[out] P *> \verbatim *> P is DOUBLE PRECISION *> \endverbatim *> *> \param[out] Q *> \verbatim *> Q is DOUBLE PRECISION *> The scalars p and q in the above expression. *> \endverbatim * * Authors: * ======== * *> \author Univ. of Tennessee *> \author Univ. of California Berkeley *> \author Univ. of Colorado Denver *> \author NAG Ltd. * *> \date January 2013 * *> \ingroup doubleOTHERauxiliary * * ===================================================================== SUBROUTINE DLADIV( A, B, C, D, P, Q ) * * -- LAPACK auxiliary routine (version 3.7.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * January 2013 * * .. Scalar Arguments .. DOUBLE PRECISION A, B, C, D, P, Q * .. * * ===================================================================== * * .. Parameters .. DOUBLE PRECISION BS PARAMETER ( BS = 2.0D0 ) DOUBLE PRECISION HALF PARAMETER ( HALF = 0.5D0 ) DOUBLE PRECISION TWO PARAMETER ( TWO = 2.0D0 ) * * .. Local Scalars .. DOUBLE PRECISION AA, BB, CC, DD, AB, CD, S, OV, UN, BE, EPS * .. * .. External Functions .. DOUBLE PRECISION DLAMCH EXTERNAL DLAMCH * .. * .. External Subroutines .. EXTERNAL DLADIV1 * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX * .. * .. Executable Statements .. * AA = A BB = B CC = C DD = D AB = MAX( ABS(A), ABS(B) ) CD = MAX( ABS(C), ABS(D) ) S = 1.0D0 OV = DLAMCH( 'Overflow threshold' ) UN = DLAMCH( 'Safe minimum' ) EPS = DLAMCH( 'Epsilon' ) BE = BS / (EPS*EPS) IF( AB >= HALF*OV ) THEN AA = HALF * AA BB = HALF * BB S = TWO * S END IF IF( CD >= HALF*OV ) THEN CC = HALF * CC DD = HALF * DD S = HALF * S END IF IF( AB <= UN*BS/EPS ) THEN AA = AA * BE BB = BB * BE S = S / BE END IF IF( CD <= UN*BS/EPS ) THEN CC = CC * BE DD = DD * BE S = S * BE END IF IF( ABS( D ).LE.ABS( C ) ) THEN CALL DLADIV1(AA, BB, CC, DD, P, Q) ELSE CALL DLADIV1(BB, AA, DD, CC, P, Q) Q = -Q END IF P = P * S Q = Q * S * RETURN * * End of DLADIV * END *> \ingroup doubleOTHERauxiliary SUBROUTINE DLADIV1( A, B, C, D, P, Q ) * * -- LAPACK auxiliary routine (version 3.7.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * January 2013 * * .. Scalar Arguments .. DOUBLE PRECISION A, B, C, D, P, Q * .. * * ===================================================================== * * .. Parameters .. DOUBLE PRECISION ONE PARAMETER ( ONE = 1.0D0 ) * * .. Local Scalars .. DOUBLE PRECISION R, T * .. * .. External Functions .. DOUBLE PRECISION DLADIV2 EXTERNAL DLADIV2 * .. * .. Executable Statements .. * R = D / C T = ONE / (C + D * R) P = DLADIV2(A, B, C, D, R, T) A = -A Q = DLADIV2(B, A, C, D, R, T) * RETURN * * End of DLADIV1 * END *> \ingroup doubleOTHERauxiliary DOUBLE PRECISION FUNCTION DLADIV2( A, B, C, D, R, T ) * * -- LAPACK auxiliary routine (version 3.7.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * January 2013 * * .. Scalar Arguments .. DOUBLE PRECISION A, B, C, D, R, T * .. * * ===================================================================== * * .. Parameters .. DOUBLE PRECISION ZERO PARAMETER ( ZERO = 0.0D0 ) * * .. Local Scalars .. DOUBLE PRECISION BR * .. * .. Executable Statements .. * IF( R.NE.ZERO ) THEN BR = B * R IF( BR.NE.ZERO ) THEN DLADIV2 = (A + BR) * T ELSE DLADIV2 = A * T + (B * T) * R END IF ELSE DLADIV2 = (A + D * (B / C)) * T END IF * RETURN * * End of DLADIV12 * END