Download @polo.procedur

Back to the list

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

© Cast3M 2003 - All rights reserved.
Disclaimer