Télécharger la plaquette Cast3M


fr en

Télécharger dlamch.eso

Retour à la liste

Numérotation des lignes : 

dlamch

  1. C DLAMCH    SOURCE    PV090527  24/01/19    21:15:03     11827          
  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.       IMPLICIT INTEGER(I-N)
  52.       IMPLICIT REAL*8(A-H,O-Z)
  53.  
  54. -INC CCREEL
  55. -INC PPARAM
  56. -INC CCOPTIO
  57.  
  58.       CHARACTER CMACH
  59.       REAL*8 LAMCH,DLAMCH
  60.       REAL*8 SMALL
  61.       REAL*8 EPS,RND,SFMIN
  62.       REAL*8 SFMIN1,SFMIN2,SFMIN4,SFMIN10
  63.  
  64.       REAL*8 ONE
  65.       PARAMETER (ONE = 1.D0)
  66.  
  67.       RND=ONE
  68.  
  69.       IF (ONE .EQ. RND) THEN
  70.  
  71. c         EPS=EPSILON(XZERO)*0.5D0
  72.         EPS=XZPREC*0.5D0
  73.       ELSE
  74.  
  75. c         EPS=EPSILON(XZERO)
  76.         EPS=XZPREC
  77.       ENDIF
  78.  
  79.  
  80.       IF (CMACH .EQ. 'E' .OR. CMACH .EQ. 'e') THEN
  81.  
  82.         LAMCH=EPS
  83.  
  84.       ELSEIF (CMACH .EQ. 'S'.OR. CMACH .EQ. 's') THEN
  85.  
  86. c         SFMIN=TINY(XZERO)
  87.           SFMIN=XPETIT
  88.  
  89. c         SMALL = ONE / HUGE(XZERO)
  90.           SMALL=XPETIT         
  91.  
  92.         IF (SMALL .GE. SFMIN) THEN
  93.  
  94.           SFMIN=SMALL*( ONE + EPS )
  95. c           SFMIN=SMALL*( ONE + XZPREC )
  96.  
  97.         ENDIF
  98.         LAMCH=SFMIN
  99.  
  100.       ELSEIF (CMACH .EQ. 'B'.OR. CMACH .EQ. 'b') THEN
  101.  
  102. c         LAMCH=RADIX(XZERO)
  103.         LAMCH=2.D0
  104.  
  105.       ELSEIF (CMACH .EQ. 'P'.OR. CMACH .EQ. 'p') THEN
  106.  
  107. c         LAMCH=EPSILON(XZERO)*RADIX(XZERO)
  108.         LAMCH=XZPREC*2.D0
  109.  
  110.  
  111. ************************************************************************
  112. *Les options qui suivent sont mises en commentaire car impliquent du
  113. *fortran 95
  114. ************************************************************************
  115.  
  116. c       ELSEIF (CMACH .EQ. 'N'.OR. CMACH .EQ. 'n') THEN
  117. c
  118. c         LAMCH=DIGITS(XZERO)
  119. c
  120. c       ELSEIF (CMACH .EQ. 'R'.OR. CMACH .EQ. 'r') THEN
  121. c
  122. c         LAMCH=MINEXPONENT(XZERO)
  123. c
  124. c       ELSEIF (CMACH .EQ. 'M'.OR. CMACH .EQ. 'm') THEN
  125. c
  126. c         LAMCH=TINY(XZERO)
  127. c
  128. c       ELSEIF (CMACH .EQ. 'U'.OR. CMACH .EQ. 'u') THEN
  129. c
  130. c         LAMCH=MINEXPONENT(XZERO)
  131. c
  132. c       ELSEIF (CMACH .EQ. 'L'.OR. CMACH .EQ. 'l') THEN
  133. c
  134. c         LAMCH=MAXEXPONENT(XZERO)
  135.  
  136.       ELSEIF (CMACH .EQ. 'O'.OR. CMACH .EQ. 'o') THEN
  137.  
  138. c         LAMCH=HUGE(XZERO)
  139.         LAMCH=XGRAND
  140.  
  141.       ELSE
  142.  
  143.         LAMCH=XZERO
  144.         write(*,*) 'DLAMCH(',CMACH,')= non prévu !'
  145.         CALL ERREUR(5)
  146.  
  147.       ENDIF
  148.  
  149.       DLAMCH=LAMCH
  150.  
  151.       RETURN
  152.  
  153.       END
  154.  
  155.  
  156.  
  157.  
  158.  
  159.  

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