Download @FIS_3.procedur

Back to the list

   1 : * @FIS_3    PROCEDUR  CHAT      12/08/07    21:15:02     7481           
   2 : *
   3 : debproc @FIS_3 c*flottant a*flottant lo*flottant
   4 :                  to*flottant ho*flottant eps*flottant
   5 :                  nt*entier nc*entier ns*entier
   6 :                  rc0*flottant rc1*flottant rc2*flottant rc3*flottant
   7 :                  beta*flottant alpha*flottant
   8 :                  ndt*entier nsdt*entier
   9 :                  xl*entier xt*entier xh*entier
  10 :                  d1*mot d2*mot ;
  11 : *
  12 : saut ligne ;
  13 : mess '*****************************************************' ;
  14 : mess '****  PROCEDURE DE MAILLAGE D"UN BLOC FISSURE 3D ****' ;
  15 : mess '*****************************************************' ;
  16 : saut ligne ;
  17 : *
  18 : oeil = -100 -310 200 ;
  19 : *
  20 : * Tests sur les parametres d'entree de la procedure
  21 : * ------------------------------------------------
  22 : *
  23 : si ((a < 0) ou (c < 0) ou (lo < 0) ou (to < 0) ou (ho < 0)
  24 :     ou (rc0 < 0) ou (rc1 < 0) ou (rc2 < 0) ou (rc3 < 0)
  25 :     ou (xl < 0) ou (xt < 0) ou (xh < 0) ou (nt < 0)) ;
  26 :    saut ligne ;
  27 :    mess '================================================== ' ;
  28 :    mess '                 ATTENTION !!!                     ' ;
  29 :    saut ligne ;
  30 :    mess '  Un parametre au moins est negatif ...            ' ;
  31 :    mess '  Tous les parametres doivent etre positifs.       ' ;
  32 :    mess '      -----  VERIFIEZ VOS DONNEES  ----            ' ;
  33 :    saut ligne ;
  34 :    mess '      ------ ON SORT DE LA PROCEDURE -----         ' ;
  35 :    mess '================================================== ' ;
  36 : quit @FIS_3 ;
  37 : finsi ;
  38 : *
  39 : si ((ndt neg 1) et (ndt neg 2)) ;
  40 :    saut ligne ;
  41 :    mess '================================================== ' ;
  42 :    mess '                 ATTENTION !!!                     ' ;
  43 :    saut ligne ;
  44 :    mess '     Le nombre de couronnes de deraffinement       ' ;
  45 :    mess '     des tranches doit etre egal a 1 ou 2          ' ;
  46 :    mess '  ndt =' ndt ;
  47 :    saut ligne ;
  48 :    mess '      ------ ON SORT DE LA PROCEDURE -----         ' ;
  49 :    mess '================================================== ' ;
  50 : quit @FIS_3 ;
  51 : finsi ;
  52 : *
  53 : si ((alpha > 1.) ou (alpha < 0.)) ;
  54 :    saut ligne ;
  55 :    mess '================================================== ' ;
  56 :    mess '                 ATTENTION !!!                     ' ;
  57 :    saut ligne ;
  58 :    mess '     Le parametre imposant l"inclinaison           ' ;
  59 :    mess '     des tranches doit etre compris entre 0 et 1   ' ;
  60 :    mess '     alpha =' alpha ;
  61 :    saut ligne ;
  62 :    mess '      ------ ON SORT DE LA PROCEDURE -----         ' ;
  63 :    mess '================================================== ' ;
  64 : quit @FIS_3 ;
  65 : finsi ;
  66 : *
  67 : si ((beta > 1.) ou (beta < 0.)) ;
  68 :    saut ligne ;
  69 :    mess '================================================== ' ;
  70 :    mess '                 ATTENTION !!!                     ' ;
  71 :    saut ligne ;
  72 :    mess '     Le parametre imposant le decoupage            ' ;
  73 :    mess '     des tranches doit etre compris entre 0 et 1   ' ;
  74 :    mess '     beta =' beta ;
  75 :    saut ligne ;
  76 :    mess '      ------ ON SORT DE LA PROCEDURE -----         ' ;
  77 :    mess '================================================== ' ;
  78 : quit @FIS_3 ;
  79 : finsi ;
  80 : *
  81 : si ((eps > 1.) ou (eps < 0)) ;
  82 :    saut ligne ;
  83 :    mess '================================================== ' ;
  84 :    mess '                 ATTENTION !!!                     ' ;
  85 :    saut ligne ;
  86 :    mess '     Le demi angle d"ouverture de la fissure       ' ;
  87 :    mess '     doit etre compris entre 0 et 1 degre          ' ;
  88 :    mess '     eps =' eps ;
  89 :    saut ligne ;
  90 :    mess '      ------ ON SORT DE LA PROCEDURE -----         ' ;
  91 :    mess '================================================== ' ;
  92 : quit @FIS_3 ;
  93 : finsi ;
  94 : *
  95 : si (lo < c) ;
  96 :    saut ligne ;
  97 :    mess '================================================== ' ;
  98 :    mess '                 ATTENTION !!!                     ' ;
  99 :    saut ligne ;
 100 :    mess '     La longueur du bloc doit etre superieure      ' ;
 101 :    mess '     au demi grand axe                             ' ;
 102 :    mess '     lo =' lo ;
 103 :    mess '     c =' c ;
 104 :    saut ligne ;
 105 :    mess '      ------ ON SORT DE LA PROCEDURE -----         ' ;
 106 :    mess '================================================== ' ;
 107 : quit @FIS_3 ;
 108 : finsi ;
 109 : *
 110 : si ((neg d1 'non') et (neg d1 'oui')) ;
 111 :    saut ligne ;
 112 :    mess '================================================== ' ;
 113 :    mess '                 ATTENTION !!!                     ' ;
 114 :    saut ligne ;
 115 :    mess '  Le mot cle imposant le deplacement des noeuds    ' ;
 116 :    mess '  intermediares du "boudin torique" doit etre egal ' ;
 117 :    mess '  a : oui ou non, en minuscules et entre cotes.    ' ;
 118 :      saut ligne ;
 119 :    mess '      ------ ON SORT DE LA PROCEDURE -----         ' ;
 120 :    mess '================================================== ' ;
 121 : quit @FIS_3 ;
 122 : finsi ;
 123 : *
 124 : si ((neg d2 'non') et (neg d2 'oui')) ;
 125 :    saut ligne ;
 126 :    mess '================================================== ' ;
 127 :    mess '                 ATTENTION !!!                     ' ;
 128 :    saut ligne ;
 129 :    mess '  Le mot cle imposant le maillage rayonnant sur la ' ;
 130 :    mess '  face exterieure au boudin torique doit etre egal ' ;
 131 :    mess '  a : oui ou non, en minuscules et entre cotes.    ' ;
 132 :      saut ligne ;
 133 :    mess '      ------ ON SORT DE LA PROCEDURE -----         ' ;
 134 :    mess '================================================== ' ;
 135 : quit @FIS_3 ;
 136 : finsi ;
 137 : *
 138 : si (nt > 64) ;
 139 :    saut ligne ;
 140 :    mess '================================================== ' ;
 141 :    mess '                 ATTENTION !!!                     ' ;
 142 :    saut ligne ;
 143 :    mess '  Le nombre de tranches doit etre inferieur ou     ' ;
 144 :    mess '  egal a 64                                        ' ;
 145 :    saut ligne ;
 146 :    mess '  VOUS AVEZ UN NOMBRE DE TRANCHES DE' nt           ;
 147 :    saut ligne ;
 148 :    mess '      ------ ON SORT DE LA PROCEDURE -----         ' ;
 149 :    mess '================================================== ' ;
 150 : quit @FIS_3 ;
 151 : finsi ;
 152 : *
 153 : i = 1 ;
 154 : puis = 0 ;
 155 : repe bouc1 6 ;
 156 :  i = i + 1 ;
 157 :  if = flottant i ;
 158 :  ndivf = flottant nt ;
 159 :  deux = ndivf ** (1 / if) ;
 160 :     si (deux ega 2 .001) ;
 161 :        puis = 1 ;
 162 :        quit bouc1 ;
 163 :     finsi ;
 164 : fin bouc1 ;
 165 : *
 166 : si (puis ega 0) ;
 167 :    saut ligne ;
 168 :    mess '================================================== ' ;
 169 :    mess '    ATTENTION !!!  Le nombre de tranches doit etre ' ;
 170 :    mess '                   une puissance de 2              ' ;
 171 :    mess '                                                   ' ;
 172 :    mess '  VOUS AVEZ UN NOMBRE DE TRANCHES DE' nt           ;
 173 :    saut ligne ;
 174 :    mess '      ------ ON SORT DE LA PROCEDURE -----         ' ;
 175 :    mess '================================================== ' ;
 176 :    saut ligne ;
 177 :    quit @FIS_3 ;
 178 : finsi ;
 179 : *
 180 : si ((nsdt neg 2) et (nsdt neg 4)) ;
 181 :    saut ligne ;
 182 :    mess '================================================== ' ;
 183 :    mess '                 ATTENTION !!!                     ' ;
 184 :    saut ligne ;
 185 :    mess '  Le nombre de secteurs des couronnes de           ' ;
 186 :    mess '  deraffinement des tranches doit etre             ' ;
 187 :    mess '  egal a 2 ou 4                                    ' ;
 188 :    saut ligne ;
 189 :    mess '  VOUS AVEZ UN NOMBRE DE SECTEUR (nsdt) DE' nsdt     ;
 190 :    saut ligne ;
 191 :    mess '      ------ ON SORT DE LA PROCEDURE -----         ' ;
 192 :    mess '================================================== ' ;
 193 : quit @FIS_3 ;
 194 : finsi ;
 195 : *
 196 : *----------------------------------------
 197 : * Calcul de la profondeur du bloc initial
 198 : * ---------------------------------------
 199 : bsura = a / c ;
 200 : *
 201 : si (bsura < .15) ;
 202 : * CMODI BK 10/3/95
 203 : *   t = a / .7 ;
 204 :    t = a / .6 ;
 205 : finsi ;
 206 : si (bsura > .15) ;
 207 : * CMODI BK 10/3/95
 208 : *    t = a / .6 ;
 209 :     t = a / .5 ;
 210 : finsi ;
 211 : *
 212 : bsurt = a / t ;
 213 : bsurto = a / to ;
 214 : *
 215 : rallon = 1 ;
 216 : si (bsurto >EG ((1.-1.E-6)*bsurt)) ;
 217 :    t = a / bsurto ;
 218 :    rallon = 0 ;
 219 : finsi ;
 220 : *
 221 : * --------------------------------------
 222 : ns = ns * 4 ;
 223 : nt = nt * 2 ;
 224 : *
 225 : *
 226 :  si ((nt <EG 8) et (ndt ega 2)) ;
 227 :   mess '=========================================================' ;
 228 :   mess '    ATTENTION !!! Vous ne pouvez pas utiliser 2 couronnes' ;
 229 :   mess '                  de deraffinement avec 4 tranches       ' ;
 230 :   mess '=========================================================' ;
 231 :   quit @FIS_3 ;
 232 :  finsi ;
 233 : *
 234 : *
 235 : * maillage 2D de la section du tore dans le plan xoz
 236 : * --------------------------------------------------
 237 : *
 238 : flag_eps = 1 ;
 239 :  si (eps ega 0) ;
 240 :     eps = .1 ;
 241 :     flag_eps = 0 ;
 242 :  finsi ;
 243 : *
 244 : o = 0. 0. 0. ;
 245 : ox = c 0. 0. ;
 246 : coseps = cos eps ;
 247 : sineps = sin eps ;
 248 : crit_cer = rc0 / 1.E4 ;
 249 : p0 = (c - (crit_cer * coseps)) 0.
 250 :      (-1. * crit_cer * sineps) ;
 251 : p1 = (c - (rc0 * coseps)) 0. ( -1. * rc0 * sineps) ;
 252 : angrot = 180. - eps ;
 253 : loxp1 = p0 d nc p1 ;
 254 : nsdemi = ns / 2 ;
 255 : nsquart = ns / 4;
 256 : * demi boudin inferieur
 257 : mbase = loxp1 rota nsdemi angrot ox (c -1. 0.) ;
 258 : * fusion des noeuds situes pres du centre du maillage 2D en etoile
 259 : mbapoi = changer poi1 mbase ;
 260 : confon = mbapoi poin sphe ox p0 (rc0 / 1.E4) ;
 261 : elim confon (rc0 / 1.E4) ;
 262 : mbase = rege mbase ;
 263 : mbase = mbase coul roug ;
 264 : *
 265 : * premiere couronne de transition
 266 : * -------------------------------
 267 : *
 268 : p2 = (c - ((1 + rc1) * rc0 * coseps)) 0.
 269 :      ( -1. * (1 + rc1) * rc0 * sineps) ;
 270 : p3 = (c - ((1 + rc1 + rc2) * rc0 * coseps)) 0.
 271 :      (-1 * (1 + rc1 + rc2) * rc0 * sineps) ;
 272 : lp1p2 = p1 d 1 p2 ;
 273 : q1 = (c + rc0) 0. 0. ;
 274 : q2 = (c + ((1 + rc1) * rc0)) 0. 0. ;
 275 : q3 = (c + ((1 + rc1 + rc2) * rc0)) 0. 0. ;
 276 : undemi = 1./2. ;
 277 : *
 278 : si (nsdt ega 4) ;
 279 :    nbp1bq1b = 8 ;
 280 : sinon ;
 281 :    nbp1bq1b = (4 + nsdemi) / 2 ;
 282 : finsi ;
 283 : *
 284 : xp1b = undemi*( ( 2. * c ) - ( coseps * rc0 * (2. + rc1) )) ;
 285 : yp1b = 0. ;
 286 : zp1b = undemi*( -1. * (2 + rc1) *  rc0 * sineps ) ;
 287 : xq1b = undemi*( ( 2. * c ) + ( (2 + rc1) * rc0 ) ) ;
 288 : yq1b = 0. ;
 289 : zq1b = 0. ;
 290 : p1b  = xp1b yp1b zp1b ;
 291 : q1b  = xq1b yq1b zq1b ;
 292 : opti elem seg3 ;
 293 : lp1p1b  = p1 d 1 p1b ;
 294 : lp1bq1b = p1b cerc nbp1bq1b ox q1b ;
 295 : lp2q2   = p2  cerc 4        ox q2  ;
 296 : lp1q1   = p1  cerc nsdemi   ox q1  ;
 297 : si ( EGA nsdemi 12) ;
 298 :  chp1bq1b = chan lp1bq1b poi1 ;
 299 :  chp1q1   = chan lp1q1   poi1 ;
 300 : *
 301 : * tri de la ligne lp1bq1b
 302 : *
 303 : i = 0 ;
 304 : tab1 = table ;
 305 : tab2 = table ;
 306 : nbval = nbno chp1bq1b ;
 307 : repeter bouc5 nbval ;
 308 :  i = i + 1 ;
 309 :  pcour_c = chp1bq1b poin i ;
 310 :  xp = coor 1 pcour_c ;
 311 :  yp = coor 2 pcour_c ;
 312 :  zp = coor 3 pcour_c ;
 313 :  tab1 . i = xp ;
 314 :  tab2 . i = pcour_c ;
 315 : fin bouc5 ;
 316 : tab2 = @FIS_1 tab1 tab2 ;
 317 : *
 318 : * tri de la ligne lp1q1
 319 : *
 320 : i = 0 ;
 321 : tab3 = table ;
 322 : tab4 = table ;
 323 : nbval = nbno chp1q1 ;
 324 : repeter bouc5 nbval ;
 325 :  i = i + 1 ;
 326 :  pcour_c = chp1q1 poin i ;
 327 :  xp = coor 1 pcour_c ;
 328 :  yp = coor 2 pcour_c ;
 329 :  zp = coor 3 pcour_c ;
 330 :  tab3 . i = xp ;
 331 :  tab4 . i = pcour_c ;
 332 : fin bouc5 ;
 333 : tab4 = @FIS_1 tab3 tab4 ;
 334 : *
 335 : * construction des points milieu interieur couronne
 336 : *
 337 :  lpoin_m = table ;
 338 :  poin_m  = table ;
 339 :  i = 0 ;
 340 :  j = 1 ;
 341 :  opti elem seg3 ;
 342 :  lpoin_m . 1  = chan ( (tab4 . 1  ) d 1 (tab2 . 1  ) ) poi1 ;
 343 :  lpoin_m . 2  = chan ( (tab4 . 3  ) d 1 (tab2 . 3  ) ) poi1 ;
 344 :  lpoin_m . 3  = chan ( (tab4 . 5  ) d 1 (tab2 . 3  ) ) poi1 ;
 345 :  lpoin_m . 4  = chan ( (tab4 . 7  ) d 1 (tab2 . 5  ) ) poi1 ;
 346 :  lpoin_m . 5  = chan ( (tab4 . 9  ) d 1 (tab2 . 7  ) ) poi1 ;
 347 :  lpoin_m . 6  = chan ( (tab4 . 11 ) d 1 (tab2 . 7  ) ) poi1 ;
 348 :  lpoin_m . 7  = chan ( (tab4 . 13 ) d 1 (tab2 . 9  ) ) poi1 ;
 349 :  lpoin_m . 8  = chan ( (tab4 . 15 ) d 1 (tab2 . 11 ) ) poi1 ;
 350 :  lpoin_m . 9  = chan ( (tab4 . 17 ) d 1 (tab2 . 11 ) ) poi1 ;
 351 :  lpoin_m . 10 = chan ( (tab4 . 19 ) d 1 (tab2 . 13 ) ) poi1 ;
 352 :  lpoin_m . 11 = chan ( (tab4 . 21 ) d 1 (tab2 . 15 ) ) poi1 ;
 353 :  lpoin_m . 12 = chan ( (tab4 . 23 ) d 1 (tab2 . 15 ) ) poi1 ;
 354 :  lpoin_m . 13 = chan ( (tab4 . 25 ) d 1 (tab2 . 17 ) ) poi1 ;
 355 : *
 356 : * construction des elements de la couronne
 357 : *
 358 :  opti elem qua8 ;
 359 :  elem1  = manu qua8 (tab4 . 1)  (poin 2 (lpoin_m . 1) )
 360 :                     (tab2 . 1)  (tab2 . 2)
 361 :                     (tab2 . 3)  (poin 2 (lpoin_m . 2) )
 362 :                     (tab4 . 3)  (tab4 . 2) ;
 363 :  elem2  = manu tri6 (tab4 . 3)  (poin 2 (lpoin_m . 2) )
 364 :                     (tab2 . 3)  (poin 2 (lpoin_m . 3) )
 365 :                     (tab4 . 5)  (tab4 . 4) ;
 366 :  elem3  = manu qua8 (tab4 . 5)  (poin 2 (lpoin_m . 3) )
 367 :                     (tab2 . 3)  (tab2 . 4)
 368 :                     (tab2 . 5)  (poin 2 (lpoin_m . 4) )
 369 :                     (tab4 . 7)  (tab4 . 6) ;
 370 : *
 371 :  elem4  = manu qua8 (tab4 . 7)  (poin 2 (lpoin_m . 4) )
 372 :                     (tab2 . 5)  (tab2 . 6)
 373 :                     (tab2 . 7)  (poin 2 (lpoin_m . 5) )
 374 :                     (tab4 . 9)  (tab4 . 8) ;
 375 :  elem5  = manu tri6 (tab4 . 9)  (poin 2 (lpoin_m . 5) )
 376 :                     (tab2 . 7)  (poin 2 (lpoin_m . 6) )
 377 :                     (tab4 . 11) (tab4 . 10) ;
 378 :  elem6  = manu qua8 (tab4 . 11) (poin 2 (lpoin_m . 6) )
 379 :                     (tab2 . 7)  (tab2 . 8)
 380 :                     (tab2 . 9)  (poin 2 (lpoin_m . 7) )
 381 :                     (tab4 . 13) (tab4 . 12) ;
 382 : *
 383 :  elem7  = manu qua8 (tab4 . 13) (poin 2 (lpoin_m . 7) )
 384 :                     (tab2 . 9 ) (tab2 . 10)
 385 :                     (tab2 . 11) (poin 2 (lpoin_m . 8) )
 386 :                     (tab4 . 15) (tab4 . 14) ;
 387 :  elem8  = manu tri6 (tab4 . 15) (poin 2 (lpoin_m . 8) )
 388 :                     (tab2 . 11) (poin 2 (lpoin_m . 9) )
 389 :                     (tab4 . 17) (tab4 . 16) ;
 390 :  elem9  = manu qua8 (tab4 . 17) (poin 2 (lpoin_m . 9) )
 391 :                     (tab2 . 11) (tab2 . 12)
 392 :                     (tab2 . 13) (poin 2 (lpoin_m . 10) )
 393 :                     (tab4 . 19) (tab4 . 18) ;
 394 : *
 395 :  elem10 = manu qua8 (tab4 . 19) (poin 2 (lpoin_m . 10) )
 396 :                     (tab2 . 13) (tab2 . 14 )
 397 :                     (tab2 . 15) (poin 2 (lpoin_m . 11) )
 398 :                     (tab4 . 21) (tab4 . 20) ;
 399 :  elem11 = manu tri6 (tab4 . 21) (poin 2 (lpoin_m . 11) )
 400 :                     (tab2 . 15) (poin 2 (lpoin_m . 12) )
 401 :                     (tab4 . 23) (tab4 . 22 ) ;
 402 :  elem12 = manu qua8 (tab4 . 23) (poin 2 (lpoin_m . 12) )
 403 :                     (tab2 . 15) (tab2 . 16)
 404 :                     (tab2 . 17) (poin 2 (lpoin_m . 13) )
 405 :                     (tab4 . 25) (tab4 . 24) ;
 406 : *
 407 :  mtran11 = elem1  et elem2  et elem3  et
 408 :            elem4  et elem5  et elem6  et
 409 :            elem7  et elem8  et elem9  et
 410 :            elem10 et elem11 et elem12 ;
 411 : elim mtran11 (c / 1.E4) ;
 412 : sinon ;
 413 :  opti elem seg3 ;
 414 :  coutou1 = lp1p1b et lp1bq1b et
 415 :            (q1b d 1 q1) et (inve lp1q1) ;
 416 :  opti elem qua8 ;
 417 : *
 418 : *CMODI BK le 10/5/95
 419 : *
 420 : si ((EGA ns 8) et (EGA nsdt 2)) ;
 421 :  mtran11 =  lp1q1 regler 1 lp1bq1b ;
 422 : sinon ;
 423 :  mtran11 = surf coutou1 plan ;
 424 : finsi ;
 425 : finsi ;
 426 : *
 427 : si (nsdt ega 2) ;
 428 : *
 429 :  opti elem seg3 ;
 430 :  coutou2 = (p1b d 1 p2)  et lp2q2 et
 431 :            (q2  d 1 q1b) et (inve lp1bq1b);
 432 :  opti elem qua8 ;
 433 : si (EGA ns 8) ;
 434 :  mtran12 =  lp2q2 regler 1 lp1bq1b ;
 435 : sinon ;
 436 :  mtran12 = surf coutou2 plan ;
 437 : finsi ;
 438 : *
 439 :  mtran1  = mtran11 et mtran12 ;
 440 : *
 441 : sinon ;
 442 : *
 443 :  mtran1 = mtran11 ;
 444 : *
 445 : finsi ;
 446 : *
 447 :  mtran1 = mtran1 coul bleu ;
 448 :  elim (c / 1.E4) mtran1 mbase ;
 449 :  mgen = mbase et mtran1 ;
 450 : *
 451 : * deuxieme couronne de transition
 452 : *
 453 : *
 454 : p6 = q3 moins (0. 0. ((1 + rc1 + rc2) * rc0)) ;
 455 : p4 = (c - ((1 + rc1 + rc2) * rc0 * coseps)) 0.
 456 :      (-1 * (1 + rc1 + rc2) * rc0 ) ;
 457 : p5 = plus p4 p6  / 2;
 458 : *
 459 : si (nsdt ega 2) ;
 460 : *
 461 :   pasang = (180 - eps) / 4 ;
 462 : *
 463 :   p4b = q2 tour ox (c 1 0) (3 * pasang) ;
 464 :   p5b = q2 tour ox (c 1 0) (2 * pasang) ;
 465 :   p6b = q2 tour ox (c 1 0) (1 * pasang) ;
 466 : *
 467 :   mtran21 alpha_m1 al_max1 sommet11 sommet31 sommet51
 468 :   sommet71
 469 :                            = @FIS_2 p3 p2 p4b p4 ox c a
 470 :                              alpha beta nt 1;
 471 : *
 472 :   mtran22 alpha_m2 al_max2 sommet12 sommet32 sommet52
 473 :   sommet72
 474 :                            = @FIS_2 p4 p4b p5b p5 ox c a
 475 :                              alpha beta nt 1;
 476 : *
 477 :   mtran23 alpha_m3 al_max3 sommet13 sommet33 sommet53
 478 :   sommet73
 479 :                            = @FIS_2 p5 p5b p6b p6 ox c a
 480 :                              alpha beta nt 1;
 481 : *
 482 :   mtran24 alpha_m4 al_max4 sommet14 sommet34 sommet54
 483 :   sommet74
 484 :                            = @FIS_2 p6 p6b q2 q3 ox c a
 485 :                              alpha beta nt 1;
 486 : *
 487 :   al_m_c1 = prog alpha_m1 alpha_m2 alpha_m3 alpha_m4 ;
 488 :   alpha_c1 = mini al_m_c1 ;
 489 : *
 490 :   al_max = prog al_max1 al_max2 al_max3 al_max4 ;
 491 :   almax = maxi al_max ;
 492 : *
 493 :   lref = sommet74 ;
 494 : *
 495 : sinon ;
 496 : *
 497 :   pasang = (180 - eps) / 8 ;
 498 : *
 499 :   p24b  = q1b tour ox (c 1 0) (7 * pasang) ;
 500 :   p4b   = q1b tour ox (c 1 0) (6 * pasang) ;
 501 :   p4b5b = q1b tour ox (c 1 0) (5 * pasang) ;
 502 :   p5b   = q1b tour ox (c 1 0) (4 * pasang) ;
 503 :   p5b6b = q1b tour ox (c 1 0) (3 * pasang) ;
 504 :   p6b   = q1b tour ox (c 1 0) (2 * pasang) ;
 505 :   p6b2  = q1b tour ox (c 1 0) (1 * pasang) ;
 506 : *
 507 : p63 = plus q3 p6 / 2 ;
 508 : p56 = plus p6 p5 / 2 ;
 509 : p45 = plus  p4 p5 / 2 ;
 510 : p34 = plus  p3 p4  / 2;
 511 : *
 512 :   mtran21 alpha_m1 al_max1 sommet11 sommet31 sommet51
 513 :   sommet71
 514 :                            = @FIS_2 p3 p1b p24b p34 ox c a
 515 :                              alpha beta nt 1;
 516 : *
 517 :   mtran22 alpha_m2 al_max2 sommet12 sommet32 sommet52
 518 :   sommet72
 519 :                            = @FIS_2 p34 p24b p4b p4 ox c a
 520 :                              alpha beta nt 1;
 521 : *
 522 :   mtran23 alpha_m3 al_max3 sommet13 sommet33 sommet53
 523 :   sommet73
 524 :                            = @FIS_2 p4 p4b p4b5b p45 ox c a
 525 :                              alpha beta nt 1;
 526 : *
 527 :   mtran24 alpha_m4 al_max4 sommet14 sommet34 sommet54
 528 :   sommet74
 529 :                            = @FIS_2 p45 p4b5b p5b p5 ox c a
 530 :                              alpha beta nt 1;
 531 : *
 532 :   mtran25 alpha_m5 al_max5 sommet15 sommet35 sommet55
 533 :   sommet75
 534 :                            = @FIS_2 p5 p5b p5b6b p56 ox c a
 535 :                              alpha beta nt 1;
 536 : *
 537 :   mtran26 alpha_m6 al_max6 sommet16 sommet36 sommet56
 538 :   sommet76
 539 :                            = @FIS_2 p56 p5b6b p6b p6 ox c a
 540 :                              alpha beta nt 1;
 541 : *
 542 :   mtran27 alpha_m7 al_max7 sommet17 sommet37 sommet57
 543 :   sommet77
 544 :                            = @FIS_2 p6 p6b p6b2 p63 ox c a
 545 :                              alpha beta nt 1;
 546 : *
 547 :   mtran28 alpha_m8 al_max8 sommet18 sommet38 sommet58
 548 :   sommet78
 549 :                            = @FIS_2 p63 p6b2 q1b q3 ox c a
 550 :                              alpha beta nt 1;
 551 : *
 552 :   al_m_c1 = prog alpha_m1 alpha_m2 alpha_m3 alpha_m4
 553 :                  alpha_m5 alpha_m6 alpha_m7 alpha_m8 ;
 554 :   alpha_c1 = mini al_m_c1 ;
 555 : *
 556 :   al_max = prog al_max1 al_max2 al_max3 al_max4
 557 :                 al_max5 al_max6 al_max7 al_max8 ;
 558 :   almax = maxi al_max ;
 559 : *
 560 :   lref = sommet78 ;
 561 : *
 562 : finsi ;
 563 : *
 564 :   saut ligne ;
 565 :   mess '--------------------------------------------------' ;
 566 :   mess 'ANGLE MINI SUR LES PRISMES DE LA PREMIERE COURONNE' ;
 567 :   mess 'DE DERAFFINEMENT DES TRANCHES =' alpha_c1 'DEGRES'  ;
 568 :   saut ligne ;
 569 :   mess '    POUR AUGMENTER CET ANGLE : AUGMENTER "rc2" ' ;
 570 :   mess '                               DIMINUER  "rc0" ' ;
 571 :   saut ligne ;
 572 :   mess '--------------------------------------------------' ;
 573 :   saut ligne ;
 574 : *
 575 : si (almax > 175.) ;
 576 :   mess '----------------------------------------------------' ;
 577 :   mess 'L"ANGLE MAXI SUR LES PRISMES DE LA PREMIERE COURONNE' ;
 578 :   mess 'DE DERAFFINEMENT DES TRANCHES EST TROP GRAND :' almax ;
 579 :   mess 'DEGRES !!!   ERREUR SUR LA GENERATION DU MAILLAGE    ' ;
 580 :   saut ligne ;
 581 :   mess '    POUR DIMINUER CET ANGLE : AUGMENTER "rc2" ' ;
 582 :   mess '                              DIMINUER  "rc0" ' ;
 583 :   saut ligne ;
 584 :   mess '   ATTENTION !!! ---- ON SORT DE LA PROCEDURE ----- ' ;
 585 :   saut ligne ;
 586 :   mess '----------------------------------------------------' ;
 587 :   saut ligne ;
 588 : quit @FIS_3 ;
 589 : finsi ;
 590 : *
 591 : si (nsdt ega 2) ;
 592 :    mtran2 = mtran21 et mtran22 et mtran23 et mtran24 ;
 593 : sinon ;
 594 :    mtran2 = mtran21 et mtran22 et mtran23 et mtran24 et
 595 :             mtran25 et mtran26 et mtran27 et mtran28 ;
 596 : finsi ;
 597 : *
 598 : elim mtran2 (c / 1.E4);
 599 : *
 600 : *
 601 :  si (flag_eps ega 0) ;
 602 : saut ligne ;
 603 : mess '===========================================================' ;
 604 : mess '    ATTENTION !!! Vous ne pouvez pas utiliser un demi-angle' ;
 605 : mess '                  d"ouverture de la fissure egal a 0 degre ' ;
 606 : mess '                                                           ' ;
 607 : mess '    LA PROCEDURE FIXE CET ANGLE A 0.1 DEGRE PAR DEFAUT     ' ;
 608 : mess '    ET PROJETTE LA LEVRE SUR LE PLAN Z=0                   ' ;
 609 : mess '===========================================================' ;
 610 : saut ligne ;
 611 :  finsi ;
 612 : *
 613 : * troisieme couronne de transition
 614 : * --------------------------------
 615 : *
 616 : si (ndt ega 2) ;
 617 : *
 618 : p7 = (c - ((1 + rc1 + rc2 + rc3) * rc0 * coseps)) 0.
 619 :      (-1 * (1 + rc1 + rc2 + rc3) * rc0 * sineps) ;
 620 : p8 = (c - ((1 + rc1 + rc2 + rc3) * rc0 * coseps)) 0.
 621 :      (-1 * (1 + rc1 + rc2 + rc3) * rc0 ) ;
 622 : p10 = (c + ((1 + rc1 + rc2 + rc3) * rc0 * coseps)) 0.
 623 :       (-1 * (1 + rc1 + rc2 + rc3) * rc0 ) ;
 624 : p9 = plus p8 p10 / 2 ;
 625 : p11 = (c + ((1 + rc1 + rc2 + rc3) * rc0)) 0. 0. ;
 626 : *
 627 : si (nsdt ega 2) ;
 628 : *
 629 :   mtran31 alpha_m1 al_max1 sommet11 sommet31 sommet51
 630 :   sommet71
 631 :                            = @FIS_2 p7 p3 p4 p8 o c a
 632 :                              alpha beta nt 2;
 633 : *
 634 :   mtran32 alpha_m2 al_max2 sommet12 sommet32 sommet52
 635 :   sommet72
 636 :                            = @FIS_2 p8 p4 p5 p9 o c a
 637 :                              alpha beta nt 2;
 638 : *
 639 :   mtran33 alpha_m3 al_max3 sommet13 sommet33 sommet53
 640 :   sommet73
 641 :                            = @FIS_2 p9 p5 p6 p10 o c a
 642 :                              alpha beta nt 2;
 643 : *
 644 :   mtran34 alpha_m4 al_max4 sommet14 sommet34 sommet54
 645 :   sommet74
 646 :                            = @FIS_2 p10 p6 q3 p11 o c a
 647 :                              alpha beta nt 2;
 648 : *
 649 :   al_m_c2 = prog alpha_m1 alpha_m2 alpha_m3 alpha_m4 ;
 650 :   alpha_c2 = mini al_m_c2 ;
 651 : *
 652 :   al_max = prog al_max1 al_max2 al_max3 al_max4 ;
 653 :   almax2 = maxi al_max ;
 654 : *
 655 :   lref = sommet74 ;
 656 : *
 657 : sinon ;
 658 : *
 659 :   p78 = plus p7 p8 / 2 ;
 660 :   p89 = plus p8 p9 / 2;
 661 :   p910 = plus p9 p10 / 2 ;
 662 :   p1011 = plus p10 p11 / 2 ;
 663 : *
 664 :   mtran31 alpha_m1 al_max1 sommet11 sommet31 sommet51
 665 :   sommet71
 666 :                            = @FIS_2 p7 p3 p34 p78 o c a
 667 :                              alpha beta nt 2;
 668 : *
 669 :   mtran32 alpha_m2 al_max2 sommet12 sommet32 sommet52
 670 :   sommet72
 671 :                            = @FIS_2 p78 p34 p4 p8 o c a
 672 :                              alpha beta nt 2;
 673 : *
 674 :   mtran33 alpha_m3 al_max3 sommet13 sommet33 sommet53
 675 :   sommet73
 676 :                            = @FIS_2 p8 p4 p45 p89 o c a
 677 :                              alpha beta nt 2;
 678 :   mtran34 alpha_m4 al_max4 sommet14 sommet34 sommet54
 679 :   sommet74
 680 :                            = @FIS_2 p89 p45 p5 p9 o c a
 681 :                              alpha beta nt 2;
 682 : *
 683 :   mtran35 alpha_m5 al_max5 sommet15 sommet35 sommet55
 684 :   sommet75
 685 :                            = @FIS_2 p9 p5 p56 p910 o c a
 686 :                              alpha beta nt 2;
 687 : *
 688 :   mtran36 alpha_m6 al_max6 sommet16 sommet36 sommet56
 689 :   sommet76
 690 :                            = @FIS_2 p910 p56 p6 p10 o c a
 691 :                              alpha beta nt 2;
 692 : *
 693 :   mtran37 alpha_m7 al_max7 sommet17 sommet37 sommet57
 694 :   sommet77
 695 :                            = @FIS_2 p10 p6 p63 p1011 o c a
 696 :                              alpha beta nt 2;
 697 : *
 698 :   mtran38 alpha_m8 al_max8 sommet18 sommet38 sommet58
 699 :   sommet78
 700 :                            = @FIS_2 p1011 p63 q3 p11 o c a
 701 :                              alpha beta nt 2;
 702 : *
 703 :   al_m_c2 = prog alpha_m1 alpha_m2 alpha_m3 alpha_m4
 704 :                  alpha_m5 alpha_m6 alpha_m7 alpha_m8 ;
 705 :   alpha_c2 = mini al_m_c2 ;
 706 : *
 707 :   al_max = prog al_max1 al_max2 al_max3 al_max4
 708 :                 al_max5 al_max6 al_max7 al_max8 ;
 709 :   almax2 = maxi al_max ;
 710 : *
 711 :   lref = sommet78 ;
 712 : *
 713 : finsi ;
 714 : *
 715 :   saut ligne ;
 716 :   mess '--------------------------------------------------' ;
 717 :   mess 'ANGLE MINI SUR LES PRISMES DE LA DEUXIEME COURONNE' ;
 718 :   mess 'DE DERAFFINEMENT DES TRANCHES =' alpha_c2 'DEGRES'  ;
 719 :   saut ligne ;
 720 :   mess '    POUR AUGMENTER CET ANGLE : AUGMENTER "rc3" ' ;
 721 :   mess '                               DIMINUER  "rc0" ' ;
 722 :   saut ligne ;
 723 :   mess '--------------------------------------------------' ;
 724 :   saut ligne ;
 725 : *
 726 : si (almax2 > 175.) ;
 727 :   mess '----------------------------------------------------' ;
 728 :   mess 'L"ANGLE MAXI SUR LES PRISMES DE LA DEUXIEME COURONNE' ;
 729 :   mess 'DE DERAFFINEMENT DES TRANCHES EST TROP GRAND :' almax2 ;
 730 :   mess 'DEGRES !!!   ERREUR SUR LA GENERATION DU MAILLAGE    ' ;
 731 :   saut ligne ;
 732 :   mess '    POUR DIMINUER CET ANGLE : AUGMENTER "rc3" ' ;
 733 :   mess '                              DIMINUER  "rc0" ' ;
 734 :   saut ligne ;
 735 :   mess '   ATTENTION !!! ---- ON SORT DE LA PROCEDURE ----- ' ;
 736 :   saut ligne ;
 737 :   mess '----------------------------------------------------' ;
 738 :   saut ligne ;
 739 : quit @FIS_3 ;
 740 : finsi ;
 741 : *
 742 : si (nsdt ega 2) ;
 743 :    mtran3 = mtran31 et mtran32 et mtran33 et mtran34;
 744 : sinon ;
 745 :    mtran3 = mtran31 et mtran32 et mtran33 et mtran34 et
 746 :             mtran35 et mtran36 et mtran37 et mtran38 ;
 747 : finsi ;
 748 : *
 749 : mtran3 = mtran3 coul vert ;
 750 : elim mtran3 (c / 1.E4) ;
 751 : *
 752 : finsi ;
 753 : *
 754 : *
 755 : * parcours de la generatrice elliptique
 756 : * -------------------------------------
 757 : *
 758 :   si (ega ndt 1) ;
 759 :      p7 = p3 ;
 760 :      p8 = p4 ;
 761 :      p9 = p5 ;
 762 :      p10 = p6 ;
 763 :      p11 = q3 ;
 764 :      na = 2 ;
 765 :      nb = (nt / 8) ;
 766 :      nd = 1 + rc1 + rc2 ;
 767 :   sinon ;
 768 :      na = 4 ;
 769 :      nb = (nt / 16) ;
 770 :      nd = 1 + rc1 + rc2 + rc3 ;
 771 :   finsi ;
 772 : *
 773 : l810 = p8 droi 1 p9 droi 1 p10 ;
 774 : *
 775 : opti elem cu20 ;
 776 : ermax = 0 ;
 777 : idiv = 0 ;
 778 : ndiv2 = nt / 2 ;
 779 : lff = ox ;
 780 : pcour_m1 = ox ;
 781 : dis_max = 0 ;
 782 : *
 783 : si (nsdt ega 2) ;
 784 :    lboulev = ox d nc p1 d 1 p1b d 1 p2 ;
 785 :    lbouext = q2 d 1 q1b d 1 q1 d nc ox ;
 786 : sinon ;
 787 :    lboulev = ox d nc p1 d 1 p1b ;
 788 :    lbouext = q1b d 1 q1 d nc ox ;
 789 : finsi ;
 790 : *
 791 : * Cas de la demi ellipse
 792 : repeter bloc1 ndiv2 ;
 793 :    idiv = idiv + 1 ;
 794 :    psi = (idiv * 180.) / nt ;
 795 :    si (ega idiv ndiv2) ;
 796 :       phi = 90. ;
 797 :       cosphi = 0. ;
 798 :       sinphi = 1. ;
 799 :    sinon ;
 800 :       cospsi = cos psi ;
 801 :       sinpsi = sin psi ;
 802 :       tanpsi = sinpsi / cospsi ;
 803 :       tanphi = a * tanpsi / c ;
 804 :       phik1  = atg tanphi ;
 805 :       phik2  = psi ;
 806 :       phi = (beta * phik2) + ((1 - beta) * phik1) ;
 807 :       si (phi < 0.) ;
 808 :          phi = 180. + phi ;
 809 :       finsi ;
 810 :       cosphi = cos phi ;
 811 :       sinphi = sin phi ;
 812 : *
 813 :       tanphi = sinphi / cosphi ;
 814 :       psiref = atg (c * tanphi / a) ;
 815 :       talpha = (alpha * (1 - (c / a))) + (c / a) ;
 816 :       tanpsi = talpha * tanphi ;
 817 :       psi = atg tanpsi ;
 818 :     erreupsi = abs (psiref - psi) ;
 819 :     si (erreupsi > ermax) ;
 820 :        ermax = erreupsi ;
 821 :     finsi ;
 822 :    finsi ;
 823 :    si (ega idiv nt) ;
 824 :       phi = 180. ;
 825 :       cosphi = -1. ;
 826 :       sinphi = 0. ;
 827 :    finsi ;
 828 :    xcour = c * cosphi ;
 829 :    ycour = a * sinphi ;
 830 :    zcour = 0. ;
 831 :    pcour = xcour ycour zcour ;
 832 :    s_lff = pcour_m1 d 1 pcour ;
 833 :    pcour_m1 = pcour ;
 834 :    lff = lff d 1 pcour ;
 835 : *
 836 : * Mesure de la longueur maxi d'un segment de lff
 837 : * ----------------------------------------------
 838 :    pi_s_lff = s_lff poin initial ;
 839 :    pf_s_lff = s_lff poin final ;
 840 :    dis_pipf = moins pi_s_lff pf_s_lff  norm ;
 841 :     si (dis_pipf > dis_max) ;
 842 :        dis_max = dis_pipf ;
 843 :     finsi ;
 844 : *
 845 :    mcour = mgen moins ox ;
 846 :    depl mcour tour psi o (0. 0. 1.) ;
 847 :    depl mcour plus pcour ;
 848 : *
 849 :    lboulcou = lboulev moins ox ;
 850 :    depl lboulcou tour psi o (0. 0. 1.) ;
 851 :    depl lboulcou plus pcour ;
 852 :    lbouecou = lbouext moins ox ;
 853 :    depl lbouecou tour psi o (0. 0. 1.) ;
 854 :    depl lbouecou plus pcour ;
 855 : *
 856 : * ---------------------------------------------------------------
 857 : * -----  Test sur les parametres rc0 rc1 rc2 rc3            ------
 858 : * ---------------------------------------------------------------
 859 : *
 860 :      si (ega ndt 1) ;
 861 :         dx1 = rc0 * (1 + rc1 + rc2) ;
 862 : *CMODI BK 08/03/95
 863 : *        dx2 = dx1 + (rc0 * rc2) ;
 864 :         dx2 = dx1 + (2. * rc0 * rc2) ;
 865 :      sinon ;
 866 :         dx1 = rc0 * (1 + rc1 + rc2 + rc3) ;
 867 : *CMODI BK 08/03/95
 868 : *        dx2 = dx1 + (rc0 * rc3) ;
 869 :         dx2 = dx1 + (2. * rc0 * rc3) ;
 870 :      finsi ;
 871 : *
 872 : * l = longueur du bloc initial
 873 : * ----------------------------
 874 : l = c + dx2 ;
 875 : *
 876 : si (ega idiv 1) ;
 877 : *
 878 :   si (dx1 > (ycour / tanpsi)) ;
 879 :    saut ligne ;
 880 :    mess '-----------------------------------------------------------';
 881 :    mess 'ATTENTION !!  LES VALEURS DES PARAMETRES rc0,rc1,rc2 et rc3';
 882 :    mess 'SONT TROP ELEVEES POUR UNE GENERATION CORRECTE DU MAILLAGE' ;
 883 :    saut ligne ;
 884 :    mess '*** PROBLEME AU NIVEAU DU PLUS PETIT RAYON DE COURBURE **' ;
 885 :    mess '-----------------------------------------------------------';
 886 :    saut ligne ;
 887 :      si (ega ndt 1) ;
 888 :        mess 'LA VALEUR MAXI DU TERME rc0 * (1 + rc1 + rc2)' ;
 889 :        mess 'DOIT ETRE INFERIEURE A :' (ycour / tanpsi) ;
 890 :        saut ligne ;
 891 :        mess 'SI VOUS CONSERVEZ rc1,rc2,rc3 ALORS rc0 DOIT ETRE ';
 892 :        mess 'INFERIEUR A :' ((ycour / tanpsi) / (1 + rc1 + rc2)) ;
 893 :      sinon ;
 894 :        mess 'LA VALEUR MAXI DU TERME rc0 * (1 + rc1 + rc2 + rc3)' ;
 895 :        mess 'DOIT ETRE INFERIEURE A :' (ycour / tanpsi) ;
 896 :        saut ligne ;
 897 :        mess 'SI VOUS CONSERVEZ rc1,rc2,rc3 ALORS rc0 DOIT ETRE ';
 898 :        mess 'INFERIEUR A :' ;
 899 :        mess ((ycour / tanpsi) / (1 + rc1 + rc2 + rc3)) ;
 900 :      finsi ;
 901 :   finsi ;
 902 :       si (dx2 > (t - a )) ;
 903 :    saut ligne ;
 904 :    mess '-----------------------------------------------------------';
 905 :    mess 'ATTENTION !!  LES VALEURS DES PARAMETRES rc0,rc1,rc2 et rc3';
 906 :    mess 'SONT TROP ELEVEES POUR UNE GENERATION CORRECTE DU MAILLAGE' ;
 907 :    saut ligne ;
 908 :    mess '*** PROBLEME AU NIVEAU DU PLUS GRAND RAYON DE COURBURE **' ;
 909 :    mess '-----------------------------------------------------------';
 910 :    saut ligne ;
 911 :      si (ega ndt 1) ;
 912 :        mess 'LA VALEUR MAXI DU TERME rc0 * (1 + rc1 + rc2)' ;
 913 :        mess 'DOIT ETRE INFERIEURE A :' ((t - a) - (rc0 * rc2)) ;
 914 :        saut ligne ;
 915 :        mess 'SI VOUS CONSERVEZ rc1,rc2,rc3 ALORS rc0 DOIT ETRE ';
 916 :        mess 'INFERIEUR A :' ;
 917 : *       mess (((t - a) - (rc0 * rc2)) / (1 + rc1 + rc2)) ;
 918 :        mess ((t - a) / (1 + rc1 + (2 * rc2))) ;
 919 :      sinon ;
 920 :        mess 'LA VALEUR MAXI DU TERME rc0 * (1 + rc1 + rc2 + rc3)' ;
 921 :        mess 'DOIT ETRE INFERIEURE A :' ((t - a) - (rc0 * rc3)) ;
 922 :        saut ligne ;
 923 :        mess 'SI VOUS CONSERVEZ rc1,rc2,rc3 ALORS rc0 DOIT ETRE ';
 924 :        mess 'INFERIEUR A :' ;
 925 : *       mess (((t - a) - (rc0 * rc3)) / (1 + rc1 + rc2 + rc3)) ;
 926 :        mess ((t - a) / (1 + rc1 + rc2 + (2 * rc3))) ;
 927 :      finsi ;
 928 :       finsi ;
 929 : finsi ;
 930 : *
 931 : *
 932 :    p8cour = p8 moins ox ;
 933 :    depl p8cour tour psi o (0. 0. 1.) ;
 934 :    depl p8cour plus pcour ;
 935 : *
 936 :    p9cour = p9 moins ox ;
 937 :    depl p9cour tour psi o (0. 0. 1.) ;
 938 :    depl p9cour plus pcour ;
 939 : *
 940 :    p10cour = p10 moins ox ;
 941 :    depl p10cour tour psi o (0. 0. 1.) ;
 942 :    depl p10cour plus pcour ;
 943 : *
 944 : l810cour = p8cour droi 1 p9cour droi 1 p10cour ;
 945 : *
 946 :    p7cour = p7 moins ox ;
 947 :    depl p7cour tour psi o (0. 0. 1.) ;
 948 :    depl p7cour plus pcour ;
 949 :    xp7cour = coord 1 p7cour ;
 950 : *
 951 :    p11cour = p11 moins ox ;
 952 :    depl p11cour tour psi o (0. 0. 1.) ;
 953 :    depl p11cour plus pcour ;
 954 :    xp11cour = coord 1 p11cour ;
 955 : *
 956 :    xcourp7 = (c - (4 * rc0 * coseps)) * cosphi ;
 957 :    zp7 = coor 3 p7 ;
 958 : *
 959 :    si (ega idiv 1) ;
 960 :       boudin = mgen volu 1 mcour ;
 961 :       linf_b = lboulev regler 1 lboulcou ;
 962 :       linf_bex = lbouext regler 1 lbouecou ;
 963 :    sinon ;
 964 :       boudin = boudin volu 1 mcour ;
 965 :       linf_b = linf_b regler 1 lboulcou ;
 966 :       linf_bex = linf_bex regler 1 lbouecou ;
 967 :    finsi ;
 968 : *
 969 : tab_fron = table ;
 970 : tab_ang = table ;
 971 : tab_int = table ;
 972 : *
 973 : *   si (ega idiv na) ;
 974 :    si (idiv <EG (2 * na)) ;
 975 :       si (ega idiv na) ;
 976 :          lfronti1 = p7 droi 1 p7cour ;
 977 :          lfronte1 = p11 droi 1 p11cour ;
 978 :       finsi ;
 979 :       si (ega idiv (2 * na)) ;
 980 :          p7n1 = p7cour ;
 981 :          p11n1 = p11cour ;
 982 :          lfronti1 = lfronti1 droi 1 p7cour ;
 983 :          lfronte1 = lfronte1 droi 1 p11cour ;
 984 :       finsi ;
 985 : *
 986 : *
 987 : * On ecrit dans la table tab_fron les points de la ligne
 988 : * lfrontex et dans la table tab_ang l'angle de la tranche
 989 : * -------------------------------------------------------
 990 : *
 991 : tab_fron . 1 = p11cour ;
 992 : tab_ang . 1 = tanpsi ;
 993 : it = 1 ;
 994 :    sinon ;
 995 :       indd = idiv / na  entier;
 996 :       ind  = idiv - (indd * na) ;                                               
 997 :           si (ind ega 0) ;
 998 :              si (idiv ega (3 * na)) ;
 999 :                 lfrontin = p7n1 droi 1 p7cour ;
1000 :                 lfrontex = p11n1 droi 1 p11cour ;
1001 :                 lxi = p7 droi 1 (xp7cour 0 zp7) ;
1002 :              sinon ;
1003 :                lfrontin = lfrontin droi 1 p7cour ;
1004 :                lfrontin = lfrontin coul rouge;
1005 :                lfrontex = lfrontex droi 1 p11cour ;
1006 :                lfrontex = lfrontex coul rouge;
1007 :                lxi = lxi droi 1 (xp7cour 0 zp7) ;
1008 :              finsi ;
1009 : it = it + 1 ;
1010 : tab_fron . it  = p11cour ;
1011 : tab_ang . it = tanpsi ;
1012 : *
1013 :          finsi ;
1014 :    finsi ;
1015 : *
1016 : fin bloc1 ;
1017 : *
1018 : r1 = l 0 0 ;
1019 : r2 = l t 0 ;
1020 : r3 = 0 t 0 ;
1021 : *
1022 : *
1023 :  si (ermax > 1.) ;
1024 :      saut ligne ;
1025 :   mess '-----------------------------------------------------------' ;
1026 :   mess 'INCLINAISON MAXIMALE DES TRANCHES PAR RAPPORT A LA NORMALE'  ;
1027 :   mess 'DE LA GENERATRICE DU FOND DE FISSURE :' ermax 'DEGRES'       ;
1028 :      saut ligne ;
1029 :   mess 'POUR DIMINUER L"INCLINAISON : DIMINUER LE PARAMETRE "alpha"' ;
1030 :   mess '-----------------------------------------------------------' ;
1031 :      saut ligne ;
1032 :  sinon ;
1033 :      saut ligne ;
1034 :   mess '--------------------------------------------------' ;
1035 :   mess 'TOUTES LES TRANCHES SONT NORMALES A LA GENERATRICE' ;
1036 :   mess '--------------------------------------------------' ;
1037 :      saut ligne ;
1038 :  finsi ;
1039 : *
1040 : la_cour = rc0 / nc ;
1041 : fac_etir = dis_max / la_cour ;
1042 : *
1043 :   mess '-----------------------------------------------------------' ;
1044 :   mess 'FACTEUR D"ETIREMENT MAXI LE LONG DE LA FISSURE =' fac_etir   ;
1045 :   saut ligne ;
1046 :   mess '   POUR REDUIRE LE FACTEUR D"ETIREMENT : AUGMENTER "nt"    ' ;
1047 :   mess '                                         DIMINUER  "nc"    ' ;
1048 :   mess '-----------------------------------------------------------' ;
1049 :   saut ligne ;
1050 : *
1051 : * Epaisseur absolue de la couronne de deraffinement des tranches la
1052 : * plus eloignee de la ligne de fond de fissure
1053 : * -----------------------------------------------------------------
1054 :  si (ndt ega 1) ;
1055 :    ep_cd = (rc0 * rc2) ;
1056 :  sinon ;
1057 :    ep_cd = (rc0 * rc3) ;
1058 :  finsi ;
1059 : *
1060 : * surface superieure interieure a l ellipse
1061 : * -----------------------------------------
1062 : *
1063 : * CMODI BK 30/05/95
1064 : *
1065 : yp7cour = coor 2 p7cour ;
1066 : *
1067 : * Repartition 1/3 2/3 dans le plan x=0
1068 : *
1069 : lyie = p7cour droi 1 (xp7cour (2. * yp7cour / 3.) zp7)
1070 :               droi 1 (xp7cour 0 zp7) ;
1071 : *
1072 : cont = lfrontin et lfronti1 et lyie et (inve lxi) ;
1073 : elim cont (c / 1.E4) ;
1074 : *
1075 : sintsup = lfrontin lyie (inve lxi) lfronti1 dall plan ;
1076 : *
1077 : *
1078 : * surface superieure exterieure a l ellipse
1079 : * -----------------------------------------
1080 : *
1081 : * tri de la ligne lref
1082 : *
1083 : lref = chan lref poi1 ;
1084 : *
1085 : i = 0 ;
1086 : tab1 = table ;
1087 : tab2 = table ;
1088 : nbval = nbno lref ;
1089 : repeter bouc1 nbval ;
1090 :  i = i + 1 ;
1091 :  pcour_c = lref poin i ;
1092 :  xp = coor 1 pcour_c ;
1093 :  tab1 . i = xp ;
1094 :  tab2 . i = pcour_c ;
1095 : fin bouc1 ;
1096 : tab2 = @FIS_1 tab1 tab2 ;
1097 : *
1098 : p11n3 = plus r1 r2 / 2;
1099 : *
1100 : lyee1 = p11n3 d 2 r1 ;
1101 : lyee2 = p11n3 d 2 r2;
1102 : *
1103 : *
1104 :    nbel_lxi = nbel lxi ;
1105 : *
1106 : si (ega d2 'oui') ;
1107 : *
1108 : * DECOUPAGE RAYONNANT SELON X DE LA FACE Y=t
1109 : * ------------------------------------------------
1110 : p11n2 = ((coor 1 p11n1) t 0) ;
1111 : lxee1 = r2 d 2 p11n2 ;
1112 : *
1113 : si (nbval ega 9) ;
1114 :    lxee2 = r3 d nbel_lxi p11n2 ;
1115 : sinon ;
1116 : *
1117 :    lxee2 = r3 d 1 ((coor 1 (tab2 . 3)) t 0) ;
1118 : *
1119 :    i = 3 ;
1120 : *   repeter bouc1 ((nbval - 1) / 4) ;
1121 :    repeter bouc1 ((nbel lfrontex) - 2) ;
1122 :    i = i + 2 ;
1123 :         lxee2 = lxee2 d 1 ((coor 1 (tab2 . i)) t 0) ;
1124 :    fin bouc1 ;
1125 : *
1126 :    lxee2 = lxee2 d 1 p11n2 ;
1127 : *
1128 : finsi ;
1129 : *
1130 : sinon ;
1131 : *
1132 : * DECOUPAGE REGULIER SELON X DE LA FACE Y=t
1133 : * -----------------------------------------------------
1134 :    long_el = l / (nbel_lxi + 2) ;
1135 :    p11n2 = ((nbel_lxi * long_el) t 0) ;
1136 :    lxee1 = r2 d 2 p11n2 ;
1137 :    lxee2 = r3 d nbel_lxi p11n2 ;
1138 : *
1139 : * -----------------------------------------------------
1140 : *
1141 : finsi ;
1142 : *
1143 : lp11n2n1 = p11n2 d 2 p11n1 ;
1144 : lp11n1n3 = p11n1 d 2 p11n3 ;
1145 : *
1146 : lxee = (inve lxee1) et lxee2 ;
1147 : *
1148 : d_r1p11 = moins r1 p11   norm ;
1149 : d_r3p11c = moins r3 p11cour  norm ;
1150 : *
1151 : lxei = r1 d 1 (r1 moin ((2. * d_r1p11 / 3.) 0 0)) d 1 p11 ;
1152 : lyei = p11cour d 1 (p11cour plus (0 (d_r3p11c / 3.) 0)) d 1 r3 ;
1153 : *
1154 : sextsup1 = lxei lfronte1 lp11n1n3 lyee1 dall plan ;
1155 : sextsup2 = lp11n2n1 lp11n1n3 lyee2 lxee1 dall plan ;
1156 : sextsup3 = lfrontex lyei lxee2 lp11n2n1 dall plan ;
1157 : *
1158 : sextsup = sextsup1 et sextsup2 et sextsup3 ;
1159 : *
1160 : * volume interieur a l ellipse
1161 : * ----------------------------
1162 : *
1163 : opti elem cu20 ;
1164 : *
1165 : si (nsdt ega 2) ;
1166 :    vint = sintsup volu tran 1 (0 0 ((nd * rc0) * (sineps - 1))) ;
1167 : sinon ;
1168 :    vint = sintsup volu tran 2 (0 0 ((nd * rc0) * (sineps - 1))) ;
1169 : finsi ;
1170 : *
1171 : * volume exterieur a l ellipse
1172 : * ----------------------------
1173 : *
1174 : si (nsdt ega 2) ;
1175 :    vext = sextsup volu tran 1 (0 0 (-1 * nd * rc0)) ;
1176 : sinon ;
1177 :    vext = sextsup volu tran 2 (0 0 (-1 * nd * rc0)) ;
1178 : finsi ;
1179 : *
1180 : * volume sous le boudin
1181 : * ---------------------
1182 : *
1183 :    si (ega ndt 1) ;
1184 :      vtotcomp = (boudin et mtran2 et vint et vext et linf_b
1185 :                  et linf_bex et lff) ;
1186 :        elim vtotcomp (c / 1.E4) ;
1187 :      vtot = boudin et mtran2 et vint et vext ;
1188 :       sinon ;
1189 :      vtotcomp = (boudin et mtran2 et mtran3 et vint et vext
1190 :                  et linf_b et linf_bex et lff) ;
1191 :        elim vtotcomp (c / 1.E4) ;
1192 :      vtot = boudin et mtran2 et mtran3 et vint et vext ;
1193 :    finsi ;
1194 : *
1195 : * MODIF BC 30/04/96
1196 : * recuperation de la surface inferieure de velim
1197 : * avec velim = mtran2 et mtran3 et vint et vext
1198 : * pour une elimination des points doubles avec vbas
1199 : *
1200 : si (ega ndt 1) ;
1201 :    velim = mtran2 et vint et vext ;
1202 : sinon ;
1203 :    velim = mtran2 et mtran3 et vint et vext ;
1204 : finsi ;
1205 : env_vel = enve velim ;
1206 : zcot1 = -1 * nd * rc0 ;
1207 : pvelim = env_vel point plan (0. 0. zcot1) (1. 0. zcot1)
1208 :          (0. 1. zcot1) (c / 1.E4) ;
1209 : selim = env_vel elem appuye strictement pvelim ;
1210 : *
1211 : * FIN MODIF BC 30/04/96
1212 : *
1213 : * -----------------------------------------------
1214 : * Deplacement des noeuds intermediares du boudin
1215 : * -----------------------------------------------
1216 : *
1217 : si (ega d1 'oui') ;
1218 : *
1219 : idiv1 = -1 ;
1220 : idiv2 = 0 ;
1221 : idiv3 = -.5 ;
1222 : nc = 1 ;
1223 : ndiv4 = nt / 2 ;
1224 : * Cas du quart d'ellipse
1225 : repeter bouc1 ndiv4 ;
1226 :    idiv1 = idiv1 + nc ;
1227 :    idiv2 = idiv2 + nc ;
1228 :    idiv3 = idiv3 + nc ;
1229 :    psi1 = (idiv1 * 180.) / nt ;
1230 :    psi2 = (idiv2 * 180.) / nt ;
1231 :    psi3 = (idiv3 * 180.) / nt ;
1232 :       cospsi1 = cos psi1 ;
1233 :       sinpsi1 = sin psi1 ;
1234 :       tanpsi1 = sinpsi1 / cospsi1 ;
1235 :       tanphi1 = a * tanpsi1 / c ;
1236 :       phik1  = atg tanphi1 ;
1237 :       phik2  = psi1 ;
1238 :       phi1 = (beta * phik2) + ((1 - beta) * phik1) ;
1239 : *      phi1    = atg tanphi1 ;
1240 :       si (phi1 < 0.) ;
1241 :          phi1 = 180. + phi1 ;
1242 :       finsi ;
1243 :       cosphi1 = cos phi1 ;
1244 :       sinphi1 = sin phi1 ;
1245 :       tanphi1 = sinphi1 / cosphi1 ;
1246 :       talpha = (alpha * (1 - (c / a))) + (c / a) ;
1247 :       tanpsi1 = talpha * tanphi1 ;
1248 :       psi1 = atg tanpsi1 ;
1249 :       cospsi1 = cos psi1 ;
1250 :       sinpsi1 = sin psi1 ;
1251 : *
1252 :    si (ega idiv2 (nt /2)) ;
1253 :       phi2 = 90. ;
1254 :       cosphi2 = 0. ;
1255 :       sinphi2 = 1. ;
1256 :    sinon ;
1257 :       cospsi2 = cos psi2 ;
1258 :       sinpsi2 = sin psi2 ;
1259 :       tanpsi2 = sinpsi2 / cospsi2 ;
1260 :       tanphi2 = a * tanpsi2 / c ;
1261 :       phik1  = atg tanphi2 ;
1262 :       phik2  = psi2 ;
1263 :       phi2 = (beta * phik2) + ((1 - beta) * phik1) ;
1264 : *      phi2    = atg tanphi2 ;
1265 :       si (phi2 < 0.) ;
1266 :          phi2 = 180. + phi2 ;
1267 :       finsi ;
1268 :       cosphi2 = cos phi2 ;
1269 :       sinphi2 = sin phi2 ;
1270 :       tanphi2 = sinphi2 / cosphi2 ;
1271 :       talpha = (alpha * (1 - (c / a))) + (c / a) ;
1272 :       tanpsi2 = talpha * tanphi2 ;
1273 :       psi2 = atg tanpsi2 ;
1274 :       cospsi2 = cos psi2 ;
1275 :       sinpsi2 = sin psi2 ;
1276 :    finsi ;
1277 : *
1278 :       cospsi3 = cos psi3 ;
1279 :       sinpsi3 = sin psi3 ;
1280 :       tanpsi3 = sinpsi3 / cospsi3 ;
1281 :       tanphi3 = a * tanpsi3 / c ;
1282 :       phik1  = atg tanphi3 ;
1283 :       phik2  = psi3 ;
1284 :       phi3 = (beta * phik2) + ((1 - beta) * phik1) ;
1285 : *      phi3    = atg tanphi3 ;
1286 :       si (phi3 < 0.) ;
1287 :          phi3 = 180. + phi3 ;
1288 :       finsi ;
1289 :       cosphi3 = cos phi3 ;
1290 :       sinphi3 = sin phi3 ;
1291 :       tanphi3 = sinphi3 / cosphi3 ;
1292 :       talpha = (alpha * (1 - (c / a))) + (c / a) ;
1293 :       tanpsi3 = talpha * tanphi3 ;
1294 :       psi3 = atg tanpsi3 ;
1295 :       cospsi3 = cos psi3 ;
1296 :       sinpsi3 = sin psi3 ;
1297 : *
1298 : *
1299 :    xcour1 = c * cosphi1 ;
1300 :    ycour1 = a * sinphi1 ;
1301 :    zcour1 = 0. ;
1302 :    pcour1 = xcour1 ycour1 zcour1 ;
1303 : *
1304 :    xcour2 = c * cosphi2 ;
1305 :    ycour2 = a * sinphi2 ;
1306 :    zcour2 = 0. ;
1307 :    pcour2 = xcour2 ycour2 zcour2 ;
1308 : *
1309 :    xcour3 = c * cosphi3 ;
1310 :    ycour3 = a * sinphi3 ;
1311 :    zcour3 = 0. ;
1312 :    pcour3 = xcour3 ycour3 zcour3 ;
1313 : *
1314 :    pcourmi = plus pcour1 pcour2 / 2 ;
1315 :    pcourmiz = pcourmi plus (0 0 1) ;
1316 : *
1317 : *
1318 :    pcourq11 = q1 moins ox ;
1319 :    depl pcourq11 tour psi1 o (0. 0. 1.) ;
1320 :    depl pcourq11 plus pcour1 ;
1321 : *
1322 :    pcourq12 = q1 moins ox ;
1323 :    depl pcourq12 tour psi2 o (0. 0. 1.) ;
1324 :    depl pcourq12 plus pcour2 ;
1325 : *
1326 :    pcourq1 = plus pcourq11 pcourq12 / 2 ;
1327 : *
1328 :    hyp = moins pcourmi pcourq1  norm ;
1329 :    dx = (coor 1 pcourq1) - (coor 1 pcourmi) ;
1330 :    dy = (coor 2 pcourq1) - (coor 2 pcourmi) ;
1331 :    sina = (dy / hyp) ;
1332 :    cosa = (dx / hyp) ;
1333 : *
1334 :    vproj = (-1 * sina) cosa 0 ;
1335 :    depl pcour3 proj vproj plan pcourmi pcourmiz pcourq1 ;
1336 : *
1337 :    padep = boudin poin plan pcourmi pcourmiz pcourq1 (c / 1.E4) ;
1338 : *
1339 :     dvect = moins pcour3 pcourmi  norm ;
1340 :     vect = ((dvect * cosa) (dvect * sina) 0) ;
1341 : *
1342 :    depl padep plus vect ;
1343 : *
1344 : fin bouc1 ;
1345 : *
1346 : finsi ;
1347 : *
1348 : * ===========================================================
1349 : *          RECUPERATION DE LA LEVRE DE LA FISSURE
1350 : * -----------------------------------------------------------
1351 : *
1352 : *  Surface interieure dans le plan z=constante
1353 : *  --------------------------------------------
1354 : *
1355 : z_p2 = coor 3 p2 ;
1356 : z_p4b = coor 3 p4b ;
1357 : dz_p2p4b = z_p2 - z_p4b ;
1358 : crit = dz_p2p4b / 10. ;
1359 : sineps = (sin eps) ;
1360 : *
1361 :  si (ega ndt 1) ;
1362 :     p7 = p3 ;
1363 :     plinf_c = (vint et mtran21) poin plan p7cour p7 (xp7cour 0 zp7)
1364 :               crit ;
1365 :  sinon ;
1366 :     p7 = (c - ((1 + rc1 + rc2 + rc3) * rc0 * coseps)) 0.
1367 :          (-1 * (1 + rc1 + rc2 + rc3) * rc0 * sineps) ;
1368 :     plinf_c = (vint et mtran21 et mtran31) poin plan p7cour p7
1369 :               (xp7cour 0 zp7) crit ;
1370 :  finsi ;
1371 : *
1372 : *
1373 : vtot_env = enve vtot ;
1374 : *
1375 : levreinf = vtot_env elem appuye strictement plinf_c ;
1376 : *
1377 : levreinf = levreinf et linf_b ;
1378 : *
1379 : levreinf = levreinf orienter direction (0 0 1) ;
1380 : *
1381 : si (flag_eps ega 0) ;
1382 :    depl levreinf proj (0 0 1) plan (0 0 0) (1 0 0) (0 1 0) ;
1383 : finsi ;
1384 : *
1385 : * =============================================================
1386 : *
1387 : *  Creation du volume complementaire pour l obtention de la
1388 : *  longueur lo
1389 : *  ------------------------------------------------------------
1390 : *
1391 : pslat_i = vtot poin plan r1 r2 (r2 plus (0 0 1)) (c / 1.E4) ;
1392 : slat_i = vtot_env elem appuye strictement pslat_i ;
1393 : *
1394 : si ((lo - l) < 0) ;
1395 :   mess '=============================================================' ;
1396 :   mess 'ATTENTION !!! La longueur du bloc est trop faible par rapport' ;
1397 :   mess '              au grand axe de l"ellipse et/ou aux parametres ' ;
1398 :   mess '              rc0,rc1,rc2,rc3                                ' ;
1399 :   mess '               --- REDUISEZ CES PARAMETRES ---               ' ;
1400 :   mess '=============================================================' ;
1401 : finsi ;
1402 : *
1403 : si (((abs (lo - l)) < (l / 1.E10)) ou (xl ega 0)) ;
1404 :    mess '----------------------------------------------- ' ;
1405 :    mess 'Pas de prolongation du bloc initial en longueur ' ;
1406 :    mess 'Longueur =' l                                     ;
1407 :    mess '----------------------------------------------- ' ;
1408 :    ind_vlat = 0 ;
1409 :    xl = 0 ;
1410 :      si (xl ega 0) ;
1411 :         si (ndt ega 1) ;
1412 :            lo = c + (rc0 * (1 + rc1 + (3. * rc2))) ;
1413 :         sinon ;
1414 :            lo = c + (rc0 * (1 + rc1 + rc2 + (3. * rc3))) ;
1415 :         finsi ;
1416 :      finsi ;
1417 : sinon ;
1418 :    ind_vlat = 1 ;
1419 :    vlat_com = slat_i volu tran xl ((lo - l) 0 0) ;
1420 :    vtot = vtot et vlat_com ;
1421 : finsi ;
1422 : *
1423 : vtot_env = enve vtot ;
1424 : *
1425 : *
1426 : *  Creation du volume complementaire pour l'obtention de la
1427 : *  largeur to
1428 : *  --------------------------------------------------------
1429 : *
1430 : si (ndt ega 1) ;
1431 :   nd = 1 + rc1 + rc2 ;
1432 : sinon ;
1433 :   nd = 1 + rc1 + rc2 + rc3 ;
1434 : finsi ;
1435 : *
1436 : hh = -1 * (nd * rc0) ;
1437 : *
1438 : si ((rallon ega 1) et (xt neg 0)) ;
1439 : *
1440 : si (ind_vlat ega 1) ;
1441 : *
1442 :        r2b = r2 plus ((lo - l) 0 0) ;
1443 :        lxee_p = lxee d xl r2b ;
1444 : *
1445 : sinon ;
1446 :         r2b = r2 ;
1447 :         lxee_p = lxee ;
1448 : finsi ;
1449 : *
1450 : nbe_l = (nbel lxee) + xl ;
1451 : *
1452 :    l_r3r2b = r3 d nbe_l r2b ;
1453 : *
1454 :    l_r3r2b = l_r3r2b plus (0 (to - t) 0) ;
1455 : *
1456 : si (nsdt ega 2) ;
1457 :    s_r3r2b = l_r3r2b tran 1 (0 0 hh) ;
1458 :    sar_i = lxee_p tran 1 (0 0 hh) ;
1459 : sinon ;
1460 :    s_r3r2b = l_r3r2b tran 2 (0 0 hh) ;
1461 :    sar_i = lxee_p tran 2 (0 0 hh) ;
1462 : finsi ;
1463 : *
1464 : *
1465 :    var_com = volu xt sar_i s_r3r2b ;
1466 : *
1467 :     vtot = vtot et var_com ; elim vtot (c / 1.E6) ;
1468 : *
1469 : finsi ;
1470 : *
1471 :    vtot_env = enve vtot ;
1472 : *
1473 : si (xt ega 0) ;
1474 :    rallon = 0 ;
1475 :    to = t ;
1476 :    mess '---------------------------------------------- ' ;
1477 :    mess 'Pas de prolongation du bloc initial en largeur ' ;
1478 :    mess 'Largeur =' t                                     ;
1479 :    mess '---------------------------------------------- ' ;
1480 : finsi ;
1481 : *
1482 : *
1483 : *  Creation du volume complementaire MI1 pour l obtention de la
1484 : *  hauteur ho
1485 : *  ------------------------------------------------------------
1486 : *
1487 : si (((2. * hh) + ho) < 0) ;
1488 :   mess '=============================================================' ;
1489 :   mess 'ATTENTION !!!  La hauteur du bloc est trop faible par rapport' ;
1490 :   mess '               aux parametres rc0,rc1,rc2,rc3                ' ;
1491 :   mess '               --- REDUISEZ CES PARAMETRES ---               ' ;
1492 :   mess '=============================================================' ;
1493 : finsi ;
1494 : *
1495 :    psi1 = vint poin plan (0 0 hh) (0 1 hh) (1 0 hh) (c / 1.E4) ;
1496 :    si1 = (enve vint) elem appuye strictement psi1 ;
1497 : *
1498 : ************ ATTENTION ***************
1499 : *   hh < 0
1500 : *   ep2 < 0
1501 : *   ep3 < 0
1502 : **************************************
1503 : *
1504 : * hh : Altitude du niveau 1
1505 : * ---------------------------
1506 : *
1507 : * ep2 : Altitude du niveau 0
1508 : * ---------------------------
1509 : *
1510 : * ep3 : Altitude du niveau -1
1511 : * ---------------------------
1512 : *
1513 : ral_bloc = 0 ;
1514 : *
1515 : si ((ho / (-1. * hh)) < 5.) ;
1516 :    ep2 = (((-1. * ho) - hh) / 2.) + hh ;
1517 :    ep3 = -1. * ho ;
1518 : sinon ;
1519 :    ral_bloc = 1 ;
1520 :    ep2 = 3. * hh ;
1521 :    ep3 = 5. * hh ;
1522 : finsi ;
1523 : *
1524 : si ((-1. * ep3) > ho) ;
1525 :    ep23 = (ho + hh) / 2. ;
1526 :    ep3 = -1. * ho ;
1527 :    ep2 = ep3 + ep23 ;
1528 : finsi ;
1529 : *
1530 : si (xh ega 0) ;
1531 :    ral_bloc = 0 ;
1532 :    ep2 = 3. * hh ;
1533 :    ep3 = 5. * hh ;
1534 : finsi ;
1535 : *
1536 :    mi1 = si1 volu tran 1 (0 0 (ep2 - hh)) ;
1537 : *
1538 : *  Projection de la surface SE1 sur le niveau 0
1539 : *  --------------------------------------------
1540 : *
1541 : se1 = sextsup plus (0 0 hh) ;
1542 : *
1543 : ****************************************
1544 : *
1545 : *  Creation de la surface SE0 par transformation geometrique
1546 : *  ---------------------------------------------------------
1547 : *
1548 : si (nsdt ega 2) ;
1549 :    i1 = sommet71 ;
1550 :    e1 = sommet14 ;
1551 :    p_i1 = changer i1 poi1 ;
1552 :    p_e1 = changer e1 poi1 ;
1553 : sinon ;
1554 :    i1 = sommet72 ;
1555 :    e1 = sommet17 ;
1556 :    p_i1 = changer i1 poi1 ;
1557 :    p_e1 = changer e1 poi1 ;
1558 : finsi ;
1559 : *
1560 : se01 = sextsup1 plus (0 0 ep2) ;
1561 : se02 = sextsup2 plus (0 0 ep2) ;
1562 : se03 = sextsup3 plus (0 0 ep2) ;
1563 : se0 = se01 et se02 et se03 ;
1564 : elim se0 crit ;
1565 : *
1566 : e0 = e1 plus (0 0 (ep2 - hh)) ;
1567 : elim se0 e0 crit ;
1568 : p_e0 = changer e0 poi1 ;
1569 : *
1570 : numnod = nbno p_e0 ;
1571 : inod = 0 ;
1572 : *
1573 : * deplacement des points du bord e0
1574 : *
1575 : repe bouc1 numnod ;
1576 :      inod = inod + 1 ;
1577 :      dep = (p_i1 poin inod) moins (p_e1 poin inod) ;
1578 :      dx = coor 1 dep ;
1579 :      dy = coor 2 dep ;
1580 :      depl (p_e0 poin inod) plus (dx dy 0.) ;
1581 : fin bouc1 ;
1582 : *
1583 : * definition des points limites du contour
1584 : *
1585 : p_se0 = se0 chan poi1 ;
1586 : con_se0 = 'CONT' se0 ;
1587 : p_lx = con_se0 poin plan (l 0 0) (l 1 0) (l 0 1) crit ;
1588 : lx = con_se0 elem appui stric p_lx ;
1589 : p_ly = con_se0 poin plan (0 t 0) (1 t 0) (0 t 1) crit ;
1590 : ly = con_se0 elem appui stric p_ly ;
1591 : p_lx0 = con_se0 poin plan (0 0 0) (0 1 0) (0 0 1) crit ;
1592 : lx0 = con_se0 elem appui stric p_lx0 ;
1593 : p_ly0 = con_se0 poin plan (0 0 0) (1 0 0) (0 0 1) crit ;
1594 : ly0 = con_se0 elem appui stric p_ly0 ;
1595 : *
1596 : ppp1 = p_e0 poin 1 ;
1597 : ppp2 = p_e0 poin (nbno p_e0) ;
1598 : ppp1 = e0 poin plan (0 0 0) (1 0 0) (0 0 1) crit ;
1599 : ppp2 = e0 poin plan (0 0 0) (0 1 0) (0 0 1) crit ;
1600 : p_lx0_2 = p_lx0 diff ppp2 ;
1601 : p_ly0_1 = p_ly0 diff ppp1 ;
1602 : *
1603 : * definition des points "interieurs"
1604 : *
1605 : lxy = lx et ly et lx0 et ly0 et e0 ;
1606 : p_lxy = lxy chan poi1 ;
1607 : p_inter = p_se0 diff p_lxy ;
1608 : *
1609 : * definitions des points definissant les transformations
1610 : *
1611 : p_pro_y = (0. t 0. ) ;
1612 : p_y = p_pro_y plus (l 0. 0.) ;
1613 : *
1614 : * p_e1t et p_i1t sont les images de p_e1 et p_i1 par
1615 : * l'affinite transformant la "presque ellipse" e0 en " presque cercle".
1616 : *
1617 : p_e1t = p_e1 plus (0. 0. 0.) ;
1618 : p_i1t = p_i1 plus (0. 0. 0.) ;
1619 : depl p_e1t affi (a/c) p_pro_y p_y ;
1620 : depl p_i1t affi (a/c) p_pro_y p_y ;
1621 : *
1622 : * calcul des distances des points de p_e1t et p_i1t au centre
1623 : *
1624 : numnod = nbno p_e1t ;
1625 : inod = 0 ;
1626 : rayone1 = table ;
1627 : rayoni1 = table ;
1628 : repe bouc2 numnod ;
1629 :      inod = inod + 1 ;
1630 :      xe1 ye1 ze1 = coord (p_e1t poin inod) ;
1631 :      xi1 yi1 zi1 = coord (p_i1t poin inod) ;
1632 :      rayone1 . inod = (((xe1**2)+(ye1**2))**0.5) ;
1633 :      rayoni1 . inod = (((xi1**2)+(yi1**2))**0.5) ;
1634 : fin bouc2 ;
1635 : *
1636 : * calcul des rayons pour les points x = 0 et y = 0
1637 : *
1638 : inod = numnod ;
1639 :      xe1 ye1 ze1 = coord (p_e1t poin inod) ;
1640 :      xi1 yi1 zi1 = coord (p_i1t poin inod) ;
1641 :      re1x = (((xe1**2)+(ye1**2))**0.5) ;
1642 :      ri1x = (((xi1**2)+(yi1**2))**0.5) ;
1643 : inod = 1 ;
1644 :      xe1 ye1 ze1 = coord (p_e1t poin inod) ;
1645 :      xi1 yi1 zi1 = coord (p_i1t poin inod) ;
1646 :      re1y = (((xe1**2)+(ye1**2))**0.5) ;
1647 :      ri1y = (((xi1**2)+(yi1**2))**0.5) ;
1648 : *
1649 : lasc = l * a / c ;
1650 : *
1651 : *
1652 : * Calcul des angles a l'origine des points de p_e1t et p_i1t
1653 : *
1654 : angle1 = table ;
1655 : angli1 = table ;
1656 : numray = nbno p_e1t ;
1657 : inod = 0 ;
1658 : repe bouc7 numray ;
1659 :    inod = inod + 1 ;
1660 :    angle1 . inod = ((p_e1t poin inod) coor 2)
1661 :                  / ((p_e1t poin inod) coor 1) ;
1662 :    angli1 . inod = ((p_i1t poin inod) coor 2)
1663 :                  / ((p_i1t poin inod) coor 1) ;
1664 : fin bouc7 ;
1665 : *
1666 : * deplacement des points "interieurs"
1667 : * -----------------------------------
1668 : * affinite transformant la "presque ellipse" e0 en " presque cercle".
1669 : *
1670 : depl p_inter affi (a/c) p_pro_y p_y ;
1671 : *
1672 : * homothetie de centre (0 0 0) et de rapport dpsd. le rapport depend
1673 : * du point courant et est calcule en fonction des rayons des points
1674 : * de p_e1t et p_i1t, qui juxtaposent la projection du point courant
1675 : * sur ces memes contours
1676 : *
1677 : numnod = nbno p_inter ;
1678 : inod = 0 ;
1679 : repe bouc3 numnod ;
1680 :      inod = inod + 1 ;
1681 :      p = p_inter poin inod ;
1682 :      x y z = coor p ;
1683 :      r = ((x**2) + (y**2))**0.5 ;
1684 :      dmax1 = r*lasc/x ;
1685 :      dmax2 = r*t/y ;
1686 :      dmax = dmax1 ;
1687 :      si (dmax2 < dmax1) ; dmax = dmax2 ; finsi ;
1688 :      re1 = (((x/r*re1y)**2) + ((y/r*re1x)**2))**0.5 ;
1689 :      ri1 = (((x/r*ri1y)**2) + ((y/r*ri1x)**2))**0.5 ;
1690 : * calcul des rayons secants
1691 :      iray = 0 ;
1692 :      anglc = y / x ;
1693 :      ke1 = 0 ;
1694 :      ki1 = 0 ;
1695 :      repe bouc77 numray ;
1696 :         iray = iray + 1 ;
1697 :         si ( ega ke1 0 ) ;
1698 :         si ( anglc < angle1 . iray ); ie1 = iray ; ke1 = 1 ; finsi ;
1699 :         finsi ;
1700 :         si ( ega ki1 0 ) ;
1701 :         si ( anglc < angli1 . iray ); ii1 = iray ; ki1 = 1 ; finsi ;
1702 :         finsi ;
1703 :      fin bouc77 ;
1704 :      re1 = (rayone1 . ie1 + rayone1 . (ie1 - 1) ) / 2. ;
1705 :      ri1 = (rayoni1 . ii1 + rayoni1 . (ii1 - 1) ) / 2. ;
1706 : * fin de calcul des rayons secants
1707 :      dpsd = ((dmax-ri1) + (dmax/r*(ri1-re1)))/(dmax-re1) ;
1708 : * ccoo est un coefficient qui limite le deplacement des points en x
1709 : * ccoo est compris entre 0 et 1, et depend de la distance a l'axe Oy
1710 :      ccoo = (x/lasc)**2.0 ;
1711 :      dx = (x * dpsd - x)*ccoo ;
1712 :      dy = y * dpsd - y ;
1713 :      depl p plus (dx dy 0.) ;
1714 : fin bouc3 ;
1715 : *
1716 : * affinite inverse de la premiere, appliquee aux points interieurs
1717 : *
1718 : depl p_inter affi (c/a) p_pro_y p_y ;
1719 : *
1720 : * deplacement des points de lx0.
1721 : * ------------------------------
1722 : * homothetie de centre (0 0 0) et de rapport dpsd.
1723 : *
1724 : numnod = nbno p_lx0_2 ;
1725 : inod = 0 ;
1726 : repe bouc4 numnod ;
1727 :      inod = inod + 1 ;
1728 :      p = p_lx0_2 poin inod ;
1729 :      y = coor 2 p ;
1730 :      dpsd = ((t-ri1x) + (t/y*(ri1x-re1x)))/(t-re1x) ;
1731 :      dy = y * dpsd - y ;
1732 :      depl p plus (0. dy 0.) ;
1733 : fin bouc4 ;
1734 : *
1735 : * deplacement des points de ly0.
1736 : * ------------------------------
1737 : * affinite transformant la "presque ellipse" e0 en " presque cercle".
1738 : *
1739 : depl p_ly0_1 affi (a/c) p_pro_y p_y ;
1740 : *
1741 : * homothetie de centre (0 0 0) et de rapport dpsd.
1742 : *
1743 : numnod = nbno p_ly0_1 ;
1744 : inod = 0 ;
1745 : repe bouc5 numnod ;
1746 :      inod = inod + 1 ;
1747 :      p = p_ly0_1 poin inod ;
1748 :      x = coor 1 p ;
1749 :      dpsd = ((lasc-ri1y) + (lasc/x*(ri1y-re1y)))/(lasc-re1y) ;
1750 : * ccoo est un coefficient qui limite le deplacement des points en x
1751 : * ccoo est compris entre 0 et 1, et depend de la distance a l'axe Oy
1752 :      ccoo = (x/lasc)**2.0 ;
1753 :      dx = (x * dpsd - x)*ccoo ;
1754 :      depl p plus (dx 0. 0.) ;
1755 : fin bouc5 ;
1756 : *
1757 : * affinite inverse de la premiere.
1758 : *
1759 : depl p_ly0_1 affi (c/a) p_pro_y p_y ;
1760 : *
1761 : * rectification des cotes courbes de la surface se0
1762 : * -------------------------------------------------
1763 : numel = nbel se0 ;
1764 : iel = 0 ;
1765 : repeter bloc1 numel ;
1766 :    iel = iel + 1 ;
1767 :    elcour = se0 elem iel ;
1768 :    pcour = changer elcour poi1 ;
1769 :    pt1 = pcour poin 1 ;
1770 :    x1 = pt1 coor 1 ;
1771 :    y1 = pt1 coor 2 ;
1772 :    pt2 = pcour poin 2 ;
1773 :    x2 = pt2 coor 1 ;
1774 :    y2 = pt2 coor 2 ;
1775 :    pt3 = pcour poin 3 ;
1776 :    x3 = pt3 coor 1 ;
1777 :    y3 = pt3 coor 2 ;
1778 :    pt4 = pcour poin 4 ;
1779 :    x4 = pt4 coor 1 ;
1780 :    y4 = pt4 coor 2 ;
1781 :    pt5 = pcour poin 5 ;
1782 :    x5 = pt5 coor 1 ;
1783 :    y5 = pt5 coor 2 ;
1784 :    pt6 = pcour poin 6 ;
1785 :    x6 = pt6 coor 1 ;
1786 :    y6 = pt6 coor 2 ;
1787 :    pt7 = pcour poin 7 ;
1788 :    x7 = pt7 coor 1 ;
1789 :    y7 = pt7 coor 2 ;
1790 :    pt8 = pcour poin 8 ;
1791 :    x8 = pt8 coor 1 ;
1792 :    y8 = pt8 coor 2 ;
1793 :    dx2 = (0.5 * (x1 + x3) ) - x2 ;
1794 :    dy2 = (0.5 * (y1 + y3) ) - y2 ;
1795 :    depl pt2 plus (dx2 dy2 0) ;
1796 :    dx4 = (0.5 * (x3 + x5) ) - x4 ;
1797 :    dy4 = (0.5 * (y3 + y5) ) - y4 ;
1798 :    depl pt4 plus (dx4 dy4 0) ;
1799 :    dx6 = (0.5 * (x5 + x7) ) - x6 ;
1800 :    dy6 = (0.5 * (y5 + y7) ) - y6 ;
1801 :    depl pt6 plus (dx6 dy6 0) ;
1802 :    dx8 = (0.5 * (x7 + x1) ) - x8 ;
1803 :    dy8 = (0.5 * (y7 + y1) ) - y8 ;
1804 :    depl pt8 plus (dx8 dy8 0) ;
1805 : fin bloc1 ;
1806 : *
1807 : se0 = se0 coul blan ;
1808 : se1 = se1 coul vert ;
1809 : *
1810 : *
1811 : *  Creation du volume ME1
1812 : *  ----------------------
1813 : *
1814 : me1 = volu 1 se1 se0 ;
1815 : ***********
1816 : *
1817 : * Creation de la surface elliptique du volume ME1
1818 : * -----------------------------------------------
1819 : *
1820 : lextsup = lfrontex et lfronte1 ;
1821 : lextsup = lextsup plus (0 0 hh) ;
1822 : *
1823 : * tri de la ligne e0 pour sa creation en seg3
1824 : *
1825 : e0 = chan e0 poi1 ;
1826 : *
1827 : i = 0 ;
1828 : tab1 = table ;
1829 : tab2 = table ;
1830 : nbval = nbno e0 ;
1831 : repeter bouc5 nbval ;
1832 :  i = i + 1 ;
1833 :  pcour_c = e0 poin i ;
1834 :  xp = coor 1 pcour_c ;
1835 :  tab1 . i = xp ;
1836 :  tab2 . i = pcour_c ;
1837 : fin bouc5 ;
1838 : tab2 = @FIS_1 tab1 tab2 ;
1839 : *
1840 : nel = (nbval / 2 ) ;
1841 : *
1842 : i = -1 ;
1843 : repe bouc1 nel ;
1844 : i = i + 2 ;
1845 : si (i ega 1) ;
1846 : le0 = manu seg3 (tab2 . i) (tab2 . (i + 1))
1847 :                 (tab2 . (i + 2)) ;
1848 : sinon ;
1849 : l2 = manu seg3 (tab2 . i) (tab2 . (i + 1))
1850 :                (tab2 . (i + 2)) ;
1851 : le0 = le0 et l2 ;
1852 : finsi ;
1853 : *
1854 : fin bouc1 ;
1855 : *
1856 : le0 = inve le0 ;
1857 : spe = lextsup regler 1 le0 ;
1858 : *
1859 : * Creation de la surface elliptique du volume MI1
1860 : * -----------------------------------------------
1861 : *
1862 : lsup = (lfrontin et lfronti1) plus (0 0 hh) ;
1863 : linf = (lfrontin et lfronti1) plus (0 0 ep2) ;
1864 : *
1865 : spi = lsup regler 1 linf ;
1866 : *
1867 : * Creation du volume de la zone prismatique
1868 : * -----------------------------------------
1869 : *
1870 : si (nsdt ega 2) ;
1871 :    volpri = volu 2 spe spi ;
1872 : sinon ;
1873 :    volpri = volu 4 spe spi ;
1874 : finsi ;
1875 : *
1876 : elim volpri (c / 1.E3) ;
1877 : volpri = rege volpri ;
1878 : *
1879 : si (ndt ega 1) ;
1880 :    elim mtran2 volpri (c / 1.E3) ;
1881 : sinon ;
1882 :    elim mtran3 volpri (c / 1.E3) ;
1883 : finsi ;
1884 : *
1885 : elim volpri mi1 (c / 1.E3) ;
1886 : *
1887 : vtot = vtot et me1 et mi1 et volpri ;
1888 : elim vtot (c / 1.E4) ;
1889 : *
1890 : *
1891 : * ======================================================
1892 : * Creation des maillages grilles reguliers
1893 : * ----------------------------------------
1894 : *
1895 : si0 = sintsup plus (0 0 ep2) ;
1896 : *
1897 : * Nombre d'elements sur la droite y=0
1898 : nbel_fro = nbel lfrontin ;
1899 : nbel_lxe = nbel lxei ;
1900 : nbely0 = nbel_fro + nbel_lxe ;
1901 : *
1902 : l_elem = l / nbely0 ;
1903 : *
1904 : p1_n2 = 0 0 0 ;
1905 : p2_n2 = (l_elem * nbel_fro) 0 0 ;
1906 : p3_n2 = (coor 1 p2_n2) (coor 2 p11n3) 0 ;
1907 : p4_n2 = 0 (coor 2 p11n3) 0 ;
1908 : p5_n2 = (coor 1 p2_n2) t 0 ;
1909 : *
1910 : l1_n2 = p3_n2 d nbel_fro p4_n2 ;
1911 : l2_n2 = p4_n2 d 2 p1_n2 ;
1912 : l3_n2 = p1_n2 d nbel_fro p2_n2 ;
1913 : l4_n2 = p2_n2 d 2 p3_n2 ;
1914 : *
1915 : l5_n2 = r1 d 2 p2_n2 ;
1916 : l6_n2 = p11n3 d 2 r1 ;
1917 : l7_n2 = p3_n2 d 2 p11n3 ;
1918 : l8_n2 = p11n3 d 2 r2 ;
1919 : l9_n2 = lxee1 ;
1920 : *l9_n2 = r2 d 2 p5_n2 ;
1921 : *l10_n2 = p5_n2 d 2 p3_n2 ;
1922 : l10_n2 = p11n2 d 2 p3_n2 ;
1923 : l11_n2 = lxee2 ;
1924 : *l11_n2 = r3 d nbel_fro p5_n2 ;
1925 : l12_n2 = p4_n2 d 2 r3 ;
1926 : *
1927 : si2_r = l1_n2 l2_n2 l3_n2 l4_n2 dall plan ;
1928 : *
1929 : se21_r = l5_n2 l4_n2 l7_n2 l6_n2 dall plan ;
1930 : se22_r = l10_n2 l7_n2 l8_n2 l9_n2 dall plan ;
1931 : se23_r = l1_n2 l12_n2 l11_n2 l10_n2 dall plan ;
1932 : *
1933 : si0_inf = si2_r plus (0 0 ep3) ;
1934 : *
1935 : se01_inf = se21_r plus (0 0 ep3) ;
1936 : se02_inf = se22_r plus (0 0 ep3) ;
1937 : se03_inf = se23_r plus (0 0 ep3) ;
1938 : *
1939 : vi_inf = volu 1 si0_inf si0 ;
1940 : ve1_inf = volu 1 se01_inf se01 ;
1941 : ve2_inf = volu 1 se02_inf se02 ;
1942 : ve3_inf = volu 1 se03_inf se03 ;
1943 : *
1944 : v_inf = vi_inf et ve1_inf et ve2_inf et ve3_inf ;
1945 : *
1946 : vbas = v_inf et mi1 et me1 et volpri ;
1947 : elim vbas (c / 1.E3) ;
1948 : *
1949 : vtot = vtot et v_inf ;
1950 : *
1951 : vtot_env = enve vtot ;
1952 : *
1953 : * MODIF BC 30/04/96
1954 : * elimination des points doubles avec le bloc superieur
1955 : * dont on a extrait la surface selim
1956 : *
1957 : *mess 'debut cmodif bc 30/04/96 ';
1958 : celim = c / 1.E2 ;
1959 : si ( celim >EG (rc0/10.) ) ;
1960 : celim = rc0 / 10. ;
1961 : *mess 'celim = rc0 / 10.  celim = ' celim ;
1962 : finsi ;
1963 : 
1964 : elim ( vbas et selim ) celim ;
1965 : vtot = rege vtot ;
1966 : *vtot_env = enve vtot ;
1967 : *trac oeil vtot_env   ;
1968 : *vbas_env = enve vbas ;
1969 : *trac oeil vbas_env   ;
1970 : *mess 'fin cmodif bc 30/04/96 ';
1971 : 
1972 : *FIN MODIF BC 30/04/96
1973 : *
1974 : *  Creation du volume complementaire inferieur du bloc initial
1975 : *  pour obtenir h
1976 : *  -----------------------------------------------------------
1977 : *
1978 : si (ral_bloc ega 1) ;
1979 : *
1980 : p_se_inf = vtot poin plan (0 0 ep3) (0 1 ep3)
1981 :                           (1 0 ep3) (c / 1.E4) ;
1982 : *
1983 : se_inf = vtot_env elem appuye strictement p_se_inf ;
1984 : se_inf = se_inf orienter direction (0 0 -1) ;
1985 : *
1986 : * nelh = nombre d'elements dans la hauteur du volume
1987 : nelh = xh ;
1988 : *
1989 : vral_blo = se_inf volu tran nelh (0 0 (-1. * (ho + ep3))) ;
1990 : *
1991 : vtot = vtot et vral_blo ;
1992 : *
1993 : *
1994 : finsi ;
1995 : *
1996 : *
1997 : * Creation du volume complementaire inferieur en dehors du
1998 : * bloc initial pour obtenir h
1999 : * --------------------------------------------------------
2000 : *
2001 : ral_tl = 0 ;
2002 : *
2003 : si ((rallon ega 1) et (xt neg 0)) ;
2004 : *
2005 :    si (ind_vlat ega 1) ;
2006 :       p_hor_in = (var_com et vlat_com) poin plan
2007 :                                        (0 0 hh) (0 1 hh)
2008 :                                        (1 0 hh) (c / 1.E4) ;
2009 :       enve_com = enve (var_com et vlat_com) ;
2010 : *
2011 : ral_tl = 1 ;
2012 : *
2013 :    sinon ;
2014 : *
2015 :          p_hor_in = var_com poin plan
2016 :                             (0 0 hh) (0 1 hh)
2017 :                             (1 0 hh) (c / 1.E4) ;
2018 :       enve_com = enve var_com ;
2019 :    finsi ;
2020 : *
2021 : hor_inf = enve_com elem appuye
2022 :           strictement p_hor_in ;
2023 : hor_inf = hor_inf orienter direction (0 0 -1) ;
2024 : *
2025 :    vral_hor = hor_inf volu tran 1 (0 0 (ep2 - hh))
2026 :                       volu tran 1 (0 0 (ep3 - ep2)) ;
2027 : *
2028 :   si (ral_bloc ega 1) ;
2029 :     vral_hor = vral_hor volu tran xh (0 0 (-1. * (ho + ep3))) ;
2030 :   finsi ;
2031 : *
2032 : vtot = vtot et vral_hor ;
2033 : elim vtot (c / 1.E6) ;
2034 : *
2035 : finsi ;
2036 : *
2037 : si (ral_tl ega 0) ;
2038 : *
2039 : si (ind_vlat ega 1) ;
2040 : *
2041 :    si ((rallon ega 1) et (xt neg 0)) ;
2042 :       p_hor_in = (var_com et vlat_com) poin plan
2043 :                             (0 0 hh) (0 1 hh)
2044 :                             (1 0 hh) (c / 1.E4) ;
2045 :       enve_com = enve (var_com et vlat_com) ;
2046 :    sinon ;
2047 :             p_hor_in = vlat_com poin plan
2048 :                                 (0 0 hh) (0 1 hh)
2049 :                                 (1 0 hh) (c / 1.E4) ;
2050 :       enve_com = enve vlat_com ;
2051 :    finsi ;
2052 : hor_inf = enve_com elem appuye
2053 :           strictement p_hor_in ;
2054 : hor_inf = hor_inf orienter direction (0 0 -1) ;
2055 : *
2056 :    vral_hor = hor_inf volu tran 1 (0 0 (ep2 - hh))
2057 :                       volu tran 1 (0 0 (ep3 - ep2)) ;
2058 : *
2059 :   si (ral_bloc ega 1) ;
2060 :     vral_hor = vral_hor volu tran xh (0 0 (-1. * (ho + ep3))) ;
2061 :   finsi ;
2062 : *
2063 : vtot = vtot et vral_hor ;
2064 : elim vtot (c / 1.E6) ;
2065 : *
2066 : finsi ;
2067 : *
2068 : finsi ;
2069 : *
2070 : vtot_env = enve vtot ;
2071 : *
2072 : * recuperation des surfaces (sinf , sar , slat)
2073 : * ---------------------------------------------
2074 : *
2075 : pslat = vtot poin plan (lo 0 0) (lo 1 0) (lo 0 1) (c / 1.E4) ;
2076 : slat = vtot_env elem appuye strictement pslat ;
2077 : slat = slat orienter direction (1 0 0) ;
2078 : *
2079 : *
2080 : psar = vtot poin plan (0 to 0) (1 to 0) (0 to 1) (c / 1.E4) ;
2081 : sar = vtot_env elem appuye strictement psar ;
2082 : sar = sar orienter direction (0 1 0) ;
2083 : *
2084 : * CMODI BK 16/8/95
2085 : * Rajout du test (ral_bloc ega 0)
2086 : *
2087 : si (ral_bloc ega 0) ;
2088 : psinf = vtot poin plan (0 0 ep3) (0 1 ep3)
2089 :                        (1 0 ep3) (c / 1.E4) ;
2090 : *
2091 : sinon ;
2092 : psinf = vtot poin plan (0 0 (-1 * ho)) (0 1 (-1 * ho))
2093 :                        (1 0 (-1 * ho)) (c / 1.E4) ;
2094 : *
2095 : finsi ;
2096 : *
2097 : sinf = vtot_env elem appuye strictement psinf ;
2098 : sinf = sinf orienter direction (0 0 -1) ;
2099 : *
2100 : * recuperation des surfaces (ssup_s , sav_s , slat_s)
2101 : * ---------------------------------------------------
2102 : *
2103 : pslat_s = vtot poin plan (0 0 0) (0 1 0) (0 0 1) (c / 1.E4) ;
2104 : slat_s = vtot_env elem appuye strictement pslat_s ;
2105 : slat_s = slat_s orienter direction (-1000. 0. 0.) ;
2106 : *
2107 : psav_s = vtot poin plan (0 0 0) (1 0 0) (0 0 1) (c / 1.E4) ;
2108 : sav_s = vtot_env elem appuye strictement psav_s ;
2109 : *
2110 : *
2111 : sav_s = sav_s orienter direction (0 -1 0) ;
2112 : *
2113 : si ((rallon ega 1) et (ind_vlat ega 1)) ;
2114 :  si (ega ndt 1) ;
2115 :     si (ega nsdt 2) ;
2116 :     pssup_s = (vext et mtran24 et var_com et vlat_com) poin plan
2117 :               (0 0 0) (1 0 0) (0 1 0) (c / 1.E4) ;
2118 :     sinon ;
2119 :     pssup_s = (vext et mtran28 et var_com et vlat_com) poin plan
2120 :               (0 0 0) (1 0 0) (0 1 0) (c / 1.E4) ;
2121 :     finsi ;
2122 :  sinon ;
2123 : *
2124 :     si (ega nsdt 2) ;
2125 :     pssup_s = (vext et mtran24 et mtran34 et var_com et vlat_com)
2126 :               poin plan (0 0 0) (1 0 0) (0 1 0) (c / 1.E4) ;
2127 :     sinon ;
2128 :     pssup_s = (vext et mtran28 et mtran38 et var_com et vlat_com)
2129 :               poin plan (0 0 0) (1 0 0) (0 1 0) (c / 1.E4) ;
2130 :     finsi ;
2131 :  finsi ;
2132 : finsi ;
2133 : *
2134 : si ((rallon ega 0) et (ind_vlat ega 0)) ;
2135 :  si (ega ndt 1) ;
2136 :     si (ega nsdt 2) ;
2137 :     pssup_s = (vext et mtran24) poin plan
2138 :               (0 0 0) (1 0 0) (0 1 0) (c / 1.E4) ;
2139 :     sinon ;
2140 :     pssup_s = (vext et mtran28) poin plan
2141 :               (0 0 0) (1 0 0) (0 1 0) (c / 1.E4) ;
2142 :     finsi ;
2143 :  sinon ;
2144 :     si (ega nsdt 2) ;
2145 :     pssup_s = (vext et mtran24 et mtran34 )
2146 :               poin plan (0 0 0) (1 0 0) (0 1 0) (c / 1.E4) ;
2147 :     sinon ;
2148 :     pssup_s = (vext et mtran28 et mtran38 )
2149 :               poin plan (0 0 0) (1 0 0) (0 1 0) (c / 1.E4) ;
2150 :     finsi ;
2151 :  finsi ;
2152 : finsi ;
2153 : *
2154 : si ((rallon ega 1) et (ind_vlat ega 0)) ;
2155 :  si (ega ndt 1) ;
2156 :     si (ega nsdt 2) ;
2157 :     pssup_s = (vext et mtran24 et var_com ) poin plan
2158 :               (0 0 0) (1 0 0) (0 1 0) (c / 1.E4) ;
2159 :     sinon ;
2160 :     pssup_s = (vext et mtran28 et var_com ) poin plan
2161 :               (0 0 0) (1 0 0) (0 1 0) (c / 1.E4) ;
2162 :     finsi ;
2163 :  sinon ;
2164 :     si (ega nsdt 2) ;
2165 :     pssup_s = (vext et mtran24 et mtran34 et var_com )
2166 :               poin plan (0 0 0) (1 0 0) (0 1 0) (c / 1.E4) ;
2167 :     sinon ;
2168 :     pssup_s = (vext et mtran28 et mtran38 et var_com )
2169 :               poin plan (0 0 0) (1 0 0) (0 1 0) (c / 1.E4) ;
2170 :     finsi ;
2171 :  finsi ;
2172 : finsi ;
2173 : *
2174 : si ((rallon ega 0) et (ind_vlat ega 1)) ;
2175 :  si (ega ndt 1) ;
2176 :     si (ega nsdt 2) ;
2177 :     pssup_s = (vext et mtran24 et vlat_com ) poin plan
2178 :               (0 0 0) (1 0 0) (0 1 0) (c / 1.E4) ;
2179 :     sinon ;
2180 :     pssup_s = (vext et mtran28 et vlat_com ) poin plan
2181 :               (0 0 0) (1 0 0) (0 1 0) (c / 1.E4) ;
2182 :     finsi ;
2183 :  sinon ;
2184 :     si (ega nsdt 2) ;
2185 :     pssup_s = (vext et mtran24 et mtran34 et vlat_com )
2186 :               poin plan (0 0 0) (1 0 0) (0 1 0) (c / 1.E4) ;
2187 :     sinon ;
2188 :     pssup_s = (vext et mtran28 et mtran38 et vlat_com )
2189 :               poin plan (0 0 0) (1 0 0) (0 1 0) (c / 1.E4) ;
2190 :     finsi ;
2191 :  finsi ;
2192 : finsi ;
2193 : *
2194 : *
2195 : ssup_s = vtot_env elem appuye strictement pssup_s ;
2196 : *
2197 : ssup_s = ssup_s et linf_bex ;
2198 : ssup_s = ssup_s orienter direction (0 0 1) ;
2199 : *
2200 : *sort vtot ;
2201 : *sauv 'FORMATTE' vtot;
2202 : *
2203 : finproc vtot lff levreinf sar slat sinf sav_s ssup_s
2204 :         slat_s boudin ep3 ;
2205 : 
2206 :  
2207 :  

© Cast3M 2003 - All rights reserved.
Disclaimer