Télécharger la plaquette Cast3M


fr en

Télécharger @inclusi.procedur

Retour à la liste

Numérotation des lignes : 

  1. * @INCLUSI  PROCEDUR  SP204843  24/03/15    21:15:05     11871          
  2. 'DEBP' @INCLUSI THO7U*'TABLE' DPAR1*'FLOTTANT' DREP1*'FLOTTANT' ;
  3. *                                                                      *
  4. *----------------------------------------------------------------------*
  5. *                                                                      *
  6. *              Pre-traitement Maillage Particules-Matrice              *
  7. *                                                                      *
  8. *----------------------------------------------------------------------*
  9. *                                                                      *
  10. *------------------------ Lecture des entrees -------------------------*
  11. *                                                                      *
  12. * Entrees :                                                            *
  13. * ---------                                                            *
  14. * THO7U  : Table maillage cube Voronoi ;                               *
  15. * DPAR1  : Diametre des particules ;                                   *
  16. * DREP1  : Distance de repulsion ;                                     *
  17. * DENS1  : Densite de reference ;                                      *
  18. * ITRA1  : Indicateur traces ;                                         *
  19. 'ARGU' DENS1/'FLOTTANT' ;
  20. 'SI' ('NON' ('EXIS' DENS1)) ;
  21.   DENS1    = 0.25 * (('FLOT' ('NBNO' THO7U . 'MPT')) ** (-1. / 3.)) ;
  22. 'FINS' ;
  23. 'ARGU' ITRA1/'LOGIQUE' ;
  24. 'SI' ('NON' ('EXIS' ITRA1)) ;
  25.   ITRA1    = FAUX ;
  26. 'FINS' ;
  27. *                                                                      *
  28. * Variables locales :                                                  *
  29. * -------------------                                                  *
  30. * VOR1  : Maillage aretes cellules de Voronoi ;                        *
  31. * MPOI1  : Points centre des cellules ;                                *
  32. * RPAR1  : Rayon des particules ;                                      *
  33. * ELIGM1 : Epaisseur Minimale des ligaments de matrice ;               *
  34. * FTET1  : Facteur de forme des tetraedres (rapport Cote/Hauteur       *
  35. *          tetraedre regulier) ;                                       *
  36. * DENSM1 : Densite minimale du maillage ~ demi-distance entre + petit  *
  37. *          ligament de matrice possible (au facteur de forme Pres) ;   *
  38. * XELIM1 : Facteur d'elimination noeuds des polyedres ;                *
  39. * RELIM1 : Rayon d'elimination des noeuds sommets des cellules de      *
  40. *          Voronoi ;                                                   *
  41. * TOL1   : Tolerance ~ precision de la geometrie ;                     *
  42. * 
  43. * 
  44. MVOR1    = THO7U . 'MAV' ;
  45. MPOI1    = THO7U . 'MPT' ;
  46. RPAR1    = 0.5 * DPAR1 ;
  47. ELIGM1   = (0.5 * DREP1) - RPAR1 ;
  48. FTET1    = 1.5 ** 0.5 ;
  49. DENSM1   = FTET1 * ELIGM1 ;
  50. XELIM1   = 0.2 ;
  51. RELIM1   = XELIM1 * DENS1 ;
  52. TOL1     = 1.E-3 * ELIGM1 ;
  53. *                                                                      *
  54. *------ Elimination Sommets "Tres Proches" Cellules de Voronoi --------*
  55. *                                                                      *
  56. * Elimination des petites aretes de la partition de Voronoi :          *
  57. 'ELIM' MVOR1 RELIM1 ;
  58. *                                                                      *
  59. * Recollement des faces de la partition sur celle du cube unite :      *
  60. PM1      = 0. 0. 0. ;
  61. PM2      = 1. 0. 0. ;
  62. PM3      = 1. 1. 0. ;
  63. PM4      = 0. 1. 0. ;
  64. PM5      = 0. 0. 1. ;
  65. PM6      = 1. 0. 1. ;
  66. PM7      = 1. 1. 1. ;
  67. PM8      = 0. 1. 1. ;
  68. 'DEPL' (THO7U . 'FACE1') 'PROJ' 'DIRE' (-1. * PM5) 'PLAN' PM1 PM2 PM3 ;
  69. 'DEPL' (THO7U . 'FACE2') 'PROJ' 'DIRE' (-1. * PM4) 'PLAN' PM1 PM2 PM5 ;
  70. 'DEPL' (THO7U . 'FACE3') 'PROJ' 'DIRE' (-1. * PM2) 'PLAN' PM1 PM4 PM5 ;
  71. 'DEPL' (THO7U . 'FACE4') 'PROJ' 'DIRE' PM2 'PLAN' PM2 PM3 PM6 ;
  72. 'DEPL' (THO7U . 'FACE5') 'PROJ' 'DIRE' PM4 'PLAN' PM3 PM4 PM7 ;
  73. 'DEPL' (THO7U . 'FACE6') 'PROJ' 'DIRE' PM5 'PLAN' PM5 PM6 PM7 ;
  74. *                                                                      *
  75. VELE1    = 'VALE' 'ELEM' ;
  76. 'OPTI' 'ELEM' 'CUB8' ;
  77. MVCB1    = ((PM1 'DROI' 1 PM2) 'TRAN' 1 PM4) 'VOLU' 'TRAN' 1 PM5 ;
  78. 'OPTI' 'ELEM' VELE1 ;
  79. MSCB1    = 'ENVE' MVCB1 ;
  80. MACB1    = 'ARET' MVCB1 ;
  81. MPCB1    = 'CHAN' 'POI1' MVCB1 ;
  82. *                                                                      *
  83. *----------------------- Travail Preparatoire -------------------------*
  84. *                                                                      *
  85. *   1. "Nettoyer" les contours des faces + Reperage Faces Bord Cube ;  *
  86. *   2. Reperer les aretes ;                                            *
  87. *                                                                      *
  88. * 1. Nettoyages des Faces + Reperage Faces Bord Cube :                 *
  89. NBI1     = 'NBEL' MPOI1 ;
  90. TIP8V    = 'TABL' ;
  91. IPREMI1  = VRAI ;
  92. 'REPE' BI1 NBI1 ;
  93.   PCI1     = MPOI1 'POIN' &BI1 ;
  94.   TIP8V . PCI1 = 'TABL' ;
  95.   MPTI1    = THO7U . PCI1 . 'MPT' ;
  96.   NBJ1     = NBNO MPTI1 ;
  97.   IPREMJ1  = VRAI ;
  98. *                                                                      *
  99. * Boucle sur les faces des polyedres :                                 *
  100.   'REPE' BJ1 NBJ1 ;
  101.     PCJ1     = MPTI1 'POIN' &BJ1 ;
  102.     CNTIJ1   = THO7U . PCI1 . PCJ1 . 'MAV' ;
  103.     NBPCIJ1  = NBNO CNTIJ1 ;
  104.     'SI' (NBPCIJ1 '<' 3) ;
  105.       'ITER' BJ1 ;
  106.     'FINS' ;
  107. *                                                                      *
  108. *   Si cette Face a deja ete traitee, on recopie puis on itere :       *
  109.     'SI' ('EXIS' TIP8V PCJ1) ;
  110.       TIP8V . PCI1 . PCJ1 = 'TABL' ;
  111.       TIP8V . PCI1 . PCJ1 . 'MAV' = TIP8V . PCJ1 . PCI1 . 'MAV' ;
  112.       TIP8V . PCI1 . PCJ1 . 'EXT' = TIP8V . PCJ1 . PCI1 . 'EXT' ;
  113.       'SI' IPREMJ1 ;
  114.         IPREMJ1  = FAUX ;
  115.         TIP8V . PCI1 . 'MPT' = PCJ1 ;
  116.         TIP8V . PCI1 . 'MAV' = TIP8V . PCJ1 . PCI1 . 'MAV' ;
  117.       'SINO' ;
  118.         TIP8V . PCI1 . 'MPT' = TIP8V . PCI1 . 'MPT' 'ET' PCJ1 ;
  119.         TIP8V . PCI1 . 'MAV' = TIP8V . PCI1 . 'MAV'
  120.           'ET' TIP8V . PCJ1 . PCI1 . 'MAV' ;
  121.       'FINS' ;
  122.       'ITER' BJ1 ;
  123.     'FINS' ;
  124. *                                                                      *
  125. *   Sinon, on teste NBNO-NBEL pour det. presence aretes degenerees :   *
  126. *   CNTIJ2 sera le contour valide de la Face.                          *
  127.     'SI' (NBPCIJ1 'EGA' ('NBEL' CNTIJ1)) ;
  128.       CNTIJ2   = CNTIJ1 ;
  129.     'SINO' ;
  130. *     Si aretes degenerees => reconstruction du contour :              *
  131.       NBK1     = 'NBEL' CNTIJ1 ;
  132.       IPREMK1  = VRAI ;
  133.       'REPE' BK1 NBK1 ;
  134.         ELK1     = CNTIJ1 'ELEM' &BK1 ;
  135.         PSK1     = ELK1 'POIN' 1 ;
  136.         PSK2     = ELK1 'POIN' 2 ;
  137.         'SI' (PSK1 'NEG' PSK2) ;
  138.           'SI' IPREMK1 ;
  139.             IPREMK1  = FAUX ;
  140.             CNTIJ2   = ELK1 ;
  141.           'SINO' ;
  142.             CNTIJ2   = CNTIJ2 'ET' ELK1 ;
  143.           'FINS' ;
  144.         'FINS' ;
  145.       'FIN' BK1 ;
  146.     'FINS' ;
  147. *   On ordonne CNTIJ2 ;                                                *
  148.     CNTIJ2   = CNTIJ2 'ELEM' 'COMP' (CNTIJ2 'POIN' 1)
  149.                                     (CNTIJ2 'POIN' 1) ;
  150. *                                                                      *
  151. *   Construction d'un point ref. pour la Face Si Face situee sur les   *
  152. *   Bords du Cube (PCJ2) :                                             *
  153.     IEXT1    = 'NON' ('EXIS' THO7U PCJ1) ;
  154.     'SI' IEXT1 ;
  155.       NX0      = 0 ; NY0      = 0 ; NZ0      = 0 ;
  156.       NX1      = 0 ; NY1      = 0 ; NZ1      = 0 ;
  157.       NBK1     = NBNO CNTIJ2 ;
  158.       'REPE' BK1 NBK1 ;
  159.         PSK1     = CNTIJ2 'POIN' &BK1 ;
  160.         XK1 YK1 ZK1 = PSK1 'COOR' ;
  161.         'SI' (XK1 'EGA' 0.) ; NX0 = NX0 + 1 ; 'FINS' ;
  162.         'SI' (YK1 'EGA' 0.) ; NY0 = NY0 + 1 ; 'FINS' ;
  163.         'SI' (ZK1 'EGA' 0.) ; NZ0 = NZ0 + 1 ; 'FINS' ;
  164.         'SI' (XK1 'EGA' 1.) ; NX1 = NX1 + 1 ; 'FINS' ;
  165.         'SI' (YK1 'EGA' 1.) ; NY1 = NY1 + 1 ; 'FINS' ;
  166.         'SI' (ZK1 'EGA' 1.) ; NZ1 = NZ1 + 1 ; 'FINS' ;
  167.       'FIN' BK1 ;
  168.       NMAX1    = 'MAXI' ('LECT' NX0 NY0 NZ0 NX1 NY1 NZ1) ;
  169.       'SI' (NMAX1 'EGA' NX0) ;
  170.         PRCIJ1   = PM1 ;
  171.         PNCIJ1   = -1. 0. 0. ;
  172.       'FINS' ;
  173.       'SI' (NMAX1 'EGA' NX1) ;
  174.         PRCIJ1   = PM2 ;
  175.         PNCIJ1   =  1. 0. 0. ;
  176.       'FINS' ;
  177.       'SI' (NMAX1 'EGA' NY0) ;
  178.         PRCIJ1   = PM1 ;
  179.         PNCIJ1   = 0. -1. 0. ;
  180.       'FINS' ;
  181.       'SI' (NMAX1 'EGA' NY1) ;
  182.         PRCIJ1   = PM4 ;
  183.         PNCIJ1   =  0. 1. 0. ;
  184.       'FINS' ;
  185.       'SI' (NMAX1 'EGA' NZ0) ;
  186.         PRCIJ1   = PM1 ;
  187.         PNCIJ1   = 0. 0. -1. ;
  188.       'FINS' ;
  189.       'SI' (NMAX1 'EGA' NZ1) ;
  190.         PRCIJ1   = PM5 ;
  191.         PNCIJ1   =  0. 0. 1. ;
  192.       'FINS' ;
  193. *List NMAX1 ; List PRCIJ1 ; List PNCIJ1 ;
  194. *Trac ((CNTIJ2 Coul Roug) Et A1) ;
  195.       XR1 YR1 ZR1 = PNCIJ1 'COOR' ;
  196.       PTCIJ1   = ZR1 XR1 YR1 ;
  197.       PTCIJ2   = YR1 ZR1 XR1 ;
  198.       PPCIJ1   = PRCIJ1 'PLUS' PTCIJ1 ;
  199.       PPCIJ2   = PRCIJ1 'PLUS' PTCIJ2 ;
  200.       PCJ2     = PCI1 'SYME' 'PLAN' PRCIJ1 PPCIJ1 PPCIJ2 ;
  201. *Trac Qual ((CNTIJ2 Coul Rose) Et THO7U . PCI1 . Mav Et PCI1 Et PCJ2) ;
  202.     'SINO' ;
  203.       PCJ2     = PCJ1 ;
  204.     'FINS' ;
  205.     TIP8V . PCI1 . PCJ2 = 'TABL' ;
  206.     TIP8V . PCI1 . PCJ2 . 'MAV' = CNTIJ2 ;
  207.     TIP8V . PCI1 . PCJ2 . 'EXT' = IEXT1 ;
  208.     'SI' IPREMJ1 ;
  209.       IPREMJ1  = FAUX ;
  210.       TIP8V . PCI1 . 'MPT' = 'MANU' 'POI1' PCJ2 ;
  211.       TIP8V . PCI1 . 'MAV' = CNTIJ2 ;
  212.     'SINO' ;
  213.       TIP8V . PCI1 . 'MPT' = TIP8V . PCI1 . 'MPT' 'ET' PCJ2 ;
  214.       TIP8V . PCI1 . 'MAV' = TIP8V . PCI1 . 'MAV' 'ET' CNTIJ2 ;
  215.     'FINS' ;
  216.   'FIN' BJ1 ;
  217.   'SI' (('DIME' TIP8V . PCI1) '>' 0) ;
  218.     'SI' IPREMI1 ;
  219.       IPREMI1  = FAUX ;
  220.       TIP8V . 'MPT' = 'MANU' 'POI1' PCI1 ;
  221.       TIP8V . 'MAV' = TIP8V . PCI1 . 'MAV' ;
  222.     'SINO' ;
  223.       TIP8V . 'MPT' = TIP8V . 'MPT' 'ET' PCI1 ;
  224.       TIP8V . 'MAV' = TIP8V . 'MAV' 'ET' TIP8V . PCI1 . 'MAV' ;
  225.     'FINS' ;
  226.   'FINS' ;
  227. 'FIN' BI1 ;
  228. MPOI1    = TIP8V . 'MPT' ;
  229. *                                                                      *
  230. * 2. Reperer les aretes par les 3 polyedres qui les definissent :      *
  231. *                                                                      *
  232. NBI1     = NBNO MPOI1 ;
  233. THO7U    = 'TABL' ;
  234. IPREMI1  = VRAI ;
  235. 'REPE' BI1 NBI1 ;
  236.   PCI1     = MPOI1 'POIN' &BI1 ;
  237.   THO7U . PCI1 = 'TABL' ;
  238.   MPTI1    = TIP8V . PCI1 . 'MPT' ;
  239.   NBJ1     = NBNO MPTI1 ;
  240.   IPREMJ1  = VRAI ;
  241.   'REPE' BJ1 NBJ1 ;
  242.     PCJ1     = MPTI1 'POIN' &BJ1 ;
  243.     THO7U . PCI1 . PCJ1 = 'TABL' ;
  244.     CNTIJ1   = TIP8V . PCI1 . PCJ1 . 'MAV' ;
  245.     'SI' ('EXIS' THO7U PCJ1) ;
  246.       MPTIJ2   = THO7U . PCJ1 . PCI1 . 'MPT' ;
  247.       CNTIJ2   = THO7U . PCJ1 . PCI1 . 'MAV' ;
  248.       THO7U . PCI1 . PCJ1 = THO7U . PCJ1 . PCI1 ;
  249.     'SINO' ;
  250.       MPTIJ1   = MPTI1 'DIFF' ('MANU' 'POI1' PCJ1) ;
  251.       NBK1     = 'NBEL' CNTIJ1 ;
  252.       IPREMK1  = VRAI ;
  253.       'REPE' BK1 NBK1 ;
  254.         ELK1     = CNTIJ1 'ELEM' &BK1 ;
  255.         NBL1     = NBNO MPTIJ1 ;
  256.         'REPE' BL1 NBL1 ;
  257.           PCL1     = MPTIJ1 'POIN' &BL1 ;
  258.           CNTIL1   = TIP8V . PCI1 . PCL1 . 'MAV' ;
  259.           ELL1     = CNTIJ1 'INTE' CNTIL1 'NOVE' ;
  260.           NBM1     = 'NBEL' ELL1 ;
  261.           'SI' (NBM1 'NEG' 0) ;
  262.             'REPE' BM1 NBM1 ;
  263.               ELM1     = ELL1 'ELEM' &BM1 ;
  264.               'SI' ((NBNO (ELK1 'DIFF' ELM1)) 'EGA' 0) ;
  265.                 'SI' ('EXIS' THO7U . PCI1 . PCJ1 PCL1) ;
  266.                   THO7U . PCI1 . PCJ1 . PCL1 . 'MAV' =
  267.                     THO7U . PCI1 . PCJ1 . PCL1 . 'MAV' 'ET' ELK1 ;
  268.                 'SINO' ;
  269.                   THO7U . PCI1 . PCJ1 . PCL1 = 'TABL' ;
  270.                   THO7U . PCI1 . PCJ1 . PCL1 . 'MAV' = ELK1 ;
  271.                 'FINS' ;
  272.                 'SI' IPREMK1 ;
  273.                   IPREMK1  = FAUX ;
  274.                   MPTIJ2   = 'MANU' 'POI1' PCL1 ;
  275.                   CNTIJ2   = ELM1 ;
  276.                 'SINO' ;
  277.                   'SI' ('NON' ('DANS' PCL1 MPTIJ2)) ;
  278.                     MPTIJ2   = MPTIJ2 'ET' PCL1 ;
  279.                   'FINS' ;
  280.                   CNTIJ2   = CNTIJ2 'ET' ELM1 ;
  281.                 'FINS' ;
  282.                 'ITER' BK1 ;
  283.               'FINS' ;
  284.             'FIN' BM1 ;
  285.           'FINS' ;
  286.         'FIN' BL1 ;
  287.       'FIN' BK1 ;
  288.       THO7U . PCI1 . PCJ1 . 'MPT' = MPTIJ2 ;
  289.       THO7U . PCI1 . PCJ1 . 'MAV' = CNTIJ2 ;
  290.     'FINS' ;
  291.     'SI' IPREMJ1 ;
  292.       IPREMJ1  = FAUX ;
  293.       MPTI2    = 'MANU' 'POI1' PCJ1 ;
  294.       MAVI2    = CNTIJ2 ;
  295.     'SINO' ;
  296.       MPTI2    = MPTI2 'ET' PCJ1 ;
  297.       MAVI2    = MAVI2 'ET' CNTIJ2 ;
  298.     'FINS' ;
  299. *   Petit Test :                                                       *
  300.     MTEST1   = CNTIJ2 'DIFF' CNTIJ1 ;
  301.     'SI' (((NBNO MTEST1) + ('NBEL' MTEST1)) 'NEG' 0) ;
  302.       'SAUT' 1 'LIGN' ;
  303.       'TITR' ' ***** Probleme Reperage Aretes ' ;
  304.       'TRAC' (CNTIJ1 'ET' (CNTIJ2 'COUL' 'ORAN')) ;
  305.       'QUIT' BI1 ;
  306.     'FINS' ;
  307. *   Re-petit test : on verifie qu'en parcourant les points de MPTIJ2,  *
  308. *                   on parcourt de facon ordonnee le contour :         *
  309. *    'REPE' BX1 (NBNO MPTIJ2) ;
  310. *      PX1      = MPTIJ2 'POIN' &BX1 ;
  311. *    Trac Elem (CNTIJ1 Et (THO7U . PCI1 . PCJ1 . PX1 . Mav Coul Vert)) ;
  312. *    'FIN' BX1 ;
  313.   'FIN' BJ1 ;
  314. * Stockage resultats boucle BI1 :                                      *
  315.   THO7U . PCI1 . 'MPT' = MPTI2 ;
  316.   THO7U . PCI1 . 'MAV' = MAVI2 ;
  317.   'SI' IPREMI1 ;
  318.     IPREMI1  = FAUX ;
  319.     MPT2     = 'MANU' 'POI1' PCI1 ;
  320.     MAV2     = MAVI2 ;
  321.   'SINO' ;
  322.     MPT2     = MPT2 'ET' PCI1 ;
  323.     MAV2     = MAV2 'ET' MAVI2 ;
  324.   'FINS' ;
  325. 'FIN' BI1 ;
  326. THO7U . 'MPT' = MPT2 ;
  327. THO7U . 'MAV' = MAV2 ;
  328. *                                                                      *
  329. *----------------------------------------------------------------------*
  330. *                                                                      *
  331. *                      Maillage Particules-Matrice                     *
  332. *                                                                      *
  333. *----------------------------------------------------------------------*
  334. *                                                                      *
  335. * NBI1   : Nombre de particules du tirage :                            *
  336. NBI1     = NBNO MPOI1 ;
  337. *                                                                      *
  338. * FDENS1 : Facteur densite locale d'elements = Nbr. moyen d'elements   *
  339. *          Dans un ligament de matrice (1<FDENS1<2) ;                  *
  340. * RLIM1  : Distance limite projection enveloppe cellule sur centre     *
  341. *          particule ou sur son projete sur la(les) Faces :            *
  342. FDENS1   = 1.0 ;
  343. FLIM1    = 0.7 ;
  344. RLIM1    = FLIM1 * RPAR1 ;
  345. *                                                                      *
  346. * Liste de reels pour deplacement aleatoire perturbation position :    *
  347. XLPHI1   = 'BRUI' 'BLAN' 'UNIF' 0. 90. (10 * NBI1) ;
  348. XLTHE1   = 'BRUI' 'BLAN' 'UNIF' 180. 180. (10 * NBI1) ;
  349. XLAMP1   = 'BRUI' 'BLAN' 'UNIF' 1.50 1.00 (10 * NBI1) ;
  350. XLAMP1   = ELIGM1 * XLAMP1 ;
  351. NPERTI1  = 0 ;
  352. *                                                                      *
  353. * La boucle BESSA1 recommence l'operation de maillage par la parti-    *
  354. * cule qu'elle n'est pas arrivee a mailler :                           *
  355. 'REPE' BESSA1 5 ;
  356. * TMPARMAT : table contenant le maillage ;                             *
  357.   TMPARMAT = 'TABL' ;
  358.   IPREMI1  = VRAI ;
  359. 'REPE' BI1 NBI1 ;
  360.   'SAUT' 1 'LIGN' ;
  361.   'MESS' ' ***** Particule No : ' &BI1 '/' NBI1 ;
  362.   PCI1     = MPOI1 'POIN' &BI1 ;
  363. *  PCI1     = MPOI1 'POIN' 53 ;
  364. * IAFAIR1 : le travail est A FAIRe, donc pas encore realise ;          *
  365.   IAFAIR1  = VRAI ;
  366. * Boucle perturbation position particule :                             *
  367. * => Si Echec maillage, on recommence en pertubant position PCI1 :     *
  368.   NBPOSI1  = 11 ;
  369.   'REPE' BPOSI1 NBPOSI1 ;
  370.     PPARI1   = PCI1 'PLUS' (RPAR1 * PM2) ;
  371. *                                                                      *
  372. * Boucle interne sur densite :                                         *
  373. * => Si Echec maillage, on recommence en pertubant densite :           *
  374.   NBDENS1  = 15 ;
  375.   FDENSI1  = FDENS1 ;
  376.   FPLUSI1  = 1.1 ;
  377.   FMOINI1  = 0.9 ;
  378.   'REPE' BDENS1 NBDENS1 ;
  379. *   Parametres Maillage :                                              *
  380.     'SI' (&BDENS1 'MULT' 2) ;
  381.       FDENSI1  = (FPLUSI1 ** (&BDENS1 / 2)) * FDENSI1 ;
  382.     'SINO' ;
  383.       FDENSI1  = (FMOINI1 ** ((&BDENS1 - 1) / 2)) * FDENSI1 ;
  384.     'FINS' ;
  385.     DENSI1   = DENS1 / FDENSI1 ;
  386.     DENSMI1  = 0.5 * DENSM1 * (1. / FDENSI1 + 1.) ;
  387.     ELIGMI1  = DENSMI1 / FTET1 ;
  388.     DPROXI1  = RPAR1 + (0.9 * ELIGMI1) ;
  389.     DPROXI1  = 'MINI' ('PROG' DPROXI1 (0.5 * DREP1)) ;
  390.     RPARJMI1 = 18. * ('MAXI' ('PROG' DENSM1 DENSMI1)) / PI ;
  391.     DFHORI1  = ((RPAR1 ** 2) - (RPARJMI1 ** 2)) ** 0.5 ;
  392.     RPARJMI1 = 18. * ('MAXI' ('PROG' DENSM1 DENSMI1)) / PI ;
  393.     DAHORI1  = ((RPAR1 ** 2) - (RPARJMI1 ** 2)) ** 0.5 ;
  394.     RPARJMI1 = 18. * ('MAXI' ('PROG' DENSM1 DENSMI1)) / PI ;
  395.     DSHORI1  = ((RPAR1 ** 2) - (RPARJMI1 ** 2)) ** 0.5 ;
  396. *                                                                      *
  397. * On indente plus -/- BDENS1...                                        *
  398. *                                                                      *
  399. * Indice Stockage maillage :                                           *
  400.   TMPARMAT . PCI1 = 'TABL' ;
  401. * Indicateurs Cas Intersection :                                       *
  402. * IFACI1  : Partciule PCI1 intersecte une Face ;                       *
  403. * IAREI1  : Partciule PCI1 intersecte une Arete ;                      *
  404. * ISOMI1  : Partciule PCI1 intersecte un Sommet ;                      *
  405.   IFACI1   = FAUX ;
  406.   IAREI1   = FAUX ;
  407.   ISOMI1   = FAUX ;
  408. * Indicateur Position Centre Particule :                               *
  409. * IDANI1  : PCI1 est Dans le Cube Unite ;                              *
  410. * IHORI1  : Particule Hors du Cube Unite Et n'intersecte pas Cube ;    *
  411. *   Attention, un critere d'intersection permet de ne considerer que   *
  412. *   les intersections "franches" du Cube ;                             *
  413.   XCI1 YCI1 ZCI1 = PCI1 'COOR' ;
  414.   LCI1     = 'PROG' XCI1 YCI1 ZCI1 ;
  415.   IDANI1   = (('MINI' LCI1) '>EG' 0.) 'ET' (('MAXI' LCI1) '&lt;EG' 1.) ;
  416.   IHORI1   = 'NON' IDANI1 ;
  417.   'SI' IHORI1 ;
  418.     NBHORI1  = (NBNO MPCB1) + ('NBEL' MACB1) + ('NBEL' MSCB1) ;
  419.     'REPE' BHORI1 NBHORI1 ;
  420.       I1       = &BHORI1 ;
  421.       'SI' (I1 '<' 9) ;
  422.         PSCBI1   = MPCB1 'POIN' I1 ;
  423.         DSCBPCI1 = 'NORM' (PCI1 'MOIN' PSCBI1) ;
  424.         'SI' (DSCBPCI1 '<' DSHORI1) ;
  425.           IHORI1   = FAUX ;
  426.           'QUIT' BHORI1 ;
  427.         'FINS' ;
  428.       'SINO' ;
  429.         I2       = &BHORI1 - 8 ;
  430.         'SI' (I2 '<' 13) ;
  431.           ACBI1    = MACB1 'ELEM' I2 ;
  432.           PACBI1   = ACBI1 'POIN' 1 ;
  433.           PACBI2   = ACBI1 'POIN' 2 ;
  434.           PNACBI1  = PACBI2 'MOIN' PACBI1 ;
  435.           PAPCI1   = PCI1 'MOIN' PACBI1 ;
  436.           PPCACBI1 = PAPCI1 'MOIN' (('PSCA' PAPCI1 PNACBI1) * PNACBI1) ;
  437.           DACBPCI1 = 'NORM' PPCACBI1 ;
  438.           PPCACBI1 = PCI1 'MOIN' PPCACBI1 ;
  439.           PSCAI1   = 'PSCA' PAPCI1 PNACBI1 ;
  440.           'SI' ((DACBPCI1 '<' DAHORI1) 'ET' (PSCAI1 '>EG' 0.)
  441.             'ET' (PSCAI1 '&lt;EG' 1.));
  442.             IHORI1   = FAUX ;
  443.             'QUIT' BHORI1 ;
  444.           'FINS' ;
  445.         'SINO' ;
  446.           I3       = &BHORI1 - 20 ;
  447.           SCBI1    = MSCB1 'ELEM' I3 ;
  448.           MPSCBI1  = 'CHAN' 'POI1' SCBI1 ;
  449.           PSCBI1   = MPSCBI1 'POIN' 1 ;
  450.           PSCBI2   = MPSCBI1 'POIN' 2 ;
  451.           PSCBI3   = MPSCBI1 'POIN' 3 ;
  452.           PTSCBI1  = PSCBI2 'MOIN' PSCBI1 ;
  453.           PTSCBI2  = PSCBI3 'MOIN' PSCBI1 ;
  454.           PNSCBI1  = 'PVEC' PTSCBI1 PTSCBI2 ;
  455.           PNSCBI1  = PNSCBI1 / ('NORM' PNSCBI1) ;
  456.           PSPCI1   = PCI1 'MOIN' PSCBI1 ;
  457.           DSPCI1   = 'PSCA' PNSCBI1 PSPCI1 ;
  458.           PPCSCBI1 = PCI1 'MOIN' (DSPCI1 * PNSCBI1) ;
  459.           DSPCI1   = 'ABS' DSPCI1 ;
  460.           MTDI1    = ('MANU' 'POI1' PPCSCBI1) 'INCL' SCBI1 'LARG'
  461.             'NOID' ;
  462.           ITDI1    = (NBNO MTDI1) 'EGA' 1 ;
  463.           'SI' ((DSPCI1 '<' DFHORI1) 'ET' ITDI1) ;
  464.             IHORI1   = FAUX ;
  465.             'QUIT' BHORI1 ;
  466.           'FINS' ;
  467.         'FINS' ;
  468.       'FINS' ;
  469.     'FIN' BHORI1 ;
  470.   'FINS' ;
  471. * IPROXI1 : Particule a proximite d'une interface Sans la couper ;     *
  472. *   => aplanissement particule pour avoir dist. min. avec interface ;  *
  473. * IJUSI1  : la particule tangente une interface ;                      *
  474.   IPROXI1  = FAUX ;
  475.   IJUSI1   = FAUX ;
  476. * Indicateurs Realisation Maillage :                                   *
  477. * IPARI1  : Maillage de la particule ;                                 *
  478. *   Si Faux => pas d'intersection => pas de particule a mailler ;      *
  479. * IPROJFI1: Projection conique enveloppe Cellule sur Surface Particule *
  480. *   suivant Projection de PCI1 sur une des surfaces intersectees ;     *
  481.   IPARI1   = VRAI ;
  482.   IPROJFI1 = FAUX ;
  483.   IPROJAI1 = FAUX ;
  484. * Boucle sur les faces :                                               *
  485.   MPTI1    = THO7U . PCI1 . 'MPT' ;
  486.   NBJ1     = NBNO MPTI1 ;
  487.   IPREMJ1  = VRAI ;
  488.   'REPE' BJ1 NBJ1 ;
  489.     IFACJ1   = FAUX ;
  490.     IAREJ1   = FAUX ;
  491.     IDANJ1   = FAUX ;
  492.     IPROXJ1  = FAUX ;
  493.     IPROJAJ1 = FAUX ;
  494.     PCJ1     = MPTI1 'POIN' &BJ1 ;
  495.     TMPARMAT . PCI1 . PCJ1 = 'TABL' ;
  496. *                                                                      *
  497. *   Test intersection Face IJ :                                        *
  498.     CNTIJ1   = THO7U . PCI1 .  PCJ1 . 'MAV' ;
  499.     'SI' (&BPOSI1 'NEG' 1) ;
  500.       PCI0     = PCI1 'MOIN' VDEPI1 ;
  501.       PPCFIJX  = 0.5 * (PCI0 'PLUS' PCJ1) ;
  502.       PNFIJ1   = PPCFIJX 'MOIN' PCI0 ;
  503.       DCIFIJX  = 'NORM' PNFIJ1 ;
  504.       PNFIJ1   = PNFIJ1 / DCIFIJX ;
  505.       DVDEPI1  = VDEPI1 'PSCA' PNFIJ1 ;
  506.       DCIFIJ1  = DCIFIJX - DVDEPI1 ;
  507.       PPCFIJ1  = PPCFIJX 'PLUS' (VDEPI1 'MOIN' (DVDEPI1 * PNFIJ1)) ;
  508.     'SINO' ;
  509.       PPCFIJ1  = 0.5 * (PCI1 'PLUS' PCJ1) ;
  510.       PNFIJ1   = PPCFIJ1 'MOIN' PCI1 ;
  511.       DCIFIJ1  = 'NORM' PNFIJ1 ;
  512.       PNFIJ1   = PNFIJ1 / DCIFIJ1 ;
  513.     'FINS' ;
  514.     IDANJ1   = (NBNO (('MANU' 'POI1' PPCFIJ1) 'INCL' CNTIJ1 'LARG'
  515.       'NOID')) 'EGA' 1 ;
  516.     'SI' ((DCIFIJ1 '<' RPAR1) 'ET' ('NON' IHORI1)) ;
  517.       IFACJ1   = VRAI ;
  518.       RPARJ1   = (RPAR1 * RPAR1 - (DCIFIJ1 * DCIFIJ1)) ** 0.5 ;
  519.       RLIMJ1   = FLIM1 * RPARJ1 ;
  520.       'SI' ((DCIFIJ1 '>EG' DFHORI1) 'ET' IDANJ1) ;
  521.         IJUSI1   = VRAI ;
  522.         VDEPI1   = 1.05 * (DCIFIJ1 - DFHORI1) * PNFIJ1 ;
  523.         'TITR' ('CHAI' 'Particule ' &BI1 ' coupe Juste une Face') ;
  524.         'QUIT' BDENS1 ;
  525.       'FINS' ;
  526.     'SINO' ;
  527.       'SI' (DCIFIJ1 '<' DPROXI1) ;
  528.         'SI' ('NON' IPROXI1) ;
  529.           IPROXI1  = VRAI 'ET' IDANJ1 ;
  530.         'FINS' ;
  531.       'FINS' ;
  532.     'FINS' ;
  533. *   Densite relative a la distance a la Face :                         *
  534.     LCNTIJ1  = 'MESU' CNTIJ1 ;
  535.     'SI' (IFACJ1 'ET' IDANJ1) ;
  536.       DENSJ1   = DENSI1 ;
  537.     'SINO' ;
  538.       DENSJ1   = FTET1 * (DCIFIJ1 - RPAR1) / FDENSI1 ;
  539.       DENSJ1   = 'MAXI' ('PROG' DENSJ1 DENSMI1) ;
  540.       DENSJ1   = 'MINI' ('PROG' DENSJ1 DENSI1) ;
  541.     'FINS' ;
  542. *                                                                      *
  543. *   Face deja maillee ?                                                *
  544.     'SI' ('EXIS' TMPARMAT PCJ1) ;
  545.       MMATIJ1  = TMPARMAT . PCJ1 . PCI1 . 'MATR' ;
  546.       IFACJ1   = 'EXIS' TMPARMAT . PCJ1 . PCI1 'PART' ;
  547.       'SI' IFACJ1 ;
  548.         MPARIJ1  = TMPARMAT . PCJ1 . PCI1 . 'PART' ;
  549. Titr ' Face Particule deja Maillee !!!' ;
  550. Trac MPARIJ1 ;
  551.       'FINS' ;
  552.       TMPARMAT . PCI1 . PCJ1 = TMPARMAT . PCJ1 . PCI1 ;
  553.     'SINO' ;
  554. *   Maillage Face IJ => on parcourt les aretes :                       *
  555.       MPTIJ1   = THO7U . PCI1 . PCJ1 . 'MPT' ;
  556. *                                                                      *
  557. *     Maillage Aretes Matrice :                                        *
  558. *     -------------------------                                        *
  559. *                                                                      *
  560. *     Boucle sur les aretes :                                          *
  561.       NBK1     = NBNO MPTIJ1 ;
  562.       IPREMK1  = VRAI ;
  563.       'REPE' BK1 NBK1 ;
  564.         IAREK1   = FAUX ;
  565.         IPROJAK1 = FAUX ;
  566.         PCK1     = MPTIJ1 'POIN' &BK1 ;
  567.         TMPARMAT . PCI1 . PCJ1 . PCK1 = 'TABL' ;
  568. *                                                                      *
  569. *       Tests pour determiner Si l'arete est deja maillee :            *
  570. *       IIK1     : Face IK maillee => arete IJK maillee ;              *
  571. *       IKI1     : Face KI maillee => idem ;                           *
  572. *       IKJ1     : Face KJ maillee => idem ;                           *
  573. *       Note     : arete IJK pas forcement associee a IKJ Ou KIJ       *
  574. *                  du fait du Elim & peut etre constituee de + de      *
  575. *                  1 elt. => tests sur mesure aretes ;                 *
  576. *       Iij11    : test Si mesure arete recuperee test Iij1 egale      *
  577. *                  arete IJK ;                                         *
  578. *       Iij10    : test Si mesure arete recuperee test Iij1 >egal      *
  579. *                  arete IJK ;                                         *
  580.         ELIJK1   = THO7U . PCI1 . PCJ1 . PCK1 . 'MAV' ;
  581.         MESK1    = 'MESU' ELIJK1 ;
  582.         TOLK1    = TOL1 * MESK1 ;
  583. *       Face IK deja maillee ?                                         *
  584.         IIK11    = FAUX ; IIK10    = FAUX ;
  585.         IIK1     = 'EXIS' TMPARMAT . PCI1 PCK1 ;
  586.         'SI' IIK1 ;
  587.           IIK1     = 'EXIS' TMPARMAT . PCI1 . PCK1 PCJ1 ;
  588.           'SI' IIK1 ;
  589.             MMATIJK1 = TMPARMAT . PCI1 . PCK1 . PCJ1 . 'MATR' ;
  590.             'SI' ('EXIS' TMPARMAT . PCI1 . PCK1 . PCJ1 'PART') ;
  591.               IAREK1   = VRAI ;
  592.               MPARIJK1 = TMPARMAT . PCI1 . PCK1 . PCJ1 . 'PART' ;
  593.               MESKX1   = 'MESU' (MMATIJK1 'ET' MPARIJK1) ;
  594.             'SINO' ;
  595.               MESKX1   = 'MESU' MMATIJK1 ;
  596.             'FINS' ;
  597.             IIK11    = MESKX1 'EGA' MESK1 TOLK1 ;
  598.             IIK10    = MESKX1 '>EG' MESK1 ;
  599.             'SI' ('NON' (IIK11 'OU' IIK10)) ;
  600.               ELIJK0   = THO7U . PCI1 . PCK1 . PCJ1 . 'MAV' ;
  601.             'FINS' ;
  602.           'SINO' ;
  603.             MPTIK1   = TMPARMAT . PCI1 . PCK1 .'MPT' ;
  604.             NBL1     = NBNO MPTIK1 ;
  605.             'REPE' BL1 NBL1 ;
  606.               PCL1     = MPTIK1 'POIN' &BL1 ;
  607.               ELIKL1   = THO7U . PCI1 . PCK1 . PCL1 . 'MAV' ;
  608.               MTEST1   = ELIKL1 'INTE' ELIJK1 'NOVE' ;
  609.               IIK1     = ('NBEL' MTEST1) 'NEG' 0 ;
  610.               'SI' IIK1 ;
  611.                 MMATIJK1 = TMPARMAT . PCI1 . PCK1 . PCL1 . 'MATR' ;
  612.                 'SI' ('EXIS' TMPARMAT . PCI1 . PCK1 . PCL1 'PART') ;
  613.                   IAREK1   = VRAI ;
  614.                   MPARIJK1 = TMPARMAT . PCI1 . PCK1 . PCL1 . 'PART' ;
  615.                   MESKX1   = 'MESU' (MMATIJK1 'ET' MPARIJK1) ;
  616.                 'SINO' ;
  617.                   MESKX1   = 'MESU' MMATIJK1 ;
  618.                 'FINS' ;
  619.                 IIK11    = MESKX1 'EGA' MESK1 TOLK1 ;
  620.                 IIK10    = MESKX1 '>EG' MESK1 ;
  621.                 'SI' ('NON' (IIK11 'OU' IIK10)) ;
  622.                   ELIJK0   = THO7U . PCI1 . PCK1 . PCL1 . 'MAV' ;
  623.                 'FINS' ;
  624.                 'QUIT' BL1 ;
  625.               'FINS' ;
  626.             'FIN' BL1 ;
  627.           'FINS' ;
  628.         'FINS' ;
  629. *       Face KI deja maillee ?                                         *
  630.         IKI11    = FAUX ; IKI10    = FAUX ;
  631.         IKI1     = ('EXIS' TMPARMAT PCK1) 'ET' ('NON' IIK11) ;
  632.         IKJ1     = IKI1 ;
  633.         'SI' IKI1 ;
  634.           IKI1     = 'EXIS' TMPARMAT . PCK1 PCI1 ;
  635.         'FINS' ;
  636.         'SI' IKI1 ;
  637.           IKI1     = 'EXIS' TMPARMAT . PCK1 . PCI1 PCJ1 ;
  638.           'SI' IKI1 ;
  639.             MMATIJK1 = TMPARMAT . PCK1 . PCI1 . PCJ1 . 'MATR' ;
  640.             'SI' ('EXIS' TMPARMAT . PCK1 . PCI1 . PCJ1 'PART') ;
  641.               IAREK1   = VRAI ;
  642.               MPARIJK1 = TMPARMAT . PCK1 . PCI1 . PCJ1 . 'PART' ;
  643.               MESKX1   = 'MESU' (MMATIJK1 'ET' MPARIJK1) ;
  644.             'SINO' ;
  645.               MESKX1   = 'MESU' MMATIJK1 ;
  646.             'FINS' ;
  647.             IKI11    = MESKX1 'EGA' MESK1 TOLK1 ;
  648.             IKI10    = MESKX1 '>EG' MESK1 ;
  649.             'SI' ('NON' (IKI11 'OU' IKI10)) ;
  650.               ELIJK0   = THO7U . PCK1 . PCI1 . PCJ1 . 'MAV' ;
  651.             'FINS' ;
  652.           'SINO' ;
  653.             MPTKI1   = TMPARMAT . PCK1 . PCI1 .'MPT' ;
  654.             NBL1     = NBNO MPTKI1 ;
  655.             'REPE' BL1 NBL1 ;
  656.               PCL1     = MPTKI1 'POIN' &BL1 ;
  657.               ELKIL1   = THO7U . PCK1 . PCI1 . PCL1 . 'MAV' ;
  658.               MTEST1   = ELKIL1 'INTE' ELIJK1 'NOVE' ;
  659.               IKI1     = ('NBEL' MTEST1) 'NEG' 0 ;
  660.               'SI' IKI1 ;
  661.                 MMATIJK1 = TMPARMAT . PCK1 . PCI1 . PCL1 . 'MATR' ;
  662.                 'SI' ('EXIS' TMPARMAT . PCK1 . PCI1 . PCL1 'PART') ;
  663.                   IAREK1   = VRAI ;
  664.                   MPARIJK1 = TMPARMAT . PCK1 . PCI1 . PCL1 . 'PART' ;
  665.                   MESKX1   = 'MESU' (MMATIJK1 'ET' MPARIJK1) ;
  666.                 'SINO' ;
  667.                   MESKX1   = 'MESU' MMATIJK1 ;
  668.                 'FINS' ;
  669.                 IKI11    = MESKX1 'EGA' MESK1 TOLK1 ;
  670.                 IKI10    = MESKX1 '>EG' MESK1 ;
  671.                 'SI' ('NON' (IKI11 'OU' IKI10)) ;
  672.                   ELIJK0   = THO7U . PCK1 . PCI1 . PCL1 . 'MAV' ;
  673.                 'FINS' ;
  674.                 'QUIT' BL1 ;
  675.               'FINS' ;
  676.             'FIN' BL1 ;
  677.           'FINS' ;
  678.         'FINS' ;
  679. *       Face KJ deja maillee ?                                         *
  680.         IKJ11    = FAUX ; IKJ10    = FAUX ;
  681.         'SI' IKJ1 ;
  682.           IKJ1     =  ('EXIS' TMPARMAT . PCK1 PCJ1)
  683.             'ET' ('NON' IKI11) ;
  684.         'FINS' ;
  685.         'SI' IKJ1 ;
  686.           IKJ1     = 'EXIS' TMPARMAT . PCK1 . PCJ1 PCI1 ;
  687.           'SI' IKJ1 ;
  688.             MMATIJK1 = TMPARMAT . PCK1 . PCJ1 . PCI1 . 'MATR' ;
  689.             'SI' ('EXIS' TMPARMAT . PCK1 . PCJ1 . PCI1 'PART') ;
  690.               IAREK1   = VRAI ;
  691.               MPARIJK1 = TMPARMAT . PCK1 . PCJ1 . PCI1 . 'PART' ;
  692.               MESKX1   = 'MESU' (MMATIJK1 'ET' MPARIJK1) ;
  693.             'SINO' ;
  694.               MESKX1   = 'MESU' MMATIJK1 ;
  695.             'FINS' ;
  696.             IKJ11    = MESKX1 'EGA' MESK1 TOLK1 ;
  697.             IKJ10    = MESKX1 '>EG' MESK1 ;
  698.             'SI' ('NON' (IKJ11 'OU' IKJ10)) ;
  699.               ELIJK0   = THO7U . PCK1 . PCJ1 . PCI1 . 'MAV' ;
  700.             'FINS' ;
  701.           'SINO' ;
  702.             MPTKJ1   = TMPARMAT . PCK1 . PCJ1 . 'MPT' ;
  703.             NBL1     = NBNO MPTKJ1 ;
  704.             'REPE' BL1 NBL1 ;
  705.               PCL1     = MPTKJ1 'POIN' &BL1 ;
  706.               ELKJL1   = THO7U . PCK1 . PCJ1 . PCL1 . 'MAV' ;
  707.               MTEST1   = ELKJL1 'INTE' ELIJK1 'NOVE' ;
  708.               IKJ1     = ('NBEL' MTEST1) 'NEG' 0 ;
  709.               'SI' IKJ1 ;
  710.                 MMATIJK1 = TMPARMAT . PCK1 . PCJ1 . PCL1 . 'MATR' ;
  711.                 'SI' ('EXIS' TMPARMAT . PCK1 . PCJ1 . PCL1 'PART') ;
  712.                   IAREK1   = VRAI ;
  713.                   MPARIJK1 = TMPARMAT . PCK1 . PCJ1 . PCL1 . 'PART' ;
  714.                   MESKX1   = 'MESU' (MMATIJK1 'ET' MPARIJK1) ;
  715.                 'SINO' ;
  716.                   MESKX1   = 'MESU' MMATIJK1 ;
  717.                 'FINS' ;
  718.                 IKJ11    = MESKX1 'EGA' MESK1 TOLK1 ;
  719.                 IKJ10    = MESKX1 '>EG' MESK1 ;
  720.                 'SI' ('NON' (IKJ11 'OU' IKJ10)) ;
  721.                   ELIJK0   = THO7U . PCK1 . PCJ1 . PCL1 . 'MAV' ;
  722.                 'FINS' ;
  723.                 'QUIT' BL1 ;
  724.               'FINS' ;
  725.             'FIN' BL1 ;
  726.           'FINS' ;
  727.         'FINS' ;
  728. *       Traitement des cas :                                           *
  729.         IXX10    = IIK10 'OU' IKI10 'OU' IKJ10 ;
  730.         IIJK1    = VRAI ;
  731.         'SI' IIK11 ;
  732.           IXX10    = FAUX ;
  733.           IIJK1    = FAUX ;
  734.         'FINS' ;
  735.         'SI' IKI11 ;
  736.           IXX10    = FAUX ;
  737.           IIJK1    = FAUX ;
  738.         'FINS' ;
  739.         'SI' IKJ11 ;
  740.           IXX10    = FAUX ;
  741.           IIJK1    = FAUX ;
  742.         'FINS' ;
  743.         'SI' IXX10 ;
  744.           PSK1     = (ELIJK1 'ELEM' 1) 'POIN' 1 ;
  745.           PSK2     = (ELIJK1 'ELEM' ('NBEL' ELIJK1)) 'POIN' 2 ;
  746.           MMATIJK1 = MMATIJK1 'ELEM' 'COMP' PSK1 PSK2 ;
  747.           IIJK1    = FAUX ;
  748.         'FINS' ;
  749. *       Une partie de l'arete est-elle deja maillee ?                  *
  750.         'SI' IIJK1 ;
  751.           IPREME1  = VRAI ;
  752.           'SI' (IIK1 'OU' IKI1 'OU' IKJ1) ;
  753. *           Une partie de l'arete est maillee :                        *
  754.             ELIJK1   = ELIJK1 'DIFF' ELIJK0 ;
  755.             IPREME1  = FAUX ;
  756.           'FINS' ;
  757. *                                                                      *
  758. *         Maillage Arete :                                             *
  759. *         Iterations sur elts. arete du fait du Elim ;                 *
  760.           NBELK1   = 'NBEL' ELIJK1 ;
  761.           'REPE' BELK1 NBELK1 ;
  762.             IAREE1   = FAUX ;
  763.             IDANK1   = FAUX ;
  764.             AIJK1    = ELIJK1 'ELEM' &BELK1 ;
  765.             MESE1    = 'MESU' AIJK1 ;
  766.             PSK1     = AIJK1 'POIN' 1 ;
  767.             PSK2     = AIJK1 'POIN' 2 ;
  768. *           PSK12N : vecteur norme PSK1-SK2 ;                          *
  769.             PSK12N   = PSK2 'MOIN' PSK1 ;
  770.             PSK12N   = PSK12N / ('NORM' PSK12N) ;
  771. *           PSK1CI1 : vecteur PSK1-PCI1 ;                              *
  772.             PSK1CI1  = PCI1 'MOIN' PSK1 ;
  773. *           PNAKCI1 : normale a l'arete passant par PCI1 ;             *
  774.             PNAKCI1  = PSK1CI1 'MOIN'
  775.             ((PSK1CI1 'PSCA' PSK12N) * PSK12N) ;
  776. *           PPCIAK1 : projete de PCI1 sur l'arete ;                    *
  777.             PPCIAK1  = PCI1 'MOIN' PNAKCI1 ;
  778. *           DCIAK1 : distance PCI1-arete ;                             *
  779.             DCIAK1   = 'NORM' PNAKCI1 ;
  780. *           DCISKi : distance PCI1-PSKi ;                              *
  781.             DCISK1   = 'NORM' PSK1CI1 ;
  782.             DCISK2   = 'NORM' (PCI1 'MOIN' PSK2) ;
  783. *           DENSK0-DENSK1-DENSK2 : densites centre-extrem. arete ;     *
  784.             DENSK0   = FTET1 * (DCIAK1 - RPAR1) / FDENSI1 ;
  785.             DENSK1   = FTET1 * (DCISK1 - RPAR1) / FDENSI1 ;
  786.             DENSK2   = FTET1 * (DCISK2 - RPAR1) / FDENSI1 ;
  787.             DENSK0   = 'MAXI' ('PROG' DENSK0 DENSMI1) ;
  788.             DENSK1   = 'MAXI' ('PROG' DENSK1 DENSMI1) ;
  789.             DENSK2   = 'MAXI' ('PROG' DENSK2 DENSMI1) ;
  790.             DENSK0   = 'MINI' ('PROG' DENSK0 DENSI1 (10. * DENSJ1)) ;
  791.             DENSK1   = 'MINI' ('PROG' DENSK1 DENSI1 (10. * DENSJ1)) ;
  792.             DENSK2   = 'MINI' ('PROG' DENSK2 DENSI1 (10. * DENSJ1)) ;
  793. *           PSK1PPK1, PSK2PPK1 : vecteur pour test sur arete ;         *
  794.             PSK1PPK1 = PPCIAK1 'MOIN' PSK1 ;
  795.             PSK2PPK1 = PPCIAK1 'MOIN' PSK2 ;
  796.             DSK1PPK1 = 'NORM' PSK1PPK1 ;
  797.             DSK2PPK1 = 'NORM' PSK2PPK1 ;
  798. *           IDANK1=VRAI, PPCIAK1 appartient au segment [PSK1,PSK2] :   *
  799.             IDANK1   = (('PSCA' PSK1PPK1 PSK12N) '>EG' 0.)
  800.                   'ET' (('PSCA' PSK2PPK1 PSK12N) '&lt;EG' 0.) 
  801.                   'ET' (DSK1PPK1 '&lt;EG' MESE1)
  802.                   'ET' (DSK2PPK1 '&lt;EG' MESE1) ;
  803. *           Tests Intersection Sommets :                               *
  804.             IISK1    = DCISK1 '<' RPAR1 ;
  805.             IISK2    = DCISK2 '<' RPAR1 ;
  806.             ISOMI1   = IISK1 'OU' IISK2 ;
  807. *           Test Intersection Arete :                                  *
  808.             IAREE1   = (DCIAK1 '<' RPAR1) 'ET' (IDANK1 'OU' ISOMI1) ;
  809.             IAREE1   = IAREE1 'ET' ('NON' IHORI1) ;
  810.             'SI' IAREE1 ;
  811. *             DPPKPKP0 : Dist. PPCIAK1-Points Intersec. Part-Arete     *
  812.               DPPKPKP0 = (RPAR1 * RPAR1 - (DCIAK1 ** 2)) ** 0.5 ;
  813. *             PSKP1, PSKP2 : Points Intersec. Part-Arete ;             *
  814.               DPPKPKP1 = DPPKPKP0 / DSK1PPK1 ;
  815.               DPPKPKP2 = DPPKPKP0 / DSK2PPK1 ;
  816.               PSKP1    = PPCIAK1 'MOIN' (DPPKPKP1 * PSK1PPK1) ;
  817.               PSKP2    = PPCIAK1 'MOIN' (DPPKPKP2 * PSK2PPK1) ;
  818.               'SI' (DCIAK1 '>EG' DAHORI1) ;
  819.                 IJUSI1   = VRAI ;
  820.                 'SI' IDANI1 ;
  821.                   VDEPI1   = -1.05 * (DCIAK1 - DAHORI1)
  822.                     * PNAKCI1 / DCIAK1 ;
  823.                 'SINO' ;
  824.                   'SI' IDANJ1 ;
  825.                     B1       = DCIFIJ1 ;
  826.                     'SI' (DCIAK1 '<' B1) ;
  827.                       B2       = 0. ;
  828.                     'SINO' ;
  829.                       B2       = ((DCIAK1 ** 2) - (B1 ** 2)) ** 0.5 ;
  830.                     'FINS' ;
  831.                     VDEPI1   = PNAKCI1 'PLUS' (DCIFIJ1 * PNFIJ1) ;
  832.                     VDEPI1   = -1. * VDEPI1 / ('NORM' VDEPI1) ;
  833.                   'SINO' ;
  834.                     B2       = DCIFIJ1 ;
  835.                     'SI' (DCIAK1 '<' B2) ;
  836.                       B1       = 0. ;
  837.                     'SINO' ;
  838.                       B1       = ((DCIAK1 ** 2) - (B2 ** 2)) ** 0.5 ;
  839.                     'FINS' ;
  840.                     VDEPI1   = PNFIJ1 ;
  841.                   'FINS' ;
  842.                   ADEPI1   = ((DAHORI1 ** 2) - (B1 ** 2)) ** 0.5 ;
  843.                   ADEPI1   = B2 - ADEPI1 ;
  844.                   VDEPI1   = 1.05 * ADEPI1 * VDEPI1 ;
  845.                 'FINS' ;
  846.                 'TITR' ('CHAI' 'Particule ' &BI1 ' coupe Juste Arete') ;
  847.                 'QUIT' BDENS1 ;
  848.               'FINS' ;
  849. *             Elements pour calcul densites :                          *
  850.               DCJAK1   = ((DCIAK1 ** 2) - (DCIFIJ1 ** 2)) ** 0.5 ;
  851.               XNECNTK1 = (LCNTIJ1 - MESK1) / (1.0 * DENSI1) ;
  852.               THETK1   = 'ATG' (DPPKPKP0 / DCJAK1) ;
  853.               THETK1   = THETK1 * PI / 180. ;
  854. *             Determination du Cas projection contour :                *
  855.               IPROJAK1 = (DCJAK1 '<' RLIMJ1) 'OU' ('NON' IDANJ1) ;
  856.               'SI' ISOMI1 ;
  857. *               Intersection sommets :                                 *
  858. *               Calcul densite caracteristique :                       *
  859.                 DENSKP0  = (1. * RPARJ1 * THETK1) / XNECNTK1 ;
  860.                 DENSKP0  = 'MAXI' ('PROG' DENSKP0 DENSMI1) ;
  861.                 DENSKP0  = 'MINI' ('PROG' DENSKP0 DENSK1) ;
  862. *               Maillage :                                             *
  863.                 'SI' (IISK1 'ET' IISK2) ;
  864.                   'MESS' ' Intersection 2 sommets : pas encore... !' ;
  865.                   'ERRE' 26 ;
  866.                 'SINO' ;
  867.                   'SI' IISK1 ;
  868.                     PSKX PSKPX = PSK2 PSKP2 ;
  869.                     PSK2 PSKP2 = PSK1 PSKP1 ;
  870.                     PSK1 PSKP1 = PSKX PSKPX ;
  871.                     DENSKX   = DENSK2 ;
  872.                     DENSK2   = DENSK1 ;
  873.                     DENSK1   = DENSKX ;
  874.                   'FINS' ;
  875.                   DENSKP1  = 1. / (0.5 / DENSKP0 + (0.5 / DENSK1)) ;
  876. *                  DENSKP1  = 1. * (0.5 * DENSKP0 + (0.5 * DENSK1)) ;
  877.                   PSOMI1   = PSK2 ;
  878. *                  MMATIJK0 = PSK1 'DROI' PSKP1 'DINI' DENSK1
  879. *                                               'DFIN' DENSKP0 ;
  880. *                  MMATIJK0 = MMATIJK0 'COUL' 'JAUN' ;
  881. *                  MPARIJK0 = PSKP1 'DROI' PSK2 'DINI' DENSKP0
  882. *                                               'DFIN' DENSKP1 ;
  883.                   DENSKPX  = 'NORM' (PSKP1 'MOIN' PSK1) ;
  884.                   DENSKPX  = 'MAXI' ('PROG' DENSKPX DENSMI1) ;
  885.                   DENSKPX  = 'MINI' ('PROG' DENSKPX DENSI1 ) ;
  886.                   MMATIJK0 = PSK1 'DROI' PSKP1 'DINI' DENSKPX
  887.                                                'DFIN' DENSKPX ;
  888.                   MMATIJK0 = MMATIJK0 'COUL' 'JAUN' ;
  889.                   MPARIJK0 = PSKP1 'DROI' PSK2 'DINI' DENSKPX
  890.                                                'DFIN' DENSI1 ;
  891.                 'FINS' ;
  892.               'SINO' ;
  893. *               Intersection uniquement Arete :                        *
  894.                 'SI' IDANJ1 ;
  895.                   DENSKP0  = (2. * RPARJ1 * (PI - THETK1)) / XNECNTK1 ;
  896.                   DENSKP0  = 'MAXI' ('PROG' DENSKP0 DENSMI1) ;
  897.                   DENSKP0  = 'MINI' ('PROG' DENSKP0 DENSI1) ;
  898.                   DENSKP1  = DENSK1 ;
  899.                   DENSKP2  = DENSK2 ;
  900.                 'SINO' ;
  901.                   DENSKP0  = (2. * RPARJ1 * THETK1) / XNECNTK1 ;
  902.                   DENSKP0  = 'MAXI' ('PROG' DENSKP0 DENSMI1) ;
  903.                   DENSKP0  = 'MINI' ('PROG' DENSKP0 DENSI1) ;
  904.                   DCJSK1   = (DCISK1 ** 2 - (DCIFIJ1 ** 2)) ** 0.5 ;
  905.                   DCJSK2   = (DCISK2 ** 2 - (DCIFIJ1 ** 2)) ** 0.5 ;
  906.                   DENSKP1  = DENSK1 * DCJAK1 * RPARJ1 / (DCJSK1 ** 2) ;
  907.                   DENSKP2  = DENSK2 * DCJAK1 * RPARJ1 / (DCJSK2 ** 2) ;
  908.                   DENSKP1  = 'MAXI' ('PROG' DENSKP1 DENSMI1 DENSKP0) ;
  909.                   DENSKP2  = 'MAXI' ('PROG' DENSKP2 DENSMI1 DENSKP0) ;
  910.                   DENSKP1  = 'MINI' ('PROG' DENSK1 DENSKP1 DENSKP0) ;
  911.                   DENSKP2  = 'MINI' ('PROG' DENSK2 DENSKP2 DENSKP0) ;
  912.                 'FINS' ;
  913.                 DENSKP1  = 1. / (0.5 / DENSKP0 + (0.5 / DENSKP1)) ;
  914.                 DENSKP2  = 1. / (0.5 / DENSKP0 + (0.5 / DENSKP2)) ;
  915. *               Maillage Aretes Matrice-Particule :                    *
  916.                 DENSKX1  = 'NORM' (PSKP1 'MOIN' PSK1) ;
  917.                 DENSKX1  = 'MAXI' ('PROG' DENSKX1 DENSMI1) ;
  918.                 DENSKX1  = 'MINI' ('PROG' DENSKX1 DENSI1) ;
  919.                 DENSKX2  = 'NORM' (PSKP2 'MOIN' PSK2) ;
  920.                 DENSKX2  = 'MAXI' ('PROG' DENSKX2 DENSMI1) ;
  921.                 DENSKX2  = 'MINI' ('PROG' DENSKX2 DENSI1) ;
  922.                 DENSKPX1 = 'MINI' ('PROG' DENSKX1 DENSKP0) ;
  923.                 DENSKPX2 = 'MINI' ('PROG' DENSKX2 DENSKP0) ;
  924.                 DENSKPX0 = 'MINI' ('PROG' DENSI1 (2. * DENSKP0)) ;
  925.                 MMATIJK0 = PSK1 'DROI' PSKP1 'DINI' DENSKX1
  926.                                              'DFIN' DENSKPX1 ;
  927.                 MMATIJK0 = MMATIJK0 'ET'
  928.                   (PSKP2 'DROI' PSK2 'DINI' DENSKPX2 'DFIN' DENSKX2) ;
  929.                 'SI' IPROJAK1 ;
  930.                   MMATIJK0 = MMATIJK0 'COUL' 'JAUN' ;
  931.                 'FINS' ;
  932.                 MPARIJK0 = PSKP1 'DROI' PPCIAK1 'DINI' DENSKPX1
  933.                                                 'DFIN' DENSKPX0 ;
  934.                 MPARIJK0 = MPARIJK0 'ET'
  935.                 (PPCIAK1 'DROI' PSKP2 'DINI' DENSKPX0 'DFIN' DENSKPX2) ;
  936.               'FINS' ;
  937.             'SINO' ;
  938. *             Pas Intersection Arete :                                 *
  939. *             Si Distance Sommet-PPCIAK1 > Densite calcule
  940. *             Et Si PPCIAK1 sur l'arete => on maille en 2 parties :    *
  941. *              'SI' IHORI1 ;
  942. *                MMATIJK0 = PSK1 'DROI' PSK2 'DINI' DENSK1
  943. *                                            'DFIN' DENSK2 ;
  944. *              'SINO' ;
  945.                 'SI' ((DSK1PPK1 '>EG' DENSK1) 
  946.                  'ET' (DSK2PPK1 '>EG' DENSK2) 'ET' IDANK1) ;
  947.                   MMATIJK0 = PSK1 'DROI' PPCIAK1 'DINI' DENSK1
  948.                                                  'DFIN' DENSK0 ;
  949.                   MMATIJK0 = MMATIJK0 'ET'
  950.                     (PPCIAK1 'DROI' PSK2 'DINI' DENSK0 'DFIN' DENSK2) ;
  951.                 'SINO' ;
  952.                   MMATIJK0 = PSK1 'DROI' PSK2 'DINI' DENSK1
  953.                                               'DFIN' DENSK2 ;
  954.                 'FINS' ;
  955.                 'SI' (DCIAK1 '<' DPROXI1) ;
  956.                   IPROXI1  = VRAI 'ET' IDANK1 ;
  957.                 'FINS' ;
  958. *              'FINS' ;
  959.             'FINS' ;
  960.             'SI' IPREME1 ;
  961.               IPREME1  = FAUX ;
  962.               MMATIJK1 = MMATIJK0 ;
  963.             'SINO' ; 
  964.               MMATIJK1 = MMATIJK1 'ET' MMATIJK0 ;
  965.             'FINS' ;
  966.             'SI' IAREE1 ;
  967.               PPCIAE0  = PPCIAK1 ;
  968.               'SI' IAREK1 ;
  969.                 MPARIJK1 = MPARIJK1 'ET' MPARIJK0 ;
  970.               'SINO' ;
  971.                 IAREK1   = VRAI ;
  972.                 MPARIJK1 = MPARIJK0 ;
  973.               'FINS' ;
  974.             'FINS' ;
  975.           'FIN' BELK1 ;
  976.         'SINO' ;
  977.           'SI' IAREK1 ;
  978. *            'MESS' ' Arete intersectee Et deja maillee' ;
  979.             AIJK1    = ELIJK1 ;
  980.             MESE1    = 'MESU' AIJK1 ;
  981.             PSK1     = AIJK1 'POIN' 1 ;
  982.             PSK2     = AIJK1 'POIN' 2 ;
  983. *           PSK12N : vecteur norme PSK1-SK2 ;                          *
  984.             PSK12N   = PSK2 'MOIN' PSK1 ;
  985.             PSK12N   = PSK12N / ('NORM' PSK12N) ;
  986. *           PSK1CI1 : vecteur PSK1-PCI1 ;                              *
  987.             PSK1CI1  = PCI1 'MOIN' PSK1 ;
  988. *           PNAKCI1 : normale a l'arete passant par PCI1 ;             *
  989.             PNAKCI1  = PSK1CI1 'MOIN'
  990.             ((PSK1CI1 'PSCA' PSK12N) * PSK12N) ;
  991. *           PPCIAK1 : projete de PCI1 sur l'arete ;                    *
  992.             PPCIAK1  = PCI1 'MOIN' PNAKCI1 ;
  993. *           DCIAK1 : distance PCI1-arete ;                             *
  994.             DCIAK1   = 'NORM' PNAKCI1 ;
  995.             DCJAK1   = ((DCIAK1 ** 2) - (DCIFIJ1 ** 2)) ** 0.5 ;
  996.             IPROJAK1 = (DCJAK1 '<' RLIMJ1) 'OU' ('NON' IDANJ1) ;
  997.             'SI' IPROJAK1 ;
  998.               PPCIAE0  = PPCIAK1 ;
  999.               MMATIJK1 = MMATIJK1 'COUL' 'JAUN' ;
  1000.             'FINS' ;
  1001.           'FINS' ;
  1002.         'FINS' ;
  1003. *       Stockage Arete Dans la table :                                 *
  1004.         TMPARMAT . PCI1 . PCJ1 . PCK1 . 'MATR' = MMATIJK1 ;
  1005.         'SI' IPREMK1 ;
  1006.           IPREMK1  = FAUX ;
  1007.           CNTMATJ1 = MMATIJK1 ;
  1008.           TMPARMAT . PCI1 . PCJ1 . 'MPT' = 'MANU' 'POI1' PCK1 ;
  1009.         'SINO' ;
  1010.           CNTMATJ1 = CNTMATJ1 'ET' MMATIJK1 ;
  1011.           TMPARMAT . PCI1 . PCJ1 . 'MPT' =
  1012.             TMPARMAT . PCI1 . PCJ1 . 'MPT' 'ET' PCK1 ;
  1013.         'FINS' ;
  1014.         'SI' IAREK1 ;
  1015.           TMPARMAT . PCI1 . PCJ1 . PCK1 . 'PART' = MPARIJK1 ;
  1016.           'SI' IAREJ1 ;
  1017.             CNTPARJ1 = CNTPARJ1 'ET' MPARIJK1 ;
  1018.           'SINO' ;
  1019.             IAREJ1   = VRAI ;
  1020.             CNTPARJ1 = MPARIJK1 ;
  1021.           'FINS' ;
  1022.           'SI' IPROJAK1 ;
  1023.             'SI' IPROJAJ1 ;
  1024.               'SI' ISOMI1 ;
  1025.                 PPCIAK0  = PSOMI1 ;
  1026.               'SINO' ;
  1027.                 'MESS'
  1028. ' ####" 2x Projection selon point sur aretes pour 1 meme contour ?' ;
  1029.                 'ERRE' 26 ;
  1030.               'FINS' ;
  1031.             'SINO' ;
  1032.               IPROJAJ1 = VRAI ;
  1033.               PPCIAK0  = PPCIAE0 ;
  1034.             'FINS' ;
  1035.           'FINS' ;
  1036.         'FINS' ;
  1037.       'FIN' BK1 ;
  1038. *                                                                      *
  1039. *     Maillage Surfaces Matrice/Particules :                           *
  1040. *     --------------------------------------                           *
  1041. *                                                                      *
  1042. *     Maillage surface IJ :                                            *
  1043.       IFACJ1   = IFACJ1 'ET' (IDANJ1 'OU' IAREJ1) ;
  1044.       'SI' IFACJ1 ;
  1045.         'SI' IAREJ1 ;
  1046. *         Construction Contour(s) Si intersection Arete-Sommet :       *
  1047.           'SI' ISOMI1 ;
  1048.             CNTMATJ2 = CNTMATJ1 'DIFF' (CNTMATJ1 'ELEM' 'JAUN') ;
  1049.             CNTPARJ2 = CNTMATJ2 'PROJ' 'CONI' PSOMI1
  1050.                                        'SPHE' PCI1 PPARI1 ;
  1051.           'SINO' ;
  1052.             'SI' IPROJAJ1 ;
  1053.               CNTMATJ2 = CNTMATJ1 'DIFF' (CNTMATJ1 'ELEM' 'JAUN') ;
  1054.               CNTPARJ2 = CNTMATJ2 'PROJ' 'CONI' PPCIAK0
  1055.                 'SPHE' PCI1 PPARI1 ;
  1056.             'SINO' ;
  1057.               CNTPARJ2 = CNTMATJ1 'PROJ' 'CONI' PPCFIJ1
  1058.                 'SPHE' PCI1 PPARI1 ;
  1059.             'FINS' ;
  1060.           'FINS' ;
  1061.           CNTPARJ1 = CNTPARJ1 'ET' CNTPARJ2 ;
  1062.           'ELIM' CNTPARJ1 TOL1 ;
  1063.           CNTPARJ1 = CNTPARJ1 'ELEM' 'COMP' (CNTPARJ1 'POIN' 1)
  1064.                                             (CNTPARJ1 'POIN' 1) ;
  1065.           CNTMATJ1 = CNTMATJ1 'ET' CNTPARJ2 ;
  1066. *         Appel a Surf pour intersection Arete(s)-Sommet :             *
  1067.           'OPTI' 'ERRE' 'CONT' ;
  1068.           TCCONJ1  = 'CCON' CNTMATJ1 ;
  1069.           'REPE' BCCONJ1 ('DIME' TCCONJ1) ;
  1070.             CNTMATJ0 = TCCONJ1 . &BCCONJ1 ;
  1071.             CNTMATJ0 = CNTMATJ0 'ELEM' 'COMP' (CNTMATJ0 'POIN' 1)
  1072.                                               (CNTMATJ0 'POIN' 1) ;
  1073.             'SI' IPROJAJ1 ;
  1074.               MMATIJ0  = 'SURF' CNTMATJ0 'PLAN' 0.9 ;
  1075.             'SINO' ;
  1076.               MMATIJ0  = 'SURF' CNTMATJ0 'PLAN' 0.9 ;
  1077.             'FINS' ;
  1078.             'SI' (&BCCONJ1 'EGA' 1) ;
  1079.               MMATIJ1  = MMATIJ0 ;
  1080.             'SINO' ;
  1081.               MMATIJ1  = MMATIJ1 'ET' MMATIJ0 ;
  1082.             'FINS' ;
  1083.           'FIN' BCCONJ1 ;
  1084.           MPARIJ1  = 'SURF' CNTPARJ1 'PLAN' 0.9 ;
  1085.           'OPTI' 'ERRE' 'NORM' ;
  1086.           IANNULS1 = ('EGA' ('TYPE' MMATIJ1) 'ANNULE')
  1087.                 'OU' ('EGA' ('TYPE' MPARIJ1) 'ANNULE') ;
  1088.           'SI' IANNULS1 ;
  1089.             'MESS' ' ##### Echec maillage surface (ANNULE) ! ' ;
  1090.             'ITER' BDENS1 ;
  1091.           'SINO' ;
  1092.             MTOTIJ1  = MMATIJ1 'ET' MPARIJ1 ;
  1093.             SCNTIJ1  = 'MESU' 'SURF' (THO7U . PCI1 . PCJ1 . 'MAV') ;
  1094.             STOTIJ1  = 'MESU' MTOTIJ1 ;
  1095.             'SI' ((SCNTIJ1 - STOTIJ1) '>' (1.E-5 * SCNTIJ1)) ;
  1096.               'MESS' ' ##### Echec maillage surface ! ';
  1097.               'ITER' BDENS1 ;
  1098.             'FINS' ;
  1099.           'FINS' ;
  1100.         'SINO' ;
  1101. *         Construction Contour(s) Si intersection Face :               *
  1102.           CNTMATJ1 = CNTMATJ1 'ELEM' 'COMP' (CNTMATJ1 'POIN' 1)
  1103.                                             (CNTMATJ1 'POIN' 1) ;
  1104.           CNTPARJ1 = CNTMATJ1 'PROJ' 'CONI' PPCFIJ1 'SPHE' PCI1 PPARI1 ;
  1105.           CNTMATJ1 = CNTMATJ1 'ET' ('INVE' CNTPARJ1) ;
  1106. *         Maillage Surface intersection Face :                         *
  1107.           'OPTI' 'ERRE' 'CONT' ;
  1108.           MMATIJ1  = 'SURF' CNTMATJ1 'PLAN' 0.9 ;
  1109.           MPARIJ1  = 'SURF' CNTPARJ1 'PLAN' 0.9 ;
  1110.           'OPTI' 'ERRE' 'NORM' ;
  1111.           IANNULS1 = ('EGA' ('TYPE' MMATIJ1) 'ANNULE')
  1112.                 'OU' ('EGA' ('TYPE' MPARIJ1) 'ANNULE') ;
  1113.           'SI' IANNULS1 ;
  1114.             'MESS' ' ##### Echec maillage surface (ANNULE) ! ' ;
  1115.             'ITER' BDENS1 ;
  1116.           'SINO' ;
  1117.             MTOTIJ1  = MMATIJ1 'ET' MPARIJ1 ;
  1118.             SCNTIJ1  = 'MESU' 'SURF' (THO7U . PCI1 . PCJ1 . 'MAV') ;
  1119.             STOTIJ1  = 'MESU' MTOTIJ1 ;
  1120.             'SI' ((SCNTIJ1 - STOTIJ1) '>' (1.E-5 * SCNTIJ1)) ;
  1121.               'MESS' ' ##### Echec maillage surface ! ';
  1122.               'ITER' BDENS1 ;
  1123.             'FINS' ;
  1124.           'FINS' ;
  1125.         'FINS' ;
  1126.       'SINO' ;
  1127. *       Construction Contour(s) aucune intersection :                  *
  1128.         CNTMATJ1 = CNTMATJ1 'ELEM' 'COMP' (CNTMATJ1 'POIN' 1)
  1129.                                           (CNTMATJ1 'POIN' 1) ;
  1130. *       Maillage Surface :                                             *
  1131.         'SI' IHORI1 ;
  1132.           CHDIJ1   = 'MANU' 'CHPO' CNTMATJ1 1 'DENS' DENSI1 ;
  1133.         'SINO' ;
  1134.           CHDIJ1   = 'MANU' 'CHPO' CNTMATJ1 1 'DENS' DENSJ1 ;
  1135.         'FINS' ;
  1136.         'OPTI' 'ERRE' 'CONT' ;
  1137.         MMATIJ1  = 'SURF' CHDIJ1 CNTMATJ1 'PLAN' 0.9 ;
  1138.         'OPTI' 'ERRE' 'NORM' ;
  1139.         IANNULS1 = 'EGA' ('TYPE' MMATIJ1) 'ANNULE' ;
  1140.         'SI' IANNULS1 ;
  1141.           'MESS' ' ##### Echec maillage surface (ANNULE) ! ' ;
  1142.           'ITER' BDENS1 ;
  1143.         'SINO' ;
  1144.           SCNTIJ1  = 'MESU' 'SURF' CNTMATJ1 ;
  1145.           SMATIJ1  = 'MESU' MMATIJ1 ;
  1146.           'SI' ((SCNTIJ1 - SMATIJ1) '>' (1.E-5 * SCNTIJ1)) ;
  1147.             'MESS' ' ##### Echec maillage surface ! ';
  1148.             'ITER' BDENS1 ;
  1149.           'FINS' ;
  1150.         'FINS' ;
  1151.       'FINS' ;
  1152.       'SI' IFACJ1 ;
  1153.         MMATIJ1  = MMATIJ1 'COUL' 'OLIV' ;
  1154.       'FINS' ;
  1155.       TMPARMAT . PCI1 . PCJ1 . 'MATR' = MMATIJ1 ;
  1156.     'FINS' ;
  1157. * Analyse du cas traite :                                              *
  1158.     'SI' IFACJ1 ;
  1159.       MPARIJ1  = MPARIJ1 'COUL' 'ORAN' ;
  1160.       TMPARMAT . PCI1 . PCJ1 . 'PART' = MPARIJ1 ;
  1161.       'SI' IFACI1 ;
  1162.         ENVPARI1 = ENVPARI1 'ET' MPARIJ1 ;
  1163.       'SINO' ;
  1164.         IFACI1   = VRAI ;
  1165.         ENVPARI1 = MPARIJ1 ;
  1166.       'FINS' ;
  1167.       'SI' IAREJ1 ;
  1168.         'SI' ('NON' IAREI1) ;
  1169.           IAREI1   = VRAI ;
  1170.         'FINS' ;
  1171.         'SI' ((DCIFIJ1 '<' RLIM1) 'OU' ('NON' IDANI1)) ;
  1172.           'SI' IPROJAJ1 ;
  1173.             MMATIJ1  = MMATIJ1 'COUL' 'ROSE' ;
  1174.             'SI' IPROJAI1 ;
  1175. *              PPCIAJ0  = PPCIAJ0 'PLUS' (PPCIAK0 'MOIN' PCI1) ;
  1176.             'SINO' ;
  1177.               IPROJAI1 = VRAI ;
  1178.               PPCIAJ0  = PPCIAK0 ;
  1179.             'FINS' ;
  1180.           'SINO' ;
  1181.             MMATIJ1  = MMATIJ1 'COUL' 'TURQ' ;
  1182.             'SI' IPROJFI1 ;
  1183.               IJUSI1   = VRAI ;
  1184.               PPCFIJ0  = PPCFIJ0 'PLUS' (PPCFIJ1 'MOIN' PCI1) ;
  1185.             'SINO' ;
  1186.               IPROJFI1 = VRAI ;
  1187.               PPCFIJ0  = PPCFIJ1 ;
  1188.             'FINS' ;
  1189.           'FINS' ;
  1190.         'FINS' ;
  1191.       'SINO' ;
  1192.         'SI' ((DCIFIJ1 '<' RLIM1) 'OU' ('NON' IDANI1)) ;
  1193.           MMATIJ1  = MMATIJ1 'COUL' 'TURQ' ;
  1194.           'SI' IPROJFI1 ;
  1195.             IJUSI1   = VRAI ;
  1196.             PPCFIJ0  = PPCFIJ0 'PLUS' (PPCFIJ1 'MOIN' PCI1) ;
  1197.           'SINO' ;
  1198.             IPROJFI1 = VRAI ;
  1199.             PPCFIJ0  = PPCFIJ1 ;
  1200.           'FINS' ;
  1201.         'FINS' ;
  1202.       'FINS' ;
  1203.     'FINS' ;
  1204. *   Stockage Surfaces Dans la table :                                  *
  1205.     'SI' IPREMJ1 ;
  1206.       IPREMJ1  = FAUX ;
  1207.       ENVMATI1 = MMATIJ1 ;
  1208.       TMPARMAT . PCI1 . 'MPT' = 'MANU' 'POI1' PCJ1 ;
  1209.     'SINO' ;
  1210.       ENVMATI1 = ENVMATI1 'ET' MMATIJ1 ;
  1211.       TMPARMAT . PCI1 . 'MPT' = TMPARMAT . PCI1 . 'MPT' 'ET' PCJ1 ;
  1212.     'FINS' ;
  1213.   'FIN' BJ1 ;
  1214. *                                                                      *
  1215. * Maillage Volumes Matrice-Particules :                                *
  1216. * -------------------------------------                                *
  1217. *                                                                      *
  1218. * Enveloppes Connexes Volumes a mailler :                              *
  1219.   'SI' IFACI1 ;
  1220.     'SI' ISOMI1 ;
  1221.       'MESS' '   - Intersections : Sommet' ;
  1222.       ENVMATI2 = ENVMATI1 'ELEM' 'DEFA' ;
  1223.       ENVPARI2 = ENVMATI2 'PROJ' 'CONI' PSOMI1 'SPHE' PCI1 PPARI1 ;
  1224.     'SINO' ;
  1225.       'SI' IAREI1 ;
  1226.         'MESS' '   - Intersections : Arete(s)' ;
  1227.       'SINO' ;
  1228.         'MESS' '   - Intersections : Face(s)' ;
  1229.       'FINS' ;
  1230.       'SI' IPROJFI1 ;
  1231.         'SI' IJUSI1 ;
  1232.           IJUSI1   = FAUX ;
  1233.           VDEPI1   = PPCFIJ0 'MOIN' PCI1 ;
  1234.           ADEPI1   = 'NORM' VDEPI1 ;
  1235.           VDEPI1   = VDEPI1 / ADEPI1 ;
  1236.           VDEPI1   = 1.05 * (ADEPI1 - DAHORI1) * VDEPI1 ;
  1237.           'TITR' ' 2x IPROJFI1 => IJUSI1' ;
  1238.           'QUIT' BDENS1 ;
  1239.         'SINO' ;
  1240.           ENVMATI2 = ENVMATI1 'DIFF' (ENVMATI1 'ELEM' 'TURQ') ;
  1241.           ENVPARI2 = ENVMATI2 'PROJ' 'CONI' PPCFIJ0 'SPHE' PCI1 PPARI1 ;
  1242.         'FINS' ;
  1243.       'SINO' ;
  1244.         'SI' IPROJAI1 ;
  1245.           ENVMATI2 = ENVMATI1 'DIFF' (ENVMATI1 'ELEM' 'ROSE') ;
  1246.           ENVPARI2 = ENVMATI2 'PROJ' 'CONI' PPCIAJ0 'SPHE' PCI1 PPARI1 ;
  1247.         'SINO' ;
  1248.           ENVPARI2 = ENVMATI1 'PROJ' 'CONI' PCI1 'SPHE' PCI1 PPARI1 ;
  1249.         'FINS' ;
  1250.       'FINS' ;
  1251.     'FINS' ;
  1252.     ENVPARI1 = ENVPARI1 'ET' ENVPARI2 ;
  1253.     'ELIM' (ENVPARI1 'ET' ENVMATI1) TOL1 ;
  1254.     'SI' IPROXI1 ;
  1255.       'MESS'
  1256. '   - ATTENTION : PROXIMITE particule-enveloppe cellule detectee' ;
  1257.       'MESS'
  1258. '     => Aplanissement zone surface particule trop proche cellule' ;
  1259.       ENVMATI3 = ENVMATI1 'ELEM' 'DEFA' ;
  1260.       ENVPARI3 = ENVPARI2 'ELEM' 'DEFA' ;
  1261.       MPASSI1  = ENVMATI3 'VOLU' 1 ENVPARI3 ;
  1262.       MPASSI1  = ('CHAN' 'LIGN' MPASSI1) 'DIFF'
  1263.         ('CHAN' 'LIGN' (ENVPARI3 'ET' ENVMATI3)) ;
  1264.       XM1 YM1 ZM1 = ENVMATI3 'COOR' ;
  1265.       XM1      = 'KPRO' XM1 MPASSI1 ;
  1266.       YM1      = 'KPRO' YM1 MPASSI1 ;
  1267.       ZM1      = 'KPRO' ZM1 MPASSI1 ;
  1268.       DX1 DY1 DZ1 = (XM1 - XCI1) (YM1 - YCI1) (ZM1 - ZCI1) ;
  1269.       DMPI1    = ((DX1 ** 2) + (DY1 ** 2) + (DZ1 ** 2)) ** 0.5 ;
  1270.       MASQI1   = DMPI1 'MASQ' 'INFE' DPROXI1 ;
  1271.       XP1 YP1 ZP1 = ENVPARI3 'COOR' ;
  1272.       XN1 YN1 ZN1 = (XP1 - XM1) (YP1 - YM1) (ZP1 - ZM1) ;
  1273.       XNXN1    = ((XN1 ** 2) + (YN1 ** 2) + (ZN1 ** 2)) ** 0.5 ;
  1274.       XN1 YN1 ZN1 = (XN1 / XNXN1) (YN1 / XNXN1) (ZN1 / XNXN1) ;
  1275.       DUI1     = (DPROXI1 - DMPI1) ;
  1276.       CHUXI1   = ((DUI1 * XN1) 'NOMC' 'UX') ;
  1277.       CHUYI1   = ((DUI1 * YN1) 'NOMC' 'UY') ;
  1278.       CHUZI1   = ((DUI1 * ZN1) 'NOMC' 'UZ') ;
  1279.       CHUXI1   = 'CHAN' 'ATTRIBUT' CHUXI1 'NATURE' 'DISCRET' ;
  1280.       CHUYI1   = 'CHAN' 'ATTRIBUT' CHUYI1 'NATURE' 'DISCRET' ;
  1281.       CHUZI1   = 'CHAN' 'ATTRIBUT' CHUZI1 'NATURE' 'DISCRET' ;
  1282.       CHUI1    = (CHUXI1 'ET' CHUYI1 'ET' CHUZI1) * MASQI1 ;
  1283.       'DEPL' ENVPARI1 'PLUS' CHUI1 ;
  1284.     'FINS' ;
  1285.     ENVMATI1 = ENVMATI1 'ET' ENVPARI2 ;
  1286. *    'ELIM' ENVMATI1 TOL1 ;
  1287.   'SINO' ;
  1288.     'MESS' '   - Intersections : AUCUNE' ;
  1289.     'SI' IDANI1 ;
  1290.       ENVPARI1 = ENVMATI1 'PROJ' 'CONI' PCI1 'SPHE' PCI1 PPARI1 ;
  1291.       PSK0     = THO7U . PCI1 . 'MAV' 'POIN' 1 ;
  1292.       ELMI1    = (ENVMATI1 'ELEM' 'APPU' 'LARG' PSK0) 'ELEM' 1 ;
  1293.       ELPI1    = ELMI1 'PROJ' 'CONI' PCI1 'SPHE' PCI1 PPARI1 ;
  1294.       'ELIM' (ELPI1 'ET' ENVPARI1) TOL1 ;
  1295. *     Si Particule proche Face Cellule (d<DPROXI1), on fait un meplat  *
  1296. *     Sur Particule pour assurer distance min. :                       *
  1297.       'SI' IPROXI1 ;
  1298.         'MESS'
  1299. '   - ATTENTION : PROXIMITE particule-enveloppe cellule detectee' ;
  1300.         'MESS'
  1301. '     => Aplanissement zone surface particule trop proche cellule' ;
  1302.         ENVPARI3 = ENVPARI1 'DIFF' ELPI1 ;
  1303.         ENVMATI3 = ENVMATI1 'DIFF' ELMI1 ;
  1304.         MPASSI1  = ENVMATI3 'VOLU' 1 ENVPARI3 ;
  1305.         MPASSI1  = ('CHAN' 'LIGN' MPASSI1) 'DIFF'
  1306.           ('CHAN' 'LIGN' (ENVPARI3 'ET' ENVMATI3)) ;
  1307.         XM1 YM1 ZM1 = ENVMATI3 'COOR' ;
  1308.         XM1      = 'KPRO' XM1 MPASSI1 ;
  1309.         YM1      = 'KPRO' YM1 MPASSI1 ;
  1310.         ZM1      = 'KPRO' ZM1 MPASSI1 ;
  1311.         DX1 DY1 DZ1 = (XM1 - XCI1) (YM1 - YCI1) (ZM1 - ZCI1) ;
  1312.         DMPI1    = ((DX1 ** 2) + (DY1 ** 2) + (DZ1 ** 2)) ** 0.5 ;
  1313.         MASQI1   = DMPI1 'MASQ' 'INFE' DPROXI1 ;
  1314.         XP1 YP1 ZP1 = ENVPARI3 'COOR' ;
  1315.         XN1 YN1 ZN1 = (XP1 - XM1) (YP1 - YM1) (ZP1 - ZM1) ;
  1316.         XNXN1    = ((XN1 ** 2) + (YN1 ** 2) + (ZN1 ** 2)) ** 0.5 ;
  1317.         XN1 YN1 ZN1 = (XN1 / XNXN1) (YN1 / XNXN1) (ZN1 / XNXN1) ;
  1318.         DUI1     = (DPROXI1 - DMPI1) ;
  1319.         CHUXI1   = ((DUI1 * XN1) 'NOMC' 'UX') ;
  1320.         CHUYI1   = ((DUI1 * YN1) 'NOMC' 'UY') ;
  1321.         CHUZI1   = ((DUI1 * ZN1) 'NOMC' 'UZ') ;
  1322.         CHUXI1   = 'CHAN' 'ATTRIBUT' CHUXI1 'NATURE' 'DISCRET' ;
  1323.         CHUYI1   = 'CHAN' 'ATTRIBUT' CHUYI1 'NATURE' 'DISCRET' ;
  1324.         CHUZI1   = 'CHAN' 'ATTRIBUT' CHUZI1 'NATURE' 'DISCRET' ;
  1325.         CHUI1    = (CHUXI1 'ET' CHUYI1 'ET' CHUZI1) * MASQI1 ;
  1326.         'DEPL' ENVPARI3 'PLUS' CHUI1 ;
  1327.       'FINS' ;
  1328.       DENSX1   = ('MESU' ('CONT' ELMI1)) / 3. ;
  1329.       DENSX1   = 'MAXI' ('PROG' DENSX1 DENSMI1) ;
  1330.       DENSX1   = 'MINI' ('PROG' DENSX1 DENSI1) ;
  1331.       VXI1     = ELMI1 'VOLU' ELPI1 'DINI' DENSX1 'DFIN' DENSX1 ;
  1332.       VXI1     = VXI1 'CHAN' 'TET4' ;
  1333.       ENVMATI2 = (ENVMATI1 'ET' ENVPARI1) 'DIFF' ('ENVE' VXI1) ;
  1334.       ENVMATI1 = ENVMATI1 'ET' ENVPARI1 ;
  1335.       'ELIM' ENVMATI1 TOL1 ;
  1336.     'SINO' ;
  1337.       IPARI1   = FAUX ;
  1338.     'FINS' ;
  1339.   'FINS' ;
  1340. *                                                                      *
  1341. * Maillage Volume Matrice :                                            *
  1342.   'OPTI' 'ERRE' 'CONT' ;
  1343.   'SI' (IFACI1 'OU' ('NON' IPARI1)) ;
  1344.     MMATI1   = ('VOLU' ENVMATI1) 'COUL' 'OLIV' ;
  1345.   'SINO' ;
  1346.     MMATI1   = (('VOLU' ENVMATI2) 'ET' VXI1) 'COUL' 'OLIV' ;
  1347.   'FINS' ;
  1348.   'OPTI' 'ERRE' 'NORM' ;
  1349. * Test Resultat Volu :                                                 *
  1350.   IANNULV1 = 'EGA' ('TYPE' MMATI1) 'ANNULE' ;
  1351.   'SI' IANNULV1 ;
  1352.     'MESS' ' ##### ECHEC Maillage Volume Matrice (ANNULE) !' ;
  1353.   'SINO' ;
  1354. *   Test sur Enveloppes Resultat :                                     *
  1355.     MTESTI1  = ('ENVE' MMATI1) 'DIFF' ENVMATI1 ;
  1356.     'SI' ((NBNO MTESTI1) 'NEG' 0) ;
  1357.       'MESS' ' ##### ECHEC Maillage Volume Matrice !' ;
  1358.     'SINO' ;
  1359.       TMPARMAT . PCI1 . 'MATR' = MMATI1 ;
  1360.       IAFAIR1  = FAUX ;
  1361.     'FINS' ;
  1362.   'FINS' ;
  1363. *                                                                      *
  1364. * Maillage Volume Particule :                                          *
  1365.   'SI' IPARI1 ;
  1366.     'OPTI' 'ERRE' 'CONT' ;
  1367.     MPARI1   = ('VOLU' ENVPARI1) 'COUL' 'ORAN' ;
  1368.     'OPTI' 'ERRE' 'NORM' ;
  1369. *   Test Resultat Volu :                                               *
  1370.     IANNULV2 = 'EGA' ('TYPE' MPARI1) 'ANNULE' ;
  1371.     'SI' IANNULV2 ;
  1372.       'MESS' ' ##### ECHEC Maillage Volume particule (ANNULE) ' ;
  1373.     'SINO' ;
  1374. *     Test sur Enveloppes Resultat :                                   *
  1375.       MTESTI1  = ('ENVE' MPARI1) 'DIFF' ENVPARI1 ;
  1376.       'SI' ((NBNO MTESTI1) 'NEG' 0) ;
  1377.         'MESS' ' ##### ECHEC Maillage Volume particule ' ;
  1378.         IAFAIR1  = VRAI ;
  1379.       'SINO' ;
  1380.         TMPARMAT . PCI1 . 'PART' = MPARI1 ;
  1381.         IAFAIR1  = IAFAIR1 'OU' FAUX ;
  1382.       'FINS' ;
  1383.     'FINS' ;
  1384.     IANNULV1 = IANNULV1 'OU' IANNULV2 ;
  1385.   'FINS' ;
  1386. *                                                                      *
  1387.   'SI' ('NON' IAFAIR1) ;
  1388.     MOT1     = 'CHAI'
  1389.       ' ***** Particule No ' &BI1 ' / ' NBI1 ' : maillage REUSSI !' ;
  1390.     'MESS' MOT1 ;
  1391.     'QUIT' BDENS1 ;
  1392.   'SINO' ;
  1393.     MOT1     = 'CHAI'
  1394.       ' ##### Particule No ' &BI1 ' / ' NBI1 ' : maillage ECHOUE !' ;
  1395.     'MESS' MOT1 ;
  1396.     'SAUT' 1 'LIGN' ;
  1397.   'FINS' ;
  1398. *                                                                      *
  1399.   'FIN' BDENS1 ;
  1400. *                                                                      *
  1401.   'SI' IAFAIR1 ;
  1402.     'SI' (&BPOSI1 '>' 1) ;
  1403.       'DEPL' PCI1 'MOIN' VDEPI0 ;
  1404.     'FINS' ;
  1405.     'SI' (&BPOSI1 'EGA' NBPOSI1) ;
  1406.       'QUIT' BPOSI1 ;
  1407.     'FINS' ;
  1408.     IPERI1   = VRAI ;
  1409.     'SI' IJUSI1 ;
  1410.       'MESS'
  1411. '   - ATTENTION : Intersection PAS ASSEZ FRANCHE detectee' ;
  1412.         'MESS'
  1413. '     => Deplacement position particule' ;
  1414.       VDEPI1   = ('FLOT' &BPOSI1) * VDEPI1 ;
  1415.       PCI0     = PCI1 'PLUS' VDEPI1 ;
  1416.       IOKAY1   = VRAI ;
  1417.       'REPE' BJ1 NBJ1 ;
  1418.         PCJ0     = MPTI1 'POIN' &BJ1 ;
  1419.         'SI' (PCJ0 'DANS' MPOI1) ;
  1420.           'SI' (('NORM' (PCJ0 'MOIN' PCI0)) '&lt;EG' DREP1) ;
  1421.             IOKAY1   = FAUX ;
  1422.             'QUIT' BJ1 ;
  1423.           'FINS' ;
  1424.         'FINS' ;
  1425.       'FIN' BJ1 ;
  1426.       'SI' IOKAY1 ;
  1427.         IPERI1   = FAUX ;
  1428.       'SINO' ;
  1429.         'MESS'
  1430. '   - ATTENTION : Deplacement calcule NON VALIDE ' ;
  1431.       'FINS' ;
  1432.     'SINO' ;
  1433.       'MESS'
  1434. '   - ATTENTION : ECHEC realisation maillage ' ;
  1435.     'FINS' ;
  1436.     'SI' IPERI1 ;
  1437.       'TITR' ' Perturbation position ' ;
  1438.       'MESS'
  1439. '     => Perturbation aleatoire position particule' ;
  1440.       NBPERT1  = NBI1 - NPERTI1 ;
  1441.       'SI' (NBPERT1 '&lt;EG' 1) ;
  1442.         'QUIT' BPOSI1 ;
  1443.       'FINS' ;
  1444.       'REPE' BPERT1 NBPERT1 ;
  1445.         NPERTI1  = NPERTI1 + 1 ;
  1446.         PHII1    = XLPHI1 'EXTR' NPERTI1 ;
  1447.         THEI1    = XLTHE1 'EXTR' NPERTI1 ;
  1448.         XVDEPI1  = ('COS' PHII1) * ('COS' THEI1) ;
  1449.         YVDEPI1  = ('COS' PHII1) * ('SIN' THEI1) ;
  1450.         ZVDEPI1  = ('SIN' PHII1) ;
  1451.         VDEPI1   = XVDEPI1 YVDEPI1 ZVDEPI1 ;
  1452.         AMPI1    = XLAMP1 'EXTR' NPERTI1 ;
  1453.         'SI' (&BPOSI1 '>' 5) ;
  1454.           AMPI1    = ('FLOT' &BPOSI1) * AMPI1 ;
  1455.         'FINS' ;
  1456.         VDEPI1   = AMPI1 * VDEPI1 ;
  1457.         PCI0     = PCI1 'PLUS' VDEPI1 ;
  1458.         IOKAY1   = VRAI ;
  1459.         'REPE' BJ1 NBJ1 ;
  1460.           PCJ0     = MPTI1 'POIN' &BJ1 ;
  1461.           'SI' (PCJ0 'DANS' MPOI1) ;
  1462.             'SI' (('NORM' (PCJ0 'MOIN' PCI0)) '&lt;EG' DREP1) ;
  1463.               IOKAY1   = FAUX ;
  1464.               'QUIT' BJ1 ;
  1465.             'FINS' ;
  1466.           'FINS' ;
  1467.         'FIN' BJ1 ;
  1468.         'SI' IOKAY1 ;
  1469.           'MESS'
  1470. '     i) Perturbation reussie apres ' &BPERT1 ' essai(s)' ;
  1471.           'QUIT' BPERT1 ;
  1472.         'FINS' ;
  1473.       'FIN' BPERT1 ;
  1474.     'FINS' ;
  1475. PCI0 = PCI1 Plus VDEPI1 ;
  1476.     'DEPL' PCI1 'PLUS' VDEPI1 ;
  1477.     VDEPI0   = VDEPI1 ;
  1478.   'SINO' ;
  1479.     'QUIT' BPOSI1 ;
  1480.   'FINS' ;
  1481.   'FIN' BPOSI1 ;
  1482. *                                                                      *
  1483. *--------------------------- Fin Maillage -----------------------------*
  1484. *                                                                      *
  1485.   'SI' IAFAIR1 ;
  1486.     'SAUT' 1 'LIGN' ;
  1487.     'MESS' '   - ATTENTION : ECHEC perturbations ' ;
  1488.     'SI' ('NON' IANNULV1) ;
  1489.       PSK1   = THO7U . PCI1 . 'MAV' 'POIN' 1 ;
  1490.       PSK2   = THO7U . PCI1 . 'MAV' 'POIN' 2 ;
  1491.       'TRAC' 'NCLK' 'FACE' (MMATI1 'ET' MPARI1) 'COUP' PCI1 PSK1 PSK2 ;
  1492.     'FINS' ;
  1493.     ISTOP1   = FAUX ;
  1494.     IESSA1   = VRAI ;
  1495.     'SI' FAUX ;
  1496. *    'SI' ('NEG' ('VALE' 'TRAC') 'PSC') ;
  1497.       ISTOP1 IESSA1 = 'CHOI'
  1498.       ' Erreur maillage : STOPer ou ESSAyer a nouveau ?' ISTOP1 IESSA1 ;
  1499.     'FINS' ;
  1500.     'SI' ISTOP1 ;
  1501.       'MESS' ' ****** ARET OPERATION MAILLAGE !!!' ;
  1502.       'QUIT' BESSA1 ;
  1503.     'SINO' ;
  1504.       'SI' IESSA1 ;
  1505.     'MESS'
  1506. '     => Re-initialisation du schema ' ;
  1507.         MPOI0   = MPOI1 'DIFF' ('MANU' 'POI1' PCI1) ;
  1508.         MPOI1   = PCI1 'ET' MPOI0 ;
  1509.         'ITER' BESSA1 ;
  1510.       'SINO' ;
  1511.         'ITER' BI1 ;
  1512.       'FINS' ;
  1513.     'FINS' ;
  1514.   'SINO' ;
  1515.     'SI' IPARI1 ;
  1516.       MTOTI1   = MMATI1 'ET' MPARI1 ;
  1517.     'SINO' ;
  1518.       MTOTI1   = MMATI1 ;
  1519.     'FINS' ;
  1520.     TMPARMAT . PCI1 . 'MAIL' = MTOTI1 ;
  1521.     'SI' IPREMI1 ;
  1522.       IPREMI1  = FAUX ;
  1523.       TMPARMAT . 'MPCP' = 'MANU' 'POI1' PCI1 ;
  1524.       TMPARMAT . 'MATR' = MMATI1 ;
  1525.       'SI' IPARI1 ;
  1526.         TMPARMAT . 'PART' = MPARI1 ;
  1527.       'FINS' ;
  1528.       TMPARMAT . 'MAIL' = MTOTI1 ;
  1529.     'SINO' ;
  1530.       TMPARMAT . 'MPCP' = TMPARMAT . 'MPCP' 'ET' PCI1 ;
  1531.       TMPARMAT . 'MATR' = TMPARMAT . 'MATR'  'ET' MMATI1 ;
  1532.       'SI' IPARI1 ;
  1533.         'SI' ('EXIS' TMPARMAT 'PART') ;
  1534.           TMPARMAT . 'PART' = TMPARMAT . 'PART'  'ET' MPARI1 ;
  1535.         'SINO' ;
  1536.           TMPARMAT . 'PART' = MPARI1 ;
  1537.         'FINS' ;
  1538.       'FINS' ;
  1539.       TMPARMAT . 'MAIL' = TMPARMAT . 'MAIL'  'ET' MTOTI1 ;
  1540.     'FINS' ;
  1541.     'SI' (&BI1 'EGA' NBI1) ;
  1542.       'QUIT' BESSA1 ;
  1543.     'FINS' ;
  1544.   'FINS' ;
  1545. *                                                                      *
  1546. 'FIN' BI1 ;
  1547. 'FIN' BESSA1 ;
  1548. MPAR1    = TMPARMAT . 'PART' ;
  1549. MMAT1    = TMPARMAT . 'MATR' ;
  1550. MTOT1    = TMPARMAT . 'MAIL' ;
  1551. 'ELIM' MTOT1 TOL1 ;
  1552. *                                                                      *
  1553. * Test Conformite Maillage Total :                                     *
  1554. X1 Y1 Z1 = MTOT1 'COOR' ;
  1555. MPFCB1   = (X1 'POIN' 'INFE' TOL1) 'ET' (X1 'POIN' 'SUPE' (1. - TOL1))
  1556.       'ET' (Y1 'POIN' 'INFE' TOL1) 'ET' (Y1 'POIN' 'SUPE' (1. - TOL1))
  1557.       'ET' (Z1 'POIN' 'INFE' TOL1) 'ET' (Z1 'POIN' 'SUPE' (1. - TOL1)) ;
  1558. ENVTOT1  = 'ENVE' MTOT1 ;
  1559. MSTOT1   = ENVTOT1 'ELEM' 'APPU' 'STRI' MPFCB1 ;
  1560. MTEST1   = ENVTOT1 'DIFF' MSTOT1 ;
  1561. *                                                                      *
  1562. 'SI' (((NBNO MTEST1) + ('NBEL' MTEST1)) 'EGA' 0) ;
  1563.   'SAUT' 1 'LIGN' ;
  1564.   'MESS'
  1565. '-------------------------- MAILLAGE REUSSI --------------------------'
  1566.     ;
  1567.   'SAUT' 1 'LIGN' ;
  1568.   'SI' ITRA1 ;
  1569.     FVOL     = 100. * ('MESU' MPAR1) / ('MESU' MTOT1) ;
  1570.     'TITR' ('CHAI' ' Maillage (Fvol = ' 'FORMAT' '(F5.1)' FVOL ' %) : '
  1571.       (NBNO TMPARMAT . 'MPCP') ' Particules / '
  1572.       (NBNO MTOT1) ' Noeuds / '
  1573.       ('NBEL' MTOT1) ' Elements') ;
  1574.     'TRAC' 'FACE' (MACB1 'ET' MMAT1) ;
  1575.     'TRAC' 'FACE' (MACB1 'ET' MPAR1) ;
  1576.     'TRAC' 'FACE' (MACB1 'ET' MTOT1) ;
  1577.   'FINS' ;
  1578. 'SINO' ;
  1579.   'SAUT' 1 'LIGN' ;
  1580.   'MESS'
  1581. '########################## MAILLAGE ECHOUE ##########################'
  1582.     ;
  1583.   'SAUT' 1 'LIGN' ;
  1584.   'SI' ITRA1 ; 'TRAC' (MSTOT1 'ET' (MTEST1 'COUL' 'ROSE')) ; 'FINS' ;
  1585. 'FINS' ;
  1586. *                                                                      *
  1587. 'FINP' TMPARMAT ;
  1588. *-------------------- FIN DE LA PROCEDURE INCLUSIO --------------------*
  1589.  
  1590.  

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