Télécharger la plaquette Cast3M


fr en

Télécharger envori.eso

Retour à la liste

Numérotation des lignes : 

envori

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

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