Esope source files

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