Télécharger facet2.eso

Retour à la liste

Numérotation des lignes :

  1. C FACET2 SOURCE JC220346 16/11/29 21:15:15 9221
  2. C---------------------------------------------------------------------|
  3. C |
  4. LOGICAL FUNCTION FACET2(JF)
  5. C |
  6. C CETTE FONCTION LOGIQUE INDIQUE SI LA FACETTE JF EST VALIDE. |
  7. C -+- ON TESTE L'INTERSECTION DE LA FACETTE AVEC LES FACETTES |
  8. C ENVIRONNANTES. |
  9. C ON TESTE AUSSI QU'AUCUNE ARETE N'EST DIAGONALE D'UN |
  10. C FACETTE QUADRANGULAIRE |
  11. C ON VERIFIE QU'ELLE EST DISTANTE DES FACETTES ENVIRONNANTES |
  12. C |
  13. C---------------------------------------------------------------------|
  14. C
  15. IMPLICIT INTEGER(I-N)
  16. IMPLICIT REAL*8(A-H,O-Z)
  17. -INC TDEMAIT
  18. -INC CCOPTIO
  19. LOGICAL INTER,DROIT,DIAGO
  20. C
  21. FACET2=.TRUE.
  22. C
  23. * NE FAIRE LES TESTS QUE SI LA FACETTE EST NOUVELLE
  24. IF=0
  25. DO 50 I=1,NFACET
  26. IF=IFUT(I)
  27. IF (IF.EQ.JF) GOTO 60
  28. 50 CONTINUE
  29. RETURN
  30. 60 CONTINUE
  31. *
  32. I1=NFC(1,JF)
  33. I2=NFC(2,JF)
  34. I3=NFC(3,JF)
  35. I4=NFC(4,JF)
  36. IF (DIAGO(I1,I2,0.95d0)) GOTO 500
  37. IF (DIAGO(I2,I3,0.95d0)) GOTO 500
  38. IF (I4.EQ.0) THEN
  39. IF (DIAGO(I3,I1,0.95d0)) GOTO 500
  40. ELSE
  41. IF (DIAGO(I3,I4,0.95d0)) GOTO 500
  42. IF (DIAGO(I4,I1,0.95d0)) GOTO 500
  43. ENDIF
  44. C
  45. C TEST DE L'INTERSECTION DE LA FACETTE JF AVEC LES FACETTES ENVIRON
  46. C -----------------------------------------------------------------
  47. C
  48. 105 CONTINUE
  49. C
  50. * DO 110 I=1,NFACET
  51. * IF=IFUT(I)
  52. * IF (IF.EQ.JF) GOTO 110
  53. * J1=NFC(1,IF)
  54. * J2=NFC(2,IF)
  55. * J3=NFC(3,IF)
  56. * J4=NFC(4,IF)
  57. * IF (INTER(I1,I2,I3,J1,J2,J3,XYZ(1,1))) GOTO 500
  58. * IF (I4.NE.0) THEN
  59. * IF (INTER(I3,I4,I1,J1,J2,J3,XYZ(1,1))) GOTO 500
  60. * ENDIF
  61. * IF (J4.NE.0) THEN
  62. * IF(INTER(I1,I2,I3,J3,J4,J1,XYZ(1,1))) GOTO 500
  63. * IF (I4.EQ.0) GOTO 110
  64. * IF(INTER(I3,I4,I1,J3,J4,J1,XYZ(1,1))) GOTO 500
  65. * ENDIF
  66. *110 CONTINUE
  67. C
  68. C
  69. C FACET2=FALSE SI LA NOUVELLE FACETTE EST MAUVAISE
  70. C FACET2=TRUE SI LA NOUVELLE FACETTE EST BONNE
  71. C
  72. FACET2=.TRUE.
  73. RETURN
  74. 500 FACET2=.FALSE.
  75. * WRITE(6,2000)
  76. 2000 FORMAT(' FACET2 DESTRUCTION DE L',1H','ELEMENT')
  77. RETURN
  78. C
  79. END
  80.  
  81.  
  82.  
  83.  
  84.  

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