Télécharger la plaquette Cast3M


fr en

Télécharger @polo.procedur

Retour à la liste

Numérotation des lignes : 

  1. * @POLO     PROCEDUR  CB215821  15/12/02    21:15:02     8719           
  2. *-------------------------------------------------
  3. ******          PROCEDURE @POLO             ******
  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. *
  15. * CALCUL D'UN CHAMP MAGNETIQUE POLOIDAL
  16. *
  17. *--------------------------------------------------------       
  18. 'DEBPROC' @POLO TAGEO1*'TABLE' TABOB1*'TABLE' PL1/'TABLE' ;
  19. ****************************************************************
  20. *                                                              *
  21. *                          @ P O L O                           *
  22. *                          ---------                           *
  23. *                                                              *
  24. * Objet :                                                      *
  25. *                                                              *
  26. * Calcul d'un champ magnetique poloidal genere par un ensemble *
  27. * de bobines.                                                  *
  28. *                                                              *
  29. * Syntaxe :                                                    *
  30. *                                                              *
  31. * TABCHB TAB2 = @POLO TAGEO1 TABOB1 ( PL1 ) ;                  *
  32. *                                                              *
  33. * En entree :                                                  *
  34. *                                                              *
  35. * TAGEO1        table contenant (type TABLE)                   *
  36. *    i          objet geometrique ou l'on veut calculer le     *
  37. *               champ magnetique (type MAILLAGE)               *
  38. *                                                              *
  39. * TABOB1        table a deux indices contenant les donnees     *
  40. *               relatives aux bobines (type TABLE)             *
  41. *               - 1er indice :                                 *
  42. *    i          numero de la bobine (type ENTIER)              *
  43. *               - 2eme indice (pour chaque bobine) :           *
  44. *    COUL       couleur de la bobine (voir palette dans COUL)  *
  45. *    RI         rayon interne (type FLOTTANT)                  *
  46. *    RE         rayon externe (type FLOTTANT)                  *
  47. *    H          hauteur de la section (type FLOTTANT)          *
  48. *    C          centre de la section (type POINT)              *
  49. *    V          vecteur normal a la section (type POINT)       *
  50. *    SOL        solenation : courant global dans la bobine =   *
  51. *               courant * nombre de spires (type FLOTTANT)     *
  52. *               + options facultatives (en 1er indice) :       *
  53. *    TRAC1      si existe : trace du maillage des bobines      *
  54. *    TRAC2      si existe : trace du contour des bobines dans  *
  55. *               les plans de coupe                             *
  56. *                                                              *
  57. * PL1           table a deux indices contenant la definition   *
  58. *               des plans de coupe (facultative / type TABLE)  *
  59. *               - 1er indice :                                 *
  60. *    i          numero du plan (type ENTIER)                   *
  61. *               - 2eme indice (deux possibilites) :            *
  62. *               1/ pour definir chaque plan :                  *
  63. *    PP         point quelconque du plan (type POINT)          *
  64. *    VP         vecteur normal (type POINT)                    *
  65. *               2/ pour reprendre un contour deja calcule :    *
  66. *    MAIL       contour des bobines dans un plan de coupe      *
  67. *               (type MAILLAGE)                                *
  68. *                                                              *
  69. * En sortie :                                                  *
  70. *                                                              *
  71. * TABCHB        table contenant (type TABLE)                   *
  72. *    i          champ de Biot et Savart relatif au i-eme       *
  73. *               maillage GEO1 (type CHPOINT)                   *
  74. *                                                              *
  75. * TAB2          table contenant (type TABLE)                   *
  76. * BOBMAI.i      maillage de chaque bobine i (type MAILLAGE)    *
  77. * LIG.j         ensemble des coupes sur le plan j              *
  78. *               (type MAILLAGE)                                *
  79. * CHBLIG.j      champ magnetique relatif au maillage LIG.j     *
  80. *               (type CHPOINT)                                 *
  81. *                                                              *
  82. * Remarques :                                                  *
  83. *                                                              *
  84. * Les grandeurs suivantes sont "en dur" dans la procedure :    *
  85. *                                                              *
  86. * NELE          nombre d'elements generes lors des rotations   *
  87. *               effectuees pendant la creation du maillage des *
  88. *               bobines                                        *
  89. * COEF1         coefficient etablissant la distance critique   *
  90. *               de selection des points lors de la recherche   *
  91. *               de contour                                     *
  92. *                                                              *
  93. ****************************************************************
  94. *
  95. * Valeurs de quelques constantes
  96. *
  97. MU0   = 4.E-7 * PI ;
  98. EPS   = 1.E-3 ;
  99. IERR  = 0 ;
  100. NELE  = 8 ;
  101. ALPHA = 90. ;
  102. *
  103. IGRAPH1 = FAUX ;
  104. 'SI' ( 'EXISTE' TABOB1 'TRAC1' ) ;
  105.    IGRAPH1 = VRAI ;
  106. 'FINSI' ;
  107. IGRAPH2 = FAUX ;
  108. 'SI' ( 'EXISTE' TABOB1 'TRAC2' ) ;
  109.    IGRAPH2 = VRAI ;
  110. 'FINSI' ;
  111. IDBG2 = FAUX ;
  112. 'SI' ( 'EXISTE' TABOB1 'DEBUG2' ) ;
  113.    IDBG2 = VRAI ;
  114. 'FINSI' ;
  115. IAX = VRAI ;
  116. *
  117. 'SAUTER' 1 'LIGNE' ;
  118. 'MESS' '*** POLO : CALCUL DE CHAMP MAGNETIQUE POLOIDAL ***' ;
  119. 'SAUTER' 1 'LIGNE' ;
  120. 'REPETER' PROC 1 ;
  121. *
  122. * Etape 1 : creation du maillage de chaque bobine
  123. *
  124. 'MESS' 'POLO (etape 1) : creation du maillage de chaque bobine' ;
  125. 'MESS' '------------------------------------------------------' ;
  126. 'SAUTER' 1 'LIGNE' ;
  127. TAB2     = 'TABLE' ;
  128. TABMAI   = 'TABLE' ;
  129. TABTRAV1 = 'TABLE' ; TABTRAV2 = 'TABLE' ; TABTRAV3 = 'TABLE' ;
  130. TABTRAV4 = 'TABLE' ; TABTRAV5 = 'TABLE' ; TABTRAV6 = 'TABLE' ;
  131. TABTRAV7 = 'TABLE' ;
  132. TAB2.BOBMAI = TABMAI ;
  133. REMAX = 0. ;
  134. IBOB = 1 ;
  135. CBB1 = 0. ; CBB2 = 0. ; CBB3 = 0. ;
  136. 'REPETER' BOUCBOB ;
  137.    'SI' ( 'EXISTE' TABOB1 IBOB ) ;
  138. *
  139. *     Infos concernant la bobine IBOB (+ verifications)
  140. *
  141.       'MESS' 'Lecture des infos concernant la bobine ' IBOB ;
  142.       BOB1 = TABOB1.IBOB ;
  143.       'SI' ( 'EXISTE' BOB1 'COUL' ) ;
  144.          BCOU1 = BOB1.'COUL' ;
  145.       'SINON' ;
  146.         'SAUTER' 1 'LIGNE' ;
  147.         'MESS' 'Erreur : il manque COUL pour la bobine ' IBOB ;
  148.         'SAUTER' 1 'LIGNE' ;
  149.         IERR = 1 ; 'QUITTER' PROC ;
  150.       'FINSI' ;
  151.       'SI' ( 'EXISTE' BOB1 'RI' ) ;
  152.          RI*'FLOTTANT' = BOB1.'RI' ;
  153.       'SINON' ;
  154.         'SAUTER' 1 'LIGNE' ;
  155.         'MESS' 'Erreur : il manque RI pour la bobine ' IBOB ;
  156.         'SAUTER' 1 'LIGNE' ;
  157.         IERR = 1 ; 'QUITTER' PROC ;
  158.       'FINSI' ;
  159.       'SI' ( 'EXISTE' BOB1 'RE' ) ;
  160.          RE*'FLOTTANT' = BOB1.'RE' ;
  161.          'SI' ( RE > REMAX ) ;
  162.             REMAX = RE ;
  163.         'FINSI' ;
  164.       'SINON' ;
  165.         'SAUTER' 1 'LIGNE' ;
  166.         'MESS' 'Erreur : il manque RE pour la bobine ' IBOB ;
  167.         'SAUTER' 1 'LIGNE' ;
  168.         IERR = 1 ; 'QUITTER' PROC ;
  169.       'FINSI' ;
  170.       'SI' ( 'EXISTE' BOB1 'H' ) ;
  171.          H*'FLOTTANT' = BOB1.'H' ;
  172.       'SINON' ;
  173.         'SAUTER' 1 'LIGNE' ;
  174.         'MESS' 'Erreur : il manque H pour la bobine ' IBOB ;
  175.         'SAUTER' 1 'LIGNE' ;
  176.         IERR = 1 ; 'QUITTER' PROC ;
  177.       'FINSI' ;
  178.       'SI' ( 'EXISTE' BOB1 'C' ) ;
  179.          C*'POINT' = BOB1.'C' ;
  180.       'SINON' ;
  181.         'SAUTER' 1 'LIGNE' ;
  182.         'MESS' 'Erreur : il manque C pour la bobine ' IBOB ;
  183.         'SAUTER' 1 'LIGNE' ;
  184.         IERR = 1 ; 'QUITTER' PROC ;
  185.       'FINSI' ;
  186.       'SI' ( 'EXISTE' BOB1 'V' ) ;
  187.          V*'POINT' = BOB1.'V' ;
  188.       'SINON' ;
  189.         'SAUTER' 1 'LIGNE' ;
  190.         'MESS' 'Erreur : il manque V pour la bobine ' IBOB ;
  191.         'SAUTER' 1 'LIGNE' ;
  192.         IERR = 1 ; 'QUITTER' PROC ;
  193.       'FINSI' ;
  194.       'SI' ( 'EXISTE' BOB1 'SOL' ) ;
  195.          SOL*'FLOTTANT' = BOB1.'SOL' ;
  196.       'SINON' ;
  197.         'SAUTER' 1 'LIGNE' ;
  198.         'MESS' 'Erreur : il manque SOL pour la bobine ' IBOB ;
  199.         'SAUTER' 1 'LIGNE' ;
  200.         IERR = 1 ; 'QUITTER' PROC ;
  201.       'FINSI' ;
  202.       C1 C2 C3 = 'COORD' C ;
  203.       CBB1 = CBB1 + C1 ; CBB2 = CBB2 + C2 ; CBB3 = CBB3 + C3 ;
  204.       V1 V2 V3 = 'COORD' V ;
  205. *
  206. *     Vecteur WN tq : V1 WN1 + V2 WN2 + V3 WN3 = 0
  207. *
  208.       VN = ( (V1**2) + (V2**2) + (V3**2) ) ** 0.5 ;
  209.       'SI' ( VN 'EGA' 0. ) ;
  210.         'SAUTER' 1 'LIGNE' ;
  211.          'MESS' 'ERREUR : bobine ' IBOB ' le vecteur V est nul' ;
  212.          IERR = 1 ; 'QUITTER' PROC ;
  213.         'SAUTER' 1 'LIGNE' ;
  214.       'FINSI' ;
  215.       VN1 = V1 / VN ; VN2 = V2 / VN ; VN3 = V3 / VN ;
  216.       'SI' ( VN1 'NEG' 0. ) ;
  217.          'SI' ( VN2 'NEG' 0. ) ;
  218.             'SI' ( VN3 'NEG' 0. ) ;
  219.                W2 = VN3 / VN2 ; W3 = -1 ;
  220.                WN = ( (W2**2) + (W3**2) ) ** 0.5 ;
  221.                WN1 = 0. ; WN2 = W2 / WN ; WN3 = W3 / WN ;
  222.             'SINON' ;
  223.                WN1 = 0. ; WN2 = 0. ; WN3 = 1. ;
  224.             'FINSI' ;
  225.          'SINON' ;
  226.             'SI' ( VN3 'NEG' 0. ) ;
  227.                WN1 = 0. ; WN2 = 1. ; WN3 = 0. ;
  228.             'SINON' ;
  229.                WN1 = 0. ; WN2 = 0. ; WN3 = 1. ;
  230.             'FINSI' ;
  231.          'FINSI' ;
  232.       'SINON' ;
  233.          WN1 = 1. ; WN2 = 0. ; WN3 = 0. ;
  234.       'FINSI' ;
  235.       VNOR = VN1 VN2 VN3 ;
  236. *
  237. *     Construction des points P1 P2 P3 et P4
  238. *
  239.       P11 = C1 + (RI * WN1) - ((H / 2.) * VN1) ;
  240.       P12 = C2 + (RI * WN2) - ((H / 2.) * VN2) ;
  241.       P13 = C3 + (RI * WN3) - ((H / 2.) * VN3) ;
  242.       P21 = C1 + (RE * WN1) - ((H / 2.) * VN1) ;
  243.       P22 = C2 + (RE * WN2) - ((H / 2.) * VN2) ;
  244.       P23 = C3 + (RE * WN3) - ((H / 2.) * VN3) ;
  245.       P31 = C1 + (RE * WN1) + ((H / 2.) * VN1) ;
  246.       P32 = C2 + (RE * WN2) + ((H / 2.) * VN2) ;
  247.       P33 = C3 + (RE * WN3) + ((H / 2.) * VN3) ;
  248.       P41 = C1 + (RI * WN1) + ((H / 2.) * VN1) ;
  249.       P42 = C2 + (RI * WN2) + ((H / 2.) * VN2) ;
  250.       P43 = C3 + (RI * WN3) + ((H / 2.) * VN3) ;
  251.       P1 = P11 P12 P13 ; P2 = P21 P22 P23 ;
  252.       P3 = P31 P32 P33 ; P4 = P41 P42 P43 ;
  253.       PP11 = (P11 + P41) / 2. ;
  254.       PP12 = (P12 + P42) / 2. ;
  255.       PP13 = (P13 + P43) / 2. ;
  256.       PP1 = PP11 PP12 PP13 ;
  257.       TABTRAV6.IBOB = PP1 ;
  258. *
  259. *     Les droites D1 D2 D3 et D4 generent des surfaces par
  260. *     rotation autour de l'axe C/VN
  261. *
  262.       CVN = (C1 + VN1) (C2 + VN2) (C3 + VN3) ;
  263.       D1 = 'DROITE' 1 P1 P2 ; D2 = 'DROITE' 1 P2 P3 ;
  264.       D3 = 'DROITE' 1 P3 P4 ; D4 = 'DROITE' 1 P4 P1 ;
  265.       SURF1 = D1 'ROTATION' NELE ALPHA C CVN ;
  266.       SURF2 = D2 'ROTATION' NELE ALPHA C CVN ;
  267.       SURF3 = D3 'ROTATION' NELE ALPHA C CVN ;
  268.       SURF4 = D4 'ROTATION' NELE ALPHA C CVN ;
  269.       DCVN = 'DROITE' 1 C CVN ;
  270.       SURFBO1 = SURF1 'ET' SURF2 'ET' SURF3 'ET' SURF4 ;
  271.       SURFBO2 = SURFBO1 'SYME' 'PLAN' C P1 P2 ;
  272.       XN1 = (VN2 * WN3) - (VN3 * WN2) ;
  273.       XN2 = (VN3 * WN1) - (VN1 * WN3) ;
  274.       XN3 = (VN1 * WN2) - (VN2 * WN1) ;
  275.       P51 = C1 + (RI * XN1) - ((H / 2.) * VN1) ;
  276.       P52 = C2 + (RI * XN2) - ((H / 2.) * VN2) ;
  277.       P53 = C3 + (RI * XN3) - ((H / 2.) * VN3) ;
  278.       P61 = C1 + (RE * XN1) + ((H / 2.) * VN1) ;
  279.       P62 = C2 + (RE * XN2) + ((H / 2.) * VN2) ;
  280.       P63 = C3 + (RE * XN3) + ((H / 2.) * VN3) ;
  281.       P5 = P51 P52 P53 ; P6 = P61 P62 P63 ;
  282.       PP21 = (P51 + P61) / 2. ;
  283.       PP22 = (P52 + P62) / 2. ;
  284.       PP23 = (P53 + P63) / 2. ;
  285.       PP2 = PP21 PP22 PP23 ;
  286.       TABTRAV7.IBOB = PP2 ;
  287.       SURFBO3 = SURFBO1 'SYME' 'PLAN' C P5 P6 ;
  288.       SURFBO4 = SURFBO2 'SYME' 'PLAN' C P5 P6 ;
  289.       SURFBOB = SURFBO1 'ET' SURFBO2 'ET' SURFBO3 'ET' SURFBO4 ;
  290.       'ELIM' EPS SURFBOB ;
  291.       'SI' ( IBOB 'EGA' 1 ) ;
  292.          BO1 = SURFBOB 'COUL' BCOU1 ;
  293.         GEO1 = BO1 ;
  294.       'FINSI' ;
  295.       'SI' ( IBOB 'EGA' 2 ) ;
  296.          BO2 = SURFBOB 'COUL' BCOU1 ;
  297.          GEO1 = BO1 'ET' BO2 ;
  298.       'FINSI' ;
  299.       'SI' ( IBOB 'EGA' 3 ) ;
  300.          BO3 = SURFBOB 'COUL' BCOU1 ;
  301.          GEO1 = GEO1 'ET' BO3 ;
  302.       'FINSI' ;
  303.       'SI' ( IBOB 'EGA' 4 ) ;
  304.          BO4 = SURFBOB 'COUL' BCOU1 ;
  305.          GEO1 = GEO1 'ET' BO4 ;
  306.       'FINSI' ;
  307.       'SI' ( IBOB 'EGA' 5 ) ;
  308.          BO5 = SURFBOB 'COUL' BCOU1 ;
  309.          GEO1 = GEO1 'ET' BO5 ;
  310.       'FINSI' ;
  311.       'SI' ( IBOB 'EGA' 6 ) ;
  312.          BO6 = SURFBOB 'COUL' BCOU1 ;
  313.          GEO1 = GEO1 'ET' BO6 ;
  314.       'FINSI' ;
  315.       'SI' ( IBOB 'EGA' 7 ) ;
  316.          BO7 = SURFBOB 'COUL' BCOU1 ;
  317.          GEO1 = GEO1 'ET' BO7 ;
  318.       'FINSI' ;
  319.       'SI' ( IBOB 'EGA' 8 ) ;
  320.          BO8 = SURFBOB 'COUL' BCOU1 ;
  321.          GEO1 = GEO1 'ET' BO8 ;
  322.       'FINSI' ;
  323.       'SI' ( IBOB 'EGA' 9 ) ;
  324.          BO9 = SURFBOB 'COUL' BCOU1 ;
  325.          GEO1 = GEO1 'ET' BO9 ;
  326.       'FINSI' ;
  327.       'SI' ( IBOB '>EG' 10 ) ;
  328.          BO10 = SURFBOB 'COUL' BCOU1 ;
  329.          GEO1 = GEO1 'ET' BO10 ;
  330.       'FINSI' ;
  331.       'MESS' 'Maillage bobine ' IBOB ' genere pour controle' ;
  332.       TABMAI.IBOB = GEO1 ;
  333. * tables de travail contenant des infos sur la bobine IBOB
  334.       TABTRAV1.IBOB = SURFBO1 ;
  335.       TABTRAV2.IBOB = SURFBO2 ;
  336.       TABTRAV3.IBOB = SURFBO3 ;
  337.       TABTRAV4.IBOB = SURFBO4 ;
  338.       TABTRAV5.IBOB = VNOR ;
  339.    'SINON' ;
  340.       'QUITTER' BOUCBOB ;
  341.    'FINSI' ;
  342.    IBOB = IBOB + 1 ;
  343. 'FIN' BOUCBOB ;
  344. IBOB = IBOB - 1 ;
  345. *
  346. 'OUBLIER' P1 ; 'OUBLIER' P2 ; 'OUBLIER' SURFBO1 ;
  347. 'OUBLIER' P3 ; 'OUBLIER' P4 ; 'OUBLIER' SURFBO2 ;
  348. 'OUBLIER' D1 ; 'OUBLIER' D2 ; 'OUBLIER' SURFBO3 ;
  349. 'OUBLIER' D3 ; 'OUBLIER' D4 ; 'OUBLIER' SURFBO4 ;
  350. 'OUBLIER' SURF1 ;'OUBLIER' SURF2 ;'OUBLIER' SURF3 ;
  351. 'OUBLIER' SURF4 ;'OUBLIER' SURFBOB ;
  352. *
  353. 'SI' ( IBOB '>EG' 1 ) ;
  354.    CBB1 = CBB1 / IBOB ;CBB2 = CBB2 / IBOB ;CBB3 = CBB3 / IBOB ;
  355.    CBB = CBB1 CBB2 CBB3 ;
  356.    CBX2 = (CBB1 + (2. * REMAX)) CBB2 CBB3 ;
  357.    CBY2 = CBB1 (CBB2 + (2. * REMAX)) CBB3 ;
  358.    CBZ2 = CBB1 CBB2 (CBB3 + (2. * REMAX)) ;
  359.    AXEX = ( 'DROI' 1 CBB CBX2 ) 'COUL' 'ROUGE' ;
  360.    AXEY = ( 'DROI' 1 CBB CBY2 ) 'COUL' 'ROUGE' ;
  361.    AXEZ = ( 'DROI' 1 CBB CBZ2 ) 'COUL' 'ROUGE' ;
  362.    'OUBLIER' CBB ; 'OUBLIER' CBX2 ; 'OUBLIER' CBY2 ;
  363.    'OUBLIER' CBZ2 ;
  364.    GEO1 = GEO1 'ET' AXEX 'ET' AXEY 'ET' AXEZ ;
  365. 'FINSI' ;
  366. 'SI' ( IGRAPH1 ) ;
  367.    'REPETER' BOUGRAF1 ;
  368.       'MESS' 'Entrez un oeil (OEILX puis OEILY puis OEILZ) : ';
  369.       'OBTENIR' OEILX*'FLOTTANT' ;
  370.       'OBTENIR' OEILY*'FLOTTANT' ;
  371.       'OBTENIR' OEILZ*'FLOTTANT' ;
  372.       OEIL = OEILX OEILY OEILZ ;
  373.       'TITRE' 'POLO : maillages des bobines' ;
  374.       'TRAC' 'CACH' GEO1 OEIL 'QUAL' ;
  375.       'MESS' 'Autre visualisation (Oui : 1 /Non : 0) ?' ;
  376.       'OBTENIR' REP1*'ENTIER' ;
  377.       'SI' ( REP1 'EGA' 0 ) ;
  378.          'QUITTER' BOUGRAF1 ;
  379.       'FINSI' ;
  380.    'FIN' BOUGRAF1 ;
  381. 'FINSI' ;
  382. *
  383. * Etape 2 : contour des bobines dans les plans de coupe
  384. *
  385. 'SI' ( 'EXISTE' PL1 ) ;
  386. 'SAUTER' 1 'LIGNE' ;
  387. 'MESS' 'POLO (etape 2) : contour des bobines dans les plans de coupe' ;
  388. 'MESS' '------------------------------------------------------------' ;
  389. 'SAUTER' 1 'LIGNE' ;
  390. TABLIG   = TABLE ;
  391. TAB2.LIG = TABLIG ;
  392. ICOUP = 1 ;
  393. 'REPETER' BOUCOUP ;
  394.    'SI' ( 'EXISTE' PL1 ICOUP ) ;
  395. *
  396. *     Infos concernant le plan de coupe ICOUP
  397. *
  398.       'MESS' 'Lecture infos plan de coupe ' ICOUP ;
  399.       COUP1 = PL1.ICOUP ;
  400.       IRECUP = 0 ;
  401.       'SI' ( 'EXISTE' COUP1 'MAIL' ) ;
  402.          'SAUTER' 1 'LIGNE' ;
  403.         'MESS' 'Contour des bobines dans le plan de coupe deja connu' ;
  404.         LB*'MAILLAGE' = COUP1.'MAIL' ;
  405.         IRECUP = 1 ; IINTER = 0 ;
  406.       'SINON' ;
  407.       'SI' ( 'EXISTE' COUP1 'PP' ) ;
  408.          PP*'POINT' = COUP1.'PP' ;
  409.       'SINON' ;
  410.         'SAUTER' 1 'LIGNE' ;
  411.         'MESS' 'Erreur : il manque PP pour le plan ' ICOUP ;
  412.         'SAUTER' 1 'LIGNE' ;
  413.         IERR = 1 ; 'QUITTER' PROC ;
  414.       'FINSI' ;
  415.       'SI' ( 'EXISTE' COUP1 'VP' ) ;
  416.          VP*'POINT' = COUP1.'VP' ;
  417.       'SINON' ;
  418.         'SAUTER' 1 'LIGNE' ;
  419.         'MESS' 'Erreur : il manque VP pour le plan ' ICOUP ;
  420.         'SAUTER' 1 'LIGNE' ;
  421.         IERR = 1 ; 'QUITTER' PROC ;
  422.       'FINSI' ;
  423. *
  424. *     Trois points vont definir ce plan : PP PP2 et PP3
  425. *
  426.       PP11 PP12 PP13 = COORD PP ;
  427.       VP1 VP2 VP3 = COORD VP ;
  428. *
  429. *     Vecteur WN tq : VP1 WN1 + VP2 WN2 + VP3 WN3 = 0
  430. *
  431.       VPN1 = ( (VP1**2) + (VP2**2) + (VP3**2) ) ** 0.5 ;
  432.       'SI' ( VPN1 'EGA' 0. ) ;
  433.         'SAUTER' 1 'LIGNE' ;
  434.          'MESS' 'ERREUR : plan ' ICOUP ' le vecteur VP est nul' ;
  435.         'SAUTER' 1 'LIGNE' ;
  436.          IERR = 1 ; 'QUITTER' PROC ;
  437.       'FINSI' ;
  438.       VN1 = VP1 / VPN1 ; VN2 = VP2 / VPN1 ; VN3 = VP3 / VPN1 ;
  439.       VPN = VN1 VN2 VN3 ;
  440.       'SI' ( VN1 'NEG' 0. ) ;
  441.          'SI' ( VN2 'NEG' 0. ) ;
  442.             'SI' ( VN3 'NEG' 0. ) ;
  443.                W2 = VN3 / VN2 ; W3 = -1 ;
  444.                WN = ( (W2**2) + (W3**2) ) ** 0.5 ;
  445.                WN1 = 0. ; WN2 = W2 / WN ; WN3 = W3 / WN ;
  446.             'SINON' ;
  447.                WN1 = 0. ; WN2 = 0. ; WN3 = 1. ;
  448.             'FINSI' ;
  449.          'SINON' ;
  450.             'SI' ( VN3 'NEG' 0. ) ;
  451.                WN1 = 0. ; WN2 = 1. ; WN3 = 0. ;
  452.             'SINON' ;
  453.                WN1 = 0. ; WN2 = 0. ; WN3 = 1. ;
  454.             'FINSI' ;
  455.          'FINSI' ;
  456.       'SINON' ;
  457.          WN1 = 1. ; WN2 = 0. ; WN3 = 0. ;
  458.       'FINSI' ;
  459. *
  460.       XN1 = (VN2 * WN3) - (VN3 * WN2) ;
  461.       XN2 = (VN3 * WN1) - (VN1 * WN3) ;
  462.       XN3 = (VN1 * WN2) - (VN2 * WN1) ;
  463. *
  464. *     WN et XN forment une base du plan de coupe
  465. *
  466.       PP21 = PP11 + WN1 ; PP22 = PP12 + WN2 ;
  467.       PP23 = PP13 + WN3 ; PP31 = PP11 + XN1 ;
  468.       PP32 = PP12 + XN2 ; PP33 = PP13 + XN3 ;
  469.       PP2 = PP21 PP22 PP23 ; PP3 = PP31 PP32 PP33 ;
  470. *
  471. *     Intersection de ce plan avec bobine IBO
  472. *
  473.       IBO = 1 ; IINTER = 0 ;
  474.       'REPETER' BOUCI ;
  475.          'SI' ( 'EXISTE' TABMAI IBO ) ;
  476.             'MESS' 'Recherche intersection plan : ' ICOUP
  477.             ' bobine : ' IBO ;
  478.             IMAI = 1 ;
  479.            BOB1 = TABOB1.IBO ;
  480.            CBOB1 = BOB1.'C' ; HBOB1 = BOB1.'H' ;
  481.            BCOU1 = BOB1.'COUL' ;
  482.            VNOR1 = TABTRAV5.IBO ;
  483. *
  484. *           On traite separement chaque quart de bobine
  485. *
  486.            IINTEI = 0 ;
  487.             'REPETER' QUARBOB 4 ;
  488.                'SI' ( IMAI 'EGA' 1 ) ;
  489.                   MAI0 = TABTRAV1.IBO ;
  490.                'FINSI' ;
  491.                     'SI' ( IMAI 'EGA' 2 ) ;
  492.                   MAI0 = TABTRAV2.IBO ;
  493.                'FINSI' ;
  494.                    'SI' ( IMAI 'EGA' 3 ) ;
  495.                   MAI0 = TABTRAV3.IBO ;
  496.                'FINSI' ;
  497.                    'SI' ( IMAI 'EGA' 4 ) ;
  498.                   MAI0 = TABTRAV4.IBO ;
  499.                'FINSI' ;
  500.                MAI1 = 'CHANGER' 'POI1' MAI0 ;
  501.                NBP1 = 'NBNO' MAI1 ;
  502.                'SI' (IDBG2) ;
  503.                 'MESS' '---> Quart de bobine : ' IMAI ;
  504.                 'MESS' '---> Nbre de pts     : ' NBP1 ;
  505.               'FINSI' ;
  506.                IP1 = 1 ;
  507.                IDESSOUS = 0 ; IDESSUS = 0 ; IDEDANS = 0 ;
  508.               DMOY = 0. ;
  509.                'REPETER' BOUCPOI1 NBP1 ;
  510.                   PO1 = MAI1 'POIN' IP1 ;
  511.                   POX1 POY1 POZ1 = 'COORD' PO1 ;
  512.                   MX1 = POX1 - PP11 ; MY1 = POY1 - PP12 ;
  513.                   MZ1 = POZ1 - PP13 ;  M1 = MX1 MY1 MZ1 ;
  514.                   PDT1 = M1 'PSCAL' VPN ;
  515.                 DMOY = DMOY + ('ABS' (PDT1)) ;
  516.                   'SI' ( ( 'ABS' PDT1 ) < 0.001 ) ;
  517.                      IDEDANS = IDEDANS + 1 ;
  518.                   'FINSI' ;
  519.                   'SI' ( PDT1 '&lt;EG' -0.001 ) ;
  520.                      IDESSOUS = IDESSOUS + 1 ;
  521.                   'FINSI' ;
  522.                   'SI' ( PDT1 '>EG' 0.001 ) ;
  523.                      IDESSUS = IDESSUS + 1 ;
  524.                   'FINSI' ;
  525.                   'SI' ( IP1 'EGA' 1 ) ;
  526.                      LISPDT = 'PROG' PDT1 ;
  527.                   'SINON' ;
  528.                      LISPDT = LISPDT 'ET' ( 'PROG' PDT1 ) ;
  529.                   'FINSI' ;
  530.                   IP1 = IP1 + 1 ;
  531.                'FIN' BOUCPOI1 ;
  532. *+*
  533. *+*            Distance de selection des points a projeter
  534. *+*              on divise DMOY par 2 si NELE = 4
  535. *+*                                3           8
  536.                COEF1 = 3. ;
  537.                DMOY = DMOY / NBP1 ;
  538.               DCRIT = DMOY / COEF1 ;
  539. *
  540. *              tests sur la repartition des points / plan de coupe
  541. *
  542.               'SI' ( IDEDANS '>EG' 4 ) ;
  543.                 ICAS = 1 ;
  544.               'SINON' ;
  545.                        'SI' ( IDESSUS > IDESSOUS ) ;
  546.                      ICAS = 2 ;
  547.                 'SINON' ;
  548.                    ICAS = 3 ;
  549.                 'FINSI' ;
  550.               'FINSI' ;
  551. *
  552.                'SI' ((( IDESSOUS '>EG' 1 ) 'ET' ( IDESSUS '>EG' 1 ))
  553.                    'OU' ( IDEDANS '>EG' 1 )) ;
  554.                 IINTER = IINTER + 1 ;
  555.                 IINTEI = IINTEI + 1 ;
  556.                 'SI' ( IINTEI 'EGA' 1 ) ;
  557.                    'MESS' 'Il y a une intersection ...' ;
  558.                 'FINSI' ;
  559. *
  560. *                 On ne retient que les points les plus proches du
  561. *                 plan de coupe Pc
  562. *+*
  563.                   IREC = 0 ;
  564.                 'REPETER' BOUCREC 7 ;
  565.                    IREC = IREC + 1 ;
  566.                      IP2 = 1 ; IOK = 0 ;
  567.                      'REPETER' BOUCTRI NBP1 ;
  568.                      VAL1 = 'EXTRAIRE' LISPDT IP2 ;
  569.                    'SI' ( ICAS 'EGA' 1 ) ;
  570.                         'SI' (('ABS' VAL1 ) '&lt;EG' 0.001 ) ;
  571.                            IOK = IOK + 1 ;
  572.                            'SI' ( IOK 'EGA' 1 ) ;
  573.                               MAI2 = MAI1 'POIN' IP2 ;
  574.                            'SINON' ;
  575.                               MAI2 = MAI2 'ET' ( MAI1 'POIN' IP2 ) ;
  576.                            'FINSI' ;
  577.                         'FINSI' ;
  578.                    'FINSI ' ;
  579.                     'SI' ( ICAS 'EGA' 2 ) ;
  580.                      'SI' ((('ABS' VAL1 ) '&lt;EG' DCRIT ) 'ET'
  581.                            ( VAL1 '>EG' 0.001 )) ;
  582.                            IOK = IOK + 1 ;
  583.                            'SI' ( IOK 'EGA' 1 ) ;
  584.                               MAI2 = MAI1 'POIN' IP2 ;
  585.                            'SINON' ;
  586.                               MAI2 = MAI2 'ET' ( MAI1 'POIN' IP2 ) ;
  587.                            'FINSI' ;
  588.                         'FINSI' ;
  589.                      'FINSI' ;
  590.                     'SI' ( ICAS 'EGA' 3 ) ;
  591.                      'SI' ((('ABS' VAL1 ) '&lt;EG' DCRIT ) 'ET'
  592.                            ( VAL1 < -0.001))  ;
  593.                            IOK = IOK + 1 ;
  594.                            'SI' ( IOK 'EGA' 1 ) ;
  595.                               MAI2 = MAI1 'POIN' IP2 ;
  596.                            'SINON' ;
  597.                               MAI2 = MAI2 'ET' ( MAI1 'POIN' IP2 ) ;
  598.                            'FINSI' ;
  599.                         'FINSI' ;
  600.                      'FINSI' ;
  601.                         IP2 = IP2 + 1 ;
  602.                      'FIN' BOUCTRI ;
  603.                      NBP2 = 'NBNO' MAI2 ;
  604.                    'SI' (IDBG2) ;
  605.                    'MESS' '---> Distance critique      : ' DCRIT ;
  606.                      'MESS' '---> Nbre de points retenus : ' NBP2 ;
  607.                    'FINSI' ;
  608.                    'SI' ( NBP2 < 4 ) ;
  609.                       'SI' ( IREC '&lt;EG' 6 ) ;
  610.                           'MESS' 'Pas assez de points selectionnes' ;
  611.                         'MESS' 'essai nouvelle distance critique' ;
  612.                            DCRIT = DCRIT * 1.25 ;
  613.                         'SINON' ;
  614.                          'MESS' 'Mauvaise selection des points : ' ;
  615.                          'MESS' 'contour introuvable !' ;
  616.                          IERR = 1 ; 'QUITTER' PROC ;
  617.                       'FINSI' ;
  618.                    'SINON' ;
  619.                       'QUITTER' BOUCREC ;
  620.                    'FINSI' ;
  621.                 'FIN' BOUCREC ;
  622. *
  623. *                 Construction de LIGi
  624. *
  625.                   POIPROJ = MAI2 'PROJ' VP 'PLAN' PP PP2 PP3 ;
  626. *
  627. *                recherche de WMIN, XWMIN et d'un point oppose
  628. *
  629.                 II1 = 1 ;
  630.                 NBP1 = 'NBNO' POIPROJ ;
  631.                 'REPETER' BOUCP1 NBP1 ;
  632.                    PE1 = POIPROJ 'POIN' II1 ;
  633.                    PEX1 PEY1 PEZ1 = 'COORD' PE1 ;
  634.                    VV1 = PEX1 - PP11 ;
  635.                    VV2 = PEY1 - PP12 ;
  636.                    VV3 = PEZ1 - PP13 ;
  637.                    PEW1 = (VV1 * WN1) + (VV2 * WN2) + (VV3 * WN3) ;
  638.                     PEX1 = (VV1 * XN1) + (VV2 * XN2) + (VV3 * XN3) ;
  639.                    'SI' ( II1 'EGA' 1 ) ;
  640.                      LW = 'PROG' PEW1 ; LX = 'PROG' PEX1 ;
  641.                      WMIN = PEW1 ; XWMIN = PEX1 ;
  642.                      IIMIN = 1 ;
  643.                    'SINON' ;
  644.                      LW = LW 'ET' ( 'PROG' PEW1 ) ;
  645.                      LX = LX 'ET' ( 'PROG' PEX1 ) ;
  646.                      'SI' ( PEW1 < WMIN ) ;
  647.                         WMIN = PEW1 ; XWMIN = PEX1 ;
  648.                         IIMIN = II1 ;
  649.                      'FINSI' ;
  650.                    'FINSI' ;
  651.                    II1 = II1 + 1 ;
  652.                 'FIN' BOUCP1 ;
  653. *
  654.                 II2 = 1 ; DIAG0 = 0. ;
  655.                  'REPETER' BOUCP2 NBP1 ;
  656.                    LW1 = 'EXTRAIRE' LW II2 ;
  657.                      LX1 = 'EXTRAIRE' LX II2 ;
  658.                      DIAG1 = ( ((LW1 -  WMIN) ** 2) +
  659.                                ((LX1 - XWMIN) ** 2) ) ** 0.5 ;
  660.                    'SI' ( DIAG1 > DIAG0 ) ;
  661.                       DIAG0 = DIAG1 ;
  662.                      IIMAX = II2 ;
  663.                    'FINSI' ;
  664.                    II2 = II2 + 1 ;
  665.                 'FIN' BOUCP2 ;
  666.                 PC1 = POIPROJ 'POIN' IIMIN ;
  667.                 PCX1 PCY1 PCZ1 = 'COORD' PC1 ;
  668.                 PC2 = POIPROJ 'POIN' IIMAX ;
  669.                 PCX2 PCY2 PCZ2 = 'COORD' PC2 ;
  670. *
  671. *                PQ = PC2 - PC1
  672. *
  673.                 PQX1 = PCX2 - PCX1;
  674.                 PQY1 = PCY2 - PCY1;
  675.                 PQZ1 = PCZ2 - PCZ1;
  676.                 PQ = PQX1 PQY1 PQZ1 ;
  677. *
  678. *                PN = PQ ^ VN
  679. *
  680.                  PNX1 = (PQY1 * VN3) - (PQZ1 * VN2) ;
  681.                 PNY1 = (PQZ1 * VN1) - (PQX1 * VN3) ;
  682.                 PNZ1 = (PQX1 * VN2) - (PQY1 * VN1) ;
  683.                 PN = PNX1 PNY1 PNZ1 ;
  684. *
  685. *                Recherche des deux autres points -> PC3 et PC4
  686. *
  687.                 II3 = 1 ;
  688.                 PSCAMAX = 0. ; PSCAMIN = 0. ;
  689.                 'REPETER' BOUCP3 NBP1 ;
  690.                      PE1 = POIPROJ 'POIN' II3 ;
  691.                    PEX1 PEY1 PEZ1 = 'COORD' PE1 ;
  692.                    VV1 = PEX1 - PCX1 ;
  693.                    VV2 = PEY1 - PCY1 ;
  694.                    VV3 = PEZ1 - PCZ1 ;
  695.                    PSC1 = (VV1 * PNX1) + (VV2 * PNY1) +
  696.                      (VV3 * PNZ1) ;
  697.                    'SI' ( PSC1 > PSCAMAX ) ;
  698.                      PSCAMAX = PSC1 ; IIMAX = II3 ;
  699.                    'FINSI' ;
  700.                    'SI' ( PSC1 < PSCAMIN ) ;
  701.                      PSCAMIN = PSC1 ; IIMIN = II3 ;
  702.                    'FINSI' ;
  703.                    II3 = II3 + 1 ;
  704.                 'FIN' BOUCP3 ;
  705.                 PC3 = POIPROJ 'POIN' IIMAX ;
  706.                 PC4 = POIPROJ 'POIN' IIMIN ;
  707.                 L1 = 'DROITE' 1 PC1 PC3 ; L2 = 'DROITE' 1 PC3 PC2 ;
  708.                 L3 = 'DROITE' 1 PC2 PC4 ; L4 = 'DROITE' 1 PC4 PC1 ;
  709.                 LIG1 = L1 'ET' L2 'ET' L3 'ET' L4 ;
  710.                        'SI' ( IBO 'EGA' 1 ) ;
  711.                    BO1 = LIG1 'COUL' BCOU1 ;
  712.                    'SI' ( IINTER 'EGA' 1 ) ;
  713.                      LB = BO1 ;
  714.                    'SINON' ;
  715.                       LB = LB 'ET' BO1 ;
  716.                    'FINSI' ;
  717.                 'FINSI' ;
  718.                        'SI' ( IBO 'EGA' 2 ) ;
  719.                    BO2 = LIG1 'COUL' BCOU1 ;
  720.                    'SI' ( IINTER 'EGA' 1 ) ;
  721.                      LB = BO2 ;
  722.                    'SINON' ;
  723.                      LB = LB 'ET' BO2 ;
  724.                    'FINSI' ;
  725.                 'FINSI' ;
  726.                       'SI' ( IBO 'EGA' 3 ) ;
  727.                    BO3 = LIG1 'COUL' BCOU1 ;
  728.                    'SI' ( IINTER 'EGA' 1 ) ;
  729.                      LB = BO3 ;
  730.                    'SINON' ;
  731.                      LB = LB 'ET' BO3 ;
  732.                    'FINSI' ;
  733.                 'FINSI' ;
  734.                       'SI' ( IBO 'EGA' 4 ) ;
  735.                    BO4 = LIG1 'COUL' BCOU1 ;
  736.                    'SI' ( IINTER 'EGA' 1 ) ;
  737.                      LB = BO4 ;
  738.                    'SINON' ;
  739.                      LB = LB 'ET' BO4 ;
  740.                    'FINSI' ;
  741.                 'FINSI' ;
  742.                       'SI' ( IBO 'EGA' 5 ) ;
  743.                    BO5 = LIG1 'COUL' BCOU1 ;
  744.                    'SI' ( IINTER 'EGA' 1 ) ;
  745.                      LB = BO5 ;
  746.                    'SINON' ;
  747.                      LB = LB 'ET' BO5 ;
  748.                    'FINSI' ;
  749.                 'FINSI' ;
  750.                       'SI' ( IBO 'EGA' 6 ) ;
  751.                    BO6 = LIG1 'COUL' BCOU1 ;
  752.                    'SI' ( IINTER 'EGA' 1 ) ;
  753.                      LB = BO6 ;
  754.                    'SINON' ;
  755.                      LB = LB 'ET' BO6 ;
  756.                    'FINSI' ;
  757.                 'FINSI' ;
  758.                       'SI' ( IBO 'EGA' 7 ) ;
  759.                    BO7 = LIG1 'COUL' BCOU1 ;
  760.                    'SI' ( IINTER 'EGA' 1 ) ;
  761.                      LB = BO7 ;
  762.                    'SINON' ;
  763.                      LB = LB 'ET' BO7 ;
  764.                    'FINSI' ;
  765.                 'FINSI' ;
  766.                       'SI' ( IBO 'EGA' 8 ) ;
  767.                    BO8 = LIG1 'COUL' BCOU1 ;
  768.                    'SI' ( IINTER 'EGA' 1 ) ;
  769.                      LB = BO8 ;
  770.                    'SINON' ;
  771.                      LB = LB 'ET' BO8 ;
  772.                    'FINSI' ;
  773.                 'FINSI' ;
  774.                       'SI' ( IBO 'EGA' 9 ) ;
  775.                    BO9 = LIG1 'COUL' BCOU1 ;
  776.                    'SI' ( IINTER 'EGA' 1 ) ;
  777.                      LB = BO9 ;
  778.                    'SINON' ;
  779.                      LB = LB 'ET' BO9 ;
  780.                    'FINSI' ;
  781.                 'FINSI' ;
  782.                       'SI' ( IBO '>EG' 10 ) ;
  783.                    BO10 = LIG1 'COUL' BCOU1 ;
  784.                    'SI' ( IINTER 'EGA' 1 ) ;
  785.                      LB = BO10 ;
  786.                    'SINON' ;
  787.                      LB = LB 'ET' BO10 ;
  788.                    'FINSI' ;
  789.                 'FINSI' ;
  790.                'SINON' ;
  791.                   'DETR' MAI1 ; 'DETR' LISPDT ;
  792.                'FINSI' ;
  793.                IMAI = IMAI + 1 ;
  794.             'FIN' QUARBOB ;
  795.            'SI' ( IINTEI '>EG' 1 ) ;
  796.               'MESS' 'Contour bobine' IBO '/ plan' ICOUP 'cree' ;
  797. *
  798. *              Axe de la bobine IBO (s'il y a un contour)
  799. *
  800.               CBOBX1 CBOBY1 CBOBZ1 = 'COORD' CBOB1 ;
  801.               A1 = CBOBX1 - PP11 ; A2 = CBOBY1 - PP12 ;
  802.               A3 = CBOBZ1 - PP13 ;
  803.                PSC1 = (A1 * VN1) + (A2 * VN2) + (A3 * VN3) ;
  804.               CB1 = CBOBX1 - (PSC1 * VN1) ;
  805.               CB2 = CBOBY1 - (PSC1 * VN2) ;
  806.               CB3 = CBOBZ1 - (PSC1 * VN3) ;
  807.               CBB1 = CBB1 + CB1 ; CBB2 = CBB2 + CB2 ;
  808.               CBB3 = CBB3 + CB3 ;
  809.               VNORX1 VNORY1 VNORZ1 = 'COORD' VNOR1 ;
  810.               PAX1 = CB1 + (HBOB1 * VNORX1) ;
  811.               PAY1 = CB2 + (HBOB1 * VNORY1) ;
  812.               PAZ1 = CB3 + (HBOB1 * VNORZ1) ;
  813.               PAX2 = CB1 - (HBOB1 * VNORX1) ;
  814.               PAY2 = CB2 - (HBOB1 * VNORY1) ;
  815.               PAZ2 = CB3 - (HBOB1 * VNORZ1) ;
  816.               PA1 = PAX1 PAY1 PAZ1 ;
  817.               PA2 = PAX2 PAY2 PAZ2 ;
  818.               DAXE1 = 'DROITE' 1 PA1 PA2 ;
  819.               LB = LB 'ET' DAXE1 ;
  820.            'FINSI' ;
  821.          'SINON' ;
  822.             'QUITTER' BOUCI ;
  823.          'FINSI' ;
  824.          IBO = IBO + 1 ;
  825.       'FIN' BOUCI ;
  826.       'FINSI' ;
  827. *
  828. 'SI' ( IINTER '>EG' 1 ) ;
  829.    'OUBLIER' PC1 ;'OUBLIER' PC2 ;'OUBLIER' PC3 ;'OUBLIER' PC4 ;
  830.    'OUBLIER' L1 ;'OUBLIER' L2 ;'OUBLIER' L3 ;'OUBLIER' L4 ;
  831.    'OUBLIER' LIG1 ; 'OUBLIER' POIPROJ ; 'OUBLIER' DAXE1 ;
  832.    'OUBLIER' PA1 ; 'OUBLIER' PA2 ; 'OUBLIER' PE1 ;
  833.    'OUBLIER' SYME1 ;
  834. 'FINSI' ;
  835. *
  836. *     Trace intersection des bobines / plan ICOUP
  837. *
  838.       'SI' (( IGRAPH2 ) 'ET' (( IINTER '>EG' 1 )
  839.                       'OU' ( IRECUP 'EGA' 1 )));
  840.          'REPETER' BOUGRAF2 ;
  841.             'MESS' 'Entrez un oeil (OEILX puis OEILY puis OEILZ) : ';
  842.             'OBTENIR' OEILX*'FLOTTANT' ;
  843.             'OBTENIR' OEILY*'FLOTTANT' ;
  844.             'OBTENIR' OEILZ*'FLOTTANT' ;
  845.             OEIL = OEILX OEILY OEILZ ;
  846.             'TITRE' 'Contour des bobines / plan ' ICOUP ;
  847.             'TRAC' LB OEIL 'QUAL' ;
  848.             'MESS' 'Autre visualisation (Oui : 1/Non : 0) ?' ;
  849.             'OBTENIR' REP2*'ENTIER' ;
  850.             'SI' ( REP2 'EGA' 0 ) ;
  851.                'QUITTER' BOUGRAF2 ;
  852.             'FINSI' ;
  853.          'FIN' BOUGRAF2 ;
  854.       'FINSI' ;
  855. *
  856. *     Archivage de l'intersection dans TAB2.LIG.j
  857. *
  858.       'SI' (( IINTER '>EG' 1 ) 'OU' ( IRECUP 'EGA' 1 )) ;
  859.         TABLIG.ICOUP = LB ;
  860.       'FINSI' ;
  861.    'SINON' ;
  862.       'QUITTER' BOUCOUP ;
  863.    'FINSI' ;
  864.    ICOUP = ICOUP + 1 ;
  865. 'FIN' BOUCOUP ;
  866. 'FINSI' ;
  867. *
  868. * Etape 3 : pour chaque bobine, calcul du champ de Biot et Savart
  869. * dans GEO1 et dans les maillages LIGi
  870. *
  871. 'SAUTER' 1 'LIGNE' ;
  872. 'MESS' 'POLO (etape 3) : calcul des champs de Biot et Savart' ;
  873. 'MESS' '----------------------------------------------------' ;
  874. 'SAUTER' 1 'LIGNE' ;
  875. *
  876. * Calcul du champ dans les maillages GEO1 :
  877. * contribution de chaque bobine
  878. *
  879. TABCHB = 'TABLE' ;
  880. IGEO1 = 1 ;
  881. 'REPETER' BOGEO1 ;
  882. 'SI' ( 'EXISTE' TAGEO1 IGEO1 ) ;
  883. 'SI' ( IGEO1 'EGA' 1 ) ;
  884.    'MESS' 'Calcul du champ dans le ' IGEO1 '-er maillage GEO1' ;
  885. 'SINON' ;
  886.    'MESS' 'Calcul du champ dans le ' IGEO1 '-eme maillage GEO1' ;
  887. 'FINSI' ;
  888. 'SAUTER' 1 'LIGNE' ;
  889. GEO1 = TAGEO1.IGEO1 ;
  890. IBOB = 1 ;
  891. 'REPETER' BOUCBO2 ;
  892.    'SI' ('EXISTE' TABOB1 IBOB ) ;
  893.       BOB1 = TABOB1.IBOB ;
  894.       RI  = BOB1.'RI'  ;
  895.       RE  = BOB1.'RE'  ;
  896.       H   = BOB1.'H'   ;
  897.       SOL = BOB1.'SOL' ;
  898.       C   = BOB1.'C'   ;
  899.       PP1 = TABTRAV6.IBOB ;
  900.       PP2 = TABTRAV7.IBOB ;
  901.       DENS = SOL / ((RE - RI) * H) ;
  902.      'MESS' 'Biot : contribution de la bobine ' IBOB ;
  903.       'SI' ( IBOB 'EGA' 1 ) ;
  904.          CHB1 = 'BIOT' GEO1 'CERC' C PP1 PP2 RI RE H DENS MU0 ;
  905.       'SINON' ;
  906.          CHB1 = CHB1 'ET'
  907.                ('BIOT' GEO1 'CERC' C PP1 PP2 RI RE H DENS MU0 ) ;
  908.       'FINSI' ;
  909.    'SINON' ;
  910.       'QUITTER' BOUCBO2 ;
  911.    'FINSI' ;
  912.    IBOB = IBOB + 1 ;
  913. 'FIN' BOUCBO2 ;
  914. TABCHB.IGEO1 = CHB1 ;
  915. 'SINON' ;
  916.    'QUITTER' BOGEO1 ;
  917. 'FINSI' ;
  918. IGEO1 = IGEO1 + 1 ;
  919. 'FIN' BOGEO1 ;
  920. *
  921. * Calcul du champ dans LIG.j
  922. *
  923. 'SI' ( 'EXISTE' PL1 ) ;
  924. 'SAUTER' 1 'LIGNE' ;
  925. 'MESS' 'Calcul du champ dans les contours des bobines' ;
  926. 'SAUTER' 1 'LIGNE' ;
  927. TABCH1 = 'TABLE' ;
  928. TAB2.CHBLIG = TABCH1 ;
  929. ICOUP = 1 ;
  930. 'REPETER' BOUCOU2 ;
  931.    'SI' ( 'EXISTE' PL1 ICOUP ) ;
  932.       GEO2 = TABLIG.ICOUP ;
  933.       IBOB = 1 ;
  934.       'REPETER' BOUCBO3 ;
  935.          'SI' ('EXISTE' TABOB1 IBOB ) ;
  936.             BOB1 = TABOB1.IBOB ;
  937.             RI  = BOB1.'RI'  ;
  938.             RE  = BOB1.'RE'  ;
  939.             H   = BOB1.'H'   ;
  940.             SOL = BOB1.'SOL' ;
  941.             C   = BOB1.'C'   ;
  942.             PP1 = TABTRAV6.IBOB ;
  943.             PP2 = TABTRAV7.IBOB ;
  944.             DENS = SOL / ((RE - RI) * H) ;
  945.             'MESS' 'Plan ' ICOUP
  946.               ' : appel a Biot pour la bobine ' IBOB ;
  947.             'SI' ( IBOB 'EGA' 1 ) ;
  948.                CHB2 = 'BIOT' GEO2 'CERC' C PP1 PP2 RI RE H
  949.                          DENS MU0 ;
  950.             'SINON' ;
  951.                CHB2 = CHB1 'ET' ('BIOT' GEO2 'CERC' C PP1
  952.                      PP2 RI RE H DENS MU0 ) ;
  953.             'FINSI' ;
  954.          'SINON' ;
  955.             'QUITTER' BOUCBO3 ;
  956.          'FINSI' ;
  957.          IBOB = IBOB + 1 ;
  958.       'FIN' BOUCBO3 ;
  959.       TABCH1.ICOUP = CHB2 ;
  960.    'SINON' ;
  961.       'QUITTER' BOUCOU2 ;
  962.    'FINSI' ;
  963.    ICOUP = ICOUP + 1 ;
  964. 'FIN' BOUCOU2 ;
  965. 'FINSI' ;
  966. *
  967. 'FIN' PROC ;
  968. *
  969. * On fait un peu de menage ...
  970. *
  971. 'MENAGE' ;
  972. 'SAUTER' 1 'LIGNE' ;
  973. 'SI' ( 'EGA' IERR 1 ) ;
  974.    'MESS' '*** FIN ANORMALE DE LA PROCEDURE POLO ***' ;
  975. 'SINON' ;
  976.    'MESS' '*** FIN DE LA PROCEDURE POLO ***' ;
  977. 'FINSI' ;
  978. 'SAUTER' 1 'LIGNE' ;
  979. 'FINPROC' TABCHB TAB2 ;
  980.  
  981.  
  982.  

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