Télécharger ferme.eso

Retour à la liste

Numérotation des lignes :

  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. -INC CCOPTIO
  23. C
  24. C WRITE(IOIMP,1000)
  25. C1000 FORMAT(' SUBROUTINE FERME')
  26. C
  27. IF (NFACET.EQ.0) GOTO 301
  28. DO 90 I=1,NFACET
  29. IFAT(I)=0
  30. IFUT(I)=0
  31. 90 CONTINUE
  32. IFC=1
  33. IFAT(1)=1
  34. IFUT(1)=1
  35. DO 100 I=1,NFACET
  36. IF=IFAT(I)
  37. IF (IF.EQ.0) GOTO 200
  38. DO 110 I1=1,4
  39. J1=NFC(I1,IF)
  40. IF (J1.EQ.0) GOTO 100
  41. J2=ISUCC(IF,J1)
  42. IFJ2=0
  43. DO 120 K=1,40
  44. JF=NPF(K,J1)
  45. IF (JF.EQ.0) GOTO 130
  46. IF (JF.EQ.IF) GOTO 120
  47. IF (ISUCC(JF,J1).EQ.J2) THEN
  48. * RETOURNER JF
  49. IFJ2=1
  50. IF (IFUT(JF).EQ.1) GOTO 200
  51. NBJ=4
  52. IF (NFC(4,JF).EQ.0) NBJ=3
  53. DO 125 I2=1,NBJ/2
  54. NTEMP=NFC(NBJ+1-I2,JF)
  55. NFC(NBJ+1-I2,JF)=NFC(I2,JF)
  56. NFC(I2,JF)=NTEMP
  57. 125 CONTINUE
  58. IFC=IFC+1
  59. IFAT(IFC)=JF
  60. IFUT(JF)=1
  61. ENDIF
  62. IF (IPRED(JF,J1).EQ.J2) THEN
  63. IFJ2=1
  64. IF (IFUT(JF).EQ.1) GOTO 120
  65. IFC=IFC+1
  66. IFAT(IFC)=JF
  67. IFUT(JF)=1
  68. ENDIF
  69. 120 CONTINUE
  70. 130 CONTINUE
  71. IF(IFJ2.EQ.0) GOTO 200
  72. 110 CONTINUE
  73. 100 CONTINUE
  74. IF (IFC.NE.NFACET) GOTO 200
  75. C
  76. FERME=.TRUE.
  77. C VERIFICATION DU SIGNE
  78. VOL=0.D0
  79. DO 300 IF=1,NFACET
  80. I1=NFC(1,IF)
  81. I2=NFC(2,IF)
  82. I3=NFC(3,IF)
  83. VOL=VOL-(XYZ(1,I1)*(XYZ(2,I2)*XYZ(3,I3)-XYZ(3,I2)*XYZ(2,I3))
  84. # + XYZ(2,I1)*(XYZ(3,I2)*XYZ(1,I3)-XYZ(1,I2)*XYZ(3,I3))
  85. # + XYZ(3,I1)*(XYZ(1,I2)*XYZ(2,I3)-XYZ(2,I2)*XYZ(1,I3)))
  86. I4=NFC(4,IF)
  87. IF (I4.EQ.0) GOTO 300
  88. VOL=VOL-(XYZ(1,I3)*(XYZ(2,I4)*XYZ(3,I1)-XYZ(3,I4)*XYZ(2,I1))
  89. # + XYZ(2,I3)*(XYZ(3,I4)*XYZ(1,I1)-XYZ(1,I4)*XYZ(3,I1))
  90. # + XYZ(3,I3)*(XYZ(1,I4)*XYZ(2,I1)-XYZ(2,I4)*XYZ(1,I1)))
  91. 300 CONTINUE
  92. 301 CONTINUE
  93. FERME=.TRUE.
  94. IF (VOL.LT.0.D0) GOTO 220
  95. GOTO 400
  96. C
  97. 200 FERME=.FALSE.
  98. IF (IVERB.EQ.1) WRITE(IOIMP,1010)J1,J2,IF,JF
  99. 1010 FORMAT(' PROBLEME FERME ARETE ',2I5,' FACETTES ',2I5)
  100. C
  101. RETURN
  102. 220 CONTINUE
  103. * TOUT RETOURNER
  104. DO 310 JF=1,NFACET
  105. NBJ=4
  106. IF (NFC(4,JF).EQ.0) NBJ=3
  107. DO 320 I2=1,NBJ/2
  108. NTEMP=NFC(NBJ+1-I2,JF)
  109. NFC(NBJ+1-I2,JF)=NFC(I2,JF)
  110. NFC(I2,JF)=NTEMP
  111. 320 CONTINUE
  112. 310 CONTINUE
  113. 400 CONTINUE
  114. * REMETTRE IFAT A ZERO
  115. DO 401 I=1,NFACET
  116. IFAT(I)=I
  117. IFUT(I)=I
  118. 401 CONTINUE
  119. RETURN
  120. END
  121.  
  122.  
  123.  
  124.  
  125.  
  126.  
  127.  
  128.  
  129.  

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