Télécharger egar8.eso

Retour à la liste

Numérotation des lignes :

  1. C EGAR8 SOURCE GOUNAND 18/10/10 21:15:04 9956
  2. LOGICAL FUNCTION EGAR8(X1,X2)
  3. IMPLICIT REAL*8(A-H,O-Z)
  4. IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM : EGAR8
  7. C DESCRIPTION : Teste l'egalite approximative de deux reels*8
  8. C avec un critere relatif, un critere absolu et une marge
  9. C
  10. C On utilise le common CCREEL pour les dependants machine
  11. C XZPREC et XPETIT
  12. C
  13. C Ne pas oublier de declarer :
  14. C logical EGAR8
  15. C dans le code appelant
  16. C
  17. C Voir aussi EGAR4, EGADPL
  18. C
  19. C LANGAGE : ESOPE
  20. C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SEMT/LTA)
  21. C mél : gounand@semt2.smts.cea.fr
  22. C***********************************************************************
  23. C VERSION : v1, 09/10/2018, version initiale
  24. C HISTORIQUE : v1, 09/10/2018, création
  25. C HISTORIQUE :
  26. C HISTORIQUE :
  27. C***********************************************************************
  28. -INC CCOPTIO
  29. -INC CCREEL
  30. *
  31. REAL*8 X1,X2,XREL,XABS,XMAR,XTOT
  32. * Doit etre compris entre 0.5 (tolerance large) et 1. (tolerance stricte)
  33. PARAMETER (XMAR=0.75D0)
  34. *
  35. * write(ioimp,*) 'x1=',x1,'x2=',x2,'x1-x2=',x1-x2
  36. XREL=XZPREC*(max(abs(x1),abs(x2)))
  37. XABS=XPETIT
  38. XTOT=(MAX(XREL,XABS))**XMAR
  39. * write(ioimp,*) 'xrel=',xrel,'xabs=',xabs,'xtot=',xtot
  40. *
  41. EGAR8=ABS(X1-X2).LT.XTOT
  42. *
  43. * End of logical function EGAR8
  44. *
  45. END
  46.  
  47.  
  48.  

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