Download @toro.procedur

Back to the list

   1 : * @TORO     PROCEDUR  AM        94/02/03    21:15:09     1048           
   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 = 3.1415926 ;
  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 '<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 ) '<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 ) '<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 ) '<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 '<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 ;  

© Cast3M 2003 - All rights reserved.
Disclaimer