src/tool/Utilitaire/utb3g2.h

   1 c
   2 c 2.3.4. ==> face f1 : plan (s1,s2,s3)
   3 c            prmito est le produit mixte du triedre base sur s1
   4 c            prmilo est le produit mixte pointant sur le noeud a tester.
   5 c            il faut que prmito et prmilo soient de meme signe pour que
   6 c            le noeud soit du meme cote du plan (s1,s2,s3) que s4.
   7 c            on teste le caractere strictement positif du produit
   8 c            prmito x prmilo, pour pouvoir pieger les cas ou le
   9 c            noeud est sur une face.
  10 cgn      call gtdems (94)
  11 c
  12             if ( logaux(7) ) then
  13 #ifdef _DEBUG_HOMARD_
  14         if ( glop.ne.0 ) then
  15         write (ulsort,*) '.... ', mess14(langue,2,-1), lenoeu
  16         endif
  17 #endif
  18 c
  19               daux1 = 0.d0
  20 c
  21               if ( logaux(1) ) then
  22 c
  23                 v12(1) = v2(1)-v1(1)
  24                 v12(2) = v2(2)-v1(2)
  25                 v12(3) = v2(3)-v1(3)
  26 c
  27                 v13(1) = v3(1)-v1(1)
  28                 v13(2) = v3(2)-v1(2)
  29                 v13(3) = v3(3)-v1(3)
  30 c
  31                 v14(1) = v4(1)-v1(1)
  32                 v14(2) = v4(2)-v1(2)
  33                 v14(3) = v4(3)-v1(3)
  34 c
  35 c         v0(1,.) est le produit vectoriel s1s2 x s1s3.
  36 c
  37                 v0(1,1) = v12(2)*v13(3) - v12(3)*v13(2)
  38                 v0(1,2) = v12(3)*v13(1) - v12(1)*v13(3)
  39                 v0(1,3) = v12(1)*v13(2) - v12(2)*v13(1)
  40 c
  41 c         prmito est le produit mixte (s1s2,s1s3,s1s4)
  42 c
  43                 prmito = v0(1,1)*v14(1)
  44      >                 + v0(1,2)*v14(2)
  45      >                 + v0(1,3)*v14(3)
  46 c
  47 #ifdef _DEBUG_HOMARD_
  48         if ( glop.ne.0 ) then
  49         write (ulsort,*) '.... v12', v12(1),v12(2),v12(3)
  50         write (ulsort,*) '.... v14', v14(1),v14(2),v14(3)
  51         write (ulsort,*) '.... v13', v13(1),v13(2),v13(3)
  52         write (ulsort,*) '.... v0(1,.)', v0(1,1),v0(1,2),v0(1,3)
  53         write (ulsort,*) '.... ==> prmito =', prmito
  54         endif
  55 #endif
  56 c         si le produit mixte est nul, c'est que le volume est nul
  57 c         on ne controle donc rien
  58 c
  59                 if ( prmito.le.daux1 ) then
  60                   goto 20
  61                 endif
  62 c
  63                 logaux(1) = .false.
  64 c
  65               endif
  66 c
  67 c         prmilo est le produit mixte (s1s2,s1s3,s1sn)
  68 c
  69               prmilo = v0(1,1)*(vn(1)-v1(1))
  70      >               + v0(1,2)*(vn(2)-v1(2))
  71      >               + v0(1,3)*(vn(3)-v1(3))
  72 #ifdef _DEBUG_HOMARD_
  73         if ( glop.ne.0 ) then
  74 c        write (ulsort,*) '....    vn-v1 =',(vn(iaux)-v1(iaux),iaux=1,3)
  75         write (ulsort,*) '....  f1 prmilo =', prmilo
  76         endif
  77 #endif
  78 c
  79 cgn      call gtfims (94)
  80               if ( prmito*prmilo.lt.daux1 ) then
  81                 logaux(7) = .false.
  82               endif
  83 c
  84             endif
  85 c
  86 c 2.3.5. ==> idem pour la face f2 : plan (s4,s5,s6)
  87 cgn      call gtdems (95)
  88 c
  89             if ( logaux(7) ) then
  90 c
  91               if ( logaux(2) ) then
  92 c
  93                 v54(1) = v4(1)-v5(1)
  94                 v54(2) = v4(2)-v5(2)
  95                 v54(3) = v4(3)-v5(3)
  96 c
  97                 v56(1) = v6(1)-v5(1)
  98                 v56(2) = v6(2)-v5(2)
  99                 v56(3) = v6(3)-v5(3)
 100 c
 101 c         v0(2,.) est le produit vectoriel s5s4 x s5s6
 102 c
 103                 v0(2,1) = v54(2)*v56(3) - v54(3)*v56(2)
 104                 v0(2,2) = v54(3)*v56(1) - v54(1)*v56(3)
 105                 v0(2,3) = v54(1)*v56(2) - v54(2)*v56(1)
 106 c
 107 c         prmito a ete calcule comme le produit mixte (s1s2,s1s3,s1s4)
 108 c         vu la definition des 6 sommets du pentaedre, c'est la
 109 c         meme valeur que le produit mixte (s5s4,s5s6,s5s2)
 110 c
 111                 logaux(2) = .false.
 112 c
 113               endif
 114 c
 115 c         prmilo est le produit mixte (s5s4,s5s6,s5sn)
 116 c
 117               prmilo = v0(2,1)*(vn(1)-v5(1))
 118      >               + v0(2,2)*(vn(2)-v5(2))
 119      >               + v0(2,3)*(vn(3)-v5(3))
 120 #ifdef _DEBUG_HOMARD_
 121         if ( glop.ne.0 ) then
 122 c        write (ulsort,*) '....     vn-v5 =',(vn(iaux)-v5(iaux),iaux=1,3)
 123         write (ulsort,*) '....  f2 prmilo =', prmilo
 124         endif
 125 #endif
 126 c
 127 cgn      call gtfims (95)
 128               if ( prmito*prmilo.lt.daux1 ) then
 129                 logaux(7) = .false.
 130               endif
 131 c
 132             endif
 133 c
 134 c 2.3.6. ==> idem pour la face f3 : plan (s1,s3,s6,s4)
 135 cgn      call gtdems (96)
 136 c
 137             if ( logaux(7) ) then
 138 c
 139               if ( logaux(3) ) then
 140 c
 141 c         v0(3,.) est le produit vectoriel s1s3 x s1s4
 142 c
 143                 v0(3,1) = v13(2)*v14(3) - v13(3)*v14(2)
 144                 v0(3,2) = v13(3)*v14(1) - v13(1)*v14(3)
 145                 v0(3,3) = v13(1)*v14(2) - v13(2)*v14(1)
 146 c
 147 c         prmito est le produit mixte (s1s2,s1s3,s1s4)
 148 c                                   = (s1s3,s1s4,s1s2)
 149 c
 150                 logaux(3) = .false.
 151 c
 152               endif
 153 c
 154 c         prmilo est le produit mixte (s1s3,s1s4,s1sn)
 155 c
 156               prmilo = v0(3,1)*(vn(1)-v1(1))
 157      >               + v0(3,2)*(vn(2)-v1(2))
 158      >               + v0(3,3)*(vn(3)-v1(3))
 159 #ifdef _DEBUG_HOMARD_
 160         if ( glop.ne.0 ) then
 161 c        write (ulsort,*) '....     vn-v1 =',(vn(iaux)-v1(iaux),iaux=1,3)
 162         write (ulsort,*) '....  f3 prmilo =', prmilo
 163         endif
 164 #endif
 165 c
 166 cgn      call gtfims (96)
 167               if ( prmito*prmilo.lt.daux1 ) then
 168                 logaux(7) = .false.
 169               endif
 170 c
 171             endif
 172 c
 173 c 2.3.7. ==> idem pour la face f4 : plan (s1,s2,s5,s4)
 174 cgn      call gtdems (97)
 175 c
 176             if ( logaux(7) ) then
 177 c
 178               if ( logaux(4) ) then
 179 c
 180 c         v0(4,.) est le produit vectoriel s1s4 x s1s2
 181 c
 182                 v0(4,1) = v14(2)*v12(3) - v14(3)*v12(2)
 183                 v0(4,2) = v14(3)*v12(1) - v14(1)*v12(3)
 184                 v0(4,3) = v14(1)*v12(2) - v14(2)*v12(1)
 185 c
 186 c         prmito est le produit mixte (s1s2,s1s3,s1s4)
 187 c                                   = (s1s4,s1s2,s1s3)
 188 c
 189                 logaux(4) = .false.
 190 c
 191               endif
 192 c
 193 c         prmilo est le produit mixte (s1s4,s1s2,s1sn)
 194 c
 195               prmilo = v0(4,1)*(vn(1)-v1(1))
 196      >               + v0(4,2)*(vn(2)-v1(2))
 197      >               + v0(4,3)*(vn(3)-v1(3))
 198 #ifdef _DEBUG_HOMARD_
 199         if ( glop.ne.0 ) then
 200 c        write (ulsort,*) '....     vn-v1 =',(vn(iaux)-v1(iaux),iaux=1,3)
 201         write (ulsort,*) '....  f4 prmilo =', prmilo
 202         endif
 203 #endif
 204 c
 205 cgn      call gtfims (97)
 206               if ( prmito*prmilo.lt.daux1 ) then
 207                 logaux(7) = .false.
 208               endif
 209 c
 210             endif
 211 c
 212 c 2.3.8. ==> idem pour la face f5 : plan (s2,s3,s6,s5)
 213 cgn      call gtdems (97)
 214 c
 215             if ( logaux(7) ) then
 216 c
 217               if ( logaux(5) ) then
 218 c
 219                 v52(1) = v2(1)-v5(1)
 220                 v52(2) = v2(2)-v5(2)
 221                 v52(3) = v2(3)-v5(3)
 222 c
 223 c         v0(5,.) est le produit vectoriel s5s6 x s5s2
 224 c
 225                 v0(5,1) = v56(2)*v52(3) - v56(3)*v52(2)
 226                 v0(5,2) = v56(3)*v52(1) - v56(1)*v52(3)
 227                 v0(5,3) = v56(1)*v52(2) - v56(2)*v52(1)
 228 c
 229 c         prmito est le produit mixte (s1s2,s1s3,s1s4)
 230 c         vu la definition des 6 sommets du pentaedre, c'est la
 231 c         meme valeur que le produit mixte (s5s4,s5s6,s5s2)
 232 c                                        = (s5s6,s5s2,s5s4)
 233 c
 234                 logaux(5) = .false.
 235 c
 236               endif
 237 c
 238 c         prmilo est le produit mixte (s5s6,s5s2,s5sn)
 239 c
 240               prmilo = v0(5,1)*(vn(1)-v5(1))
 241      >               + v0(5,2)*(vn(2)-v5(2))
 242      >               + v0(5,3)*(vn(3)-v5(3))
 243 #ifdef _DEBUG_HOMARD_
 244         if ( glop.ne.0 ) then
 245 c        write (ulsort,*) '....     vn-v5 =',(vn(iaux)-v5(iaux),iaux=1,3)
 246         write (ulsort,*) '....  f5 prmilo =', prmilo
 247         endif
 248 #endif
 249 c
 250 cgn      call gtfims (97)
 251               if ( prmito*prmilo.lt.daux1 ) then
 252                 logaux(7) = .false.
 253               endif
 254 c
 255             endif