Télécharger dlamch.eso

Retour à la liste

Numérotation des lignes :

  1. C DLAMCH SOURCE BP208322 15/10/13 21:15:29 8670
  2. FUNCTION DLAMCH( CMACH )
  3. *
  4. * -- LAPACK auxiliary routine (version 2.0) --
  5. * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
  6. * Courant Institute, Argonne National Lab, and Rice University
  7. * October 31, 1992
  8. *
  9. *
  10. * Purpose
  11. * =======
  12. *
  13. * DLAMCH determines REAL*8 machine parameters.
  14. *
  15. * Arguments
  16. * =========
  17. *
  18. * CMACH (input) CHARACTER*1
  19. * Specifies the value to be returned by DLAMCH:
  20. * = 'E' or 'e', DLAMCH := eps
  21. * = 'S' or 's , DLAMCH := sfmin
  22. * = 'B' or 'b', DLAMCH := base
  23. * = 'P' or 'p', DLAMCH := eps*base
  24. * = 'N' or 'n', DLAMCH := t
  25. * = 'R' or 'r', DLAMCH := rnd
  26. * = 'M' or 'm', DLAMCH := emin
  27. * = 'U' or 'u', DLAMCH := rmin
  28. * = 'L' or 'l', DLAMCH := emax
  29. * = 'O' or 'o', DLAMCH := rmax
  30. *
  31. * where
  32. *
  33. * eps = relative machine precision
  34. * sfmin = safe minimum, such that 1/sfmin does not overflow
  35. * base = base of the machine
  36. * prec = eps*base
  37. * t = number of (base) digits in the mantissa
  38. * rnd = 1.0 when rounding occurs in addition, 0.0 otherwise
  39. * emin = minimum exponent before (gradual) underflow
  40. * rmin = underflow threshold - base**(emin-1)
  41. * emax = largest exponent before overflow
  42. * rmax = overflow threshold - (base**emax)*(1-eps)
  43. *
  44. * =====================================================================
  45.  
  46. ************************************************************************
  47. *Note: la fonction a ete entierement revue pour etre compatible avec le
  48. *script compil.sh (utilisation de fonctions intrinsèques au fortran 95)
  49. ************************************************************************
  50.  
  51. -INC CCREEL
  52. -INC CCOPTIO
  53.  
  54. CHARACTER CMACH
  55.  
  56. REAL*8 LAMCH,DLAMCH
  57. REAL*8 SMALL
  58. REAL*8 EPS,RND,SFMIN
  59. REAL*8 SFMIN1,SFMIN2,SFMIN4,SFMIN10
  60.  
  61. REAL*8 ONE
  62. PARAMETER (ONE = 1.D0)
  63.  
  64. RND=ONE
  65.  
  66. IF (ONE .EQ. RND) THEN
  67.  
  68. c EPS=EPSILON(XZERO)*0.5D0
  69. EPS=XZPREC*0.5D0
  70. ELSE
  71.  
  72. c EPS=EPSILON(XZERO)
  73. EPS=XZPREC
  74. ENDIF
  75.  
  76.  
  77. IF (CMACH .EQ. 'E' .OR. CMACH .EQ. 'e') THEN
  78.  
  79. LAMCH=EPS
  80.  
  81. ELSEIF (CMACH .EQ. 'S'.OR. CMACH .EQ. 's') THEN
  82.  
  83. c SFMIN=TINY(XZERO)
  84. SFMIN=XPETIT
  85.  
  86. c SMALL = ONE / HUGE(XZERO)
  87. SMALL=ONE / XGRAND
  88.  
  89. IF (SMALL .GE. SFMIN) THEN
  90.  
  91. SFMIN=SMALL*( ONE + EPS )
  92. c SFMIN=SMALL*( ONE + XZPREC )
  93.  
  94. ENDIF
  95. LAMCH=SFMIN
  96.  
  97. ELSEIF (CMACH .EQ. 'B'.OR. CMACH .EQ. 'b') THEN
  98.  
  99. c LAMCH=RADIX(XZERO)
  100. LAMCH=2.D0
  101.  
  102. ELSEIF (CMACH .EQ. 'P'.OR. CMACH .EQ. 'p') THEN
  103.  
  104. c LAMCH=EPSILON(XZERO)*RADIX(XZERO)
  105. LAMCH=XZPREC*2.D0
  106.  
  107.  
  108. ************************************************************************
  109. *Les options qui suivent sont mises en commentaire car impliquent du
  110. *fortran 95
  111. ************************************************************************
  112.  
  113. c ELSEIF (CMACH .EQ. 'N'.OR. CMACH .EQ. 'n') THEN
  114. c
  115. c LAMCH=DIGITS(XZERO)
  116. c
  117. c ELSEIF (CMACH .EQ. 'R'.OR. CMACH .EQ. 'r') THEN
  118. c
  119. c LAMCH=MINEXPONENT(XZERO)
  120. c
  121. c ELSEIF (CMACH .EQ. 'M'.OR. CMACH .EQ. 'm') THEN
  122. c
  123. c LAMCH=TINY(XZERO)
  124. c
  125. c ELSEIF (CMACH .EQ. 'U'.OR. CMACH .EQ. 'u') THEN
  126. c
  127. c LAMCH=MINEXPONENT(XZERO)
  128. c
  129. c ELSEIF (CMACH .EQ. 'L'.OR. CMACH .EQ. 'l') THEN
  130. c
  131. c LAMCH=MAXEXPONENT(XZERO)
  132.  
  133. ELSEIF (CMACH .EQ. 'O'.OR. CMACH .EQ. 'o') THEN
  134.  
  135. c LAMCH=HUGE(XZERO)
  136. LAMCH=XGRAND
  137.  
  138. ELSE
  139.  
  140. LAMCH=XZERO
  141. write(*,*) 'DLAMCH(',CMACH,')= non prévu !'
  142. CALL ERREUR(5)
  143.  
  144. ENDIF
  145.  
  146. DLAMCH=LAMCH
  147.  
  148. RETURN
  149.  
  150. END
  151.  
  152.  
  153.  
  154.  

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