C ENVORI    SOURCE    GOUNAND   16/08/01    21:15:15     9043           
C
      SUBROUTINE ENVORI(IFAC3,IFAC4,IFAC6,IFAC8,NFACE,XCENT,IEL)
C
C     ORIente les faces avant de fabriquer l ENVeloppe
c     appelé par ENVVOL
c     on suppose 1 seule entrée parmi IFAC3,IFAC4,IFAC6,IFAC8 non nulle
c
c creation : BP, le 12/12/2011
c modifs   : SG, le 21/03/2016 erreur dans la reorientation des faces
c            quadratiques
c

      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)

-INC PPARAM
-INC CCOPTIO
-INC CCREEL
-INC SMCOORD

      REAL*8    nvG,nvn
      SEGMENT IFAC3(4,NFAC3)
      SEGMENT IFAC4(5,NFAC4)
      SEGMENT IFAC6(7,NFAC6)
      SEGMENT IFAC8(9,NFAC8)
c     avec  IFACE(1 a NBNN,n ieme face) = noeuds de la n ieme face
c     avec  IFACE(NBNN1=NBNN+1,n ieme face) = couleur de la n ieme face
      SEGMENT XCENT(3,NBELEM)
      IDIM1 = IDIM+1

c==== preliminaires ===================================================
c     numero de quelques noeuds utiles pour cette face
c     EN FONCTION DE L ENTREE
      if(IFAC3.ne.0) goto 103
      if(IFAC4.ne.0) goto 104
      if(IFAC6.ne.0) goto 106
      if(IFAC8.ne.0) goto 108
 103  continue
        ip1 = IFAC3(1,NFACE)
        ip2 = IFAC3(2,NFACE)
        ip4 = IFAC3(3,NFACE)
        goto 199
 104  continue
        ip1 = IFAC4(1,NFACE)
        ip2 = IFAC4(2,NFACE)
        ip4 = IFAC4(4,NFACE)
        goto 199
 106  continue
        ip1 = IFAC6(1,NFACE)
        ip2 = IFAC6(3,NFACE)
        ip4 = IFAC6(5,NFACE)
        goto 199
 108  continue
        ip1 = IFAC8(1,NFACE)
        ip2 = IFAC8(3,NFACE)
        ip4 = IFAC8(7,NFACE)
        goto 199
 199  continue

c     coordonnees du 1er noeud de la face
      x1 = XCOOR((ip1-1)*IDIM1+1)
      y1 = XCOOR((ip1-1)*IDIM1+2)
      z1 = XCOOR((ip1-1)*IDIM1+3)
c       write(6,*) 'x1,y1,z1=',x1,y1,z1


c==== calcul de vG = de 1 vers G=centre de l element ==================
      vGx = XCENT(1,iel) - x1
      vGy = XCENT(2,iel) - y1
      vGz = XCENT(3,iel) - z1
c       write(6,*) 'vGx,vGy,vGz=',vGx,vGy,vGz
c     norme
      nvG = sqrt(vGx*vGx + vGy*vGy + vGz*vGz)
      if (nvG.le.0.D0) then
*sg  345 2
*sg Element coque degenere. Impossible de definir sa normale
        write(6,*) ' vecteur du noeud ',ip1,' vers le centre ',
     &             'de l element ',IEL, ' indeterminable !'
        write(6,*) ' orientation de l enveloppe impossible ! '
        CALL ERREUR(345)
        return
      endif


c==== calcul de vn = normale a la face ================================
      v12x = XCOOR((ip2-1)*IDIM1+1) - x1
      v12y = XCOOR((ip2-1)*IDIM1+2) - y1
      v12z = XCOOR((ip2-1)*IDIM1+3) - z1
      v14x = XCOOR((ip4-1)*IDIM1+1) - x1
      v14y = XCOOR((ip4-1)*IDIM1+2) - y1
      v14z = XCOOR((ip4-1)*IDIM1+3) - z1
      vnx  = v12y*v14z - v12z*v14y
      vny  = v12z*v14x - v12x*v14z
      vnz  = v12x*v14y - v12y*v14x
c       write(6,*) 'vn=',vnx,vny,vnz
c     norme
      nvn = sqrt(vnx*vnx + vny*vny + vnz*vnz)
      if (nvn.le.0D0) then
        write(6,*) ' vecteur normal a la face ',NFACE,
     &             'de l element ',IEL, ' indeterminable !'
        write(6,*) ' orientation de l enveloppe impossible ! '
        CALL ERREUR(345)
        return
      endif


c==== calcul de vn*vG : si >0 => face dirigee vers l interieur ========
      psc1 = vnx*vGx + vny*vGy + vnz*vGz
      psc1 = psc1 / (nvG*nvn)

c     il faut inverser le sens de description de la face
      if (psc1.lt.0.D0) then
c       EN FONCTION DE L ENTREE
        if(IFAC3.ne.0) goto 603
        if(IFAC4.ne.0) goto 604
        if(IFAC6.ne.0) goto 606
        if(IFAC8.ne.0) goto 608
 603    continue
           itmp1 = IFAC3(1,NFACE)
           IFAC3(1,NFACE) = IFAC3(3,NFACE)
           IFAC3(3,NFACE) = itmp1
         goto 699
 604    continue
         do i1 = 1,2
           i2 = 5-i1
           itmp1 = IFAC4(i1,NFACE)
           IFAC4(i1,NFACE) = IFAC4(i2,NFACE)
           IFAC4(i2,NFACE) = itmp1
         enddo
         goto 699
 606    continue
         do i1 = 1,2
           i2 = 6-i1
           itmp1 = IFAC6(i1,NFACE)
           IFAC6(i1,NFACE) = IFAC6(i2,NFACE)
           IFAC6(i2,NFACE) = itmp1
         enddo
         goto 699
 608    continue
         do i1 = 1,3
           i2 = 8-i1
           itmp1 = IFAC8(i1,NFACE)
           IFAC8(i1,NFACE) = IFAC8(i2,NFACE)
           IFAC8(i2,NFACE) = itmp1
         enddo
         goto 699
 699    continue
      endif


      RETURN
      END