Télécharger la plaquette Cast3M


fr en

Télécharger @toro.procedur

Retour à la liste

Numérotation des lignes : 

  1. * @TORO     PROCEDUR  CB215821  15/12/02    21:15:02     8719           
  2. *-------------------------------------------------                              
  3. ******          PROCEDURE @TORO             ******
  4. *-------------------------------------------------                              
  5. *
  6. *
  7. *    CETTE PROCEDURE A ETE MISE GRACIEUSEMENT
  8. *   A DISPOSOTION DE LA COMMUNAUTE  CASTEM2000
  9. *    PAR M. LIBEYRE ( CEA/DSM/DRFC )
  10. *
  11. *     TEL : ( 33 1 ) 42 25 46 03
  12. *
  13. *-------------------------------------------------                              
  14. DEBPROC @TORO TAGEO*TABLE TABOB*TABLE ;
  15. *                                                                    
  16. * Developpement et test de la procedure @TORO
  17. * Projet DRFC/TO_PO Contrat n 30422676                                          
  18. *                                                                               
  19. opti dime 3 elem cub8 echo 0 ; 
  20. **********************************************************************          
  21. *                                                                    *          
  22. *                          T O R O                                   *
  23. *                          -------                                   *          
  24. *                                                                    *          
  25. * Objet:                                                             *          
  26. * -----                                                              *          
  27. *                                                                    *          
  28. * Calcul de l'induction magnetique creee par un ensemble             *
  29. * de bobines circulaires ou en 'D', reparties regulierement          *
  30. * autour de l'axe Oz, en l'absence de fer.                           *          
  31. *                                                                    *          
  32. * Syntaxe:                                                           *          
  33. * -------                                                            *          
  34. *                                                                    *          
  35. * TABCHB TAB2 = @TORO TAGEO1 TABOB1 ;                                *
  36. *                                                                    *          
  37. * En entree :                                                        *          
  38. *                                                                    *          
  39. *                                                                    *          
  40. * TAGEO1        table des domaines de calcul du champ                *  
  41. *    TAGEO1.i   geometrie ou le champ est calcule (type TABLE)       *          
  42. *    TAGEO1.i.'mail' : maillage de la geometrie (type MAILLAGE)      *          
  43. *                                                                    *          
  44. * TABOB         table a deux indices contenant les donnees           *          
  45. *               relatives aux bobines (type TABLE)                   *
  46. *       .GENE    table                                               *
  47. *             .1 nbob: nombre de bobines (type ENTIER)               *
  48. *             .2 b: largeur des bobines (type FLOTTANT)              *
  49. *             .3 h: hauteur des bobines (type FLOTTANT)              *
  50. *             .4 cbob: centre de la bobine (type POINT)              *
  51. *             .5 vn: vecteur normal au plan de la bobine (type POINT)*
  52. *             .6 tsol: table des solenations des bobines             *
  53. *                     .i solenation (courant * nombre de spires)     *
  54. *                        de la bobine i (type FLOTTANT)              *
  55. *             .7 rt: rayon du tore (type FLOTTANT)                   *
  56. *             .8 ri: nombre de bobines (type FLOTTANT)               *
  57. *       .TYPE     'c' pour une bobine circulaire                     *
  58. *                 'd' pour une bobine en 'D'                         *
  59. *       .TRAC1 si oui : trace du maillage des bobines (type LOGIQUE) *
  60. *       .CBIOT si oui : calcul de l'induction magnetique             *
  61. *       .D       = troncon : table des troncons:                     *
  62. *                  troncon.j = troncj : table du troncon j:          *
  63. *                     troncj.'l' longueur du troncon si rectiligne,  *
  64. *                           .'r' rayon de courbure et                *
  65. *                           .'alpha' angle de courbure si courbe     *
  66. *                                                                    *          
  67. * En sortie :                                                        *          
  68. *                                                                    *          
  69. *                                                                    *          
  70. * TABCHB        table contenant (type TABLE)                         *   
  71. *    i          champ de Biot et Savart relatif au i-eme             *          
  72. *               maillage GEO1 (type CHPOINT)                         *          
  73. *                                                                    *          
  74. * TAB2          table contenant (type TABLE)                         *          
  75. * BOBMAI.i      maillage de chaque bobine (type MAILLAGE)            *          
  76. * CONT.j        ensemble des coupes sur le plan j                    *          
  77. *               (type MAILLAGE)                                      *          
  78. *                                                                    *
  79. * Remarques:                                                         *          
  80. * ---------                                                          *          
  81. *                                                                    *  
  82. * Les grandeurs suivantes sont "en dur" dans la procedure :          *
  83. *                                                                    *
  84. * NELE          nombre d'elements generes lors des rotations         *
  85. *               et des translations effectuees pendant la            *
  86. *               creation du maillage des bobines.                    *
  87. *                                                                    *
  88. * COEF1         coefficient etablissant la distance critique         *
  89. *               de selection des points lors de la recherche         *
  90. *               de contour.                                          *
  91. *                                                                    *          
  92. **********************************************************************
  93. isym = 0 ;
  94. *
  95. * Valeurs de quelques constantes
  96. *
  97. pi = PI ;
  98. mu0 = 4.e-7 * pi ;
  99. eps = 1.e-3 ;
  100. nele = 4 ;
  101. alpha = 90. ;
  102. oeil = 100. 20. 10. ;
  103. *
  104. * creation du maillage
  105. *
  106. tab2 = table ;
  107. tabmai = table ;
  108. tab2.bobmai = tabmai ;
  109. ibob = 1 ;
  110. repeter proc 1 ;
  111.    sauter 1 ligne ;
  112.    mess ' ************ procedure @TORO' ;
  113.    sauter 1 ligne ;
  114.    ngeo = dime tageo1 ;
  115.    si (ega ngeo 0) ;
  116.       mess ' **** Il n y a pas de domaine de calcul ;
  117.    sinon ;
  118.       si (ega ngeo 1) ;
  119.          mess ' **** Il y a un seul domaine de calcul' ;
  120.       sinon ;
  121.          mess ' **** Il y a' ngeo 'domaines de calcul ;
  122.       finsi ;
  123.    finsi ;
  124.    si (existe tabob type) ;
  125.       typbob = tabob.type ;
  126.    sinon ;
  127.       mess '  ***  erreur : indice type inexistant' ;
  128.       quitter proc ;
  129.    finsi ;
  130.    si (existe tabob gene) ;
  131.       tcara = table ;
  132.       tcara = tabob.gene ;
  133.       si (existe tcara 1) ;
  134.          nbob*entier = tcara.1 ;
  135.       sinon ;
  136.          mess ' *** erreur ; il manque nbob !!' ;
  137.          quitter proc ;
  138.       finsi ;
  139.       si (existe tcara 2) ;
  140.          b*flottant = tcara.2 ;
  141.       sinon ;
  142.          mess ' *** erreur ; il manque b !!' ;
  143.          quitter proc ;
  144.       finsi ;
  145.       si (existe tcara 3) ;
  146.          h*flottant = tcara.3 ;
  147.       sinon ;
  148.          mess ' *** erreur ; il manque nbob !!' ;
  149.          quitter proc ;
  150.       finsi ;
  151.       si (existe tcara 4) ;
  152.          cbob*point = tcara.4 ; 
  153.       sinon ;
  154.          mess ' *** erreur ; il manque cbob !!' ;
  155.          quitter proc ;
  156.       finsi ;
  157.       si (existe tcara 5) ;
  158.          v*point = tcara.5 ; 
  159.       sinon ;
  160.          mess ' *** erreur ; il manque v !!' ;
  161.          quitter proc ;
  162.       finsi ;
  163.       si (existe tcara 6) ;
  164.          tabsol = table ;
  165.          tabsol = tcara.6 ;
  166.       sinon ;
  167.          mess ' *** erreur ; il manque tabsol !!' ;
  168.          quitter proc ;
  169.       finsi ;
  170.       si (existe tcara 7) ;
  171.          rt*flottant = tcara.7 ;
  172.       sinon ;
  173.          mess ' *** erreur ; il manque rt !!' ;
  174.          quitter proc ;
  175.       finsi ;
  176.       si (existe tcara 8) ;
  177.          ri*flottant = tcara.8 ;
  178.       sinon ;
  179.          mess ' *** erreur ; il manque ri !!' ;
  180.          quitter proc ;
  181.       finsi ;
  182.    sinon ;
  183.       mess '  ***  erreur : indice gene inexistant' ;
  184.    finsi ;
  185. *
  186.    si (ega typbob 'c') ;
  187.        sauter 1 ligne ;
  188.        mess ' ******* bobine circulaire *********' ;
  189.    sinon;
  190.       si (ega typbob 'd') ;
  191.           si (existe tabob 'd') ;
  192.              sauter 1 ligne ;
  193.              mess ' ******* bobine en D *********' ;
  194.              sauter 1 ligne ;
  195.           sinon;
  196.              mess ' erreur bobine D : indice d inexistant' ;
  197.           finsi;
  198.       sinon;
  199.          mess '*********  erreur bobine  ***********' ;
  200.          quitter proc ;
  201.       finsi;
  202.    finsi ;
  203. *-----------------------------------------------------------------
  204. *       fin de l'analyse syntaxique
  205. *-----------------------------------------------------------------
  206.    c1 c2 c3 = coor cbob ;
  207.    o1 = cbob plus (0. (0. - rt) 0.) ;
  208.    o2 = o1 plus (0. 0. 10.) ;
  209. *
  210. *  calcul du vecteur norme vnor normal au plan de la bobine
  211. *
  212.    v1 v2 v3 = coor v ;
  213. *
  214.    vn = ( (v1**2) + (v2**2) + (v3**2) )**0.5 ;
  215.    si (vn ega 0.);
  216.       mess '  ***  erreur: vecteur vn nul !' ;
  217.       quitter proc ;
  218.    finsi  ;
  219.    vn1 = v1/vn ; vn2 = v2/vn ; vn3 = v3/vn ;
  220.    vnor = vn1 vn2 vn3 ;
  221.    ovn = o1 plus (v1 v2 v3) ;
  222. *
  223. *  calcul du vecteur norme wn normal a vnor (dans le plan de la bobine
  224. *   et dans le plan xOy) et du vecteur t tangent au troncon
  225. *
  226.    si (vn3 ega 0.);
  227.       t0 = 0. 0. 1. ;
  228.       wn = pvec t0 vnor ;
  229.    sinon ;
  230.       si ( (non (ega vn1 0.)) ou (non (ega vn2 0.)) ) ;
  231.          wn = pvec (0. 0. 1.) vnor ;
  232.          t0 = pvec vnor wn ;
  233.       sinon ;
  234.          wn = 0. 1. 0. ;
  235.          t0 = 1. 0. 0. ;
  236.       finsi ;
  237.    finsi ;
  238.    xt0 yt0 zt0 = coor t0 ;
  239.    t = t0 plus (0. 0. 0.) ;
  240.    wn1 wn2 wn3 = coor wn ;
  241. *-----------------------------------------------------------
  242. * test sur le domaine de calcul
  243. *-----------------------------------------------------------
  244.    itest = table ;
  245.    igeo1 = 0 ;
  246.    repeter bgeo1 ngeo ;
  247.       igeo1 = igeo1 + 1 ;
  248.       si (existe tageo1 igeo1) ;
  249.           lmot = ((tageo1.igeo1).'mail') elem 'TYPE' ;
  250.           nbeldom = nbel (tageo1.igeo1).'mail' ;
  251.           nmot = dime lmot ;
  252.           imot = 0 ;
  253.           repeter boutyp nmot ;
  254.             imot = imot + 1 ;
  255.             mot1 = extr lmot imot ;
  256.             mess ' *** domaine numero' igeo1 
  257.                  'compose de' nbeldom 'elements ' mot1 ;
  258.             sauter 1 ligne ;
  259. * domaine plan
  260.              si ( (ega mot1 'TRI3') ou (ega mot1 'QUA4') ou
  261.                   (ega mot1 'TRI6') ou (ega mot1 'QUA8') ) ;
  262.                 elem1 = ((tageo1.igeo1).'mail') elem 1 ;
  263.                 elem2 = chan poi1 elem1 ;
  264.                 pel1 = elem2 poin 1 ;
  265.                 pel2 = elem2 poin 2 ;
  266.                 pel3 = elem2 poin 3 ;
  267.                 zpel1 = coor 3 pel1 ;
  268.                 zpel2 = coor 3 pel2 ;
  269.                 zpel3 = coor 3 pel3 ;
  270.                 phori = (ega zpel1 zpel2 1.E-5) et 
  271.                         (ega zpel1 zpel3 1.E-5) ;
  272.                 si (phori) ;
  273.                    (tageo1.igeo1).'ZP' = zpel1 ;
  274.                    (tageo1.igeo1).'PP' = pel1 ;
  275.                    (tageo1.igeo1).'VP' = 0. 0. 1. ;
  276.                    pequa = phori et (ega zpel1 0.) ;
  277.                    si (pequa et (ega v3 0.)) ;
  278.                       itest.igeo1 = 0 ;
  279.                       isym = 1 ;
  280.                    sinon ;
  281.                       si ((ega typbob 'c') et (ega v3 0.)) ;
  282. * calcul analytique pour une bobine circulaire verticale 
  283.                          itest.igeo1 = 1 ;
  284.                       sinon ;
  285. * calcul d'intersection de Denis
  286.                          itest.igeo1 = 2 ;
  287.                       finsi ;
  288.                    finsi ;
  289.                 sinon ;
  290.                    itest.igeo1 = -2 ;
  291.                 finsi ;
  292.                 quitter boutyp ;
  293.             sinon ;
  294. * domaine volumique
  295.                itest.igeo1 = -1 ;
  296.             finsi ;
  297.          fin boutyp ;
  298. *         sauter 1 ligne ;
  299. *         mess '  ****** itest =' itest.igeo1 ;
  300. *         sauter 1 ligne ;
  301.       sinon ;
  302.          quitter bgeo1 ;
  303.       finsi ;
  304.    fin bgeo1 ;
  305. *--------------------------------------------------------------
  306. *  construction des points de la section initiale de la bobine
  307. *--------------------------------------------------------------
  308.    re = ri + b ;
  309.    p11 = c1 + (ri*wn1) - ((h/2.)*vn1) ;
  310.    p12 = c2 + (ri*wn2) - ((h/2.)*vn2) ;
  311.    p13 = c3 + (ri*wn3) - ((h/2.)*vn3) ;
  312.    p21 = c1 + (re*wn1) - ((h/2.)*vn1) ;
  313.    p22 = c2 + (re*wn2) - ((h/2.)*vn2) ;
  314.    p23 = c3 + (re*wn3) - ((h/2.)*vn3) ;
  315.    p31 = c1 + (re*wn1) + ((h/2.)*vn1) ;
  316.    p32 = c2 + (re*wn2) + ((h/2.)*vn2) ;
  317.    p33 = c3 + (re*wn3) + ((h/2.)*vn3) ;
  318.    p41 = c1 + (ri*wn1) + ((h/2.)*vn1) ;
  319.    p42 = c2 + (ri*wn2) + ((h/2.)*vn2) ;
  320.    p43 = c3 + (ri*wn3) + ((h/2.)*vn3) ;
  321. *
  322. * points de la base
  323. *
  324.    p1 = p11 p12 p13 ; p2 = p21 p22 p23 ;
  325.    p3 = p31 p32 p33 ; p4 = p41 p42 p43 ;
  326. * barycentre de la base:
  327.    pp11 = (p11 + p21 + p31 + p41)/4. ;
  328.    pp12 = (p12 + p22 + p32 + p42)/4. ;
  329.    pp13 = (p13 + p23 + p33 + p43)/4. ;
  330.    pp1 = pp11 pp12 pp13 ;
  331. *
  332. * segments de la base
  333. *
  334.    d1 = droi 1 p1 p2 ; d2 = droi 1 p2 p3 ;
  335.    d3 = droi 1 p3 p4 ; d4 = droi 1 p4 p1 ;
  336.    cont1 = p1 d 1 p2 d 1 p3 d 1 p4 d 1 p1 ;
  337. *
  338.    cvn = cbob plus (vn1 vn2 vn3) ;
  339. *-----------------------------------------
  340. *  construction des surfaces laterales
  341. *-----------------------------------------
  342.    si (ega typbob 'c') ;
  343.       tquart = table ;
  344.       pp2 = pp1 tour alpha cbob cvn ;
  345. *
  346.       surf1 = d1 rota nele alpha cbob cvn ;
  347.       surf2 = d2 rota nele alpha cbob cvn ;
  348.       surf3 = d3 rota nele alpha cbob cvn ;
  349.       surf4 = d4 rota nele alpha cbob cvn ;
  350. *
  351.       surfbo1 = surf1 et surf2 et surf3 et surf4 ;
  352.       tquart.1 = surfbo1 ;
  353.       xn1 = (vn2*wn3) - (vn3*wn2) ;
  354.       xn2 = (vn3*wn1) - (vn1*wn3) ;
  355.       xn3 = (vn1*wn2) - (vn2*wn1) ;
  356.       p51 = c1 + (ri*xn1) - ((h/2.)*vn1) ;
  357.       p52 = c2 + (ri*xn2) - ((h/2.)*vn2) ;
  358.       p53 = c3 + (ri*xn3) - ((h/2.)*vn3) ;
  359.       p61 = c1 + (re*xn1) + ((h/2.)*vn1) ;
  360.       p62 = c2 + (re*xn2) + ((h/2.)*vn2) ;
  361.       p63 = c3 + (re*xn3) + ((h/2.)*vn3) ;
  362.       p5 = p51 p52 p53 ; p6 = p61 p62 p63 ;
  363.       surfbo2 = surfbo1 syme plan cbob p5 p6 ;
  364. *
  365.       tquart.2 = surfbo2 ;
  366.       tquart.3 = surfbo2 syme plan cbob p1 p2 ;
  367.       tquart.4 = surfbo1 syme plan cbob p1 p2 ;
  368.       cont2 = cont1 syme plan cbob p5 p6 ;
  369.       demisurf = (surfbo1 et surfbo2) ;
  370.    finsi ;
  371. *-------------------------------------------------
  372.    si (ega typbob 'd') ;
  373.       troncon = table ;
  374.       troncon = tabob.'d' ;
  375.       ntron = dime troncon ;
  376. *      mess ' ****************** Il y a' ntron 'troncons' ;
  377.       itron = 1 ;
  378.       troncj = table ;
  379.       repeter btron ntron ;
  380.          troncj = troncon.itron ;
  381.          si ( (existe troncj 'l') et (non (existe troncj 'r')) et
  382.               (non (existe troncj 'alpha')) ) ;
  383.             mess ' ******  troncon no' itron 'rectiligne' ;
  384.             lj = troncj.'l' ;
  385.             si (itron ega 1) ;
  386.                pp2 = pp1 plus ((xt0*lj) (yt0*lj) (zt0*lj)) ;
  387.                vdir = (xt0*lj) (yt0*lj) (zt0*lj) ;
  388.             sinon ;
  389.                xt yt1 zt1 = coor t ;
  390.                xpp2 ypp2 zpp2 = coor pp2 ;
  391.                pp1 = xpp2 ypp2 zpp2 ;
  392.                xg = xt*lj ;
  393.                yg = yt1*lj ;
  394.                zg = zt1*lj ;
  395.                pp2 = pp1 plus (xg yg zg) ;
  396.                vdir = xg yg zg ;
  397.             finsi ;
  398.             surf1 = d1 tran nele vdir ; 
  399.             d1 = d1 plus vdir ;
  400.             surf2 = d2 tran nele vdir ; 
  401.             d2 = d2 plus vdir ;
  402.             surf3 = d3 tran nele vdir ; 
  403.             d3 = d3 plus vdir ;
  404.             surf4 = d4 tran nele vdir ; 
  405.             d4 = d4 plus vdir ;
  406.             surfboj = surf1 et surf2 et surf3 et surf4 ;
  407. *
  408. * conservation des points definissant le troncon rectiligne
  409. *
  410.             troncj.'pp1' = pp1 ;
  411.             troncj.'pp2' = pp2 ;
  412.             troncj.'pp3' = cbob ;
  413.          sinon ;
  414.             si ( (existe troncj 'r') et (existe troncj 'alpha') 
  415.                et (non (existe troncj 'l')) ) ;
  416.                mess ' ******  troncon no' itron 'courbe' ;
  417.                rj = troncj.'r' ;
  418.                alphaj = troncj.'alpha' ;
  419.                si (itron ega 1) ;
  420.                   si (dbob > 0.) ;
  421.                      crj = cbob plus (0. (dbob - rj) 0.) ;
  422.                   sinon ;
  423.                      crj = cbob plus (0. (dbob + rj) 0.) ;
  424.                   finsi ;
  425.                sinon ;
  426.                   xpp2 ypp2 zpp2 = coor pp2 ;
  427.                   pp1 = xpp2 ypp2 zpp2 ;
  428.                   xt yt1 zt1 = coor t ;
  429. *  vecteur norme vr perpendiculaire a vnor et t
  430.                   si (alphaj > 0.) ;
  431.                      vr = vnor pvec t ;
  432.                   sinon ;
  433.                      vr = t pvec vnor ;
  434.                   finsi ;
  435.                   xvr yvr zvr = coor vr ;
  436.                   xcrj = xpp2 + ((rj+(b/2.))*xvr) ;
  437.                   ycrj = ypp2 + ((rj+(b/2.))*yvr) ;
  438.                   zcrj = zpp2 + ((rj+(b/2.))*zvr) ;
  439.                   crj = xcrj ycrj zcrj ;
  440.                finsi ;
  441.                cvn = crj plus (vn1 vn2 vn3) ;
  442.                surf1 = d1 rota nele alphaj crj cvn ;
  443.                d1 = d1 tour alphaj crj cvn ;
  444.                surf2 = d2 rota nele alphaj crj cvn ;
  445.                d2 = d2 tour alphaj crj cvn ;
  446.                surf3 = d3 rota nele alphaj crj cvn ;
  447.                d3 = d3 tour alphaj crj cvn ;
  448.                surf4 = d4 rota nele alphaj crj cvn ;
  449.                d4 = d4 tour alphaj crj cvn ;
  450.                surfboj = surf1 et surf2 et surf3 et surf4 ;
  451. *
  452. *  barycentre de la section finale 
  453. *
  454.                pp2 = pp1 tour alphaj crj cvn ;
  455. * conservation du point definissant le centre du troncon courbe
  456.                troncj.'crj' = crj ;
  457. *
  458. * construction du nouveau vecteur tangent t (par rotation de alphaj)
  459. *
  460.                t = t tour alphaj o1 ovn ;
  461.                troncj.'pp1' = pp1 ;
  462.                troncj.'pp2' = pp2 ;
  463.             sinon ;
  464.                mess ' erreur : troncon mal defini ' ;
  465.                quitter proc ;
  466.             finsi ;
  467.          finsi ;
  468.          troncj.'mail' = surfboj ;
  469.          si (itron ega 1) ;
  470.             demisurf = surfboj ;
  471.          sinon ;
  472.             demisurf = demisurf et surfboj ;
  473.          finsi ;
  474.          troncon.itron = troncj ;
  475.          itron = itron + 1 ;
  476.       fin btron ;
  477.       cont2 = d1 et d2 et d3 et d4 ;
  478.       elim 1.E-3 cont2 ;
  479. *---------------------------------------------------------
  480. * construction des troncons inferieurs par symetrie / xOy
  481. *---------------------------------------------------------
  482.       si (ega isym 0);
  483.          itron = 1 ;
  484.          repeter btron2 ntron ;
  485.             troncj = troncon.itron ;
  486.             itron2 = (2*ntron) - itron + 1 ;
  487.             troncj2 = table ;
  488.             troncj2.'mail' = (troncj.'mail') syme plan o1 cbob cvn ;
  489.             si ( (existe troncj 'r') et (existe troncj 'alpha') 
  490.               et (non (existe troncj 'l')) ) ;
  491.                 crj = (troncj.'crj') syme plan cbob p1 p2  ;
  492.                 pp1 = (troncj.'pp2') syme plan cbob p1 p2  ;
  493.                 pp2 = (troncj.'pp1') syme plan cbob p1 p2  ;
  494.                 troncj2.'crj' = crj ;
  495.                 troncj2.'pp1' = pp1 ;
  496.                 troncj2.'pp2' = pp2 ;
  497.                 troncj2.'r' = troncj.'r' ;
  498.                 troncj2.'alpha' = troncj.'alpha' ;
  499.             finsi ;
  500.             si ( (existe troncj 'l') et (non (existe troncj 'r')) et
  501.                (non (existe troncj 'alpha')) ) ;
  502.                 pp1 = (troncj.'pp2') syme plan cbob p1 p2  ;
  503.                 pp2 = (troncj.'pp1') syme plan cbob p1 p2  ;
  504.                 troncj2.'pp1' = pp1 ;
  505.                 troncj2.'pp2' = pp2 ;
  506.                 troncj2.'pp3' = cbob ;
  507.                 troncj2.'l' = troncj.'l' ;
  508.             finsi ;
  509.             troncon.itron2 = troncj2 ;
  510.             itron = itron + 1 ;
  511.          fin btron2 ;
  512.       finsi ;
  513.    finsi ;
  514. *----------------------------------------------------------------------
  515. * construction du symetrique du maillage de la bobine par rapport a xOy
  516. *----------------------------------------------------------------------
  517.    surfbob = demisurf et (demisurf syme plan cbob p1 p2 ) ;
  518.    elim eps surfbob ;
  519.    mess 'construction de la premiere bobine effectuee' ;
  520. *-----------------------------------------------------------
  521. * construction des autres bobines par rotation autour de Oz
  522. *-----------------------------------------------------------
  523.    ibob = 1 ;
  524.    tabmai.ibob = surfbob ;
  525.    surftot = surfbob ;
  526.    si (nbob > 1) ;
  527.       repeter bbob (nbob-1) ;
  528.          ibob = ibob + 1 ;
  529.          angln = (ibob-1)*360./nbob ;
  530.          surfbobn = surfbob tour angln o1 o2 ;
  531.          tabmai.ibob = surfbobn ;
  532.          surftot = surftot et tabmai.ibob ;
  533.          mess 'construction de la bobine' ibob 'effectuee' ;
  534.       fin bbob ;
  535.    finsi ;
  536. *
  537. * construction des axes
  538. *
  539.    x1 = (2.*rt) 0. 0. ;
  540.    y1 = 0. (2.*rt) 0. ;
  541.    z1 = 0. 0. (2.*rt) ;
  542.    axes = (o1 d 1 x1) et (o1 d 1 y1) et (o1 d 1 z1) ;
  543.    axes = axes coul rouge ;
  544.    si (ega tabob.trac1 'oui') ;
  545.       trac oeil cach (surftot et axes) ;
  546.    finsi ;
  547. fin proc ;
  548. ****************************************
  549. * calcul des champs de biot et savart  *
  550. ****************************************
  551. tabchb = table ;
  552. tab2.cont = table ;
  553. re = ri + b ;
  554. igeo1 = 0 ;
  555. si (ega tabob.cbiot 'oui') ;
  556.    repeter bogeo1 ngeo ;
  557.       igeo1 = igeo1 + 1 ;
  558.       mess ' *** Domaine de calcul du champ numero' igeo1 ;
  559.       si (itest.igeo1 > -1) ;
  560.          tabcon = table ;
  561.       finsi ;
  562.       si (existe tageo1 igeo1) ;
  563.          geo1 = (tageo1.igeo1).'mail' ;
  564.          chp0 = manu chpo geo1 3 bx 0. by 0. bz 0. ;
  565.          ibob = 0 ;
  566.          repeter bbob2 nbob ;
  567.             ibob = ibob + 1 ;
  568.             si (existe tabsol ibob) ;
  569.                sol = tabsol.ibob ;
  570.                dens = sol/(b*h) ;
  571.             finsi ;
  572.             si (ega typbob 'c') ;
  573.                mess ' *** BIOT ; induction magnetique cree par '
  574.                     'la bobine circulaire numero' ibob ;
  575.                mess 'dont la solenation est' sol ;
  576.                sauter 1 ligne ;
  577.                si (ega ibob 1) ;
  578.                   chb1 = biot geo1 cerc cbob pp1 pp2 ri re h dens mu0 ;
  579.                sinon ;
  580.                   anglj = 360./nbob ;
  581.                   cbob = cbob tour anglj o1 o2 ;
  582.                   pp1 = pp1 tour anglj o1 o2 ;
  583.                   pp2 = pp2 tour anglj o1 o2 ;
  584.                   chb1 = chb1 et 
  585.                  (biot geo1 cerc  cbob  pp1  pp2 ri re h dens mu0) ;
  586.                finsi ;
  587.             sinon ; 
  588.                sauter 1 ligne ;
  589.                mess ' *** BIOT ; induction magnetique cree par '
  590.                     'la bobine en D numero' ibob ; 
  591.                mess 'dont la solenation est' sol ;
  592.                sauter 1 ligne ;
  593.                itron = 0 ;
  594.                ntron = dime troncon ;
  595.                repeter bbob3 ntron ;
  596.                   itron = itron + 1 ;
  597.                   troncj = troncon.itron ;
  598. *
  599. *  troncon courbe
  600. *
  601.                 si ( (existe troncj 'r') et (existe troncj 'alpha') ) ;
  602. *                     mess ' troncon numero' itron;
  603.                      ri = troncj.'r' ;
  604.                      re = ri + b ;
  605.                      crj = troncj.'crj' ;
  606.                      pp1 = troncj.'pp1' ;
  607.                      pp2 = troncj.'pp2' ;
  608. *                     mess '** ri' ri ;
  609. *                     list crj ;
  610. *                     list pp1 ;
  611. *                     list pp2 ;
  612.                      si ( (ega ibob 1) et (ega itron 1) ) ;
  613.                         mess ' *** premier troncon courbe ' ;
  614.                  chb1 = biot geo1 arc crj pp1 pp2 ri re h dens mu0 ;
  615.                      sinon ;
  616.                         mess ' *** troncon courbe numero' itron;
  617.                         si (ibob > 1) ;
  618.                            teta = (ibob - 1)*360./nbob ;
  619.                            tcrj = crj tour teta o1 o2 ;
  620.                            tpp1 = pp1 tour teta o1 o2 ;
  621.                            tpp2 = pp2 tour teta o1 o2 ;
  622.              chb1j = biot geo1 arc tcrj tpp1 tpp2 ri re h dens mu0 ;
  623.                            chb1 = chb1 et chb1j ;
  624.                         sinon ;
  625.                 chb1j = biot geo1 arc crj pp1 pp2 ri re h dens mu0 ;
  626.                            chb1 = chb1 et chb1j ;
  627.                         finsi ;
  628.                      finsi ;
  629.                   finsi ;
  630. *
  631. *  troncon rectiligne
  632. *
  633.                   si (existe troncj 'l') ;
  634. *                     mess ' troncon numero' itron;
  635.                      pp1 = troncj.'pp1' ;
  636.                      pp2 = troncj.'pp2' ;
  637.                      pp3 = troncj.'pp3' ;
  638. *                     list pp1 ;
  639. *                     list pp2 ;
  640. *                     list pp3 ;
  641.                      si ((ega ibob 1) et (ega itron 1));
  642.                         mess ' *** premier troncon rectiligne' ;
  643.                         chb1 = biot geo1 barr pp1 pp2 pp3 b h dens mu0 ;
  644.                      sinon ;
  645.                         mess ' *** troncon rectiligne numero' itron;
  646.                         si (ibob > 1) ;
  647.                            teta = (ibob - 1)*360./nbob ;
  648.                            tpp1 = pp1 tour teta o1 o2 ;
  649.                            tpp2 = pp2 tour teta o1 o2 ;
  650.                            tpp3 = pp3 tour teta o1 o2 ;
  651.                     chb1j = biot geo1 barr tpp1 tpp2 tpp3 b h dens mu0 ;
  652.                            chb1 = chb1 et chb1j ;
  653.                         sinon ;
  654.                     chb1j = biot geo1 barr pp1 pp2 pp3 b h dens mu0 ;
  655.                            chb1 = chb1 et chb1j ;
  656.                         finsi ;
  657.                      finsi ;
  658.                   finsi ;
  659.                  si (ega isym 1) ;
  660.                     mess ' ***** calcul du champ par symetrie / xOy ' ;
  661.                     si ( (ega ibob 1) et (ega itron 1) ) ;
  662.                        chb1x = exco 'BX' chb1 'BX' ;
  663.                        chb1y = exco 'BY' chb1 'BY' ;
  664.                        chb1z = exco 'BZ' chb1 'BZ' ;
  665.                        chb2z = chb1z*(-1.) ;
  666.                        chb2 = chb1x et chb1y et chb2z ;
  667.                        chb1 = chb1 et chb2 ;
  668.                     sinon ;
  669.                        chb1x = exco 'BX' chb1j 'BX' ;
  670.                        chb1y = exco 'BY' chb1j 'BY' ;
  671.                        chb1z = exco 'BZ' chb1j 'BZ' ;
  672.                        chb2z = chb1z*(-1.) ;
  673.                        chb2 = chb1x et chb1y et chb2z ;
  674.                        chb1 = chb1 et chb2 ;
  675.                     finsi ;
  676.                 finsi ;
  677.               fin bbob3 ;
  678.            finsi ;
  679.         fin bbob2 ;
  680.         tabchb.igeo1 = chb1 ;
  681. *----------------------------------------------------
  682. * calcul des intersections pour le plan igeo1
  683. *----------------------------------------------------
  684.         si (ega itest.igeo1 0) ;
  685.            tabcon.1 = cont1 et cont2 ;
  686.         finsi ;
  687.         si (ega itest.igeo1 1) ;
  688. *----------------------------------------------------------------
  689. *  calcul analytique de l'intersection d'une bobine circulaire 
  690. *       verticale avec un plan
  691. *----------------------------------------------------------------
  692.             mess ' **** calcul analytique dans le cas' 
  693.                            'de la bobine circulaire' ;
  694.             sauter 1 ligne ;
  695.             zp = (tageo1.igeo1).'ZP' ;
  696.             mess ' **** plan a la cote' zp ;
  697.             x1 = h/2.;
  698.             cbob*point = tcara.4 ; 
  699.             cxn = cbob plus (1. 0. 0.) ;
  700.             czn = cbob plus (0. 0. 1.) ;
  701.             si (zp < ri) ;
  702.                cos1 = ((ri**2.) - (zp**2.) )**0.5 ;
  703.                beta1 = atg zp cos1 ;
  704.                y1 = ri*(cos beta1) ;
  705.                pc1 = cbob plus (x1 y1 zp) ;
  706.                pc2 = cbob plus ( (0. - x1) y1 zp ) ;
  707. *
  708.                cos2 = ((re**2.) - (zp**2.) )**0.5 ;
  709.                beta2 = atg zp cos2 ;
  710.                y2 = re*(cos beta2) ;
  711.                pc3 = cbob plus (x1 y2 zp) ;
  712.                pc4 = cbob plus ( (0. - x1) y2 zp ) ;
  713. *
  714.                cont1 = pc1 d 1 pc2 d 1 pc4 d 1 pc3 d 1 pc1 ;
  715.                tabcon.1 = cont1 et (cont1 syme plan cbob cxn czn) ;
  716.             sinon ;
  717.                si (zp < re) ;
  718.                   cos2 = ((re**2.)- (zp**2.) )**0.5 ;
  719.                   beta2 = atg zp cos2 ;
  720.                   y2 = re*(cos beta2) ;
  721.                   pc1 = cbob plus (x1 y2 zp) ;
  722.                   pc2 = cbob plus ( (0. - x1) y2 zp ) ;
  723.                   pc3 = pc2 syme plan cbob cxn czn ;
  724.                   pc4 = pc1 syme plan cbob cxn czn ;
  725.                   cont1 = pc1 d 1 pc2 d 1 pc3 d 1 pc4 d 1 pc1 ;
  726.                   tabcon.1 = cont1 ;
  727.                sinon ;
  728.                   mess ' ***** le plan ne coupe pas les bobines !!' ;
  729.                finsi ;
  730.             finsi ;
  731.             si (non (ega vn2 0.)) ;
  732.                 gama1 = atg vn2 vn1 ;
  733.                 tabcon.1 = tabcon.1 tour gama1 cbob czn ;
  734.             finsi ;
  735.          finsi ;
  736.          si (ega itest.igeo1 2) ;
  737. *            mess 'Algorithme Denis Robert' ;
  738. *------------------------------------------------------------------
  739. *   Algorithme de recherche des contours des bobines 
  740. *------------------------------------------------------------------
  741.             repeter bouci 1 ;
  742.            'SAUTER' 1 'LIGNE' ;
  743.            'MESS' 'Contour des bobines dans le domaine' igeo1 ;
  744.            'MESS' '-------------------------------------------' ;
  745.            TABLIG   = TABLE ;
  746.            TAB2.LIG = TABLIG ;
  747.            COUP1 = tageo1.igeo1 ;
  748.            IRECUP = 0 ;
  749.              'SI' ( 'EXISTE' COUP1 'PP' ) ;
  750.                  PP*'POINT' = COUP1.'PP' ;
  751.              'SINON' ;
  752.                 'SAUTER' 1 'LIGNE' ;
  753.                 'MESS' 'Erreur : il manque PP pour le plan ' igeo1 ;
  754.                 'SAUTER' 1 'LIGNE' ;
  755.                 IERR = 1 ; 'QUITTER' BOUCI;
  756.              'FINSI' ;
  757.              'SI' ( 'EXISTE' COUP1 'VP' ) ;
  758.                  VP*'POINT' = COUP1.'VP' ;
  759.              'SINON' ;
  760.                 'SAUTER' 1 'LIGNE' ;
  761.                 'MESS' 'Erreur : il manque VP pour le plan ' igeo1 ;
  762.                 'SAUTER' 1 'LIGNE' ;
  763.                 IERR = 1 ; 'QUITTER' BOUCI ;
  764.              'FINSI' ;
  765. *
  766. *     Trois points vont definir ce plan : PP PP2 et PP3
  767. *
  768.               PP11 PP12 PP13 = COORD PP ;
  769.               VP1 VP2 VP3 = COORD VP ;
  770. *                                                                               
  771. *     Vecteur WN tq : VP1 WN1 + VP2 WN2 + VP3 WN3 = 0                           
  772. *                                                                               
  773.               VPN1 = ( (VP1**2) + (VP2**2) + (VP3**2) ) ** 0.5 ;                
  774.               'SI' ( VPN1 'EGA' 0. ) ;    
  775.                 'SAUTER' 1 'LIGNE' ;                                          
  776.                 'MESS' 'ERREUR : plan ' igeo1 ' le vecteur VP est nul';
  777.                 'SAUTER' 1 'LIGNE' ;                             
  778.                 IERR = 1 ; 'QUITTER' BOUCI ;                                  
  779.               'FINSI' ;                                                         
  780.               VN1 = VP1 / VPN1 ; VN2 = VP2 / VPN1 ; VN3 = VP3 / VPN1 ; 
  781.               VPN = VN1 VN2 VN3 ;                      
  782.              'SI' ( VN1 'NEG' 0. ) ;                                            
  783.                  'SI' ( VN2 'NEG' 0. ) ;                                        
  784.                      'SI' ( VN3 'NEG' 0. ) ;                                    
  785.                           W2 = VN3 / VN2 ; W3 = -1 ;                            
  786.                           WN = ( (W2**2) + (W3**2) ) ** 0.5 ;                   
  787.                           WN1 = 0. ; WN2 = W2 / WN ; WN3 = W3 / WN ;            
  788.                      'SINON' ;                                                  
  789.                           WN1 = 0. ; WN2 = 0. ; WN3 = 1. ;                      
  790.                      'FINSI' ;                                                  
  791.                  'SINON' ;                                                      
  792.                      'SI' ( VN3 'NEG' 0. ) ;                                    
  793.                           WN1 = 0. ; WN2 = 1. ; WN3 = 0. ;                      
  794.                      'SINON' ;                                                  
  795.                           WN1 = 0. ; WN2 = 0. ; WN3 = 1. ;
  796.                      'FINSI' ;                                 
  797.                  'FINSI' ;                                                      
  798.               'SINON' ;                                                         
  799.                   WN1 = 1. ; WN2 = 0. ; WN3 = 0. ;                              
  800.               'FINSI' ; 
  801. *                                
  802.                XN1 = (VN2 * WN3) - (VN3 * WN2) ;
  803.                XN2 = (VN3 * WN1) - (VN1 * WN3) ;
  804.                XN3 = (VN1 * WN2) - (VN2 * WN1) ;
  805. *
  806. *     WN et XN forment une base du plan de coupe
  807. *      
  808.                PP21 = PP11 + WN1 ; PP22 = PP12 + WN2 ;
  809.                PP23 = PP13 + WN3 ; PP31 = PP11 + XN1 ;
  810.                PP32 = PP12 + XN2 ; PP33 = PP13 + XN3 ;
  811.                PP2 = PP21 PP22 PP23 ; PP3 = PP31 PP32 PP33 ;
  812. *
  813. *     Intersection de ce plan avec la bobine IBO
  814. *
  815.                IINTER = 0 ;
  816. *
  817. *           On traite separement chaque troncon
  818. *
  819.                IINTEI = 0 ; 
  820.                itron = 0 ;
  821.                si (ega typbob 'd') ;
  822.                   ntron = dime tabob.'d' ;
  823.                sinon ;
  824.                   ntron = 4 ;
  825.                finsi ;
  826.               'REPETER' boutron ntron ;
  827.                   itron = itron + 1 ;
  828.                   si (ega typbob 'd') ;
  829.                      MAI0 = (tabtron.itron).'mail' ;
  830.                   sinon ;
  831.                      MAI0 = tquart.itron ;
  832.                   finsi ;
  833.                   MAI1 = 'CHANGER' 'POI1' MAI0 ;
  834.                   NBP1 = 'NBNO' MAI1 ;
  835.                   'MESS' '---> troncon de bobine : ' itron ;
  836.                   'MESS' '---> Nbre de pts     : ' NBP1 ;
  837.                   IP1 = 1 ;
  838.                   IDESSOUS = 0 ; IDESSUS = 0 ; IDEDANS = 0 ;
  839.                   DMOY = 0. ;
  840.                   'REPETER' BOUCPOI1 NBP1 ;
  841.                       PO1 = MAI1 'POIN' IP1 ;
  842.                       POX1 POY1 POZ1 = 'COORD' PO1 ;
  843.                       MX1 = POX1 - PP11 ; MY1 = POY1 - PP12 ;
  844.                       MZ1 = POZ1 - PP13 ;  M1 = MX1 MY1 MZ1 ;
  845.                       PDT1 = M1 'PSCAL' VPN ;
  846.                       DMOY = DMOY + ('ABS' (PDT1)) ;
  847.                       'SI' ( ( 'ABS' PDT1 ) < 0.001 ) ;
  848.                           IDEDANS = IDEDANS + 1 ;
  849.                       'FINSI' ;
  850.                       'SI' ( PDT1 '&lt;EG' -0.001 ) ;
  851.                           IDESSOUS = IDESSOUS + 1 ;
  852.                       'FINSI' ;
  853.                       'SI' ( PDT1 '>EG' 0.001 ) ;
  854.                           IDESSUS = IDESSUS + 1 ;
  855.                       'FINSI' ;
  856.                       'SI' ( IP1 'EGA' 1 ) ;
  857.                          LISPDT = 'PROG' PDT1 ;
  858.                       'SINON' ;
  859.                          LISPDT = LISPDT 'ET' ( 'PROG' PDT1 ) ;
  860.                       'FINSI' ;
  861.                       IP1 = IP1 + 1 ;              
  862.                   'FIN' BOUCPOI1 ;
  863. *+*
  864. *+*            Distance de selection des points a projeter
  865. *+*            on divise DMOY par 2 si NELE = 4
  866. *+*                               3           8
  867.                COEF1 = 2. ;
  868.                DMOY = DMOY / NBP1 ;
  869.                DCRIT = DMOY / COEF1 ;
  870. *
  871. *              tests sur la repartition des points / plan de coupe
  872. *
  873.                'SI' ( IDEDANS '>EG' 4 ) ;
  874.                   ICAS = 1 ;
  875.                'SINON' ;
  876.                   'SI' ( IDESSUS > IDESSOUS ) ;
  877.                      ICAS = 2 ;
  878.                   'SINON' ;
  879.                      ICAS = 3 ;
  880.                   'FINSI' ;
  881.                'FINSI' ;
  882. *
  883.                'SI' ((( IDESSOUS '>EG' 1 ) 'ET' ( IDESSUS '>EG' 1 )) 
  884.                      'OU' ( IDEDANS '>EG' 1 )) ;
  885.                   IINTER = IINTER + 1 ;
  886.                   IINTEI = IINTEI + 1 ;
  887.                      'MESS' 'Il y a une intersection ...' ;
  888. *
  889. *                 On ne retient que les points les plus proches du
  890. *                 plan de coupe Pc
  891. *
  892.                   IREC = 0 ;
  893.                   'REPETER' BOUCREC 7 ;
  894.                      IREC = IREC + 1 ;
  895.                      IP2 = 1 ; IOK = 0 ;
  896.                      'REPETER' BOUCTRI NBP1 ;
  897.                         VAL1 = 'EXTRAIRE' LISPDT IP2 ;
  898.             'SI' ( ( ICAS 'EGA' 1 ) et (('ABS' VAL1 ) '&lt;EG' 0.001) );
  899.                                IOK = IOK + 1 ; 
  900.                               'SI' ( IOK 'EGA' 1 ) ;
  901.                                  MAI2 = MAI1 'POIN' IP2 ;
  902.                               'SINON' ;
  903.                                  MAI2 = MAI2 'ET' ( MAI1 'POIN' IP2 ) ;
  904.                               'FINSI' ;
  905.                        'FINSI ' ;
  906.                        'SI' ( ( ICAS 'EGA' 2 ) et 
  907.              ((('ABS' VAL1 ) '&lt;EG' DCRIT ) 'ET' ( VAL1 '>EG' 0.001)) );
  908.                                IOK = IOK + 1 ; 
  909.                               'SI' ( IOK 'EGA' 1 ) ;
  910.                                   MAI2 = MAI1 'POIN' IP2 ;
  911.                               'SINON' ;
  912.                                   MAI2 = MAI2 'ET' ( MAI1 'POIN' IP2 ) ;
  913.                               'FINSI' ;
  914.                        'FINSI' ;
  915.                        'SI' ( (ICAS 'EGA' 3 ) et 
  916.                  ((('ABS' VAL1 ) '&lt;EG' DCRIT ) 'ET' (VAL1 < -0.001)) );   
  917.                              IOK = IOK + 1 ; 
  918.                               'SI' ( IOK 'EGA' 1 ) ;
  919.                                   MAI2 = MAI1 'POIN' IP2 ;
  920.                               'SINON' ;
  921.                                   MAI2 = MAI2 'ET' ( MAI1 'POIN' IP2 ) ;
  922.                               'FINSI' ;
  923.                        'FINSI' ;
  924.                         IP2 = IP2 + 1 ;
  925.                     'FIN' BOUCTRI ;
  926.                      list iok ;
  927.                      si (iok > 1) ;
  928.                         NBP2 = 'NBNO' MAI2 ;
  929.                      sinon ;
  930.                         NBP2 = 1 ;
  931.                      finsi ;
  932.                      'MESS' '---> Distance critique      : ' DCRIT ;
  933.                      'MESS' '---> Nbre de points retenus : ' NBP2 ;
  934.                      'MESS' '---> iok : ' iok ;
  935.                      'SI' ( NBP2 < 4 ) ;
  936.                         'SI' ( IREC '&lt;EG' 6 ) ;
  937.                            'MESS' 'Pas assez de points selectionnes' ;
  938.                            'MESS' 'essai nouvelle distance critique' ;
  939.                            DCRIT = DCRIT * 1.25 ;       
  940.                         'SINON' ; 
  941.                            'MESS' 'Mauvaise selection des points : ' ;
  942.                            'MESS' 'contour introuvable !' ;
  943.                            IERR = 1 ; 'QUITTER' BOUCREC ;
  944.                         'FINSI' ;
  945.                      'SINON' ;
  946.                         'QUITTER' BOUCREC ;
  947.                      'FINSI' ;
  948.                   'FIN' BOUCREC ;
  949.                   si (ega iok 1) ;
  950.                      iterer boutron ;
  951.                      mess ' *** Il y a un point selectionne ! ' ;
  952.                   finsi ;
  953. *
  954. *                 Construction de LIGi 
  955. *
  956.                   POIPROJ = MAI2 'PROJ' VP 'PLAN' PP PP2 PP3 ;
  957. *
  958. *                 recherche de WMIN, XWMIN et d'un point oppose
  959. *
  960.                   II1 = 1 ;
  961.                   NBP1 = 'NBNO' POIPROJ ;
  962.                   'REPETER' BOUCP1 NBP1 ;
  963.                      PE1 = POIPROJ 'POIN' II1 ;
  964.                      PEX1 PEY1 PEZ1 = 'COORD' PE1 ;
  965.                      VV1 = PEX1 - PP11 ;
  966.                      VV2 = PEY1 - PP12 ;
  967.                      VV3 = PEZ1 - PP13 ;
  968.                      PEW1 = (VV1 * WN1) + (VV2 * WN2) + (VV3 * WN3) ;
  969.                      PEX1 = (VV1 * XN1) + (VV2 * XN2) + (VV3 * XN3) ;
  970.                      'SI' ( II1 'EGA' 1 ) ;
  971.                         LW = 'PROG' PEW1 ; LX = 'PROG' PEX1 ; 
  972.                         WMIN = PEW1 ; XWMIN = PEX1 ; 
  973.                         IIMIN = 1 ;
  974.                      'SINON' ;
  975.                         LW = LW 'ET' ( 'PROG' PEW1 ) ;
  976.                         LX = LX 'ET' ( 'PROG' PEX1 ) ;
  977.                         'SI' ( PEW1 < WMIN ) ;
  978.                            WMIN = PEW1 ; XWMIN = PEX1 ;
  979.                            IIMIN = II1 ;
  980.                         'FINSI' ;
  981.                      'FINSI' ;
  982.                      II1 = II1 + 1 ;
  983.                   'FIN' BOUCP1 ;                  
  984. *
  985.                   II2 = 1 ; DIAG0 = 0. ;
  986.                   'REPETER' BOUCP2 NBP1 ;
  987.                      LW1 = 'EXTRAIRE' LW II2 ;
  988.                      LX1 = 'EXTRAIRE' LX II2 ;
  989.                      DIAG1 = ( ((LW1 -  WMIN) ** 2) + 
  990.                                ((LX1 - XWMIN) ** 2) ) ** 0.5 ;
  991.                      'SI' ( DIAG1 > DIAG0 ) ;
  992.                         DIAG0 = DIAG1 ;
  993.                         IIMAX = II2 ;
  994.                      'FINSI' ;
  995.                      II2 = II2 + 1 ;
  996.                   'FIN' BOUCP2 ;
  997.                   PC1 = POIPROJ 'POIN' IIMIN ;
  998.                   PCX1 PCY1 PCZ1 = 'COORD' PC1 ;
  999.                   PC2 = POIPROJ 'POIN' IIMAX ;  
  1000.                   PCX2 PCY2 PCZ2 = 'COORD' PC2 ;
  1001. *
  1002. *                 PQ = PC2 - PC1
  1003. *
  1004.                   PQX1 = PCX2 - PCX1; 
  1005.                   PQY1 = PCY2 - PCY1; 
  1006.                   PQZ1 = PCZ2 - PCZ1;
  1007.                   PQ = PQX1 PQY1 PQZ1 ;
  1008. *
  1009. *                 PN = PQ ^ VN  
  1010. *               
  1011.                   PNX1 = (PQY1 * VN3) - (PQZ1 * VN2) ;
  1012.                   PNY1 = (PQZ1 * VN1) - (PQX1 * VN3) ;
  1013.                   PNZ1 = (PQX1 * VN2) - (PQY1 * VN1) ;
  1014.                   PN = PNX1 PNY1 PNZ1 ;
  1015. *
  1016. *                 Recherche des deux autres points -> PC3 et PC4
  1017. *
  1018.                   II3 = 1 ;
  1019.                   PSCAMAX = 0. ; PSCAMIN = 0. ;
  1020.                   'REPETER' BOUCP3 NBP1 ;
  1021.                      PE1 = POIPROJ 'POIN' II3 ;
  1022.                      PEX1 PEY1 PEZ1 = 'COORD' PE1 ;
  1023.                      VV1 = PEX1 - PCX1 ;
  1024.                      VV2 = PEY1 - PCY1 ;
  1025.                      VV3 = PEZ1 - PCZ1 ;
  1026.                      PSC1 = (VV1 * PNX1) + (VV2 * PNY1) + 
  1027.                         (VV3 * PNZ1) ;
  1028.                      'SI' ( PSC1 > PSCAMAX ) ;
  1029.                         PSCAMAX = PSC1 ; IIMAX = II3 ;
  1030.                      'FINSI' ;
  1031.                      'SI' ( PSC1 < PSCAMIN ) ;
  1032.                         PSCAMIN = PSC1 ; IIMIN = II3 ;
  1033.                      'FINSI' ;
  1034.                      II3 = II3 + 1 ;    
  1035.                   'FIN' BOUCP3 ;
  1036.                   PC3 = POIPROJ 'POIN' IIMAX ;
  1037.                   PC4 = POIPROJ 'POIN' IIMIN ;
  1038.                   L1 = 'DROITE' 1 PC1 PC3 ; L2 = 'DROITE' 1 PC3 PC2 ;
  1039.                   L3 = 'DROITE' 1 PC2 PC4 ; L4 = 'DROITE' 1 PC4 PC1 ;
  1040.                   LIG1 = L1 'ET' L2 'ET' L3 'ET' L4 ;
  1041.                   LIG1 = LIG1 'COUL' vert ;
  1042.                   mess ' ***** iinter =' iinter ;
  1043.                   'SI' (IINTER 'EGA' 1) ;
  1044.                        LB = LIG1 ;
  1045.                   'SINON' ;
  1046.                        LB = LB 'ET' LIG1 ;
  1047.                   'FINSI' ;     
  1048.                'SINON' ;
  1049.                   'DETR' MAI1 ; 'DETR' LISPDT ;
  1050.                'FINSI' ;
  1051. *               IMAI = IMAI + 1 ;
  1052.             'FIN' boutron ;
  1053.             'SI' ( IINTEI '>EG' 1 ) ;
  1054.        'MESS' 'Dans le plan' igeo1 ',' iintei 'contours ont ete crees' ;
  1055.              sinon ;
  1056.            mess ' **** il n y a pas d intersection dans le plan' igeo1 ;
  1057.             'FINSI' ; 
  1058.       'FIN' BOUCI ; 
  1059. *
  1060. *     Archivage de l'intersection dans TAB2.LIG.j
  1061. *
  1062.       'SI' (( IINTER '>EG' 1 ) 'OU' ( IRECUP 'EGA' 1 )) ;
  1063.          tabcon.1 = LB ;
  1064.       'FINSI' ;
  1065.        sauter 1 ligne ;
  1066.        mess ' ************ fin du calcul des intersections *******' ;
  1067.    finsi ;
  1068.    sinon ;
  1069.       iterer bogeo1 ;
  1070.    finsi ;
  1071.    si (ega itest.igeo1 -2) ;
  1072.        mess ' **** le plan de calcul choisi n est pas horizontal!!' ;
  1073.    finsi ;
  1074. *-------------------------------------------------------------------------      
  1075. *
  1076. *  construction des contours des autres bobines par rotation autour de Oz       
  1077. *
  1078. *-------------------------------------------------------------------------      
  1079.    si ((itest.igeo1) > -1) ;
  1080.       si (existe tabcon 1) ;
  1081.          si (nbob > 1) ;
  1082.             ibob = 1 ;
  1083.             contot = tabcon.ibob ;
  1084.             repeter bbob2 (nbob-1) ;
  1085.                ibob = ibob + 1 ;
  1086.                angln = (ibob-1)*360./nbob ;
  1087.                tabcon.ibob = tabcon.1 tour angln o1 o2 ;
  1088.                contot = contot et tabcon.ibob ;
  1089.             fin bbob2 ;
  1090.          finsi ;
  1091.       finsi ;
  1092.       (tab2.cont).igeo1 = tabcon ;
  1093.    sinon ;
  1094.       (tab2.cont).igeo1 = 0 ;
  1095.    finsi ;
  1096. fin bogeo1 ;
  1097. finsi ;
  1098. sauter 1 ligne ;
  1099. mess ' *** Fin normale de la procedure @TORO ***' ;
  1100. sauter 1 ligne ;
  1101. finproc tabchb tab2 ;  
  1102.  
  1103.  
  1104.  

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