Télécharger la plaquette Cast3M


fr en

Télécharger facet2.eso

Retour à la liste

Numérotation des lignes : 

facet2

  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 PPARAM
  19. -INC CCOPTIO
  20.        LOGICAL INTER,DROIT,DIAGO
  21. C
  22.        FACET2=.TRUE.
  23. C
  24. *  NE FAIRE LES TESTS QUE SI LA FACETTE EST NOUVELLE
  25.        IF=0
  26.        DO 50 I=1,NFACET
  27.          IF=IFUT(I)
  28.           IF (IF.EQ.JF) GOTO 60
  29.   50   CONTINUE
  30.        RETURN
  31.   60   CONTINUE
  32. *
  33.        I1=NFC(1,JF)
  34.        I2=NFC(2,JF)
  35.        I3=NFC(3,JF)
  36.        I4=NFC(4,JF)
  37.           IF (DIAGO(I1,I2,0.95d0)) GOTO 500
  38.           IF (DIAGO(I2,I3,0.95d0)) GOTO 500
  39.       IF (I4.EQ.0) THEN
  40.           IF (DIAGO(I3,I1,0.95d0)) GOTO 500
  41.       ELSE
  42.           IF (DIAGO(I3,I4,0.95d0)) GOTO 500
  43.           IF (DIAGO(I4,I1,0.95d0)) GOTO 500
  44.       ENDIF
  45. C
  46. C      TEST DE L'INTERSECTION DE LA FACETTE JF AVEC LES FACETTES ENVIRON
  47. C      -----------------------------------------------------------------
  48. C
  49. 105    CONTINUE
  50. C
  51. *      DO 110 I=1,NFACET
  52. *        IF=IFUT(I)
  53. *         IF (IF.EQ.JF) GOTO 110
  54. *           J1=NFC(1,IF)
  55. *           J2=NFC(2,IF)
  56. *           J3=NFC(3,IF)
  57. *           J4=NFC(4,IF)
  58. *            IF (INTER(I1,I2,I3,J1,J2,J3,XYZ(1,1))) GOTO 500
  59. *         IF (I4.NE.0) THEN
  60. *            IF (INTER(I3,I4,I1,J1,J2,J3,XYZ(1,1))) GOTO 500
  61. *         ENDIF
  62. *         IF (J4.NE.0) THEN
  63. *            IF(INTER(I1,I2,I3,J3,J4,J1,XYZ(1,1))) GOTO 500
  64. *         IF (I4.EQ.0) GOTO 110
  65. *            IF(INTER(I3,I4,I1,J3,J4,J1,XYZ(1,1))) GOTO 500
  66. *         ENDIF
  67. *110   CONTINUE
  68. C
  69. C
  70. C      FACET2=FALSE SI LA NOUVELLE FACETTE EST MAUVAISE
  71. C      FACET2=TRUE SI LA NOUVELLE FACETTE EST BONNE
  72. C
  73.        FACET2=.TRUE.
  74.        RETURN
  75. 500        FACET2=.FALSE.
  76. *          WRITE(6,2000)
  77. 2000       FORMAT(' FACET2 DESTRUCTION DE L',1H','ELEMENT')
  78.        RETURN
  79. C
  80.        END
  81.  
  82.  
  83.  
  84.  
  85.  

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