Numérotation des lignes :

C DLADIV    SOURCE    BP208322  18/07/10    21:15:05     9872           *> \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*> &lt;a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dladiv.f">*> [TGZ]&lt;/a>*> &lt;a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dladiv.f">*> [ZIP]&lt;/a>*> &lt;a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dladiv.f">*> [TXT]&lt;/a>*> \endhtmlonly**  Definition:*  ===========**       SUBROUTINE DLADIV( A, B, C, D, P, Q )**       .. Scalar Arguments ..*       REAL*8   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 ..      REAL*8   A, B, C, D, P, Q*     ..**  =====================================================================**     .. Parameters ..      REAL*8   BS      PARAMETER          ( BS = 2.0D0 )      REAL*8   HALF      PARAMETER          ( HALF = 0.5D0 )      REAL*8   TWO      PARAMETER          ( TWO = 2.0D0 )**     .. Local Scalars ..      REAL*8   AA, BB, CC, DD, AB, CD, S, OV, UN, BE, EPS*     ..c *     .. External Functions ..c       REAL*8   DLAMCHc       EXTERNAL           DLAMCHc *     ..c *     .. External Subroutines ..c       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 .GE. HALF*OV ) THEN         AA = HALF * AA         BB = HALF * BB         S  = TWO * S      END IF      IF( CD .GE. HALF*OV ) THEN         CC = HALF * CC         DD = HALF * DD         S  = HALF * S      END IF      IF( AB .LE. UN*BS/EPS ) THEN         AA = AA * BE         BB = BB * BE         S  = S / BE      END IF      IF( CD .LE. 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 ..      REAL*8   A, B, C, D, P, Q*     ..**  =====================================================================**     .. Parameters ..      REAL*8   ONE      PARAMETER          ( ONE = 1.0D0 )**     .. Local Scalars ..      REAL*8   R, T*     ..*     .. External Functions ..      REAL*8   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       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 ..      REAL*8   A, B, C, D, R, T      REAL*8   DLADIV2*     ..**  =====================================================================**     .. Parameters ..      REAL*8   ZERO      PARAMETER          ( ZERO = 0.0D0 )**     .. Local Scalars ..      REAL*8   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

© Cast3M 2003 - Tous droits réservés.
Mentions légales