sladiv.f 2.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128
  1. *> \brief \b SLADIV
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download SLADIV + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sladiv.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sladiv.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sladiv.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * SUBROUTINE SLADIV( A, B, C, D, P, Q )
  22. *
  23. * .. Scalar Arguments ..
  24. * REAL A, B, C, D, P, Q
  25. * ..
  26. *
  27. *
  28. *> \par Purpose:
  29. * =============
  30. *>
  31. *> \verbatim
  32. *>
  33. *> SLADIV performs complex division in real arithmetic
  34. *>
  35. *> a + i*b
  36. *> p + i*q = ---------
  37. *> c + i*d
  38. *>
  39. *> The algorithm is due to Robert L. Smith and can be found
  40. *> in D. Knuth, The art of Computer Programming, Vol.2, p.195
  41. *> \endverbatim
  42. *
  43. * Arguments:
  44. * ==========
  45. *
  46. *> \param[in] A
  47. *> \verbatim
  48. *> A is REAL
  49. *> \endverbatim
  50. *>
  51. *> \param[in] B
  52. *> \verbatim
  53. *> B is REAL
  54. *> \endverbatim
  55. *>
  56. *> \param[in] C
  57. *> \verbatim
  58. *> C is REAL
  59. *> \endverbatim
  60. *>
  61. *> \param[in] D
  62. *> \verbatim
  63. *> D is REAL
  64. *> The scalars a, b, c, and d in the above expression.
  65. *> \endverbatim
  66. *>
  67. *> \param[out] P
  68. *> \verbatim
  69. *> P is REAL
  70. *> \endverbatim
  71. *>
  72. *> \param[out] Q
  73. *> \verbatim
  74. *> Q is REAL
  75. *> The scalars p and q in the above expression.
  76. *> \endverbatim
  77. *
  78. * Authors:
  79. * ========
  80. *
  81. *> \author Univ. of Tennessee
  82. *> \author Univ. of California Berkeley
  83. *> \author Univ. of Colorado Denver
  84. *> \author NAG Ltd.
  85. *
  86. *> \date November 2011
  87. *
  88. *> \ingroup auxOTHERauxiliary
  89. *
  90. * =====================================================================
  91. SUBROUTINE SLADIV( A, B, C, D, P, Q )
  92. *
  93. * -- LAPACK auxiliary routine (version 3.4.0) --
  94. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  95. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  96. * November 2011
  97. *
  98. * .. Scalar Arguments ..
  99. REAL A, B, C, D, P, Q
  100. * ..
  101. *
  102. * =====================================================================
  103. *
  104. * .. Local Scalars ..
  105. REAL E, F
  106. * ..
  107. * .. Intrinsic Functions ..
  108. INTRINSIC ABS
  109. * ..
  110. * .. Executable Statements ..
  111. *
  112. IF( ABS( D ).LT.ABS( C ) ) THEN
  113. E = D / C
  114. F = C + D*E
  115. P = ( A+B*E ) / F
  116. Q = ( B-A*E ) / F
  117. ELSE
  118. E = C / D
  119. F = D + C*E
  120. P = ( B+A*E ) / F
  121. Q = ( -A+B*E ) / F
  122. END IF
  123. *
  124. RETURN
  125. *
  126. * End of SLADIV
  127. *
  128. END