Télécharger la plaquette Cast3M


fr en

Télécharger egar8.eso

Retour à la liste

Numérotation des lignes : 

egar8

  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.  
  29. -INC PPARAM
  30. -INC CCOPTIO
  31. -INC CCREEL
  32. *
  33.       REAL*8 X1,X2,XREL,XABS,XMAR,XTOT
  34. * Doit etre compris entre 0.5 (tolerance large) et 1. (tolerance stricte)      
  35.       PARAMETER (XMAR=0.75D0)
  36. *
  37. *      write(ioimp,*) 'x1=',x1,'x2=',x2,'x1-x2=',x1-x2
  38.       XREL=XZPREC*(max(abs(x1),abs(x2)))
  39.       XABS=XPETIT
  40.       XTOT=(MAX(XREL,XABS))**XMAR
  41. *      write(ioimp,*) 'xrel=',xrel,'xabs=',xabs,'xtot=',xtot
  42. *
  43.       EGAR8=ABS(X1-X2).LT.XTOT
  44. *
  45. * End of logical function EGAR8
  46. *
  47.       END
  48.  
  49.  
  50.  

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