Télécharger la plaquette Cast3M


fr en

Télécharger ega1.eso

Retour à la liste

Numérotation des lignes : 

ega1

  1. C EGA1      SOURCE    FANDEUR   22/05/03    21:15:02     11360          
  2.       LOGICAL FUNCTION EGA1 (IP1,IP2,EPS1)
  3.  
  4. ************************************************************************
  5. *
  6. *                             E G A 1
  7. *                             -------
  8. *
  9. * FONCTION:
  10. * ---------
  11. *
  12. *     INDIQUER SI 2 POINTS ONT MEME POSITION DANS L'ESPACE, A PEU DE
  13. *     CHOSES PRES
  14. *
  15. * ARGUMENTS:   (E)=ENTREE   (S)=SORTIE   (+ = PASSE PAR COMMUN)
  16. * ----------
  17. *
  18. *     IP1     (E)  1ER POINT.
  19. *     IP2     (E)  2EME POINT.
  20. *     EPS1    (E)  TOLERANCE POUR ANNONCER "MEME POSITION".
  21. *                  SI NEGATIF, AUCUNE TOLERANCE SPECIFIEE: ON PREND UN
  22. *                  SOUS-MULTIPLE DE LA DENSITE.
  23. *             (S)  TOLERANCE UTILISEE.
  24. *     EGA1    (S)  .TRUE. SI LES POINTS SONT A LA MEME POSITION.
  25. *                  .FALSE. SINON.
  26. *    +DENSIT  (E)  VOIR "CCGEOME".
  27. *    +IDIM    (E)  VOIR "CCOPTIO".
  28. *    +MCOORD  (E)  VOIR "SMCOORD".
  29. * ATTENTION : EPS1 est potentiellement modifie en SORTIE.
  30. *
  31. *
  32. * AUTEUR, DATE DE CREATION:
  33. * -------------------------
  34. *     PASCAL MANIGOT     1ER OCTOBRE 1986
  35. *
  36. * LANGAGE:
  37. * --------
  38. *     ESOPE + FORTRAN77
  39. *
  40. ************************************************************************
  41. *
  42.       IMPLICIT INTEGER(I-N)
  43.       IMPLICIT REAL*8(A-H,O-Z)
  44. -INC PPARAM
  45.  
  46. -INC CCOPTIO
  47. -INC CCGEOME
  48. -INC SMCOORD
  49.  
  50.       INTEGER IP1,IP2
  51.       REAL*8 EPS1
  52.  
  53.       IF (IP1 .EQ. IP2) THEN
  54.          EGA1 = .TRUE.
  55.          RETURN
  56.       END IF
  57.  
  58.       SEGACT,MCOORD
  59.       IDIMP1 = IDIM + 1
  60.  
  61.       ipt1 = (IP1-1)*IDIMP1
  62.       ipt2 = (IP2-1)*IDIMP1
  63.  
  64.       eps_d = EPS1
  65.       IF (eps_d .LT. 0.D0) THEN
  66.          eps_d = (XCOOR(ipt1+IDIMP1) + XCOOR(ipt2+IDIMP1)) / 20.D0
  67.          IF (eps_d .LE. 0.D0) eps_d = DENSIT * 0.1D0
  68.          EPS1 = eps_d 
  69.       END IF
  70.  
  71.       eps_d = eps_d * eps_d
  72.  
  73.       IF      (IDIM .EQ. 3) THEN
  74.          DIST =   (XCOOR(ipt1+1) - XCOOR(ipt2+1))**2
  75.      &          + (XCOOR(ipt1+2) - XCOOR(ipt2+2))**2
  76.      &          + (XCOOR(ipt1+3) - XCOOR(ipt2+3))**2
  77.       ELSE IF (IDIM .EQ. 2) THEN
  78.          DIST =   (XCOOR(ipt1+1) - XCOOR(ipt2+1))**2
  79.      &          + (XCOOR(ipt1+2) - XCOOR(ipt2+2))**2
  80.       ELSE IF (IDIM .EQ. 1) THEN
  81.          DIST =   (XCOOR(ipt1+1) - XCOOR(ipt2+1))**2
  82.       ELSE
  83.          CALL ERREUR(5)
  84.       END IF
  85.  
  86.       EGA1 = DIST .LE. eps_d
  87.  
  88.       END
  89.  
  90.  
  91.  

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