Télécharger la plaquette Cast3M


fr en

Télécharger ferme.eso

Retour à la liste

Numérotation des lignes : 

ferme

  1. C FERME     SOURCE    JC220346  16/11/29    21:15:16     9221           
  2. C---------------------------------------------------------------------|
  3. C                                                                     |
  4.        LOGICAL FUNCTION FERME(KKK)
  5. C                                                                     |
  6. C      CETTE FONCTION LOGIQUE VERIFIE SI LE MAILLAGE DE SURFACE       |
  7. C      EST FERME.                                                     |
  8. C      ELLE VERIFIE AUSSI LE SIGNE DU VOLUME INTERNE                  |
  9. C                                                                     |
  10. C      FERME EST VRAI SI LE MAILLAGE DE SURFACE EST FERME             |
  11. C                                                                     |
  12. C      FERME EST FAUX SI LE MAILLAGE DE SURFACE EST OUVERT            |
  13. C                                                                     |
  14. C      ELLE TENTE D'ORIENTER LES ELEME,TS TOUS PAREILS                |
  15. C                                                                     |
  16. C                                                                     |
  17. C---------------------------------------------------------------------|
  18. C
  19.       IMPLICIT INTEGER(I-N)
  20.       IMPLICIT REAL*8(A-H,O-Z)
  21. -INC TDEMAIT
  22.  
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. C
  26. C       WRITE(IOIMP,1000)
  27. C1000   FORMAT(' SUBROUTINE FERME')
  28. C
  29.       IF (NFACET.EQ.0) GOTO 301
  30.       DO 90 I=1,NFACET
  31.        IFAT(I)=0
  32.        IFUT(I)=0
  33.   90  CONTINUE
  34.        IFC=1
  35.        IFAT(1)=1
  36.        IFUT(1)=1
  37.        DO 100 I=1,NFACET
  38.         IF=IFAT(I)
  39.         IF (IF.EQ.0) GOTO 200
  40.          DO 110 I1=1,4
  41.           J1=NFC(I1,IF)
  42.                IF (J1.EQ.0) GOTO 100
  43.                  J2=ISUCC(IF,J1)
  44.                  IFJ2=0
  45.                    DO 120 K=1,40
  46.                       JF=NPF(K,J1)
  47.                       IF (JF.EQ.0) GOTO 130
  48.                       IF (JF.EQ.IF) GOTO 120
  49.                       IF (ISUCC(JF,J1).EQ.J2) THEN
  50. *  RETOURNER JF
  51.          IFJ2=1
  52.          IF (IFUT(JF).EQ.1) GOTO 200
  53.          NBJ=4
  54.          IF (NFC(4,JF).EQ.0) NBJ=3
  55.          DO 125 I2=1,NBJ/2
  56.           NTEMP=NFC(NBJ+1-I2,JF)
  57.           NFC(NBJ+1-I2,JF)=NFC(I2,JF)
  58.           NFC(I2,JF)=NTEMP
  59. 125      CONTINUE
  60.               IFC=IFC+1
  61.               IFAT(IFC)=JF
  62.               IFUT(JF)=1
  63.                        ENDIF
  64.            IF (IPRED(JF,J1).EQ.J2) THEN
  65.            IFJ2=1
  66.               IF (IFUT(JF).EQ.1) GOTO 120
  67.               IFC=IFC+1
  68.               IFAT(IFC)=JF
  69.               IFUT(JF)=1
  70.            ENDIF
  71. 120                CONTINUE
  72. 130                CONTINUE
  73.           IF(IFJ2.EQ.0) GOTO 200
  74. 110          CONTINUE
  75. 100    CONTINUE
  76.        IF (IFC.NE.NFACET) GOTO 200
  77. C
  78.        FERME=.TRUE.
  79. C  VERIFICATION DU SIGNE
  80.         VOL=0.D0
  81.          DO 300 IF=1,NFACET
  82.             I1=NFC(1,IF)
  83.             I2=NFC(2,IF)
  84.             I3=NFC(3,IF)
  85.          VOL=VOL-(XYZ(1,I1)*(XYZ(2,I2)*XYZ(3,I3)-XYZ(3,I2)*XYZ(2,I3))
  86.      # +         XYZ(2,I1)*(XYZ(3,I2)*XYZ(1,I3)-XYZ(1,I2)*XYZ(3,I3))
  87.      # +         XYZ(3,I1)*(XYZ(1,I2)*XYZ(2,I3)-XYZ(2,I2)*XYZ(1,I3)))
  88.             I4=NFC(4,IF)
  89.             IF (I4.EQ.0) GOTO 300
  90.          VOL=VOL-(XYZ(1,I3)*(XYZ(2,I4)*XYZ(3,I1)-XYZ(3,I4)*XYZ(2,I1))
  91.      # +         XYZ(2,I3)*(XYZ(3,I4)*XYZ(1,I1)-XYZ(1,I4)*XYZ(3,I1))
  92.      # +         XYZ(3,I3)*(XYZ(1,I4)*XYZ(2,I1)-XYZ(2,I4)*XYZ(1,I1)))
  93. 300    CONTINUE
  94. 301    CONTINUE
  95.        FERME=.TRUE.
  96.        IF (VOL.LT.0.D0) GOTO 220
  97.        GOTO 400
  98. C
  99. 200    FERME=.FALSE.
  100.        IF (IVERB.EQ.1) WRITE(IOIMP,1010)J1,J2,IF,JF
  101. 1010   FORMAT('  PROBLEME FERME ARETE ',2I5,' FACETTES ',2I5)
  102. C
  103.        RETURN
  104. 220    CONTINUE
  105. *  TOUT RETOURNER
  106.        DO 310 JF=1,NFACET
  107.          NBJ=4
  108.          IF (NFC(4,JF).EQ.0) NBJ=3
  109.          DO 320 I2=1,NBJ/2
  110.           NTEMP=NFC(NBJ+1-I2,JF)
  111.           NFC(NBJ+1-I2,JF)=NFC(I2,JF)
  112.           NFC(I2,JF)=NTEMP
  113. 320      CONTINUE
  114. 310      CONTINUE
  115. 400      CONTINUE
  116. *  REMETTRE IFAT A ZERO
  117.        DO 401 I=1,NFACET
  118.         IFAT(I)=I
  119.         IFUT(I)=I
  120.  401   CONTINUE
  121.        RETURN
  122.        END
  123.  
  124.  
  125.  
  126.  
  127.  
  128.  
  129.  
  130.  
  131.  

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