Télécharger la plaquette Cast3M


fr en

Télécharger @FIS_3.procedur

Retour à la liste

Numérotation des lignes : 

  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 &lt;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 &lt;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.  
  2208.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales