Télécharger envori.eso

Retour à la liste

Numérotation des lignes :

  1. C ENVORI SOURCE GOUNAND 16/08/01 21:15:15 9043
  2. C
  3. SUBROUTINE ENVORI(IFAC3,IFAC4,IFAC6,IFAC8,NFACE,XCENT,IEL)
  4. C
  5. C ORIente les faces avant de fabriquer l ENVeloppe
  6. c appelé par ENVVOL
  7. c on suppose 1 seule entrée parmi IFAC3,IFAC4,IFAC6,IFAC8 non nulle
  8. c
  9. c creation : BP, le 12/12/2011
  10. c modifs : SG, le 21/03/2016 erreur dans la reorientation des faces
  11. c quadratiques
  12. c
  13.  
  14. IMPLICIT INTEGER(I-N)
  15. IMPLICIT REAL*8 (A-H,O-Z)
  16. -INC CCOPTIO
  17. -INC CCREEL
  18. -INC SMCOORD
  19.  
  20. REAL*8 nvG,nvn
  21. SEGMENT IFAC3(4,NFAC3)
  22. SEGMENT IFAC4(5,NFAC4)
  23. SEGMENT IFAC6(7,NFAC6)
  24. SEGMENT IFAC8(9,NFAC8)
  25. c avec IFACE(1 a NBNN,n ieme face) = noeuds de la n ieme face
  26. c avec IFACE(NBNN1=NBNN+1,n ieme face) = couleur de la n ieme face
  27. SEGMENT XCENT(3,NBELEM)
  28. IDIM1 = IDIM+1
  29.  
  30. c==== preliminaires ===================================================
  31. c numero de quelques noeuds utiles pour cette face
  32. c EN FONCTION DE L ENTREE
  33. if(IFAC3.ne.0) goto 103
  34. if(IFAC4.ne.0) goto 104
  35. if(IFAC6.ne.0) goto 106
  36. if(IFAC8.ne.0) goto 108
  37. 103 continue
  38. ip1 = IFAC3(1,NFACE)
  39. ip2 = IFAC3(2,NFACE)
  40. ip4 = IFAC3(3,NFACE)
  41. goto 199
  42. 104 continue
  43. ip1 = IFAC4(1,NFACE)
  44. ip2 = IFAC4(2,NFACE)
  45. ip4 = IFAC4(4,NFACE)
  46. goto 199
  47. 106 continue
  48. ip1 = IFAC6(1,NFACE)
  49. ip2 = IFAC6(3,NFACE)
  50. ip4 = IFAC6(5,NFACE)
  51. goto 199
  52. 108 continue
  53. ip1 = IFAC8(1,NFACE)
  54. ip2 = IFAC8(3,NFACE)
  55. ip4 = IFAC8(7,NFACE)
  56. goto 199
  57. 199 continue
  58.  
  59. c coordonnees du 1er noeud de la face
  60. x1 = XCOOR((ip1-1)*IDIM1+1)
  61. y1 = XCOOR((ip1-1)*IDIM1+2)
  62. z1 = XCOOR((ip1-1)*IDIM1+3)
  63. c write(6,*) 'x1,y1,z1=',x1,y1,z1
  64.  
  65.  
  66. c==== calcul de vG = de 1 vers G=centre de l element ==================
  67. vGx = XCENT(1,iel) - x1
  68. vGy = XCENT(2,iel) - y1
  69. vGz = XCENT(3,iel) - z1
  70. c write(6,*) 'vGx,vGy,vGz=',vGx,vGy,vGz
  71. c norme
  72. nvG = sqrt(vGx*vGx + vGy*vGy + vGz*vGz)
  73. if (nvG.le.0.D0) then
  74. *sg 345 2
  75. *sg Element coque degenere. Impossible de definir sa normale
  76. write(6,*) ' vecteur du noeud ',ip1,' vers le centre ',
  77. & 'de l element ',IEL, ' indeterminable !'
  78. write(6,*) ' orientation de l enveloppe impossible ! '
  79. CALL ERREUR(345)
  80. return
  81. endif
  82.  
  83.  
  84. c==== calcul de vn = normale a la face ================================
  85. v12x = XCOOR((ip2-1)*IDIM1+1) - x1
  86. v12y = XCOOR((ip2-1)*IDIM1+2) - y1
  87. v12z = XCOOR((ip2-1)*IDIM1+3) - z1
  88. v14x = XCOOR((ip4-1)*IDIM1+1) - x1
  89. v14y = XCOOR((ip4-1)*IDIM1+2) - y1
  90. v14z = XCOOR((ip4-1)*IDIM1+3) - z1
  91. vnx = v12y*v14z - v12z*v14y
  92. vny = v12z*v14x - v12x*v14z
  93. vnz = v12x*v14y - v12y*v14x
  94. c write(6,*) 'vn=',vnx,vny,vnz
  95. c norme
  96. nvn = sqrt(vnx*vnx + vny*vny + vnz*vnz)
  97. if (nvn.le.0D0) then
  98. write(6,*) ' vecteur normal a la face ',NFACE,
  99. & 'de l element ',IEL, ' indeterminable !'
  100. write(6,*) ' orientation de l enveloppe impossible ! '
  101. CALL ERREUR(345)
  102. return
  103. endif
  104.  
  105.  
  106. c==== calcul de vn*vG : si >0 => face dirigee vers l interieur ========
  107. psc1 = vnx*vGx + vny*vGy + vnz*vGz
  108. psc1 = psc1 / (nvG*nvn)
  109.  
  110. c il faut inverser le sens de description de la face
  111. if (psc1.lt.0.D0) then
  112. c EN FONCTION DE L ENTREE
  113. if(IFAC3.ne.0) goto 603
  114. if(IFAC4.ne.0) goto 604
  115. if(IFAC6.ne.0) goto 606
  116. if(IFAC8.ne.0) goto 608
  117. 603 continue
  118. itmp1 = IFAC3(1,NFACE)
  119. IFAC3(1,NFACE) = IFAC3(3,NFACE)
  120. IFAC3(3,NFACE) = itmp1
  121. goto 699
  122. 604 continue
  123. do i1 = 1,2
  124. i2 = 5-i1
  125. itmp1 = IFAC4(i1,NFACE)
  126. IFAC4(i1,NFACE) = IFAC4(i2,NFACE)
  127. IFAC4(i2,NFACE) = itmp1
  128. enddo
  129. goto 699
  130. 606 continue
  131. do i1 = 1,2
  132. i2 = 6-i1
  133. itmp1 = IFAC6(i1,NFACE)
  134. IFAC6(i1,NFACE) = IFAC6(i2,NFACE)
  135. IFAC6(i2,NFACE) = itmp1
  136. enddo
  137. goto 699
  138. 608 continue
  139. do i1 = 1,3
  140. i2 = 8-i1
  141. itmp1 = IFAC8(i1,NFACE)
  142. IFAC8(i1,NFACE) = IFAC8(i2,NFACE)
  143. IFAC8(i2,NFACE) = itmp1
  144. enddo
  145. goto 699
  146. 699 continue
  147. endif
  148.  
  149.  
  150. RETURN
  151. END
  152.  
  153.  
  154.  
  155.  
  156.  
  157.  
  158.  

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