src/tool/Utilitaire/utb3f2.h

   1 c
   2 c 2.3.4. ==> face f1 : plan (s1,s2,s5)
   3 c            prmito est le produit mixte de la pyramide totale.
   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,s5) 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                 v52(1) = v2(1)-v5(1)
  24                 v52(2) = v2(2)-v5(2)
  25                 v52(3) = v2(3)-v5(3)
  26 c
  27                 v51(1) = v1(1)-v5(1)
  28                 v51(2) = v1(2)-v5(2)
  29                 v51(3) = v1(3)-v5(3)
  30 c
  31                 v54(1) = v4(1)-v5(1)
  32                 v54(2) = v4(2)-v5(2)
  33                 v54(3) = v4(3)-v5(3)
  34 c
  35 c         v0(1,.) represente le produit vectoriel s5s2 x s5s1.
  36 c
  37                 v0(1,1) = v52(2)*v51(3) - v52(3)*v51(2)
  38                 v0(1,2) = v52(3)*v51(1) - v52(1)*v51(3)
  39                 v0(1,3) = v52(1)*v51(2) - v52(2)*v51(1)
  40 c
  41 c         prmito est le produit mixte (s5s2,s5s1,s5s4)
  42 c
  43                 prmito = v0(1,1)*v54(1)
  44      >                 + v0(1,2)*v54(2)
  45      >                 + v0(1,3)*v54(3)
  46 c
  47 #ifdef _DEBUG_HOMARD_
  48         if ( glop.ne.0 ) then
  49         write (ulsort,*) '.... v52', v52(1),v52(2),v52(3)
  50         write (ulsort,*) '.... v51', v51(1),v51(2),v51(3)
  51         write (ulsort,*) '.... v54', v54(1),v54(2),v54(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
  57 c         si le produit mixte est nul, c'est que le volume est nul
  58 c         on ne controle donc rien
  59 c
  60                 if ( prmito.le.daux1 ) then
  61                   goto 20
  62                 endif
  63 c
  64                 logaux(1) = .false.
  65 c
  66               endif
  67 c
  68               v5n(1) = vn(1)-v5(1)
  69               v5n(2) = vn(2)-v5(2)
  70               v5n(3) = vn(3)-v5(3)
  71 c
  72 c         prmilo est le produit mixte (s5s2,s5s1,s5sn)
  73 c
  74               prmilo = v0(1,1)*v5n(1)
  75      >               + v0(1,2)*v5n(2)
  76      >               + v0(1,3)*v5n(3)
  77 #ifdef _DEBUG_HOMARD_
  78         if ( glop.ne.0 ) then
  79 c        write (ulsort,*) '....     v5n =',v5n
  80         write (ulsort,*) '....  f1 prmilo =', prmilo
  81         endif
  82 #endif
  83 c
  84 cgn      call gtfims (94)
  85               if ( prmito*prmilo.lt.daux1 ) then
  86                 logaux(7) = .false.
  87               endif
  88 c
  89             endif
  90 c
  91 c 2.3.4. ==> idem pour la face f2 : plan (s2,s3,s5)
  92 cgn      call gtdems (95)
  93 c
  94             if ( logaux(7) ) then
  95 c
  96               if ( logaux(2) ) then
  97 c
  98                 v53(1) = v3(1)-v5(1)
  99                 v53(2) = v3(2)-v5(2)
 100                 v53(3) = v3(3)-v5(3)
 101 c
 102 c         v0(2,.) est le produit vectoriel s5s3 x s5s2
 103 c
 104                 v0(2,1) = v53(2)*v52(3) - v53(3)*v52(2)
 105                 v0(2,2) = v53(3)*v52(1) - v53(1)*v52(3)
 106                 v0(2,3) = v53(1)*v52(2) - v53(2)*v52(1)
 107 c
 108 c         prmito est le produit mixte (s5s3,s5s2,s5s4)
 109 c         vu la definition des 5 sommets de la pyramide, c'est la
 110 c         meme valeur que le produit mixte (s5s2,s5s1,s5s4)
 111 c
 112                 logaux(2) = .false.
 113 c
 114               endif
 115 c
 116 c         prmilo est le produit mixte (s5s3,s5s2,s5sn)
 117 c
 118               prmilo = v0(2,1)*v5n(1)
 119      >               + v0(2,2)*v5n(2)
 120      >               + v0(2,3)*v5n(3)
 121 #ifdef _DEBUG_HOMARD_
 122         if ( glop.ne.0 ) then
 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.5. ==> idem pour la face f3 : plan (s3,s4,s5)
 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 s5s4 x s5s3
 142 c
 143                 v0(3,1) = v54(2)*v53(3) - v54(3)*v53(2)
 144                 v0(3,2) = v54(3)*v53(1) - v54(1)*v53(3)
 145                 v0(3,3) = v54(1)*v53(2) - v54(2)*v53(1)
 146 c
 147 c         prmito est le produit mixte (s5s3,s5s2,s5s4)
 148 c                                   = (s5s4,s5s3,s5s2)
 149 c
 150                 logaux(3) = .false.
 151 c
 152               endif
 153 c
 154 c         prmilo est le produit mixte (s5s4,s5s3,s5sn)
 155 c
 156               prmilo = v0(3,1)*v5n(1)
 157      >               + v0(3,2)*v5n(2)
 158      >               + v0(3,3)*v5n(3)
 159 #ifdef _DEBUG_HOMARD_
 160         if ( glop.ne.0 ) then
 161         write (ulsort,*) '....  f3 prmilo =', prmilo
 162         endif
 163 #endif
 164 c
 165 cgn      call gtfims (96)
 166               if ( prmito*prmilo.lt.daux1 ) then
 167                 logaux(7) = .false.
 168               endif
 169 c
 170             endif
 171 c
 172 c 2.3.6. ==> idem pour la face f4 : plan (s1,s4,s5)
 173 cgn      call gtdems (97)
 174 c
 175             if ( logaux(7) ) then
 176 c
 177               if ( logaux(4) ) then
 178 c
 179 c         v0(4,.) est le produit vectoriel s5s1 x s5s4
 180 c
 181                 v0(4,1) = v51(2)*v54(3) - v51(3)*v54(2)
 182                 v0(4,2) = v51(3)*v54(1) - v51(1)*v54(3)
 183                 v0(4,3) = v51(1)*v54(2) - v51(2)*v54(1)
 184 c
 185 c         prmito est le produit mixte (s5s2,s5s1,s5s4)
 186 c                                   = (s5s1,s5s4,s5s2)
 187 c
 188                 logaux(4) = .false.
 189 c
 190               endif
 191 c
 192 c         prmilo est le produit mixte (s5s1,s5s4,s5sn)
 193 c
 194               prmilo = v0(4,1)*v5n(1)
 195      >               + v0(4,2)*v5n(2)
 196      >               + v0(4,3)*v5n(3)
 197 #ifdef _DEBUG_HOMARD_
 198         if ( glop.ne.0 ) then
 199         write (ulsort,*) '....  f4 prmilo =', prmilo
 200         endif
 201 #endif
 202 c
 203 cgn      call gtfims (97)
 204               if ( prmito*prmilo.lt.daux1 ) then
 205                 logaux(7) = .false.
 206               endif
 207 c
 208             endif
 209 c
 210 c 2.3.7. ==> idem pour la face f5 : plan (s1,s2,s3,s4)
 211 cgn      call gtdems (98)
 212 c
 213             if ( logaux(7) ) then
 214 c
 215               if ( logaux(5) ) then
 216 c
 217                 v12(1) = v2(1)-v1(1)
 218                 v12(2) = v2(2)-v1(2)
 219                 v12(3) = v2(3)-v1(3)
 220 c
 221                 v14(1) = v4(1)-v1(1)
 222                 v14(2) = v4(2)-v1(2)
 223                 v14(3) = v4(3)-v1(3)
 224 c
 225 c         v0(5,.) est le produit vectoriel s1s2 x s1s4
 226 c
 227                 v0(5,1) = v12(2)*v14(3) - v12(3)*v14(2)
 228                 v0(5,2) = v12(3)*v14(1) - v12(1)*v14(3)
 229                 v0(5,3) = v12(1)*v14(2) - v12(2)*v14(1)
 230 c
 231 c         prmito est le produit mixte (s1s2,s1s4,s1s5)
 232 c         vu la definition des 5 sommets de la pyramide, c'est la
 233 c         meme valeur que le produit mixte (s5s2,s5s1,s5s4)
 234 c
 235                 logaux(5) = .false.
 236 c
 237               endif
 238 c
 239 c         prmilo est le produit mixte (s1s2,s1s4,s1sn)
 240 c
 241               prmilo = v0(5,1)*(vn(1)-v1(1))
 242      >               + v0(5,2)*(vn(2)-v1(2))
 243      >               + v0(5,3)*(vn(3)-v1(3))
 244 #ifdef _DEBUG_HOMARD_
 245         if ( glop.ne.0 ) then
 246 c        write (ulsort,*) '....     vn-v1 =',(vn(iaux)-v1(iaux),iaux=1,3)
 247         write (ulsort,*) '....  f5 prmilo =', prmilo
 248         endif
 249 #endif
 250 c
 251 cgn      call gtfims (98)
 252               if ( prmito*prmilo.lt.daux1 ) then
 253                 logaux(7) = .false.
 254               endif
 255 c
 256             endif